Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
204 lines (202 sloc) 7.92 KB
(IN-PACKAGE :METAPEG)
(DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
(DEFUN GENERATED-PARSER ()
(LET ((*CONTEXT* (MAKE-INSTANCE 'CONTEXT :START-INDEX 0)))
(FUNCALL (|parse_program|) 0)))
(DEFUN |parse_program| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"program"
(SEQ (MANY (|parse_ws_or_nl|))
(MANY1 (|parse_rule|))
(LIST 'ACTION NIL 'METAPEG-ACTION320)))))
(DEFUN |parse_rule| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"rule"
(SEQ (|parse_id|)
(MANY (|parse_ws|))
(MATCH-STRING "<-")
(MANY (|parse_ws|))
(|parse_ordered-expr-list|)
(MANY (|parse_ws_or_nl|))
(LIST 'ACTION NIL 'METAPEG-ACTION321)))))
(DEFUN |parse_ordered-expr-list| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"ordered-expr-list"
(EITHER (SEQ (|parse_expr-list|)
(MANY (|parse_ws|))
(MATCH-STRING "/")
(MANY (|parse_ws|))
(|parse_ordered-expr-list|)
(LIST 'ACTION NIL 'METAPEG-ACTION322))
(SEQ (|parse_expr-list|)
(LIST 'ACTION NIL 'METAPEG-ACTION323))))))
(DEFUN |parse_expr-list| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"expr-list"
(SEQ (|parse_expr|)
(MANY (SEQ (MANY1 (|parse_ws|)) (|parse_expr-list|)))
(LIST 'ACTION NIL 'METAPEG-ACTION324)))))
(DEFUN |parse_expr| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"expr"
(EITHER (SEQ (|parse_simple-expr|)
(MATCH-STRING "*")
(LIST 'ACTION NIL 'METAPEG-ACTION325))
(SEQ (|parse_simple-expr|)
(MATCH-STRING "+")
(LIST 'ACTION NIL 'METAPEG-ACTION326))
(SEQ (|parse_simple-expr|)
(MATCH-STRING "?")
(LIST 'ACTION NIL 'METAPEG-ACTION327))
(SEQ (|parse_simple-expr|)
(LIST 'ACTION NIL 'METAPEG-ACTION328))))))
(DEFUN |parse_simple-expr| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"simple-expr"
(EITHER (SEQ (|parse_string|) (LIST 'ACTION NIL 'METAPEG-ACTION329))
(|parse_action|)
(SEQ (MATCH-STRING "&")
(|parse_simple-expr|)
(LIST 'ACTION NIL 'METAPEG-ACTION330))
(SEQ (MATCH-STRING "@")
(|parse_id|)
(LIST 'ACTION NIL 'METAPEG-ACTION331))
(SEQ (|parse_id|) (LIST 'ACTION NIL 'METAPEG-ACTION332))
(SEQ (|parse_bracketed-rule|)
(LIST 'ACTION NIL 'METAPEG-ACTION333))
(MATCH-STRING "!.")
(SEQ (MATCH-STRING "!")
(|parse_expr|)
(LIST 'ACTION NIL 'METAPEG-ACTION334))
(SEQ (|parse_character-class|)
(LIST 'ACTION NIL 'METAPEG-ACTION335))
(SEQ (MATCH-STRING ".") (LIST 'ACTION NIL 'METAPEG-ACTION336))))))
(DEFUN |parse_bracketed-rule| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"bracketed-rule"
(EITHER (MATCH-STRING "()")
(SEQ (MATCH-STRING "(")
(MANY (|parse_ws|))
(|parse_ordered-expr-list|)
(MANY (|parse_ws|))
(MATCH-STRING ")")
(LIST 'ACTION NIL 'METAPEG-ACTION337))))))
(DEFUN |parse_id| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"id"
(SEQ (MANY1 (MATCH-CHAR '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L
#\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X
#\Y #\Z #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j
#\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v
#\w #\x #\y #\z #\- #\_)))
(LIST 'ACTION NIL 'METAPEG-ACTION338)))))
(DEFUN |parse_character-class| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"character-class"
(SEQ (MATCH-STRING "[")
(MANY1 (SEQ (|parse_not_right_bracket|) (MATCH-ANY-CHAR 'DUMMY)))
(MATCH-STRING "]")
(LIST 'ACTION NIL 'METAPEG-ACTION339)))))
(DEFUN |parse_string| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"string"
(SEQ (MATCH-CHAR '(#\"))
(MANY (SEQ (NEGATE (MATCH-CHAR '(#\"))) (MATCH-ANY-CHAR 'DUMMY)))
(MATCH-CHAR '(#\"))
(LIST 'ACTION NIL 'METAPEG-ACTION340)))))
(DEFUN |parse_action| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"action"
(SEQ (MATCH-CHAR '(#\{))
(MANY (SEQ (NEGATE (MATCH-CHAR '(#\}))) (MATCH-ANY-CHAR 'DUMMY)))
(MATCH-CHAR '(#\}))
(LIST 'ACTION NIL 'METAPEG-ACTION341)))))
(DEFUN |parse_not_right_bracket| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION "not_right_bracket" (NEGATE (MATCH-STRING "]")))))
(DEFUN |parse_semi_comment| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"semi_comment"
(SEQ (MATCH-STRING ";")
(MANY (SEQ (NEGATE (MATCH-CHAR '(#\Newline)))
(MATCH-ANY-CHAR 'DUMMY)))))))
(DEFUN |parse_inline_comment| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"inline_comment"
(SEQ (MATCH-STRING "/*")
(MANY (SEQ (NEGATE (MATCH-STRING "*/")) (MATCH-ANY-CHAR 'DUMMY)))
(MATCH-STRING "*/")))))
(DEFUN |parse_raw_ws| ()
(LAMBDA (OFFSET) (BUILD-PARSER-FUNCTION "raw_ws" (MATCH-CHAR '(#\ #\Tab)))))
(DEFUN |parse_nl| ()
(LAMBDA (OFFSET) (BUILD-PARSER-FUNCTION "nl" (MATCH-CHAR '(#\Newline)))))
(DEFUN |parse_ws| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION
"ws"
(EITHER (|parse_raw_ws|)
(|parse_inline_comment|)
(|parse_semi_comment|)))))
(DEFUN |parse_ws_or_nl| ()
(LAMBDA (OFFSET)
(BUILD-PARSER-FUNCTION "ws_or_nl" (EITHER (|parse_ws|) (|parse_nl|)))))
(defun METAPEG-ACTION341 (data)
(let ((action-name (gen-action-name)))
(push (list action-name (char-list-to-string (fix-escapes (zip-second (second data))))) *actions*)
`(list 'action nil ',action-name))
)
(defun METAPEG-ACTION340 (data) `(match-string ,(char-list-to-string (zip-second (second data)))) )
(defun METAPEG-ACTION339 (data) `(match-char ',(fix-escapes2 (zip-second (second data)))) )
(defun METAPEG-ACTION338 (data) (char-list-to-string (first data)) )
(defun METAPEG-ACTION337 (data) (third data) )
(defun METAPEG-ACTION336 (data) (declare (ignore data)) `(match-any-char 'dummy) )
(defun METAPEG-ACTION335 (data) (first data) )
(defun METAPEG-ACTION334 (data) `(negate ,(second data)) )
(defun METAPEG-ACTION333 (data) (first data) )
(defun METAPEG-ACTION332 (data)
`(,(make-name (first data)))
)
(defun METAPEG-ACTION331 (data) `(match ,(second data)) )
(defun METAPEG-ACTION330 (data) `(follow ,(second data)) )
(defun METAPEG-ACTION329 (data) (first data) )
(defun METAPEG-ACTION328 (data) (first data) )
(defun METAPEG-ACTION327 (data) `(optional ,(first data)) )
(defun METAPEG-ACTION326 (data) `(many1 ,(first data)) )
(defun METAPEG-ACTION325 (data) `(many ,(first data)) )
(defun METAPEG-ACTION324 (data) (if (or (equal (second data) "") (null (second data)))
(first data)
(let ((tail (second (first (second data)))))
(if (equal (first tail) 'seq)
`(seq ,(first data) ,@(rest tail))
`(seq ,(first data) ,tail)))) )
(defun METAPEG-ACTION323 (data) (first data) )
(defun METAPEG-ACTION322 (data)
(let ((tail (fifth data)))
(if (equal (first tail) 'either)
`(either ,(first data) ,@(rest tail))
`(either ,(first data) ,(fifth data))))
)
(defun METAPEG-ACTION321 (data) `(defun ,(make-name (first data)) ()
(lambda (offset)
(build-parser-function ,(first data) ,(fifth data)))) )
(defun METAPEG-ACTION320 (data)
`((in-package :metapeg)
(declaim (optimize (speed 3) (safety 0) (debug 0)))
(defun generated-parser ()
(let ((*context* (make-instance 'context :start-index 0)))
(funcall (|parse_program|) 0)))
,@(second data))
)