cljfmt all the things
This commit is contained in:
Scott Richmond
parent
59ccc00963
commit
bfef7a8e66
|
|
@ -1,7 +1,7 @@
|
|||
(ns ludus.analyzer
|
||||
(:require
|
||||
[ludus.ast :as ast]
|
||||
[ludus.token :as token]))
|
||||
(:require
|
||||
[ludus.ast :as ast]
|
||||
[ludus.token :as token]))
|
||||
|
||||
(defn analyze [ast] ast)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
(ns ludus.interpreter
|
||||
(:require
|
||||
[ludus.parser :as parser]
|
||||
[ludus.scanner :as scanner]
|
||||
[ludus.ast :as ast]
|
||||
[ludus.collections :as colls]
|
||||
[ludus.prelude :as prelude]
|
||||
[clojure.pprint :as pp]))
|
||||
[ludus.parser :as parser]
|
||||
[ludus.scanner :as scanner]
|
||||
[ludus.ast :as ast]
|
||||
[ludus.collections :as colls]
|
||||
[ludus.prelude :as prelude]
|
||||
[clojure.pprint :as pp]))
|
||||
|
||||
;; right now this is not very efficient:
|
||||
;; it's got runtime checking
|
||||
|
|
@ -51,23 +51,20 @@
|
|||
(let [match-value (:value pattern)]
|
||||
(if (= match-value value)
|
||||
{:success true :ctx {}}
|
||||
{:success false
|
||||
{:success false
|
||||
:reason (str "No match: Could not match " match-value " with " value)}))
|
||||
|
||||
|
||||
::ast/word
|
||||
(let [word (:word pattern)]
|
||||
(if (contains? ctx word)
|
||||
{: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)
|
||||
|
||||
|
||||
(do
|
||||
(println "ERROR! Unexpected pattern:")
|
||||
(pp/pprint pattern)
|
||||
)
|
||||
)))
|
||||
(pp/pprint pattern)))))
|
||||
|
||||
(defn- update-ctx [ctx new-ctx]
|
||||
(println "Adding to context:")
|
||||
|
|
@ -85,8 +82,7 @@
|
|||
(if success
|
||||
(swap! ctx update-ctx (:ctx match))
|
||||
(throw (ex-info (:reason match) {})))
|
||||
value
|
||||
))
|
||||
value))
|
||||
|
||||
(defn- interpret-if [ast ctx]
|
||||
(let [if-expr (:if ast)
|
||||
|
|
@ -95,8 +91,7 @@
|
|||
if-value (interpret if-expr ast)]
|
||||
(if if-value
|
||||
(interpret then-expr ctx)
|
||||
(interpret else-expr ctx)
|
||||
)))
|
||||
(interpret else-expr ctx))))
|
||||
|
||||
(defn- interpret-match [ast ctx]
|
||||
(let [match-expr (:expr ast)
|
||||
|
|
@ -112,15 +107,11 @@
|
|||
success (:success match?)
|
||||
clause-ctx (:ctx match?)]
|
||||
(if success
|
||||
(do
|
||||
(do
|
||||
(swap! new-ctx #(merge % clause-ctx))
|
||||
(interpret body new-ctx))
|
||||
(recur (first clauses) (rest clauses))
|
||||
))
|
||||
(throw (ex-info "Match Error: No match found" {}))
|
||||
))
|
||||
)
|
||||
)
|
||||
(recur (first clauses) (rest clauses))))
|
||||
(throw (ex-info "Match Error: No match found" {}))))))
|
||||
|
||||
(defn- interpret-called-kw [kw tuple ctx]
|
||||
(if (not (= 1 (:length tuple)))
|
||||
|
|
@ -128,30 +119,21 @@
|
|||
(throw (ex-info "Called keywords must be unary" {}))
|
||||
(let [kw (interpret kw ctx)
|
||||
map (second (interpret tuple ctx))]
|
||||
(get map kw)
|
||||
)
|
||||
)
|
||||
)
|
||||
(get map kw))))
|
||||
|
||||
(defn- call-fn [fn tuple ctx]
|
||||
(let [passed (interpret tuple ctx)]
|
||||
(case (::ast/type fn)
|
||||
::ast/clj (apply (:body fn) (next passed))
|
||||
(let [passed (interpret tuple ctx)]
|
||||
(case (::ast/type fn)
|
||||
::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
|
||||
(defn- interpret-synthetic-term [prev-value curr ctx]
|
||||
(let [type (::ast/type curr)]
|
||||
(if (= type ::ast/atom)
|
||||
(get prev-value (:value curr))
|
||||
(call-fn prev-value curr ctx)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(call-fn prev-value curr ctx))))
|
||||
|
||||
(defn- interpret-synthetic [ast ctx]
|
||||
(let [terms (:terms ast)
|
||||
|
|
@ -161,13 +143,10 @@
|
|||
first-term-type (::ast/type first)
|
||||
first-val (if (= first-term-type ::ast/atom)
|
||||
(interpret-called-kw first second ctx)
|
||||
(interpret-synthetic-term (interpret first ctx) second ctx))
|
||||
]
|
||||
(reduce #(interpret-synthetic-term %1 %2 ctx) first-val rest)
|
||||
(interpret-synthetic-term (interpret first ctx) second ctx))]
|
||||
(reduce #(interpret-synthetic-term %1 %2 ctx) first-val rest)))
|
||||
|
||||
))
|
||||
|
||||
(defn- map-values [f]
|
||||
(defn- map-values [f]
|
||||
(map (fn [kv]
|
||||
(let [[k v] kv]
|
||||
[k (f v)]))))
|
||||
|
|
@ -193,20 +172,17 @@
|
|||
last (peek exprs)
|
||||
ctx (atom {::parent ctx})]
|
||||
(run! #(interpret % ctx) inner)
|
||||
(interpret last ctx)
|
||||
)
|
||||
(interpret last ctx))
|
||||
|
||||
::ast/script
|
||||
(let [exprs (:exprs ast)
|
||||
inner (pop exprs)
|
||||
last (peek exprs)
|
||||
ctx (atom prelude/prelude)
|
||||
]
|
||||
ctx (atom prelude/prelude)]
|
||||
(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
|
||||
;; tuples & lists are both vectors, the first element
|
||||
;; distinguishes them
|
||||
|
|
@ -226,12 +202,9 @@
|
|||
(let [members (:members ast)]
|
||||
(into {} (map-values #(interpret % ctx)) members))
|
||||
|
||||
(do
|
||||
(do
|
||||
(println "ERROR! Unexpected AST node:")
|
||||
(pp/pprint ast)
|
||||
)
|
||||
|
||||
))
|
||||
(pp/pprint ast))))
|
||||
|
||||
(do
|
||||
|
||||
|
|
@ -246,12 +219,11 @@
|
|||
(println "")
|
||||
|
||||
(-> source
|
||||
(scanner/scan)
|
||||
(parser/parse)
|
||||
(::parser/ast)
|
||||
(interpret {})
|
||||
(pp/pprint)
|
||||
))
|
||||
(scanner/scan)
|
||||
(parser/parse)
|
||||
(::parser/ast)
|
||||
(interpret {})
|
||||
(pp/pprint)))
|
||||
|
||||
(comment "
|
||||
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
(ns ludus.parser
|
||||
(:require
|
||||
[ludus.token :as token]
|
||||
[ludus.scanner :as scanner]
|
||||
[ludus.ast :as ast]
|
||||
[clojure.pprint :as pp]
|
||||
[clojure.set :as s]))
|
||||
(:require
|
||||
[ludus.token :as token]
|
||||
[ludus.scanner :as scanner]
|
||||
[ludus.ast :as ast]
|
||||
[clojure.pprint :as pp]
|
||||
[clojure.set :as s]))
|
||||
|
||||
;; a parser map and some functions to work with them
|
||||
(defn- parser [tokens]
|
||||
|
|
@ -33,45 +33,37 @@
|
|||
(declare parse-expr parse-word parse-pattern)
|
||||
|
||||
;; handle some errors
|
||||
(def sync-on #{
|
||||
::token/newline
|
||||
(def sync-on #{::token/newline
|
||||
::token/semicolon
|
||||
::token/comma
|
||||
::token/rparen
|
||||
::token/rbracket
|
||||
::token/rbrace
|
||||
::token/eof
|
||||
})
|
||||
::token/eof})
|
||||
|
||||
(defn- sync [parser message origin end]
|
||||
(let [poison {
|
||||
::ast/type ::ast/poison
|
||||
(let [poison {::ast/type ::ast/poison
|
||||
:message message
|
||||
:origin origin
|
||||
:end end
|
||||
}]
|
||||
:end end}]
|
||||
(-> parser
|
||||
(assoc ::ast poison)
|
||||
(update ::errors conj poison))))
|
||||
(assoc ::ast poison)
|
||||
(update ::errors conj poison))))
|
||||
|
||||
(defn- poisoned? [parser]
|
||||
(= ::ast/poison (get-in parser [::ast ::ast/type])))
|
||||
|
||||
(defn- panic
|
||||
(defn- panic
|
||||
([parser message] (panic parser message sync-on))
|
||||
([parser message sync-on]
|
||||
(println (str "PANIC!!! in the parser: " message))
|
||||
(let [
|
||||
sync-on (conj (if (set? sync-on) sync-on #{sync-on}) ::token/eof)
|
||||
origin (current parser)
|
||||
]
|
||||
(let [sync-on (conj (if (set? sync-on) sync-on #{sync-on}) ::token/eof)
|
||||
origin (current parser)]
|
||||
(loop [parser parser]
|
||||
(let [
|
||||
curr (current parser)
|
||||
type (::token/type curr)
|
||||
]
|
||||
(let [curr (current parser)
|
||||
type (::token/type curr)]
|
||||
(if (or (at-end? parser) (contains? sync-on type))
|
||||
(sync parser message origin curr)
|
||||
(sync parser message origin curr)
|
||||
(recur (advance parser))))))))
|
||||
|
||||
;; some helper functions
|
||||
|
|
@ -82,8 +74,8 @@
|
|||
(if (contains? tokens type)
|
||||
(advance parser)
|
||||
(-> parser
|
||||
(advance)
|
||||
(panic message tokens)))))
|
||||
(advance)
|
||||
(panic message tokens)))))
|
||||
|
||||
(defn- expect* [tokens message parser]
|
||||
(let [curr (current parser)
|
||||
|
|
@ -91,8 +83,7 @@
|
|||
type (::token/type curr)]
|
||||
(if (contains? tokens type)
|
||||
{:success true :parser (advance parser)}
|
||||
{:success false :parser (panic (advance parser) message)}
|
||||
)))
|
||||
{:success false :parser (panic (advance parser) message)})))
|
||||
|
||||
(defn- accept [tokens parser]
|
||||
(let [curr (current parser)
|
||||
|
|
@ -105,8 +96,7 @@
|
|||
(defn- accept-many [tokens parser]
|
||||
(let [tokens (if (set? tokens) tokens #{tokens})]
|
||||
(loop [parser parser]
|
||||
(let [
|
||||
curr (current parser)
|
||||
(let [curr (current parser)
|
||||
type (::token/type curr)]
|
||||
(if (contains? tokens type)
|
||||
(recur (advance parser))
|
||||
|
|
@ -116,27 +106,23 @@
|
|||
(defn- parse-atom [parser]
|
||||
(let [token (current parser)]
|
||||
(-> parser
|
||||
(advance)
|
||||
(assoc ::ast {
|
||||
::ast/type ::ast/atom
|
||||
:token token
|
||||
:value (::token/literal token)}))))
|
||||
(advance)
|
||||
(assoc ::ast {::ast/type ::ast/atom
|
||||
:token token
|
||||
:value (::token/literal token)}))))
|
||||
|
||||
;; just a quick and dirty map to associate atomic words with values
|
||||
(def atomic-words {
|
||||
::token/nil nil
|
||||
(def atomic-words {::token/nil nil
|
||||
::token/true true
|
||||
::token/false false})
|
||||
|
||||
(defn parse-atomic-word [parser]
|
||||
(let [token (current parser)]
|
||||
(-> parser
|
||||
(advance)
|
||||
(assoc ::ast {
|
||||
::ast/type ::ast/atom
|
||||
:token token
|
||||
:value (get atomic-words (::token/type token))}))))
|
||||
|
||||
(advance)
|
||||
(assoc ::ast {::ast/type ::ast/atom
|
||||
:token token
|
||||
:value (get atomic-words (::token/type token))}))))
|
||||
|
||||
(defn- add-member [members member]
|
||||
(if (nil? member)
|
||||
|
|
@ -144,104 +130,96 @@
|
|||
(conj members member)))
|
||||
|
||||
(defn- parse-tuple [origin]
|
||||
(loop [
|
||||
parser (accept-many #{::token/newline ::token/comma} (advance origin))
|
||||
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
|
||||
members []
|
||||
current_member nil
|
||||
]
|
||||
current_member nil]
|
||||
(let [curr (current parser)]
|
||||
(case (token-type parser)
|
||||
::token/rparen (let [ms (add-member members current_member)]
|
||||
(assoc (advance parser) ::ast
|
||||
{::ast/type ::ast/tuple
|
||||
:length (count ms)
|
||||
:members ms}))
|
||||
(assoc (advance parser) ::ast
|
||||
{::ast/type ::ast/tuple
|
||||
:length (count ms)
|
||||
:members ms}))
|
||||
|
||||
(::token/comma ::token/newline)
|
||||
(recur
|
||||
(accept-many #{::token/comma ::token/newline} parser)
|
||||
(add-member members current_member) nil)
|
||||
(recur
|
||||
(accept-many #{::token/comma ::token/newline} parser)
|
||||
(add-member members current_member) nil)
|
||||
|
||||
(::token/rbrace ::token/rbracket)
|
||||
(panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
|
||||
|
||||
::token/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})]
|
||||
(recur parsed members (::ast parsed)))))))
|
||||
|
||||
(defn- parse-list [origin]
|
||||
(loop [
|
||||
parser (accept-many #{::token/newline ::token/comma} (advance origin))
|
||||
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
|
||||
members []
|
||||
current_member nil
|
||||
]
|
||||
current_member nil]
|
||||
(let [curr (current parser)]
|
||||
(case (token-type parser)
|
||||
::token/rbracket (let [ms (add-member members current_member)]
|
||||
(assoc (advance parser) ::ast
|
||||
{::ast/type ::ast/list
|
||||
:members ms}))
|
||||
(assoc (advance parser) ::ast
|
||||
{::ast/type ::ast/list
|
||||
:members ms}))
|
||||
|
||||
(::token/comma ::token/newline)
|
||||
(recur
|
||||
(accept-many #{::token/comma ::token/newline} parser)
|
||||
(add-member members current_member) nil)
|
||||
(recur
|
||||
(accept-many #{::token/comma ::token/newline} parser)
|
||||
(add-member members current_member) nil)
|
||||
|
||||
(::token/rbrace ::token/rparen)
|
||||
(panic parser (str "Mismatched enclosure in list: " (::token/lexeme curr)))
|
||||
|
||||
::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})]
|
||||
(recur parsed members (::ast parsed)))))))
|
||||
|
||||
(defn- parse-set [origin]
|
||||
(loop [
|
||||
parser (accept-many #{::token/newline ::token/comma} (advance origin))
|
||||
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
|
||||
members []
|
||||
current_member nil
|
||||
]
|
||||
current_member nil]
|
||||
(let [curr (current parser)]
|
||||
(case (token-type parser)
|
||||
::token/rbrace (let [ms (add-member members current_member)]
|
||||
(assoc (advance parser) ::ast
|
||||
{::ast/type ::ast/set
|
||||
:members ms}))
|
||||
(assoc (advance parser) ::ast
|
||||
{::ast/type ::ast/set
|
||||
:members ms}))
|
||||
|
||||
(::token/comma ::token/newline)
|
||||
(recur
|
||||
(accept-many #{::token/comma ::token/newline} parser)
|
||||
(add-member members current_member) nil)
|
||||
(recur
|
||||
(accept-many #{::token/comma ::token/newline} parser)
|
||||
(add-member members current_member) nil)
|
||||
|
||||
(::token/rbracket ::token/rparen)
|
||||
(panic parser (str "Mismatched enclosure in set: " (::token/lexeme curr)))
|
||||
|
||||
::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})]
|
||||
(recur parsed members (::ast parsed)))))))
|
||||
|
||||
(defn- parse-hash [origin]
|
||||
(loop [
|
||||
parser (accept-many #{::token/newline ::token/comma} (advance origin))
|
||||
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
|
||||
members {}
|
||||
current_member nil
|
||||
]
|
||||
current_member nil]
|
||||
(let [curr (current parser)]
|
||||
(case (token-type parser)
|
||||
::token/rbrace (let [ms (add-member members current_member)]
|
||||
(assoc (advance parser) ::ast
|
||||
{::ast/type ::ast/hash
|
||||
:members ms}))
|
||||
(assoc (advance parser) ::ast
|
||||
{::ast/type ::ast/hash
|
||||
:members ms}))
|
||||
|
||||
(::token/comma ::token/newline)
|
||||
(recur
|
||||
(accept-many #{::token/comma ::token/newline} parser)
|
||||
(add-member members current_member) nil)
|
||||
(recur
|
||||
(accept-many #{::token/comma ::token/newline} parser)
|
||||
(add-member members current_member) nil)
|
||||
|
||||
(::token/rbracket ::token/rparen)
|
||||
(panic parser (str "Mismatched enclosure in set: " (::token/lexeme curr)))
|
||||
|
|
@ -252,40 +230,34 @@
|
|||
::token/word
|
||||
(if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])]
|
||||
(recur parsed members {(keyword word) (::ast parsed)}))
|
||||
(panic parser "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
|
||||
(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))
|
||||
(pp/pprint (::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})))))
|
||||
|
||||
(defn- parse-block [origin]
|
||||
(loop [
|
||||
parser (accept-many #{::token/newline ::token/semicolon} (advance origin))
|
||||
(loop [parser (accept-many #{::token/newline ::token/semicolon} (advance origin))
|
||||
exprs []
|
||||
current_expr nil
|
||||
]
|
||||
current_expr nil]
|
||||
(let [curr (current parser)]
|
||||
(case (token-type parser)
|
||||
::token/rbrace
|
||||
::token/rbrace
|
||||
(let [es (add-member exprs current_expr)]
|
||||
(if (empty? es)
|
||||
(advance (panic parser "Blocks must have at least one expression"))
|
||||
(assoc (advance parser) ::ast {
|
||||
::ast/type ::ast/block
|
||||
:exprs es
|
||||
})))
|
||||
(assoc (advance parser) ::ast {::ast/type ::ast/block
|
||||
:exprs es})))
|
||||
|
||||
(::token/semicolon ::token/newline)
|
||||
(recur
|
||||
(accept-many #{::token/newline ::token/semicolon} parser)
|
||||
(add-member exprs current_expr) nil)
|
||||
(recur
|
||||
(accept-many #{::token/newline ::token/semicolon} parser)
|
||||
(add-member exprs current_expr) nil)
|
||||
|
||||
(::token/rbracket ::token/rparen)
|
||||
(panic parser (str "Mismatched enclosure in block: " (::token/lexeme curr)))
|
||||
|
|
@ -293,38 +265,34 @@
|
|||
::token/eof
|
||||
(panic (assoc origin ::errors (::errors parser)) "Unterminated block" ::token/eof)
|
||||
|
||||
|
||||
(let [parsed
|
||||
(let [parsed
|
||||
(if current_expr
|
||||
(panic parser "Expected end of expression" #{::token/semicolon ::token/newline})
|
||||
(parse-expr parser))]
|
||||
(recur parsed exprs (::ast parsed)))))))
|
||||
|
||||
(defn parse-script [parser]
|
||||
(loop [
|
||||
parser (accept-many #{::token/newline ::token/semicolon} parser)
|
||||
(loop [parser (accept-many #{::token/newline ::token/semicolon} parser)
|
||||
exprs []
|
||||
current_expr nil
|
||||
]
|
||||
current_expr nil]
|
||||
(case (token-type parser)
|
||||
::token/eof
|
||||
::token/eof
|
||||
(let [es (add-member exprs current_expr)]
|
||||
(if (empty? es)
|
||||
(panic parser "Scripts must have at least one expression")
|
||||
(assoc parser ::ast {::ast/type ::ast/script :exprs es})))
|
||||
(if (empty? es)
|
||||
(panic parser "Scripts must have at least one expression")
|
||||
(assoc parser ::ast {::ast/type ::ast/script :exprs es})))
|
||||
|
||||
(::token/semicolon ::token/newline)
|
||||
(recur
|
||||
(accept-many #{::token/semicolon ::token/newline} parser)
|
||||
(add-member exprs current_expr)
|
||||
nil)
|
||||
(recur
|
||||
(accept-many #{::token/semicolon ::token/newline} parser)
|
||||
(add-member exprs current_expr)
|
||||
nil)
|
||||
|
||||
(let [parsed
|
||||
(if current_expr
|
||||
(panic parser "Expected end of expression" #{::token/semicolon ::token/newline})
|
||||
(parse-expr parser)
|
||||
)
|
||||
]
|
||||
(parse-expr parser))]
|
||||
|
||||
(recur parsed exprs (::ast parsed))))))
|
||||
|
||||
(defn- parse-synthetic [parser]
|
||||
|
|
@ -333,52 +301,48 @@
|
|||
(let [curr (current parser)
|
||||
type (::token/type curr)]
|
||||
(case type
|
||||
::token/keyword
|
||||
::token/keyword
|
||||
(recur (advance parser) (conj terms (::ast (parse-atom parser))))
|
||||
|
||||
::token/word
|
||||
::token/word
|
||||
(recur (advance parser) (conj terms (::ast (parse-word parser))))
|
||||
|
||||
::token/lparen
|
||||
(let [parsed (parse-tuple parser)]
|
||||
(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]
|
||||
(let [curr (current parser)]
|
||||
(-> parser
|
||||
(advance)
|
||||
(assoc ::ast {::ast/type ::ast/word :word (::token/lexeme curr)}))))
|
||||
(advance)
|
||||
(assoc ::ast {::ast/type ::ast/word :word (::token/lexeme curr)}))))
|
||||
|
||||
(def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow}))
|
||||
|
||||
(defn- parse-tuple-pattern [origin]
|
||||
(loop [
|
||||
parser (accept-many #{::token/newline ::token/comma} (advance origin))
|
||||
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
|
||||
members []
|
||||
current_member nil
|
||||
]
|
||||
current_member nil]
|
||||
(let [curr (current parser)]
|
||||
(case (token-type parser)
|
||||
::token/rparen (let [ms (add-member members current_member)]
|
||||
(assoc (advance parser) ::ast
|
||||
{::ast/type ::ast/tuple
|
||||
:length (count ms)
|
||||
:members ms}))
|
||||
(assoc (advance parser) ::ast
|
||||
{::ast/type ::ast/tuple
|
||||
:length (count ms)
|
||||
:members ms}))
|
||||
|
||||
(::token/comma ::token/newline)
|
||||
(recur
|
||||
(accept-many #{::token/comma ::token/newline} parser)
|
||||
(add-member members current_member) nil)
|
||||
(recur
|
||||
(accept-many #{::token/comma ::token/newline} parser)
|
||||
(add-member members current_member) nil)
|
||||
|
||||
(::token/rbrace ::token/rbracket)
|
||||
(panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
|
||||
|
||||
::token/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)]
|
||||
(recur parsed members (::ast parsed)))))))
|
||||
|
|
@ -387,9 +351,9 @@
|
|||
(let [curr (current parser)
|
||||
type (::token/type curr)]
|
||||
(case type
|
||||
::token/placeholder (-> parser
|
||||
(advance)
|
||||
(assoc ::ast {::ast/type ::ast/placeholder}))
|
||||
::token/placeholder (-> parser
|
||||
(advance)
|
||||
(assoc ::ast {::ast/type ::ast/placeholder}))
|
||||
|
||||
::token/word (parse-word parser)
|
||||
|
||||
|
|
@ -400,8 +364,7 @@
|
|||
::token/error
|
||||
(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]
|
||||
(let [expr (parse-expr parser)]
|
||||
|
|
@ -444,25 +407,19 @@
|
|||
(defn- parse-if [parser]
|
||||
(let [if-expr (parse-expr (advance parser) #{::token/newline ::token/then})
|
||||
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]
|
||||
(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)
|
||||
(let [body (parse-expr (:parser rarrow))]
|
||||
(assoc body ::ast {::ast/type ::ast/clause
|
||||
:pattern (::ast pattern) :body (::ast body)})
|
||||
)
|
||||
(panic pattern "Expected -> in match clause. Clauses must be in the form pattern -> expression" #{::token/newline ::token/rbrace})
|
||||
)
|
||||
))
|
||||
:pattern (::ast pattern) :body (::ast body)}))
|
||||
(panic pattern "Expected -> in match clause. Clauses must be in the form pattern -> expression" #{::token/newline ::token/rbrace}))))
|
||||
|
||||
(defn- parse-match-clauses [parser]
|
||||
(loop [
|
||||
parser (accept-many #{::token/newline} (advance parser))
|
||||
(loop [parser (accept-many #{::token/newline} (advance parser))
|
||||
clauses []]
|
||||
(let [curr (current parser)]
|
||||
(case (::token/type curr)
|
||||
|
|
@ -471,13 +428,9 @@
|
|||
|
||||
::token/newline
|
||||
(recur (accept-many #{::token/newline} parser) clauses)
|
||||
|
||||
|
||||
(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]
|
||||
(let [match-expr (parse-expr (advance parser) #{::token/with})
|
||||
|
|
@ -494,12 +447,9 @@
|
|||
(let [clause (parse-match-clause clauses)]
|
||||
(assoc clause ::ast {::ast/type ::ast/match
|
||||
: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]
|
||||
(let [first (advance parser)]
|
||||
|
|
@ -514,64 +464,57 @@
|
|||
:clauses [{::ast/type ::ast/clause
|
||||
:pattern (::ast pattern)
|
||||
: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
|
||||
::token/word
|
||||
::token/word
|
||||
(let [name (parse-word first)
|
||||
pattern (parse-tuple-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 sync-on]
|
||||
([parser sync-on]
|
||||
(let [token (current parser)]
|
||||
(case (::token/type token)
|
||||
|
||||
|
||||
(::token/number ::token/string)
|
||||
(parse-atom parser)
|
||||
|
||||
::token/keyword
|
||||
|
||||
::token/keyword
|
||||
(let [next (peek parser)
|
||||
type (::token/type next)]
|
||||
(if (= type ::token/lparen)
|
||||
(parse-synthetic parser)
|
||||
(parse-atom parser)))
|
||||
|
||||
::token/word
|
||||
|
||||
::token/word
|
||||
(let [next (peek parser)
|
||||
type (::token/type next)]
|
||||
(case type
|
||||
(::token/lparen ::token/keyword) (parse-synthetic parser)
|
||||
(parse-word parser)))
|
||||
|
||||
|
||||
(::token/nil ::token/true ::token/false)
|
||||
(parse-atomic-word parser)
|
||||
|
||||
|
||||
::token/lparen (parse-tuple parser)
|
||||
|
||||
|
||||
::token/lbracket (parse-list parser)
|
||||
|
||||
|
||||
::token/startset (parse-set parser)
|
||||
|
||||
::token/starthash (parse-hash parser)
|
||||
|
||||
|
||||
::token/lbrace (parse-block parser)
|
||||
|
||||
|
||||
::token/let (parse-let parser)
|
||||
|
||||
|
||||
::token/if (parse-if parser)
|
||||
|
||||
::token/match (parse-match parser)
|
||||
|
|
@ -581,25 +524,22 @@
|
|||
;; TODO: improve handling of comments?
|
||||
;; Scanner now just skips comments
|
||||
;; ::token/comment (advance parser)
|
||||
|
||||
|
||||
::token/error (panic parser (:message token) sync-on)
|
||||
|
||||
|
||||
(::token/rparen ::token/rbrace ::token/rbracket)
|
||||
(panic parser (str "Unbalanced enclosure: " (::token/lexeme token)))
|
||||
|
||||
|
||||
(::token/semicolon ::token/comma)
|
||||
(panic parser (str "Unexpected delimiter: " (::token/lexeme token)))
|
||||
|
||||
(panic parser "Expected expression" sync-on)
|
||||
|
||||
))))
|
||||
|
||||
(panic parser "Expected expression" sync-on)))))
|
||||
|
||||
(defn parse [lexed]
|
||||
(-> lexed
|
||||
(:tokens)
|
||||
(parser)
|
||||
(parse-script)
|
||||
))
|
||||
(:tokens)
|
||||
(parser)
|
||||
(parse-script)))
|
||||
|
||||
(do
|
||||
(def pp pp/pprint)
|
||||
|
|
@ -617,11 +557,9 @@
|
|||
(println "*** *** NEW PARSE *** ***")
|
||||
|
||||
(-> p
|
||||
(parse-fn)
|
||||
(::ast)
|
||||
(pp)
|
||||
)
|
||||
)
|
||||
(parse-fn)
|
||||
(::ast)
|
||||
(pp)))
|
||||
|
||||
(comment "
|
||||
Further thoughts/still to do:
|
||||
|
|
|
|||
|
|
@ -1,36 +1,26 @@
|
|||
(ns ludus.prelude
|
||||
(:require
|
||||
[ludus.ast :as ast]))
|
||||
(:require
|
||||
[ludus.ast :as ast]))
|
||||
|
||||
(def eq {
|
||||
:name "eq"
|
||||
::ast/type ::ast/clj
|
||||
:body =
|
||||
})
|
||||
(def eq {:name "eq"
|
||||
::ast/type ::ast/clj
|
||||
:body =})
|
||||
|
||||
(def add {
|
||||
:name "add"
|
||||
::ast/type ::ast/clj
|
||||
:body +
|
||||
})
|
||||
(def add {:name "add"
|
||||
::ast/type ::ast/clj
|
||||
:body +})
|
||||
|
||||
(def panic {
|
||||
:name "panic"
|
||||
::ast/type ::ast/clj
|
||||
:body (fn [& args] (throw (ex-info "Ludus panicked!" {:args args})))
|
||||
})
|
||||
(def panic {:name "panic"
|
||||
::ast/type ::ast/clj
|
||||
:body (fn [& args] (throw (ex-info "Ludus panicked!" {:args args})))})
|
||||
|
||||
(def print {
|
||||
:name "print"
|
||||
::ast/type ::ast/clj
|
||||
:body (fn [& args]
|
||||
(println (str args))
|
||||
:ok)
|
||||
})
|
||||
(def print {:name "print"
|
||||
::ast/type ::ast/clj
|
||||
:body (fn [& args]
|
||||
(println (str args))
|
||||
:ok)})
|
||||
|
||||
(def prelude {
|
||||
"eq" eq
|
||||
"add" add
|
||||
"panic" panic
|
||||
"print" print
|
||||
})
|
||||
(def prelude {"eq" eq
|
||||
"add" add
|
||||
"panic" panic
|
||||
"print" print})
|
||||
|
|
@ -1,15 +1,14 @@
|
|||
(ns ludus.scanner
|
||||
(:require
|
||||
[ludus.token :as token]
|
||||
[clojure.pprint :as pp]
|
||||
[clojure.edn :as edn]
|
||||
[clojure.string :as s]))
|
||||
(:require
|
||||
[ludus.token :as token]
|
||||
[clojure.pprint :as pp]
|
||||
[clojure.edn :as edn]
|
||||
[clojure.string :as s]))
|
||||
|
||||
(def reserved-words
|
||||
"List of Ludus reserved words."
|
||||
;; see ludus-spec repo for more info
|
||||
{
|
||||
"as" ::token/as
|
||||
{"as" ::token/as
|
||||
"cond" ::token/cond
|
||||
"do" ::token/do
|
||||
"else" ::token/else
|
||||
|
|
@ -37,11 +36,9 @@
|
|||
"wait" ::token/wait
|
||||
"yield" ::token/yield
|
||||
;; below here, possible
|
||||
"when" ::token/when
|
||||
})
|
||||
"when" ::token/when})
|
||||
|
||||
|
||||
(defn- new-scanner
|
||||
(defn- new-scanner
|
||||
"Creates a new scanner."
|
||||
[source]
|
||||
{::source source
|
||||
|
|
@ -52,34 +49,34 @@
|
|||
::line 1
|
||||
::tokens []})
|
||||
|
||||
(defn- at-end?
|
||||
(defn- at-end?
|
||||
"Tests if a scanner is at end of input."
|
||||
[scanner]
|
||||
(>= (::current scanner) (::length scanner)))
|
||||
|
||||
(defn- current-char
|
||||
(defn- current-char
|
||||
"Gets the current character of the scanner."
|
||||
[scanner]
|
||||
(nth (::source scanner) (::current scanner) nil))
|
||||
|
||||
(defn- advance
|
||||
(defn- advance
|
||||
"Advances the scanner by a single character."
|
||||
[scanner]
|
||||
(update scanner ::current inc))
|
||||
|
||||
(defn- next-char
|
||||
(defn- next-char
|
||||
"Gets the next character from the scanner."
|
||||
[scanner]
|
||||
(current-char (advance scanner)))
|
||||
|
||||
(defn- current-lexeme
|
||||
(defn- current-lexeme
|
||||
[scanner]
|
||||
(subs (::source scanner) (::start scanner) (::current scanner)))
|
||||
|
||||
(defn- char-in-range? [start end char]
|
||||
(and char
|
||||
(>= (int char) (int start))
|
||||
(<= (int char) (int end))))
|
||||
(>= (int char) (int start))
|
||||
(<= (int char) (int end))))
|
||||
|
||||
(defn- digit? [c]
|
||||
(char-in-range? \0 \9 c))
|
||||
|
|
@ -93,7 +90,6 @@
|
|||
(defn- alpha? [c]
|
||||
(or (char-in-range? \a \z c) (char-in-range? \A \Z c)))
|
||||
|
||||
|
||||
;; legal characters in words
|
||||
(def word-chars #{\_ \? \! \* \/})
|
||||
|
||||
|
|
@ -112,32 +108,30 @@
|
|||
([scanner token-type]
|
||||
(add-token scanner token-type nil))
|
||||
([scanner token-type literal]
|
||||
(update scanner ::tokens conj
|
||||
(token/token
|
||||
token-type
|
||||
(current-lexeme scanner)
|
||||
literal
|
||||
(::line scanner)
|
||||
(::start scanner)))))
|
||||
(update scanner ::tokens conj
|
||||
(token/token
|
||||
token-type
|
||||
(current-lexeme scanner)
|
||||
literal
|
||||
(::line scanner)
|
||||
(::start scanner)))))
|
||||
|
||||
;; TODO: errors should also be in the vector of tokens
|
||||
;; The goal is to be able to be able to hand this to an LSP?
|
||||
;; Do we need a different structure
|
||||
(defn- add-error [scanner msg]
|
||||
(let [
|
||||
token (token/token
|
||||
::token/error
|
||||
(current-lexeme scanner)
|
||||
nil
|
||||
(::line scanner)
|
||||
(::start scanner))
|
||||
err-token (assoc token :message msg)
|
||||
]
|
||||
(let [token (token/token
|
||||
::token/error
|
||||
(current-lexeme scanner)
|
||||
nil
|
||||
(::line scanner)
|
||||
(::start scanner))
|
||||
err-token (assoc token :message msg)]
|
||||
(-> scanner
|
||||
(update ::errors conj err-token)
|
||||
(update ::tokens conj err-token))))
|
||||
(update ::errors conj err-token)
|
||||
(update ::tokens conj err-token))))
|
||||
|
||||
(defn- add-keyword
|
||||
(defn- add-keyword
|
||||
[scanner]
|
||||
(loop [scanner scanner
|
||||
key ""]
|
||||
|
|
@ -166,7 +160,7 @@
|
|||
|
||||
;; TODO: add string interpolation
|
||||
;; This still has to be devised
|
||||
(defn- add-string
|
||||
(defn- add-string
|
||||
[scanner]
|
||||
(loop [scanner scanner
|
||||
string ""]
|
||||
|
|
@ -183,7 +177,7 @@
|
|||
(add-error scanner "Unterminated string.")
|
||||
(recur (advance scanner) (str string char)))))))
|
||||
|
||||
(defn- add-word
|
||||
(defn- add-word
|
||||
[char scanner]
|
||||
(loop [scanner scanner
|
||||
word (str char)]
|
||||
|
|
@ -268,7 +262,7 @@
|
|||
|
||||
;; placeholders
|
||||
;; there's a flat _, and then ignored words
|
||||
\_ (cond
|
||||
\_ (cond
|
||||
(terminates? next) (add-token scanner ::token/placeholder)
|
||||
(alpha? next) (add-ignored scanner)
|
||||
:else (add-error scanner (str "Expected placeholder: _. Got " char next)))
|
||||
|
|
@ -310,13 +304,11 @@
|
|||
(loop [scanner (new-scanner source)]
|
||||
(if (at-end? scanner)
|
||||
(let [scanner (add-token scanner ::token/eof)]
|
||||
{:tokens (::tokens scanner)
|
||||
{:tokens (::tokens scanner)
|
||||
:errors (::errors scanner)})
|
||||
(recur (-> scanner (scan-token) (next-token))))))
|
||||
|
||||
|
||||
(do
|
||||
(def source "abc nil")
|
||||
|
||||
(pp/pprint (scan source))
|
||||
)
|
||||
(pp/pprint (scan source)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user