cljfmt
This commit is contained in:
Scott Richmond
parent
874dacf791
commit
173f5756a7
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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 "
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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-
|
||||
})
|
||||
"or" or-})
|
||||
|
|
@ -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 []
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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"})
|
||||
|
|
|
|||
|
|
@ -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})
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user