Permalink
Browse files

Introduced EMPTY-CHAR-ACCUM-P and EMPTY-LIST-ACCUM-P.

  • Loading branch information...
1 parent 32d2565 commit 28d19dd89c58042f843bb991f4246045230c4090 Volkan YAZICI committed Jul 15, 2007
Showing with 137 additions and 141 deletions.
  1. +93 −54 README
  2. +1 −1 meta-sexp.asd
  3. +39 −51 meta-sexp.lisp
  4. +4 −3 packages.lisp
  5. +0 −32 rules.lisp
View
@@ -21,50 +21,90 @@ in Common Lisp' paper of Henry G. Baker
`--------------------'
In most of the time, you'll need to define your own parsers using
-DEFRULE. But in some certain situations, you may need to DEFATOM
-too. (See builtin functions for further examples.)
-
-(defrule wiki-link? (&aux c (href (make-char-accum)) (text (make-char-accum)))
- "[["
- (:+ (:not (:or "]]" (:type white-space?)))
- (:assign c (:type graphic?))
- (:char-push c href))
- (:? (:rule lwsp?)
- (:+ (:not "]]")
- (:assign c (:type graphic?))
- (:char-push c text)))
- "]]"
- (:return href text))
-
-(wiki-link? (make-instance 'parser-context :data "[[http://foo.com/]]"))
-==> "http://foo.com/", ""
-
-(wiki-link? (make-instance 'parser-context :data "[[http://foo.com/ bar baz]]"))
-==> "http://foo.com/", "bar baz"
-
-(wiki-link? (make-instance 'parser-context :data "[[]]"))
-==> NIL
-
-(defrule in-wonderland? ()
- "META-SEXP"
- (progn
- (format t "META-SEXP in Wonderland!")
- (meta (:type space?)
- "in Wonderland!"))
- (:return t))
-
-(in-wonderland? (make-instance 'parser-context :data "META-SEXP in Wonderland!"))
-==> META-SEXP in Wonderland!
-T
-(in-wonderland? (make-instance 'parser-context :data "META-SEXP in Fooland!"))
-==> META-SEXP in Wonderland!
-NIL
-
-Instead of creating PARSER-CONTEXT instances manually, you may want to
-prefer below CREATE-PARSER-CONTEXT methods too.
-
- create-parser-context ((input string) &key start end)
- create-parser-context ((input string-stream) &key buffer-size start end)
+CREATE-PARSER-CONTEXT methods and DEFRULE, DEFRENDERER macros.
+
+ create-parser-context ((input string) &key start end attachment)
+ create-parser-context ((input string-stream) &key buffer-size start end attachment)
+
+ defrule (name (&rest args) (&rest attachment-lambda-list) &body body)
+ defrenderer (name (&rest args) (&rest attachment-lambda-list) &body body)
+
+ If supplied, attachment lambda lists are expanded using
+ DESTRUCTURE-BIND on ATTACHMENT given to CREATE-PARSER-CONTEXT (or
+ specified via MAKE-INSTANCE).
+
+In some certain situations, you may also need to use DEFATOM too. See
+atoms.lisp for DEFATOM examples.
+
+Here is a tiny example:
+
+ (defrule integer?
+ (&aux sign c (num 0))
+ ()
+ (:? (:or (:and "+" (:assign sign 1))
+ (:and "-" (:assign sign -1))))
+ (:+ (:assign c (:type digit?))
+ (:assign num (+ (* num 10)
+ (- (char-code c) #.(char-code #\0)))))
+ (:return (* sign num)))
+
+ (integer? (make-instance 'parser-context :data "-14"))
+ ==> -14
+
+Here is another example demonstrating the usage of META symbol.
+
+ (defrule in-wonderland? () ()
+ "META-SEXP"
+ (progn
+ (format t "META-SEXP in Wonderland!")
+ (meta (:type space?)
+ "in Wonderland!"))
+ (:return t))
+
+ (in-wonderland? (make-instance
+ 'parser-context :data "META-SEXP in Wonderland!"))
+ META-SEXP in Wonderland!
+ ==> T
+
+ (in-wonderland? (make-instance
+ 'parser-context :data "META-SEXP in Fooland!"))
+ META-SEXP in Wonderland!
+ ==> NIL
+
+You mostly won't need to bother with MAKE-INSTANCE calls. Here's a
+complete example with renderers and attachments.
+
+ (defrenderer internal-link!
+ (label &optional text)
+ (attachment)
+ (format attachment "<a href='~a'>~a</a>"
+ label (if (empty-char-accum-p text) label text)))
+
+ (defrule internal-link?
+ (&aux (ref (make-char-accum)) (text (make-char-accum)))
+ ()
+ "[["
+ (:+ (:not (:or "]]" (:type (or space? newline?))))
+ (:char-push ref))
+ (:? (:* (:type (or white-space? newline?)))
+ (:+ (:not "]]")
+ (:char-push text)))
+ "]]"
+ (:render internal-link! ref text))
+
+ (defrule wiki-markup?
+ (&aux c)
+ (attachment)
+ (:* (:or (:rule internal-link?)
+ (:and (:assign c (:read-atom))
+ (if c (write-char c attachment)))))
+ (get-output-stream-string attachment))
+
+ (wiki-markup?
+ (create-parser-context
+ "foo bar [[ref text]] and [[just-ref]] here."
+ :attachment (list (make-string-output-stream))))
+ ==> "foo bar <a href='ref'>text</a> and <a href='just-ref'>just-ref</a> here."
,-------------------------.
@@ -79,15 +119,6 @@ ALNUM? ALPHA? GRAPHIC? ASCII? BIT? DIGIT? EXTENDED? LOWER? NEWLINE?
SPACE? TAB? UPPER? WHITE-SPACE?
- ,-----------------.
- | AVAILABLE RULES |
- `-----------------'
-
-Rules are parser grammars compiled by COMPILE-GRAMMAR.
-
-LWSP? (Linear White-Space)
-
-
,---------------------------.
| AVAILABLE SYNTAX KEYWORDS |
`---------------------------'
@@ -106,6 +137,10 @@ LWSP? (Linear White-Space)
(:RETURN VAR VAR ...)
Returns supplied variables using VALUES function.
+(:RENDER RENDERER ARG ARG ...)
+ Calls specified RENDERER (that is defined with DEFRENDERER) with
+ supplied arguments.
+
(:? FORM FORM ...)
May appear once. (Similar to `?' in regular expressions.)
(:* FORM FORM ...)
@@ -131,12 +166,16 @@ LWSP? (Linear White-Space)
LIST-ACCUM/CHAR-ACCUM. If :CHAR-PUSH is called with only one
argument, current character gets read and pushed into supplied
accumulator. (You can use MAKE-LIST-ACCUM and MAKE-CHAR-ACCUM
- functions to initialize new accumulators.)
+ functions to initialize new accumulators. Moreover, you'll probably
+ need EMPTY-LIST-ACCUM-P and EMPTY-CHAR-ACCUM-P predicates too.)
(:LIST-RESET LIST-ACCUM)
(:CHAR-RESET CHAR-ACCUM)
Resets supplied accumulators.
+(:READ-ATOM)
+ Reads current atom at the cursor position.
+
(:DEBUG)
(:DEBUG VAR)
Prints current character and its position in the input data. If VAR
View
@@ -42,4 +42,4 @@
:depends-on (:cl-utilities)
:components ((:file "packages")
(:file "meta-sexp")
- (:file "rules")))
+ (:file "atoms")))
View
@@ -48,7 +48,12 @@
(checkpoints
:initform nil
:accessor parser-context-checkpoints
- :documentation "Reversed list of declared checkpoints."))
+ :documentation "Reversed list of declared checkpoints.")
+ (attachment
+ :initarg :attachment
+ :initform nil
+ :accessor parser-context-attachment
+ :documentation "Attachment to carry with to parser context object."))
(:documentation "Information about current state of the parsing process."))
(defgeneric parser-context-size (ctx))
@@ -60,10 +65,15 @@
(defgeneric create-parser-context (input &rest args))
-(defmethod create-parser-context ((input string) &key start end)
- (make-instance 'parser-context :data input :size end :cursor (or start 0)))
+(defmethod create-parser-context ((input string) &key start end attachment)
+ (make-instance 'parser-context
+ :data input
+ :size end
+ :cursor (or start 0)
+ :attachment attachment))
-(defmethod create-parser-context ((input string-stream) &key buffer-size start end)
+(defmethod create-parser-context
+ ((input string-stream) &key buffer-size start end attachment)
(assert (input-stream-p input))
(let* (size
(string
@@ -75,7 +85,8 @@
until (zerop pos)
do (write-string buf output :end pos)
finally (setq size size-acc)))))
- (create-parser-context string :start start :end (or end size))))
+ (create-parser-context
+ string :start start :end (or end size) :attachment attachment)))
(defgeneric peek-atom (ctx))
(defgeneric read-atom (ctx))
@@ -135,6 +146,9 @@
(defun reset-char-accum (accum)
(setf (fill-pointer accum) 0))
+(defun empty-char-accum-p (accum)
+ (zerop (fill-pointer accum)))
+
(defun make-list-accum ()
nil)
@@ -144,6 +158,9 @@
(defmacro reset-list-accum (accum)
`(setf ,accum nil))
+(defun empty-list-accum-p (accum)
+ (endp accum))
+
;;; Grammar Compiler
@@ -168,6 +185,7 @@
(:or `(or ,@(compile-exprs (cdr form))))
(:not (compile-expr `(:checkpoint (not ,(compile-expr (cadr form))))))
(:return `(return-from rule-block (values ,@(cdr form))))
+ (:render `(,(cadr form) ,@(nconc (list ctx) (cddr form))))
(:? `(prog1 t ,(compile-expr `(:and ,@(cdr form)))))
(:* `(not (do () ((not ,(compile-expr `(:and ,@(cdr form))))))))
(:+ (compile-expr `(:and ,@(cdr form) (:* ,@(cdr form)))))
@@ -186,6 +204,7 @@
`(char-accum-push ,(cadr form) ,(caddr form))
`(char-accum-push (read-atom ,ctx) ,(cadr form))))
(:char-reset `(reset-char-accum ,(cadr form)))
+ (:read-atom `(read-atom ,ctx))
(:debug
`(prog1 t
,(if (cadr form)
@@ -206,59 +225,28 @@
(compile-expr form)))
-;;; Atom Definitions
+;;; Atom, Rule & Renderer Definition Macros
(defmacro defatom (name &body body)
`(progn
(defun ,name (c) (when c ,@body))
(deftype ,name () `(satisfies ,',name))))
-(defatom ascii?
- (typep c 'standard-char))
-
-(defatom extended?
- (typep c 'extended-char))
-
-(defatom alpha?
- (alpha-char-p c))
-
-(defatom alnum?
- (alphanumericp c))
-
-(defatom graphic?
- (graphic-char-p c))
-
-(defatom upper?
- (upper-case-p c))
-
-(defatom lower?
- (lower-case-p c))
+(defmacro destructure-attachment ((ctx lambda-list) &body body)
+ (if lambda-list
+ `(destructuring-bind ,lambda-list (parser-context-attachment ,ctx)
+ ,@body)
+ `(progn ,@body)))
-(defatom digit?
- (digit-char-p c))
-
-(defatom bit?
- (or (char= c #\0)
- (char= c #\1)))
-
-(defatom space?
- (char= c #\space))
-
-(defatom newline?
- (char= c #\newline))
-
-(defatom tab?
- (char= c #\tab))
-
-(defatom white-space?
- (or (space? c)
- (tab? c)))
-
-
-;;; Rule Definitions
+(defmacro defrule (name (&rest args) (&rest attachment-lambda-list) &body body)
+ (with-gensyms (ctx)
+ `(defun ,name ,(nconc (list ctx) args)
+ (destructure-attachment (,ctx ,attachment-lambda-list)
+ (block rule-block
+ ,(compile-grammar ctx `(:checkpoint (:and ,@body))))))))
-(defmacro defrule (name (&rest args) &body body)
+(defmacro defrenderer (name (&rest args) (&rest attachment-lambda-list) &body body)
(with-gensyms (ctx)
`(defun ,name ,(nconc (list ctx) args)
- (block rule-block
- ,(compile-grammar ctx `(:checkpoint (:and ,@body)))))))
+ (destructure-attachment (,ctx ,attachment-lambda-list) ,@body)
+ t)))
View
@@ -33,15 +33,18 @@
(:use :cl :cl-utilities)
(:export :defatom
:defrule
+ :defrenderer
:parser-context
:parser-context-error
:create-parser-context
:make-char-accum
:char-accum-push
:reset-char-accum
+ :empty-char-accum-p
:make-list-accum
:list-accum-push
:reset-list-accum
+ :empty-list-accum-p
:compile-grammar
:grammar-error
:meta
@@ -58,6 +61,4 @@
:space?
:tab?
:upper?
- :white-space?
- ;; Builtin Rules
- :lwsp?))
+ :white-space?))
Oops, something went wrong.

0 comments on commit 28d19dd

Please sign in to comment.