This commit is contained in:
Scott Richmond 2022-05-27 19:18:00 -04:00
parent 874dacf791
commit 173f5756a7
9 changed files with 338 additions and 376 deletions

View File

@ -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]

View File

@ -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
@ -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
@ -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,8 +210,7 @@
(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
@ -228,15 +219,15 @@
:name (str (:name lfn) "{partial}")
:body (fn [arg]
(call-fn
lfn
(concat [::data/tuple] (replace {::data/placeholder arg} (rest tuple)))
ctx))}
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})))
@ -329,9 +319,9 @@
(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))))
@ -341,11 +331,11 @@
(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))))
(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!
@ -383,10 +373,7 @@
(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})))
@ -395,9 +382,9 @@
(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}))))
@ -425,9 +412,9 @@
(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)
@ -497,8 +482,8 @@
::ast/tuple
(let [members (:members ast)]
(into
[(if (:partial ast) ::data/partial ::data/tuple)]
(map #(interpret-ast % ctx)) members))
[(if (:partial ast) ::data/partial ::data/tuple)]
(map #(interpret-ast % ctx)) members))
::ast/list (interpret-list ast ctx)
@ -536,23 +521,23 @@
(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}))))
(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 "

View File

@ -7,10 +7,10 @@
([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)))))
(fs/path
(fs/parent (fs/canonicalize from))
(fs/path file)))))

View 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,16 +140,16 @@
(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)))
@ -157,11 +157,11 @@
::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))
(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 {::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))
(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)))
@ -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,12 +343,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 "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})))))
@ -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)))
@ -441,9 +441,9 @@
(::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)))
@ -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)))
@ -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)))
@ -611,8 +611,8 @@
(case type
(::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)]
@ -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))
(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)
@ -837,7 +831,6 @@
(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)
@ -851,12 +844,8 @@
(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)))
@ -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:

View File

@ -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-})

View File

@ -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]))
[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)
@ -16,62 +16,59 @@
(def prompt "=> ")
(def base-ctx (merge prelude/prelude
{::repl true
"repl"
{
::data/struct true
::data/type ::data/ns
::data/name "repl"
{::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
(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 []

View File

@ -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
@ -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]

View File

@ -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)
(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)) "}"))
@ -53,7 +51,7 @@
(def show-linear (comp (map show) (interpose ", ")))
(def show-keyed (comp
(map #(str (show (first %)) " " (show (second %))))
(interpose ", ")))
(map #(str (show (first %)) " " (show (second %))))
(interpose ", ")))
(show {::data/type ::data/fn :name "foo"})

View File

@ -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})