Now homoiconic for SEXPRS.

This commit is contained in:
Simon Brooke 2019-08-14 17:46:58 +01:00
parent 4d09151ab2
commit 9f669d2d50
2 changed files with 37 additions and 13 deletions

View file

@ -26,14 +26,26 @@
beowulf.cons_cell.ConsCell beowulf.cons_cell.ConsCell
(prin [x] (prin [x]
(let [car (.CAR x) (loop [c x
cdr (.CDR x)] n 0
(str s "("]
"(" (let [car (.CAR c)
(prin (.CAR x)) cdr (.CDR c)
" . " cons? (instance? beowulf.cons_cell.ConsCell cdr)
(prin (.CDR x)) ss (str
")"))) s
(prin car)
(cond
cons?
" "
(or (nil? cdr) (= cdr 'NIL))
")"
:else
(str " . " (prin cdr) ")")))]
(if
cons?
(recur cdr (inc n) ss)
ss))))
java.lang.Object java.lang.Object
(prin (prin

View file

@ -57,7 +57,6 @@
'p'. Note that the function acts recursively and progressively decapitates 'p'. Note that the function acts recursively and progressively decapitates
its argument, so that the argument will not always be a valid parse tree." its argument, so that the argument will not always be a valid parse tree."
[p] [p]
(println p)
(cond (cond
(empty? p) (empty? p)
NIL NIL
@ -72,6 +71,8 @@
(gen-dot-terminated-list (rest p))))) (gen-dot-terminated-list (rest p)))))
(defn gen-cond-clause (defn gen-cond-clause
"Generate a cond clause from this simplified parse tree fragment `p`;
returns `nil` if `p` does not represent a cond clause."
[p] [p]
(if (if
(and (coll? p)(= :cond-clause (first p))) (and (coll? p)(= :cond-clause (first p)))
@ -79,9 +80,9 @@
(list (generate (nth p 1)) (list (generate (nth p 1))
(generate (nth p 2)))))) (generate (nth p 2))))))
(defn gen-cond (defn gen-cond
"Generate a cond statement from this simplified parse tree fragment `p`;
returns `nil` if `p` does not represent a (MEXPR) cond statement."
[p] [p]
(if (if
(and (coll? p)(= :cond (first p))) (and (coll? p)(= :cond (first p)))
@ -92,7 +93,17 @@
gen-cond-clause gen-cond-clause
(rest p)))))) (rest p))))))
(defn gen-fn-call
"Generate a function call from this simplified parse tree fragment `p`;
returns `nil` if `p` does not represent a (MEXPR) function call.
TODO: I'm not yet certain but it appears that args in mexprs are
implicitly quoted; this function does not (yet) do that."
[p]
(if
(and (coll? p)(= :fncall (first p))(= :fn-name (first (second p))))
(make-cons-cell
(second (second p))
(generate (nth p 2)))))
(defn generate (defn generate
"Generate lisp structure from this parse tree `p`. It is assumed that "Generate lisp structure from this parse tree `p`. It is assumed that
@ -106,7 +117,8 @@
:dotted-pair (make-cons-cell :dotted-pair (make-cons-cell
(generate (nth p 1)) (generate (nth p 1))
(generate (nth p 2))) (generate (nth p 2)))
:list (gen-dot-terminated-list (rest p)) :fncall (gen-fn-call p)
(:args :list) (gen-dot-terminated-list (rest p))
:number (clojure.core/read-string (second p)) :number (clojure.core/read-string (second p))
;; default ;; default
(throw (Exception. (str "Cannot yet generate " (first p))))) (throw (Exception. (str "Cannot yet generate " (first p)))))