191 lines
4.5 KiB
Plaintext
191 lines
4.5 KiB
Plaintext
### A recursive descent parser for Ludus
|
|
|
|
|
|
### First, some mutual recursion helpers
|
|
(defn unreachable
|
|
"A function that errors out if called."
|
|
[&] (error "cannot call recursive function before definition"))
|
|
|
|
(defmacro declare
|
|
"Forward-declares a function name, so that it can be called in a mutually recursive manner."
|
|
[& names]
|
|
(def bindings @[])
|
|
(loop [name :in names]
|
|
(def binding ~(var ,name unreachable))
|
|
(array/push bindings binding))
|
|
~(upscope ,;bindings))
|
|
|
|
(defmacro defrec
|
|
"Defines a function depended on by another function, that has been forward `declare`d."
|
|
[name & forms]
|
|
(if-not (dyn name) (error "recursive functions must be declared before they are defined"))
|
|
~(set ,name (defn ,name ,;forms)))
|
|
|
|
### Next: a data structure for a parser
|
|
(defn- new-parser [tokens]
|
|
@{
|
|
:tokens (tokens :tokens)
|
|
:ast @[]
|
|
:current 0
|
|
:errors @[]
|
|
})
|
|
|
|
### and some helper functions for interfacing with that data structure
|
|
(defn- current [parser]
|
|
(def curr (get (parser :tokens) (parser :current)))
|
|
(if (not curr)
|
|
(error "no more tokens")
|
|
curr))
|
|
|
|
|
|
(defn- peek [parser] (get (parser :tokens) (inc (parser :current))))
|
|
|
|
(defn- advance [parser] (update parser :current inc))
|
|
|
|
(defn- type [token] (get token :type))
|
|
|
|
(defn- check [parser type]
|
|
(def current-type (-> parser current (get :type)))
|
|
(= type current-type))
|
|
|
|
### Parsing functions
|
|
(declare nonbinding binding)
|
|
|
|
# errors
|
|
(def terminators [:break :newline :semicolon :eof])
|
|
|
|
(defn- terminates? [parser]
|
|
(def curr (current parser))
|
|
(def ttype (type curr))
|
|
(has-value? terminators ttype))
|
|
|
|
(defn- panic [parser message]
|
|
(print "Panic in the parser: " message)
|
|
(def origin (current parser))
|
|
(advance parser)
|
|
(def skipped @[origin])
|
|
(while (not (terminates? parser))
|
|
(array/push skipped (current parser))
|
|
(advance parser))
|
|
(array/push skipped (current parser))
|
|
(advance parser)
|
|
(error {:type :error :data skipped :token origin}))
|
|
|
|
(defn- expected [parser ttype]
|
|
(panic parser (string "expected " ttype ", got " (-> parser current type))))
|
|
|
|
(defn- expect [parser type]
|
|
(if-not (check parser type) (expected parser type)))
|
|
|
|
# atoms
|
|
(defn- bool [parser]
|
|
(expect parser :bool)
|
|
(def curr (-> parser current))
|
|
(def ttype (type curr))
|
|
(def value (if (= ttype :true) true false))
|
|
(advance parser)
|
|
{:type :bool :data value :token curr}
|
|
)
|
|
|
|
(defn- num [parser]
|
|
(expect parser :number)
|
|
(def curr (-> parser current))
|
|
(advance parser)
|
|
{:type :number :data (curr :literal) :token curr}
|
|
)
|
|
|
|
(defn- kw [parser]
|
|
(expect parser :keyword)
|
|
(def curr (-> parser current))
|
|
(advance parser)
|
|
{:type :keyword :data (curr :literal) :token curr}
|
|
)
|
|
|
|
(defn- nill [parser]
|
|
(expect parser :nil)
|
|
(advance parser)
|
|
{:type :nil :token (current parser)}
|
|
)
|
|
|
|
(defn- str [parser]
|
|
(expect parser :string)
|
|
(def curr (-> parser current))
|
|
(advance parser)
|
|
{:type :string :data (curr :literal) :token curr}
|
|
)
|
|
|
|
(def separates [:break :newline :comma])
|
|
|
|
(defn- separates? [parser]
|
|
(def curr (current parser))
|
|
(def ttype (type curr))
|
|
(has-value? separates ttype))
|
|
|
|
(defn- separators [parser]
|
|
(if-not (separates? parser)
|
|
(panic parser (string "expected separator, got " (-> parser current type))))
|
|
(while (separates? parser) (advance parser)))
|
|
|
|
(defn- tup-term [parser]
|
|
(def term (nonbinding parser))
|
|
(if (separates? parser)
|
|
(do
|
|
(while (separates? parser) (advance parser))
|
|
term)
|
|
(panic parser (string "expected separator, got " (type (current parser))))))
|
|
|
|
(defn- tup [parser]
|
|
(def origin (current parser))
|
|
(advance parser) # consume the :lparen
|
|
(def ast {:type :tuple :data @[] :token origin})
|
|
(while (separates? parser) (advance parser)) # consume any separators
|
|
(while (not (check parser :rparen))
|
|
(def term (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 nonbinding [parser]
|
|
(def curr (current parser))
|
|
(case (type curr)
|
|
# atoms
|
|
:nil (nill parser)
|
|
:true (bool parser)
|
|
:false (bool parser)
|
|
:number (num parser)
|
|
:keyword (kw parser)
|
|
|
|
# strings
|
|
:string (str parser)
|
|
### TODO: interpolated strings
|
|
|
|
# tuples
|
|
:lparen (tup parser)
|
|
|
|
(panic parser (string "expected nonbinding expression, got " (type curr)))
|
|
)
|
|
)
|
|
|
|
(defrec binding [parser]
|
|
(def curr (current parser))
|
|
(case (type curr)
|
|
:let nil
|
|
:fn nil
|
|
)
|
|
)
|
|
|
|
(os/cd "janet") # For repl to do relative imports
|
|
(import ./scanner :as s)
|
|
(do
|
|
#(comment
|
|
|
|
(def scanned (s/scan "(1, (2 3), 3)"))
|
|
(def a-parser (new-parser scanned))
|
|
(def parsed (nonbinding a-parser))
|
|
(-> parsed (get :data) )
|
|
)
|
|
|
|
|