syncase code issue 1.8.8 -> 2.0.11

[Matt Wette <mwette@alumni.caltech.edu>]

[-- Attachment #1: Type: text/plain, Size: 2225 bytes --]

Hi Folks,

Anyone interested in looking at my syntax-case code?   I wrote this several years ago under 1.8.8.  Now moving to 2.0.11: not working :(.

Matt

This uses syntax-case.  It works in 1.8.8, but I get errors in 2.0.11.   I'm guessing I don't understand something about syntax-case in R6RS.  I learned (or mislearned) syntax-case from the papers by Kent Dybvig, not from the R6RS spec.

Here is what I'm trying to do:
@item define-tokenizer name (rex1 tok1) (rex2 tok2) ...
Define tokenizer for which one can build string tokenizers.

Example:
(define-tokenizer tokiz ("[0-9]+" #\1) ("[a-z]+" #\a))
(define mt (make-tokiz "abc=def"))
(tokiz-latok mt) -> #\a
(tokiz-laval mt) -> "abc"
(tokiz-match mt #\a)
(tokiz-latok mt) -> #\=

In 1.8.8, I get the above output.   In 2.0.11 I get

Syntax-case macros are now a part of Guile core; importing (ice-9 syncase) is no longer necessary.   <=(no issue here)
ice-9/psyntax.scm:1274:12: In procedure dobody:
ice-9/psyntax.scm:1274:12: Syntax error:
u1.scm:106:18: definition in expression context, where definitions are not allowed, in form
    (define make-tokiz
      (lambda (string)
        (let ((pobj (vector string 0 (string-length string) #\nul "")))
          (tokiz-match pobj #\nul) pobj)))

Here is synopsis of the code (see attached for all of it):

(define-syntax define-tokenizer
  ;; pobj = parse object = #(string ix nd latok laval)
  (lambda (x)
    (syntax-case x ()
      ((_ name (c1 r1) ...)
       (with-syntax ((maker (sc-gen-id (syntax name) "make-" (syntax name)))
                     ...
                     )
	 (syntax
	  (begin
	    (define maker
	      (lambda (string)
		(let ((pobj (vector string 0 (string-length string) #\nul "")))
		  (match pobj #\nul)  ; prime latok/laval in parse-object
		  pobj)))
             .....
           )))))



(define sc-gen-id  ;; (gc-gen-id (syntax name) "make-" (syntax name)) where name=foo -> make-foo 
  (lambda (template-id . args)
    (datum->syntax-object template-id
      (string->symbol
       (apply string-append
	      (map (lambda (x) 
		     (if (string? x) x
			 (symbol->string (syntax-object->datum x))))
		   args))))))



[-- Attachment #2: u1.scm --]
[-- Type: application/octet-stream, Size: 3839 bytes --]

(use-modules (ice-9 regex))
(use-modules (ice-9 format))
(use-modules (ice-9 syncase))

;; @item sc-gen-id template-id . args
;; For use in syntax-case/with-syntax, generates an identifier given
;; template-identifier and pattern from remaining args of symbol or string.
;; Example:
;;   (sc-gen-id (syntax name) (syntax name) "-setter") -> foo-setter
;; where (syntax name) is 'foo
(define sc-gen-id
  (lambda (template-id . args)
    (datum->syntax-object template-id
      (string->symbol
       (apply string-append
	      (map (lambda (x) 
		     (if (string? x) x
			 (symbol->string (syntax-object->datum x))))
		   args))))))


;; @item define-tokenizer name (rex1 tok1) (rex2 tok2) ...
;; Define tokenizer for which one can build string tokenizers.
;; (define t (make-name string)) generates the tokenizer for the string.
;; (name-latok t) returns the lookahead token, a character.
;; (name-laval t) returns the lookahead value, a string.
;; The end-of-string results in latok of #\nul, laval of "".
;; Example:
;; (define-tokenizer tokiz ("[0-9]+" #\1) ("[a-z]+" #\a))
;; (define mt (make-tokiz "abc=def"))
;; (tokiz-latok mt) -> #\a
;; (tokiz-laval mt) -> "abc"
;; (tokiz-match mt #\a)
;; (tokiz-latok mt) -> #\=
;; (tokiz-match mt #\=)
(define-syntax define-tokenizer
  ;; pobj = parse object = #(string ix nd latok laval)
  (lambda (x)
    (syntax-case x ()
      ((_ name (c1 r1) ...)
       (with-syntax ((maker (sc-gen-id (syntax name) "make-" (syntax name)))
		     (latok (sc-gen-id (syntax name) (syntax name) "-latok"))
		     (laval (sc-gen-id (syntax name) (syntax name) "-laval"))
		     (match (sc-gen-id (syntax name) (syntax name) "-match"))
		     ((def ...)
		      (let f ((ix 1)
			      (cz (syntax (c1 ...)))
			      (rz (syntax (r1 ...))))
			(if (null? cz) '()
			    (cons (list (sc-gen-id
					 (car cz) "pat-" (number->string ix))
					(list
					 make-regexp 
					 (list string-append "^" (car cz))))
				  (f (+ 1 ix) (cdr cz) (cdr rz))))))
		     ((v1 ...)
		      (let f ((ix 1)
			      (cz (syntax (c1 ...)))
			      (rz (syntax (r1 ...))))
			(if (null? cz) '()
			    (cons (sc-gen-id
				   (car cz) "pat-" (number->string ix))
				  (f (+ 1 ix) (cdr cz) (cdr rz)))))))
	 (syntax
	  (begin
	    (define maker
	      (lambda (string)
		(let ((pobj (vector string 0 (string-length string) #\nul "")))
		  (match pobj #\nul)  ; prime latok/laval in parse-object
		  pobj)))
	    (define latok (lambda (pobj) (vector-ref pobj 3)))
	    (define laval (lambda (pobj) (vector-ref pobj 4)))
	    (define match
	      (let (def ...)
		(lambda (pobj tokn)
		  (if (not (eq? tokn (latok pobj))) (error "syntax error"))
		  ;; Shift.
		  (vector-set! pobj 1 (+ (vector-ref pobj 1)
					 (string-length (vector-ref pobj 4))))
		  ;; Find new latok/laval.
		  (let* ((ps (substring	(vector-ref pobj 0)
					(vector-ref pobj 1)
					(vector-ref pobj 2)))
			 (pc (if (eq? (vector-ref pobj 1)
				      (vector-ref pobj 2)) #\nul
				 (string-ref (vector-ref pobj 0)
					     (vector-ref pobj 1))))
			 (ms (lambda (rx) (regexp-exec rx ps)))
			 (set-la (lambda (tok val) ; set and return
				   (vector-set! pobj 3 tok)
				   (vector-set! pobj 4 val)
				   tok)))
		    ;; next lookahead
		    (let iter ((vs (list v1 ...))  (rs (list r1 ...)))
		      (cond
		       ((eq? (vector-ref pobj 1) (vector-ref pobj 2)) ; end
			(set-la #\nul ""))
		       ((null? vs)	; character
			(set-la pc (string pc)))
		       ((ms (car vs)) => ; pattern
			(lambda (m)
			  (set-la (car rs) (match:substring m))))
		       (else
			(iter (cdr vs) (cdr rs))))))))))))))))

(format #t "~a\n" (define-tokenizer tokiz ("[0-9]+" #\1) ("[a-z]+" #\a)))
(format #t "~a\n" (define mt (make-tokiz "abc=def")))
(format #t "~a\n" (tokiz-latok mt))
(format #t "~a\n" (tokiz-laval mt))
(format #t "~a\n" (tokiz-match mt #\a))