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

Reader now reads from file, and ignores (some) comments

Browse source
This commit is contained in:
Simon Brooke 2021-02-05 18:01:48 +00:00
parent 78f2cc39f0
commit d049c7ec40
2 changed files with 106 additions and 83 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
resources/lisp1.5.lsp
View file

@ -0,0 +1,11 @@
;; Test comment
(DEFINE
(APPEND
(LAMBDA
(X Y)
(COND ((NULL X) Y) (T (CONS (CAR X) (APPEND (CDR X Y)))))))
(CONC
(LAMBDA
(X Y)
(COND ((NULL (CDR X)) (RPLACD X Y)) (T (CONC (CDR X) Y)))
X)))

178
src/beowulf/read.clj
View file

@ -14,11 +14,14 @@
Both these extensions can be disabled by using the `--strict` command line Both these extensions can be disabled by using the `--strict` command line
switch." switch."
(:require [beowulf.bootstrap :refer [*options*]] (:require [beowulf.bootstrap :refer [*options*]]
[clojure.java.io :refer [file reader]]
[clojure.math.numeric-tower :refer [expt]] [clojure.math.numeric-tower :refer [expt]]
[clojure.string :refer [starts-with? upper-case]] [clojure.string :refer [starts-with? upper-case]]
[instaparse.core :as i] [instaparse.core :as i]
[instaparse.failure :as f] [instaparse.failure :as f]
[beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL]])) [beowulf.cons-cell :refer [make-beowulf-list make-cons-cell NIL]])
(:import [java.io InputStream PushbackReader]
[instaparse.gll Failure]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
@ -34,13 +37,15 @@
"Parse a string presented as argument into a parse tree which can then "Parse a string presented as argument into a parse tree which can then
be operated upon further." be operated upon further."
(i/parser (i/parser
(str (str
;; top level: we accept mexprs as well as sexprs. ;; we tolerate whitespace and comments around legitimate input
"expr := mexpr | sexpr;" "raw := expr | opt-comment expr opt-comment;"
;; top level: we accept mexprs as well as sexprs.
"expr := mexpr | sexpr ;"
;; mexprs. I'm pretty clear that Lisp 1.5 could never read these, ;; mexprs. I'm pretty clear that Lisp 1.5 could never read these,
;; but it's a convenience. ;; but it's a convenience.
"mexpr := λexpr | fncall | defn | cond | mvar | mexpr comment; "mexpr := λexpr | fncall | defn | cond | mvar | mexpr comment;
λexpr := λ lsqb bindings semi-colon body rsqb; λexpr := λ lsqb bindings semi-colon body rsqb;
λ := 'λ'; λ := 'λ';
bindings := lsqb args rsqb; bindings := lsqb args rsqb;
@ -58,11 +63,12 @@
semi-colon := ';';" semi-colon := ';';"
;; comments. I'm pretty confident Lisp 1.5 did NOT have these. ;; comments. I'm pretty confident Lisp 1.5 did NOT have these.
"comment := opt-space <';;'> #'[^\\n\\r]*';" "opt-comment := opt-space | comment;"
"comment := opt-space <';;'> #'[^\\n\\r]*' opt-space;"
;; sexprs. Note it's not clear to me whether Lisp 1.5 had the quote macro, ;; 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. ;; but I've included it on the basis that it can do little harm.
"sexpr := quoted-expr | atom | number | dotted-pair | list | sexpr comment; "sexpr := quoted-expr | atom | number | dotted-pair | list | sexpr comment;
list := lpar opt-space sexpr rpar | lpar opt-space (sexpr sep)* rpar | lpar opt-space (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 ; dotted-pair := lpar dot-terminal ;
dot := '.'; dot := '.';
@ -77,7 +83,7 @@
atom := #'[A-Z][A-Z0-9]*';" atom := #'[A-Z][A-Z0-9]*';"
;; Lisp 1.5 supported octal as well as decimal and scientific notation ;; Lisp 1.5 supported octal as well as decimal and scientific notation
"number := integer | decimal | scientific | octal; "number := integer | decimal | scientific | octal;
integer := #'-?[1-9][0-9]*'; integer := #'-?[1-9][0-9]*';
decimal := #'-?[1-9][0-9]*\\.?[0-9]*' | #'0.[0-9]*'; decimal := #'-?[1-9][0-9]*\\.?[0-9]*' | #'0.[0-9]*';
scientific := coefficient e exponent; scientific := coefficient e exponent;
@ -93,55 +99,57 @@
an `ex-info`, with `p` as the value of its `:failure` key." an `ex-info`, with `p` as the value of its `:failure` key."
([p] ([p]
(if (if
(instance? instaparse.gll.Failure p) (instance? Failure p)
(throw (ex-info (str "Ic ne behæfd: " (f/pprint-failure p)) {:cause :parse-failure :failure p})) (throw (ex-info (str "Ic ne behæfd: " (f/pprint-failure p)) {:cause :parse-failure
:failure p}))
(simplify p :sexpr))) (simplify p :sexpr)))
([p context] ([p context]
(if (if
(coll? p) (coll? p)
(apply (apply
vector vector
(remove (remove
#(if (coll? %) (empty? %)) #(if (coll? %) (empty? %))
(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 :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
:atom (if :atom (if
(= context :mexpr) (= context :mexpr)
[:quoted-expr p] [:quoted-expr p]
p) p)
:comment (if (:comment :opt-comment) (if
(:strict *options*)
(throw
(ex-info "Cannot parse comments in strict mode"
{:cause :strict})))
:dotted-pair (if
(= context :mexpr)
[:fncall
[:mvar "cons"]
[:args
(simplify (nth p 1) context)
(simplify (nth p 2) context)]]
(map simplify p))
:mexpr (if
(:strict *options*) (:strict *options*)
(throw (throw
(ex-info "Cannot parse meta expressions in strict mode" (ex-info "Cannot parse comments in strict mode"
{:cause :strict})) {:cause :strict})))
(simplify (second p) :mexpr)) :dotted-pair (if
:list (if (= context :mexpr)
(= context :mexpr) [:fncall
[:fncall [:mvar "cons"]
[:mvar "list"] [:args
[:args (apply vector (map simplify (rest p)))]] (simplify (nth p 1) context)
(map #(simplify % context) p)) (simplify (nth p 2) context)]]
(map simplify p))
:mexpr (if
(:strict *options*)
(throw
(ex-info "Cannot parse meta expressions in strict mode"
{:cause :strict}))
(simplify (second p) :mexpr))
:list (if
(= context :mexpr)
[:fncall
[:mvar "list"]
[:args (apply vector (map simplify (rest p)))]]
(map #(simplify % context) p))
:raw (first (remove empty? (map simplify (rest p))))
;;default ;;default
p))) p)))
p))) p)))
;; # From Lisp 1.5 Programmers Manual, page 10 ;; # From Lisp 1.5 Programmers Manual, page 10
@ -199,33 +207,33 @@
returns `nil` if `p` does not represent a cond clause." 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)))
(make-beowulf-list (make-beowulf-list
(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`; "Generate a cond statement from this simplified parse tree fragment `p`;
returns `nil` if `p` does not represent a (MEXPR) cond statement." 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)))
(make-beowulf-list (make-beowulf-list
(cons (cons
'COND 'COND
(map (map
gen-cond-clause gen-cond-clause
(rest p)))))) (rest p))))))
(defn gen-fn-call (defn gen-fn-call
"Generate a function call from this simplified parse tree fragment `p`; "Generate a function call from this simplified parse tree fragment `p`;
returns `nil` if `p` does not represent a (MEXPR) function call." returns `nil` if `p` does not represent a (MEXPR) function call."
[p] [p]
(if (if
(and (coll? p)(= :fncall (first p))(= :mvar (first (second p)))) (and (coll? p) (= :fncall (first p)) (= :mvar (first (second p))))
(make-cons-cell (make-cons-cell
(generate (second p)) (generate (second p))
(generate (nth p 2))))) (generate (nth p 2)))))
(defn gen-dot-terminated-list (defn gen-dot-terminated-list
@ -239,12 +247,12 @@
(and (coll? (first p)) (= :dot-terminal (first (first p)))) (and (coll? (first p)) (= :dot-terminal (first (first p))))
(let [dt (first p)] (let [dt (first p)]
(make-cons-cell (make-cons-cell
(generate (nth dt 1)) (generate (nth dt 1))
(generate (nth dt 2)))) (generate (nth dt 2))))
:else :else
(make-cons-cell (make-cons-cell
(generate (first p)) (generate (first p))
(gen-dot-terminated-list (rest p))))) (gen-dot-terminated-list (rest p)))))
(defn strip-leading-zeros (defn strip-leading-zeros
@ -255,24 +263,24 @@
(strip-leading-zeros s "")) (strip-leading-zeros s ""))
([s prefix] ([s prefix]
(if (if
(empty? s) "0" (empty? s) "0"
(case (first s) (case (first s)
(\+ \-)(strip-leading-zeros (subs s 1) (str (first s) prefix)) (\+ \-) (strip-leading-zeros (subs s 1) (str (first s) prefix))
"0" (strip-leading-zeros (subs s 1) prefix) "0" (strip-leading-zeros (subs s 1) prefix)
(str prefix s))))) (str prefix s)))))
(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
`p` has been simplified." `p` has been simplified."
[p] [p]
(if (if
(coll? p) (coll? p)
(case (first p) (case (first p)
:λ "LAMBDA" :λ "LAMBDA"
:λexpr (make-cons-cell :λexpr (make-cons-cell
(generate (nth p 1)) (generate (nth p 1))
(make-cons-cell (generate (nth p 2)) (make-cons-cell (generate (nth p 2))
(generate (nth p 3)))) (generate (nth p 3))))
(:args :list) (gen-dot-terminated-list (rest p)) (:args :list) (gen-dot-terminated-list (rest p))
:atom (symbol (second p)) :atom (symbol (second p))
:bindings (generate (second p)) :bindings (generate (second p))
@ -280,21 +288,21 @@
: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)))
: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)))
:exponent (generate (second p)) :exponent (generate (second p))
:fncall (gen-fn-call p) :fncall (gen-fn-call p)
:mvar (symbol (upper-case (second p))) :mvar (symbol (upper-case (second p)))
:octal (let [n (read-string (strip-leading-zeros (second p) "0")) :octal (let [n (read-string (strip-leading-zeros (second p) "0"))
scale (generate (nth p 2))] scale (generate (nth p 2))]
(* n (expt 8 scale))) (* n (expt 8 scale)))
;; the quote read macro (which probably didn't exist in Lisp 1.5, but...) ;; the quote read macro (which probably didn't exist in Lisp 1.5, but...)
:quoted-expr (make-beowulf-list (list 'QUOTE (generate (second p)))) :quoted-expr (make-beowulf-list (list 'QUOTE (generate (second p))))
:scale-factor (if :scale-factor (if
(empty? (second p)) 0 (empty? (second p)) 0
(read-string (strip-leading-zeros (second p)))) (read-string (strip-leading-zeros (second p))))
:scientific (let [n (generate (second p)) :scientific (let [n (generate (second p))
exponent (generate (nth p 2))] exponent (generate (nth p 2))]
(* n (expt 10 exponent))) (* n (expt 10 exponent)))
@ -311,6 +319,10 @@
(defn READ (defn READ
"An implementation of a Lisp reader sufficient for bootstrapping; not necessarily "An implementation of a Lisp reader sufficient for bootstrapping; not necessarily
the final Lisp reader." 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] [input]
(gsp (or input (read-line)))) (cond
(string? input) (gsp (or input (read-line)))
(instance? InputStream input) (READ (slurp input))
:else (throw (ex-info "READ: `input` should be a string or an input stream" {}))))