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

cljfmt

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

16
src/ludus/core.clj
View File

@ -1,13 +1,13 @@
(ns ludus.core (ns ludus.core
"A tree-walk interpreter for the Ludus language." "A tree-walk interpreter for the Ludus language."
(:require (:require
[ludus.scanner :as scanner] [ludus.scanner :as scanner]
[ludus.parser :as parser] [ludus.parser :as parser]
[ludus.interpreter :as interpreter] [ludus.interpreter :as interpreter]
[ludus.show :as show] [ludus.show :as show]
[clojure.pprint :as pp] [clojure.pprint :as pp]
[ludus.loader :as loader] [ludus.loader :as loader]
[ludus.repl :as repl]) [ludus.repl :as repl])
(:gen-class)) (:gen-class))
(defn- run [file source] (defn- run [file source]
@ -29,7 +29,7 @@
(defn -main [& args] (defn -main [& args]
(cond (cond
(= (count args) 1) (= (count args) 1)
(let [file (first args) (let [file (first args)
source (loader/load-import file)] source (loader/load-import file)]
(run file source)) (run file source))

169
src/ludus/interpreter.clj
View File

@ -1,15 +1,15 @@
(ns ludus.interpreter (ns ludus.interpreter
(:require (:require
[ludus.parser :as parser] [ludus.parser :as parser]
[ludus.scanner :as scanner] [ludus.scanner :as scanner]
[ludus.ast :as ast] [ludus.ast :as ast]
[ludus.prelude :as prelude] [ludus.prelude :as prelude]
[ludus.data :as data] [ludus.data :as data]
[ludus.show :as show] [ludus.show :as show]
[ludus.loader :as loader] [ludus.loader :as loader]
[ludus.token :as token] [ludus.token :as token]
[clojure.pprint :as pp] [clojure.pprint :as pp]
[clojure.set])) [clojure.set]))
;; right now this is not very efficient: ;; right now this is not very efficient:
;; it's got runtime checking ;; it's got runtime checking
@ -76,7 +76,7 @@
(not (::data/dict value)) (not (::data/dict value))
{:success false :reason "Cannot match non-dict data types a dict pattern"} {:success false :reason "Cannot match non-dict data types a dict pattern"}
:else :else
(let [members (:members pattern) (let [members (:members pattern)
kws (keys members)] kws (keys members)]
(loop [i (dec (count kws)) ctx {}] (loop [i (dec (count kws)) ctx {}]
@ -87,10 +87,8 @@
(let [match? (match (kw members) (kw value) ctx-vol)] (let [match? (match (kw members) (kw value) ctx-vol)]
(if (:success match?) (if (:success match?)
(recur (dec i) (merge ctx (:ctx 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] (defn- match-struct [pattern value ctx-vol]
(cond (cond
@ -100,7 +98,7 @@
(not (::data/struct value)) (not (::data/struct value))
{:success false :reason "Cannot match non-struct data types a struct pattern"} {:success false :reason "Cannot match non-struct data types a struct pattern"}
:else :else
(let [members (:members pattern) (let [members (:members pattern)
kws (keys members)] kws (keys members)]
(loop [i (dec (count kws)) ctx {}] (loop [i (dec (count kws)) ctx {}]
@ -111,10 +109,8 @@
(let [match? (match (kw members) (kw value) ctx-vol)] (let [match? (match (kw members) (kw value) ctx-vol)]
(if (:success match?) (if (:success match?)
(recur (dec i) (merge ctx (:ctx 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] (defn- match [pattern value ctx-vol]
(let [ctx @ctx-vol] (let [ctx @ctx-vol]
@ -200,11 +196,7 @@
truthy? (boolean (interpret-ast test-expr ctx))] truthy? (boolean (interpret-ast test-expr ctx))]
(if truthy? (if truthy?
(interpret-ast body ctx) (interpret-ast body ctx)
(recur (first clauses) (rest clauses)) (recur (first clauses) (rest clauses))))))))
)
)
)
)))
(defn- interpret-called-kw [kw tuple ctx] (defn- interpret-called-kw [kw tuple ctx]
;; TODO: check this statically ;; TODO: check this statically
@ -218,25 +210,24 @@
(if (= (::data/type map) ::data/ns) (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 "Namespace error: no member " kw " in ns " (::data/name map)) {: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}))))
(get map kw)) (get map kw)))))
)))
(defn- call-fn [lfn tuple ctx] (defn- call-fn [lfn tuple ctx]
(cond (cond
(= ::data/partial (first tuple)) (= ::data/partial (first tuple))
{::data/type ::data/clj {::data/type ::data/clj
:name (str (:name lfn) "{partial}") :name (str (:name lfn) "{partial}")
:body (fn [arg] :body (fn [arg]
(call-fn (call-fn
lfn lfn
(concat [::data/tuple] (replace {::data/placeholder arg} (rest tuple))) (concat [::data/tuple] (replace {::data/placeholder arg} (rest tuple)))
ctx))} ctx))}
(= (::data/type lfn) ::data/clj) (apply (:body lfn) (next tuple)) (= (::data/type lfn) ::data/clj) (apply (:body lfn) (next tuple))
(= (::data/type lfn) ::data/fn) (= (::data/type lfn) ::data/fn)
(let [clauses (:clauses lfn) (let [clauses (:clauses lfn)
closed-over (:ctx lfn)] closed-over (:ctx lfn)]
(loop [clause (first clauses) (loop [clause (first clauses)
clauses (rest clauses)] clauses (rest clauses)]
(if clause (if clause
@ -262,9 +253,8 @@
(kw target) (kw target)
(if (= (::data/type target) ::data/ns) (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 "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))) (kw target)))
(throw (ex-info "Called keywords take a single argument" {:ast lfn}))) (throw (ex-info "Called keywords take a single argument" {:ast lfn})))
@ -276,8 +266,8 @@
(if (::data/struct prev-value) (if (::data/struct prev-value)
(if (contains? prev-value (:value curr)) (if (contains? prev-value (:value curr))
(get prev-value (:value curr)) (get prev-value (:value curr))
(if (= (::data/type prev-value) ::data/ns) (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 "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})))) (throw (ex-info (str "Struct error: no member " (:value curr)) {:ast curr}))))
(get prev-value (:value curr))) (get prev-value (:value curr)))
(call-fn prev-value (interpret-ast curr ctx) ctx)))) (call-fn prev-value (interpret-ast curr ctx) ctx))))
@ -324,14 +314,14 @@
[k (f v)])))) [k (f v)]))))
(defn- interpret-ns [ast ctx] (defn- interpret-ns [ast ctx]
(let [members (:members ast) (let [members (:members ast)
name (:name ast)] name (:name ast)]
(if (contains? @ctx name) (if (contains? @ctx name)
(throw (ex-info (str "ns name " name " is already bound") {:ast ast})) (throw (ex-info (str "ns name " name " is already bound") {:ast ast}))
(let [ns (into (let [ns (into
{::data/struct true ::data/type ::data/ns ::data/name name} {::data/struct true ::data/type ::data/ns ::data/name name}
(map-values #(interpret-ast % ctx)) (map-values #(interpret-ast % ctx))
members)] members)]
(vswap! ctx update-ctx {name ns}) (vswap! ctx update-ctx {name ns})
ns)))) ns))))
@ -340,12 +330,12 @@
name (:name ast)] name (:name ast)]
(if (contains? @ctx name) (if (contains? @ctx name)
(throw (ex-info (str "Name " name " is alrady bound") {:ast ast})) (throw (ex-info (str "Name " name " is alrady bound") {:ast ast}))
(let [source (try (let [source (try
(loader/load-import path (resolve-word ::file ctx)) (loader/load-import path (resolve-word ::file ctx))
(catch Exception e (catch Exception e
(if (::loader/error (ex-data e)) (if (::loader/error (ex-data e))
(throw (ex-info (ex-message e) {:ast ast})) (throw (ex-info (ex-message e) {:ast ast}))
(throw e)))) (throw e))))
result (-> source (scanner/scan) (parser/parse) (interpret path))] result (-> source (scanner/scan) (parser/parse) (interpret path))]
(vswap! ctx update-ctx {name result}) (vswap! ctx update-ctx {name result})
result ;; TODO: test this! result ;; TODO: test this!
@ -379,25 +369,22 @@
(vswap! new-ctx #(merge % clause-ctx)) (vswap! new-ctx #(merge % clause-ctx))
(interpret-ast body new-ctx)) (interpret-ast body new-ctx))
(recur (first clauses) (rest clauses)))) (recur (first clauses) (rest clauses))))
(throw (ex-info (str "Match Error: No match found in loop for " input) {:ast ast}))))] (throw (ex-info (str "Match Error: No match found in loop for " input) {:ast ast}))))]
(if (::data/recur output) (if (::data/recur output)
(recur (:tuple output)) (recur (:tuple output))
output output)))))
))
))
)
(defn- panic [ast ctx] (defn- panic [ast ctx]
(throw (ex-info (show/show (interpret-ast (:expr ast) ctx)) {:ast ast}))) (throw (ex-info (show/show (interpret-ast (:expr ast) ctx)) {:ast ast})))
(defn- list-term [ctx] (defn- list-term [ctx]
(fn [list member] (fn [list member]
(if (= (::ast/type member) ::ast/splat) (if (= (::ast/type member) ::ast/splat)
(let [splatted (interpret-ast (:expr member) ctx) (let [splatted (interpret-ast (:expr member) ctx)
splat-list? (and splat-list? (and
(vector? splatted) (vector? splatted)
(not (= (first splatted) ::data/tuple)))] (not (= (first splatted) ::data/tuple)))]
(if splat-list? (if splat-list?
(concat list splatted) (concat list splatted)
(throw (ex-info "Cannot splat non-list into list" {:ast member})))) (throw (ex-info "Cannot splat non-list into list" {:ast member}))))
@ -411,7 +398,7 @@
(fn [set member] (fn [set member]
(if (= (::ast/type member) ::ast/splat) (if (= (::ast/type member) ::ast/splat)
(let [splatted (interpret-ast (:expr member) ctx) (let [splatted (interpret-ast (:expr member) ctx)
splat-set? (set? splatted)] splat-set? (set? splatted)]
(if splat-set? (if splat-set?
(clojure.set/union set splatted) (clojure.set/union set splatted)
(throw (ex-info "Cannot splat non-set into set" {:ast member})))) (throw (ex-info "Cannot splat non-set into set" {:ast member}))))
@ -422,12 +409,12 @@
(reduce (set-term ctx) #{} members))) (reduce (set-term ctx) #{} members)))
(defn- dict-term [ctx] (defn- dict-term [ctx]
(fn [dict member] (fn [dict member]
(if (= (::ast/type member) ::ast/splat) (if (= (::ast/type member) ::ast/splat)
(let [splatted (interpret-ast (:expr member) ctx) (let [splatted (interpret-ast (:expr member) ctx)
splat-map? (and splat-map? (and
(map? splatted) (map? splatted)
(::data/dict splatted))] (::data/dict splatted))]
(if splat-map? (if splat-map?
(merge dict splatted) (merge dict splatted)
(throw (ex-info "Cannot splat non-dict into dict" {:ast member})))) (throw (ex-info "Cannot splat non-dict into dict" {:ast member}))))
@ -436,9 +423,7 @@
(defn- interpret-dict [ast ctx] (defn- interpret-dict [ast ctx]
(let [members (:members ast)] (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] (defn interpret-ast [ast ctx]
(case (::ast/type ast) (case (::ast/type ast)
@ -496,9 +481,9 @@
;; tuples are vectors with a special first member ;; tuples are vectors with a special first member
::ast/tuple ::ast/tuple
(let [members (:members ast)] (let [members (:members ast)]
(into (into
[(if (:partial ast) ::data/partial ::data/tuple)] [(if (:partial ast) ::data/partial ::data/tuple)]
(map #(interpret-ast % ctx)) members)) (map #(interpret-ast % ctx)) members))
::ast/list (interpret-list ast ctx) ::ast/list (interpret-list ast ctx)
@ -525,7 +510,7 @@
(System/exit 67)))) (System/exit 67))))
(defn interpret-safe [parsed] (defn interpret-safe [parsed]
(try (try
(let [base-ctx (volatile! (merge {} prelude/prelude))] (let [base-ctx (volatile! (merge {} prelude/prelude))]
(interpret-ast (::parser/ast parsed) base-ctx)) (interpret-ast (::parser/ast parsed) base-ctx))
(catch clojure.lang.ExceptionInfo e (catch clojure.lang.ExceptionInfo e
@ -534,25 +519,25 @@
(println (ex-message e)) (println (ex-message e))
(pp/pprint (ex-data e))))) (pp/pprint (ex-data e)))))
(defn interpret-repl (defn interpret-repl
([parsed] ([parsed]
(let [base-ctx (volatile! (merge {} prelude/prelude))] (let [base-ctx (volatile! (merge {} prelude/prelude))]
(try (try
(let [result (interpret-ast (::parser/ast parsed) base-ctx)] (let [result (interpret-ast (::parser/ast parsed) base-ctx)]
{:result result :ctx base-ctx}) {:result result :ctx base-ctx})
(catch clojure.lang.ExceptionInfo e (catch clojure.lang.ExceptionInfo e
(println "Ludus panicked!") (println "Ludus panicked!")
(println (ex-message e)) (println (ex-message e))
{:result ::error :ctx base-ctx})))) {:result ::error :ctx base-ctx}))))
([parsed ctx] ([parsed ctx]
(let [orig-ctx @ctx] (let [orig-ctx @ctx]
(try (try
(let [result (interpret-ast (::parser/ast parsed) ctx)] (let [result (interpret-ast (::parser/ast parsed) ctx)]
{:result result :ctx ctx}) {:result result :ctx ctx})
(catch clojure.lang.ExceptionInfo e (catch clojure.lang.ExceptionInfo e
(println "Ludus panicked!") (println "Ludus panicked!")
(println (ex-message e)) (println (ex-message e))
{:result ::error :ctx (volatile! orig-ctx)}))))) {:result ::error :ctx (volatile! orig-ctx)})))))
(comment (comment
@ -566,12 +551,12 @@
(println "") (println "")
(-> source (-> source
(scanner/scan) (scanner/scan)
(parser/parse) (parser/parse)
(interpret-safe) (interpret-safe)
(show/show) (show/show)
;;(println) ;;(println)
)) ))
(comment " (comment "

14
src/ludus/loader.clj
View File

@ -4,13 +4,13 @@
(defn cwd [] (fs/cwd)) (defn cwd [] (fs/cwd))
(defn load-import (defn load-import
([file] ([file]
(let [path (-> file (fs/canonicalize) (fs/file))] (let [path (-> file (fs/canonicalize) (fs/file))]
(try (slurp path) (try (slurp path)
(catch java.io.FileNotFoundException _ (catch java.io.FileNotFoundException _
(throw (ex-info (str "File " path " not found") {:path path ::error true})))))) (throw (ex-info (str "File " path " not found") {:path path ::error true}))))))
([file from] ([file from]
(load-import (load-import
(fs/path (fs/path
(fs/parent (fs/canonicalize from)) (fs/parent (fs/canonicalize from))
(fs/path file))))) (fs/path file)))))

285
src/ludus/parser.clj
View File

@ -1,10 +1,10 @@
(ns ludus.parser (ns ludus.parser
(:require (:require
[ludus.token :as token] [ludus.token :as token]
[ludus.scanner :as scanner] [ludus.scanner :as scanner]
[ludus.ast :as ast] [ludus.ast :as ast]
[clojure.pprint :as pp] [clojure.pprint :as pp]
[clojure.set :as s])) [clojure.set :as s]))
;; a parser map and some functions to work with them ;; a parser map and some functions to work with them
(defn- parser [tokens] (defn- parser [tokens]
@ -47,8 +47,8 @@
:origin origin :origin origin
:end end}] :end end}]
(-> parser (-> parser
(assoc ::ast poison) (assoc ::ast poison)
(update ::errors conj poison)))) (update ::errors conj poison))))
(defn- poisoned? [parser] (defn- poisoned? [parser]
(= ::ast/poison (get-in parser [::ast ::ast/type]))) (= ::ast/poison (get-in parser [::ast ::ast/type])))
@ -74,8 +74,8 @@
(if (contains? tokens type) (if (contains? tokens type)
(advance parser) (advance parser)
(-> parser (-> parser
(advance) (advance)
(panic message tokens))))) (panic message tokens)))))
(defn- expect* [tokens message parser] (defn- expect* [tokens message parser]
(let [curr (current parser) (let [curr (current parser)
@ -106,10 +106,10 @@
(defn- parse-atom [parser] (defn- parse-atom [parser]
(let [token (current parser)] (let [token (current parser)]
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/atom (assoc ::ast {::ast/type ::ast/atom
:token token :token token
:value (::token/literal token)})))) :value (::token/literal token)}))))
;; just a quick and dirty map to associate atomic words with values ;; just a quick and dirty map to associate atomic words with values
(def atomic-words {::token/nil nil (def atomic-words {::token/nil nil
@ -119,10 +119,10 @@
(defn parse-atomic-word [parser] (defn parse-atomic-word [parser]
(let [token (current parser)] (let [token (current parser)]
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/atom (assoc ::ast {::ast/type ::ast/atom
:token token :token token
:value (get atomic-words (::token/type token))})))) :value (get atomic-words (::token/type token))}))))
(defn- add-member [members member] (defn- add-member [members member]
(if (nil? member) (if (nil? member)
@ -140,28 +140,28 @@
(case (token-type parser) (case (token-type parser)
::token/rparen (let [ms (add-member members current_member)] ::token/rparen (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/tuple {::ast/type ::ast/tuple
:length (count ms) :length (count ms)
:members ms :members ms
:token (current origin) :token (current origin)
:partial (contains-placeholder? ms)})) :partial (contains-placeholder? ms)}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbrace ::token/rbracket) (::token/rbrace ::token/rbracket)
(panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
::token/placeholder ::token/placeholder
(if (contains-placeholder? members) (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 (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 ::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof)
@ -177,24 +177,24 @@
(case (token-type parser) (case (token-type parser)
::token/rparen (let [ms (add-member members current_member)] ::token/rparen (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/tuple {::ast/type ::ast/tuple
:token (current origin) :token (current origin)
:length (count ms) :length (count ms)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbrace ::token/rbracket) (::token/rbrace ::token/rbracket)
(panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
::token/placeholder ::token/placeholder
(recur (recur
(advance parser) (advance parser)
members members
(panic parser "Placeholders in tuples may only be in function calls." curr)) (panic parser "Placeholders in tuples may only be in function calls." curr))
::token/eof ::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof)
@ -210,14 +210,14 @@
(case (token-type parser) (case (token-type parser)
::token/rbracket (let [ms (add-member members current_member)] ::token/rbracket (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/list {::ast/type ::ast/list
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbrace ::token/rparen) (::token/rbrace ::token/rparen)
(panic parser (str "Mismatched enclosure in list: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in list: " (::token/lexeme curr)))
@ -244,14 +244,14 @@
(case (token-type parser) (case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/set {::ast/type ::ast/set
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in set: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in set: " (::token/lexeme curr)))
@ -278,14 +278,14 @@
(case (token-type parser) (case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/dict {::ast/type ::ast/dict
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in dict: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in dict: " (::token/lexeme curr)))
@ -294,15 +294,15 @@
(panic (assoc origin ::errors (::errors parser)) "Unterminated dict" ::token/eof) (panic (assoc origin ::errors (::errors parser)) "Unterminated dict" ::token/eof)
::token/word ::token/word
(if (not current_member) (if (not current_member)
(let [parsed (parse-word parser) (let [parsed (parse-word parser)
word (get-in parsed [::ast :word])] word (get-in parsed [::ast :word])]
(recur parsed members [(keyword word) (::ast parsed)])) (recur parsed members [(keyword word) (::ast parsed)]))
(panic parser "Dict entries must be single words or keyword+expression pairs." #{::token/rbrace})) (panic parser "Dict entries must be single words or keyword+expression pairs." #{::token/rbrace}))
::token/keyword ::token/keyword
(if (not current_member) (if (not current_member)
(let [kw (parse-atom parser) (let [kw (parse-atom parser)
expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})] expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})]
(recur expr members [(:value (::ast kw)) (::ast expr)])) (recur expr members [(:value (::ast kw)) (::ast expr)]))
(panic parser "Dict entries must be single words or keyword+expression pairs." #{::token/rbrace})) (panic parser "Dict entries must be single words or keyword+expression pairs." #{::token/rbrace}))
@ -325,14 +325,14 @@
(case (token-type parser) (case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/struct {::ast/type ::ast/struct
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in struct: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in struct: " (::token/lexeme curr)))
@ -343,24 +343,24 @@
::token/word ::token/word
(if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] (if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])]
(recur parsed members {(keyword word) (::ast parsed)})) (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 ::token/keyword
(if (not current_member) (let [kw (parse-atom parser) expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})] (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)})) (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}))))) (panic parser "Struct entries must be single words or keyword+expression pairs" #{::token/rbrace})))))
(defn- parse-ns [ns-root] (defn- parse-ns [ns-root]
(let [name (expect* #{::token/word} "Expected ns name" (advance ns-root)) (let [name (expect* #{::token/word} "Expected ns name" (advance ns-root))
origin (expect* #{::token/lbrace} "Expected { after ns name" (:parser name))] origin (expect* #{::token/lbrace} "Expected { after ns name" (:parser name))]
(cond (cond
(not (:success name)) (panic parser "Expected ns name" #{::token/newline}) (not (:success name)) (panic parser "Expected ns name" #{::token/newline})
(not (:success origin)) (panic (:parser name) "Expected { after ns name") (not (:success origin)) (panic (:parser name) "Expected { after ns name")
:else :else
(loop [parser (accept-many #{::token/newline ::token/comma} (:parser origin)) (loop [parser (accept-many #{::token/newline ::token/comma} (:parser origin))
members {} members {}
current_member nil] current_member nil]
@ -368,15 +368,15 @@
(case (token-type parser) (case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/ns {::ast/type ::ast/ns
:token (current ns-root) :token (current ns-root)
:name (get-in (parse-word (advance ns-root)) [::ast :word]) :name (get-in (parse-word (advance ns-root)) [::ast :word])
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in ns: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in ns: " (::token/lexeme curr)))
@ -387,12 +387,12 @@
::token/word ::token/word
(if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] (if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])]
(recur parsed members {(keyword word) (::ast parsed)})) (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 ::token/keyword
(if (not current_member) (let [kw (parse-atom parser) expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})] (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)})) (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}))))))) (panic parser "ns entries must be single words or keyword+expression pairs" #{::token/rbrace})))))))
@ -412,8 +412,8 @@
(::token/semicolon ::token/newline) (::token/semicolon ::token/newline)
(recur (recur
(accept-many #{::token/newline ::token/semicolon} parser) (accept-many #{::token/newline ::token/semicolon} parser)
(add-member exprs current_expr) nil) (add-member exprs current_expr) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in block: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in block: " (::token/lexeme curr)))
@ -436,14 +436,14 @@
(let [es (add-member exprs current_expr)] (let [es (add-member exprs current_expr)]
(if (empty? es) (if (empty? es)
(panic parser "Scripts must have at least one expression") (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 (current origin) :exprs es})))
(::token/semicolon ::token/newline) (::token/semicolon ::token/newline)
(recur (recur
(accept-many #{::token/semicolon ::token/newline} parser) (accept-many #{::token/semicolon ::token/newline} parser)
(add-member exprs current_expr) (add-member exprs current_expr)
nil) nil)
(let [parsed (let [parsed
(if current_expr (if current_expr
@ -473,8 +473,8 @@
(defn- parse-word [parser] (defn- parse-word [parser]
(let [curr (current parser)] (let [curr (current parser)]
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/word :token (current parser) :word (::token/lexeme curr)})))) (assoc ::ast {::ast/type ::ast/word :token (current parser) :word (::token/lexeme curr)}))))
(def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow})) (def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow}))
@ -486,14 +486,14 @@
(case (token-type parser) (case (token-type parser)
::token/rbracket (let [ms (add-member members current_member)] ::token/rbracket (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/list {::ast/type ::ast/list
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbrace ::token/rparen) (::token/rbrace ::token/rparen)
(panic parser (str "Mismatched enclosure in list pattern: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in list pattern: " (::token/lexeme curr)))
@ -512,14 +512,14 @@
(case (token-type parser) (case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/dict {::ast/type ::ast/dict
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in dict pattern: " (::token/lexeme curr))) (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) (panic (assoc origin ::errors (::errors parser)) "Unterminated dict pattern" ::token/eof)
::token/word ::token/word
(if (not current_member) (if (not current_member)
(let [parsed (parse-word parser) word (get-in parsed [::ast :word])] (let [parsed (parse-word parser) word (get-in parsed [::ast :word])]
(recur parsed members {(keyword word) (::ast parsed)})) (recur parsed members {(keyword word) (::ast parsed)}))
(panic parser "Dict patterns may only include single words or keyword+pattern pairs." #{::token/rbrace})) (panic parser "Dict patterns may only include single words or keyword+pattern pairs." #{::token/rbrace}))
::token/keyword ::token/keyword
(if (not current_member) (if (not current_member)
(let [kw (parse-atom parser) pattern (parse-pattern kw)] (let [kw (parse-atom parser) pattern (parse-pattern kw)]
(recur pattern members {(:value (::ast kw)) (::ast pattern)})) (recur pattern members {(:value (::ast kw)) (::ast pattern)}))
(panic parser "Dict patterns may only include single words or keyword+pattern pairs." #{::token/rbrace})) (panic parser "Dict patterns may only include single words or keyword+pattern pairs." #{::token/rbrace}))
@ -549,14 +549,14 @@
(case (token-type parser) (case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/struct {::ast/type ::ast/struct
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in struct pattern: " (::token/lexeme curr))) (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) (panic (assoc origin ::errors (::errors parser)) "Unterminated struct pattern" ::token/eof)
::token/word ::token/word
(if (not current_member) (if (not current_member)
(let [parsed (parse-word parser) word (get-in parsed [::ast :word])] (let [parsed (parse-word parser) word (get-in parsed [::ast :word])]
(recur parsed members {(keyword word) (::ast parsed)})) (recur parsed members {(keyword word) (::ast parsed)}))
(panic parser "Struct patterns may only include single words or keyword+pattern pairs." #{::token/rbrace})) (panic parser "Struct patterns may only include single words or keyword+pattern pairs." #{::token/rbrace}))
::token/keyword ::token/keyword
(if (not current_member) (if (not current_member)
(let [kw (parse-atom parser) pattern (parse-pattern kw)] (let [kw (parse-atom parser) pattern (parse-pattern kw)]
(recur pattern members {(:value (::ast kw)) (::ast pattern)})) (recur pattern members {(:value (::ast kw)) (::ast pattern)}))
(panic parser "Struct patterns may only include single words or keyword+pattern pairs." #{::token/rbrace})) (panic parser "Struct patterns may only include single words or keyword+pattern pairs." #{::token/rbrace}))
@ -586,15 +586,15 @@
(case (token-type parser) (case (token-type parser)
::token/rparen (let [ms (add-member members current_member)] ::token/rparen (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/tuple {::ast/type ::ast/tuple
:token (current origin) :token (current origin)
:length (count ms) :length (count ms)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbrace ::token/rbracket) (::token/rbrace ::token/rbracket)
(panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
@ -609,10 +609,10 @@
(let [curr (current parser) (let [curr (current parser)
type (::token/type curr)] type (::token/type curr)]
(case type (case type
(::token/placeholder ::token/ignored) (::token/placeholder ::token/ignored)
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/placeholder :token curr})) (assoc ::ast {::ast/type ::ast/placeholder :token curr}))
::token/word (parse-word parser) ::token/word (parse-word parser)
@ -659,8 +659,7 @@
success (:success assignment)] success (:success assignment)]
(if success (if success
(parse-ref-expr (:parser assignment) name) (parse-ref-expr (:parser assignment) name)
(panic parser "Expected assignment"))) (panic parser "Expected assignment"))))
)
(defn- parse-ref [parser] (defn- parse-ref [parser]
(let [name (advance parser)] (let [name (advance parser)]
@ -713,7 +712,7 @@
(let [curr (current parser)] (let [curr (current parser)]
(case (::token/type curr) (case (::token/type curr)
::token/rbrace ::token/rbrace
(if (< 0 (count clauses)) (if (< 0 (count clauses))
(assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses}) (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses})
(panic parser "Expected one or more clauses" #{::rbrace})) (panic parser "Expected one or more clauses" #{::rbrace}))
@ -762,7 +761,7 @@
(let [curr (current parser)] (let [curr (current parser)]
(case (::token/type curr) (case (::token/type curr)
::token/rbrace ::token/rbrace
(if (< 0 (count clauses)) (if (< 0 (count clauses))
(assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses}) (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses})
(panic parser "Expected one or more loop clauses" #{::token/rbrace})) (panic parser "Expected one or more loop clauses" #{::token/rbrace}))
@ -794,8 +793,7 @@
:clauses [(::ast clause)]})))) :clauses [(::ast clause)]}))))
(panic parser "Expected with after loop expression"))) (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] (defn- parse-recur [parser]
(let [next (advance parser)] (let [next (advance parser)]
@ -803,21 +801,17 @@
(let [tuple (parse-tuple next)] (let [tuple (parse-tuple next)]
(assoc tuple ::ast {::ast/type ::ast/recur (assoc tuple ::ast {::ast/type ::ast/recur
:token (current parser) :token (current parser)
:tuple (::ast tuple)}) :tuple (::ast tuple)}))
) (panic parser "Expected tuple after recur"))))
(panic parser "Expected tuple after recur")
)
)
)
(defn- parse-cond-clause [parser] (defn- parse-cond-clause [parser]
(let [expr (if (let [expr (if
(contains? #{::token/else ::token/placeholder} (token-type parser)) (contains? #{::token/else ::token/placeholder} (token-type parser))
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/atom (assoc ::ast {::ast/type ::ast/atom
:token (current parser) :token (current parser)
:value true})) :value true}))
(parse-expr parser)) (parse-expr parser))
rarrow (expect* #{::token/rarrow} "Expected arrow after expression in cond clause" expr)] rarrow (expect* #{::token/rarrow} "Expected arrow after expression in cond clause" expr)]
(if (:success rarrow) (if (:success rarrow)
@ -833,11 +827,10 @@
(let [curr (current parser)] (let [curr (current parser)]
(case (::token/type curr) (case (::token/type curr)
::token/rbrace ::token/rbrace
(if (< 0 (count clauses)) (if (< 0 (count clauses))
(assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses}) (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses})
(panic parser "Expected one or more clauses" #{::rbrace})) (panic parser "Expected one or more clauses" #{::rbrace}))
::token/newline ::token/newline
(recur (accept-many #{::token/newline} parser) clauses) (recur (accept-many #{::token/newline} parser) clauses)
@ -845,18 +838,14 @@
(recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause))))))))
(defn- parse-cond [parser] (defn- parse-cond [parser]
(let [header (let [header
(expect* #{::token/lbrace} "Expected { after cond" (advance parser))] (expect* #{::token/lbrace} "Expected { after cond" (advance parser))]
(if (:success header) (if (:success header)
(let [clauses (parse-cond-clauses (:parser header))] (let [clauses (parse-cond-clauses (:parser header))]
(assoc clauses ::ast {::ast/type ::ast/cond (assoc clauses ::ast {::ast/type ::ast/cond
:token (current parser) :token (current parser)
:clauses (get-in clauses [::ast :clauses])}) :clauses (get-in clauses [::ast :clauses])}))
) (panic parser "Expected { after cond"))))
(panic parser "Expected { after cond")
)
)
)
(defn- parse-fn-clause [parser] (defn- parse-fn-clause [parser]
(if (not (= ::token/lparen (token-type parser))) (if (not (= ::token/lparen (token-type parser)))
@ -876,7 +865,7 @@
(let [curr (current parser)] (let [curr (current parser)]
(case (::token/type curr) (case (::token/type curr)
::token/rbrace ::token/rbrace
(if (< 0 (count clauses)) (if (< 0 (count clauses))
(assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses}) (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses})
(panic parser "Expected one or more function clauses" #{::token/rbrace})) (panic parser "Expected one or more function clauses" #{::token/rbrace}))
@ -930,8 +919,7 @@
(recur (advance expr+newline) (conj exprs (::ast expr))) (recur (advance expr+newline) (conj exprs (::ast expr)))
(assoc expr ::ast {::ast/type ::ast/pipeline (assoc expr ::ast {::ast/type ::ast/pipeline
:token (current parser) :token (current parser)
:exprs (conj exprs (::ast expr))}) :exprs (conj exprs (::ast expr))}))))))
)))))
(defn- parse-import [parser] (defn- parse-import [parser]
(let [path (parse-atom (advance parser)) (let [path (parse-atom (advance parser))
@ -941,8 +929,7 @@
nil) nil)
name (if (:success named?) name (if (:success named?)
(parse-word (:parser as)) (parse-word (:parser as))
nil nil)]
)]
(cond (cond
(not= ::token/string (token-type (advance parser))) (not= ::token/string (token-type (advance parser)))
(panic parser "Expected path after import" #{::token/newline}) (panic parser "Expected path after import" #{::token/newline})
@ -1042,9 +1029,9 @@
(defn parse [lexed] (defn parse [lexed]
(-> lexed (-> lexed
(:tokens) (:tokens)
(parser) (parser)
(parse-script))) (parse-script)))
(comment (comment
(def pp pp/pprint) (def pp pp/pprint)
@ -1063,9 +1050,9 @@
(println "*** *** NEW PARSE *** ***") (println "*** *** NEW PARSE *** ***")
(-> p (-> p
(parse-script) (parse-script)
(::ast) (::ast)
(pp))) (pp)))
(comment " (comment "
Further thoughts/still to do: Further thoughts/still to do:

53
src/ludus/prelude.clj
View File

@ -12,12 +12,12 @@
(defn- id [x] x) (defn- id [x] x)
(def and- {:name "and" (def and- {:name "and"
::data/type ::data/clj ::data/type ::data/clj
:body (fn [&args] (every? id &args))}) :body (fn [&args] (every? id &args))})
(def or- {:name "or" (def or- {:name "or"
::data/type ::data/clj ::data/type ::data/clj
:body (fn [&args] (some id &args))}) :body (fn [&args] (some id &args))})
(def add {:name "add" (def add {:name "add"
::data/type ::data/clj ::data/type ::data/clj
@ -36,12 +36,12 @@
:body /}) :body /})
(def inc- {:name "inc" (def inc- {:name "inc"
::data/type ::data/clj ::data/type ::data/clj
:body inc}) :body inc})
(def dec- {:name "dec" (def dec- {:name "dec"
::data/type ::data/clj ::data/type ::data/clj
:body dec}) :body dec})
(def ld-not {:name "not" (def ld-not {:name "not"
::data/type ::data/clj ::data/type ::data/clj
@ -52,30 +52,28 @@
:body (fn [& args] (throw (ex-info (apply str (interpose " " args)) {})))}) :body (fn [& args] (throw (ex-info (apply str (interpose " " args)) {})))})
(def print- {:name "print" (def print- {:name "print"
::data/type ::data/clj ::data/type ::data/clj
:body (fn [& args] :body (fn [& args]
(println (apply str args)) (println (apply str args))
:ok)}) :ok)})
(def deref- {:name "deref" (def deref- {:name "deref"
::data/type ::data/clj ::data/type ::data/clj
:body (fn [ref] :body (fn [ref]
(if (::data/ref ref) (if (::data/ref ref)
(deref (::data/value ref)) (deref (::data/value ref))
(throw (ex-info "Cannot deref something that is not a ref" {})) (throw (ex-info "Cannot deref something that is not a ref" {}))))})
))})
(def set!- {:name "set!" (def set!- {:name "set!"
::data/type ::data/clj ::data/type ::data/clj
:body (fn [ref value] :body (fn [ref value]
(if (::data/ref ref) (if (::data/ref ref)
(reset! (::data/value ref) value) (reset! (::data/value ref) value)
(throw (ex-info "Cannot set! something that is not a ref" {})) (throw (ex-info "Cannot set! something that is not a ref" {}))))})
))})
(def show {:name "show" (def show {:name "show"
::data/type ::data/clj ::data/type ::data/clj
:body ludus.show/show}) :body ludus.show/show})
(def prelude {"eq" eq (def prelude {"eq" eq
"add" add "add" add
@ -91,5 +89,4 @@
"deref" deref- "deref" deref-
"set!" set!- "set!" set!-
"and" and- "and" and-
"or" or- "or" or-})
})

97
src/ludus/repl.clj
View File

@ -1,11 +1,11 @@
(ns ludus.repl (ns ludus.repl
(:require (:require
[ludus.scanner :as scanner] [ludus.scanner :as scanner]
[ludus.parser :as parser] [ludus.parser :as parser]
[ludus.interpreter :as interpreter] [ludus.interpreter :as interpreter]
[ludus.prelude :as prelude] [ludus.prelude :as prelude]
[ludus.show :as show] [ludus.show :as show]
[ludus.data :as data])) [ludus.data :as data]))
(declare repl-prelude new-session) (declare repl-prelude new-session)
@ -15,63 +15,60 @@
(def prompt "=> ") (def prompt "=> ")
(def base-ctx (merge prelude/prelude (def base-ctx (merge prelude/prelude
{::repl true {::repl true
"repl" "repl"
{ {::data/struct true
::data/struct true ::data/type ::data/ns
::data/type ::data/ns ::data/name "repl"
::data/name "repl"
:flush :flush
{:name "flush" {:name "flush"
::data/type ::data/clj ::data/type ::data/clj
:body (fn [] :body (fn []
(let [session @current-session] (let [session @current-session]
(swap! session #(assoc % :ctx (volatile! base-ctx))) (swap! session #(assoc % :ctx (volatile! base-ctx)))
:ok))} :ok))}
:new :new
{:name "new" {:name "new"
::data/type ::data/clj ::data/type ::data/clj
:body (fn [name] :body (fn [name]
(let [session (new-session name)] (let [session (new-session name)]
(reset! current-session session) (reset! current-session session)
:ok))} :ok))}
:swap :switch
{:name "swap" {:name "switch"
::data/type ::data/clj ::data/type ::data/clj
:body (fn [name] :body (fn [name]
(if-let [session (get @sessions name)] (if-let [session (get @sessions name)]
(do (do
(reset! current-session session) (reset! current-session session)
:ok) :ok)
(do (do
(println "No session named" name) (println "No session named" name)
:error)))} :error)))}}}))
}}))
(defn- new-session [name] (defn- new-session [name]
(let [session (atom { (let [session (atom {:name name
:name name :ctx (volatile! base-ctx)
:ctx (volatile! base-ctx)
:history []})] :history []})]
(swap! sessions #(assoc % name session)) (swap! sessions #(assoc % name session))
session)) session))
(defn- exit [] (defn- exit []
(println "\nGoodbye!") (println "\nGoodbye!")
(System/exit 0)) (System/exit 0))
(defn repl-loop [] (defn repl-loop []
(let [session-atom @current-session (let [session-atom @current-session
session @session-atom session @session-atom
orig-ctx (:ctx session)] orig-ctx (:ctx session)]
(print (str (:name session) prompt)) (print (str (:name session) prompt))
(flush) (flush)
(let [raw-input (read-line) (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)) parsed (-> input (scanner/scan) (parser/parse))
{result :result ctx :ctx} (interpreter/interpret-repl parsed (:ctx session))] {result :result ctx :ctx} (interpreter/interpret-repl parsed (:ctx session))]
(if (= result ::interpreter/error) (if (= result ::interpreter/error)
@ -79,7 +76,7 @@
(do (do
(println (show/show result)) (println (show/show result))
(when (not (= @ctx @orig-ctx)) (when (not (= @ctx @orig-ctx))
(swap! session-atom #(assoc % :ctx ctx))) (swap! session-atom #(assoc % :ctx ctx)))
(repl-loop)))))) (repl-loop))))))
(defn launch [] (defn launch []

46
src/ludus/scanner.clj
View File

@ -1,14 +1,13 @@
(ns ludus.scanner (ns ludus.scanner
(:require (:require
[ludus.token :as token] [ludus.token :as token]
[clojure.pprint :as pp] [clojure.pprint :as pp]
[clojure.edn :as edn])) [clojure.edn :as edn]))
(def reserved-words (def reserved-words
"List of Ludus reserved words." "List of Ludus reserved words."
;; see ludus-spec repo for more info ;; 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 "cond" ::token/cond ;; impl
"do" ::token/do ;; impl "do" ::token/do ;; impl
"else" ::token/else ;; impl "else" ::token/else ;; impl
@ -36,12 +35,12 @@
"spawn" ::token/spawn "spawn" ::token/spawn
"to" ::token/to "to" ::token/to
;; type system ;; type system
"data" ::token/data "data" ::token/data
;; others ;; others
"repeat" ::token/repeat ;; syntax sugar over "loop" "repeat" ::token/repeat ;; syntax sugar over "loop"
"test" ::token/test "test" ::token/test
"when" ::token/when "when" ::token/when
;; below here, possibly not ;; below here, possibly not
;; generators (sugar over actors?) ;; generators (sugar over actors?)
"gen" ::token/gen "gen" ::token/gen
@ -51,8 +50,7 @@
"wait" ::token/wait "wait" ::token/wait
;; vars ;; vars
"mut" ::token/mut "mut" ::token/mut
"var" ::token/var "var" ::token/var})
})
(defn- new-scanner (defn- new-scanner
"Creates a new scanner." "Creates a new scanner."
@ -91,8 +89,8 @@
(defn- char-in-range? [start end char] (defn- char-in-range? [start end char]
(and char (and char
(>= (int char) (int start)) (>= (int char) (int start))
(<= (int char) (int end)))) (<= (int char) (int end))))
(defn- digit? [c] (defn- digit? [c]
(char-in-range? \0 \9 c)) (char-in-range? \0 \9 c))
@ -125,27 +123,27 @@
(add-token scanner token-type nil)) (add-token scanner token-type nil))
([scanner token-type literal] ([scanner token-type literal]
(update scanner ::tokens conj (update scanner ::tokens conj
(token/token (token/token
token-type token-type
(current-lexeme scanner) (current-lexeme scanner)
literal literal
(::line scanner) (::line scanner)
(::start scanner))))) (::start scanner)))))
;; TODO: errors should also be in the vector of tokens ;; 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? ;; The goal is to be able to be able to hand this to an LSP?
;; Do we need a different structure ;; Do we need a different structure
(defn- add-error [scanner msg] (defn- add-error [scanner msg]
(let [token (token/token (let [token (token/token
::token/error ::token/error
(current-lexeme scanner) (current-lexeme scanner)
nil nil
(::line scanner) (::line scanner)
(::start scanner)) (::start scanner))
err-token (assoc token :message msg)] err-token (assoc token :message msg)]
(-> scanner (-> scanner
(update ::errors conj err-token) (update ::errors conj err-token)
(update ::tokens conj err-token)))) (update ::tokens conj err-token))))
(defn- add-keyword (defn- add-keyword
[scanner] [scanner]

24
src/ludus/show.clj
View File

@ -1,7 +1,7 @@
(ns ludus.show (ns ludus.show
(:require (:require
[ludus.data :as data] [ludus.data :as data]
[clojure.pprint :as pp])) [clojure.pprint :as pp]))
(declare show show-linear show-keyed) (declare show show-linear show-keyed)
@ -13,27 +13,25 @@
(defn- show-map [v] (defn- show-map [v]
(cond (cond
(or (= (::data/type v) ::data/fn) (or (= (::data/type v) ::data/fn)
(= (::data/type v) ::data/clj)) (= (::data/type v) ::data/clj))
(str "fn " (:name v)) (str "fn " (:name v))
(= (::data/type v) ::data/ns) (= (::data/type v) ::data/ns)
(str "ns " (::data/name v) " {" (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))) "}") (str "@{" (apply str (into [] show-keyed (dissoc v ::data/struct))) "}")
(::data/ref v) ;; TODO: reconsider this (::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) (::data/hashmap v)
(str "#{" (apply str (into [] show-keyed (dissoc v ::data/hashmap))) "}") (str "#{" (apply str (into [] show-keyed (dissoc v ::data/hashmap))) "}")
:else :else
(pp/pprint v) (pp/pprint v)))
))
(defn- show-set [v] (defn- show-set [v]
(str "${" (apply str (into [] show-linear v)) "}")) (str "${" (apply str (into [] show-linear v)) "}"))
@ -52,8 +50,8 @@
(def show-linear (comp (map show) (interpose ", "))) (def show-linear (comp (map show) (interpose ", ")))
(def show-keyed (comp (def show-keyed (comp
(map #(str (show (first %)) " " (show (second %)))) (map #(str (show (first %)) " " (show (second %))))
(interpose ", "))) (interpose ", ")))
(show {::data/type ::data/fn :name "foo"}) (show {::data/type ::data/fn :name "foo"})

10
src/ludus/token.clj
View File

@ -2,8 +2,8 @@
(defn token (defn token
[type text literal line start] [type text literal line start]
{::type type {::type type
::lexeme text ::lexeme text
::literal literal ::literal literal
::line line ::line line
::start start}) ::start start})