Add tokens (and thus locations) to all AST nodes

This commit is contained in:
Scott Richmond 2022-05-19 16:58:38 -04:00
parent ee4438bf1e
commit 1fb41d8b71

View File

@ -143,6 +143,7 @@
{::ast/type ::ast/tuple {::ast/type ::ast/tuple
:length (count ms) :length (count ms)
:members ms :members ms
:token (current origin)
:partial (contains-placeholder? ms)})) :partial (contains-placeholder? ms)}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
@ -160,7 +161,7 @@
members members
(panic parser "Partially applied functions must be unary. (Only one placeholder allowed in partial application.)" curr)) (panic parser "Partially applied functions must be unary. (Only one placeholder allowed in partial application.)" curr))
(recur (recur
(advance parser) members {::ast/type ::ast/placeholder})) (advance parser) members {::ast/type ::ast/placeholder :token curr}))
::token/eof ::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof)
@ -177,6 +178,7 @@
::token/rparen (let [ms (add-member members current_member)] ::token/rparen (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/tuple {::ast/type ::ast/tuple
:token (current origin)
:length (count ms) :length (count ms)
:members ms})) :members ms}))
@ -209,6 +211,7 @@
::token/rbracket (let [ms (add-member members current_member)] ::token/rbracket (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/list {::ast/type ::ast/list
:token origin
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
@ -234,6 +237,7 @@
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/set {::ast/type ::ast/set
:token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
@ -259,6 +263,7 @@
::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
:token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
@ -293,6 +298,7 @@
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/struct {::ast/type ::ast/struct
:token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
@ -335,6 +341,7 @@
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/ns {::ast/type ::ast/ns
:token (current ns-root)
:name (get-in (parse-word (advance ns-root)) [::ast :word]) :name (get-in (parse-word (advance ns-root)) [::ast :word])
:members ms})) :members ms}))
@ -372,6 +379,7 @@
(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 {::ast/type ::ast/block (assoc (advance parser) ::ast {::ast/type ::ast/block
:token (current origin)
:exprs es}))) :exprs es})))
(::token/semicolon ::token/newline) (::token/semicolon ::token/newline)
@ -391,8 +399,8 @@
(parse-expr parser))] (parse-expr parser))]
(recur parsed exprs (::ast parsed))))))) (recur parsed exprs (::ast parsed)))))))
(defn parse-script [parser] (defn parse-script [origin]
(loop [parser (accept-many #{::token/newline ::token/semicolon} parser) (loop [parser (accept-many #{::token/newline ::token/semicolon} origin)
exprs [] exprs []
current_expr nil] current_expr nil]
(case (token-type parser) (case (token-type parser)
@ -400,7 +408,8 @@
(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
:token (current origin) :exprs es})))
(::token/semicolon ::token/newline) (::token/semicolon ::token/newline)
(recur (recur
@ -431,13 +440,13 @@
(let [parsed (parse-fn-tuple parser)] (let [parsed (parse-fn-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 :token (current parser) :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 :token (current parser) :word (::token/lexeme curr)}))))
(def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow})) (def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow}))
@ -450,6 +459,7 @@
::token/rparen (let [ms (add-member members current_member)] ::token/rparen (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/tuple {::ast/type ::ast/tuple
:token (current origin)
:length (count ms) :length (count ms)
:members ms})) :members ms}))
@ -471,9 +481,10 @@
(let [curr (current parser) (let [curr (current parser)
type (::token/type curr)] type (::token/type curr)]
(case type (case type
(::token/placeholder ::token/ignored) (-> parser (::token/placeholder ::token/ignored)
(advance) (-> parser
(assoc ::ast {::ast/type ::ast/placeholder})) (advance)
(assoc ::ast {::ast/type ::ast/placeholder :token curr}))
::token/word (parse-word parser) ::token/word (parse-word parser)
@ -489,6 +500,7 @@
(defn- parse-let-expr [parser pattern] (defn- parse-let-expr [parser pattern]
(let [expr (parse-expr parser)] (let [expr (parse-expr parser)]
(assoc expr ::ast {::ast/type ::ast/let (assoc expr ::ast {::ast/type ::ast/let
:token (current parser)
:pattern (::ast pattern) :expr (::ast expr)}))) :pattern (::ast pattern) :expr (::ast expr)})))
(defn- parse-assignment [parser] (defn- parse-assignment [parser]
@ -505,6 +517,7 @@
(defn- parse-ref-expr [parser name] (defn- parse-ref-expr [parser name]
(let [expr (parse-expr parser)] (let [expr (parse-expr parser)]
(assoc expr ::ast {::ast/type ::ast/ref (assoc expr ::ast {::ast/type ::ast/ref
:token (current parser)
:name name :expr (::ast expr)}))) :name name :expr (::ast expr)})))
(defn- parse-ref-assignment [parser name] (defn- parse-ref-assignment [parser name]
@ -545,17 +558,18 @@
(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 :token (current parser) :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 (if (= ::token/else (token-type parser)) (let [pattern (if (= ::token/else (token-type parser))
(-> parser (advance) (assoc ::ast {::ast/type ::ast/placeholder})) (-> parser (advance) (assoc ::ast {::ast/type ::ast/placeholder :token (current parser)}))
(parse-pattern parser)) (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
:token (current parser)
: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}))))
@ -566,7 +580,7 @@
(case (::token/type curr) (case (::token/type curr)
::token/rbrace ::token/rbrace
(if (< 0 (count clauses)) (if (< 0 (count clauses))
(assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses}) (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses})
(panic parser "Expected one or more clauses" #{::rbrace})) (panic parser "Expected one or more clauses" #{::rbrace}))
::token/newline ::token/newline
@ -584,11 +598,13 @@
;; match expression with one or many clauses in braces ;; match expression with one or many clauses in braces
(let [clauses (parse-match-clauses clauses)] (let [clauses (parse-match-clauses clauses)]
(assoc clauses ::ast {::ast/type ::ast/match (assoc clauses ::ast {::ast/type ::ast/match
:token (current parser)
:expr (::ast match-expr) :expr (::ast match-expr)
:clauses (get-in clauses [::ast :clauses])})) :clauses (get-in clauses [::ast :clauses])}))
;; match expression with single match clause ;; match expression with single match clause
(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
:token (current parser)
:expr (::ast match-expr) :expr (::ast match-expr)
:clauses [(::ast clause)]})))) :clauses [(::ast clause)]}))))
@ -602,6 +618,7 @@
body (parse-expr (:parser arrow))] body (parse-expr (:parser arrow))]
(if (:success arrow) (if (:success arrow)
(assoc body ::ast {::ast/type ::ast/clause (assoc body ::ast {::ast/type ::ast/clause
:token (current parser)
:pattern (::ast pattern) :body (::ast body)}) :pattern (::ast pattern) :body (::ast body)})
(panic pattern "Expected -> in loop clause. Clauses must be in the form of (pattern) -> expression"))))) (panic pattern "Expected -> in loop clause. Clauses must be in the form of (pattern) -> expression")))))
@ -612,7 +629,7 @@
(case (::token/type curr) (case (::token/type curr)
::token/rbrace ::token/rbrace
(if (< 0 (count clauses)) (if (< 0 (count clauses))
(assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses}) (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses})
(panic parser "Expected one or more loop clauses" #{::token/rbrace})) (panic parser "Expected one or more loop clauses" #{::token/rbrace}))
::token/newline ::token/newline
@ -624,31 +641,34 @@
(defn- parse-loop [parser] (defn- parse-loop [parser]
(let [next (advance parser)] (let [next (advance parser)]
(if (= ::token/lparen (token-type next)) (if (= ::token/lparen (token-type next))
(let [loop-tup (parse-tuple next) (let [loop-tup (parse-tuple next)
loop-header (expect* #{::token/with} "Expected with" loop-tup)] loop-header (expect* #{::token/with} "Expected with" loop-tup)]
(if (:success loop-header) (if (:success loop-header)
(let [clauses (:parser loop-header)] (let [clauses (:parser loop-header)]
(if (= (token-type clauses) ::token/lbrace) (if (= (token-type clauses) ::token/lbrace)
;; loop expression with one or many clauses in braces ;; loop expression with one or many clauses in braces
(let [clauses (parse-loop-clauses clauses)] (let [clauses (parse-loop-clauses clauses)]
(assoc clauses ::ast {::ast/type ::ast/loop (assoc clauses ::ast {::ast/type ::ast/loop
:expr (::ast loop-tup) :token (current parser)
:clauses (get-in clauses [::ast :clauses])})) :expr (::ast loop-tup)
;; loop expression with single match clause :clauses (get-in clauses [::ast :clauses])}))
(let [clause (parse-loop-clause clauses)] ;; loop expression with single match clause
(assoc clause ::ast {::ast/type ::ast/loop (let [clause (parse-loop-clause clauses)]
:expr (::ast loop-tup) (assoc clause ::ast {::ast/type ::ast/loop
:clauses [(::ast clause)]})))) :token (current parser)
:expr (::ast loop-tup)
:clauses [(::ast clause)]}))))
(panic parser "Expected with after loop expression"))) (panic parser "Expected with after loop expression")))
(panic parser "Expected tuple as loop expression") (panic parser "Expected tuple as loop expression")
))) )))
(defn- parse-recur [parser] (defn- parse-recur [parser]
(let [next (advance parser)] (let [next (advance parser)]
(if (= ::token/lparen (token-type next)) (if (= ::token/lparen (token-type next))
(let [tuple (parse-tuple next)] (let [tuple (parse-tuple next)]
(assoc tuple ::ast {::ast/type ::ast/recur (assoc tuple ::ast {::ast/type ::ast/recur
:token (current parser)
:tuple (::ast tuple)}) :tuple (::ast tuple)})
) )
(panic parser "Expected tuple after recur") (panic parser "Expected tuple after recur")
@ -669,6 +689,7 @@
(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
:token (current parser)
:test (::ast expr) :body (::ast body)})) :test (::ast expr) :body (::ast body)}))
(panic expr "Expected -> in cond clause. Clauses must be in the form test_expression -> result_expression" #{::token/newline ::token/rbrace})))) (panic expr "Expected -> in cond clause. Clauses must be in the form test_expression -> result_expression" #{::token/newline ::token/rbrace}))))
@ -679,7 +700,7 @@
(case (::token/type curr) (case (::token/type curr)
::token/rbrace ::token/rbrace
(if (< 0 (count clauses)) (if (< 0 (count clauses))
(assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses}) (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses})
(panic parser "Expected one or more clauses" #{::rbrace})) (panic parser "Expected one or more clauses" #{::rbrace}))
@ -695,6 +716,7 @@
(if (:success header) (if (:success header)
(let [clauses (parse-cond-clauses (:parser header))] (let [clauses (parse-cond-clauses (:parser header))]
(assoc clauses ::ast {::ast/type ::ast/cond (assoc clauses ::ast {::ast/type ::ast/cond
:token (current parser)
:clauses (get-in clauses [::ast :clauses])}) :clauses (get-in clauses [::ast :clauses])})
) )
(panic parser "Expected { after cond") (panic parser "Expected { after cond")
@ -710,6 +732,7 @@
body (parse-expr (:parser arrow))] body (parse-expr (:parser arrow))]
(if (:success arrow) (if (:success arrow)
(assoc body ::ast {::ast/type ::ast/clause (assoc body ::ast {::ast/type ::ast/clause
:token (current parser)
:pattern (::ast pattern) :body (::ast body)}) :pattern (::ast pattern) :body (::ast body)})
(panic pattern "Expected -> in function clause. Clauses must be in the form of (pattern) -> expression"))))) (panic pattern "Expected -> in function clause. Clauses must be in the form of (pattern) -> expression")))))
@ -720,7 +743,7 @@
(case (::token/type curr) (case (::token/type curr)
::token/rbrace ::token/rbrace
(if (< 0 (count clauses)) (if (< 0 (count clauses))
(assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses}) (assoc (advance parser) ::ast {::ast/type ::ast/clauses :token (current parser) :clauses clauses})
(panic parser "Expected one or more function clauses" #{::token/rbrace})) (panic parser "Expected one or more function clauses" #{::token/rbrace}))
::token/newline ::token/newline
@ -735,12 +758,14 @@
::token/lparen ::token/lparen
(let [clause (parse-fn-clause name)] (let [clause (parse-fn-clause name)]
(assoc clause ::ast {::ast/type ::ast/fn (assoc clause ::ast {::ast/type ::ast/fn
:token (current parser)
:name (get-in name [::ast :word]) :name (get-in name [::ast :word])
:clauses [(::ast clause)]})) :clauses [(::ast clause)]}))
::token/lbrace ::token/lbrace
(let [clauses (parse-fn-clauses name)] (let [clauses (parse-fn-clauses name)]
(assoc clauses ::ast {::ast/type ::ast/fn (assoc clauses ::ast {::ast/type ::ast/fn
:token (current parser)
:name (get-in name [::ast :word]) :name (get-in name [::ast :word])
:clauses (get-in clauses [::ast :clauses])})) :clauses (get-in clauses [::ast :clauses])}))
@ -753,6 +778,7 @@
(let [clause (parse-fn-clause first)] (let [clause (parse-fn-clause first)]
(assoc clause ::ast {::ast/type ::ast/fn (assoc clause ::ast {::ast/type ::ast/fn
:name ::ast/anon :name ::ast/anon
:token (current parser)
:clauses [(::ast clause)]})) :clauses [(::ast clause)]}))
::token/word (parse-named-fn first) ::token/word (parse-named-fn first)
@ -769,6 +795,7 @@
(if (= ::token/pipeline next) (if (= ::token/pipeline next)
(recur (advance expr+newline) (conj exprs (::ast expr))) (recur (advance expr+newline) (conj exprs (::ast expr)))
(assoc expr ::ast {::ast/type ::ast/pipeline (assoc expr ::ast {::ast/type ::ast/pipeline
:token (current parser)
:exprs (conj exprs (::ast expr))}) :exprs (conj exprs (::ast expr))})
))))) )))))
@ -794,6 +821,7 @@
:else :else
(assoc name ::ast {::ast/type ::ast/import (assoc name ::ast {::ast/type ::ast/import
:token (current parser)
:path (get-in path [::ast :value]) :path (get-in path [::ast :value])
:name (get-in name [::ast :word])})))) :name (get-in name [::ast :word])}))))
@ -879,13 +907,7 @@
(do (do
(def pp pp/pprint) (def pp pp/pprint)
(def source "loop (10) with { (def source "foo
(0) -> print (:boom)
(n) -> {
print (:tick)
recur (dec (n))
}
}
") ")
(def lexed (scanner/scan source)) (def lexed (scanner/scan source))