Tokenize now recognizes gensym syntax:

#{id0} => a fresh gensym with pretty-string id0
  #{id0 id1} => an interned gensym with pretty-string id0
                and unique-string id1.
id0 and id1 can have any identifier syntax including bar-quoted ids.
any number of whitespaces can be placed around id0 and id1.
This commit is contained in:
Abdulaziz Ghuloum 2006-12-25 11:18:37 +03:00
parent 158980aeea
commit e7d0a0a1cc
2 changed files with 49 additions and 1 deletions

Binary file not shown.

View File

@ -10,7 +10,7 @@
(define delimiter? (define delimiter?
(lambda (c) (lambda (c)
(or (char-whitespace? c) (or (char-whitespace? c)
(memq c '(#\( #\) #\[ #\] #\' #\` #\, #\"))))) (memq c '(#\( #\) #\[ #\] #\{ #\} #\' #\` #\, #\")))))
(define digit? (define digit?
(lambda (c) (lambda (c)
(and ($char<= #\0 c) ($char<= c #\9)))) (and ($char<= #\0 c) ($char<= c #\9))))
@ -274,6 +274,14 @@
(define tokenize-hash (define tokenize-hash
(lambda (p) (lambda (p)
(tokenize-hash/c (read-char p) p))) (tokenize-hash/c (read-char p) p)))
(define (skip-whitespace p caller)
(let ([c (read-char p)])
(cond
[(eof-object? c)
(error 'tokenize "invalid eof insize ~a" caller)]
[(char-whitespace? c)
(skip-whitespace p caller)]
[else c])))
(define tokenize-hash/c (define tokenize-hash/c
(lambda (c p) (lambda (c p)
(cond (cond
@ -343,6 +351,46 @@
(cons 'datum (eof-object)))))] (cons 'datum (eof-object)))))]
[(digit? c) [(digit? c)
(tokenize-hashnum p (char->num c))] (tokenize-hashnum p (char->num c))]
[($char= #\{ c)
(let* ([c (skip-whitespace p "gensym")]
[id0
(cond
[(initial? c)
(list->string
(reverse (tokenize-identifier (cons c '()) p)))]
[($char= #\| c)
(list->string
(reverse (tokenize-bar p '())))]
[else
(error 'tokenize
"invalid char ~a inside gensym" c)])]
[c (skip-whitespace p "gensym")])
(cond
[($char= #\} c)
(cons 'datum (gensym id0))]
[else
(let ([id1
(cond
[(initial? c)
(list->string
(reverse
(tokenize-identifier
(cons c '()) p)))]
[($char= #\| c)
(list->string
(reverse (tokenize-bar p '())))]
[else
(error 'tokenize
"invalid char ~a inside gensym" c)])])
(let ([c (skip-whitespace p "gensym")])
(cond
[($char= #\} c)
(cons 'datum
(foreign-call "ikrt_strings_to_gensym"
id0 id1))]
[else
(error 'tokenize
"invalid char ~a inside gensym" c)])))]))]
[else [else
(unread-char c p) (unread-char c p)
(error 'tokenize "invalid syntax #~a" c)]))) (error 'tokenize "invalid syntax #~a" c)])))