From 173f5756a743e06ac2decf2b4037a397d2ca8248 Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Fri, 27 May 2022 19:18:00 -0400 Subject: [PATCH] cljfmt --- src/ludus/core.clj | 16 +-- src/ludus/interpreter.clj | 169 ++++++++++------------ src/ludus/loader.clj | 14 +- src/ludus/parser.clj | 285 ++++++++++++++++++-------------------- src/ludus/prelude.clj | 53 ++++--- src/ludus/repl.clj | 97 +++++++------ src/ludus/scanner.clj | 46 +++--- src/ludus/show.clj | 24 ++-- src/ludus/token.clj | 10 +- 9 files changed, 338 insertions(+), 376 deletions(-) diff --git a/src/ludus/core.clj b/src/ludus/core.clj index 8384a0c..72f4bbe 100644 --- a/src/ludus/core.clj +++ b/src/ludus/core.clj @@ -1,13 +1,13 @@ (ns ludus.core "A tree-walk interpreter for the Ludus language." (:require - [ludus.scanner :as scanner] - [ludus.parser :as parser] - [ludus.interpreter :as interpreter] - [ludus.show :as show] - [clojure.pprint :as pp] - [ludus.loader :as loader] - [ludus.repl :as repl]) + [ludus.scanner :as scanner] + [ludus.parser :as parser] + [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] @@ -29,7 +29,7 @@ (defn -main [& args] (cond - (= (count args) 1) + (= (count args) 1) (let [file (first args) source (loader/load-import file)] (run file source)) diff --git a/src/ludus/interpreter.clj b/src/ludus/interpreter.clj index c0d3032..823b877 100644 --- a/src/ludus/interpreter.clj +++ b/src/ludus/interpreter.clj @@ -1,15 +1,15 @@ (ns ludus.interpreter (:require - [ludus.parser :as parser] - [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] - [clojure.pprint :as pp] - [clojure.set])) + [ludus.parser :as parser] + [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] + [clojure.pprint :as pp] + [clojure.set])) ;; right now this is not very efficient: ;; it's got runtime checking @@ -76,7 +76,7 @@ (not (::data/dict value)) {:success false :reason "Cannot match non-dict data types a dict pattern"} - :else + :else (let [members (:members pattern) kws (keys members)] (loop [i (dec (count kws)) ctx {}] @@ -87,10 +87,8 @@ (let [match? (match (kw members) (kw value) ctx-vol)] (if (:success match?) (recur (dec i) (merge ctx (:ctx match?))) - {:success false :reason (str "Could not match " pattern " with " value " at key " kw)} - )) - {:success false :reason (str "Could not match " pattern " with " value " at key " kw)} - ))))))) + {:success false :reason (str "Could not match " pattern " with " value " at key " kw)})) + {:success false :reason (str "Could not match " pattern " with " value " at key " kw)}))))))) (defn- match-struct [pattern value ctx-vol] (cond @@ -100,7 +98,7 @@ (not (::data/struct value)) {:success false :reason "Cannot match non-struct data types a struct pattern"} - :else + :else (let [members (:members pattern) kws (keys members)] (loop [i (dec (count kws)) ctx {}] @@ -111,10 +109,8 @@ (let [match? (match (kw members) (kw value) ctx-vol)] (if (:success match?) (recur (dec i) (merge ctx (:ctx match?))) - {:success false :reason (str "Could not match " pattern " with " value " at key " kw)} - )) - {:success false :reason (str "Could not match " pattern " with " value " at key " kw)} - ))))))) + {:success false :reason (str "Could not match " pattern " with " value " at key " kw)})) + {:success false :reason (str "Could not match " pattern " with " value " at key " kw)}))))))) (defn- match [pattern value ctx-vol] (let [ctx @ctx-vol] @@ -200,11 +196,7 @@ truthy? (boolean (interpret-ast test-expr ctx))] (if truthy? (interpret-ast body ctx) - (recur (first clauses) (rest clauses)) - ) - ) - ) - ))) + (recur (first clauses) (rest clauses)))))))) (defn- interpret-called-kw [kw tuple ctx] ;; TODO: check this statically @@ -218,25 +210,24 @@ (if (= (::data/type map) ::data/ns) (throw (ex-info (str "Namespace error: no member " kw " in ns " (::data/name map)) {:ast kw})) (throw (ex-info (str "Struct error: no member at " kw) {:ast kw})))) - (get map kw)) - ))) + (get map kw))))) (defn- call-fn [lfn tuple ctx] (cond (= ::data/partial (first tuple)) {::data/type ::data/clj :name (str (:name lfn) "{partial}") - :body (fn [arg] - (call-fn - lfn - (concat [::data/tuple] (replace {::data/placeholder arg} (rest tuple))) - ctx))} + :body (fn [arg] + (call-fn + lfn + (concat [::data/tuple] (replace {::data/placeholder arg} (rest tuple))) + ctx))} (= (::data/type lfn) ::data/clj) (apply (:body lfn) (next tuple)) (= (::data/type lfn) ::data/fn) (let [clauses (:clauses lfn) - closed-over (:ctx lfn)] + closed-over (:ctx lfn)] (loop [clause (first clauses) clauses (rest clauses)] (if clause @@ -262,9 +253,8 @@ (kw target) (if (= (::data/type target) ::data/ns) (throw (ex-info (str "Namespace error: no member " kw " in ns" (::data/name target)) {:ast kw})) - (throw (ex-info (str "Struct error: no member at " kw) {:ast kw})) - ) - ) + (throw (ex-info (str "Struct error: no member at " kw) {:ast kw})))) + (kw target))) (throw (ex-info "Called keywords take a single argument" {:ast lfn}))) @@ -276,8 +266,8 @@ (if (::data/struct prev-value) (if (contains? prev-value (:value curr)) (get prev-value (:value curr)) - (if (= (::data/type prev-value) ::data/ns) - (throw (ex-info (str "Namespace error: no member " (:value curr) " in ns " (::data/name prev-value)) {:ast curr})) + (if (= (::data/type prev-value) ::data/ns) + (throw (ex-info (str "Namespace error: no member " (:value curr) " in ns " (::data/name prev-value)) {:ast curr})) (throw (ex-info (str "Struct error: no member " (:value curr)) {:ast curr})))) (get prev-value (:value curr))) (call-fn prev-value (interpret-ast curr ctx) ctx)))) @@ -324,14 +314,14 @@ [k (f v)])))) (defn- interpret-ns [ast ctx] - (let [members (:members ast) + (let [members (:members ast) name (:name ast)] (if (contains? @ctx name) (throw (ex-info (str "ns name " name " is already bound") {:ast ast})) (let [ns (into - {::data/struct true ::data/type ::data/ns ::data/name name} - (map-values #(interpret-ast % ctx)) - members)] + {::data/struct true ::data/type ::data/ns ::data/name name} + (map-values #(interpret-ast % ctx)) + members)] (vswap! ctx update-ctx {name ns}) ns)))) @@ -340,12 +330,12 @@ name (:name ast)] (if (contains? @ctx name) (throw (ex-info (str "Name " name " is alrady bound") {:ast ast})) - (let [source (try - (loader/load-import path (resolve-word ::file ctx)) - (catch Exception e - (if (::loader/error (ex-data e)) - (throw (ex-info (ex-message e) {:ast ast})) - (throw e)))) + (let [source (try + (loader/load-import path (resolve-word ::file ctx)) + (catch Exception e + (if (::loader/error (ex-data e)) + (throw (ex-info (ex-message e) {:ast ast})) + (throw e)))) result (-> source (scanner/scan) (parser/parse) (interpret path))] (vswap! ctx update-ctx {name result}) result ;; TODO: test this! @@ -379,25 +369,22 @@ (vswap! new-ctx #(merge % clause-ctx)) (interpret-ast body new-ctx)) (recur (first clauses) (rest clauses)))) - + (throw (ex-info (str "Match Error: No match found in loop for " input) {:ast ast}))))] (if (::data/recur output) (recur (:tuple output)) - output - )) - )) - ) + output))))) (defn- panic [ast ctx] (throw (ex-info (show/show (interpret-ast (:expr ast) ctx)) {:ast ast}))) (defn- list-term [ctx] - (fn [list member] + (fn [list member] (if (= (::ast/type member) ::ast/splat) (let [splatted (interpret-ast (:expr member) ctx) - splat-list? (and - (vector? splatted) - (not (= (first splatted) ::data/tuple)))] + splat-list? (and + (vector? splatted) + (not (= (first splatted) ::data/tuple)))] (if splat-list? (concat list splatted) (throw (ex-info "Cannot splat non-list into list" {:ast member})))) @@ -411,7 +398,7 @@ (fn [set member] (if (= (::ast/type member) ::ast/splat) (let [splatted (interpret-ast (:expr member) ctx) - splat-set? (set? splatted)] + splat-set? (set? splatted)] (if splat-set? (clojure.set/union set splatted) (throw (ex-info "Cannot splat non-set into set" {:ast member})))) @@ -422,12 +409,12 @@ (reduce (set-term ctx) #{} members))) (defn- dict-term [ctx] - (fn [dict member] + (fn [dict member] (if (= (::ast/type member) ::ast/splat) (let [splatted (interpret-ast (:expr member) ctx) - splat-map? (and - (map? splatted) - (::data/dict splatted))] + splat-map? (and + (map? splatted) + (::data/dict splatted))] (if splat-map? (merge dict splatted) (throw (ex-info "Cannot splat non-dict into dict" {:ast member})))) @@ -436,9 +423,7 @@ (defn- interpret-dict [ast ctx] (let [members (:members ast)] - (assoc (reduce (dict-term ctx) {} members) ::data/dict true) - ) - ) + (assoc (reduce (dict-term ctx) {} members) ::data/dict true))) (defn interpret-ast [ast ctx] (case (::ast/type ast) @@ -496,9 +481,9 @@ ;; tuples are vectors with a special first member ::ast/tuple (let [members (:members ast)] - (into - [(if (:partial ast) ::data/partial ::data/tuple)] - (map #(interpret-ast % ctx)) members)) + (into + [(if (:partial ast) ::data/partial ::data/tuple)] + (map #(interpret-ast % ctx)) members)) ::ast/list (interpret-list ast ctx) @@ -525,7 +510,7 @@ (System/exit 67)))) (defn interpret-safe [parsed] - (try + (try (let [base-ctx (volatile! (merge {} prelude/prelude))] (interpret-ast (::parser/ast parsed) base-ctx)) (catch clojure.lang.ExceptionInfo e @@ -534,25 +519,25 @@ (println (ex-message e)) (pp/pprint (ex-data e))))) -(defn interpret-repl - ([parsed] - (let [base-ctx (volatile! (merge {} prelude/prelude))] - (try - (let [result (interpret-ast (::parser/ast parsed) base-ctx)] - {:result result :ctx base-ctx}) - (catch clojure.lang.ExceptionInfo e - (println "Ludus panicked!") - (println (ex-message e)) - {:result ::error :ctx base-ctx})))) +(defn interpret-repl + ([parsed] + (let [base-ctx (volatile! (merge {} prelude/prelude))] + (try + (let [result (interpret-ast (::parser/ast parsed) base-ctx)] + {:result result :ctx base-ctx}) + (catch clojure.lang.ExceptionInfo e + (println "Ludus panicked!") + (println (ex-message e)) + {:result ::error :ctx base-ctx})))) ([parsed ctx] - (let [orig-ctx @ctx] - (try - (let [result (interpret-ast (::parser/ast parsed) ctx)] - {:result result :ctx ctx}) - (catch clojure.lang.ExceptionInfo e - (println "Ludus panicked!") - (println (ex-message e)) - {:result ::error :ctx (volatile! orig-ctx)}))))) + (let [orig-ctx @ctx] + (try + (let [result (interpret-ast (::parser/ast parsed) ctx)] + {:result result :ctx ctx}) + (catch clojure.lang.ExceptionInfo e + (println "Ludus panicked!") + (println (ex-message e)) + {:result ::error :ctx (volatile! orig-ctx)}))))) (comment @@ -566,12 +551,12 @@ (println "") (-> source - (scanner/scan) - (parser/parse) - (interpret-safe) - (show/show) + (scanner/scan) + (parser/parse) + (interpret-safe) + (show/show) ;;(println) - )) + )) (comment " diff --git a/src/ludus/loader.clj b/src/ludus/loader.clj index f65d055..888682f 100644 --- a/src/ludus/loader.clj +++ b/src/ludus/loader.clj @@ -4,13 +4,13 @@ (defn cwd [] (fs/cwd)) (defn load-import - ([file] + ([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})))))) + (catch java.io.FileNotFoundException _ + (throw (ex-info (str "File " path " not found") {:path path ::error true})))))) ([file from] - (load-import - (fs/path - (fs/parent (fs/canonicalize from)) - (fs/path file))))) + (load-import + (fs/path + (fs/parent (fs/canonicalize from)) + (fs/path file))))) diff --git a/src/ludus/parser.clj b/src/ludus/parser.clj index ea1bc28..dc52d13 100644 --- a/src/ludus/parser.clj +++ b/src/ludus/parser.clj @@ -1,10 +1,10 @@ (ns ludus.parser (:require - [ludus.token :as token] - [ludus.scanner :as scanner] - [ludus.ast :as ast] - [clojure.pprint :as pp] - [clojure.set :as s])) + [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] @@ -47,8 +47,8 @@ :origin origin :end end}] (-> parser - (assoc ::ast poison) - (update ::errors conj poison)))) + (assoc ::ast poison) + (update ::errors conj poison)))) (defn- poisoned? [parser] (= ::ast/poison (get-in parser [::ast ::ast/type]))) @@ -74,8 +74,8 @@ (if (contains? tokens type) (advance parser) (-> parser - (advance) - (panic message tokens))))) + (advance) + (panic message tokens))))) (defn- expect* [tokens message parser] (let [curr (current parser) @@ -106,10 +106,10 @@ (defn- parse-atom [parser] (let [token (current parser)] (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/atom - :token token - :value (::token/literal token)})))) + (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 @@ -119,10 +119,10 @@ (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))})))) + (advance) + (assoc ::ast {::ast/type ::ast/atom + :token token + :value (get atomic-words (::token/type token))})))) (defn- add-member [members member] (if (nil? member) @@ -140,28 +140,28 @@ (case (token-type parser) ::token/rparen (let [ms (add-member members current_member)] (assoc (advance parser) ::ast - {::ast/type ::ast/tuple - :length (count ms) - :members ms - :token (current origin) - :partial (contains-placeholder? ms)})) + {::ast/type ::ast/tuple + :length (count ms) + :members ms + :token (current origin) + :partial (contains-placeholder? ms)})) (::token/comma ::token/newline) (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) + (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})) + (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) @@ -177,24 +177,24 @@ (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})) + {::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) + (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)) + (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) @@ -210,14 +210,14 @@ (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})) + {::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) + (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))) @@ -244,14 +244,14 @@ (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})) + {::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) + (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))) @@ -278,14 +278,14 @@ (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})) + {::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) + (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))) @@ -294,15 +294,15 @@ (panic (assoc origin ::errors (::errors parser)) "Unterminated dict" ::token/eof) ::token/word - (if (not current_member) - (let [parsed (parse-word parser) + (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) + (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})) @@ -325,14 +325,14 @@ (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})) + {::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) + (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))) @@ -343,24 +343,24 @@ ::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})) + (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})) (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 + (cond (not (:success name)) (panic parser "Expected ns name" #{::token/newline}) (not (:success origin)) (panic (:parser name) "Expected { after ns name") - :else + :else (loop [parser (accept-many #{::token/newline ::token/comma} (:parser origin)) members {} current_member nil] @@ -368,15 +368,15 @@ (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})) + {::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) + (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))) @@ -387,12 +387,12 @@ ::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})) + (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})) (panic parser "ns entries must be single words or keyword+expression pairs" #{::token/rbrace}))))))) @@ -412,8 +412,8 @@ (::token/semicolon ::token/newline) (recur - (accept-many #{::token/newline ::token/semicolon} parser) - (add-member exprs current_expr) nil) + (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))) @@ -436,14 +436,14 @@ (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 + (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) + (accept-many #{::token/semicolon ::token/newline} parser) + (add-member exprs current_expr) + nil) (let [parsed (if current_expr @@ -473,8 +473,8 @@ (defn- parse-word [parser] (let [curr (current parser)] (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/word :token (current parser) :word (::token/lexeme curr)})))) + (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})) @@ -486,14 +486,14 @@ (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})) + {::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) + (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))) @@ -512,14 +512,14 @@ (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})) + {::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) + (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))) @@ -528,13 +528,13 @@ (panic (assoc origin ::errors (::errors parser)) "Unterminated dict pattern" ::token/eof) ::token/word - (if (not current_member) + (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) + (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})) @@ -549,14 +549,14 @@ (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})) + {::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) + (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))) @@ -565,13 +565,13 @@ (panic (assoc origin ::errors (::errors parser)) "Unterminated struct pattern" ::token/eof) ::token/word - (if (not current_member) + (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) + (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})) @@ -586,15 +586,15 @@ (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})) + {::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) + (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))) @@ -609,10 +609,10 @@ (let [curr (current parser) type (::token/type curr)] (case type - (::token/placeholder ::token/ignored) + (::token/placeholder ::token/ignored) (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/placeholder :token curr})) + (advance) + (assoc ::ast {::ast/type ::ast/placeholder :token curr})) ::token/word (parse-word parser) @@ -659,8 +659,7 @@ success (:success assignment)] (if success (parse-ref-expr (:parser assignment) name) - (panic parser "Expected assignment"))) - ) + (panic parser "Expected assignment")))) (defn- parse-ref [parser] (let [name (advance parser)] @@ -713,7 +712,7 @@ (let [curr (current parser)] (case (::token/type curr) ::token/rbrace - (if (< 0 (count clauses)) + (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})) @@ -762,7 +761,7 @@ (let [curr (current parser)] (case (::token/type curr) ::token/rbrace - (if (< 0 (count clauses)) + (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})) @@ -794,8 +793,7 @@ :clauses [(::ast clause)]})))) (panic parser "Expected with after loop expression"))) - (panic parser "Expected tuple as loop expression") - ))) + (panic parser "Expected tuple as loop expression")))) (defn- parse-recur [parser] (let [next (advance parser)] @@ -803,21 +801,17 @@ (let [tuple (parse-tuple next)] (assoc tuple ::ast {::ast/type ::ast/recur :token (current parser) - :tuple (::ast tuple)}) - ) - (panic parser "Expected tuple after recur") - ) - ) - ) + :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)) + (let [expr (if + (contains? #{::token/else ::token/placeholder} (token-type parser)) (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/atom - :token (current parser) - :value true})) + (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) @@ -833,11 +827,10 @@ (let [curr (current parser)] (case (::token/type curr) ::token/rbrace - (if (< 0 (count clauses)) + (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) @@ -845,18 +838,14 @@ (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) (defn- parse-cond [parser] - (let [header + (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") - ) - ) - ) + :clauses (get-in clauses [::ast :clauses])})) + (panic parser "Expected { after cond")))) (defn- parse-fn-clause [parser] (if (not (= ::token/lparen (token-type parser))) @@ -876,7 +865,7 @@ (let [curr (current parser)] (case (::token/type curr) ::token/rbrace - (if (< 0 (count clauses)) + (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})) @@ -930,8 +919,7 @@ (recur (advance expr+newline) (conj exprs (::ast expr))) (assoc expr ::ast {::ast/type ::ast/pipeline :token (current parser) - :exprs (conj exprs (::ast expr))}) - ))))) + :exprs (conj exprs (::ast expr))})))))) (defn- parse-import [parser] (let [path (parse-atom (advance parser)) @@ -941,8 +929,7 @@ nil) name (if (:success named?) (parse-word (:parser as)) - nil - )] + nil)] (cond (not= ::token/string (token-type (advance parser))) (panic parser "Expected path after import" #{::token/newline}) @@ -1042,9 +1029,9 @@ (defn parse [lexed] (-> lexed - (:tokens) - (parser) - (parse-script))) + (:tokens) + (parser) + (parse-script))) (comment (def pp pp/pprint) @@ -1063,9 +1050,9 @@ (println "*** *** NEW PARSE *** ***") (-> p - (parse-script) - (::ast) - (pp))) + (parse-script) + (::ast) + (pp))) (comment " Further thoughts/still to do: diff --git a/src/ludus/prelude.clj b/src/ludus/prelude.clj index 71b43ba..61cb3ff 100644 --- a/src/ludus/prelude.clj +++ b/src/ludus/prelude.clj @@ -12,12 +12,12 @@ (defn- id [x] x) (def and- {:name "and" - ::data/type ::data/clj - :body (fn [&args] (every? id &args))}) + ::data/type ::data/clj + :body (fn [&args] (every? id &args))}) (def or- {:name "or" - ::data/type ::data/clj - :body (fn [&args] (some id &args))}) + ::data/type ::data/clj + :body (fn [&args] (some id &args))}) (def add {:name "add" ::data/type ::data/clj @@ -36,12 +36,12 @@ :body /}) (def inc- {:name "inc" - ::data/type ::data/clj - :body inc}) + ::data/type ::data/clj + :body inc}) (def dec- {:name "dec" - ::data/type ::data/clj - :body dec}) + ::data/type ::data/clj + :body dec}) (def ld-not {:name "not" ::data/type ::data/clj @@ -52,30 +52,28 @@ :body (fn [& args] (throw (ex-info (apply str (interpose " " args)) {})))}) (def print- {:name "print" - ::data/type ::data/clj - :body (fn [& args] - (println (apply str args)) - :ok)}) + ::data/type ::data/clj + :body (fn [& args] + (println (apply str args)) + :ok)}) (def deref- {:name "deref" - ::data/type ::data/clj - :body (fn [ref] - (if (::data/ref ref) - (deref (::data/value ref)) - (throw (ex-info "Cannot deref something that is not a ref" {})) - ))}) + ::data/type ::data/clj + :body (fn [ref] + (if (::data/ref ref) + (deref (::data/value ref)) + (throw (ex-info "Cannot deref something that is not a ref" {}))))}) (def set!- {:name "set!" - ::data/type ::data/clj - :body (fn [ref value] - (if (::data/ref ref) - (reset! (::data/value ref) value) - (throw (ex-info "Cannot set! something that is not a ref" {})) - ))}) + ::data/type ::data/clj + :body (fn [ref value] + (if (::data/ref ref) + (reset! (::data/value ref) value) + (throw (ex-info "Cannot set! something that is not a ref" {}))))}) (def show {:name "show" - ::data/type ::data/clj - :body ludus.show/show}) + ::data/type ::data/clj + :body ludus.show/show}) (def prelude {"eq" eq "add" add @@ -91,5 +89,4 @@ "deref" deref- "set!" set!- "and" and- - "or" or- - }) \ No newline at end of file + "or" or-}) \ No newline at end of file diff --git a/src/ludus/repl.clj b/src/ludus/repl.clj index 4b3e719..406449c 100644 --- a/src/ludus/repl.clj +++ b/src/ludus/repl.clj @@ -1,11 +1,11 @@ (ns ludus.repl - (:require - [ludus.scanner :as scanner] - [ludus.parser :as parser] - [ludus.interpreter :as interpreter] - [ludus.prelude :as prelude] - [ludus.show :as show] - [ludus.data :as data])) + (:require + [ludus.scanner :as scanner] + [ludus.parser :as parser] + [ludus.interpreter :as interpreter] + [ludus.prelude :as prelude] + [ludus.show :as show] + [ludus.data :as data])) (declare repl-prelude new-session) @@ -15,63 +15,60 @@ (def prompt "=> ") -(def base-ctx (merge prelude/prelude - {::repl true - "repl" - { - ::data/struct true - ::data/type ::data/ns - ::data/name "repl" +(def base-ctx (merge prelude/prelude + {::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))} + :flush + {:name "flush" + ::data/type ::data/clj + :body (fn [] + (let [session @current-session] + (swap! session #(assoc % :ctx (volatile! base-ctx))) + :ok))} - :new - {:name "new" - ::data/type ::data/clj - :body (fn [name] - (let [session (new-session name)] - (reset! current-session session) - :ok))} + :new + {:name "new" + ::data/type ::data/clj + :body (fn [name] + (let [session (new-session name)] + (reset! current-session session) + :ok))} - :swap - {:name "swap" - ::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)))} - }})) + :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)))}}})) -(defn- new-session [name] - (let [session (atom { - :name name - :ctx (volatile! base-ctx) +(defn- new-session [name] + (let [session (atom {:name name + :ctx (volatile! base-ctx) :history []})] (swap! sessions #(assoc % name session)) session)) (defn- exit [] - (println "\nGoodbye!") - (System/exit 0)) + (println "\nGoodbye!") + (System/exit 0)) (defn repl-loop [] (let [session-atom @current-session - session @session-atom - orig-ctx (:ctx session)] + session @session-atom + orig-ctx (:ctx session)] (print (str (:name session) prompt)) (flush) (let [raw-input (read-line) - input (if raw-input raw-input (exit)) + input (if raw-input raw-input (exit)) parsed (-> input (scanner/scan) (parser/parse)) {result :result ctx :ctx} (interpreter/interpret-repl parsed (:ctx session))] (if (= result ::interpreter/error) @@ -79,7 +76,7 @@ (do (println (show/show result)) (when (not (= @ctx @orig-ctx)) - (swap! session-atom #(assoc % :ctx ctx))) + (swap! session-atom #(assoc % :ctx ctx))) (repl-loop)))))) (defn launch [] diff --git a/src/ludus/scanner.clj b/src/ludus/scanner.clj index 2c6c853..0a7f7f1 100644 --- a/src/ludus/scanner.clj +++ b/src/ludus/scanner.clj @@ -1,14 +1,13 @@ (ns ludus.scanner (:require - [ludus.token :as token] - [clojure.pprint :as pp] - [clojure.edn :as edn])) + [ludus.token :as token] + [clojure.pprint :as pp] + [clojure.edn :as edn])) (def reserved-words "List of Ludus reserved words." ;; see ludus-spec repo for more info - { - "as" ::token/as ;; impl for `import`; not yet for patterns + {"as" ::token/as ;; impl for `import`; not yet for patterns "cond" ::token/cond ;; impl "do" ::token/do ;; impl "else" ::token/else ;; impl @@ -36,12 +35,12 @@ "spawn" ::token/spawn "to" ::token/to ;; type system - "data" ::token/data + "data" ::token/data ;; others "repeat" ::token/repeat ;; syntax sugar over "loop" "test" ::token/test "when" ::token/when - + ;; below here, possibly not ;; generators (sugar over actors?) "gen" ::token/gen @@ -51,8 +50,7 @@ "wait" ::token/wait ;; vars "mut" ::token/mut - "var" ::token/var - }) + "var" ::token/var}) (defn- new-scanner "Creates a new scanner." @@ -91,8 +89,8 @@ (defn- char-in-range? [start end char] (and char - (>= (int char) (int start)) - (<= (int char) (int end)))) + (>= (int char) (int start)) + (<= (int char) (int end)))) (defn- digit? [c] (char-in-range? \0 \9 c)) @@ -125,27 +123,27 @@ (add-token scanner token-type nil)) ([scanner token-type literal] (update scanner ::tokens conj - (token/token - token-type - (current-lexeme scanner) - literal - (::line scanner) - (::start scanner))))) + (token/token + token-type + (current-lexeme scanner) + literal + (::line scanner) + (::start scanner))))) ;; TODO: errors should also be in the vector of tokens ;; The goal is to be able to be able to hand this to an LSP? ;; Do we need a different structure (defn- add-error [scanner msg] (let [token (token/token - ::token/error - (current-lexeme scanner) - nil - (::line scanner) - (::start scanner)) + ::token/error + (current-lexeme scanner) + nil + (::line scanner) + (::start scanner)) err-token (assoc token :message msg)] (-> scanner - (update ::errors conj err-token) - (update ::tokens conj err-token)))) + (update ::errors conj err-token) + (update ::tokens conj err-token)))) (defn- add-keyword [scanner] diff --git a/src/ludus/show.clj b/src/ludus/show.clj index c8ae5a2..6e4ac01 100644 --- a/src/ludus/show.clj +++ b/src/ludus/show.clj @@ -1,7 +1,7 @@ (ns ludus.show (:require - [ludus.data :as data] - [clojure.pprint :as pp])) + [ludus.data :as data] + [clojure.pprint :as pp])) (declare show show-linear show-keyed) @@ -13,27 +13,25 @@ (defn- show-map [v] (cond (or (= (::data/type v) ::data/fn) - (= (::data/type v) ::data/clj)) + (= (::data/type v) ::data/clj)) (str "fn " (:name v)) (= (::data/type v) ::data/ns) (str "ns " (::data/name v) " {" - (apply str (into [] show-keyed (dissoc v ::data/struct ::data/type ::data/name))) - "}") + (apply str (into [] show-keyed (dissoc v ::data/struct ::data/type ::data/name))) + "}") - (::data/struct v) + (::data/struct v) (str "@{" (apply str (into [] show-keyed (dissoc v ::data/struct))) "}") (::data/ref v) ;; TODO: reconsider this - (str "ref:" (::data/name v) " <" (deref (::data/value v))">") + (str "ref:" (::data/name v) " <" (deref (::data/value v)) ">") (::data/hashmap v) (str "#{" (apply str (into [] show-keyed (dissoc v ::data/hashmap))) "}") :else - (pp/pprint v) - - )) + (pp/pprint v))) (defn- show-set [v] (str "${" (apply str (into [] show-linear v)) "}")) @@ -52,8 +50,8 @@ (def show-linear (comp (map show) (interpose ", "))) -(def show-keyed (comp - (map #(str (show (first %)) " " (show (second %)))) - (interpose ", "))) +(def show-keyed (comp + (map #(str (show (first %)) " " (show (second %)))) + (interpose ", "))) (show {::data/type ::data/fn :name "foo"}) diff --git a/src/ludus/token.clj b/src/ludus/token.clj index abb1192..e156751 100644 --- a/src/ludus/token.clj +++ b/src/ludus/token.clj @@ -2,8 +2,8 @@ (defn token [type text literal line start] - {::type type - ::lexeme text - ::literal literal - ::line line - ::start start}) + {::type type + ::lexeme text + ::literal literal + ::line line + ::start start})