Interop now working. Not all tests pass.

src/beowulf/bootstrap.clj

@@ -10,7 +10,7 @@
   therefore all arguments must be numbers, symbols or `beowulf.cons_cell.ConsCell`
   objects."
   (:require [clojure.string :as s]
-            [clojure.tools.trace :refer :all]
+            [clojure.tools.trace :refer [deftrace]]
             [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -39,7 +39,7 @@
   `(if (= ~x NIL) T F))
 
 (defmacro ATOM
-  "Returns `T` if and only is the argument `x` is bound to and atom; else `F`.
+  "Returns `T` if and only if the argument `x` is bound to an atom; else `F`.
   It is not clear to me from the documentation whether `(ATOM 7)` should return
   `T` or `F`. I'm going to assume `T`."
   [x]
@@ -52,6 +52,12 @@
   [x]
   `(if (or (symbol? ~x) (number? ~x)) T NIL))
 
+(defmacro NUMBERP
+  "Returns `T` if and only if the argument `x` is bound to an number; else `F`.
+  TODO: check whether floating point numbers, rationals, etc were numbers in Lisp 1.5"
+  [x]
+  `(if (number? ~x) T F))
+
 (defn CAR
   "Return the item indicated by the first pointer of a pair. NIL is treated
   specially: the CAR of NIL is NIL."
@@ -159,7 +165,6 @@
     :else
     (make-cons-cell (CAR x) (APPEND (CDR x) y))))
 
-
 (defn MEMBER
   "This predicate is true if the S-expression `x` occurs among the elements
   of the list `y`.
@@ -192,6 +197,11 @@
             (make-cons-cell (CAR x) (CAR y))
             (PAIRLIS (CDR x) (CDR y) a))))
 
+(defmacro QUOTE
+  "Quote, but in upper case for LISP 1.5"
+  [f]
+  `(quote ~f))
+
 (defn ASSOC
   "If a is an association list such as the one formed by PAIRLIS in the above
   example, then assoc will produce the first pair whose first term is x. Thus
@@ -253,6 +263,18 @@
           "/")))
     l))
 
+(defn to-clojure
+  "If l is a `beowulf.cons_cell.ConsCell`, return a Clojure list having the 
+  same members in the same order."
+  [l]
+  (cond
+    (not (instance? beowulf.cons_cell.ConsCell l))
+    l
+    (= (CDR l) NIL)
+    (list (to-clojure (CAR l)))
+    :else
+    (conj (to-clojure (CDR l)) (to-clojure (CAR l)))))
+
 (deftrace INTEROP
   "Clojure (or other host environment) interoperation API. `fn-symbol` is expected
   to be either
@@ -294,10 +316,11 @@
                      {:cause      :interop
                       :detail     :not-found
                       :name       fn-symbol
-                        :also-tried l-name})))]
+                      :also-tried l-name})))
-    (print (str "INTEROP: evaluating `" (cons f args) "`"))
+    args' (to-clojure args)]
+    (print (str "INTEROP: evaluating `" (cons f args') "`"))
     (flush)
-    (let [result (eval (read-string (str "(cons " f " " args ")")))] ;; this has the potential to blow up the world
+    (let [result (eval (conj args' f))] ;; this has the potential to blow up the world
       (println (str "; returning `" result "`"))
 
       (cond
@@ -373,6 +396,7 @@
   "Essentially, identical to EVAL except traced."
   [expr env]
   (cond
+    (NUMBERP expr) expr
     (=
       (ATOM? expr) T)
     (CDR (ASSOC expr env))
@@ -398,12 +422,13 @@
   (cond
     (true? (:trace *options*))
     (traced-eval expr env)
+    (NUMBERP expr) expr
     (=
      (ATOM? expr) T)
     (CDR (ASSOC expr env))
     (=
      (ATOM? (CAR expr))
-      T)(cond
+     T) (cond
           (= (CAR expr) 'QUOTE) (CADR expr)
           (= (CAR expr) 'COND) (EVCON (CDR expr) env)
           :else (APPLY

src/beowulf/cons_cell.clj

@@ -25,6 +25,9 @@
   (rplacd
     [this value]
     "replace the rest (but-first; cdr) of this sequence with this value")
+  (getCar 
+   [this]
+   "Return the first element of this sequence.")
   (getCdr
     [this]
     "like `more`, q.v., but returns List `NIL` not Clojure `nil` when empty." ))
@@ -66,6 +69,8 @@
               (str "Invalid value in RPLACD: `" value "` (" (type value) ")")
               {:cause  :bad-value
                :detail :rplaca}))))
+  (getCar [this] 
+          (. this CAR))
   (getCdr [this]
     (. this CDR))
 

src/beowulf/read.clj

@@ -17,6 +17,7 @@
             [clojure.math.numeric-tower :refer [expt]]
             [clojure.string :refer [starts-with? upper-case]]
             [instaparse.core :as i]
+            [instaparse.failure :as f]
             [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL]]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -93,7 +94,7 @@
   ([p]
    (if
      (instance? instaparse.gll.Failure p)
-     (throw (ex-info "Ic ne behæfd" {:cause :parse-failure :failure p}))
+     (throw (ex-info (str "Ic ne behæfd: " (f/pprint-failure p)) {:cause :parse-failure :failure p}))
      (simplify p :sexpr)))
   ([p context]
   (if

test/beowulf/bootstrap_test.clj

@@ -51,6 +51,21 @@
           actual (ATOM? (gsp "(A B C D)"))]
       (is (= actual expected) "A list is explicitly not an atom"))))
 
+(deftest numberp-tests
+  (testing "NUMBERP"
+    (let [expected T
+          actual   (NUMBERP 7)]
+      (is (= actual expected) "7 is a number"))
+    (let [expected T
+          actual   (NUMBERP 3.14)]
+      (is (= actual expected) "3.14 is a number"))
+    (let [expected F
+          actual   (NUMBERP NIL)]
+      (is (= actual expected) "NIL is not a number"))
+    (let [expected F
+          actual   (NUMBERP (gsp "HELLO"))]
+      (is (= actual expected) "HELLO is not a number"))))
+
 (deftest access-function-tests
   (testing "CAR"
     (let [expected 'A

test/beowulf/interop_test.clj

@@ -8,11 +8,11 @@
 
 (deftest interop-test
   (testing "INTEROP called from Clojure"
-    (let [expected '123
+    (let [expected (symbol "123")
           actual (INTEROP (gsp "(CLOJURE CORE STR)") (gsp "(1 2 3)"))]
       (is (= actual expected))))
   (testing "INTEROP called from Lisp"
     (let [expected 'ABC
-          actual (EVAL (gsp "(INTEROP '(CLOJURE CORE STR) '('A 'B 'C)"))]
+          actual (EVAL (INTEROP '(CLOJURE CORE STR) '('A 'B 'C)) '())]
       (is (= actual expected))))
     )