From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Matt Wette Newsgroups: gmane.lisp.guile.user Subject: syncase code issue 1.8.8 -> 2.0.11 Date: Wed, 17 Sep 2014 18:18:05 -0700 Message-ID: <2097C007-9993-4AA1-A5F7-209A7DADD6CE@alumni.caltech.edu> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 (Mac OS X Mail 7.3 \(1878.6\)) Content-Type: multipart/mixed; boundary="Apple-Mail=_63837671-4EE4-49C6-B9CE-461EF7A0218C" X-Trace: ger.gmane.org 1411003137 8440 80.91.229.3 (18 Sep 2014 01:18:57 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 18 Sep 2014 01:18:57 +0000 (UTC) To: guile-user@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Thu Sep 18 03:18:50 2014 Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XUQN0-0000T3-CL for guile-user@m.gmane.org; Thu, 18 Sep 2014 03:18:50 +0200 Original-Received: from localhost ([::1]:48009 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XUQMz-0003oG-VH for guile-user@m.gmane.org; Wed, 17 Sep 2014 21:18:49 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:32903) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XUQMl-0003k4-4C for guile-user@gnu.org; Wed, 17 Sep 2014 21:18:42 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XUQMc-0004O1-SO for guile-user@gnu.org; Wed, 17 Sep 2014 21:18:35 -0400 Original-Received: from vms173021pub.verizon.net ([206.46.173.21]:65485) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XUQMc-0004MA-M4 for guile-user@gnu.org; Wed, 17 Sep 2014 21:18:26 -0400 Original-Received: from [192.168.2.127] ([unknown] [71.108.232.6]) by vms173021.mailsrvcs.net (Sun Java(tm) System Messaging Server 7u2-7.02 32bit (built Apr 16 2009)) with ESMTPA id <0NC2006QXOY3U1D0@vms173021.mailsrvcs.net> for guile-user@gnu.org; Wed, 17 Sep 2014 20:18:05 -0500 (CDT) X-Mailer: Apple Mail (2.1878.6) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 206.46.173.21 X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Original-Sender: guile-user-bounces+guile-user=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.user:11524 Archived-At: --Apple-Mail=_63837671-4EE4-49C6-B9CE-461EF7A0218C Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset=us-ascii 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=3Ddef")) (tokiz-latok mt) -> #\a (tokiz-laval mt) -> "abc" (tokiz-match mt #\a) (tokiz-latok mt) -> #\=3D 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. <=3D(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 =3D parse object =3D #(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=3Dfoo -> make-foo=20 (lambda (template-id . args) (datum->syntax-object template-id (string->symbol (apply string-append (map (lambda (x)=20 (if (string? x) x (symbol->string (syntax-object->datum x)))) args)))))) --Apple-Mail=_63837671-4EE4-49C6-B9CE-461EF7A0218C Content-Disposition: attachment; filename=u1.scm Content-Type: application/octet-stream; name="u1.scm" Content-Transfer-Encoding: 7bit (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)) --Apple-Mail=_63837671-4EE4-49C6-B9CE-461EF7A0218C--