*** empty log message ***

original commit: 4d3ec15b51313f6f9296a1ed2057786481570a84

collects/parser-tools/lex.ss

@@ -20,7 +20,8 @@
 			(let ((match 
 			       (push-back lb (- length longest-match-length))))
 			  (if (not longest-match-action)
-			      (error 'lex "No match found in rest of input"))
+			      (error 'lexer (format "No match found in input starting with: ~a" 
+                                                    (list->string (lex-buffer-from lb)))))
 			  (longest-match-action
 			   (lambda ()
 			     first-pos)
@@ -33,9 +34,11 @@
 			   lb)))))
 	      (lambda (lb)
 		(unless (lex-buffer? lb)
-			(error 'lex 
-			       (format 
-				"Lexer expects argument of type lex-buf; given ~a" lb)))
+                  (raise-type-error 
+                   'lexer 
+                   "lex-buf"
+                   0
+                   lb))
 		(let ((first-pos (get-position lb)))
 		  (let lexer-loop (
 				   ;; current-state
@@ -51,7 +54,6 @@
 				   (length 1)
 				   ;; how many characters are in the longest match
 				   (longest-match-length 0)
-				   ;;(end-pos first-pos))
 				   (end-pos first-pos))
 		    (let ((next-state
 			   (cond
@@ -84,45 +86,44 @@
 				      pos)))))))))))
       (lambda (stx)
 	(syntax-case stx ()
-		     ((_ (re act) ...) 
-		      (let* ((table (generate-table (syntax ((re act) ...)) 
-						    stx))
+          ((_ (re1 act1) (re act) ...) 
+           (let* ((table (generate-table (syntax ((re1 act1) (re act) ...)) stx))
                   (code
                    `(let ((start-state ,(table-start table))
                           (trans-table ,(table-trans table))
                           (eof-table ,(table-eof table))
                           (actions (vector ,@(vector->list (table-actions table)))))
                       ,code)))
-			(datum->syntax-object #'here code #f)))))))
+             (datum->syntax-object #'here code #f)))
+          (_
+           (raise-syntax-error #f "Form should be (lexer (re act) ...) with at least 1 (re ast) pair" stx))))))
   
   
   
-  (define-syntax define-lex-abbrev
-    (lambda (stx)
+  (define-syntax (define-lex-abbrev stx)
     (syntax-case stx ()
-        ((_ name val)
+      ((_ name re)
        (syntax
         (define-syntax name
-            (make-lex-abbrev (quote-syntax val)))))
+          (make-lex-abbrev (quote-syntax re)))))
       (_ 
        (raise-syntax-error
         #f
-          "Form should be (define-lex-abbrev name val)"
-          stx)))))
+        "Form should be (define-lex-abbrev name re)"
+        stx))))
 
-  (define-syntax define-lex-abbrevs
-    (lambda (stx)
+  (define-syntax (define-lex-abbrevs stx)
     (syntax-case stx ()
       ((_ x ...)
        (let* ((abbrev (syntax->list (syntax (x ...))))
               (r (map (lambda (a)
                         (syntax-case a ()
-                            ((name val)
+                          ((name re)
                            (identifier? (syntax name))
-                             (syntax (define-lex-abbrev name val)))
+                           (syntax (define-lex-abbrev name re)))
                           (_ (raise-syntax-error
-                                #f 
-                                "Lexer abbreviation must be (identifier value)"
+                              'Lexer-abbreviation 
+                              "Form should be (identifier value)"
                               a))))
                       abbrev)))
          (datum->syntax-object
@@ -132,8 +133,8 @@
       (_
        (raise-syntax-error
         #f
-          "Form should be (define-lex-abbrevs (name val) ...)"
-          stx)))))
+        "Form should be (define-lex-abbrevs (name re) ...)"
+        stx))))
 
   ;; Lex buffer is NOT thread safe