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

cljfmt all the things

Browse Source
This commit is contained in:
Scott Richmond 2022-03-20 17:58:38 -04:00
parent 59ccc00963
commit bfef7a8e66
5 changed files with 245 additions and 353 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/ludus/analyzer.clj
View File

@ -1,7 +1,7 @@
(ns ludus.analyzer (ns ludus.analyzer
(:require (:require
[ludus.ast :as ast] [ludus.ast :as ast]
[ludus.token :as token])) [ludus.token :as token]))
(defn analyze [ast] ast) (defn analyze [ast] ast)

100
src/ludus/interpreter.clj
View File

@ -1,11 +1,11 @@
(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.collections :as colls] [ludus.collections :as colls]
[ludus.prelude :as prelude] [ludus.prelude :as prelude]
[clojure.pprint :as pp])) [clojure.pprint :as pp]))
;; right now this is not very efficient: ;; right now this is not very efficient:
;; it's got runtime checking ;; it's got runtime checking
@ -51,23 +51,20 @@
(let [match-value (:value pattern)] (let [match-value (:value pattern)]
(if (= match-value value) (if (= match-value value)
{:success true :ctx {}} {:success true :ctx {}}
{:success false {:success false
:reason (str "No match: Could not match " match-value " with " value)})) :reason (str "No match: Could not match " match-value " with " value)}))
::ast/word ::ast/word
(let [word (:word pattern)] (let [word (:word pattern)]
(if (contains? ctx word) (if (contains? ctx word)
{:success false :reason (str "Name " word " is already bound")} {:success false :reason (str "Name " word " is already bound")}
{:success true :ctx {word value}} {:success true :ctx {word value}}))
))
::ast/tuple (match-tuple pattern value ctx-atom) ::ast/tuple (match-tuple pattern value ctx-atom)
(do (do
(println "ERROR! Unexpected pattern:") (println "ERROR! Unexpected pattern:")
(pp/pprint pattern) (pp/pprint pattern)))))
)
)))
(defn- update-ctx [ctx new-ctx] (defn- update-ctx [ctx new-ctx]
(println "Adding to context:") (println "Adding to context:")
@ -85,8 +82,7 @@
(if success (if success
(swap! ctx update-ctx (:ctx match)) (swap! ctx update-ctx (:ctx match))
(throw (ex-info (:reason match) {}))) (throw (ex-info (:reason match) {})))
value value))
))
(defn- interpret-if [ast ctx] (defn- interpret-if [ast ctx]
(let [if-expr (:if ast) (let [if-expr (:if ast)
@ -95,8 +91,7 @@
if-value (interpret if-expr ast)] if-value (interpret if-expr ast)]
(if if-value (if if-value
(interpret then-expr ctx) (interpret then-expr ctx)
(interpret else-expr ctx) (interpret else-expr ctx))))
)))
(defn- interpret-match [ast ctx] (defn- interpret-match [ast ctx]
(let [match-expr (:expr ast) (let [match-expr (:expr ast)
@ -112,15 +107,11 @@
success (:success match?) success (:success match?)
clause-ctx (:ctx match?)] clause-ctx (:ctx match?)]
(if success (if success
(do (do
(swap! new-ctx #(merge % clause-ctx)) (swap! new-ctx #(merge % clause-ctx))
(interpret body new-ctx)) (interpret body new-ctx))
(recur (first clauses) (rest clauses)) (recur (first clauses) (rest clauses))))
)) (throw (ex-info "Match Error: No match found" {}))))))
(throw (ex-info "Match Error: No match found" {}))
))
)
)
(defn- interpret-called-kw [kw tuple ctx] (defn- interpret-called-kw [kw tuple ctx]
(if (not (= 1 (:length tuple))) (if (not (= 1 (:length tuple)))
@ -128,30 +119,21 @@
(throw (ex-info "Called keywords must be unary" {})) (throw (ex-info "Called keywords must be unary" {}))
(let [kw (interpret kw ctx) (let [kw (interpret kw ctx)
map (second (interpret tuple ctx))] map (second (interpret tuple ctx))]
(get map kw) (get map kw))))
)
)
)
(defn- call-fn [fn tuple ctx] (defn- call-fn [fn tuple ctx]
(let [passed (interpret tuple ctx)] (let [passed (interpret tuple ctx)]
(case (::ast/type fn) (case (::ast/type fn)
::ast/clj (apply (:body fn) (next passed)) ::ast/clj (apply (:body fn) (next passed))
(throw (ex-info "I don't know how to call that" {:fn fn})) (throw (ex-info "I don't know how to call that" {:fn fn})))))
)
))
;; TODO: add placeholder partial application ;; TODO: add placeholder partial application
(defn- interpret-synthetic-term [prev-value curr ctx] (defn- interpret-synthetic-term [prev-value curr ctx]
(let [type (::ast/type curr)] (let [type (::ast/type curr)]
(if (= type ::ast/atom) (if (= type ::ast/atom)
(get prev-value (:value curr)) (get prev-value (:value curr))
(call-fn prev-value curr ctx) (call-fn prev-value curr ctx))))
)
)
)
(defn- interpret-synthetic [ast ctx] (defn- interpret-synthetic [ast ctx]
(let [terms (:terms ast) (let [terms (:terms ast)
@ -161,13 +143,10 @@
first-term-type (::ast/type first) first-term-type (::ast/type first)
first-val (if (= first-term-type ::ast/atom) first-val (if (= first-term-type ::ast/atom)
(interpret-called-kw first second ctx) (interpret-called-kw first second ctx)
(interpret-synthetic-term (interpret first ctx) second ctx)) (interpret-synthetic-term (interpret first ctx) second ctx))]
] (reduce #(interpret-synthetic-term %1 %2 ctx) first-val rest)))
(reduce #(interpret-synthetic-term %1 %2 ctx) first-val rest)
)) (defn- map-values [f]
(defn- map-values [f]
(map (fn [kv] (map (fn [kv]
(let [[k v] kv] (let [[k v] kv]
[k (f v)])))) [k (f v)]))))
@ -193,20 +172,17 @@
last (peek exprs) last (peek exprs)
ctx (atom {::parent ctx})] ctx (atom {::parent ctx})]
(run! #(interpret % ctx) inner) (run! #(interpret % ctx) inner)
(interpret last ctx) (interpret last ctx))
)
::ast/script ::ast/script
(let [exprs (:exprs ast) (let [exprs (:exprs ast)
inner (pop exprs) inner (pop exprs)
last (peek exprs) last (peek exprs)
ctx (atom prelude/prelude) ctx (atom prelude/prelude)]
]
(run! #(interpret % ctx) inner) (run! #(interpret % ctx) inner)
(interpret last ctx) (interpret last ctx))
)
;; note that the runtime representations of collections is ;; note that the runtime representations of collections is
;; unboxed in the tree-walk interpreter ;; unboxed in the tree-walk interpreter
;; tuples & lists are both vectors, the first element ;; tuples & lists are both vectors, the first element
;; distinguishes them ;; distinguishes them
@ -226,12 +202,9 @@
(let [members (:members ast)] (let [members (:members ast)]
(into {} (map-values #(interpret % ctx)) members)) (into {} (map-values #(interpret % ctx)) members))
(do (do
(println "ERROR! Unexpected AST node:") (println "ERROR! Unexpected AST node:")
(pp/pprint ast) (pp/pprint ast))))
)
))
(do (do
@ -246,12 +219,11 @@
(println "") (println "")
(-> source (-> source
(scanner/scan) (scanner/scan)
(parser/parse) (parser/parse)
(::parser/ast) (::parser/ast)
(interpret {}) (interpret {})
(pp/pprint) (pp/pprint)))
))
(comment " (comment "

360
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]
@ -33,45 +33,37 @@
(declare parse-expr parse-word parse-pattern) (declare parse-expr parse-word parse-pattern)
;; handle some errors ;; handle some errors
(def sync-on #{ (def sync-on #{::token/newline
::token/newline
::token/semicolon ::token/semicolon
::token/comma ::token/comma
::token/rparen ::token/rparen
::token/rbracket ::token/rbracket
::token/rbrace ::token/rbrace
::token/eof ::token/eof})
})
(defn- sync [parser message origin end] (defn- sync [parser message origin end]
(let [poison { (let [poison {::ast/type ::ast/poison
::ast/type ::ast/poison
:message message :message message
: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])))
(defn- panic (defn- panic
([parser message] (panic parser message sync-on)) ([parser message] (panic parser message sync-on))
([parser message sync-on] ([parser message sync-on]
(println (str "PANIC!!! in the parser: " message)) (println (str "PANIC!!! in the parser: " message))
(let [ (let [sync-on (conj (if (set? sync-on) sync-on #{sync-on}) ::token/eof)
sync-on (conj (if (set? sync-on) sync-on #{sync-on}) ::token/eof) origin (current parser)]
origin (current parser)
]
(loop [parser parser] (loop [parser parser]
(let [ (let [curr (current parser)
curr (current parser) type (::token/type curr)]
type (::token/type curr)
]
(if (or (at-end? parser) (contains? sync-on type)) (if (or (at-end? parser) (contains? sync-on type))
(sync parser message origin curr) (sync parser message origin curr)
(recur (advance parser)))))))) (recur (advance parser))))))))
;; some helper functions ;; some helper functions
@ -82,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)
@ -91,8 +83,7 @@
type (::token/type curr)] type (::token/type curr)]
(if (contains? tokens type) (if (contains? tokens type)
{:success true :parser (advance parser)} {:success true :parser (advance parser)}
{:success false :parser (panic (advance parser) message)} {:success false :parser (panic (advance parser) message)})))
)))
(defn- accept [tokens parser] (defn- accept [tokens parser]
(let [curr (current parser) (let [curr (current parser)
@ -105,8 +96,7 @@
(defn- accept-many [tokens parser] (defn- accept-many [tokens parser]
(let [tokens (if (set? tokens) tokens #{tokens})] (let [tokens (if (set? tokens) tokens #{tokens})]
(loop [parser parser] (loop [parser parser]
(let [ (let [curr (current parser)
curr (current parser)
type (::token/type curr)] type (::token/type curr)]
(if (contains? tokens type) (if (contains? tokens type)
(recur (advance parser)) (recur (advance parser))
@ -116,27 +106,23 @@
(defn- parse-atom [parser] (defn- parse-atom [parser]
(let [token (current parser)] (let [token (current parser)]
(-> parser (-> parser
(advance) (advance)
(assoc ::ast { (assoc ::ast {::ast/type ::ast/atom
::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 { (def atomic-words {::token/nil nil
::token/nil nil
::token/true true ::token/true true
::token/false false}) ::token/false false})
(defn parse-atomic-word [parser] (defn parse-atomic-word [parser]
(let [token (current parser)] (let [token (current parser)]
(-> parser (-> parser
(advance) (advance)
(assoc ::ast { (assoc ::ast {::ast/type ::ast/atom
::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)
@ -144,104 +130,96 @@
(conj members member))) (conj members member)))
(defn- parse-tuple [origin] (defn- parse-tuple [origin]
(loop [ (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
parser (accept-many #{::token/newline ::token/comma} (advance origin))
members [] members []
current_member nil current_member nil]
]
(let [curr (current parser)] (let [curr (current parser)]
(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/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/eof ::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof)
(let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rparen})] (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rparen})]
(recur parsed members (::ast parsed))))))) (recur parsed members (::ast parsed)))))))
(defn- parse-list [origin] (defn- parse-list [origin]
(loop [ (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
parser (accept-many #{::token/newline ::token/comma} (advance origin))
members [] members []
current_member nil current_member nil]
]
(let [curr (current parser)] (let [curr (current parser)]
(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
: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)))
::token/eof ::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated list" ::token/eof) (panic (assoc origin ::errors (::errors parser)) "Unterminated list" ::token/eof)
(let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbracket})] (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbracket})]
(recur parsed members (::ast parsed))))))) (recur parsed members (::ast parsed)))))))
(defn- parse-set [origin] (defn- parse-set [origin]
(loop [ (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
parser (accept-many #{::token/newline ::token/comma} (advance origin))
members [] members []
current_member nil current_member nil]
]
(let [curr (current parser)] (let [curr (current parser)]
(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
: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)))
::token/eof ::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated set" ::token/eof) (panic (assoc origin ::errors (::errors parser)) "Unterminated set" ::token/eof)
(let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbrace})] (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbrace})]
(recur parsed members (::ast parsed))))))) (recur parsed members (::ast parsed)))))))
(defn- parse-hash [origin] (defn- parse-hash [origin]
(loop [ (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
parser (accept-many #{::token/newline ::token/comma} (advance origin))
members {} members {}
current_member nil current_member nil]
]
(let [curr (current parser)] (let [curr (current parser)]
(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/hash {::ast/type ::ast/hash
: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)))
@ -252,40 +230,34 @@
::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 "Hashmap entries must be single words or keyword+expression pairs." #{::token/rbrace}) (panic parser "Hashmap 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})]
(println "found keyword/expr pair:" (:value kw)) (println "found keyword/expr pair:" (:value kw))
(pp/pprint (::ast expr)) (pp/pprint (::ast expr))
(recur expr members {(:value (::ast kw)) (::ast expr)})) (recur expr members {(:value (::ast kw)) (::ast expr)}))
(panic parser "Hashmap entries must be single words or keyword+expression pairs." #{::token/rbrace}) (panic parser "Hashmap entries must be single words or keyword+expression pairs." #{::token/rbrace}))
)
(panic parser "Hashmap entries must be single words or keyword+expression pairs" #{::token/rbrace}))))) (panic parser "Hashmap entries must be single words or keyword+expression pairs" #{::token/rbrace})))))
(defn- parse-block [origin] (defn- parse-block [origin]
(loop [ (loop [parser (accept-many #{::token/newline ::token/semicolon} (advance origin))
parser (accept-many #{::token/newline ::token/semicolon} (advance origin))
exprs [] exprs []
current_expr nil current_expr nil]
]
(let [curr (current parser)] (let [curr (current parser)]
(case (token-type parser) (case (token-type parser)
::token/rbrace ::token/rbrace
(let [es (add-member exprs current_expr)] (let [es (add-member exprs current_expr)]
(if (empty? es) (if (empty? es)
(advance (panic parser "Blocks must have at least one expression")) (advance (panic parser "Blocks must have at least one expression"))
(assoc (advance parser) ::ast { (assoc (advance parser) ::ast {::ast/type ::ast/block
::ast/type ::ast/block :exprs es})))
:exprs es
})))
(::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)))
@ -293,38 +265,34 @@
::token/eof ::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated block" ::token/eof) (panic (assoc origin ::errors (::errors parser)) "Unterminated block" ::token/eof)
(let [parsed
(let [parsed
(if current_expr (if current_expr
(panic parser "Expected end of expression" #{::token/semicolon ::token/newline}) (panic parser "Expected end of expression" #{::token/semicolon ::token/newline})
(parse-expr parser))] (parse-expr parser))]
(recur parsed exprs (::ast parsed))))))) (recur parsed exprs (::ast parsed)))))))
(defn parse-script [parser] (defn parse-script [parser]
(loop [ (loop [parser (accept-many #{::token/newline ::token/semicolon} parser)
parser (accept-many #{::token/newline ::token/semicolon} parser)
exprs [] exprs []
current_expr nil current_expr nil]
]
(case (token-type parser) (case (token-type parser)
::token/eof ::token/eof
(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 :exprs es}))) (assoc parser ::ast {::ast/type ::ast/script :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
(panic parser "Expected end of expression" #{::token/semicolon ::token/newline}) (panic parser "Expected end of expression" #{::token/semicolon ::token/newline})
(parse-expr parser) (parse-expr parser))]
)
]
(recur parsed exprs (::ast parsed)))))) (recur parsed exprs (::ast parsed))))))
(defn- parse-synthetic [parser] (defn- parse-synthetic [parser]
@ -333,52 +301,48 @@
(let [curr (current parser) (let [curr (current parser)
type (::token/type curr)] type (::token/type curr)]
(case type (case type
::token/keyword ::token/keyword
(recur (advance parser) (conj terms (::ast (parse-atom parser)))) (recur (advance parser) (conj terms (::ast (parse-atom parser))))
::token/word ::token/word
(recur (advance parser) (conj terms (::ast (parse-word parser)))) (recur (advance parser) (conj terms (::ast (parse-word parser))))
::token/lparen ::token/lparen
(let [parsed (parse-tuple parser)] (let [parsed (parse-tuple parser)]
(recur parsed (conj terms (::ast parsed)))) (recur parsed (conj terms (::ast parsed))))
(assoc parser ::ast {::ast/type ::ast/synthetic :terms terms}) (assoc parser ::ast {::ast/type ::ast/synthetic :terms terms})))))
))))
(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 :word (::token/lexeme curr)})))) (assoc ::ast {::ast/type ::ast/word :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}))
(defn- parse-tuple-pattern [origin] (defn- parse-tuple-pattern [origin]
(loop [ (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
parser (accept-many #{::token/newline ::token/comma} (advance origin))
members [] members []
current_member nil current_member nil]
]
(let [curr (current parser)] (let [curr (current parser)]
(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/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/eof ::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof)
(let [parsed (parse-pattern parser)] (let [parsed (parse-pattern parser)]
(recur parsed members (::ast parsed))))))) (recur parsed members (::ast parsed)))))))
@ -387,9 +351,9 @@
(let [curr (current parser) (let [curr (current parser)
type (::token/type curr)] type (::token/type curr)]
(case type (case type
::token/placeholder (-> parser ::token/placeholder (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/placeholder})) (assoc ::ast {::ast/type ::ast/placeholder}))
::token/word (parse-word parser) ::token/word (parse-word parser)
@ -400,8 +364,7 @@
::token/error ::token/error
(panic parser (:message (current parser)) sync-pattern) (panic parser (:message (current parser)) sync-pattern)
(panic parser "Expected pattern" sync-pattern) (panic parser "Expected pattern" sync-pattern))))
)))
(defn- parse-let-expr [parser pattern] (defn- parse-let-expr [parser pattern]
(let [expr (parse-expr parser)] (let [expr (parse-expr parser)]
@ -444,25 +407,19 @@
(defn- parse-if [parser] (defn- parse-if [parser]
(let [if-expr (parse-expr (advance parser) #{::token/newline ::token/then}) (let [if-expr (parse-expr (advance parser) #{::token/newline ::token/then})
ast (assoc if-expr ::ast {::ast/type ::ast/if :if (::ast if-expr)})] ast (assoc if-expr ::ast {::ast/type ::ast/if :if (::ast if-expr)})]
(parse-then (accept ::token/newline ast)) (parse-then (accept ::token/newline ast))))
))
(defn- parse-match-clause [parser] (defn- parse-match-clause [parser]
(let [pattern (parse-pattern parser) (let [pattern (parse-pattern parser)
rarrow (expect* #{::token/rarrow} "Expected arrow after pattern" pattern) rarrow (expect* #{::token/rarrow} "Expected arrow after pattern" pattern)]
]
(if (:success rarrow) (if (:success rarrow)
(let [body (parse-expr (:parser rarrow))] (let [body (parse-expr (:parser rarrow))]
(assoc body ::ast {::ast/type ::ast/clause (assoc body ::ast {::ast/type ::ast/clause
:pattern (::ast pattern) :body (::ast body)}) :pattern (::ast pattern) :body (::ast body)}))
) (panic pattern "Expected -> in match clause. Clauses must be in the form pattern -> expression" #{::token/newline ::token/rbrace}))))
(panic pattern "Expected -> in match clause. Clauses must be in the form pattern -> expression" #{::token/newline ::token/rbrace})
)
))
(defn- parse-match-clauses [parser] (defn- parse-match-clauses [parser]
(loop [ (loop [parser (accept-many #{::token/newline} (advance parser))
parser (accept-many #{::token/newline} (advance parser))
clauses []] clauses []]
(let [curr (current parser)] (let [curr (current parser)]
(case (::token/type curr) (case (::token/type curr)
@ -471,13 +428,9 @@
::token/newline ::token/newline
(recur (accept-many #{::token/newline} parser) clauses) (recur (accept-many #{::token/newline} parser) clauses)
(let [clause (parse-match-clause parser)] (let [clause (parse-match-clause parser)]
(recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause))) (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause))))))))
)
)
)
))
(defn- parse-match [parser] (defn- parse-match [parser]
(let [match-expr (parse-expr (advance parser) #{::token/with}) (let [match-expr (parse-expr (advance parser) #{::token/with})
@ -494,12 +447,9 @@
(let [clause (parse-match-clause clauses)] (let [clause (parse-match-clause clauses)]
(assoc clause ::ast {::ast/type ::ast/match (assoc clause ::ast {::ast/type ::ast/match
:expr (::ast match-expr) :expr (::ast match-expr)
:clauses [(::ast clause)]}) :clauses [(::ast clause)]}))))
)
))
(panic parser "Expected with after match expression") (panic parser "Expected with after match expression"))))
)))
(defn- parse-fn [parser] (defn- parse-fn [parser]
(let [first (advance parser)] (let [first (advance parser)]
@ -514,64 +464,57 @@
:clauses [{::ast/type ::ast/clause :clauses [{::ast/type ::ast/clause
:pattern (::ast pattern) :pattern (::ast pattern)
:body (::ast body)}]})) :body (::ast body)}]}))
(panic pattern "Expected arrow after pattern in fn clause") (panic pattern "Expected arrow after pattern in fn clause")))
)
)
;; TODO: finish this ;; TODO: finish this
;; right now it's broke ;; right now it's broke
::token/word ::token/word
(let [name (parse-word first) (let [name (parse-word first)
pattern (parse-tuple-pattern name) pattern (parse-tuple-pattern name)
arrow (expect* ::token/rarrow "Expected arrow after pattern" name) arrow (expect* ::token/rarrow "Expected arrow after pattern" name)
body (parse-expr (:parser arrow)) body (parse-expr (:parser arrow))]
] ())
(
) (panic parser "Expected name or clause after fn"))))
)
(panic parser "Expected name or clause after fn") (defn- parse-expr
)))
(defn- parse-expr
([parser] (parse-expr parser sync-on)) ([parser] (parse-expr parser sync-on))
([parser sync-on] ([parser sync-on]
(let [token (current parser)] (let [token (current parser)]
(case (::token/type token) (case (::token/type token)
(::token/number ::token/string) (::token/number ::token/string)
(parse-atom parser) (parse-atom parser)
::token/keyword ::token/keyword
(let [next (peek parser) (let [next (peek parser)
type (::token/type next)] type (::token/type next)]
(if (= type ::token/lparen) (if (= type ::token/lparen)
(parse-synthetic parser) (parse-synthetic parser)
(parse-atom parser))) (parse-atom parser)))
::token/word ::token/word
(let [next (peek parser) (let [next (peek parser)
type (::token/type next)] type (::token/type next)]
(case type (case type
(::token/lparen ::token/keyword) (parse-synthetic parser) (::token/lparen ::token/keyword) (parse-synthetic parser)
(parse-word parser))) (parse-word parser)))
(::token/nil ::token/true ::token/false) (::token/nil ::token/true ::token/false)
(parse-atomic-word parser) (parse-atomic-word parser)
::token/lparen (parse-tuple parser) ::token/lparen (parse-tuple parser)
::token/lbracket (parse-list parser) ::token/lbracket (parse-list parser)
::token/startset (parse-set parser) ::token/startset (parse-set parser)
::token/starthash (parse-hash parser) ::token/starthash (parse-hash parser)
::token/lbrace (parse-block parser) ::token/lbrace (parse-block parser)
::token/let (parse-let parser) ::token/let (parse-let parser)
::token/if (parse-if parser) ::token/if (parse-if parser)
::token/match (parse-match parser) ::token/match (parse-match parser)
@ -581,25 +524,22 @@
;; TODO: improve handling of comments? ;; TODO: improve handling of comments?
;; Scanner now just skips comments ;; Scanner now just skips comments
;; ::token/comment (advance parser) ;; ::token/comment (advance parser)
::token/error (panic parser (:message token) sync-on) ::token/error (panic parser (:message token) sync-on)
(::token/rparen ::token/rbrace ::token/rbracket) (::token/rparen ::token/rbrace ::token/rbracket)
(panic parser (str "Unbalanced enclosure: " (::token/lexeme token))) (panic parser (str "Unbalanced enclosure: " (::token/lexeme token)))
(::token/semicolon ::token/comma) (::token/semicolon ::token/comma)
(panic parser (str "Unexpected delimiter: " (::token/lexeme token))) (panic parser (str "Unexpected delimiter: " (::token/lexeme token)))
(panic parser "Expected expression" sync-on) (panic parser "Expected expression" sync-on)))))
))))
(defn parse [lexed] (defn parse [lexed]
(-> lexed (-> lexed
(:tokens) (:tokens)
(parser) (parser)
(parse-script) (parse-script)))
))
(do (do
(def pp pp/pprint) (def pp pp/pprint)
@ -617,11 +557,9 @@
(println "*** *** NEW PARSE *** ***") (println "*** *** NEW PARSE *** ***")
(-> p (-> p
(parse-fn) (parse-fn)
(::ast) (::ast)
(pp) (pp)))
)
)
(comment " (comment "
Further thoughts/still to do: Further thoughts/still to do:

50
src/ludus/prelude.clj
View File

@ -1,36 +1,26 @@
(ns ludus.prelude (ns ludus.prelude
(:require (:require
[ludus.ast :as ast])) [ludus.ast :as ast]))
(def eq { (def eq {:name "eq"
:name "eq" ::ast/type ::ast/clj
::ast/type ::ast/clj :body =})
:body =
})
(def add { (def add {:name "add"
:name "add" ::ast/type ::ast/clj
::ast/type ::ast/clj :body +})
:body +
})
(def panic { (def panic {:name "panic"
:name "panic" ::ast/type ::ast/clj
::ast/type ::ast/clj :body (fn [& args] (throw (ex-info "Ludus panicked!" {:args args})))})
:body (fn [& args] (throw (ex-info "Ludus panicked!" {:args args})))
})
(def print { (def print {:name "print"
:name "print" ::ast/type ::ast/clj
::ast/type ::ast/clj :body (fn [& args]
:body (fn [& args] (println (str args))
(println (str args)) :ok)})
:ok)
})
(def prelude { (def prelude {"eq" eq
"eq" eq "add" add
"add" add "panic" panic
"panic" panic "print" print})
"print" print
})

82
src/ludus/scanner.clj
View File

@ -1,15 +1,14 @@
(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]
[clojure.string :as s])) [clojure.string :as s]))
(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
"as" ::token/as
"cond" ::token/cond "cond" ::token/cond
"do" ::token/do "do" ::token/do
"else" ::token/else "else" ::token/else
@ -37,11 +36,9 @@
"wait" ::token/wait "wait" ::token/wait
"yield" ::token/yield "yield" ::token/yield
;; below here, possible ;; below here, possible
"when" ::token/when "when" ::token/when})
})
(defn- new-scanner
(defn- new-scanner
"Creates a new scanner." "Creates a new scanner."
[source] [source]
{::source source {::source source
@ -52,34 +49,34 @@
::line 1 ::line 1
::tokens []}) ::tokens []})
(defn- at-end? (defn- at-end?
"Tests if a scanner is at end of input." "Tests if a scanner is at end of input."
[scanner] [scanner]
(>= (::current scanner) (::length scanner))) (>= (::current scanner) (::length scanner)))
(defn- current-char (defn- current-char
"Gets the current character of the scanner." "Gets the current character of the scanner."
[scanner] [scanner]
(nth (::source scanner) (::current scanner) nil)) (nth (::source scanner) (::current scanner) nil))
(defn- advance (defn- advance
"Advances the scanner by a single character." "Advances the scanner by a single character."
[scanner] [scanner]
(update scanner ::current inc)) (update scanner ::current inc))
(defn- next-char (defn- next-char
"Gets the next character from the scanner." "Gets the next character from the scanner."
[scanner] [scanner]
(current-char (advance scanner))) (current-char (advance scanner)))
(defn- current-lexeme (defn- current-lexeme
[scanner] [scanner]
(subs (::source scanner) (::start scanner) (::current scanner))) (subs (::source scanner) (::start scanner) (::current scanner)))
(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))
@ -93,7 +90,6 @@
(defn- alpha? [c] (defn- alpha? [c]
(or (char-in-range? \a \z c) (char-in-range? \A \Z c))) (or (char-in-range? \a \z c) (char-in-range? \A \Z c)))
;; legal characters in words ;; legal characters in words
(def word-chars #{\_ \? \! \* \/}) (def word-chars #{\_ \? \! \* \/})
@ -112,32 +108,30 @@
([scanner token-type] ([scanner token-type]
(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 [ (let [token (token/token
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]
(loop [scanner scanner (loop [scanner scanner
key ""] key ""]
@ -166,7 +160,7 @@
;; TODO: add string interpolation ;; TODO: add string interpolation
;; This still has to be devised ;; This still has to be devised
(defn- add-string (defn- add-string
[scanner] [scanner]
(loop [scanner scanner (loop [scanner scanner
string ""] string ""]
@ -183,7 +177,7 @@
(add-error scanner "Unterminated string.") (add-error scanner "Unterminated string.")
(recur (advance scanner) (str string char))))))) (recur (advance scanner) (str string char)))))))
(defn- add-word (defn- add-word
[char scanner] [char scanner]
(loop [scanner scanner (loop [scanner scanner
word (str char)] word (str char)]
@ -268,7 +262,7 @@
;; placeholders ;; placeholders
;; there's a flat _, and then ignored words ;; there's a flat _, and then ignored words
\_ (cond \_ (cond
(terminates? next) (add-token scanner ::token/placeholder) (terminates? next) (add-token scanner ::token/placeholder)
(alpha? next) (add-ignored scanner) (alpha? next) (add-ignored scanner)
:else (add-error scanner (str "Expected placeholder: _. Got " char next))) :else (add-error scanner (str "Expected placeholder: _. Got " char next)))
@ -310,13 +304,11 @@
(loop [scanner (new-scanner source)] (loop [scanner (new-scanner source)]
(if (at-end? scanner) (if (at-end? scanner)
(let [scanner (add-token scanner ::token/eof)] (let [scanner (add-token scanner ::token/eof)]
{:tokens (::tokens scanner) {:tokens (::tokens scanner)
:errors (::errors scanner)}) :errors (::errors scanner)})
(recur (-> scanner (scan-token) (next-token)))))) (recur (-> scanner (scan-token) (next-token))))))
(do (do
(def source "abc nil") (def source "abc nil")
(pp/pprint (scan source)) (pp/pprint (scan source)))
)