fix panic off-by-one-error

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,64 @@
  })
 
 ### 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
-(declare nonbinding binding synthetic)
+# 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]
- # (print "Panic in the 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)
  (def skipped @[origin])
@@ -74,16 +98,41 @@
   (array/push skipped (current parser))
   (advance parser))
  (array/push skipped (current parser))
- # (advance parser)
  (def err {:type :error :data skipped :token origin :msg message})
  (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 
+ "Same as expect, but captures the error, returning it as a value"
+ [parser type]
+ (try (expect parser type) ([e] e)))
+
+(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]
@@ -220,7 +269,7 @@
  (advance parser)
  ast)
 
-(defn- set [parser]
+(defn- sett [parser]
  (def origin (current parser))
  (advance parser)
  (def ast {:type :set :data @[] :token origin})
@@ -261,6 +310,75 @@
  (advance parser)
  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))
+ (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))
+ (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)
+
+### XXX: We've got an off-by-one error here
+# We're expecting a terminator, we panic until we get to a terminator, and we then return back to something that expects a terminator, and now we've started parsing again *at the terminator*
+(defn- terminator [parser]
+ (if-not (terminates? parser) 
+  # this line panics, captures the panic, advances the parser, and re-throws the error
+  (try (panic parser "expected terminator") ([e] (advance parser) (error e))))
+ (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])
+
+### function forms
+(defn- fnn [parser])
+
+(defn- lambda [parser])
+
+### compoound forms
+(defn- block [parser])
+
+(defn- doo [parser])
 
 ### expressions
 # four levels of expression complexity:
@@ -315,8 +433,8 @@
   :word (word parser)
 
   # conditional forms
-  :if (unreachable)
-  :cond (unreachable)
+  :if (iff parser)
+  :when (whenn parser)
   :match (unreachable)
   :with (unreachable)
 
@@ -336,9 +454,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)
@@ -350,8 +468,8 @@
   :startdict (dict parser)
   :startset (sett parser)
   :word (word parser)
-  :if (unreachable)
-  :cond (unreachable)
+  :if (iff parser)
+  :when (whenn parser)
   :match (unreachable)
   :with (unreachable)
   :do (unreachable)
@@ -361,16 +479,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)
@@ -382,8 +500,8 @@
   :startdict (dict parser)
   :startset (sett parser)
   :word (word parser)
-  :if (unreachable)
-  :cond (unreachable)
+  :if (iff parser)
+  :when (whenn parser)
   :match (unreachable)
   :with (unreachable)
   :do (unreachable)
@@ -392,15 +510,20 @@
  )
 )
 
-(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 scanned (s/scan "#{}"))
+(def source `when {
+ foo -> bar quux
+ bar -> baz
+}
+`)
+(def scanned (s/scan source))
 (def a-parser (new-parser scanned))
-(def parsed (nonbinding a-parser))
+(def parsed (whenn a-parser))
 (-> parsed)
+# (map (fn [t] (t :type)) (scanned :tokens))
 )
 
 

janet/scanner.janet

@@ -259,12 +259,12 @@
       "\n" (add-token (update scanner :line inc) :newline)
       "\\" (add-token scanner :backslash)
       "=" (add-token scanner :equals)
-      ">" (add-token scanner :pipeline)
+      ">" (add-token (add-token scanner :break) :pipeline)
 
       ## two-character tokens
       ## ->
       "-" (cond
-           (= next ">") (add-token (advance scanner) :rarrow)
+           (= next ">") (add-token (advance scanner) :arrow)
            (digit? next) (add-number char scanner)
            :else (add-error scanner (string "Expected -> or negative number after `-`. Got `" char next "`")))