ludus/janet/recursive.janet

### 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) )
)