(def return (new-parse-position return-value)
(list new-parse-position return-value))
(def match (f)
(only (fn (p)
(let x car.p
(if (f x)
(return cdr.p x))))))
(def alt parsers
(fn (p)
(some [_ p] parsers)))
(def seq parsers
(fn (p)
((afn (p parsers a)
(if parsers
(iflet (p2 r) (car.parsers p)
(self p2 cdr.parsers (cons r a)))
(return p rev.a)))
p parsers nil)))
(def many (parser)
(fn (p)
((afn (p a)
(iflet (s2 r) (parser p)
(self s2 (cons r a))
(return p rev.a)))
p nil)))
(def on-result (f parser)
(fn (p)
(iflet (p2 r) (parser p)
(return p2 (f r)))))
(mac with-result (vars parser . body)
`(on-result (fn (,vars) ,@body)
,parser))
(mac with-seq (vars-parsers . body)
(withs (ps (pair vars-parsers)
vars (map car ps)
parsers (map cadr ps))
`(on-result (fn (,vars) ,@body) (seq ,@parsers))))
(def cons-seq (a b)
(with-seq (r a
rs b)
(cons r rs)))
(def many1 (parser)
(cons-seq parser
(many parser)))
(def must (errmsg parser)
(fn (p)
(or (parser p)
(err errmsg))))
(def seqi (i parsers)
(with-result results (apply seq parsers)
(results i)))
(def seq1 p (seqi 0 p))
(def seq2 p (seqi 1 p))
(def optional (parser)
(alt parser
(fn (p)
(return p nil))))
(mac forward (parser)
(w/uniq p
`(fn (,p) (,parser ,p))))
(def match-is (x)
(match [is x _]))
(def match-literal (pat val)
(with (patlist (coerce pat 'cons)
patlen len.pat)
(fn (p)
(if (begins p patlist)
(return (nthcdr patlen p) val)))))
(def parse-intersperse (separator parser must-message)
(optional (cons-seq parser
(many (seq2 separator
(must must-message parser))))))
(def skipw (p)
(mem nonwhite p))
(def skipwhite (parser)
(fn (p)
(parser (skipw p))))
(def comma-separated (parser must-message)
(parse-intersperse (skipwhite:match-is #\,) parser must-message))
Download parsecomb0.arc.
Or, using the hackinator:
hack ycombinator.com/arc/arc3.1.tar \ awwx.ws/parsecomb0.arc
This code is in the public domain.
Questions? Comments? Email me andrew.wilcox [at] gmail.com