From d049c7ec401498dcf36a3a158865cc9d63bc0cf8 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 5 Feb 2021 18:01:48 +0000 Subject: [PATCH] Reader now reads from file, and ignores (some) comments --- resources/lisp1.5.lsp | 11 +++ src/beowulf/read.clj | 178 ++++++++++++++++++++++-------------------- 2 files changed, 106 insertions(+), 83 deletions(-) diff --git a/resources/lisp1.5.lsp b/resources/lisp1.5.lsp index e69de29..c2d508e 100644 --- a/resources/lisp1.5.lsp +++ b/resources/lisp1.5.lsp @@ -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))) \ No newline at end of file diff --git a/src/beowulf/read.clj b/src/beowulf/read.clj index 37abf31..1450807 100644 --- a/src/beowulf/read.clj +++ b/src/beowulf/read.clj @@ -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" {}))))