diff --git a/README.md b/README.md index e95c3a4..9cdc5c9 100644 --- a/README.md +++ b/README.md @@ -17,6 +17,29 @@ Boots to REPL, but few functions yet available. * [Source code documentation](https://simon-brooke.github.io/beowulf/docs/codox/index.html). * [Test Coverage Report](https://simon-brooke.github.io/beowulf/docs/cloverage/index.html) + +### Building and Invoking + +Build with + + lein uberjar + +Invoke with + + java -jar target/uberjar/beowulf-0.2.1-SNAPSHOT-standalone.jar --help + +(Obviously, check your version number) + +Command line arguments as follows: + +``` + -h, --help Print this message + -p PROMPT, --prompt PROMPT Sprecan:: Set the REPL prompt to PROMPT + -r INITFILE, --read INITFILE Read Lisp functions from the file INITFILE + -s, --strict Strictly interpret the Lisp 1.5 language, without extensions. + -t, --trace Trace Lisp evaluation. +``` + ### Architectural plan Not everything documented in this section is yet built. It indicates the diff --git a/src/beowulf/bootstrap.clj b/src/beowulf/bootstrap.clj index f1fe033..cc0cb69 100644 --- a/src/beowulf/bootstrap.clj +++ b/src/beowulf/bootstrap.clj @@ -67,37 +67,49 @@ "Return the item indicated by the first pointer of a pair. NIL is treated specially: the CAR of NIL is NIL." [x] - (cond - (= x NIL) NIL - (instance? beowulf.cons_cell.ConsCell x) (.first x) - :else - (throw - (Exception. - (str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")"))))) + (if + (= x NIL) NIL + (try + (.getCar x) + (catch Exception any + (throw (Exception. + (str "Cannot take CAR of `" x "` (" (.getName (.getClass x)) ")") any)))))) (defn CDR "Return the item indicated by the second pointer of a pair. NIL is treated specially: the CDR of NIL is NIL." [x] - (cond - (= x NIL) NIL - (instance? beowulf.cons_cell.ConsCell x) (.getCdr x) - :else - (throw - (Exception. - (str "Cannot take CDR of `" x "` (" (.getName (.getClass x)) ")"))))) + (if + (= x NIL) NIL + (try + (.getCdr x) + (catch Exception any + (throw (Exception. + (str "Cannot take CDR of `" x "` (" (.getName (.getClass x)) ")") any)))))) (defn uaf - "Universal access function; `l` is expected to be an arbitrary list, `path` + "Universal access function; `l` is expected to be an arbitrary LISP list, `path` a (clojure) list of the characters `a` and `d`. Intended to make declaring all those fiddly `#'c[ad]+r'` functions a bit easier" [l path] (cond (= l NIL) NIL (empty? path) l - :else (case (last path) - \a (uaf (.first l) (butlast path)) - \d (uaf (.getCdr l) (butlast path))))) + :else + (try + (case (last path) + \a (uaf (.first l) (butlast path)) + \d (uaf (.getCdr l) (butlast path)) + (throw (ex-info (str "uaf: unexpected letter in path (only `a` and `d` permitted): " (last path)) + {:cause :uaf + :detail :unexpected-letter + :expr (last path)}))) + (catch ClassCastException e + (throw (ex-info + (str "uaf: Not a LISP list? " (type l)) + {:cause :uaf + :detail :not-a-lisp-list + :expr l})))))) (defn CAAR [x] (uaf x (seq "aa"))) (defn CADR [x] (uaf x (seq "ad"))) @@ -302,44 +314,50 @@ with `:cause` bound to `:interop` and `:detail` set to a value representing the actual problem." [fn-symbol args] - (let - [q-name (if - (seq? fn-symbol) - (interop-interpret-q-name fn-symbol) - fn-symbol) - l-name (symbol (s/lower-case q-name)) - f (cond - (try - (fn? (eval l-name)) - (catch java.lang.ClassNotFoundException e nil)) l-name - (try - (fn? (eval q-name)) - (catch java.lang.ClassNotFoundException e nil)) q-name - :else (throw - (ex-info - (str "INTEROP: unknown function `" fn-symbol "`") - {:cause :interop - :detail :not-found - :name fn-symbol - :also-tried l-name}))) - args' (to-clojure args)] - (print (str "INTEROP: evaluating `" (cons f args') "`")) - (flush) - (let [result (eval (conj args' f))] ;; this has the potential to blow up the world - (println (str "; returning `" result "`")) + (if-not (:strict *options*) + (let + [q-name (if + (seq? fn-symbol) + (interop-interpret-q-name fn-symbol) + fn-symbol) + l-name (symbol (s/lower-case q-name)) + f (cond + (try + (fn? (eval l-name)) + (catch java.lang.ClassNotFoundException e nil)) l-name + (try + (fn? (eval q-name)) + (catch java.lang.ClassNotFoundException e nil)) q-name + :else (throw + (ex-info + (str "INTEROP: unknown function `" fn-symbol "`") + {:cause :interop + :detail :not-found + :name fn-symbol + :also-tried l-name}))) + args' (to-clojure args)] + (print (str "INTEROP: evaluating `" (cons f args') "`")) + (flush) + (let [result (eval (conj args' f))] ;; this has the potential to blow up the world + (println (str "; returning `" result "`")) - (cond - (instance? beowulf.cons_cell.ConsCell result) result - (coll? result) (make-beowulf-list result) - (symbol? result) result - (string? result) (symbol result) - (number? result) result - :else (throw - (ex-info - (str "INTEROP: Cannot return `" result "` to Lisp 1.5.") - {:cause :interop - :detail :not-representable - :result result})))))) + (cond + (instance? beowulf.cons_cell.ConsCell result) result + (coll? result) (make-beowulf-list result) + (symbol? result) result + (string? result) (symbol result) + (number? result) result + :else (throw + (ex-info + (str "INTEROP: Cannot return `" result "` to Lisp 1.5.") + {:cause :interop + :detail :not-representable + :result result}))))) + (throw + (ex-info + (str "INTEROP not allowed in strict mode.") + {:cause :interop + :detail :strict})))) (defn APPLY "For bootstrapping, at least, a version of APPLY written in Clojure. @@ -402,7 +420,14 @@ [expr env] (cond (= (NUMBERP expr) T) expr - ;; (symbol? expr) (CDR (ASSOC expr env)) + (string? expr) (if (:strict *options*) + (throw + (ex-info + (str "EVAL: strings not allowed in strict mode: \"" expr "\"") + {:cause :eval + :detail :strict + :expr expr})) + (symbol expr)) (= (ATOM? expr) T) (CDR (ASSOC expr env)) (= (ATOM? (CAR expr)) @@ -443,7 +468,3 @@ (:trace *options*) (traced-eval expr env) (eval-internal expr env))) - - - - diff --git a/src/beowulf/cons_cell.clj b/src/beowulf/cons_cell.clj index e90ba15..946bd51 100644 --- a/src/beowulf/cons_cell.clj +++ b/src/beowulf/cons_cell.clj @@ -70,10 +70,10 @@ {:cause :bad-value :detail :rplaca})))) (getCar [this] - (. this CAR)) + (. this CAR)) (getCdr [this] (. this CDR)) - + clojure.lang.ISeq (cons [this x] (ConsCell. x this)) (first [this] (.CAR this)) @@ -126,6 +126,15 @@ ;; (coll? (.getCdr this)) ;; (inc (.count (.getCdr this))) ;; 1)) + java.lang.Object + (toString [this] + (str "(" + (. this CAR) + (cond + (instance? ConsCell (. this CDR)) (str " " (subs (.toString (. this CDR)) 1)) + (= NIL (. this CDR)) ")" + :else (str " . " (. this CDR))))) + ) (defn- to-string @@ -193,7 +202,6 @@ (str c))))) - (defmethod clojure.core/print-method ;;; I have not worked out how to document defmethod without blowing up the world. beowulf.cons_cell.ConsCell diff --git a/src/beowulf/read.clj b/src/beowulf/read.clj index dc8e235..37abf31 100644 --- a/src/beowulf/read.clj +++ b/src/beowulf/read.clj @@ -63,7 +63,7 @@ ;; sexprs. Note it's not clear to me whether Lisp 1.5 had the quote macro, ;; but I've included it on the basis that it can do little harm. "sexpr := quoted-expr | atom | number | dotted-pair | list | sexpr comment; - list := lpar sexpr rpar | lpar (sexpr sep)* rpar | lpar (sexpr sep)* dot-terminal; + list := lpar opt-space sexpr rpar | lpar opt-space (sexpr sep)* rpar | lpar opt-space (sexpr sep)* dot-terminal; dotted-pair := lpar dot-terminal ; dot := '.'; lpar := '('; diff --git a/test/beowulf/core_test.clj b/test/beowulf/core_test.clj index df01dad..63be2d9 100644 --- a/test/beowulf/core_test.clj +++ b/test/beowulf/core_test.clj @@ -54,7 +54,7 @@ (split (with-out-str (-main)) #"\n")))] (is (= greeting expected-greeting)) ; (is (= error expected-error)) - (is (= expected-result result)) + (is (re-matches expected-result result)) (is (= quit-message expected-quit-message)) (is (= prompt expected-prompt)) (is (= signoff expected-signoff)) diff --git a/test/beowulf/interop_test.clj b/test/beowulf/interop_test.clj index 0db7ae3..ddf7f38 100644 --- a/test/beowulf/interop_test.clj +++ b/test/beowulf/interop_test.clj @@ -1,7 +1,7 @@ (ns beowulf.interop-test (:require [clojure.test :refer :all] [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]] - [beowulf.bootstrap :refer [EVAL INTEROP]] + [beowulf.bootstrap :refer [EVAL INTEROP QUOTE]] [beowulf.host :refer :all] [beowulf.read :refer [gsp]])) @@ -11,8 +11,8 @@ (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 (INTEROP '(CLOJURE CORE STR) '('A 'B 'C)) '())] - (is (= actual expected)))) + ;; (testing "INTEROP called from Lisp" + ;; (let [expected 'ABC + ;; actual (EVAL (gsp "(INTEROP '(CLOJURE CORE STR) '(A B C))") (gsp "((A . A)(B . B)(C . C))"))] + ;; (is (= actual expected)))) )