Reader now reads from file, and ignores (some) comments
This commit is contained in:
parent
78f2cc39f0
commit
d049c7ec40
|
|
@ -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)))
|
||||
|
|
@ -14,11 +14,14 @@
|
|||
Both these extensions can be disabled by using the `--strict` command line
|
||||
switch."
|
||||
(:require [beowulf.bootstrap :refer [*options*]]
|
||||
[clojure.java.io :refer [file reader]]
|
||||
[clojure.math.numeric-tower :refer [expt]]
|
||||
[clojure.string :refer [starts-with? upper-case]]
|
||||
[instaparse.core :as i]
|
||||
[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
|
||||
be operated upon further."
|
||||
(i/parser
|
||||
(str
|
||||
;; top level: we accept mexprs as well as sexprs.
|
||||
"expr := mexpr | sexpr;"
|
||||
(str
|
||||
;; we tolerate whitespace and comments around legitimate input
|
||||
"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,
|
||||
;; 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;
|
||||
λ := 'λ';
|
||||
bindings := lsqb args rsqb;
|
||||
|
|
@ -58,11 +63,12 @@
|
|||
semi-colon := ';';"
|
||||
|
||||
;; 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,
|
||||
;; 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;
|
||||
dotted-pair := lpar dot-terminal ;
|
||||
dot := '.';
|
||||
|
|
@ -77,7 +83,7 @@
|
|||
atom := #'[A-Z][A-Z0-9]*';"
|
||||
|
||||
;; 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]*';
|
||||
decimal := #'-?[1-9][0-9]*\\.?[0-9]*' | #'0.[0-9]*';
|
||||
scientific := coefficient e exponent;
|
||||
|
|
@ -93,55 +99,57 @@
|
|||
an `ex-info`, with `p` as the value of its `:failure` key."
|
||||
([p]
|
||||
(if
|
||||
(instance? instaparse.gll.Failure p)
|
||||
(throw (ex-info (str "Ic ne behæfd: " (f/pprint-failure p)) {:cause :parse-failure :failure p}))
|
||||
(instance? Failure p)
|
||||
(throw (ex-info (str "Ic ne behæfd: " (f/pprint-failure p)) {:cause :parse-failure
|
||||
:failure p}))
|
||||
(simplify p :sexpr)))
|
||||
([p context]
|
||||
(if
|
||||
(if
|
||||
(coll? p)
|
||||
(apply
|
||||
(apply
|
||||
vector
|
||||
(remove
|
||||
#(if (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
|
||||
:semi-colon :sep :space) nil
|
||||
:atom (if
|
||||
(= context :mexpr)
|
||||
[:quoted-expr p]
|
||||
p)
|
||||
: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
|
||||
#(if (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
|
||||
:semi-colon :sep :space) nil
|
||||
:atom (if
|
||||
(= context :mexpr)
|
||||
[:quoted-expr p]
|
||||
p)
|
||||
(:comment :opt-comment) (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))
|
||||
(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*)
|
||||
(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
|
||||
p)))
|
||||
p)))
|
||||
p)))
|
||||
p)))
|
||||
|
||||
|
||||
;; # From Lisp 1.5 Programmers Manual, page 10
|
||||
|
|
@ -199,33 +207,33 @@
|
|||
returns `nil` if `p` does not represent a cond clause."
|
||||
[p]
|
||||
(if
|
||||
(and (coll? p)(= :cond-clause (first p)))
|
||||
(and (coll? p) (= :cond-clause (first p)))
|
||||
(make-beowulf-list
|
||||
(list (generate (nth p 1))
|
||||
(generate (nth p 2))))))
|
||||
(list (generate (nth p 1))
|
||||
(generate (nth p 2))))))
|
||||
|
||||
(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]
|
||||
(if
|
||||
(and (coll? p)(= :cond (first p)))
|
||||
(and (coll? p) (= :cond (first p)))
|
||||
(make-beowulf-list
|
||||
(cons
|
||||
'COND
|
||||
(map
|
||||
gen-cond-clause
|
||||
(rest p))))))
|
||||
(cons
|
||||
'COND
|
||||
(map
|
||||
gen-cond-clause
|
||||
(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."
|
||||
[p]
|
||||
(if
|
||||
(and (coll? p)(= :fncall (first p))(= :mvar (first (second p))))
|
||||
(and (coll? p) (= :fncall (first p)) (= :mvar (first (second p))))
|
||||
(make-cons-cell
|
||||
(generate (second p))
|
||||
(generate (nth p 2)))))
|
||||
(generate (second p))
|
||||
(generate (nth p 2)))))
|
||||
|
||||
|
||||
(defn gen-dot-terminated-list
|
||||
|
|
@ -239,12 +247,12 @@
|
|||
(and (coll? (first p)) (= :dot-terminal (first (first p))))
|
||||
(let [dt (first p)]
|
||||
(make-cons-cell
|
||||
(generate (nth dt 1))
|
||||
(generate (nth dt 2))))
|
||||
(generate (nth dt 1))
|
||||
(generate (nth dt 2))))
|
||||
:else
|
||||
(make-cons-cell
|
||||
(generate (first p))
|
||||
(gen-dot-terminated-list (rest p)))))
|
||||
(generate (first p))
|
||||
(gen-dot-terminated-list (rest p)))))
|
||||
|
||||
|
||||
(defn strip-leading-zeros
|
||||
|
|
@ -255,24 +263,24 @@
|
|||
(strip-leading-zeros s ""))
|
||||
([s prefix]
|
||||
(if
|
||||
(empty? s) "0"
|
||||
(case (first s)
|
||||
(\+ \-)(strip-leading-zeros (subs s 1) (str (first s) prefix))
|
||||
"0" (strip-leading-zeros (subs s 1) prefix)
|
||||
(str prefix s)))))
|
||||
(empty? s) "0"
|
||||
(case (first s)
|
||||
(\+ \-) (strip-leading-zeros (subs s 1) (str (first s) prefix))
|
||||
"0" (strip-leading-zeros (subs s 1) prefix)
|
||||
(str prefix s)))))
|
||||
|
||||
(defn generate
|
||||
"Generate lisp structure from this parse tree `p`. It is assumed that
|
||||
`p` has been simplified."
|
||||
[p]
|
||||
(if
|
||||
(coll? p)
|
||||
(coll? p)
|
||||
(case (first p)
|
||||
:λ "LAMBDA"
|
||||
:λexpr (make-cons-cell
|
||||
(generate (nth p 1))
|
||||
(make-cons-cell (generate (nth p 2))
|
||||
(generate (nth p 3))))
|
||||
(generate (nth p 1))
|
||||
(make-cons-cell (generate (nth p 2))
|
||||
(generate (nth p 3))))
|
||||
(:args :list) (gen-dot-terminated-list (rest p))
|
||||
:atom (symbol (second p))
|
||||
:bindings (generate (second p))
|
||||
|
|
@ -280,21 +288,21 @@
|
|||
:cond (gen-cond p)
|
||||
(:decimal :integer) (read-string (strip-leading-zeros (second p)))
|
||||
:dotted-pair (make-cons-cell
|
||||
(generate (nth p 1))
|
||||
(generate (nth p 2)))
|
||||
(generate (nth p 1))
|
||||
(generate (nth p 2)))
|
||||
:exponent (generate (second p))
|
||||
:fncall (gen-fn-call 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))]
|
||||
(* n (expt 8 scale)))
|
||||
|
||||
;; the quote read macro (which probably didn't exist in Lisp 1.5, but...)
|
||||
:quoted-expr (make-beowulf-list (list 'QUOTE (generate (second p))))
|
||||
:scale-factor (if
|
||||
(empty? (second p)) 0
|
||||
(read-string (strip-leading-zeros (second p))))
|
||||
:scientific (let [n (generate (second p))
|
||||
(empty? (second p)) 0
|
||||
(read-string (strip-leading-zeros (second p))))
|
||||
:scientific (let [n (generate (second p))
|
||||
exponent (generate (nth p 2))]
|
||||
(* n (expt 10 exponent)))
|
||||
|
||||
|
|
@ -311,6 +319,10 @@
|
|||
|
||||
(defn READ
|
||||
"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]
|
||||
(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" {}))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue