Started on generating defns, but it doesn't work yet.

Also: downgraded to Clojure 1.8, because LightTable doesn't yet support 1.10
This commit is contained in:
Simon Brooke 2019-08-17 15:48:03 +01:00
parent 692eefeece
commit 8a7a2a4e25
3 changed files with 16 additions and 3 deletions

View file

@ -3,7 +3,7 @@
:url "http://example.com/FIXME" :url "http://example.com/FIXME"
:license {:name "GPL-2.0-or-later" :license {:name "GPL-2.0-or-later"
:url "https://www.eclipse.org/legal/epl-2.0/"} :url "https://www.eclipse.org/legal/epl-2.0/"}
:dependencies [[org.clojure/clojure "1.10.0"] :dependencies [[org.clojure/clojure "1.8.0"]
[org.clojure/math.numeric-tower "0.0.4"] [org.clojure/math.numeric-tower "0.0.4"]
[org.clojure/tools.trace "0.7.10"] [org.clojure/tools.trace "0.7.10"]
[environ "1.1.0"] [environ "1.1.0"]

View file

@ -26,7 +26,7 @@
fncall := fn-name lsqb args rsqb; fncall := fn-name lsqb args rsqb;
lsqb := '['; lsqb := '[';
rsqb := ']'; rsqb := ']';
defn := mexpr opt-space '=' opt-space mexpr; defn := mexpr opt-space <'='> opt-space mexpr;
cond := lsqb (cond-clause semi-colon opt-space)* cond-clause rsqb; cond := lsqb (cond-clause semi-colon opt-space)* cond-clause rsqb;
cond-clause := expr opt-space arrow opt-space expr; cond-clause := expr opt-space arrow opt-space expr;
arrow := '->'; arrow := '->';
@ -81,7 +81,7 @@
(case (first p) (case (first p)
(:arg :expr :coefficient :fn-name :number :sexpr) (simplify (second p) context) (:arg :expr :coefficient :fn-name :number :sexpr) (simplify (second p) context)
(:λexpr (:λexpr
:args :bindings :body :cond :cond-clause :dot-terminal :args :bindings :body :cond :cond-clause :defn :dot-terminal
:fncall :octal :quoted-expr :scientific) (map #(simplify % context) p) :fncall :octal :quoted-expr :scientific) (map #(simplify % context) p)
(:arrow :dot :e :lpar :lsqb :opt-space :q :quote :rpar :rsqb (:arrow :dot :e :lpar :lsqb :opt-space :q :quote :rpar :rsqb
:semi-colon :sep :space) nil :semi-colon :sep :space) nil
@ -195,6 +195,17 @@
(generate (second p)) (generate (second p))
(generate (nth p 2))))) (generate (nth p 2)))))
(defn gen-defn
[p]
(make-beowulf-list
(list
'LABEL
(generate (second (second p)))
(make-beowulf-list
(list
'LAMBDA
(generate (nth (second p) 2))
(doall (map generate (rest (rest p)))))))))
(defn gen-dot-terminated-list (defn gen-dot-terminated-list
"Generate a list, which may be dot-terminated, from this partial parse tree "Generate a list, which may be dot-terminated, from this partial parse tree
@ -247,6 +258,7 @@
:body (make-beowulf-list (map generate (rest p))) :body (make-beowulf-list (map generate (rest p)))
:cond (gen-cond p) :cond (gen-cond p)
(:decimal :integer) (read-string (strip-leading-zeros (second p))) (:decimal :integer) (read-string (strip-leading-zeros (second p)))
:defn (gen-defn p)
: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)))

View file

@ -64,3 +64,4 @@
(parse "label[ff;λ[[x];[atom[x]->x; T->ff[car[x]]]]]"))))] (parse "label[ff;λ[[x];[atom[x]->x; T->ff[car[x]]]]]"))))]
(is (= actual expected))))) (is (= actual expected)))))
;; (parse "equal[x;y] = [atom[x]->[atom[y]->eq[x;y]; T->F]; equal[car[x]; car[y]]->equal[cdr[x];cdr[y]];T->F]")