diff --git a/janet/recursive.janet b/janet/recursive.janet index b33bf27..773e614 100644 --- a/janet/recursive.janet +++ b/janet/recursive.janet @@ -22,7 +22,9 @@ ~(set ,name (defn ,name ,;forms))) ### Next: a data structure for a parser -(defn- new-parser [tokens] +(defn- new-parser + "Creates a new parser data structure to pass around" + [tokens] @{ :tokens (tokens :tokens) :ast @[] @@ -31,42 +33,63 @@ }) ### 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- current + "Returns the current token of a parser. If the parser is at the last token, keeps returning the last token." + [parser] + (def tokens (parser :tokens)) + (get tokens (parser :current) (last tokens))) -(defn- peek [parser] (get (parser :tokens) (inc (parser :current)))) +(defn- peek + "Returns the next token of the parser. If the parser is at the last token, keeps returning the last token." + [parser] + (def tokens (parser :tokens)) + (get tokens (inc (parser :current)) (last tokens))) -(defn- advance [parser] (update parser :current inc)) +(defn- advance + "Advances the parser by a token" + [parser] + (update parser :current inc)) -(defn- type [token] (get token :type)) +(defn- type + "Returns the type of a token" + [token] + (get token :type)) -(defn- check [parser type] +(defn- check + "Returns true if the parser's current token is one of the passed types" + [parser type & types] + (def accepts [type ;types]) (def current-type (-> parser current (get :type))) - (= type current-type)) + (has-value? accepts current-type)) ### Parsing functions # forward declarations (declare simple nonbinding expr toplevel synthetic) # errors +# terminators are what terminate expressions (def terminators [:break :newline :semicolon :eof]) -(defn- terminates? [parser] +(defn- terminates? + "Returns true if the current token in the parser is a terminator" + [parser] (def curr (current parser)) (def ttype (type curr)) (has-value? terminators ttype)) +# breakers are what terminate panics (def breaking [:break :newline :semicolon :comma :eof :then :else]) -(defn- breaks? [parser] +(defn- breaks? + "Returns true if the current token in the parser should break a panic" + [parser] (def curr (current parser)) (def ttype (type curr)) (has-value? breaking ttype)) -(defn- panic [parser message] +(defn- panic + "Panics the parser: starts skipping tokens until a breaking token is encountered. Adds the error to the parser's errors array, and also errors out." + [parser message] (print "Panic in the parser: " message) (def origin (current parser)) (advance parser) @@ -79,18 +102,38 @@ (update parser :errors array/push err) (error err)) -(defn- expected [parser ttype] - (panic parser (string "expected " ttype ", got " (-> parser current type)))) +(defn- expected + "Panics the parser with a message: expected {type} got ..." + [parser ttype & ttypes] + (def expected (map string [ttype ;ttypes])) + (def type-msg (string/join expected " | ")) + (panic parser (string "expected {" type-msg "}, got " (-> parser current type)))) -(defn- expect [parser type] - (if-not (check parser type) (expected parser type))) +(defn- expect + "Panics if the parser's current token is not of type; otherwise does nothing & returns nil" + [parser type & types] + (if-not (check parser type ;types) (expected parser type ;types))) -(defn- expect-ret [parser type] +(defn- expect-ret + "Same as expect, but captures the error, returning it as a value" + [parser type] (try (expect parser type) ([e] e))) -(defn- capture [parse-fn parser] +(defn- capture + "Applies the parse function to the parser, returning the parsed AST. If there is a panic, captures the panic and returns it as a value." + [parse-fn parser] (try (parse-fn parser) ([e] e))) +(defn- accept-one + "Accepts a single token of passed type, advancing the parser if a match, doing nothing if not." + [parser type] + (if (check parser type) (advance parser))) + +(defn- accept-many + "Accepts any number of tokens of a passed type, advancing the parser on match until there are no more matches. Does nothing on no match." + [parser type] + (while (check parser type) (advance parser))) + # atoms (defn- bool [parser] (expect parser :bool) @@ -268,19 +311,59 @@ ast) ### conditional forms +# if {simple} then {nonbinding} else {nonbinding} (defn- iff [parser] (def ast {:type :if :data @[] :token (current parser)}) (advance parser) #consume the if (array/push (ast :data) (capture simple parser)) - (when-let [err (expect-ret parser :then)] (array/push (ast :data) err)) - (advance parser) + (accept-many parser :newline) + (if-let [err (expect-ret parser :then)] + (array/push (ast :data) err) + (advance parser)) (array/push (ast :data) (capture nonbinding parser)) - (when-let [err (expect-ret parser :else)] (array/push (ast :data) err)) - (advance parser) + (accept-many parser :newline) + (if-let [err (expect-ret parser :else)] + (array/push (ast :data) err) + (advance parser)) (array/push (ast :data) (capture nonbinding parser)) ast) -(defn- condd [parser]) + +(defn- terminator [parser] + (if-not (terminates? parser) (panic parser "expected terminator")) + (advance parser) + (while (terminates? parser) (advance parser))) + +# {simple} -> {nonbinding} {terminator} +(defn- when-clause [parser] + (def clause @[]) + (print "parsing lhs: " (-> parser current type)) + (array/push clause (capture simple parser)) + (print "parsing arrow") + (if-let [err (expect-ret parser :arrow)] + (array/push clause err) + (advance parser)) + (print "accepting newlines") + (accept-many parser :newline) + (print "parsing rhs") + (array/push clause (nonbinding parser)) + (print "parsing terminator") + (try (terminator parser) ([e] (array/push clause e))) + clause) + +(defn- whenn [parser] + (def ast {:type :when :data @[] :origin (current parser)}) + (advance parser) # consume cond + (if-let [err (expect-ret parser :lbrace)] + (do + (array/push (ast :data) err) + (break ast)) + (advance parser)) + (accept-many parser :newline) + (while (not (check parser :rbrace :eof)) + (array/push (ast :data) (capture when-clause parser))) + (advance parser) + ast) (defn- match [parser]) @@ -348,7 +431,7 @@ # conditional forms :if (iff parser) - :cond (unreachable) + :when (whenn parser) :match (unreachable) :with (unreachable) @@ -368,9 +451,9 @@ (defrec expr [parser] (def curr (current parser)) (case (type curr) - :let nil - :fn nil - :ref nil + :let (unreachable) + :fn (unreachable) + :ref (unreachable) :nil (nill parser) :true (bool parser) :false (bool parser) @@ -383,7 +466,7 @@ :startset (sett parser) :word (word parser) :if (iff parser) - :cond (unreachable) + :when (whenn parser) :match (unreachable) :with (unreachable) :do (unreachable) @@ -393,16 +476,16 @@ ) (defrec toplevel [parser] - (def curr (current parser)) + (def when (current parser)) (case (type curr) - :pkg nil - :ns nil - :test nil - :import nil - :use nil - :let nil - :fn nil - :ref nil + :pkg (unreachable) + :ns (unreachable) + :test (unreachable) + :import (unreachable) + :use (unreachable) + :let (unreachable) + :fn (unreachable) + :ref (unreachable) :nil (nill parser) :true (bool parser) :false (bool parser) @@ -415,7 +498,7 @@ :startset (sett parser) :word (word parser) :if (iff parser) - :cond (unreachable) + :when (whenn parser) :match (unreachable) :with (unreachable) :do (unreachable) @@ -424,14 +507,17 @@ ) ) -(os/cd "janet") # For repl to do relative imports +(os/cd "janet") # when repl to do relative imports (import ./scanner :as s) (do #(comment -(def source "if foo then else baz") +(def source "when { +foo -> bar +} +") (def scanned (s/scan source)) (def a-parser (new-parser scanned)) -(def parsed (nonbinding a-parser)) +(def parsed (whenn a-parser)) (-> parsed) )