twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
TODO.xit
View File

@ -2,3 +2,13 @@
[ ] Write send function [ ] Write send function
[ ] ---- Investigate weird timing issue in current send implementation [ ] ---- Investigate weird timing issue in current send implementation
[ ] Investigate with-bindings and virtual threads [ ] 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?

263
src/ludus/grammar.clj
View File

@ -4,78 +4,92 @@
(declare expression pattern) (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 (defp tuple-pattern group order-1 [(quiet :lparen)
[(quiet :lparen)
(quiet (zero+ separator)) (quiet (zero+ separator))
(zero+ tuple-pattern-entry) (zero+ tuple-pattern-entry)
(quiet :rparen)]))) (quiet :rparen)])
(def list-pattern (group (order-1 :list-pattern (defp list-pattern group order-1 [(quiet :lbracket)
[(quiet :lbracket)
(quiet (zero+ separator)) (quiet (zero+ separator))
(zero+ tuple-pattern-entry) (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 (defp dict-pattern group order-1 [(quiet :startdict)
[(quiet :startdict)
(quiet (zero+ separator)) (quiet (zero+ separator))
(zero+ dict-pattern-entry) (zero+ dict-pattern-entry)
(quiet :rbrace) (quiet :rbrace)
]))) ])
(def struct-pattern (group (order-1 :struct-pattern (defp struct-pattern group order-1 [(quiet :startstruct)
[(quiet :startstruct)
(quiet (zero+ separator)) (quiet (zero+ separator))
(zero+ dict-pattern-entry) (zero+ dict-pattern-entry)
(quiet :rbrace) (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 (defp match-clause group weak-order :match-clause [pattern (maybe guard) (quiet :rarrow) expression])
[pattern (maybe constraint) (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 (defp match group order-1 [(quiet :match) expression nls?
[(quiet :match) expression nls?
(quiet :with) (quiet :lbrace) (quiet :with) (quiet :lbrace)
(quiet (zero+ terminator)) (quiet (zero+ terminator))
(one+ match-entry) (one+ match-entry)
(quiet :rbrace) (quiet :rbrace)
]))) ])
(def iff (group (order-1 :if [(quiet :if) (defp if-expr group order-1 [(quiet :if)
nls? nls?
expression expression
nls? nls?
@ -83,194 +97,191 @@
expression expression
nls? nls?
(quiet :else) (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)) (quiet (zero+ terminator))
(one+ cond-entry) (one+ cond-entry)
(quiet :rbrace)]))) (quiet :rbrace)])
(def lett (group (order-1 :let [(quiet :let) (defp let-expr group order-1 [(quiet :let)
pattern pattern
(quiet :equals) (quiet :equals)
nls? 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)) (quiet (zero+ separator))
(zero+ tuple-entry) (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 (defp list-literal group order-1 [(quiet :lbracket)
[(quiet :lbracket)
(quiet (zero+ separator)) (quiet (zero+ separator))
(zero+ list-entry) (zero+ list-entry)
(quiet :rbracket)]))) (quiet :rbracket)])
(def sett (group (order-1 :set [ (defp set-literal group order-1 [(quiet :startset)
(quiet :startset)
(quiet (zero+ separator)) (quiet (zero+ separator))
(zero+ list-entry) (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 (defp struct-literal group order-1 [(quiet :startstruct)
[(quiet :startstruct)
(quiet (zero+ separator)) (quiet (zero+ separator))
(zero+ struct-entry) (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 (defp dict group order-1 [(quiet :startdict)
[(quiet :startdict)
(quiet (zero+ separator)) (quiet (zero+ separator))
(zero+ dict-entry) (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 (defp args group order-1 [(quiet :lparen)
[(quiet :lparen)
(quiet (zero+ separator)) (quiet (zero+ separator))
(zero+ arg-entry) (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? nls?
(maybe :string) (maybe :string)
(quiet (zero+ terminator)) (quiet (zero+ terminator))
(one+ fn-entry) (one+ fn-entry)
(quiet :rbrace) (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)) (quiet (zero+ terminator))
(one+ block-line) (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 expression
(one+ do-entry) (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 (defp receive group order-1 [(quiet :receive) (quiet :lbrace)
[(quiet :receive) (quiet :lbrace)
(quiet (zero+ terminator)) (quiet (zero+ terminator))
(one+ match-entry) (one+ match-entry)
(quiet :rbrace) (quiet :rbrace)
]))) ])
(def compound-loop (group (order-0 :compound-loop (defp compound-loop group order-0 [(quiet :lbrace)
[(quiet :lbrace)
(quiet (zero+ terminator)) (quiet (zero+ terminator))
(one+ fn-entry) (one+ fn-entry)
(quiet :rbrace)]))) (quiet :rbrace)])
(def loopp (group (order-1 :loop (defp loop-expr group order-1 [(quiet :loop) tuple (quiet :with)
[(quiet :loop) tuple (quiet :with) (flat (choice :loop-body [fn-clause compound-loop]))])
(flat (choice :loop-body [fn-clause compound-loop]))])))
(def expression (flat (choice :expression [fnn (defp expression flat choice [fn-expr
match match
loopp loop-expr
lett let-expr
iff if-expr
condd cond-expr
spawn spawn
receive receive
synthetic synthetic
recurr recur-call
block block
doo do-expr
reff ref-expr
structt struct-literal
dict dict
listt list-literal
sett set-literal
tuple 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 :word
(quiet :lbrace) (quiet :lbrace)
(quiet (zero+ separator)) (quiet (zero+ separator))
(zero+ struct-entry) (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) (one+ script-line)
(quiet :eof)])) (quiet :eof)])
;;; REPL ;;; REPL
;; TODO: fix this recursive def bullshit problem (def source
"2"
(comment (def source
"if 1 then 2 else 3"
) )
(def result (apply-parser script source)) (def rule (literal))
(def tokens (-> source scan/scan :tokens))
(def result (apply-parser literal tokens))
(defn report [node] (defn report [node]
@ -295,4 +306,4 @@
tap tap
)) ))
(println my-data)) (println my-data)

45
src/ludus/interpreter.clj
View File

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

24
src/ludus/parser_new.clj
View File

@ -47,6 +47,7 @@
(let [result (cond (let [result (cond
(keyword? parser) (apply-kw-parser parser tokens) (keyword? parser) (apply-kw-parser parser tokens)
(:rule parser) (apply-fn-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")))] :else (throw (Exception. "`apply-parser` requires a parser")))]
;(println "Parser result " (? (:name parser) parser) (:status result)) ;(println "Parser result " (? (:name parser) parser) (:status result))
result result
@ -308,3 +309,26 @@
(defn err-msg [{token :token trace :trace}] (defn err-msg [{token :token trace :trace}]
(println "Unexpected token " (:type token) " on line " (:line token)) (println "Unexpected token " (:type token) " on line " (:line token))
(println "Expected token " (first trace))) (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))