diff --git a/src/beowulf/bootstrap.clj b/src/beowulf/bootstrap.clj index 3b69d49..ade18df 100644 --- a/src/beowulf/bootstrap.clj +++ b/src/beowulf/bootstrap.clj @@ -11,7 +11,7 @@ objects." (:require [clojure.string :as s] [clojure.tools.trace :refer [deftrace]] - [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL T F]])) + [beowulf.cons-cell :refer [cons-cell? make-beowulf-list make-cons-cell NIL pretty-print T F]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -38,6 +38,11 @@ [x] `(if (= ~x NIL) T F)) +(defmacro NILP + "Not part of LISP 1.5: `T` if `o` is `NIL`, else `NIL`." + [x] + `(if (= ~x NIL) T NIL)) + (defmacro ATOM "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 @@ -280,6 +285,16 @@ "/"))) l)) +(defn to-beowulf + "Return a beowulf-native representation of the Clojure object `o`. + Numbers and symbols are unaffected. Collections have to be converted; + strings must be converted to symbols." + [o] + (cond + (coll? o) (make-beowulf-list o) + (string? o) (symbol (s/upper-case o)) + :else o)) + (defn to-clojure "If l is a `beowulf.cons_cell.ConsCell`, return a Clojure list having the same members in the same order." @@ -359,6 +374,33 @@ {:cause :interop :detail :strict})))) +(defn OBLIST + "Not certain whether or not this is part of LISP 1.5; adapted from PSL. + return the current value of the object list. Note that in PSL this function + returns a list of the symbols bound, not the whole association list." + [args] + (@oblist)) + +(deftrace DEFINE + "Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten + in LISP. + + The single argument to `DEFINE` should be an assoc list which should be + nconc'ed onto the front of the oblist. Broadly, + (SETQ OBLIST (NCONC ARG1 OBLIST))" + [args] + (swap! + oblist + (fn [ob arg1] + (loop [cursor arg1 a arg1] + (if (= (CDR cursor) NIL) + (do + (.rplacd cursor @oblist) + (pretty-print a) + a) + (recur (CDR cursor) a)))) + (CAR args))) + (defn APPLY "For bootstrapping, at least, a version of APPLY written in Clojure. All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects. @@ -373,6 +415,7 @@ (= function 'CAR) (CAAR args) (= function 'CDR) (CDAR args) (= function 'CONS) (make-cons-cell (CAR args) (CADR args)) + (= function 'DEFINE) (DEFINE args) (= function 'ATOM) (if (ATOM? (CAR args)) T NIL) (= function 'EQ) (if (= (CAR args) (CADR args)) T NIL) (= function 'INTEROP) (INTEROP (CAR args) (CDR args)) @@ -381,6 +424,8 @@ (EVAL function environment) args environment)) + (fn? function) ;; i.e., it's a Clojure function + (apply function (to-clojure args)) (= (first function) 'LAMBDA) (EVAL (CADDR function) (PAIRLIS (CADR function) args environment)) @@ -424,9 +469,9 @@ (throw (ex-info (str "EVAL: strings not allowed in strict mode: \"" expr "\"") - {:cause :eval - :detail :strict - :expr expr})) + {:cause :eval + :detail :strict + :expr expr})) (symbol expr)) (= (ATOM? expr) T) (CDR (ASSOC expr env)) (= diff --git a/src/beowulf/cons_cell.clj b/src/beowulf/cons_cell.clj index f99f4f2..f15106e 100644 --- a/src/beowulf/cons_cell.clj +++ b/src/beowulf/cons_cell.clj @@ -4,6 +4,8 @@ must have both CAR and CDR mutable, so cannot be implemented on top of Clojure lists.") +(declare cons-cell?) + (def NIL "The canonical empty list symbol." (symbol "NIL")) @@ -46,6 +48,7 @@ ;; beowulf.cons_cell.ConsCell, ;; because it is not yet ;; defined + (cons-cell? value) (number? value) (symbol? value)) (do @@ -60,6 +63,7 @@ (if (or (satisfies? MutableSequence value) + (cons-cell? value) (number? value) (symbol? value)) (do @@ -217,6 +221,11 @@ (throw (ex-info "Cound not construct cons cell" {:car car :cdr cdr} any))))) +(defn cons-cell? + "Is this object `o` a beowulf cons-cell?" + [o] + (instance? beowulf.cons_cell.ConsCell o)) + (defn make-beowulf-list "Construct a linked list of cons cells with the same content as the sequence `x`."