cljfmt all the things

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

View File

@ -58,16 +58,13 @@
(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)
@ -115,12 +110,8 @@
(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))
(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,11 +143,8 @@
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]
(map (fn [kv]
@ -193,18 +172,15 @@
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
;; unboxed in the tree-walk interpreter
@ -228,10 +204,7 @@
(do
(println "ERROR! Unexpected AST node:")
(pp/pprint ast)
)
))
(pp/pprint ast))))
(do
@ -250,8 +223,7 @@
(parser/parse)
(::parser/ast)
(interpret {})
(pp/pprint)
))
(pp/pprint)))
(comment "

View File

@ -33,23 +33,19 @@
(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))))
@ -61,15 +57,11 @@
([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)
(recur (advance 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))
@ -117,14 +107,12 @@
(let [token (current parser)]
(-> parser
(advance)
(assoc ::ast {
::ast/type ::ast/atom
(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})
@ -132,23 +120,19 @@
(let [token (current parser)]
(-> parser
(advance)
(assoc ::ast {
::ast/type ::ast/atom
(assoc ::ast {::ast/type ::ast/atom
:token token
:value (get atomic-words (::token/type token))}))))
(defn- add-member [members member]
(if (nil? member)
members
(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)]
@ -172,11 +156,9 @@
(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)]
@ -199,11 +181,9 @@
(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)]
@ -226,11 +206,9 @@
(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)]
@ -252,35 +230,29 @@
::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
(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
@ -293,7 +265,6 @@
::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated block" ::token/eof)
(let [parsed
(if current_expr
(panic parser "Expected end of expression" #{::token/semicolon ::token/newline})
@ -301,11 +272,9 @@
(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
(let [es (add-member exprs current_expr)]
@ -322,9 +291,8 @@
(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]
@ -343,9 +311,7 @@
(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)]
@ -356,11 +322,9 @@
(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)]
@ -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)
@ -473,11 +430,7 @@
(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,9 +464,7 @@
: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
;; right now it's broke
@ -524,15 +472,10 @@
(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
([parser] (parse-expr parser sync-on))
@ -590,16 +533,13 @@
(::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)
))
(parse-script)))
(do
(def pp pp/pprint)
@ -619,9 +559,7 @@
(-> p
(parse-fn)
(::ast)
(pp)
)
)
(pp)))
(comment "
Further thoughts/still to do:

View File

@ -2,35 +2,25 @@
(:require
[ludus.ast :as ast]))
(def eq {
:name "eq"
(def eq {:name "eq"
::ast/type ::ast/clj
:body =
})
:body =})
(def add {
:name "add"
(def add {:name "add"
::ast/type ::ast/clj
:body +
})
:body +})
(def panic {
:name "panic"
(def panic {:name "panic"
::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 {
:name "print"
(def print {:name "print"
::ast/type ::ast/clj
:body (fn [& args]
(println (str args))
:ok)
})
:ok)})
(def prelude {
"eq" eq
(def prelude {"eq" eq
"add" add
"panic" panic
"print" print
})
"print" print})

View File

@ -8,8 +8,7 @@
(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,9 +36,7 @@
"wait" ::token/wait
"yield" ::token/yield
;; below here, possible
"when" ::token/when
})
"when" ::token/when})
(defn- new-scanner
"Creates a new scanner."
@ -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 #{\_ \? \! \* \/})
@ -124,15 +120,13 @@
;; 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
(let [token (token/token
::token/error
(current-lexeme scanner)
nil
(::line scanner)
(::start scanner))
err-token (assoc token :message msg)
]
err-token (assoc token :message msg)]
(-> scanner
(update ::errors conj err-token)
(update ::tokens conj err-token))))
@ -314,9 +308,7 @@
:errors (::errors scanner)})
(recur (-> scanner (scan-token) (next-token))))))
(do
(def source "abc nil")
(pp/pprint (scan source))
)
(pp/pprint (scan source)))