Support @ for current parse position.
authorTony Garnock-Jones <tonygarnockjones@gmail.com>
Wed, 26 May 2010 23:52:23 +1200
changeset 32 5deee5dae03d
parent 31 dd9850e5e4fc
child 33 bec0f2436e38
Support @ for current parse position.
ometa-boot-pretty.g
ometa-boot.g
ometa-opt.g
ometa.scm
--- a/ometa-boot-pretty.g	Wed May 26 21:52:29 2010 +1200
+++ b/ometa-boot-pretty.g	Wed May 26 23:52:23 2010 +1200
@@ -15,9 +15,10 @@
 
 expr-seq = (expr3)*:xs -> `(seq ,@xs);
 
-expr3 = expr2:r ( token("*") -> `(many ,r)
-		| token("+") -> `(many1 ,r)
-		| 	     -> r):r
+expr3 = ( expr2:r ( token("*") -> `(many ,r)
+		  | token("+") -> `(many1 ,r)
+		  | 	       -> r)
+	| token("@") -> `(position)):r
 	( $: name:n -> `(bind ,n ,r)
 	|    	    -> r);
 expr3 = token(":") name:n -> `(bind ,n (anything));
--- a/ometa-boot.g	Wed May 26 21:52:29 2010 +1200
+++ b/ometa-boot.g	Wed May 26 23:52:23 2010 +1200
@@ -17,7 +17,7 @@
 ;
 
 expr3 =
-(expr2:r (token("*") ->(quasiquote (many (unquote r))) | token("+") ->(quasiquote (many1 (unquote r))) | ->r):r ($: name:n ->(quasiquote (bind (unquote n) (unquote r))) | ->r) | token(":") name:n ->(quasiquote (bind (unquote n) (anything))))
+((expr2:r (token("*") ->(quasiquote (many (unquote r))) | token("+") ->(quasiquote (many1 (unquote r))) | ->r) | token("@") ->(quasiquote (position))):r ($: name:n ->(quasiquote (bind (unquote n) (unquote r))) | ->r) | token(":") name:n ->(quasiquote (bind (unquote n) (anything))))
 ;
 
 expr2 =
--- a/ometa-opt.g	Wed May 26 21:52:29 2010 +1200
+++ b/ometa-opt.g	Wed May 26 23:52:23 2010 +1200
@@ -32,3 +32,4 @@
 action :exp -> `(action ,exp);
 exactly :datum -> `(exactly ,datum);
 sequence :exp -> `(sequence ,exp);
+position -> `(position);
--- a/ometa.scm	Wed May 26 21:52:29 2010 +1200
+++ b/ometa.scm	Wed May 26 23:52:23 2010 +1200
@@ -249,7 +249,8 @@
 ;; (bind name parser)
 ;; (seq parser ...)
 ;; (anything)
-;; (action meta-exp); => exp, !exp, ?exp
+;; (position)
+;; (action meta-exp); -> exp, ?exp
 
 ;; We use current-namespace below as a default so that grammars by
 ;; default have access to the toplevel.
@@ -455,6 +456,8 @@
       ((anything)
        (input (lambda (pos item tail) (ks item env tail #f))
 	      (lambda (pos) (kf #f))))
+      ((position)
+       (ks (input-stream-position input) env input #f))
       ((action)
        (let* ((names (nonshared-env-names env))
 	      (probe (cons (cadr exp) names))
@@ -516,10 +519,11 @@
     (expr-seq (seq (bind xs (many (apply expr3)))
 		   (action `(seq ,@xs))))
 
-    (expr3 (or (seq (bind r (apply expr2))
-		    (bind r (or (seq (apply token "*") (action `(many ,r)))
-				(seq (apply token "+") (action `(many1 ,r)))
-				(action r)))
+    (expr3 (or (seq (bind r (or (seq (bind r (apply expr2))
+				     (or (seq (apply token "*") (action `(many ,r)))
+					 (seq (apply token "+") (action `(many1 ,r)))
+					 (action r)))
+				(seq (apply token "@") (action `(position)))))
 		    (or (seq (exactly #\:) (bind n (apply name))
 			     (action `(bind ,n ,r)))
 			(action r)))