Use defp macros for parsers; update grammar using defp; update interpreter with new node names

This commit is contained in:
Scott Richmond 2023-05-26 15:07:41 -04:00
parent cff0f9b6e8
commit c6eeed4f4c
4 changed files with 296 additions and 248 deletions

View File

@ -2,3 +2,13 @@
[ ] Write send function
[ ] ---- Investigate weird timing issue in current send implementation
[ ] Investigate with-bindings and virtual threads
[ ] Fix recursive definition problems in grammar.clj
[ ] Wire up new interpreter to repl, script situation
[ ] Write compiler
[ ] Merge new interpreter
[ ] Get drawing working?

View File

@ -4,78 +4,92 @@
(declare expression pattern)
(def separator (choice :separator [:comma :newline :break]))
;(def separator (choice :separator [:comma :newline :break]))
(defp separator [choice] [:comma :newline :break])
(def separators (quiet (one+ separator)))
;(def separators (quiet (one+ separator)))
(defp separators quiet one+ separator)
(def terminator (choice :terminator [:newline :semicolon :break]))
;(def terminator (choice :terminator [:newline :semicolon :break]))
(defp terminator choice [:newline :semicolon :break])
(def terminators (quiet (one+ terminator)))
;(def terminators (quiet (one+ terminator)))
(defp terminators quiet one+ terminator)
(def nls? (quiet (zero+ :nls :newline)))
;(def nls? (quiet (zero+ :nls :newline)))
(defp nls? quiet zero+ :newline)
(def splat (group (order-1 :splat [(quiet :splat) :word])))
;(def splat (group (order-1 :splat [(quiet :splat) :word])))
(defp splat group order-1 [(quiet :splat) :word])
(def splattern (group (order-1 :splat [(quiet :splat) (flat (choice :splatted [:word :ignored :placeholder]))])))
;(def splattern (group (order-1 :splat [(quiet :splat) (maybe (flat (choice :splatted [:word :ignored :placeholder])))])))
(defp patt-splat-able quiet flat choice [:word :ignored :placeholder])
(defp splattern group order-1 [(quiet :splat) (maybe patt-splat-able)])
(def literal (flat (choice :literal [:nil :true :false :number :string])))
;(def literal (flat (choice :literal [:nil :true :false :number :string])))
(defp literal flat choice [:nil :true :false :number :string])
(def tuple-pattern-term (flat (choice :tuple-pattern-term [pattern splattern])))
;(def tuple-pattern-term (flat (choice :tuple-pattern-term [pattern splattern])))
(defp tuple-pattern-term flat choice [pattern splattern])
(def tuple-pattern-entry (weak-order :tuple-pattern-entry [tuple-pattern-term separators]))
;(def tuple-pattern-entry (weak-order :tuple-pattern-entry [tuple-pattern-term separators]))
(defp tuple-pattern-entry weak-order [tuple-pattern-term separators])
(def tuple-pattern (group (order-1 :tuple-pattern
[(quiet :lparen)
(defp tuple-pattern group order-1 [(quiet :lparen)
(quiet (zero+ separator))
(zero+ tuple-pattern-entry)
(quiet :rparen)])))
(quiet :rparen)])
(def list-pattern (group (order-1 :list-pattern
[(quiet :lbracket)
(defp list-pattern group order-1 [(quiet :lbracket)
(quiet (zero+ separator))
(zero+ tuple-pattern-entry)
(quiet :rbracket)])))
(quiet :rbracket)])
(def pair-pattern (order-0 :pair-pattern [:keyword pattern]))
(defp pair-pattern order-0 [:keyword #'pattern])
(def dict-pattern-term (flat (choice :dict-pattern-term [pair-pattern :word splattern])))
(defp dict-pattern-term flat choice [pair-pattern :word splattern])
(def dict-pattern-entry (weak-order :dict-pattern-entry [dict-pattern-term separators]))
(defp dict-pattern-entry weak-order [dict-pattern-term separators])
(def dict-pattern (group (order-1 :dict-pattern
[(quiet :startdict)
(defp dict-pattern group order-1 [(quiet :startdict)
(quiet (zero+ separator))
(zero+ dict-pattern-entry)
(quiet :rbrace)
])))
])
(def struct-pattern (group (order-1 :struct-pattern
[(quiet :startstruct)
(defp struct-pattern group order-1 [(quiet :startstruct)
(quiet (zero+ separator))
(zero+ dict-pattern-entry)
(quiet :rbrace)
])))
])
(def constraint (order-0 :constraint [(quiet :when) expression]))
(defp guard order-0 [(quiet :when) expression])
(def typed (group (weak-order :typed [:word (quiet :as) :keyword])))
(defp typed group weak-order [:word (quiet :as) :keyword])
(def pattern (flat (choice :pattern [literal :ignored :placeholder typed :word :keyword tuple-pattern dict-pattern struct-pattern list-pattern])))
(defp pattern flat choice [literal
:ignored
:placeholder
typed
:word
:keyword
tuple-pattern
dict-pattern
struct-pattern
list-pattern])
(def match-clause (group (weak-order :match-clause
[pattern (maybe constraint) (quiet :rarrow) expression])))
(defp match-clause group weak-order :match-clause [pattern (maybe guard) (quiet :rarrow) expression])
(def match-entry (weak-order :match-entry [match-clause terminators]))
(defp match-entry weak-order [match-clause terminators])
(def match (group (order-1 :match
[(quiet :match) expression nls?
(defp match group order-1 [(quiet :match) expression nls?
(quiet :with) (quiet :lbrace)
(quiet (zero+ terminator))
(one+ match-entry)
(quiet :rbrace)
])))
])
(def iff (group (order-1 :if [(quiet :if)
(defp if-expr group order-1 [(quiet :if)
nls?
expression
nls?
@ -83,194 +97,191 @@
expression
nls?
(quiet :else)
expression])))
expression])
(def cond-lhs (flat (choice :cond-lhs [expression :placeholder :else])))
(defp cond-lhs flat choice [expression :placeholder :else])
(def cond-clause (group (weak-order :cond-clause [cond-lhs (quiet :rarrow) expression])))
(defp cond-clause group weak-order [cond-lhs (quiet :rarrow) expression])
(def cond-entry (weak-order :cond-entry [cond-clause terminators]))
(defp cond-entry weak-order [cond-clause terminators])
(def condd (group (order-1 :cond [(quiet :cond) (quiet :lbrace)
(defp cond-expr group order-1 [(quiet :cond) (quiet :lbrace)
(quiet (zero+ terminator))
(one+ cond-entry)
(quiet :rbrace)])))
(quiet :rbrace)])
(def lett (group (order-1 :let [(quiet :let)
(defp let-expr group order-1 [(quiet :let)
pattern
(quiet :equals)
nls?
expression])))
expression])
(def tuple-entry (weak-order :tuple-entry [expression separators]))
(defp tuple-entry weak-order [expression separators])
(def tuple (group (order-1 :tuple [(quiet :lparen)
(defp tuple group order-1 [(quiet :lparen)
(quiet (zero+ separator))
(zero+ tuple-entry)
(quiet :rparen)])))
(quiet :rparen)])
(def list-term (flat (choice :list-term [splat expression])))
(defp list-term flat choice [splat expression])
(def list-entry (order-1 :list-entry [list-term separators]))
(defp list-entry order-1 [list-term separators])
(def listt (group (order-1 :list
[(quiet :lbracket)
(defp list-literal group order-1 [(quiet :lbracket)
(quiet (zero+ separator))
(zero+ list-entry)
(quiet :rbracket)])))
(quiet :rbracket)])
(def sett (group (order-1 :set [
(quiet :startset)
(defp set-literal group order-1 [(quiet :startset)
(quiet (zero+ separator))
(zero+ list-entry)
(quiet :rbrace)])))
(quiet :rbrace)])
(def pair (group (order-0 :pair [:keyword expression])))
(defp pair group order-0 [:keyword expression])
(def struct-term (flat (choice :struct-term [:word pair])))
(defp struct-term flat choice [:word pair])
(def struct-entry (order-1 :struct-entry [struct-term separators]))
(defp struct-entry order-1 [struct-term separators])
(def structt (group (order-1 :struct
[(quiet :startstruct)
(defp struct-literal group order-1 [(quiet :startstruct)
(quiet (zero+ separator))
(zero+ struct-entry)
(quiet :rbrace)])))
(quiet :rbrace)])
(def dict-term (flat (choice :dict-term [splat :word pair])))
(defp dict-term flat choice [splat :word pair])
(def dict-entry (order-1 :dict-entry [dict-term separators]))
(defp dict-entry order-1 [dict-term separators])
(def dict (group (order-1 :dict
[(quiet :startdict)
(defp dict group order-1 [(quiet :startdict)
(quiet (zero+ separator))
(zero+ dict-entry)
(quiet :rbrace)])))
(quiet :rbrace)])
(def arg-expr (flat (choice :arg-expr [:placeholder expression])))
(defp arg-expr flat choice [:placeholder expression])
(def arg-entry (weak-order :arg-entry [arg-expr separators]))
(defp arg-entry weak-order [arg-expr separators])
(def args (group (order-1 :args
[(quiet :lparen)
(defp args group order-1 [(quiet :lparen)
(quiet (zero+ separator))
(zero+ arg-entry)
(quiet :rparen)])))
(quiet :rparen)])
(def recurr (group (order-1 :recur [(quiet :recur) tuple])))
(defp recur-call group order-1 [(quiet :recur) tuple])
(def synth-root (flat (choice :synth-root [:keyword :word])))
(defp synth-root flat choice [:keyword :word])
(def synth-term (flat (choice :synth-term [args :keyword])))
(defp synth-term flat choice [args :keyword])
(def synthetic (group (order-1 :synthetic [synth-root (zero+ synth-term)])))
(defp synthetic group order-1 [synth-root (zero+ synth-term)])
(def fn-clause (group (order-1 :fn-clause [tuple-pattern (maybe constraint) (quiet :rarrow) expression])))
(defp fn-clause group order-1 [tuple-pattern (maybe constraint) (quiet :rarrow) expression])
(def fn-entry (order-1 :fn-entry [fn-clause terminators]))
(defp fn-entry order-1 [fn-clause terminators])
(def compound (group (order-1 :compound [(quiet :lbrace)
(defp compound group order-1 [(quiet :lbrace)
nls?
(maybe :string)
(quiet (zero+ terminator))
(one+ fn-entry)
(quiet :rbrace)
])))
])
(def clauses (flat (choice :clauses [fn-clause compound])))
(defp clauses flat choice [fn-clause compound])
(def named (group (order-1 :named [:word clauses])))
(defp named group order-1 [:word clauses])
(def body (flat (choice :body [fn-clause named])))
(defp body flat choice [fn-clause named])
(def fnn (group (order-1 :fn [(quiet :fn) body])))
(defp fn-expr group order-1 [(quiet :fn) body])
(def block-line (weak-order :block-line [expression terminators]))
(defp block-line weak-order [expression terminators])
(def block (group (order-1 :block [(quiet :lbrace)
(defp block group order-1 [(quiet :lbrace)
(quiet (zero+ terminator))
(one+ block-line)
(quiet :rbrace)])))
(quiet :rbrace)])
(def pipeline (quiet (order-0 :pipeline [nls? :pipeline])))
(defp pipeline quiet order-0 [nls? :pipeline])
(def do-entry (order-1 :do-entry [pipeline expression]))
(defp do-entry order-1 [pipeline expression])
(def doo (group (order-1 :do [(quiet :do)
(defp do-expr group order-1 [(quiet :do)
expression
(one+ do-entry)
])))
])
(def reff (group (order-1 :ref [(quiet :ref) :word (quiet :equals) expression])))
(defp ref-expr group order-1 [(quiet :ref) :word (quiet :equals) expression])
(def spawn (group (order-1 :spawn [(quiet :spawn) expression])))
(defp spawn group order-1 [(quiet :spawn) expression])
(def receive (group (order-1 :receive
[(quiet :receive) (quiet :lbrace)
(defp receive group order-1 [(quiet :receive) (quiet :lbrace)
(quiet (zero+ terminator))
(one+ match-entry)
(quiet :rbrace)
])))
])
(def compound-loop (group (order-0 :compound-loop
[(quiet :lbrace)
(defp compound-loop group order-0 [(quiet :lbrace)
(quiet (zero+ terminator))
(one+ fn-entry)
(quiet :rbrace)])))
(quiet :rbrace)])
(def loopp (group (order-1 :loop
[(quiet :loop) tuple (quiet :with)
(flat (choice :loop-body [fn-clause compound-loop]))])))
(defp loop-expr group order-1 [(quiet :loop) tuple (quiet :with)
(flat (choice :loop-body [fn-clause compound-loop]))])
(def expression (flat (choice :expression [fnn
(defp expression flat choice [fn-expr
match
loopp
lett
iff
condd
loop-expr
let-expr
if-expr
cond-expr
spawn
receive
synthetic
recurr
recur-call
block
doo
reff
structt
do-expr
ref-expr
struct-literal
dict
listt
sett
list-literal
set-literal
tuple
literal])))
literal])
(def testt (group (order-1 :test [(quiet :test) :string expression])))
(defp test-expr group order-1 [(quiet :test) :string expression])
(def importt (group (order-1 :import [(quiet :import) :string (quiet :as) :word])))
(defp import-expr group order-1 [(quiet :import) :string (quiet :as) :word])
(def nss (group (order-1 :ns [(quiet :ns)
(defp ns-expr group order-1 [(quiet :ns)
:word
(quiet :lbrace)
(quiet (zero+ separator))
(zero+ struct-entry)
(quiet :rbrace)])))
(quiet :rbrace)])
(def toplevel (flat (choice :toplevel [importt nss expression testt])))
(defp toplevel flat choice [import-expr
ns-expr
expression
test-expr])
(def script-line (weak-order :script-line [toplevel terminators]))
(defp script-line weak-order [toplevel terminators])
(def script (order-0 :script [nls?
(defp script order-0 [nls?
(one+ script-line)
(quiet :eof)]))
(quiet :eof)])
;;; REPL
;; TODO: fix this recursive def bullshit problem
(comment (def source
"if 1 then 2 else 3"
(def source
"2"
)
(def result (apply-parser script source))
(def rule (literal))
(def tokens (-> source scan/scan :tokens))
(def result (apply-parser literal tokens))
(defn report [node]
@ -295,4 +306,4 @@
tap
))
(println my-data))
(println my-data)

View File

@ -87,6 +87,7 @@
(recur (dec i)))
{:success false :reason (str "Could not match " pattern " with " value " because " (:reason match?))}))))))))
;; TODO: update this to use new AST representation
(defn- match-list [pattern value ctx-vol]
(cond
(not (vector? value)) {:success false :reason "Could not match non-list value to list"}
@ -112,6 +113,7 @@
(recur (dec i)))
{:success false :reason (str "Could not match " pattern " with " value " because " (:reason match?))})))))))
;; TODO: update this to match new AST representation
(defn- match-dict [pattern value ctx-vol]
(cond
(not (map? value))
@ -139,6 +141,7 @@
{:success false
:reason (str "Could not match " pattern " with " value " at key " kw " because there is no value at " kw)})))))))
;; TODO: update this to use new AST representation
(defn- match-struct [pattern value ctx-vol]
(cond
(not (map? value))
@ -242,7 +245,7 @@
if-expr (first data)
then-expr (second data)
else-expr (nth data 2)]
(if (= (:type if-expr) :let)
(if (= (:type if-expr) :let-expr)
(interpret-if-let ast ctx)
(if (interpret-ast if-expr ctx)
(interpret-ast then-expr ctx)
@ -563,9 +566,6 @@
(recur (:args output))
output)))))
(defn- panic [ast ctx]
(throw (ex-info (show/show (interpret-ast (:expr ast) ctx)) {:ast ast})))
(defn- list-term [ctx]
(fn [list member]
(if (= (:type member) :splat)
@ -656,6 +656,7 @@
(vswap! ctx update-ctx {name ns})
ns))))
;; TODO: update this to use new AST representation
(defn- interpret-receive [ast ctx]
(let [process-atom (get @process/processes self)
inbox (promise)
@ -684,6 +685,7 @@
(recur (first clauses) (rest clauses))))
(throw (ex-info "Match Error: No match found" {:ast ast})))))))
;; TODO: update send to be a function (here or in prelude)
(defn- interpret-send [ast ctx]
(let [msg (interpret-ast (:msg ast) ctx)
pid (interpret-ast (:pid ast) ctx)
@ -715,8 +717,6 @@
(defn- interpret-literal [ast] (-> ast :data first))
(interpret-literal {:data [false]})
(defn interpret-ast [ast ctx]
(println "interpreting ast type" (:type ast))
;(println "AST: " ast)
@ -724,9 +724,9 @@
(:nil :true :false :number :string :keyword) (interpret-literal ast)
:let (interpret-let ast ctx)
:let-expr (interpret-let ast ctx)
:if (interpret-if ast ctx)
:if-expr (interpret-if ast ctx)
:word (resolve-word ast ctx)
@ -734,28 +734,28 @@
:match (interpret-match ast ctx)
:cond (interpret-cond ast ctx)
:cond-expr (interpret-cond ast ctx)
:fn (interpret-fn ast ctx)
:fn-expr (interpret-fn ast ctx)
:do (interpret-do ast ctx)
:do-expr (interpret-do ast ctx)
:placeholder ::data/placeholder
:ns (interpret-ns ast ctx)
:ns-expr (interpret-ns ast ctx)
:import (interpret-import ast ctx)
:import-expr (interpret-import ast ctx)
:ref (interpret-ref ast ctx)
:ref-expr (interpret-ref ast ctx)
::ast/spawn (interpret-spawn ast ctx)
; ::ast/spawn (interpret-spawn ast ctx)
::ast/receive (interpret-receive ast ctx)
; ::ast/receive (interpret-receive ast ctx)
:recur
:recur-call
{::data/recur true :args (interpret-ast (-> ast :data first) ctx)}
:loop (interpret-loop ast ctx)
:loop-expr (interpret-loop ast ctx)
:block
(let [exprs (:data ast)
@ -779,17 +779,18 @@
(let [members (:data ast)]
(into [::data/tuple] (map #(interpret-ast % ctx)) members))
:list (interpret-list ast ctx)
:list-literal (interpret-list ast ctx)
:set (interpret-set ast ctx)
:set-literal (interpret-set ast ctx)
:dict (interpret-dict ast ctx)
:struct
:struct-literal
(let [members (:members ast)] (interpret-struct ast ctx))
(throw (ex-info "Unknown AST node type" {:ast ast}))))
;; TODO: update this to use new parser pipeline & new AST representation
(defn interpret-file [parsed file]
(try
(let [base-ctx (volatile! (merge {:file file} prelude/prelude process/process))]
@ -800,6 +801,7 @@
(println (ex-message e))
(System/exit 67))))
;; TODO: update this to use new parser pipeline & new AST representation
(defn interpret [parsed file]
(try
(let [base-ctx (volatile! (merge {:file file} prelude/prelude process/process))
@ -833,6 +835,7 @@
(println (ex-message e))
(pp/pprint (ex-data e)))))
;; TODO: update this to use new parser pipeline & new AST representation
(defn interpret-repl
([parsed ctx]
(let [orig-ctx @ctx

View File

@ -47,6 +47,7 @@
(let [result (cond
(keyword? parser) (apply-kw-parser parser tokens)
(:rule parser) (apply-fn-parser parser tokens)
(fn? parser) (apply-fn-parser (parser) tokens)
:else (throw (Exception. "`apply-parser` requires a parser")))]
;(println "Parser result " (? (:name parser) parser) (:status result))
result
@ -308,3 +309,26 @@
(defn err-msg [{token :token trace :trace}]
(println "Unexpected token " (:type token) " on line " (:line token))
(println "Expected token " (first trace)))
(defmacro defp [name & items]
(let [arg (last items)
fns (into [] (butlast items))]
`(defn ~name [] ((apply comp ~fns) (keyword '~name) ~arg))))
(macroexpand '(defp foo group choice [:one :two]))
(comment (defp foo quiet choice [:one :two])
(def group-choice (apply comp '(group choice)))
(group-choice :thing [:a :b])
((apply comp [group choice]) :foo [:one :two])
(fn? foo)
foo
(keyword 'foo)
(foo))