complete simple expressions
This commit is contained in:
parent
98fcfe7eb4
commit
05703a27fa
|
@ -4,7 +4,7 @@
|
||||||
### First, some mutual recursion helpers
|
### First, some mutual recursion helpers
|
||||||
(defn unreachable
|
(defn unreachable
|
||||||
"A function that errors out if called."
|
"A function that errors out if called."
|
||||||
[&] (error "cannot call recursive function before definition"))
|
[&] (error "reached the unreachable"))
|
||||||
|
|
||||||
(defmacro declare
|
(defmacro declare
|
||||||
"Forward-declares a function name, so that it can be called in a mutually recursive manner."
|
"Forward-declares a function name, so that it can be called in a mutually recursive manner."
|
||||||
|
@ -37,7 +37,6 @@
|
||||||
(error "no more tokens")
|
(error "no more tokens")
|
||||||
curr))
|
curr))
|
||||||
|
|
||||||
|
|
||||||
(defn- peek [parser] (get (parser :tokens) (inc (parser :current))))
|
(defn- peek [parser] (get (parser :tokens) (inc (parser :current))))
|
||||||
|
|
||||||
(defn- advance [parser] (update parser :current inc))
|
(defn- advance [parser] (update parser :current inc))
|
||||||
|
@ -49,7 +48,7 @@
|
||||||
(= type current-type))
|
(= type current-type))
|
||||||
|
|
||||||
### Parsing functions
|
### Parsing functions
|
||||||
(declare nonbinding binding)
|
(declare nonbinding binding synthetic)
|
||||||
|
|
||||||
# errors
|
# errors
|
||||||
(def terminators [:break :newline :semicolon :eof])
|
(def terminators [:break :newline :semicolon :eof])
|
||||||
|
@ -59,17 +58,26 @@
|
||||||
(def ttype (type curr))
|
(def ttype (type curr))
|
||||||
(has-value? terminators ttype))
|
(has-value? terminators ttype))
|
||||||
|
|
||||||
|
(def breaking [:break :newline :semicolon :comma :eof :then :else])
|
||||||
|
|
||||||
|
(defn- breaks? [parser]
|
||||||
|
(def curr (current parser))
|
||||||
|
(def ttype (type curr))
|
||||||
|
(has-value? breaking ttype))
|
||||||
|
|
||||||
(defn- panic [parser message]
|
(defn- panic [parser message]
|
||||||
(print "Panic in the parser: " message)
|
# (print "Panic in the parser: " message)
|
||||||
(def origin (current parser))
|
(def origin (current parser))
|
||||||
(advance parser)
|
(advance parser)
|
||||||
(def skipped @[origin])
|
(def skipped @[origin])
|
||||||
(while (not (terminates? parser))
|
(while (not (breaks? parser))
|
||||||
(array/push skipped (current parser))
|
(array/push skipped (current parser))
|
||||||
(advance parser))
|
(advance parser))
|
||||||
(array/push skipped (current parser))
|
(array/push skipped (current parser))
|
||||||
(advance parser)
|
# (advance parser)
|
||||||
(error {:type :error :data skipped :token origin}))
|
(def err {:type :error :data skipped :token origin :msg message})
|
||||||
|
(update parser :errors array/push err)
|
||||||
|
(error err))
|
||||||
|
|
||||||
(defn- expected [parser ttype]
|
(defn- expected [parser ttype]
|
||||||
(panic parser (string "expected " ttype ", got " (-> parser current type))))
|
(panic parser (string "expected " ttype ", got " (-> parser current type))))
|
||||||
|
@ -96,6 +104,7 @@
|
||||||
|
|
||||||
(defn- kw [parser]
|
(defn- kw [parser]
|
||||||
(expect parser :keyword)
|
(expect parser :keyword)
|
||||||
|
(if (= :lparen (-> parser peek type)) (break (synthetic parser)))
|
||||||
(def curr (-> parser current))
|
(def curr (-> parser current))
|
||||||
(advance parser)
|
(advance parser)
|
||||||
{:type :keyword :data (curr :literal) :token curr}
|
{:type :keyword :data (curr :literal) :token curr}
|
||||||
|
@ -114,6 +123,7 @@
|
||||||
{:type :string :data (curr :literal) :token curr}
|
{:type :string :data (curr :literal) :token curr}
|
||||||
)
|
)
|
||||||
|
|
||||||
|
# words & synthetic expressions
|
||||||
(def separates [:break :newline :comma])
|
(def separates [:break :newline :comma])
|
||||||
|
|
||||||
(defn- separates? [parser]
|
(defn- separates? [parser]
|
||||||
|
@ -126,14 +136,57 @@
|
||||||
(panic parser (string "expected separator, got " (-> parser current type))))
|
(panic parser (string "expected separator, got " (-> parser current type))))
|
||||||
(while (separates? parser) (advance parser)))
|
(while (separates? parser) (advance parser)))
|
||||||
|
|
||||||
(defn- tup-term [parser]
|
(def sequels [:lparen :keyword])
|
||||||
(def term (nonbinding parser))
|
|
||||||
(if (separates? parser)
|
|
||||||
(do
|
|
||||||
(while (separates? parser) (advance parser))
|
|
||||||
term)
|
|
||||||
(panic parser (string "expected separator, got " (type (current parser))))))
|
|
||||||
|
|
||||||
|
(defn- word [parser]
|
||||||
|
(expect parser :word)
|
||||||
|
(if (has-value? sequels (-> parser peek type)) (break (synthetic parser)))
|
||||||
|
(def curr (-> parser current))
|
||||||
|
(advance parser)
|
||||||
|
{:type :word :data (curr :lexeme) :token curr}
|
||||||
|
)
|
||||||
|
|
||||||
|
(defn- args [parser]
|
||||||
|
(def origin (current parser))
|
||||||
|
(advance parser) # consume the :lparen
|
||||||
|
(def ast @{:type :args :data @[] :token origin :partial false})
|
||||||
|
(while (separates? parser) (advance parser)) # consume any separators
|
||||||
|
(while (not (check parser :rparen))
|
||||||
|
(def origin (current parser))
|
||||||
|
(def term (if (check parser :placeholder)
|
||||||
|
(if (ast :partial)
|
||||||
|
(do
|
||||||
|
(def err {:type :error :data [] :token origin :msg "partially applied functions may only use one placeholder"})
|
||||||
|
(advance parser)
|
||||||
|
(update parser :errors array/push err)
|
||||||
|
err)
|
||||||
|
(do
|
||||||
|
(set (ast :partial) true)
|
||||||
|
(advance parser)
|
||||||
|
{:type :placeholder :token origin}))
|
||||||
|
(try (nonbinding parser) ([e] e))))
|
||||||
|
(array/push (ast :data) term)
|
||||||
|
(try (separators parser)
|
||||||
|
([e] (pp e) (array/push (ast :data) e))))
|
||||||
|
(advance parser)
|
||||||
|
ast)
|
||||||
|
|
||||||
|
(defrec synthetic [parser]
|
||||||
|
(def origin (current parser))
|
||||||
|
(def ast {:type :synthetic :data @[origin] :token origin})
|
||||||
|
(advance parser)
|
||||||
|
(while (has-value? sequels (-> parser current type))
|
||||||
|
(def term
|
||||||
|
(case (-> parser current type)
|
||||||
|
:lparen (args parser)
|
||||||
|
:keyword (kw parser)
|
||||||
|
))
|
||||||
|
(array/push (ast :data) term)
|
||||||
|
)
|
||||||
|
ast
|
||||||
|
)
|
||||||
|
|
||||||
|
# collections
|
||||||
(defn- tup [parser]
|
(defn- tup [parser]
|
||||||
(def origin (current parser))
|
(def origin (current parser))
|
||||||
(advance parser) # consume the :lparen
|
(advance parser) # consume the :lparen
|
||||||
|
@ -147,6 +200,96 @@
|
||||||
(advance parser)
|
(advance parser)
|
||||||
ast)
|
ast)
|
||||||
|
|
||||||
|
(defn- list [parser]
|
||||||
|
(def origin (current parser))
|
||||||
|
(advance parser)
|
||||||
|
(def ast {:type :list :data @[] :token origin})
|
||||||
|
(while (separates? parser) (advance parser))
|
||||||
|
(while (not (check parser :rbracket))
|
||||||
|
(def origin (current parser))
|
||||||
|
(def term (if (check parser :splat)
|
||||||
|
(do
|
||||||
|
(advance parser)
|
||||||
|
(def splatted (try (word parser) ([e] e)))
|
||||||
|
{:type :splat :data splatted :token origin}
|
||||||
|
)
|
||||||
|
(try (nonbinding parser) ([e] e))))
|
||||||
|
(array/push (ast :data) term)
|
||||||
|
(try (separators parser)
|
||||||
|
([e] (array/push (ast :data) e))))
|
||||||
|
(advance parser)
|
||||||
|
ast)
|
||||||
|
|
||||||
|
(defn- set [parser]
|
||||||
|
(def origin (current parser))
|
||||||
|
(advance parser)
|
||||||
|
(def ast {:type :set :data @[] :token origin})
|
||||||
|
(while (separates? parser) (advance parser))
|
||||||
|
(while (not (check parser :rbrace))
|
||||||
|
(def origin (current parser))
|
||||||
|
(def term (if (check parser :splat)
|
||||||
|
(do
|
||||||
|
(advance parser)
|
||||||
|
(def splatted (try (word parser) ([e] e)))
|
||||||
|
{:type :splat :data splatted :token origin}
|
||||||
|
)
|
||||||
|
(try (nonbinding parser) ([e] e))))
|
||||||
|
(array/push (ast :data) term)
|
||||||
|
(try (separators parser)
|
||||||
|
([e] (array/push (ast :data) e))))
|
||||||
|
(advance parser)
|
||||||
|
ast)
|
||||||
|
|
||||||
|
(defn- dict [parser]
|
||||||
|
(def origin (current parser))
|
||||||
|
(advance parser)
|
||||||
|
(def ast {:type :dict :data @[] :token origin})
|
||||||
|
(while (separates? parser) (advance parser))
|
||||||
|
(while (not (check parser :rbrace))
|
||||||
|
(def origin (current parser))
|
||||||
|
(def term (case (type origin)
|
||||||
|
:splat {:type :splat :data (try (word (advance parser)) ([e] e)) :token origin}
|
||||||
|
:word (try (word parser) ([e] e))
|
||||||
|
:keyword (do
|
||||||
|
(def key (try (kw parser) ([e] e)))
|
||||||
|
(def value (try (nonbinding parser) ([e] e)))
|
||||||
|
{:type :pair :data [key value] :token origin})
|
||||||
|
(try (panic parser (string expect "expected dict term, got " (type origin))) ([e] e))
|
||||||
|
))
|
||||||
|
(array/push (ast :data) term)
|
||||||
|
(try (separators parser) ([e] (array/push (ast :data) e))))
|
||||||
|
(advance parser)
|
||||||
|
ast)
|
||||||
|
|
||||||
|
|
||||||
|
### expressions
|
||||||
|
# four levels of expression complexity:
|
||||||
|
# simple (atoms, collections, synthetic expressions; no conditionals or binding or blocks)
|
||||||
|
# nonbinding (excludes let, ref, named fn: what is allowed inside collections)
|
||||||
|
# plain old exprs (anything but toplevel)
|
||||||
|
# toplevel (exprs + ns, pkg, test, import, use)
|
||||||
|
|
||||||
|
# simple expressions: what can go anywhere you expect an expression
|
||||||
|
(defrec simple [parser]
|
||||||
|
(def curr (current parser))
|
||||||
|
(case (type curr)
|
||||||
|
:nil (nill parser)
|
||||||
|
:true (bool parser)
|
||||||
|
:false (bool parser)
|
||||||
|
:number (num parser)
|
||||||
|
:keyword (kw parser)
|
||||||
|
:string (str parser)
|
||||||
|
:lparen (tup parser)
|
||||||
|
:lbracket (list parser)
|
||||||
|
:startdict (dict parser)
|
||||||
|
:startset (sett parser)
|
||||||
|
:word (word parser)
|
||||||
|
(panic parser (string expect "expected simple expression, got " (type curr)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
# non-binding expressions
|
||||||
|
# the rhs of lets, clauses, inside conditional forms, etc.
|
||||||
(defrec nonbinding [parser]
|
(defrec nonbinding [parser]
|
||||||
(def curr (current parser))
|
(def curr (current parser))
|
||||||
(case (type curr)
|
(case (type curr)
|
||||||
|
@ -160,19 +303,92 @@
|
||||||
# strings
|
# strings
|
||||||
:string (str parser)
|
:string (str parser)
|
||||||
### TODO: interpolated strings
|
### TODO: interpolated strings
|
||||||
|
:interpolated (unreachable)
|
||||||
|
|
||||||
# tuples
|
# collection literals
|
||||||
:lparen (tup parser)
|
:lparen (tup parser)
|
||||||
|
:lbracket (list parser)
|
||||||
|
:startdict (dict parser)
|
||||||
|
:startset (sett parser)
|
||||||
|
|
||||||
|
# synthetic
|
||||||
|
:word (word parser)
|
||||||
|
|
||||||
|
# conditional forms
|
||||||
|
:if (unreachable)
|
||||||
|
:cond (unreachable)
|
||||||
|
:match (unreachable)
|
||||||
|
:with (unreachable)
|
||||||
|
|
||||||
|
# do
|
||||||
|
:do (unreachable)
|
||||||
|
|
||||||
|
# fn: but only lambda
|
||||||
|
:fn (unreachable)
|
||||||
|
|
||||||
|
# blocks
|
||||||
|
:lbrace (unreachable)
|
||||||
|
|
||||||
(panic parser (string "expected nonbinding expression, got " (type curr)))
|
(panic parser (string "expected nonbinding expression, got " (type curr)))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
(defrec binding [parser]
|
(defrec expr [parser]
|
||||||
(def curr (current parser))
|
(def curr (current parser))
|
||||||
(case (type curr)
|
(case (type curr)
|
||||||
:let nil
|
:let nil
|
||||||
:fn nil
|
:fn nil
|
||||||
|
:ref nil
|
||||||
|
:nil (nill parser)
|
||||||
|
:true (bool parser)
|
||||||
|
:false (bool parser)
|
||||||
|
:number (num parser)
|
||||||
|
:keyword (kw parser)
|
||||||
|
:string (str parser)
|
||||||
|
:lparen (tup parser)
|
||||||
|
:lbracket (list parser)
|
||||||
|
:startdict (dict parser)
|
||||||
|
:startset (sett parser)
|
||||||
|
:word (word parser)
|
||||||
|
:if (unreachable)
|
||||||
|
:cond (unreachable)
|
||||||
|
:match (unreachable)
|
||||||
|
:with (unreachable)
|
||||||
|
:do (unreachable)
|
||||||
|
:lbrace (unreachable)
|
||||||
|
(panic parser (string "expected expression, got " (type curr)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(defrec toplevel [parser]
|
||||||
|
(def curr (current parser))
|
||||||
|
(case (type curr)
|
||||||
|
:pkg nil
|
||||||
|
:ns nil
|
||||||
|
:test nil
|
||||||
|
:import nil
|
||||||
|
:use nil
|
||||||
|
:let nil
|
||||||
|
:fn nil
|
||||||
|
:ref nil
|
||||||
|
:nil (nill parser)
|
||||||
|
:true (bool parser)
|
||||||
|
:false (bool parser)
|
||||||
|
:number (num parser)
|
||||||
|
:keyword (kw parser)
|
||||||
|
:string (str parser)
|
||||||
|
:lparen (tup parser)
|
||||||
|
:lbracket (list parser)
|
||||||
|
:startdict (dict parser)
|
||||||
|
:startset (sett parser)
|
||||||
|
:word (word parser)
|
||||||
|
:if (unreachable)
|
||||||
|
:cond (unreachable)
|
||||||
|
:match (unreachable)
|
||||||
|
:with (unreachable)
|
||||||
|
:do (unreachable)
|
||||||
|
:lbrace (unreachable)
|
||||||
|
(panic parser (string "expected expression, got " (type curr)))
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -181,10 +397,10 @@
|
||||||
(do
|
(do
|
||||||
#(comment
|
#(comment
|
||||||
|
|
||||||
(def scanned (s/scan "(1, (2 3), 3)"))
|
(def scanned (s/scan "#{}"))
|
||||||
(def a-parser (new-parser scanned))
|
(def a-parser (new-parser scanned))
|
||||||
(def parsed (nonbinding a-parser))
|
(def parsed (nonbinding a-parser))
|
||||||
(-> parsed (get :data) )
|
(-> parsed)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -297,7 +297,7 @@
|
||||||
## splats
|
## splats
|
||||||
"." (let [after_next (current-char (advance scanner))]
|
"." (let [after_next (current-char (advance scanner))]
|
||||||
(if (= ".." (string next after_next))
|
(if (= ".." (string next after_next))
|
||||||
(add-token (advance (advance scanner)) :splat)
|
(add-token (advance scanner) :splat)
|
||||||
(add-error scanner (string "Expected splat: ... . Got " (string "." next after_next)))))
|
(add-error scanner (string "Expected splat: ... . Got " (string "." next after_next)))))
|
||||||
|
|
||||||
## strings
|
## strings
|
||||||
|
|
Loading…
Reference in New Issue
Block a user