From 7ec258ee2465f0be72ee3cd6ac4a59823cfc30ed Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Thu, 16 Nov 2023 19:16:31 -0500 Subject: [PATCH] Clean it up, wire it up. --- deps.edn | 10 +- justfile | 5 +- src/ludus/analyzer.clj | 22 - src/ludus/{ast.clj => ast.cljc} | 0 .../{collections.clj => collections.cljc} | 0 src/ludus/compile.clj | 35 - src/ludus/core.clj | 39 - src/ludus/core.cljc | 39 + src/ludus/core.cljs | 3 - src/ludus/{data.clj => data.cljc} | 0 src/ludus/draw.clj | 32 - src/ludus/{grammar.clj => grammar.cljc} | 53 +- .../{interpreter.clj => interpreter.cljc} | 236 +-- src/ludus/interpreter_new.clj | 38 - src/ludus/loader.clj | 16 - src/ludus/ludus.ebnf | 135 -- src/ludus/parser.clj | 1279 ----------------- src/ludus/{parser_new.clj => parser.cljc} | 22 +- src/ludus/{prelude.clj => prelude.cljc} | 0 src/ludus/process.clj | 96 -- src/ludus/repl.clj | 124 -- src/ludus/{scanner.clj => scanner.cljc} | 2 +- src/ludus/{show.clj => show.cljc} | 0 src/ludus/{token.clj => token.cljc} | 0 24 files changed, 110 insertions(+), 2076 deletions(-) delete mode 100644 src/ludus/analyzer.clj rename src/ludus/{ast.clj => ast.cljc} (100%) rename src/ludus/{collections.clj => collections.cljc} (100%) delete mode 100644 src/ludus/compile.clj delete mode 100644 src/ludus/core.clj create mode 100644 src/ludus/core.cljc delete mode 100644 src/ludus/core.cljs rename src/ludus/{data.clj => data.cljc} (100%) delete mode 100644 src/ludus/draw.clj rename src/ludus/{grammar.clj => grammar.cljc} (92%) rename src/ludus/{interpreter.clj => interpreter.cljc} (81%) delete mode 100644 src/ludus/interpreter_new.clj delete mode 100644 src/ludus/loader.clj delete mode 100644 src/ludus/ludus.ebnf delete mode 100644 src/ludus/parser.clj rename src/ludus/{parser_new.clj => parser.cljc} (96%) rename src/ludus/{prelude.clj => prelude.cljc} (100%) delete mode 100644 src/ludus/process.clj delete mode 100644 src/ludus/repl.clj rename src/ludus/{scanner.clj => scanner.cljc} (99%) rename src/ludus/{show.clj => show.cljc} (100%) rename src/ludus/{token.clj => token.cljc} (100%) diff --git a/deps.edn b/deps.edn index ab9ab03..1440aae 100644 --- a/deps.edn +++ b/deps.edn @@ -1,7 +1,11 @@ { :deps {org.clojure/clojurescript {:mvn/version "1.11.121"}} - :aliases {:nREPL - {:extra-deps - {nrepl/nrepl {:mvn/version "0.9.0"}}}} + :aliases + {:repl + {:exec-fn clojure.core.server/start-server + :exec-args {:name "repl" + :port 5555 + :accept clojure.core.server/repl + :server-daemon false}}} } \ No newline at end of file diff --git a/justfile b/justfile index db14e23..6aacdfe 100644 --- a/justfile +++ b/justfile @@ -1,2 +1,3 @@ -repl: # start a repl - clj -X clojure.core.server/start-server :name repl :port 5555 :accept clojure.core.server/repl :server-daemon false \ No newline at end of file +# start a repl +repl: + clj -X:repl \ No newline at end of file diff --git a/src/ludus/analyzer.clj b/src/ludus/analyzer.clj deleted file mode 100644 index bc96e2a..0000000 --- a/src/ludus/analyzer.clj +++ /dev/null @@ -1,22 +0,0 @@ -(ns ludus.analyzer - (:require - [ludus.ast :as ast] - [ludus.token :as token])) - -(defn analyze [ast] ast) - -(comment " - Here's where we do a bunch of static analysis. - Some things we might wish for: - * No unused bindings - * No unbound names - * Compound `loop` and `gen` forms must have LHS's (tuple patterns) of the same length - * Recur must be in tail position in `loop`s - * Tail call optimization for simple recursion (rewrite it as a loop?) - * Check arities for statically known functions - * Enforce single-member tuple after called keywords - * Placeholders may only appear in tuples in synthetic expressions - * Each of these may have zero or one placeholders - * Function arities are correct - * Arity of called keywords must be 1 -") \ No newline at end of file diff --git a/src/ludus/ast.clj b/src/ludus/ast.cljc similarity index 100% rename from src/ludus/ast.clj rename to src/ludus/ast.cljc diff --git a/src/ludus/collections.clj b/src/ludus/collections.cljc similarity index 100% rename from src/ludus/collections.clj rename to src/ludus/collections.cljc diff --git a/src/ludus/compile.clj b/src/ludus/compile.clj deleted file mode 100644 index 5ead91d..0000000 --- a/src/ludus/compile.clj +++ /dev/null @@ -1,35 +0,0 @@ -(ns ludus.compile - (:require - [ludus.grammar :as g] - [ludus.parser-new :as p] - [ludus.scanner :as s])) - -(def source - "1" - ) - -(def result (->> source s/scan :tokens (p/apply-parser g/script))) - -(println result) - -(comment " - What sorts of compiling and validation do we want to do? Be specific. - - - check used names are bound (validation) - - check bound names are free (validation) - - check `recur` is only ever in `loop` (and in `fn` bodies?), in tail position (validation) - - separate function arities into different functions (optimization) - - desugar partially applied functions (?) (simplification) - - desugar keyword entry shorthand (?) (simplification) - - flag tail calls for optimization (optimization) - - direct tail calls - - through different expressions - - block - - if - - cond - - match - - let - - check ns access (validation) - - check constraints: only use specific fns (checked against a constraint-specific ctx) (validation) - - ") \ No newline at end of file diff --git a/src/ludus/core.clj b/src/ludus/core.clj deleted file mode 100644 index e1296e3..0000000 --- a/src/ludus/core.clj +++ /dev/null @@ -1,39 +0,0 @@ -(ns ludus.core - "A tree-walk interpreter for the Ludus language." - (:require - [ludus.scanner :as scanner] - ;[ludus.parser :as parser] - [ludus.parser-new :as p] - [ludus.grammar :as g] - [ludus.interpreter :as interpreter] - [ludus.show :as show] - [clojure.pprint :as pp] - [ludus.loader :as loader] - [ludus.repl :as repl]) - (:gen-class)) - -(defn- run [file source] - (let [scanned (scanner/scan source)] - (if (not-empty (:errors scanned)) - (do - (println "I found some scanning errors!") - (pp/pprint (:errors scanned)) - (System/exit 65)) - (let [parsed (p/apply-parser g/script (:tokens scanned))] - (if (p/fail? parsed) - (do - (println "I found some parsing errors!") - (println (p/err-msg parsed)) - (System/exit 66)) - (let [interpreted (interpreter/interpret source file parsed)] - (println (show/show interpreted)) - (System/exit 0))))))) - -(defn -main [& args] - (cond - (= (count args) 1) - (let [file (first args) - source (loader/load-import file)] - (run file source)) - - :else (repl/launch))) \ No newline at end of file diff --git a/src/ludus/core.cljc b/src/ludus/core.cljc new file mode 100644 index 0000000..ee8c600 --- /dev/null +++ b/src/ludus/core.cljc @@ -0,0 +1,39 @@ +(ns ludus.core + (:require + [ludus.scanner :as scanner] + [ludus.parser :as parser] + [ludus.grammar :as grammar] + [ludus.interpreter :as interpreter] + [ludus.show :as show] + [clojure.pprint :as pp] + )) + +(println "Hi, there.") + +(defn run [source] + (println (str "Running some ludus source: " source)) + (let [scanned (scanner/scan source)] + (if (not-empty (:errors scanned)) + (do + (println "I found some scanning errors!") + (pp/pprint (:errors scanned)) + nil + ) + (let [parsed (parser/apply-parser grammar/script (:tokens scanned))] + (if (parser/fail? parsed) + (do + (println "I found some parsing errors!") + (println (parser/err-msg parsed)) + nil + ) + (let [interpreted (interpreter/interpret source parsed)] + (println (show/show interpreted)) + interpreted + )))))) + +(run " + +fn foo () -> :bar + +foo () + ") \ No newline at end of file diff --git a/src/ludus/core.cljs b/src/ludus/core.cljs deleted file mode 100644 index cca0597..0000000 --- a/src/ludus/core.cljs +++ /dev/null @@ -1,3 +0,0 @@ -(ns ludus.core) - -(println "Hello, world!") \ No newline at end of file diff --git a/src/ludus/data.clj b/src/ludus/data.cljc similarity index 100% rename from src/ludus/data.clj rename to src/ludus/data.cljc diff --git a/src/ludus/draw.clj b/src/ludus/draw.clj deleted file mode 100644 index 5bc82e8..0000000 --- a/src/ludus/draw.clj +++ /dev/null @@ -1,32 +0,0 @@ -(ns ludus.draw - (:require [quil.core :as q] - [quil.middleware :as m])) - -(defn setup [] - (q/frame-rate 60) - (q/color-mode :hsb) - {:color 0 :angle 0}) - -(defn update-state [state] - {:color (mod (+ (:color state) 0.7) 255) - :angle (+ (:angle state) 0.1)}) - -(defn draw-state [state] - (q/background 240) - (q/fill (:color state) 255 255) - (let [angle (:angle state) - x (* 150 (q/cos angle)) - y (* 150 (q/sin angle))] - (q/with-translation [(/ (q/width) 2) - (/ (q/height) 2)] - (q/ellipse x y 100 100)))) - -(defn ludus-draw [] - (q/defsketch sketch - :title "Hello Ludus" - :size [500 500] - :setup setup - :update update-state - :draw draw-state - :features [] - :middleware [m/fun-mode])) diff --git a/src/ludus/grammar.clj b/src/ludus/grammar.cljc similarity index 92% rename from src/ludus/grammar.clj rename to src/ludus/grammar.cljc index 52a6cd9..6b5c4ae 100644 --- a/src/ludus/grammar.clj +++ b/src/ludus/grammar.cljc @@ -1,6 +1,13 @@ (ns ludus.grammar - (:require [ludus.parser-new :refer :all] - [ludus.scanner :as scan])) + (:require + #?( + :clj [ludus.parser :refer :all] + :cljs [ludus.parser + :refer [choice quiet one+ zero+ group order-0 order-1 flat maybe weak-order] + :refer-macros [defp] + ] + ) + )) (declare expression pattern) @@ -275,44 +282,4 @@ (defp script order-0 [nls? (one+ script-line) - (quiet :eof)]) - - -;;; REPL - -(comment - - (def source - "if 1 then 2 else 3" - ) - - (def rule (literal)) - - (def tokens (-> source scan/scan :tokens)) - - (def result (apply-parser script tokens)) - - - (defn report [node] - (when (fail? node) (err-msg node)) - node) - - (defn clean [node] - (if (map? node) - (-> node - (report) - (dissoc - ;:status - :remaining - :token) - (update :data #(into [] (map clean) %))) - node)) - - (defn tap [x] (println "\n\n\n\n******NEW RUN\n\n:::=> " x "\n\n") x) - - (def my-data (-> result - clean - tap - )) - - (println my-data)) \ No newline at end of file + (quiet :eof)]) \ No newline at end of file diff --git a/src/ludus/interpreter.clj b/src/ludus/interpreter.cljc similarity index 81% rename from src/ludus/interpreter.clj rename to src/ludus/interpreter.cljc index e06a80d..3ee9cc5 100644 --- a/src/ludus/interpreter.clj +++ b/src/ludus/interpreter.cljc @@ -1,21 +1,16 @@ (ns ludus.interpreter (:require - [ludus.parser :as parser] - [ludus.parser-new :as p] + [ludus.parser :as p] [ludus.grammar :as g] [ludus.scanner :as scanner] [ludus.ast :as ast] [ludus.prelude :as prelude] [ludus.data :as data] - [ludus.show :as show] - [ludus.loader :as loader] - [ludus.token :as token] - [ludus.process :as process] + ;;[ludus.loader :as loader] + [clojure.pprint :as pp] [clojure.set] [clojure.string])) -(def ^:dynamic self @process/current-pid) - ;; right now this is not very efficient: ;; it's got runtime checking ;; we should be able to do these checks statically @@ -593,30 +588,30 @@ (let [[k v] kv] [k (f v)])))) -(defn- interpret-import [ast ctx] - (let [data (:data ast) - path (-> data first :data first) - name (-> data second :data first) - file (ludus-resolve :file ctx) - from (if (= ::not-found file) :cwd file)] - (if (contains? @ctx name) - (throw (ex-info (str "Name " name " is alrady bound") {:ast ast})) - (let [source (try - (loader/load-import path from) - (catch Exception e - (if (::loader/error (ex-data e)) - (throw (ex-info (ex-message e) {:ast ast})) - (throw e)))) - parsed (->> source (scanner/scan) :tokens (p/apply-parser g/script))] - (if (p/fail? parsed) - (throw (ex-info - (str "Parse error in file " path "\n" - (p/err-msg parsed)) - {:ast ast})) - (let [interpret-result (interpret-file source path parsed)] - (vswap! ctx update-ctx {name interpret-result}) - interpret-result)) - )))) +; (defn- interpret-import [ast ctx] +; (let [data (:data ast) +; path (-> data first :data first) +; name (-> data second :data first) +; file (ludus-resolve :file ctx) +; from (if (= ::not-found file) :cwd file)] +; (if (contains? @ctx name) +; (throw (ex-info (str "Name " name " is alrady bound") {:ast ast})) +; (let [source (try +; (loader/load-import path from) +; (catch Exception e +; (if (::loader/error (ex-data e)) +; (throw (ex-info (ex-message e) {:ast ast})) +; (throw e)))) +; parsed (->> source (scanner/scan) :tokens (p/apply-parser g/script))] +; (if (p/fail? parsed) +; (throw (ex-info +; (str "Parse error in file " path "\n" +; (p/err-msg parsed)) +; {:ast ast})) +; (let [interpret-result (interpret-file source path parsed)] +; (vswap! ctx update-ctx {name interpret-result}) +; interpret-result)) +; )))) (defn- interpret-ref [ast ctx] (let [data (:data ast) @@ -757,70 +752,9 @@ (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) - clauses (:clauses ast)] - ;; (println "receiving in" self) - (swap! process-atom #(assoc % :inbox inbox :status :idle)) - ;; (println "awaiting message in" self) - (let [msg @inbox] - (swap! process-atom #(assoc % :status :occupied)) - ;; (println "message received by" self ":" msg) - (loop [clause (first clauses) - clauses (rest clauses)] - (if clause - (let [pattern (:pattern clause) - body (:body clause) - new-ctx (volatile! {::parent ctx}) - match? (match pattern msg new-ctx) - success (:success match?) - clause-ctx (:ctx match?)] - (if success - (do - (vswap! new-ctx #(merge % clause-ctx)) - (let [result (interpret-ast body new-ctx)] - (swap! process-atom #(assoc % :status :idle)) - result)) - (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) - process-atom (get @process/processes pid) - process @process-atom - q (:queue process) - status (:status process)] - (when (not (= :dead status)) - (swap! process-atom #(assoc % :queue (conj q msg))) - (Thread/sleep 1) ;; this is terrible--but it avoids deadlock - ;;TODO: actually debug this? - ;;THOUGHT: is swap! returning before the value is actually changed? Clojure docs say atoms are synchronous - ) - msg)) - -(defn- interpret-spawn [ast ctx] - (let [expr (-> ast :data first) - process (process/new-process) - pid (:pid @process)] - (with-bindings {#'self pid} - (future - (try (interpret-ast expr ctx) - (catch Exception e - (println "Panic in Ludus process" (str self ":") (ex-message e)) - ;; (pp/pprint (ex-data e)) - (println "On line" (get-in (ex-data e) [:ast :token ::token/line]) "in" (ludus-resolve :file ctx)))) - (swap! process #(assoc % :status :dead)))) - pid)) - (defn- interpret-literal [ast] (-> ast :data first)) (defn interpret-ast [ast ctx] - ;(println "interpreting ast type" (:type ast)) - ;(println "AST: " ast) (case (:type ast) (:nil :true :false :number :string :keyword) (interpret-literal ast) @@ -845,16 +779,12 @@ :ns-expr (interpret-ns ast ctx) - :import-expr (interpret-import ast ctx) + ;; :import-expr (interpret-import ast ctx) :ref-expr (interpret-ref ast ctx) :when-expr (interpret-ast (-> ast :data first) ctx) - ; ::ast/spawn (interpret-spawn ast ctx) - - ; ::ast/receive (interpret-receive ast ctx) - :recur-call {::data/recur true :args (interpret-ast (-> ast :data first) ctx)} @@ -899,99 +829,29 @@ (clojure.string/trim (nth lines (dec line)))))) ;; TODO: update this to use new parser pipeline & new AST representation -(defn interpret-file [source path parsed] - (try - (let [base-ctx (volatile! {::parent (volatile! prelude/prelude) :file path})] +; (defn interpret-file [source path parsed] +; (try +; (let [base-ctx (volatile! {::parent (volatile! prelude/prelude) :file path})] +; (interpret-ast parsed base-ctx)) +; (catch clojure.lang.ExceptionInfo e +; (println "Ludus panicked in" path) +; (println "On line" (get-in (ex-data e) [:ast :token :line])) +; (println ">>> " (get-line source (get-in (ex-data e) [:ast :token :line]))) +; (println (ex-message e)) +; (System/exit 67)))) + +;; TODO: update this to use new parser pipeline & new AST representation +(defn interpret [source parsed] + (try + (let [base-ctx (volatile! {::parent (volatile! prelude/prelude)})] (interpret-ast parsed base-ctx)) (catch clojure.lang.ExceptionInfo e - (println "Ludus panicked in" path) + (println "Ludus panicked!") (println "On line" (get-in (ex-data e) [:ast :token :line])) (println ">>> " (get-line source (get-in (ex-data e) [:ast :token :line]))) (println (ex-message e)) - (System/exit 67)))) - -;; TODO: update this to use new parser pipeline & new AST representation -(defn interpret [source path parsed] - (try - (let [base-ctx (volatile! {::parent (volatile! prelude/prelude) :file path}) - process (process/new-process)] - (process/start-vm) - (with-bindings {#'self (:pid @process)} - (let [result (interpret-ast parsed base-ctx)] - (swap! process #(assoc % :status :dead)) - (process/stop-vm) - result))) - (catch clojure.lang.ExceptionInfo e - (println "Ludus panicked in" path) - (println "On line" (get-in (ex-data e) [:ast :token :line])) - (println ">>> " (get-line source (get-in (ex-data e) [:ast :token :line]))) - (println (ex-message e)) - (System/exit 67)))) - -(defn interpret-safe [parsed] - (try - (let [base-ctx (volatile! {::parent (volatile! prelude/prelude)}) - process (process/new-process)] - (process/start-vm) - (with-bindings {#'self (:pid @process)} - (let [result (interpret-ast parsed base-ctx)] - (swap! process #(assoc % :status :dead)) - (process/stop-vm) - result))) - (catch clojure.lang.ExceptionInfo e - (process/stop-vm) - (println "Ludus panicked on line " (get-in (ex-data e) [:ast :token :line])) - (println "> " (get-in (ex-data e) [:ast :token])) - (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 - process (process/new-process) - pid (:pid @process)] - (try - (process/start-vm) - (with-bindings {#'self pid} - (let [result (interpret-ast parsed ctx)] - {:result result :ctx ctx :pid pid})) - (catch clojure.lang.ExceptionInfo e - (println "Ludus panicked!") - (println (ex-message e)) - {:result :error :ctx (volatile! orig-ctx) :pid pid})))) - ([parsed ctx pid] - (let [orig-ctx @ctx] - (try - (process/start-vm) - (with-bindings {#'self pid} - (let [result (interpret-ast parsed ctx)] - {:result result :ctx ctx :pid pid})) - (catch clojure.lang.ExceptionInfo e - (println "Ludus panicked!") - (println (ex-message e)) - {:result :error :ctx (volatile! orig-ctx) :pid pid} - ))))) - - -(comment - (def source " - let 2 = 1 - ") - - (println "") - (println "****************************************") - (println "*** *** NEW INTERPRETATION *** ***") - (println "") - - (let [result (->> source - scanner/scan - :tokens - (p/apply-parser g/script) - interpret-safe - show/show - )] - (println result) - result)) + (pp/pprint (ex-data e) + ;;(System/exit 67) + )))) +(+ 1 2) \ No newline at end of file diff --git a/src/ludus/interpreter_new.clj b/src/ludus/interpreter_new.clj deleted file mode 100644 index 174531e..0000000 --- a/src/ludus/interpreter_new.clj +++ /dev/null @@ -1,38 +0,0 @@ -(ns ludus.interpreter-new - (:require - [ludus.grammar :as g] - [ludus.parser-new :as p] - [ludus.scanner :as s])) - -(def source - "(1, 2) -" - ) - -(def tokens (-> source s/scan :tokens)) - -(def result (p/apply-parser g/script tokens)) - -(-> result :data) - -(defn report [node] - (when (p/fail? node) (p/err-msg node)) - node) - -(defn clean [node] - (if (map? node) - (-> node - (report) - (dissoc - ;:status - :remaining - :token) - (update :data #(into [] (map clean) %))) - node)) - -(defn tap [x] (println "\n\n\n\n******NEW RUN\n\n:::=> " x "\n\n") x) - -(def my-data (-> result - clean - tap - )) diff --git a/src/ludus/loader.clj b/src/ludus/loader.clj deleted file mode 100644 index f8ba0a0..0000000 --- a/src/ludus/loader.clj +++ /dev/null @@ -1,16 +0,0 @@ -(ns ludus.loader - (:require [babashka.fs :as fs])) - -(defn cwd [] (fs/cwd)) - -(defn load-import - ([file] - (let [path (-> file (fs/canonicalize) (fs/file))] - (try (slurp path) - (catch java.io.FileNotFoundException _ - (throw (ex-info (str "File " path " not found") {:path path ::error true})))))) - ([file from] - (load-import - (fs/path - (if (= from :cwd) (fs/cwd) (fs/parent (fs/canonicalize from))) - (fs/path file))))) diff --git a/src/ludus/ludus.ebnf b/src/ludus/ludus.ebnf deleted file mode 100644 index 3427f8a..0000000 --- a/src/ludus/ludus.ebnf +++ /dev/null @@ -1,135 +0,0 @@ -(* - ludus.ebnf - - An Instaparse-style EBNF grammer for Ludus. -*) - -script = toplevel { toplevel } - -terminator = (";" | <{comment}> "\n")+ - -ws = (" " | "\t" | "\r")+ - -wsnl = (ws | <{comment}> "\n")+ - -reserved = "cond" | "let" | "if" | "then" | "else" | "nil" | "true" | "false" | "as" | "match" | "with" | "NaN" | "recur" - -comment = "&" not_nl* - -not_nl = #"[^\n]" - -toplevel = expression | import | test | ns - -test = <"test" ws> string expression - -import = <"import" ws> string name - -ns = <"ns" ws> name entries - -entries = [(name | entry) { [(name | entry)]}] - -expression = if | cond | let | tuple | atom | synthetic | block | match | fn | do | loop | dict | struct | list | ref | spawn | send | receive | repeat - -(* TODO: is this right? *) -repeat = <"repeat" ws> (number | name) fn_clause - -spawn = <"spawn" ws> expression - -receive = <"receive" ws? "{" wsnl?> match_clause {terminator [match_clause]} - -ref = <"ref" ws> name tuple (fn_clause - | (<"{" wsnl?> fn_clause {terminator [fn_clause]} )) - -do = <"do" ws> expression { expression} - -pipe = wsnl? "|>" wsnl? - -fn = lambda | named | complex - -lambda = <"fn" ws?> fn_clause - -named = <"fn" ws?> name fn_clause - -complex = <"fn" ws?> name "{" string? fn_clause {terminator [fn_clause]} - -fn_clause = tuple_pattern expression - -match = <"match" ws> expression match_clause {terminator [match_clause]} - -match_clause = pattern constraint? expression - -constraint = <"when" ws> expression - -let = <"let" ws> pattern [pattern { [pattern]}] <{separator} ws? ")"> - -struct_pattern = <"@{" wsnl?> [(name | pattern_entry | splattern) { [(name | pattern_entry | splattern)]}] <{separator} ws? "}"> - -dict_pattern = <"#{" wsnl?> [(name | pattern_entry | splattern) { [(name | pattern_entry | splattern)]}] <{separator} ws? "}"> - -pattern_entry = keyword pattern - -splattern = <"..."> name | ignored | placeholder - -block = <"{" wsnl?> expression { expression } - -cond = "cond" expression cond_clause {terminator [cond_clause]} - -cond_clause = expression expression - -arrow = " wsnl?> - -if = <"if" ws> expression expression <"else" ws> expression - -synthetic = (name | keyword | recur) (( (args | keyword))+) - -recur = <"recur"> - -separator = ("," | "\n") - -args = <"(" ws? {separator}> [arg_expr { [arg_expr]}] <{separator} ws? ")"> - -arg_expr = expression | placeholder - -placeholder = <"_"> - -tuple = <"(" wsnl?> [expression { [expression]}] <{separator} ws? ")"> - -list = <"[" wsnl?> [(expression | splat) { [(expression | splat)]}] <{separator} ws? "]"> - -struct = <"@{" wsnl?> [(name | entry) { [(name | entry)]}] <{separator} ws? "}"> - -dict = <"#{" wsnl?> [(name | entry | splat) { [(name | entry | splat)]}] <{separator} ws? "}"> - -entry = keyword expression - -splat = <"..."> name - -atom = name | ignored | keyword | number | string | boolean | nil - -boolean = true | false - -true = <"true"> - -false = <"false"> - -nil = <"nil"> - -string = <'"'> {escaped_quote | nonquote} <'"'> - -escaped_quote = "\\" '\"' -nonquote = #'[^"]' - -keyword = #":[a-zA-Z][a-zA-Z0-9\/\-_!\*\?]*" -ignored = #"_[a-z][a-zA-Z0-9\/\-_!\*\?]*" - -name = !reserved #"[a-z][a-zA-Z0-9\/\-_!\*\?]*" - -(* TODO: Debug this to reject things starting with 0, eg 012. *) -number = #"\-?[1-9][0-9]*" | #"\-?(0|[1-9][0-9]*).[0-9]+" | ["-"] "0" | "NaN" - diff --git a/src/ludus/parser.clj b/src/ludus/parser.clj deleted file mode 100644 index cf5f0f3..0000000 --- a/src/ludus/parser.clj +++ /dev/null @@ -1,1279 +0,0 @@ -(ns ludus.parser - (:require - [ludus.token :as token] - [ludus.scanner :as scanner] - [ludus.ast :as ast] - [clojure.pprint :as pp] - [clojure.set :as s])) - -;; a parser map and some functions to work with them -(defn- parser [tokens] - {::tokens tokens ::token 0 ::ast {} ::errors []}) - -(defn- current [parser] - (nth (::tokens parser) (::token parser) nil)) - -(defn- ppeek [parser] - (nth (::tokens parser) (inc (::token parser)) nil)) - -(defn- at-end? [parser] - (let [curr (current parser)] - (or (nil? curr) (= ::token/eof (::token/type curr))))) - -(defn- advance [parser] - (update parser ::token inc)) - -(defn- token-type [parser] - (::token/type (current parser))) - -(defn- node-type [parser] - (get-in parser [::ast ::ast/type])) - -;; some forward declarations -(declare parse-expr parse-word parse-pattern) - -;; handle some errors -(def sync-on #{::token/newline - ::token/semicolon - ::token/comma - ::token/rparen - ::token/rbracket - ::token/rbrace - ::token/eof}) - -(defn- psync [parser message origin end] - (let [poison {::ast/type ::ast/poison - :message message - :origin origin - :end end}] - (-> parser - (assoc ::ast poison) - (update ::errors conj poison)))) - -(defn- poisoned? [parser] - (= ::ast/poison (get-in parser [::ast ::ast/type]))) - -(defn- panic - ([parser message] (panic parser message sync-on)) - ([parser message sync-on] - (println (str "PANIC!!! in the parser: " message)) - (let [sync-on (conj (if (set? sync-on) sync-on #{sync-on}) ::token/eof) - origin (current parser)] - (loop [parser parser] - (let [curr (current parser) - type (::token/type curr)] - (if (or (at-end? parser) (contains? sync-on type)) - (psync parser message origin curr) - (recur (advance parser)))))))) - -;; some helper functions -(defn- expect [tokens message parser] - (let [curr (current parser) - tokens (if (set? tokens) tokens #{tokens}) - type (::token/type curr)] - (if (contains? tokens type) - (advance parser) - (-> parser - (advance) - (panic message tokens))))) - -(defn- expect* [tokens message parser] - (let [curr (current parser) - tokens (if (set? tokens) tokens #{tokens}) - type (::token/type curr)] - (if (contains? tokens type) - {:success true :parser (advance parser)} - {:success false :parser (panic (advance parser) message)}))) - -(defn- accept [tokens parser] - (let [curr (current parser) - tokens (if (set? tokens) tokens #{tokens}) - type (::token/type curr)] - (if (contains? tokens type) - (advance parser) - parser))) - -(defn- accept-many [tokens parser] - (let [tokens (if (set? tokens) tokens #{tokens})] - (loop [parser parser] - (let [curr (current parser) - type (::token/type curr)] - (if (contains? tokens type) - (recur (advance parser)) - parser))))) - -;; various parsing functions -(defn- parse-atom [parser] - (let [token (current parser)] - (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/atom - :token token - :value (::token/literal token)})))) - -;; just a quick and dirty map to associate atomic words with values -(def atomic-words {::token/nil nil - ::token/true true - ::token/false false}) - -(defn parse-atomic-word [parser] - (let [token (current parser)] - (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/atom - :token token - :value (get atomic-words (::token/type token))})))) - -(defn- parse-datatype [parser] - (let [token (current parser)] - (-> parser (advance) - (assoc ::ast {::ast/type ::ast/datatype - :token token - :value (::token/literal token)})))) - -(defn- add-member [members member] - (if (nil? member) - members - (conj members member))) - -(defn- contains-placeholder? [members] - (< 0 (count (filter #(= ::ast/placeholder (::ast/type %1)) members)))) - -(defn unary-placeholder? [tuple] - (and (:partial tuple) (= (:length tuple) 1))) - -(defn- parse-fn-tuple [origin] - (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rparen (let [ms (add-member members current_member) - ast {::ast/type ::ast/tuple - :length (count ms) - :members ms - :token (current origin) - :partial (contains-placeholder? ms)}] - (if (unary-placeholder? ast) - (panic parser "You may not use a placeholder in a tuple of length 1. You may only partially apply functions that take more than one argument.") - (assoc (advance parser) ::ast ast))) - - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) - - (::token/rbrace ::token/rbracket) - (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) - - ::token/placeholder - (if (contains-placeholder? members) - (recur - (advance parser) - members - (panic parser "Partially applied functions must be unary. (Only one placeholder allowed in partial application.)" curr)) - (recur - (advance parser) members {::ast/type ::ast/placeholder :token curr})) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) - - (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rparen})] - (recur parsed members (::ast parsed))))))) - -(defn- parse-tuple [origin] - (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rparen (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/tuple - :token (current origin) - :length (count ms) - :members ms})) - - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) - - (::token/rbrace ::token/rbracket) - (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) - - ::token/placeholder - (recur - (advance parser) - members - (panic parser "Placeholders in tuples may only be in function calls." curr)) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) - - (if current_member - (panic parser "Comma expected between tuple members") - (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rparen})] - (recur parsed members (::ast parsed)))))))) - -(defn- parse-list [origin] - (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbracket (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/list - :token (current origin) - :members ms})) - - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) - - (::token/rbrace ::token/rparen) - (panic parser (str "Mismatched enclosure in list: " (::token/lexeme curr))) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated list" ::token/eof) - - ::token/splat - (let [splatted (parse-expr (advance parser)) - splat-type (node-type splatted)] - (if (contains? #{::ast/word ::ast/synthetic} splat-type) - (recur splatted members {::ast/type ::ast/splat - :token curr :expr (::ast splatted)}) - (panic parser "You may only splat words and synthetic expressions"))) - - (if current_member - (panic parser "Comma expected between list members") - (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbracket})] - (recur parsed members (::ast parsed)))))))) - -(defn- parse-set [origin] - (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbrace (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/set - :token (current origin) - :members ms})) - - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) - - (::token/rbracket ::token/rparen) - (panic parser (str "Mismatched enclosure in set: " (::token/lexeme curr))) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated set" ::token/eof) - - ::token/splat - (let [splatted (parse-expr (advance parser)) - splat-type (node-type splatted)] - (if (contains? #{::ast/word ::ast/synthetic} splat-type) - (recur splatted members {::ast/type ::ast/splat - :token curr :expr (::ast splatted)}) - (panic parser "You may only splat words and synthetic expressions"))) - - (if current_member - (panic parser "Comma expected between set members") - (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbrace})] - (recur parsed members (::ast parsed)))))))) - -(defn- parse-dict [origin] - (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbrace (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/dict - :token (current origin) - :members ms})) - - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) - - (::token/rbracket ::token/rparen) - (panic parser (str "Mismatched enclosure in dict: " (::token/lexeme curr))) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated dict" ::token/eof) - - ::token/word - (if (not current_member) - (let [parsed (parse-word parser) - word (get-in parsed [::ast :word])] - (recur parsed members [(keyword word) (::ast parsed)])) - (panic parser "Dict entries must be single words or keyword+expression pairs." #{::token/rbrace})) - - ::token/keyword - (if (not current_member) - (let [kw (parse-atom parser) - expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})] - (recur expr members [(:value (::ast kw)) (::ast expr)])) - (panic parser "Dict entries must be single words or keyword+expression pairs." #{::token/rbrace})) - - ::token/splat - (let [splatted (parse-expr (advance parser)) - splat-type (node-type splatted)] - (if (contains? #{::ast/word ::ast/synthetic} splat-type) - (recur splatted members {::ast/type ::ast/splat - :token curr :expr (::ast splatted)}) - (panic parser "You may only splat words and synthetic expressions"))) - - (panic parser "Dict entries must be single words or keyword+expression pairs" #{::token/rbrace}))))) - -(defn- parse-struct [origin] - (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members {} - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbrace (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/struct - :token (current origin) - :members ms})) - - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) - - (::token/rbracket ::token/rparen) - (panic parser (str "Mismatched enclosure in struct: " (::token/lexeme curr))) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated struct" ::token/eof) - - ::token/word - (if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] - (recur parsed members {(keyword word) (::ast parsed)})) - (panic parser "Struct entries must be single words or keyword+expression pairs." #{::token/rbrace})) - - ::token/keyword - (if (not current_member) (let [kw (parse-atom parser) expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})] - (recur expr members {(:value (::ast kw)) (::ast expr)})) - (panic parser "Struct entries must be single words or keyword+expression pairs." #{::token/rbrace})) - - (panic parser "Struct entries must be single words or keyword+expression pairs" #{::token/rbrace}))))) - -(defn- parse-ns [ns-root] - (let [name (expect* #{::token/word} "Expected ns name" (advance ns-root)) - origin (expect* #{::token/lbrace} "Expected { after ns name" (:parser name))] - (cond - (not (:success name)) (panic parser "Expected ns name" #{::token/newline}) - - (not (:success origin)) (panic (:parser name) "Expected { after ns name") - - :else - (loop [parser (accept-many #{::token/newline ::token/comma} (:parser origin)) - members {} - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbrace (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/ns - :token (current ns-root) - :name (get-in (parse-word (advance ns-root)) [::ast :word]) - :members ms})) - - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) - - (::token/rbracket ::token/rparen) - (panic parser (str "Mismatched enclosure in ns: " (::token/lexeme curr))) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated ns" ::token/eof) - - ::token/word - (if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] - (recur parsed members {(keyword word) (::ast parsed)})) - (panic parser "ns entries must be single words or keyword+expression pairs." #{::token/rbrace})) - - ::token/keyword - (if (not current_member) (let [kw (parse-atom parser) expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})] - (recur expr members {(:value (::ast kw)) (::ast expr)})) - (panic parser "ns entries must be single words or keyword+expression pairs." #{::token/rbrace})) - - (panic parser "ns entries must be single words or keyword+expression pairs" #{::token/rbrace}))))))) - -(defn- parse-block [origin] - (loop [parser (accept-many #{::token/newline ::token/semicolon} (advance origin)) - exprs [] - current_expr nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbrace - (let [es (add-member exprs current_expr)] - (if (empty? es) - (advance (panic parser "Blocks must have at least one expression")) - (assoc (advance parser) ::ast {::ast/type ::ast/block - :token (current origin) - :exprs es}))) - - (::token/semicolon ::token/newline) - (recur - (accept-many #{::token/newline ::token/semicolon} parser) - (add-member exprs current_expr) nil) - - (::token/rbracket ::token/rparen) - (panic parser (str "Mismatched enclosure in block: " (::token/lexeme curr))) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated block" ::token/eof) - - (let [parsed - (if current_expr - (panic parser "Expected end of expression" #{::token/semicolon ::token/newline}) - (parse-expr parser))] - (recur parsed exprs (::ast parsed))))))) - -(defn- parse-synthetic [parser] - (loop [parser parser - terms []] - (let [curr (current parser) - type (::token/type curr)] - (case type - ::token/keyword - (recur (advance parser) (conj terms (::ast (parse-atom parser)))) - - ::token/word - (recur (advance parser) (conj terms (::ast (parse-word parser)))) - - ::token/lparen - (let [parsed (parse-fn-tuple parser)] - (recur parsed (conj terms (::ast parsed)))) - - (assoc parser ::ast {::ast/type ::ast/synthetic :token (current parser) :terms terms}))))) - -(defn- parse-word [parser] - (let [curr (current parser)] - (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/word :token (current parser) :word (::token/lexeme curr)})))) - -(def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow})) - -(defn- parse-list-tuple-splat-pattern [origin] - (let [splatted (advance origin)] - (case (token-type splatted) - ::token/word - (assoc (advance splatted) ::ast - {::ast/type ::ast/splat - :token (current origin) - :into (::ast (parse-word splatted))}) - - ::token/placeholder - (assoc (advance splatted) ::ast - {::ast/type ::ast/splat - :token (current origin) - :into {::ast/type ::ast/placeholder :token (current splatted)}}) - - (::token/comma ::token/newline ::token/rbrace ::token/rparen ::token/rbracket) - (assoc splatted ::ast - {::ast/type ::ast/splat - :token (current origin) - :into {::ast/type ::ast/placeholder :token (current origin)}}) - - (panic origin "Splat patterns may only splat into words or placeholders.")))) - -(defn- parse-list-pattern [origin] - (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbracket - (let [ms (add-member members current_member)] - (if (not-any? #(= (::ast/type %) ::ast/splat) (drop-last ms)) - (assoc (advance parser) ::ast - {::ast/type ::ast/list - :token (current origin) - :length (count ms) - :members ms}) - (panic parser "A splat my only appear once in a list pattern, at the end of the pattern."))) - - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) - - (::token/rbrace ::token/rparen) - (panic parser (str "Mismatched enclosure in list pattern: " (::token/lexeme curr))) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated list pattern" ::token/eof) - - ::token/splat - (let [splatted (parse-list-tuple-splat-pattern parser)] - (recur splatted members (::ast splatted))) - - (let [parsed (parse-pattern parser)] - (recur parsed members (::ast parsed))))))) - -(defn- parse-dict-pattern [origin] - (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members {} - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbrace - (let [current-key (first (keys current_member))] - (if (current-key members) - (panic parser (str "Dict patterns may not duplicate keys: " current-key)) - (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/dict - :token (current origin) - :members ms})))) - - (::token/comma ::token/newline) - (let [current-key (first (keys current_member))] - (if (current-key members) - (panic parser (str "Dict patterns may not duplicate keys: " current-key)) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil))) - - (::token/rbracket ::token/rparen) - (panic parser (str "Mismatched enclosure in dict pattern: " (::token/lexeme curr))) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated dict pattern" ::token/eof) - - ::token/splat - (cond - current_member - (panic parser "Unexpected splat after keyword in dict pattern.") - - (::ast/splat members) - (panic parser "Dict patterns may only have one splat.") - - (not= ::token/word (::token/type (current (advance parser)))) - (panic parser "Splats in dicts may only splat into words.") - - :else - (let [splatted (parse-word (advance parser))] - (recur splatted members {::ast/splat (::ast splatted)}))) - - ::token/word - (if (not current_member) - (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] - (recur parsed members {(keyword word) (::ast parsed)})) - (panic parser "Dict patterns may only include single words or keyword+pattern pairs." #{::token/rbrace})) - - ::token/keyword - (if (not current_member) - (let [kw (parse-atom parser) pattern (parse-pattern kw)] - (recur pattern members {(:value (::ast kw)) (::ast pattern)})) - (panic parser "Dict patterns may only include single words or keyword+pattern pairs." #{::token/rbrace})) - - (panic parser "Dict patterns may only include single words or keyword+pattern pairs" #{::token/rbrace}))))) - -(defn- parse-struct-pattern [origin] - (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members {} - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbrace (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/struct - :token (current origin) - :members ms})) - - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) - - (::token/rbracket ::token/rparen) - (panic parser (str "Mismatched enclosure in struct pattern: " (::token/lexeme curr))) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated struct pattern" ::token/eof) - - ::token/splat - (cond - current_member - (panic parser "Unexpected splat after keyword in struct pattern.") - - (::ast/splat members) - (panic parser "Struct patterns may only have one splat.") - - (not= ::token/word (::token/type (current (advance parser)))) - (panic parser "Splats in structs may only splat into words.") - - :else - (let [splatted (parse-word (advance parser))] - (recur splatted members {::ast/splat (::ast splatted)}))) - - ::token/word - (if (not current_member) - (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] - (recur parsed members {(keyword word) (::ast parsed)})) - (panic parser "Struct patterns may only include single words or keyword+pattern pairs." #{::token/rbrace})) - - ::token/keyword - (if (not current_member) - (let [kw (parse-atom parser) pattern (parse-pattern kw)] - (recur pattern members {(:value (::ast kw)) (::ast pattern)})) - (panic parser "Struct patterns may only include single words or keyword+pattern pairs." #{::token/rbrace})) - - (panic parser "Struct patterns may only include single words or keyword+pattern pairs." #{::token/rbrace}))))) - -(defn- parse-tuple-pattern [origin] - (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rparen - (let [ms (add-member members current_member)] - (if (not-any? #(= (::ast/type %) ::ast/splat) (drop-last ms)) - (assoc (advance parser) ::ast - {::ast/type ::ast/tuple - :token (current origin) - :length (count ms) - :members ms}) - (panic parser "A splat my only appear once in a tuple pattern, at the end of the pattern."))) - - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) - - (::token/rbrace ::token/rbracket) - (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) - - ::token/splat - (let [splatted (parse-list-tuple-splat-pattern parser)] - (recur splatted members (::ast splatted))) - - (let [parsed (parse-pattern parser)] - (recur parsed members (::ast parsed))))))) - -(defn- parse-pattern [parser] - (let [curr (current parser) - type (::token/type curr)] - (case type - (::token/placeholder ::token/ignored) - (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/placeholder :token curr})) - - ::token/word (parse-word parser) - - (::token/number ::token/string ::token/keyword ::token/nil) (parse-atom parser) - - ::token/lparen (parse-tuple-pattern parser) - - ::token/lbracket (parse-list-pattern parser) - - ::token/startdict (parse-dict-pattern parser) - - ::token/startstruct (parse-struct-pattern parser) - - ::token/error - (panic parser (:message (current parser)) sync-pattern) - - (panic parser "Expected pattern" sync-pattern)))) - -(defn- parse-let-expr [parser pattern] - (let [expr (parse-expr parser)] - (assoc expr ::ast {::ast/type ::ast/let - :token (current parser) - :pattern (::ast pattern) :expr (::ast expr)}))) - -(defn- parse-assignment [parser] - (let [assignment (expect* ::token/equals "Expected assignment" parser) - success (:success assignment)] - (if success - (parse-let-expr (:parser assignment) parser) - (panic parser "Expected assignment")))) - -(defn- parse-let [parser] - (let [pattern (parse-pattern (advance parser))] - (parse-assignment pattern))) - -(defn- parse-ref-expr [parser name] - (let [expr (parse-expr parser)] - (assoc expr ::ast {::ast/type ::ast/ref - :token (current parser) - :name name :expr (::ast expr)}))) - -(defn- parse-ref-assignment [parser name] - (let [assignment (expect* ::token/equals "Expected assignment" (advance parser)) - success (:success assignment)] - (if success - (parse-ref-expr (:parser assignment) name) - (panic parser "Expected assignment")))) - -(defn- parse-ref [parser] - (let [name (advance parser)] - (if (= ::token/word (token-type name)) - (parse-ref-assignment name (::token/lexeme (current name))) - (panic parser "Expected reference name")))) - -(defn- parse-else [parser] - (let [ast (::ast parser) - else-kw (expect* ::token/else "Expected else clause after then" parser) - success (:success else-kw) - else-kw-parser (:parser else-kw)] - (if success - (let [expr (parse-expr else-kw-parser) - else-expr (::ast expr)] - (assoc expr ::ast (assoc ast :else else-expr))) - else-kw-parser))) - -(defn- parse-then [parser] - (let [ast (::ast parser) - then-kw (expect* ::token/then "Expected then clause after if" parser) - success (:success then-kw) - then-kw-parser (:parser then-kw)] - (if success - (let [expr (parse-expr then-kw-parser (conj sync-on ::token/else)) - then-expr (::ast expr)] - (parse-else (accept ::token/newline (assoc expr ::ast (assoc ast :then then-expr))))) - then-kw-parser))) - -(defn- parse-if [parser] - (let [if-expr (parse-expr (advance parser) #{::token/newline ::token/then}) - ast (assoc if-expr ::ast {::ast/type ::ast/if :token (current parser) :if (::ast if-expr)})] - (parse-then (accept ::token/newline ast)))) - -(defn- parse-match-clause [parser] - (let [pattern (if (= ::token/else (token-type parser)) - (-> parser (advance) (assoc ::ast {::ast/type ::ast/placeholder :token (current parser)})) - (parse-pattern parser)) - rarrow (expect* #{::token/rarrow} "Expected arrow after pattern" pattern)] - (if (:success rarrow) - (let [body (parse-expr (:parser rarrow))] - (assoc body ::ast {::ast/type ::ast/clause - :token (current parser) - :pattern (::ast pattern) :body (::ast body)})) - (panic pattern "Expected -> in match clause. Clauses must be in the form pattern -> expression" #{::token/newline ::token/rbrace})))) - -(defn- parse-match-clauses [parser] - (loop [parser (accept-many #{::token/newline} (advance parser)) - clauses []] - (let [curr (current parser)] - (case (::token/type curr) - ::token/rbrace - (if (< 0 (count clauses)) - (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses}) - (panic parser "Expected one or more clauses" #{::rbrace})) - - ::token/newline - (recur (accept-many #{::token/newline} parser) clauses) - - (let [clause (parse-match-clause parser)] - (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) - -(defn- parse-match [parser] - (let [match-expr (parse-expr (advance parser) #{::token/with}) - match-header (expect* #{::token/with} "Expected with" match-expr)] - (if (:success match-header) - (let [clauses (:parser match-header)] - (if (= (token-type clauses) ::token/lbrace) - ;; match expression with one or many clauses in braces - (let [clauses (parse-match-clauses clauses)] - (assoc clauses ::ast {::ast/type ::ast/match - :token (current parser) - :expr (::ast match-expr) - :clauses (get-in clauses [::ast :clauses])})) - ;; match expression with single match clause - (let [clause (parse-match-clause clauses)] - (assoc clause ::ast {::ast/type ::ast/match - :token (current parser) - :expr (::ast match-expr) - :clauses [(::ast clause)]})))) - - (panic parser "Expected with after match expression")))) - -(defn- parse-loop-clause [parser] - (if (not (= ::token/lparen (token-type parser))) - (panic parser "Loop clauses must begin with tuple patterns") - (let [pattern (parse-tuple-pattern parser) - arrow (expect* #{::token/rarrow} "Expected arrow" pattern) - body (parse-expr (:parser arrow))] - (if (:success arrow) - (assoc body ::ast {::ast/type ::ast/clause - :token (current parser) - :pattern (::ast pattern) :body (::ast body)}) - (panic pattern "Expected -> in loop clause. Clauses must be in the form of (pattern) -> expression"))))) - -(defn- parse-loop-clauses [parser] - (loop [parser (accept-many #{::token/newline} (advance parser)) - clauses []] - (let [curr (current parser)] - (case (::token/type curr) - ::token/rbrace - (if (< 0 (count clauses)) - (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses}) - (panic parser "Expected one or more loop clauses" #{::token/rbrace})) - - ::token/newline - (recur (accept-many #{::token/newline} parser) clauses) - - (let [clause (parse-loop-clause parser)] - (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) - -(defn- parse-loop [parser] - (let [next (advance parser)] - (if (= ::token/lparen (token-type next)) - (let [loop-tup (parse-tuple next) - loop-header (expect* #{::token/with} "Expected with" loop-tup)] - (if (:success loop-header) - (let [clauses (:parser loop-header)] - (if (= (token-type clauses) ::token/lbrace) - ;; loop expression with one or many clauses in braces - (let [clauses (parse-loop-clauses clauses)] - (assoc clauses ::ast {::ast/type ::ast/loop - :token (current parser) - :expr (::ast loop-tup) - :clauses (get-in clauses [::ast :clauses])})) - ;; loop expression with single match clause - (let [clause (parse-loop-clause clauses)] - (assoc clause ::ast {::ast/type ::ast/loop - :token (current parser) - :expr (::ast loop-tup) - :clauses [(::ast clause)]})))) - - (panic parser "Expected with after loop expression"))) - (panic parser "Expected tuple as loop expression")))) - -(defn- parse-recur [parser] - (let [next (advance parser)] - (if (= ::token/lparen (token-type next)) - (let [tuple (parse-tuple next)] - (assoc tuple ::ast {::ast/type ::ast/recur - :token (current parser) - :tuple (::ast tuple)})) - (panic parser "Expected tuple after recur")))) - -(defn- parse-cond-clause [parser] - (let [expr (if - (contains? #{::token/else ::token/placeholder} (token-type parser)) - (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/atom - :token (current parser) - :value true})) - (parse-expr parser)) - rarrow (expect* #{::token/rarrow} "Expected arrow after expression in cond clause" expr)] - (if (:success rarrow) - (let [body (parse-expr (:parser rarrow))] - (assoc body ::ast {::ast/type ::ast/clause - :token (current parser) - :test (::ast expr) :body (::ast body)})) - (panic expr "Expected -> in cond clause. Clauses must be in the form test_expression -> result_expression" #{::token/newline ::token/rbrace})))) - -(defn- parse-cond-clauses [parser] - (loop [parser (accept-many #{::token/newline} parser) - clauses []] - (let [curr (current parser)] - (case (::token/type curr) - ::token/rbrace - (if (< 0 (count clauses)) - (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses}) - (panic parser "Expected one or more clauses" #{::rbrace})) - - ::token/newline - (recur (accept-many #{::token/newline} parser) clauses) - - (let [clause (parse-cond-clause parser)] - (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) - -(defn- parse-cond [parser] - (let [header - (expect* #{::token/lbrace} "Expected { after cond" (advance parser))] - (if (:success header) - (let [clauses (parse-cond-clauses (:parser header))] - (assoc clauses ::ast {::ast/type ::ast/cond - :token (current parser) - :clauses (get-in clauses [::ast :clauses])})) - (panic parser "Expected { after cond")))) - -(defn- parse-fn-clause [parser] - (if (not (= ::token/lparen (token-type parser))) - (panic parser "Function clauses must begin with tuple patterns") - (let [pattern (parse-tuple-pattern parser) - arrow (expect* #{::token/rarrow} "Expected arrow" pattern) - body (parse-expr (:parser arrow))] - (if (:success arrow) - (assoc body ::ast {::ast/type ::ast/clause - :token (current parser) - :pattern (::ast pattern) :body (::ast body)}) - (panic pattern "Expected -> in function clause. Clauses must be in the form of (pattern) -> expression"))))) - -(defn- parse-fn-clauses [parser] - (loop [parser (accept-many #{::token/newline} (advance parser)) - clauses []] - (let [curr (current parser)] - (case (::token/type curr) - ::token/rbrace - (if (< 0 (count clauses)) - (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses}) - (panic parser "Expected one or more function clauses" #{::token/rbrace})) - - ::token/newline - (recur (accept-many #{::token/newline} parser) clauses) - - (let [clause (parse-fn-clause parser)] - (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) - -(defn- parse-named-fn [parser] - (let [name (parse-word parser)] - (case (token-type name) - ::token/lparen - (let [clause (parse-fn-clause name)] - (assoc clause ::ast {::ast/type ::ast/fn - :token (current parser) - :name (get-in name [::ast :word]) - :clauses [(::ast clause)]})) - - ::token/lbrace - (let [clauses (parse-fn-clauses name)] - (assoc clauses ::ast {::ast/type ::ast/fn - :token (current parser) - :name (get-in name [::ast :word]) - :clauses (get-in clauses [::ast :clauses])})) - - (panic name "Expected one or more function clauses")))) - -(defn- parse-fn [parser] - (let [first (advance parser)] - (case (::token/type (current first)) - ::token/lparen - (let [clause (parse-fn-clause first)] - (assoc clause ::ast {::ast/type ::ast/fn - :name ::ast/anon - :token (current parser) - :clauses [(::ast clause)]})) - - ::token/word (parse-named-fn first) - - (panic parser "Expected name or clause after fn")))) - -(defn- parse-do [parser] - (let [first (advance parser)] - (loop [parser first - exprs []] - (let [expr (parse-expr parser) - expr+newline (accept ::token/newline expr) - next (token-type expr+newline)] - (if (= ::token/pipeline next) - (recur (advance expr+newline) (conj exprs (::ast expr))) - (assoc expr ::ast {::ast/type ::ast/pipeline - :token (current parser) - :exprs (conj exprs (::ast expr))})))))) - -(defn- parse-import [parser] - (let [path (parse-atom (advance parser)) - as (expect* #{::token/as} "Expected as after path" path) - named? (if (:success as) - (expect* #{::token/word} "Expected name binding after as" (:parser as)) - nil) - name (if (:success named?) - (parse-word (:parser as)) - nil)] - (cond - (not= ::token/string (token-type (advance parser))) - (panic parser "Expected path after import" #{::token/newline}) - - (not (:success as)) - (panic parser "Expected as after path" #{::token/newline}) - - (not (:success named?)) - (panic parser "Expected name binding after as") - - :else - (assoc name ::ast {::ast/type ::ast/import - :token (current parser) - :path (get-in path [::ast :value]) - :name (get-in name [::ast :word])})))) - -(defn- parse-panic [parser] - (let [expr (parse-expr (advance parser))] - (assoc expr ::ast {::ast/type ::ast/panic - :token (current parser) :expr (::ast expr)}))) - -(defn- parse-spawn [parser] - (let [expr (parse-expr (advance parser))] - (assoc expr ::ast {::ast/type ::ast/spawn :expr (::ast expr) :token (current parser)}))) - -(defn- parse-send [parser] - (let [msg (parse-expr (advance parser)) - to (expect* ::token/to "Expected `to` between message and PID" msg)] - (if (:success to) - (let [pid (parse-expr (:parser to))] - (assoc pid ::ast {::ast/type ::ast/send :token (current parser) :msg (::ast msg) :pid (::ast pid)})) - (panic parser "Expected PID after `to` in send expression")))) - -(defn- parse-receive [parser] - (let [header - (expect* #{::token/lbrace} "Expected { after receive" (advance parser))] - (if (:success header) - (let [clauses (parse-match-clauses (advance parser))] - (assoc clauses ::ast {::ast/type ::ast/receive - :token (current parser) - :clauses (get-in clauses [::ast :clauses])})) - (panic parser "Expected { after receive")))) - -(defn- parse-data-constr [parser] - (if (= (token-type parser) ::token/datatype) - (let [dt-ast (parse-datatype parser) - after-dt (token-type dt-ast)] - (case after-dt - ::token/newline (assoc dt-ast ::ast {::ast/type ::ast/datatype - :token (current parser) - :constructor-type :nullary}) - ::token/lparen - (let [pattern (parse-tuple-pattern (advance dt-ast))] - (assoc pattern ::ast {::ast/type ::ast/datatype - :token (current parser) - :constructor-type :tuple - :pattern (::ast pattern)})) - - ::token/lbrace - (let [pattern (parse-struct-pattern (advance dt-ast))] - (assoc pattern ::ast {::ast/type ::ast/datatype - :token (current parser) - :constructor-type :struct - :pattern (::ast pattern)})) - - (panic dt-ast (str "Unexpected " (get-in dt-ast [::token :lexeme]) " after datatype declaration.")))) - (panic parser "Expected datatype constructor."))) - -;; XXX: write the enum parser, model it after a script or a match -;; note that the current token here should be an lbrace -(defn- parse-enum [parser]) - -(defn- parse-data-decl [parser] - (let [dt (advance parser)] - (if (= (token-type dt) ::token/datatype) - (let [dt-ast (parse-datatype dt) - after-dt (token-type dt-ast)] - (case after-dt - ::token/newline (assoc dt-ast ::ast {::ast/type ::ast/datatype - :token (current parser) - :constructor-type :nullary}) - ::token/lparen - (let [pattern (parse-tuple-pattern (advance dt-ast))] - (assoc pattern ::ast {::ast/type ::ast/datatype - :token (current parser) - :constructor-type :tuple - :pattern (::ast pattern)})) - - ::token/lbrace - (let [pattern (parse-struct-pattern (advance dt-ast))] - (assoc pattern ::ast {::ast/type ::ast/datatype - :token (current parser) - :constructor-type :struct - :pattern (::ast pattern)})) - - ::token/with - (parse-enum (advance dt-ast)) - - (panic dt-ast (str "Unexpected " (get-in dt-ast [::token :lexeme]) " after datatype declaration.")))) - (panic dt "Expected datatype name after data reserved word.")))) - -(defn- parse-toplevel [parser] - (case (token-type parser) - ::token/ns (parse-ns parser) - - ::token/import (parse-import parser) - - ::token/data (parse-data-decl parser) - - (parse-expr parser))) - -(defn parse-script [origin] - (loop [parser (accept-many #{::token/newline ::token/semicolon} origin) - exprs [] - current_expr nil] - (case (token-type parser) - ::token/eof - (let [es (add-member exprs current_expr)] - (if (empty? es) - (panic parser "Scripts must have at least one expression") - (assoc parser ::ast {::ast/type ::ast/script - :token (current origin) :exprs es}))) - - (::token/semicolon ::token/newline) - (recur - (accept-many #{::token/semicolon ::token/newline} parser) - (add-member exprs current_expr) - nil) - - (let [parsed - (if current_expr - (panic parser "Expected end of expression" #{::token/semicolon ::token/newline}) - (parse-toplevel parser))] - - (recur parsed exprs (::ast parsed)))))) - -(defn- parse-expr - ([parser] (parse-expr parser sync-on)) - ([parser sync-on] - (let [token (current parser)] - (case (::token/type token) - - (::token/number ::token/string) - (parse-atom parser) - - ::token/keyword - (let [next (ppeek parser) - type (::token/type next)] - (if (= type ::token/lparen) - (parse-synthetic parser) - (parse-atom parser))) - - ::token/word - (let [next (ppeek parser) - type (::token/type next)] - (case type - (::token/lparen ::token/keyword) (parse-synthetic parser) - (parse-word parser))) - - ::token/datatype - (parse-datatype parser) - - (::token/nil ::token/true ::token/false) - (parse-atomic-word parser) - - (::token/self) - (assoc (advance parser) ::ast {::ast/type ::ast/self :token token}) - - ::token/lparen (parse-tuple parser) - - ::token/lbracket (parse-list parser) - - ::token/startset (parse-set parser) - - ::token/startdict (parse-dict parser) - - ::token/startstruct (parse-struct parser) - - ::token/lbrace (parse-block parser) - - ::token/let (parse-let parser) - - ::token/if (parse-if parser) - - ::token/match (parse-match parser) - - ::token/fn (parse-fn parser) - - ::token/do (parse-do parser) - - ::token/cond (parse-cond parser) - - ::token/ref (parse-ref parser) - - ::token/loop (parse-loop parser) - - ::token/recur (parse-recur parser) - - ::token/panic (parse-panic parser) - - ::token/spawn (parse-spawn parser) - - ::token/send (parse-send parser) - - ::token/receive (parse-receive parser) - - ;; TODO: improve handling of comments? - ;; Scanner now just skips comments - ;; ::token/comment (advance parser) - - ::token/error (panic parser (:message token) sync-on) - - (::token/rparen ::token/rbrace ::token/rbracket) - (panic parser (str "Unbalanced enclosure: " (::token/lexeme token))) - - (::token/semicolon ::token/comma) - (panic parser (str "Unexpected delimiter: " (::token/lexeme token))) - - (panic parser "Expected expression" sync-on))))) - -(defn parse [lexed] - (-> lexed - (:tokens) - (parser) - (parse-script))) - - -(comment - (do - (def my-source " -data Foo {foo, bar} -data Bar as { - Bar - Baz -} - -") - - (::ast (parse (scanner/scan my-source))))) - -(comment " - Further thoughts/still to do: - * Functions docstrings - * Cond expressions - * Loops - * Structs - * Namespaces - * Types (:|) - * Modules - * Add `as` clauses to patterns - * Add `when` clauses to patterns - * var/mut - * ref/swap - * Splats in lists, hashmaps, sets - * AST nodes should include tokens/locations - - at current, only atoms do this - * Improve error handling in hashmap parsing - * Consider error handling in match expressions - * Add treatment of ignored variables - * Placeholders - * How much in parser, how much in analysis? - - Some architectural changes: - * UGH, this code is just kind of a mess and hard to reason about - * Especially sequential forms - * Parsers are hard - * One idea: - * Refactor everything so that it returns a success or failure - * Because this is all stateless, in sequential forms, you can just do all the things - * This lets you do one let (with everything building up) and then a cond with bespoke errors/panics - * This also still lets you encapsulate parsererrors with poisoned nodes - - ") - - - - - - diff --git a/src/ludus/parser_new.clj b/src/ludus/parser.cljc similarity index 96% rename from src/ludus/parser_new.clj rename to src/ludus/parser.cljc index 62eb781..ec1eb3e 100644 --- a/src/ludus/parser_new.clj +++ b/src/ludus/parser.cljc @@ -1,4 +1,4 @@ -(ns ludus.parser-new) +(ns ludus.parser) (defn ? [val default] (if (nil? val) default val)) @@ -48,7 +48,7 @@ (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")))] + :else (throw (ex-info "`apply-parser` requires a parser" {})))] ;(println "Parser result " (? (:name parser) parser) (:status result)) result )) @@ -314,21 +314,3 @@ (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)) diff --git a/src/ludus/prelude.clj b/src/ludus/prelude.cljc similarity index 100% rename from src/ludus/prelude.clj rename to src/ludus/prelude.cljc diff --git a/src/ludus/process.clj b/src/ludus/process.clj deleted file mode 100644 index 30926f0..0000000 --- a/src/ludus/process.clj +++ /dev/null @@ -1,96 +0,0 @@ -(ns ludus.process - (:require - [ludus.data :as data]) - (:import (java.util.concurrent Executors))) - -;; virtual thread patch from https://ales.rocks/notes-on-virtual-threads-and-clojure -(defn- thread-factory [name] - (-> (Thread/ofVirtual) - (.name name 0) - (.factory))) - -(set-agent-send-off-executor! - (Executors/newThreadPerTaskExecutor - (thread-factory "ludus-vthread-"))) - -(def processes (atom {})) - -(def current-pid (atom 1001)) - -(defn new-process [] - (let [pid @current-pid - process (atom {:pid pid - :queue clojure.lang.PersistentQueue/EMPTY - :inbox nil - :status :occupied - })] - (swap! processes #(assoc % pid process)) - (swap! current-pid inc) - process)) - -(def vm-state (atom :stopped)) - -(defn- values [m] (into [] (map (fn [[_ v]] v)) m)) - -(defn- map-values [m f] (into {} (map (fn [[k v]] [k (f v)])) m)) - -(defn process-msg [process] - ;;(println "processing message" self) - (let [q (:queue process) - inbox (:inbox process)] - (when (not (realized? inbox)) - ;;(println "delivering message in" self) - (deliver inbox (peek q)) - (assoc process :queue (pop q) :inbox nil)))) - -(defn run-process [process-atom] - (let [process @process-atom - status (:status process) - q (:queue process) - inbox (:inbox process)] - ;;(println "running process" self ":" (into [] q)) - (when (and (= status :idle) (not-empty q) inbox) - (swap! process-atom process-msg)))) - -(defn start-vm [] - ;; (println "Starting Ludus VM") - (when (= @vm-state :stopped) - (future - (reset! vm-state :running) - (loop [] - (when (= @vm-state :running) - (run! run-process (values @processes)) - (recur) - ;; (println "Ludus VM shutting down") - ))))) - -(defn stop-vm [] - (reset! vm-state :stopped) - (reset! processes {}) - (reset! current-pid 1001) - nil) - -(def process {"process" { - ::data/struct true - ::data/type ::data/ns - ::data/name "process" - - "list" {::data/type ::data/clj - :name "list" - :body (fn [] (into [] (keys @processes)))} - - "info" {::data/type ::data/clj - :name "info" - :body (fn [pid] - (let [process @(get @processes pid) - queue (into [] (:queue process))] - (assoc process :queue queue ::data/dict true)))} - - "flush" {::data/type ::data/clj - :name "flush" - :body (fn [pid] - (let [process (get @processes pid) - queue (into [] (:queue @process))] - (swap! process #(assoc % :queue clojure.lang.PersistentQueue/EMPTY)) - queue))} - }}) \ No newline at end of file diff --git a/src/ludus/repl.clj b/src/ludus/repl.clj deleted file mode 100644 index 6455f48..0000000 --- a/src/ludus/repl.clj +++ /dev/null @@ -1,124 +0,0 @@ -(ns ludus.repl - (:require - [ludus.scanner :as scanner] - ;[ludus.parser :as parser] - [ludus.parser-new :as p] - [ludus.grammar :as g] - [ludus.interpreter :as interpreter] - [ludus.prelude :as prelude] - [ludus.show :as show] - [ludus.data :as data] - ;[ludus.process :as process] - )) - -(declare repl-prelude new-session) - -(def sessions (atom {})) - -(def current-session (atom nil)) - -(def prompt "=> ") - -(defn- exit [] - (println "\nGoodbye!") - (System/exit 0)) - -(def base-ctx (merge prelude/prelude ;process/process - {::repl true - "repl" - {::data/struct true - ::data/type ::data/ns - ::data/name "repl" - - :flush - {:name "flush" - ::data/type ::data/clj - :body (fn - ([] - (let [session @current-session] - (swap! session #(assoc % :ctx (volatile! base-ctx))) - :ok)) - ([name] - (if-let [session (get @sessions name)] - (do - (swap! session #(assoc % :ctx (volatile! base-ctx))) - :ok) - (do - (println "No session named" name) - :error))))} - - :new - {:name "new" - ::data/type ::data/clj - :body (fn [name] - (let [session (new-session name)] - (reset! current-session session) - :ok))} - - :switch - {:name "switch" - ::data/type ::data/clj - :body (fn [name] - (if-let [session (get @sessions name)] - (do - (reset! current-session session) - :ok) - (do - (println "No session named" name) - :error)))} - - :quit - {:name "quit" - ::data/type ::data/clj - :body (fn [] (exit))} - }})) - -(defn- new-session [name] - (let [session (atom {:name name - :ctx (volatile! base-ctx) - :history []})] - (swap! sessions #(assoc % name session)) - session)) - -(defn repl-loop [] - (let [session-atom @current-session - session @session-atom - orig-ctx (:ctx session) - pid (:pid session)] - (print (str (:name session) prompt)) - (flush) - (let [input (read-line)] - (cond - (= nil input) (exit) - - (= "" input) (recur) - - :else - (let [parsed (->> input - (scanner/scan) - :tokens - (p/apply-parser g/script))] - (if (= :err (:status parsed)) - (do - (println (p/err-msg parsed)) - (recur)) - (let [{result :result ctx :ctx pid- :pid} - (if pid - (interpreter/interpret-repl parsed orig-ctx pid) - (interpreter/interpret-repl parsed orig-ctx))] - (if (= result :error) - (recur) - (do - (println (show/show result)) - (when (not (= @ctx @orig-ctx)) - (swap! session-atom #(assoc % :ctx ctx))) - (when (not (= pid pid-)) - (swap! session-atom #(assoc % :pid pid-))) - (recur)))))))))) - -(defn launch [] - (println "Welcome to Ludus (v. 0.1.0-alpha)") - (let [session (new-session :ludus)] - (reset! current-session session) - (repl-loop))) - diff --git a/src/ludus/scanner.clj b/src/ludus/scanner.cljc similarity index 99% rename from src/ludus/scanner.clj rename to src/ludus/scanner.cljc index bc2ac78..4c79bb4 100644 --- a/src/ludus/scanner.clj +++ b/src/ludus/scanner.cljc @@ -181,7 +181,7 @@ interpolate? false] (let [char (current-char scanner)] (case char - \{ (recur (update (advance scanner)) (str string char) true) + \{ (recur (advance scanner) (str string char) true) ; allow multiline strings \newline (recur (update (advance scanner) :line inc) (str string char) interpolate?) \" (if interpolate? diff --git a/src/ludus/show.clj b/src/ludus/show.cljc similarity index 100% rename from src/ludus/show.clj rename to src/ludus/show.cljc diff --git a/src/ludus/token.clj b/src/ludus/token.cljc similarity index 100% rename from src/ludus/token.clj rename to src/ludus/token.cljc