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

Tonksy-fmt

Browse Source
This commit is contained in:
Scott Richmond 2022-02-18 17:49:02 -05:00
parent d6a547bdcb
commit 5d78d5f823
1 changed files with 208 additions and 208 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

416
src/ludus/parser.clj
View File

@ -1,29 +1,29 @@
(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]))
;; 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]
{::tokens tokens ::token 0 ::ast {}}) {::tokens tokens ::token 0 ::ast {}})
(defn- current [parser] (defn- current [parser]
(nth (::tokens parser) (::token parser) nil)) (nth (::tokens parser) (::token parser) nil))
(defn- peek [parser] (defn- peek [parser]
(nth (::tokens parser) (inc (::token parser)) nil)) (nth (::tokens parser) (inc (::token parser)) nil))
(defn- at-end? [parser] (defn- at-end? [parser]
(let [curr (current parser)] (let [curr (current parser)]
(or (nil? curr) (= ::token/eof (::token/type curr))))) (or (nil? curr) (= ::token/eof (::token/type curr)))))
(defn- advance [parser] (defn- advance [parser]
(update parser ::token inc)) (update parser ::token inc))
(defn- token-type [parser] (defn- token-type [parser]
(::token/type (current parser))) (::token/type (current parser)))
;; some forward declarations ;; some forward declarations
(declare parse-expr) (declare parse-expr)
@ -31,265 +31,265 @@
;; various parsing functions ;; various parsing functions
(defn- parse-atom [parser token] (defn- parse-atom [parser token]
(-> parser (-> parser
(advance) (advance)
(assoc ::ast { (assoc ::ast {
::ast/type ::ast/atom ::ast/type ::ast/atom
: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 token] (defn parse-atomic-word [parser token]
(-> parser (-> parser
(advance) (advance)
(assoc ::ast { (assoc ::ast {
::ast/type ::ast/atom ::ast/type ::ast/atom
: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)
members members
(conj members member))) (conj members member)))
(defn- parse-tuple [parser] (defn- parse-tuple [parser]
(loop [parser (advance parser) (loop [parser (advance parser)
members [] members []
current_member nil] current_member nil]
(let [curr (current parser)] (let [curr (current parser)]
(case (::token/type curr) (case (::token/type curr)
::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) (recur (advance parser) (add-member members current_member) nil) (::token/comma ::token/newline) (recur (advance parser) (add-member members current_member) nil)
(let [parsed (parse-expr parser)] (let [parsed (parse-expr parser)]
(recur parsed members (::ast parsed))) (recur parsed members (::ast parsed)))
)))) ))))
(defn- parse-list [parser] (defn- parse-list [parser]
(loop [parser (advance parser) (loop [parser (advance parser)
members [] members []
current_member nil] current_member nil]
(let [curr (current parser)] (let [curr (current parser)]
(case (::token/type curr) (case (::token/type curr)
::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) (recur (advance parser) (add-member members current_member) nil) (::token/comma ::token/newline) (recur (advance parser) (add-member members current_member) nil)
(let [parsed (parse-expr parser)] (let [parsed (parse-expr parser)]
(recur parsed members (::ast parsed))) (recur parsed members (::ast parsed)))
)))) ))))
(defn- parse-set [parser] (defn- parse-set [parser]
(loop [parser (advance parser) (loop [parser (advance parser)
members [] members []
current_member nil] current_member nil]
(let [curr (current parser)] (let [curr (current parser)]
(case (::token/type curr) (case (::token/type curr)
::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) (recur (advance parser) (add-member members current_member) nil) (::token/comma ::token/newline) (recur (advance parser) (add-member members current_member) nil)
(let [parsed (parse-expr parser)] (let [parsed (parse-expr parser)]
(recur parsed members (::ast parsed))) (recur parsed members (::ast parsed)))
)))) ))))
(defn- parse-block [parser] (defn- parse-block [parser]
(loop [parser (advance parser) (loop [parser (advance parser)
exprs [] exprs []
current_expr nil] current_expr nil]
(case (::token/type (current parser)) (case (::token/type (current parser))
::token/rbrace ::token/rbrace
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
(if (and (empty? exprs) (nil? current_expr)) (if (and (empty? exprs) (nil? current_expr))
{::ast/type ::ast/poison :message "Blocks must have at least one expression"} {::ast/type ::ast/poison :message "Blocks must have at least one expression"}
{::ast/type ::ast/block :exprs (add-member exprs current_expr)})) {::ast/type ::ast/block :exprs (add-member exprs current_expr)}))
(::token/semicolon ::token/newline) (::token/semicolon ::token/newline)
(recur (advance parser) (add-member exprs current_expr) nil) (recur (advance parser) (add-member exprs current_expr) nil)
(if current_expr (if current_expr
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/poison :message "Expected end of expression"})) (assoc ::ast {::ast/type ::ast/poison :message "Expected end of expression"}))
(let [parsed (parse-expr parser)] (let [parsed (parse-expr parser)]
(recur parsed exprs (::ast parsed)))) (recur parsed exprs (::ast parsed))))
))) )))
(defn- parse-script [parser] (defn- parse-script [parser]
(loop [parser parser (loop [parser parser
exprs [] exprs []
current_expr nil] current_expr nil]
(case (::token/type (current parser)) (case (::token/type (current parser))
::token/eof (assoc parser ::ast ::token/eof (assoc parser ::ast
{::ast/type ::ast/script :exprs (add-member exprs current_expr)}) {::ast/type ::ast/script :exprs (add-member exprs current_expr)})
(::token/semicolon ::token/newline) (::token/semicolon ::token/newline)
(recur (advance parser) (add-member exprs current_expr) nil) (recur (advance parser) (add-member exprs current_expr) nil)
(if current_expr (if current_expr
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/poison :message "Expected end of expression"})) (assoc ::ast {::ast/type ::ast/poison :message "Expected end of expression"}))
(let [parsed (parse-expr parser)] (let [parsed (parse-expr parser)]
(recur parsed exprs (::ast parsed)))) (recur parsed exprs (::ast parsed))))
))) )))
(defn- parse-synthetic [parser] (defn- parse-synthetic [parser]
(loop [parser parser (loop [parser parser
terms []] terms []]
(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 curr)))) (recur (advance parser) (conj terms (::ast (parse-atom parser curr))))
::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))))
(-> parser (-> parser
(assoc ::ast {::ast/type ::ast/synthetic :terms terms}) (assoc ::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)}))))
(defn- parse-pattern [parser] (defn- parse-pattern [parser]
(let [curr (current parser) (let [curr (current parser)
type (::token/type curr)] type (::token/type curr)]
(case type (case type
::token/word (parse-word parser) ::token/word (parse-word parser)
(::token/number ::token/string ::token/keyword) (parse-atom parser curr) (::token/number ::token/string ::token/keyword) (parse-atom parser curr)
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/poison :message "Expected pattern"})) (assoc ::ast {::ast/type ::ast/poison :message "Expected pattern"}))
))) )))
(defn- expect [token message parser] (defn- expect [token message parser]
(let [curr (current parser) (let [curr (current parser)
type (::token/type curr)] type (::token/type curr)]
(if (= type token) (if (= type token)
(advance parser) (advance parser)
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/poison :message message}))))) (assoc ::ast {::ast/type ::ast/poison :message message})))))
(defn- accept [token parser] (defn- accept [token parser]
(let [curr (current parser) (let [curr (current parser)
type (::token/type curr)] type (::token/type curr)]
(if (= type token) (if (= type token)
(advance parser) (advance parser)
parser))) parser)))
(defn- accept-many [token parser] (defn- accept-many [token parser]
(loop [curr (current parser)] (loop [curr (current parser)]
(let [type (::token/type curr)] (let [type (::token/type curr)]
(if (= type token) (if (= type token)
(recur (advance parser)) (recur (advance parser))
parser)))) parser))))
(defn- parse-let [parser] (defn- parse-let [parser]
(let [ (let [
pattern (parse-pattern (advance parser)) pattern (parse-pattern (advance parser))
equals (expect ::token/equals "Expected assignment" pattern) equals (expect ::token/equals "Expected assignment" pattern)
expr (parse-expr equals) expr (parse-expr equals)
results (map #(get-in % [::ast ::ast/type]) [pattern equals expr]) results (map #(get-in % [::ast ::ast/type]) [pattern equals expr])
] ]
(if (some #(= ::ast/poison %) results) (if (some #(= ::ast/poison %) results)
(println ::poison) (println ::poison)
(assoc expr ::ast { (assoc expr ::ast {
::ast/type ::ast/let ::ast/type ::ast/let
:pattern (::ast pattern) :pattern (::ast pattern)
:expr (::ast expr)})) :expr (::ast expr)}))
)) ))
(defn- parse-if [parser] (defn- parse-if [parser]
(let [ (let [
if-expr (parse-expr (advance parser)) if-expr (parse-expr (advance parser))
then (expect ::token/then "Expected then" (accept ::token/newline if-expr)) then (expect ::token/then "Expected then" (accept ::token/newline if-expr))
then-expr (parse-expr then) then-expr (parse-expr then)
else (expect ::token/else "Epected else" (accept ::token/newline then-expr)) else (expect ::token/else "Epected else" (accept ::token/newline then-expr))
else-expr (parse-expr else) else-expr (parse-expr else)
results (map #(get-in % [::ast ::ast/type]) [if-expr then then-expr else else-expr]) results (map #(get-in % [::ast ::ast/type]) [if-expr then then-expr else else-expr])
] ]
(if (some #(= ::ast/poison %) results) (if (some #(= ::ast/poison %) results)
(println ::ast/poison) (println ::ast/poison)
(assoc else-expr ::ast { (assoc else-expr ::ast {
::ast/type ::ast/let ::ast/type ::ast/let
:if-expr (::ast if-expr) :if-expr (::ast if-expr)
:then-expr (::ast then-expr) :then-expr (::ast then-expr)
:else-expr (::ast else-expr) :else-expr (::ast else-expr)
})) }))
)) ))
(defn- parse-expr [parser] (defn- parse-expr [parser]
(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 token) (parse-atom parser token)
::token/keyword (let [next (peek parser) ::token/keyword (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 token))) (parse-atom parser token)))
::token/word (let [next (peek parser) ::token/word (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 token) (parse-atomic-word parser token)
::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/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)
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/poison :message "Expected expression"})) (assoc ::ast {::ast/type ::ast/poison :message "Expected expression"}))
))) )))
(do (do
(def source "if let foo = :foo (def source "if let foo = :foo
then { then {
bar (baz) :quux bar (baz) :quux
} }
@ -301,13 +301,13 @@
(false, nil, ()) (false, nil, ())
]") ]")
(def tokens (:tokens (scanner/scan source))) (def tokens (:tokens (scanner/scan source)))
(def p (parser tokens)) (def p (parser tokens))
(-> (parse-script p) (-> (parse-script p)
(::ast) (::ast)
(pp/pprint))) (pp/pprint)))
(comment " (comment "
Further thoughts/still to do: Further thoughts/still to do: