simon/beowulf
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Beginning work on infix operators in mexprs.

Browse source
This commit is contained in:
Simon Brooke 2023-03-25 16:25:56 +00:00
parent 434276ecea
commit ce7fe8f3ef
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
6 changed files with 152 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
project.clj
View file

@ -7,12 +7,14 @@
:description "An implementation of LISP 1.5 in Clojure"
:license {:name "GPL-2.0-or-later"
:url "https://www.eclipse.org/legal/epl-2.0/"}
:dependencies [[org.clojure/clojure "1.8.0"]
[org.clojure/math.numeric-tower "0.0.4"]
[org.clojure/tools.cli "0.4.2"]
[org.clojure/tools.trace "0.7.10"]
[environ "1.1.0"]
[instaparse "1.4.10"]]
:dependencies [[org.clojure/clojure "1.11.1"]
[org.clojure/math.numeric-tower "0.0.5"]
[org.clojure/tools.cli "1.0.214"]
[org.clojure/tools.trace "0.7.11"]
[environ "1.2.0"]
[instaparse "1.4.12"]
[rhizome "0.2.9"] ;; not needed in production builds
]
:main ^:skip-aot beowulf.core
:plugins [[lein-cloverage "1.1.1"]
[lein-codox "0.10.7"]

1
resources/apply-2.mexpr.lsp
View file

@ -19,4 +19,3 @@ apply[fn;args;a] = [
eq[car[fn]; FUNARG] -> apply[cadr[fn]; args; caddr[fn]];
eq[car[fn]; LAMBDA] -> eval[caddr[fn]; nconc[pair[cadr[fn]; args]; a]];
T -> apply[eval[fn;a]; args; a]]

3
resources/ff.mexpr.lsp Normal file
View file

@ -0,0 +1,3 @@
;; From page 6 of Lisp 1.5 Programmer's Manual
ff[x]=[atom[x] -> x; T -> ff[car[x]]]

3
resources/gcd.mexpr.lsp Normal file
View file

@ -0,0 +1,3 @@
gcd[x;y] = [x>y -> gcd[y;x];
rem[y;x] = 0 -> x;
T -> gcd[rem[y;x];x]]

152
src/beowulf/read.clj
View file

@ -5,7 +5,7 @@
Intended deviations from the behaviour of the real Lisp reader are as follows:
1. It reads the meta-expression language `MEXPR` in addition to the
1. It reads the meta-expression language `MEXPR` in addition to fLAMthe
symbolic expression language `SEXPR`, which I do not believe the Lisp 1.5
reader ever did;
2. It treats everything between a semi-colon and an end of line as a comment,
@ -15,7 +15,7 @@
switch."
(:require [beowulf.bootstrap :refer [*options*]]
[clojure.math.numeric-tower :refer [expt]]
[clojure.string :refer [join split starts-with? upper-case]]
[clojure.string :refer [join split starts-with? trim upper-case]]
[instaparse.core :as i]
[instaparse.failure :as f]
[beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL]])
@ -32,6 +32,29 @@
(declare generate)
(defn strip-line-comments
"Strip blank lines and comment lines from this string `s`, expected to
be Lisp source."
[^String s]
(join "\n"
(remove
#(or (empty? %)
(starts-with? (trim %) ";;"))
(split s #"\n"))))
(defn number-lines
([^String s]
(number-lines s nil))
([^String s ^Failure e]
(let [l (-> e :line)
c (-> e :column)]
(join "\n"
(map #(str (format "%5d %s" (inc %1) %2)
(when (= l (inc %1))
(str "\n" (apply str (repeat c " ")) "^")))
(range)
(split s #"\n"))))))
(def parse
"Parse a string presented as argument into a parse tree which can then
be operated upon further."
@ -54,7 +77,7 @@
;; but it's a convenience.
"exprs := expr | exprs;"
"mexpr := λexpr | fncall | defn | cond | mvar | mexpr comment;
"mexpr := λexpr | fncall | defn | cond | mvar | iexpr | mexpr comment;
λexpr := λ lsqb bindings semi-colon body rsqb;
λ := 'λ';
bindings := lsqb args rsqb;
@ -65,14 +88,20 @@
lbrace := '{';
rbrace := '}';
defn := mexpr opt-space '=' opt-space mexpr;
cond := lsqb (cond-clause semi-colon opt-space)* cond-clause rsqb;
cond-clause := expr opt-space arrow opt-space expr;
cond := lsqb (opt-space cond-clause semi-colon opt-space)* cond-clause rsqb;
cond-clause := expr opt-space arrow opt-space expr opt-space;
arrow := '->';
args := (expr semi-colon opt-space)* expr;
args := (opt-space expr semi-colon opt-space)* expr;
fn-name := mvar;
mvar := #'[a-z]+';
semi-colon := ';';"
;; Infix operators appear in mexprs, e.g. on page 7. Ooops!
;; I do not know what infix operators are considered legal.
"iexpr := iexp iop iexp;
iexp := mexpr | mvar | number | mexpr | opt-space iexp opt-space;
iop := '>' | '<' | '+' | '-' | '/' | '=' ;"
;; comments. I'm pretty confident Lisp 1.5 did NOT have these.
"opt-comment := opt-space | comment;"
"comment := opt-space <';;'> #'[^\\n\\r]*' opt-space;"
@ -106,6 +135,38 @@
q := 'Q';
scale-factor := #'[0-9]*'")))
(declare simplify)
(defn simplify-second-of-two
"There are a number of possible simplifications such that if the `tree` has
only two elements, the second is semantically sufficient."
[tree context]
(if (= (count tree) 2)
(simplify (second tree) context)
tree))
(defn remove-optional-space
[tree]
(if (vector? tree)
(if (= :opt-space (first tree))
nil
(remove nil?
(map remove-optional-space tree)))
tree))
(defn remove-nesting
[tree]
(let [tree' (remove-optional-space tree)]
(if-let [key (when (and (vector? tree') (keyword? (first tree'))) (first tree'))]
(loop [r tree']
(if (and r (vector? r) (keyword? (first r)))
(if (= (first r) key)
(recur (simplify (second r) :foo))
r)
r))
tree')))
(defn simplify
"Simplify this parse tree `p`. If `p` is an instaparse failure object, throw
an `ex-info`, with `p` as the value of its `:failure` key."
@ -113,27 +174,28 @@
(if
(instance? Failure p)
(throw (ex-info (str "Ic ne behæfd: " (f/pprint-failure p)) {:cause :parse-failure
:phase :simplify
:failure p}))
(simplify p :sexpr)))
(simplify p :expr)))
([p context]
(if
(coll? p)
(apply
vector
(remove
#(if (coll? %) (empty? %))
#(when (coll? %) (empty? %))
(case (first p)
(:arg :expr :coefficient :fn-name :number :sexpr) (simplify (second p) context)
(:λexpr
:args :bindings :body :cond :cond-clause :dot-terminal
:fncall :octal :quoted-expr :scientific) (map #(simplify % context) p)
(:arrow :dot :e :lpar :lsqb :opt-space :q :quote :rpar :rsqb
:args :bindings :body :cond :cond-clause :defn :dot-terminal
:fncall :lhs :octal :quoted-expr :rhs :scientific) (map #(simplify % context) p)
(:arg :expr :coefficient :fn-name :number) (simplify (second p) context)
(:arrow :dot :e :lpar :lsqb :opt-comment :opt-space :q :quote :rpar :rsqb
:semi-colon :sep :space) nil
:atom (if
(= context :mexpr)
[:quoted-expr p]
p)
(:comment :opt-comment) (if
:comment (when
(:strict *options*)
(throw
(ex-info "Cannot parse comments in strict mode"
@ -146,6 +208,11 @@
(simplify (nth p 1) context)
(simplify (nth p 2) context)]]
(map simplify p))
:iexp (second (remove-nesting p))
:iexpr [:iexpr
[:lhs (simplify (second p) context)]
(simplify (nth p 2) context) ;; really should be the operator
[:rhs (simplify (nth p 3) context)]]
:mexpr (if
(:strict *options*)
(throw
@ -159,6 +226,7 @@
[:args (apply vector (map simplify (rest p)))]]
(map #(simplify % context) p))
:raw (first (remove empty? (map simplify (rest p))))
:sexpr (simplify (second p) :sexpr)
;;default
p)))
p)))
@ -268,6 +336,29 @@
(generate (first p))
(gen-dot-terminated-list (rest p)))))
(defn generate-defn
[tree]
(make-beowulf-list
(list 'SET
(list 'QUOTE (generate (-> tree second second)))
(list 'QUOTE
(cons 'LAMBDA
(cons (generate (nth (second tree) 2))
(map generate (-> tree rest rest rest))))))))
(defn generate-set
"Actually not sure what the mexpr representation of set looks like"
[tree]
(throw (ex-info "Not Yet Implemented" {:feature "generate-set"})))
(defn generate-assign
"Generate an assignment statement based on this `tree`. If the thing
being assigned to is a function signature, then we have to do something
different to if it's an atom."
[tree]
(case (first (second tree))
:fncall (generate-defn tree)
(:mvar :atom) (generate-set tree)))
(defn strip-leading-zeros
"`read-string` interprets strings with leading zeros as octal; strip
@ -303,6 +394,7 @@
:cond (gen-cond p)
:cond-clause (gen-cond-clause p)
(:decimal :integer) (read-string (strip-leading-zeros (second p)))
:defn (generate-assign p)
:dotted-pair (make-cons-cell
(generate (nth p 1))
(generate (nth p 2)))
@ -332,20 +424,38 @@
{:generating p}
any)))))
(defmacro gsp
;; (defn parse
;; "Parse string `s` into a parse tree which can then be operated upon further."
;; [s]
;; (let [r (parse-internal s)]
;; (when (instance? Failure r)
;; (throw
;; (ex-info "Parse failed"
;; (merge {:fail r :source s} r))))
;; r))
(defn gsp
"Shortcut macro - the internals of read; or, if you like, read-string.
Argument `s` should be a string representation of a valid Lisp
expression."
[s]
`(generate (simplify (parse ~s))))
(let [source (strip-line-comments s)
parse-tree (parse source)]
(if (instance? Failure parse-tree)
(doall (println (number-lines source parse-tree))
(throw (ex-info "Parse failed" (assoc parse-tree :source source))))
(generate (simplify parse-tree)))))
(defn READ
"An implementation of a Lisp reader sufficient for bootstrapping; not necessarily
the final Lisp reader. `input` should be either a string representation of a LISP
expression, or else an input stream. A single form will be read."
[input]
(cond
(empty? input) (gsp (read-line))
(string? input) (gsp input)
(instance? InputStream input) (READ (slurp input))
:else (throw (ex-info "READ: `input` should be a string or an input stream" {}))))
([]
(gsp (read-line)))
([input]
(cond
(empty? input) (gsp (read-line))
(string? input) (gsp input)
(instance? InputStream input) (READ (slurp input))
:else (throw (ex-info "READ: `input` should be a string or an input stream" {})))))

6
test/beowulf/mexpr_test.clj
View file

@ -76,3 +76,9 @@
Exception
#"Cannot parse meta expressions in strict mode"
(gsp "label[ff;λ[[x];[atom[x]->x; T->ff[car[x]]]]]"))))))
(deftest assignment-tests
(testing "Function assignment"
(let [expected "(SET (QUOTE FF) (LAMBDA (X) (COND ((ATOM X) X) (T (FF (CAR X))))))"
actual (gsp "ff[x]=[atom[x] -> x; T -> ff[car[x]]]")]
(is (= actual expected)))))