1.1 --- a/ometa-parser.g	Fri Aug 28 09:15:50 2009 +0200
     1.2 +++ b/ometa-parser.g	Wed Nov 16 19:38:46 2011 +0200
     1.3 @@ -45,6 +45,6 @@
     1.4  ruleName = name | spaces tsString,
     1.5  rule = &(ruleName:n) spaces rulePart(n):x ("," spaces rulePart(n))*:xs -> << (prog1 `(:rule ,n ,(locals o) (:or ,x ,@xs)) (setf (locals o) nil)) >>,
     1.6  rulePart :rn = ruleName:n ?<<(equal n rn)>> spaces expr4:b1 (spaces "=" spaces expr:b2 -> << `(:and ,b1 ,b2) >> | empty -> b1),
     1.7 -grammar = okeyword("ometa") spaces name:n spaces ("<:" name | empty -> <<"OMeta">>):sn spaces "{" listof("rule", ","):rs spaces "}" -> << `(:grammar ,n ,sn ,@rs) >>
     1.8 +grammar = okeyword("ometa") spaces name:n spaces ("<:" name | empty -> <<"OMeta">>):sn spaces "{" listof("rule", ","):rs spaces "}" anything* -> << `(:grammar ,n ,sn ,@rs) >>
     1.9  }
    1.10  

     2.1 --- a/ometa-parser.lisp	Fri Aug 28 09:15:50 2009 +0200
     2.2 +++ b/ometa-parser.lisp	Wed Nov 16 19:38:46 2011 +0200
     2.3 @@ -1511,5 +1511,14 @@
     2.4                                      (OMETA::OMETA-APPLY OMETA::O 'OMETA:TOKEN
     2.5                                                          (LIST "}")))
     2.6                                    (LAMBDA (OMETA::O OMETA::NULLARG)
     2.7 +                                    (OMETA::OMETA-APPLY OMETA::O 'OMETA::OMANY
     2.8 +                                                        (LAMBDA
     2.9 +                                                            (OMETA::O
    2.10 +                                                             OMETA::NULLARG)
    2.11 +                                                          (OMETA::OMETA-APPLY
    2.12 +                                                           OMETA::O
    2.13 +                                                           'OMETA:ANYTHING
    2.14 +                                                           NIL))))
    2.15 +                                  (LAMBDA (OMETA::O OMETA::NULLARG)
    2.16                                      `(:GRAMMAR ,OMETA::N ,OMETA::SN
    2.17                                        ,@OMETA::RS))))))
    2.18 \ No newline at end of file

     3.1 --- a/ometa-prim.lisp	Fri Aug 28 09:15:50 2009 +0200
     3.2 +++ b/ometa-prim.lisp	Wed Nov 16 19:38:46 2011 +0200
     3.3 @@ -27,23 +27,37 @@
     3.4    (reset-to-mark o)
     3.5    (pop-mark o))
     3.6  
     3.7 +(defmethod remaining ((o ometa-input-stream))
     3.8 +  (assert (< (input-position o) (length (input-array o))) ()  (list "remaining input checked failed" o))
     3.9 +  (subseq (input-array o) (input-position o) (- (length (input-array o)) 1)))
    3.10 +				
    3.11  (defmethod parse-input-file ((parser ometa::ometa) (file-name string))
    3.12 -    (ometa::init-memo)
    3.13 -    (let ((input (with-open-file (file file-name :direction :input)
    3.14 -             (let ((s (make-array (file-length file))))
    3.15 -               (read-sequence s file)
    3.16 -               s))))
    3.17 -        (let ((input-stream (make-instance 'ometa:ometa-input-stream :input-array input)))
    3.18 -          (setf (input-stream parser) input-stream)
    3.19 -          (ometa-apply parser 'grammar nil)
    3.20 -          )))
    3.21 +	    (ometa::init-memo)
    3.22 +	    (let ((input (with-open-file (file file-name :direction :input)
    3.23 +			   (let ((s (make-array (file-length file))))
    3.24 +			     (read-sequence s file)
    3.25 +			     s))))
    3.26 +	      (let ((input-stream (make-instance 'ometa:ometa-input-stream :input-array input)))
    3.27 +		(setf (input-stream parser) input-stream)
    3.28 +		(let ((parse-result (ometa-apply parser 'grammar nil)))
    3.29 +		  (if (not (o-fail? parse-result))
    3.30 +		      (if (at-end-p input-stream)
    3.31 +			  parse-result
    3.32 +			  (progn
    3.33 +			    (format t "partial parse result at ~A out of ~A~%" (input-position input-stream)
    3.34 +				    (length (input-array input-stream)))
    3.35 +			    (print (remaining input-stream))
    3.36 +			    (error "parse failed " parse-result)))
    3.37 +		      parse-result)))))
    3.38 +
    3.39  
    3.40  (defmethod parse-input-string ((parser ometa::ometa) (input string))
    3.41 -    (ometa::init-memo)
    3.42 -    (let ((input-stream (make-instance 'ometa:ometa-input-stream :input-array input)))
    3.43 -      (setf (input-stream parser) input-stream)
    3.44 -      (ometa-apply parser 'grammar nil)
    3.45 -      ))
    3.46 +  (ometa::init-memo)
    3.47 +  (let ((input-stream (make-instance 'ometa:ometa-input-stream :input-array input)))
    3.48 +    (setf (input-stream parser) input-stream)
    3.49 +    (ometa-apply parser 'grammar nil)
    3.50 +    ))
    3.51 +
    3.52  
    3.53  (defclass ometa-list-input-stream () ((input-list :initarg :input-list :accessor input-list)
    3.54  				      (mark-stack :initform nil :accessor mark-stack)))
    3.55 @@ -82,11 +96,11 @@
    3.56    (setf *memo-table* (make-hash-table :test #'equal)))
    3.57  
    3.58  (defmethod ometa-apply ((o ometa-prim) fun arg)
    3.59 -  (save-input o)
    3.60    (if (and (null arg)
    3.61  	   (symbolp fun))
    3.62        (let* ((key (list fun (input-position (input-stream o)) arg ))
    3.63  	     (lookup (gethash key *memo-table* :memo-lookup-failure)))
    3.64 +	(save-input o)
    3.65  	(if (eq lookup :memo-lookup-failure)
    3.66  	    (let ((result (funcall fun o arg)))
    3.67  	      (setf (gethash key *memo-table*) (cons result (input-position (input-stream o))))
    3.68 @@ -94,13 +108,11 @@
    3.69  	      result)
    3.70  	    (progn
    3.71  	      (if (not (eq (car lookup) o-fail))
    3.72 -              (setf (input-position (input-stream o)) (cdr lookup))
    3.73 -              (restore-input o))
    3.74 +		  (setf (input-position (input-stream o)) (cdr lookup))
    3.75 +		  (restore-input o))
    3.76  	      (discard-input o)
    3.77  	      (car lookup))))
    3.78 -      (progn
    3.79 -	(discard-input o)
    3.80 -	(funcall fun o arg) )))
    3.81 +      (funcall (the (or symbol function) fun) o arg) ))
    3.82  
    3.83  
    3.84  (defun inspect-memo ()
    3.85 @@ -178,15 +190,16 @@
    3.86  		    (push v answer)
    3.87  		    (discard-input o))))))))
    3.88  
    3.89 -(defmethod seq ((o ometa-prim) xs)
    3.90 -  (save-input o)
    3.91 -  (loop for x in xs
    3.92 +(defmethod seq ((o ometa-prim) args)
    3.93 +  (let ((xs (first args)))
    3.94 +    (save-input o)
    3.95 +    (loop for x in xs
    3.96         when (o-fail? (ometa-apply o 'ometa::exactly (list x)))
    3.97         do (progn
    3.98  	    (restore-and-discard-input o)
    3.99  	    (return-from seq o-fail)))
   3.100 -  (discard-input o)
   3.101 -  xs)
   3.102 +    (discard-input o)
   3.103 +    xs))
   3.104  
   3.105  (defmethod opred ((o ometa-prim) p)
   3.106    (or p o-fail))
   3.107 @@ -260,7 +273,9 @@
   3.108  	      (cons result result1)))))))
   3.109  
   3.110  (defmethod listof ((o ometa-prim) args)
   3.111 -  (let* ((thing (if (functionp (car args)) (pop args) (intern (string-upcase (pop args)) :ometa)))
   3.112 +  (let* ((thing (if (functionp (car args))
   3.113 +		    (pop args)
   3.114 +		    (intern (string-upcase (pop args)) :ometa)))
   3.115  	 (separator (pop args))
   3.116  	 (first-rule (ometa-apply o thing nil)))
   3.117      (if (o-fail? first-rule)