├── .gitignore ├── LICENSE.txt ├── README.md ├── parse.asd └── parse.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.*fasl 3 | *.*fsl 4 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | This file is provided to you under the Apache License, 2 | Version 2.0 (the "License"); you may not use this file 3 | except in compliance with the License. You may obtain 4 | a copy of the License at 5 | 6 | http://www.apache.org/licenses/LICENSE-2.0 7 | 8 | Unless required by applicable law or agreed to in writing, 9 | software distributed under the License is distributed on an 10 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 11 | KIND, either express or implied. See the License for the 12 | specific language governing permissions and limitations 13 | under the License. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # The PARSE Package 2 | 3 | The parse package is a simple token parsing library for Common Lisp. 4 | 5 | It is based on Haskell's [Parsec](http://hackage.haskell.org/package/parsec-3.1.9/docs/Text-Parsec.html) library, but using macros to make more accessible to Lisp. 6 | 7 | In a few technical bullet points, it is: 8 | 9 | * [Top-down](https://en.wikipedia.org/wiki/Top-down_parsing) 10 | * [Recursive-descent](https://en.wikipedia.org/wiki/Recursive_descent_parser) 11 | * [Backtracking - LL(k)](https://en.wikipedia.org/wiki/LL_parser) 12 | * [Combinatory](https://en.wikipedia.org/wiki/Parser_combinator) 13 | * [Monadic](https://en.wikipedia.org/wiki/Monad_%28category_theory%29) 14 | 15 | ## Token Generation 16 | 17 | Before we can parse, we need to generate tokens. 18 | 19 | The `parse` function must be given a function with 0-arity that can be called whenever it needs to read another token. This *next-token* function should return 2 values for each token: 20 | 21 | * The token class (typically a keyword) 22 | * The token value (optional) 23 | 24 | When there are no more tokens in the source stream, it should return `nil`. *Note: it may be called several times at the end of the token stream, so it should handle that condition.* 25 | 26 | Let's create a simple token function we can use for the rest of our parsing examples. It will simply read the next the next value from a list and return that value as the token's value, and use the type as the token's class. 27 | 28 | (defun make-token-reader (list) 29 | #'(lambda () 30 | (let ((x (pop list))) 31 | (when x 32 | (etypecase x 33 | (string (values :string x)) 34 | (character (values :character x)) 35 | (number (values :number x)) 36 | (symbol (values :symbol x))))))) 37 | 38 | *Note: this example shows that tokens can be generated many ways. However, the most common method of generating tokens would be with a [`lexer`](http://github.com/massung/lexer) package.* 39 | 40 | ## Quickstart 41 | 42 | Now that we can generate tokens, let's take a look at the `parse` function and try some simple examples. 43 | 44 | (parse parser next-token &key initial-state (errorp t) error-value) 45 | 46 | Ignoring the keyword arguments for now, simply note that the parse function requires both a parse combinator function (*parser*) and a token generator function (*next-token*). 47 | 48 | Let's parse a symbol... 49 | 50 | CL-USER > (parse (.is :symbol) (make-token-reader '(a b c))) 51 | A 52 | T 53 | 54 | The first value returned is the result of the parse combinator function (in this case the value of the token parsed), and `T` indicating that the parse was successful. 55 | 56 | However, our parse functions are *combinatory*, so let's chain some more in there to make it a bit more interesting. 57 | 58 | CL-USER > (parse (.many1 (.is :symbol)) (make-token-reader '(a b c))) 59 | (A B C) 60 | T 61 | 62 | Excellent! What if we supply the wrong tokens, though? 63 | 64 | CL-USER > (parse (.many1 (.is :symbol)) (make-token-reader '(1 2 3))) 65 | Parse failure 66 | 67 | Our parser expected symbols and was given numbers. Good. But, maybe we want to read symbols or numbers? 68 | 69 | CL-USER > (parse (.many1 (.either (.is :symbol) (.is :number))) (make-token-reader '(a 1 b 2 c 3))) 70 | (A 1 B 2 C 3) 71 | T 72 | 73 | Okay, but now our parser is getting to be a bit unwieldy. Let's actually define our parser outside the REPL. In addition, let's parse symbols or numbers, but only keep the numbers in the resulting list. 74 | 75 | (define-parser number-parser 76 | "Parse a list of numbers, ignoring all symbols." 77 | (.many1 (.either (.is :number) 78 | (.do (.skip-many1 (.is :symbol)) 79 | (.is :number))))) 80 | 81 | Looking at this combinator, it tries (1 or more times) to either parse a number, or - if that fails - skip 1 or more symbols, and then parse a number. 82 | 83 | Now, let's plug it in and see what we get. 84 | 85 | CL-USER > (parse 'number-parser (make-token-reader '(a z 1 b 2 c 3))) 86 | (1 2 3) 87 | T 88 | 89 | ## Returning Values 90 | 91 | Until now, we've been using the `.is` parse combinator, which always returns the value of the token parsed. But, sometimes it's useful to return other values instead. This is done with the `.ret` parse combinator. 92 | 93 | CL-USER > (parse (.ret 10) (make-token-reader nil)) 94 | 10 95 | T 96 | 97 | It's important to use `.ret`, as the values being returned must be put into a parse combinator function. 98 | 99 | For another example, let's create a parser that returns the character code of any characters parsed. 100 | 101 | (define-parser char-code-parser 102 | "Parses a character, returns its character code." 103 | (.let (c (.is :character)) 104 | (.ret (char-code c)))) 105 | 106 | And try it... 107 | 108 | CL-USER > (parse 'char-code-parser (make-token-reader '(#\!))) 109 | 33 110 | T 111 | 112 | ## Backtracking 113 | 114 | The `parse` package supports arbitrarily deep backtracking. We can test this with a simple parse combinator... 115 | 116 | (define-parser backtracker 117 | "Test backtracking." 118 | (.either (.do (.skip-many1 (.is :number)) (.is :char)) 119 | (.do (.skip-many1 (.is :number)) (.is :symbol)))) 120 | 121 | The above combinator should parse a bunch of numbers and then either a character or a symbol. Once it has parsed a list of numbers, though, if it fails to parse a character it needs to backtrack in order to try the next combinator. 122 | 123 | CL-USER > (parse 'backtracker (make-token-reader '(1 2 3 a))) 124 | A 125 | T 126 | 127 | Success! 128 | 129 | *Note: it's more efficient to write your parsers to be predictive when possible. The above parser can be re-written to be predictive like so:* 130 | 131 | (define-parser predictive 132 | "A predictive version of the backtracker combinator." 133 | (.do (.skip-many1 (.is :number)) 134 | (.either (.is :char) 135 | (.is :symbol)))) 136 | 137 | With the predictive version, the parser can just keep moving forward and not have to rewind state, and parse the same tokens again. 138 | 139 | ## Error Handling 140 | 141 | Remember the *errorp* and *error-value* keyword arguments to the `parse` function? They will control what happens from a parse failure. 142 | 143 | If *errorp* it's set to `nil`, then instead of signaling a parse failure error, *error-value* will be returned, along with `nil` indicating that the parse failed. 144 | 145 | CL-USER > (parse 'number-parser (make-token-reader '(#\a)) :errorp nil :error-value 'ack) 146 | ACK 147 | NIL 148 | 149 | There is also a `.fail` parse combinator function that can be used to report an error in parsing. It will signal an error during parsing. If *errorp* is `nil` and `.fail` is tripped, the error will be ignored and the parse will fail. 150 | 151 | ## Parsing With State 152 | 153 | The parse monad also has state data associated with it. This data can be gotten (`.get`), set (`.put`), etc. It is yours to do with as you please. 154 | 155 | Let's create a parse combinator that will accumulate all the numbers it comes across in a token stream. 156 | 157 | (define-parser sum-parser 158 | "Add all number tokens together." 159 | (.do (.many (.or (.let (n (.is :number)) 160 | (.modify #'(lambda (x) (+ x n)))) 161 | (.any))) 162 | (.get))) 163 | 164 | Let's give it a whirl... 165 | 166 | CL-USER > (parse 'sum-parser (make-token-reader '(1 a 2 b 3 c)) :initial-state 0) 167 | 6 168 | T 169 | 170 | *Note: we needed to set the `:initial-state` of the parse monad!* 171 | 172 | Parse state data can be useful for all sorts of things. For example, while parsing a markup language (e.g. XML), the parse state might hold a stack of tags. 173 | 174 | ## Gotchyas 175 | 176 | It's important to remember that while the parse combinators are functional, Common Lisp is neither a [purely functional](https://en.wikipedia.org/wiki/Purely_functional) nor [lazy](https://en.wikipedia.org/wiki/Lazy_evaluation) language! 177 | 178 | #### Side Effects in Combinators 179 | 180 | *All your parse combinators should be 100% free of side-effects!* 181 | 182 | Due to backtracking and the eagerness of building the parse combinators, code can execute during parsing that you didn't think would parse. For example: 183 | 184 | (define-parser oops-parser 185 | "Show an example of a bad parser." 186 | (.either (.do (.is :number) 187 | (.ret (print 'ack))) 188 | (.let (s (.is :string)) 189 | (.ret (print s))))) 190 | 191 | The above parser looks like it will print "ACK" *only* if a number is parsed. But, let's see what actually happens... 192 | 193 | CL-USER > (parse 'oops-parser (make-token-reader '("Test"))) 194 | ACK 195 | "Test" 196 | 197 | The "ACK" was printed anyway, because the `.ret` function evaluated its arguments in order to build the parse combinator. 198 | 199 | #### Shared State 200 | 201 | While the parse state is copied between combinators - allowing for backtracking - if the state is an instance of an object, then the state data will be shallow copy. 202 | 203 | This means that it's possible to be walking down one parse branch that will eventually fail, modify the parse state, then backtrack to a correct branch, which is now working with an invalid parse state. 204 | 205 | ## Real-World Examples 206 | 207 | Some real-world examples that use a [`lexer`](http://github.com/massung/lexer) to tokenize as well, check out the code in the following respositories: 208 | 209 | * [URL](http://github.com/massung/url) 210 | * [XML](http://github.com/massung/xml) 211 | * [TOML](http://github.com/sgarciac/sawyer) 212 | 213 | ## Documentation 214 | 215 | Here are all the built-in parse combinator functions: 216 | 217 | **>>=** *p f* 218 | 219 | Bind the result of parsing *p* by passing it to the function *f*. The result of *f* is expected to be a parse combinator. 220 | 221 | **>>** *p m* 222 | 223 | Ignore the result of parsing *p* and immediately chain the parse combinator *m*. 224 | 225 | **.prog1** *form &body body* (macro) 226 | 227 | Just like **prog1**, except that the results of the first form are returned to the parse monad with **.ret**. Useful for executing random Lisp code inside a parse combinator (beware of side-effects!). 228 | 229 | **.progn** *&body body* (macro) 230 | 231 | Just like **progn**, except that the results of the last form in *body* are returned to the parse monad with **.ret**. Useful for executing random Lisp code inside a parse combinator (beware of side-effects!). 232 | 233 | **.let** (*var p*) *&body body* (macro) 234 | 235 | Parse *p* and bind the result into *var*. Execute *body*. The final value of *body* needs to be a parse combinator to continue execution. 236 | 237 | **.let*** (*binding &rest bindings*) *&body body* (macro) 238 | 239 | Create bindings and chain then together. Similar to **.let**. 240 | 241 | **.do** (*p &rest ps*) (macro) 242 | 243 | Parse *p* and each combinator in *ps* in order. Ignore all the intermediate results and return the last one. This is just a wrapper around chaining **>>** combinators. 244 | 245 | **.or** (*p &rest ps*) (macro) 246 | 247 | Attempts to parse *p* and each combinator in *ps*. Returns the first successful result and ignores the rest. This is a wrapper around chaining **.either** combinators. 248 | 249 | **.ret** *x* 250 | 251 | Returns the value *x*. 252 | 253 | **.fail** *datum &rest arguments* 254 | 255 | Signals an error. Use this instead of *error* because it will not be evaluated unless the parse combinator is called. 256 | 257 | **.get** 258 | 259 | Each parse state has data associated with it. This parse combinator always succeeds and returns that data. 260 | 261 | **.put** *x* 262 | 263 | Replaces the current parse state data with *x*. Returns *x*. 264 | 265 | **.modify** *function* 266 | 267 | Gets the current parse state data and passes it to *function*. The return value is then put back into the parse state data. 268 | 269 | **.push** *x* 270 | 271 | Assumes the current parse state data is a list, and pushes *x* onto the head of the list. Returns the new parse state data. 272 | 273 | **.pop** 274 | 275 | Assumes the parse state data is a list and pops the top value off the list. Returns the value popped, and puts the rest of the list back into the parse state data. 276 | 277 | **.any** 278 | 279 | Matches any token. Returns the value of the token. 280 | 281 | **.eof** 282 | 283 | Matches if at the end of the token stream. Returns `nil`. 284 | 285 | **.is** *class* 286 | 287 | Matches the current token against *class*. Returns the value of the token. 288 | 289 | **.either** *p1 p2* 290 | 291 | Attempts to parse *p1*. If that fails, tries *p2*. 292 | 293 | **.opt** *x p* 294 | 295 | Optionally parses *p*. If successful, returns the token value, otherwise returns *x* and does not consume the token. 296 | 297 | **.ignore** *p* 298 | 299 | Parse *p*, but ignore the value (always returns `nil`). 300 | 301 | **.all** *p &rest ps* 302 | 303 | Parse *p* and then the *ps* combinators in order, returns a list of all the values parsed in-order. 304 | 305 | **.maybe** *p* 306 | 307 | Tries to parse *p*. If successful, returns `nil`. If it fails, returns `nil` anyway. 308 | 309 | **.many** *p* 310 | 311 | Parse zero or more occurrences of *p*. Return the list of parsed values. 312 | 313 | **.many1** *p* 314 | 315 | Parse one or more occurrences of *p*. Return the list of parsed values. 316 | 317 | **.many-until** *p end* 318 | 319 | Parse *p* zero or more times and then parse *end* returning a list of all parsed values (excluding *end*). 320 | 321 | **.sep-by** *p sep* 322 | 323 | Parse zero or more occurrences of *p* separated by *sep*. Return the list of all *p*'s parsed. 324 | 325 | **.sep-by1** *p sep* 326 | 327 | Parse one or more occurrences of *p* separated by *sep*. Return the list of all *p*'s parsed. 328 | 329 | **.skip-many** *p* 330 | 331 | Parse zero or more occurrences of *p*, ignores the results and returns `nil`. 332 | 333 | **.skip-many1** *p* 334 | 335 | Parse one or more occurrences of *p*, ignores the results and returns `nil`. 336 | 337 | **.between** *open-guard close-guard p* 338 | 339 | Parse *open-guard*, then *p*, binding the result of *p*. Parses the *close-guard* and then return the result of *p*. 340 | -------------------------------------------------------------------------------- /parse.asd: -------------------------------------------------------------------------------- 1 | (defpackage :parse-asd 2 | (:use :cl :asdf)) 3 | 4 | (in-package :parse-asd) 5 | 6 | (defsystem :parse 7 | :name "parse" 8 | :version "1.0" 9 | :author "Jeffrey Massung" 10 | :license "Apache 2.0" 11 | :description "Parsing package for Common Lisp." 12 | :serial t 13 | :components ((:file "parse"))) 14 | -------------------------------------------------------------------------------- /parse.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Monadic parsing package for Common Lisp 2 | ;;;; 3 | ;;;; Copyright (c) Jeffrey Massung 4 | ;;;; 5 | ;;;; This file is provided to you under the Apache License, 6 | ;;;; Version 2.0 (the "License"); you may not use this file 7 | ;;;; except in compliance with the License. You may obtain 8 | ;;;; a copy of the License at 9 | ;;;; 10 | ;;;; http://www.apache.org/licenses/LICENSE-2.0 11 | ;;;; 12 | ;;;; Unless required by applicable law or agreed to in writing, 13 | ;;;; software distributed under the License is distributed on an 14 | ;;;; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 15 | ;;;; KIND, either express or implied. See the License for the 16 | ;;;; specific language governing permissions and limitations 17 | ;;;; under the License. 18 | ;;;; 19 | 20 | (defpackage :parse 21 | (:use :cl) 22 | (:export 23 | #:parse 24 | 25 | ;; declare a parse combinator 26 | #:define-parser 27 | 28 | ;; monadic bind functions 29 | #:>>= 30 | #:>> 31 | 32 | ;; combinator macros 33 | #:.prog1 34 | #:.progn 35 | #:.let 36 | #:.let* 37 | #:.do 38 | #:.or 39 | 40 | ;; monadic functions 41 | #:.ret 42 | #:.fail 43 | #:.get 44 | #:.put 45 | #:.modify 46 | #:.push 47 | #:.pop 48 | 49 | ;; parse combinators 50 | #:.any 51 | #:.eof 52 | #:.is 53 | #:.either 54 | #:.opt 55 | #:.ignore 56 | #:.all 57 | #:.maybe 58 | #:.many 59 | #:.many1 60 | #:.many-until 61 | #:.sep-by 62 | #:.sep-by1 63 | #:.skip-many 64 | #:.skip-many1 65 | #:.between)) 66 | 67 | (in-package :parse) 68 | 69 | ;;; ---------------------------------------------------- 70 | 71 | (defstruct parse-state read-token tokens token-last data) 72 | 73 | ;;; ---------------------------------------------------- 74 | 75 | (defun parse-state-next-token (st) 76 | "Returns the next token in the token list as a cons pair." 77 | (cadr (parse-state-tokens st))) 78 | 79 | ;;; ---------------------------------------------------- 80 | 81 | (defun parse-state-token-class (st) 82 | "Returns the class of the current token." 83 | (car (parse-state-next-token st))) 84 | 85 | ;;; ---------------------------------------------------- 86 | 87 | (defun parse-state-token-value (st) 88 | "Returns the value of the current token." 89 | (cdr (parse-state-next-token st))) 90 | 91 | ;;; ---------------------------------------------------- 92 | 93 | (defun parse (p next-token &key initial-state (errorp t) error-value) 94 | "Create a parse-state and pass it through a parse combinator." 95 | (let* ((token-cache (list nil)) 96 | 97 | ;; create the initial parse state 98 | (st (make-parse-state :tokens token-cache 99 | :token-last token-cache 100 | :data initial-state))) 101 | 102 | ;; create a function that will read into the shared token list 103 | (setf (parse-state-read-token st) 104 | #'(lambda () 105 | (multiple-value-bind (class value) 106 | (funcall next-token) 107 | (car (setf (parse-state-token-last st) 108 | (cdr (rplacd (parse-state-token-last st) 109 | (list (cons class value))))))))) 110 | 111 | ;; read the first token as the current token 112 | (funcall (parse-state-read-token st)) 113 | 114 | ;; parse the token stream 115 | (multiple-value-bind (x okp) 116 | (funcall p st) 117 | (cond (okp (values x t)) 118 | 119 | ;; should we error out? 120 | (errorp (error "Parse failure")) 121 | 122 | ;; return the error result and parse failure 123 | (t (values error-value nil)))))) 124 | 125 | ;;; ---------------------------------------------------- 126 | 127 | (defun satisfy (st pred) 128 | "Read the next token if necesary, test class, return value." 129 | (destructuring-bind (class . value) 130 | (let ((token (parse-state-next-token st))) 131 | (if token 132 | token 133 | (funcall (parse-state-read-token st)))) 134 | (when (funcall pred class) 135 | (let ((nst (copy-parse-state st))) 136 | (multiple-value-prog1 137 | (values value nst) 138 | (pop (parse-state-tokens nst))))))) 139 | 140 | ;;; ---------------------------------------------------- 141 | 142 | (defmacro define-parser (name &body ps) 143 | "Create a parse combinator." 144 | (let ((st (gensym))) 145 | `(defun ,name (,st) 146 | 147 | ;; add a documentation string to the parser if provided 148 | ,(when (stringp (first ps)) (pop ps)) 149 | 150 | ;; parse the combinators, return the final result 151 | (funcall (.do ,@ps) ,st)))) 152 | 153 | ;;; ---------------------------------------------------- 154 | 155 | (defun >>= (p f) 156 | "Monadic bind combinator." 157 | #'(lambda (st) 158 | (multiple-value-bind (x nst) 159 | (funcall p st) 160 | (when nst 161 | (funcall (funcall f x) nst))))) 162 | 163 | ;;; ---------------------------------------------------- 164 | 165 | (defun >> (p m) 166 | "Monadic bind, ignore intermediate result." 167 | #'(lambda (st) 168 | (let ((nst (nth-value 1 (funcall p st)))) 169 | (when nst 170 | (funcall m nst))))) 171 | 172 | ;;; ---------------------------------------------------- 173 | 174 | (defmacro .prog1 (form &body rest) 175 | "Macro to execute Lisp expressions, returning the first result." 176 | `(.ret (prog1 ,form ,@rest))) 177 | 178 | ;;; ---------------------------------------------------- 179 | 180 | (defmacro .progn (&body rest) 181 | "Macro to execute Lisp expressions, returning the last result." 182 | `(.ret (progn ,@rest))) 183 | 184 | ;;; ---------------------------------------------------- 185 | 186 | (defmacro .let ((var p) &body body) 187 | "Macro for >>= to make it more readable." 188 | `(>>= ,p #'(lambda (,var) (declare (ignorable ,var)) ,@body))) 189 | 190 | ;;; ---------------------------------------------------- 191 | 192 | (defmacro .let* ((binding &rest bindings) &body body) 193 | "Macro for making multiple .let bindings more readable." 194 | (if (null bindings) 195 | `(.let ,binding ,@body) 196 | `(.let ,binding 197 | (.let* ,bindings ,@body)))) 198 | 199 | ;;; ---------------------------------------------------- 200 | 201 | (defmacro .do (p &rest ps) 202 | "Chained together >> combinators." 203 | (labels ((chain (p ps) 204 | (if (null ps) 205 | p 206 | `(>> ,p ,(chain (first ps) (rest ps)))))) 207 | (chain p ps))) 208 | 209 | ;;; ---------------------------------------------------- 210 | 211 | (defmacro .or (p &rest ps) 212 | "Chained together or combinators." 213 | (labels ((try (p ps) 214 | (if (null ps) 215 | p 216 | `(.either ,p ,(try (first ps) (rest ps)))))) 217 | (try p ps))) 218 | 219 | ;;; ---------------------------------------------------- 220 | 221 | (defun .ret (x) 222 | "Convert X into a monadic value." 223 | #'(lambda (st) (values x st))) 224 | 225 | ;;; ---------------------------------------------------- 226 | 227 | (defun .fail (datum &rest arguments) 228 | "Ensures that the parse combinator fails." 229 | #'(lambda (st) 230 | (declare (ignore st)) 231 | (apply #'error datum arguments))) 232 | 233 | ;;; ---------------------------------------------------- 234 | 235 | (defun .get () 236 | "Always succeeds, returns the current parse state data." 237 | #'(lambda (st) 238 | (values (parse-state-data st) st))) 239 | 240 | ;;; ---------------------------------------------------- 241 | 242 | (defun .put (x) 243 | "Always succeeds, puts data into the parse state." 244 | #'(lambda (st) 245 | (let ((nst (copy-parse-state st))) 246 | (values (setf (parse-state-data nst) x) nst)))) 247 | 248 | ;;; ---------------------------------------------------- 249 | 250 | (defun .modify (f) 251 | "Always succeeds, applys f with the parse state data." 252 | (.let (x (.get)) 253 | (.put (funcall f x)))) 254 | 255 | ;;; ---------------------------------------------------- 256 | 257 | (defun .push (x) 258 | "Always succeeds, assumes data is a list and pushes x onto it." 259 | (.let (xs (.get)) 260 | (.put (cons x xs)))) 261 | 262 | ;;; ---------------------------------------------------- 263 | 264 | (defun .pop () 265 | "Always succeeds, assumes data is a list an pops it." 266 | (.let (xs (.get)) 267 | (.do (.put (cdr xs)) 268 | (.ret (car xs))))) 269 | 270 | ;;; ---------------------------------------------------- 271 | 272 | (defun .any () 273 | "Succeeds if not at the end of the token stream." 274 | #'(lambda (st) (satisfy st #'identity))) 275 | 276 | ;;; ---------------------------------------------------- 277 | 278 | (defun .eof () 279 | "Succeeds if at the end of the token stream." 280 | #'(lambda (st) (satisfy st #'null))) 281 | 282 | ;;; ---------------------------------------------------- 283 | 284 | (defun .is (class &key (test #'eql)) 285 | "Checks if the current token is of a given class." 286 | #'(lambda (st) (satisfy st #'(lambda (c) (funcall test c class))))) 287 | 288 | ;;; ---------------------------------------------------- 289 | 290 | (defun .either (p1 p2) 291 | "Attempt to parse p1, if that fails, try p2." 292 | #'(lambda (st) 293 | (multiple-value-bind (x nst) 294 | (funcall p1 st) 295 | (if nst 296 | (values x nst) 297 | (funcall p2 st))))) 298 | 299 | ;;; ---------------------------------------------------- 300 | 301 | (defun .opt (x p) 302 | "Optionally match a parse combinator or return x." 303 | (.either p (.ret x))) 304 | 305 | ;;; ---------------------------------------------------- 306 | 307 | (defun .ignore (p) 308 | "Parse p, ignore the result." 309 | (.do p (.ret nil))) 310 | 311 | ;;; ---------------------------------------------------- 312 | 313 | (defun .all (p &rest ps) 314 | "Parse each combinator in order and return all as a list." 315 | (.let (first p) 316 | #'(lambda (st) 317 | (loop 318 | for p in ps 319 | 320 | ;; try the next combinator 321 | for (x nst) = (multiple-value-list (funcall p st)) 322 | while nst 323 | 324 | ;; update the parse state 325 | do (setf st nst) 326 | 327 | ;; keep all the matches in a list 328 | collect x into rest 329 | 330 | ;; return the matches and final state 331 | finally (return (values (cons first rest) st)))))) 332 | 333 | ;;; ---------------------------------------------------- 334 | 335 | (defun .maybe (p) 336 | "Try and parse p, ignore it if there." 337 | (.opt nil (.ignore p))) 338 | 339 | ;;; ---------------------------------------------------- 340 | 341 | (defun .many (p) 342 | "Try and parse a combinator zero or more times." 343 | (.opt nil (.many1 p))) 344 | 345 | ;;; ---------------------------------------------------- 346 | 347 | (defun .many1 (p) 348 | "Try and parse a combinator one or more times." 349 | (.let (first p) 350 | #'(lambda (st) 351 | (loop 352 | 353 | ;; keep repeating the parse combinator until it fails 354 | for (x nst) = (multiple-value-list (funcall p st)) 355 | while nst 356 | 357 | ;; update the parse state 358 | do (setf st nst) 359 | 360 | ;; keep all the matches in a list 361 | collect x into rest 362 | 363 | ;; return the matches and final state 364 | finally (return (values (cons first rest) st)))))) 365 | 366 | ;;; ---------------------------------------------------- 367 | 368 | (defun .many-until (p end) 369 | "Parse zero or more combinators until an end combinator is reached." 370 | #'(lambda (st) 371 | (loop 372 | 373 | ;; try and parse the end 374 | for nst = (nth-value 1 (funcall end st)) 375 | collect (if nst 376 | (loop-finish) 377 | (multiple-value-bind (x xst) 378 | (funcall p st) 379 | (if (null xst) 380 | (return nil) 381 | (prog1 x 382 | (setf st xst))))) 383 | 384 | ;; join all the results together 385 | into xs 386 | 387 | ;; return the results 388 | finally (return (values xs nst))))) 389 | 390 | ;;; ---------------------------------------------------- 391 | 392 | (defun .sep-by (p sep) 393 | "Zero or more occurances of p separated by sep." 394 | (.opt nil (.sep-by1 p sep))) 395 | 396 | ;;; ---------------------------------------------------- 397 | 398 | (defun .sep-by1 (p sep) 399 | "One or more occurances of p separated by sep." 400 | (.let (x p) 401 | (.let (xs (.many (.do sep p))) 402 | (.ret (cons x xs))))) 403 | 404 | ;;; ---------------------------------------------------- 405 | 406 | (defun .skip-many (p) 407 | "Optionally skip a parse combinator zero or more times." 408 | (.opt nil (.skip-many1 p))) 409 | 410 | ;;; ---------------------------------------------------- 411 | 412 | (defun .skip-many1 (p) 413 | "Try and parse a combinator one or more times, ignore it." 414 | (.maybe (.many1 p))) 415 | 416 | ;;; ---------------------------------------------------- 417 | 418 | (defun .between (open-guard close-guard p) 419 | "Capture a combinator between guards." 420 | (.do open-guard (.let (x p) (.do close-guard (.ret x))))) 421 | --------------------------------------------------------------------------------