a few more rules
authorD Herring <dherring@at.tentpost.dot.com>
Fri, 23 Mar 2012 03:53:57 +0000 (23:53 -0400)
committerD Herring <dherring@at.tentpost.dot.com>
Fri, 23 Mar 2012 03:53:57 +0000 (23:53 -0400)
examples/extensible-parser-example.lisp
extensible-parser.lisp

index 4a04ec1..75a62d4 100644 (file)
@@ -6,7 +6,7 @@
 (defconstant slash-f #\Page "C escape: \f; (code-char 12)")
 (defconstant slash-r #\Return "C escape: \r; (code-char 13)")
 
-(defparameter *c++-mode* nil "indicate that we are parsing C++ code")
+(defparameter *c++-mode* t "indicate that we are parsing C++ code")
 
 (defun ascii-range (string start end char0 char1)
   (when (< start end)
       (and "\U" (hex-quad) (hex-quad))))
 
 
+;; 2.8, lex.comment
+(defun c-comment (string &optional (start 0) (end (length string)))
+  (when (starts-with string start end "/*")
+    (let ((close (search "*/" string :start2 (+ start 2))))
+      (unless close
+        (error "unterminated C comment, start: ~A" start))
+      (values (+ close 2) (list :comment (subseq string (+ start 2) close))))))
+
+(defrule c++-comment
+  (:cl (when *c++-mode*
+         (:parse
+          (and "//"
+               ;; the standard mentions slash-v and slash-f
+               ;; ignore for now since hard to encode
+               ;;(repeat 0 nil (exception (any) (or slash-v slash-f slash-n)))
+               ;;(repeat 0 nil (or slash-v slash-f (exception whitespace slash-n)))
+               (repeat 0 nil (exception (any-char) slash-n))
+               (assert slash-n))))))
+
+
+;; 2.9, lex.header
+(defrule h-char
+  (exception (any-char) (or slash-n #\>)))
+
+(defrule h-char-sequence
+  (repeat 1 nil (h-char)))
+
+(defrule q-char
+  (exception (any-char) (or slash-n #\")))
+
+(defrule q-char-sequence
+  (repeat 1 nil (q-char)))
+
+(defrule header-name
+  (or (and #\< (h-char-sequence) #\>)
+      (and #\" (q-char-sequence) #\")))
+
+
 ;; 2.10, lex.ppnumber
 
 ;; left recursion...
@@ -385,21 +423,6 @@ NonDigit           = [a-zA-Z_$] | UniversalChar;
         operator
         punctuator))
 
-;; 2.8
-(defrule c-comment
-    (and "/*" (match-until "*/")))
-
-;; 2.8
-(defrule c++-comment
-  (:cl (when *c++-mode*
-         (:parse
-          (and "//"
-               (repeat 0 * (exception any (or slash-v slash-f slash-n)))
-               (repeat 0 * (or slash-v slash-f (exception whitespace slash-n)))
-               slash-n)))))
-
-
-
 ;; 2.12
 ;; these apply to full tokens...
 (defrule keywords
index 4f92b01..62a86b3 100644 (file)
@@ -62,6 +62,12 @@ possible extensions/optimiztions
 - flag when start/values can be modified directly
 |#
 
+(defmethod print-object ((obj string-context) stream)
+  (with-slots (string start end) obj
+    (format stream "#.(make-instance 'string-context :string '~A :start '~A :end '~A)~%"
+            string start end)))
+
+
 (defclass list-context (context)
   (top here end)
   (:documentation "specialization for parsing a list of tokens"))
@@ -511,6 +517,7 @@ or to allow changes to the rule,
 
 
 (defmethod cpf-list ((car (eql 'exception)) form context env)
+  "(exception A B) -> match if A matches but B does not"
   (assert (= (length form) 3))
   (with-slots (string start end) context
     (destructuring-bind (pass fail) (cdr form)
@@ -521,6 +528,18 @@ or to allow changes to the rule,
              (unless ,(cpf fail context env)
                (values ,e ,v))))))))
 
+(defmethod cpf-list ((car (eql 'assert)) form context env)
+  "(assert A) -> A or an exception if no match"
+  (unless (= (length form) 2)
+    (error "expected (assert X), got ~A" form))
+  (with-slots (string start end) context
+    (let* ((e (gensym (symbol-name :end-)))
+           (v (gensym (symbol-name :val-))))
+      `(multiple-value-bind (,e ,v) ,(cpf (cadr form) context env)
+         (unless ,e
+           (error ,(format nil "rule did not match: ~A~%at index ~~A" form) ,start))
+         (values ,e ,v)))))
+
 
 #|
 (defmacro defrule (name &body body)