Update of /cvsroot/wisp/wisp/src/builtin
In directory usw-pr-cvs1:/tmp/cvs-serv32455/src/builtin
Modified Files:
parser.wisp stdenv.wisp
Log Message:
Implemented generic string templates.
Index: parser.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/parser.wisp,v
retrieving revision 1.117
retrieving revision 1.118
diff -u -d -r1.117 -r1.118
--- parser.wisp 4 Sep 2002 14:34:29 -0000 1.117
+++ parser.wisp 4 Sep 2002 14:38:13 -0000 1.118
@@ -431,24 +431,40 @@
(if (not (eqv? t #\]))
(raise 'syntax t)))
item))
- ((#\[ #\open #\,)
+ ((#\open)
(read-simple-structure port))
(else ; can't happen
(raise 'invalid-dollar-construct c)))
- (cons! tail (list (if unquote?
- 'dwim-stringify
- 'structure->string) item))))
+ (if unquote?
+ (set! item (list 'unquote item)))
+ (if (string? item)
+ (set! item (list 'begin item)))
+ (cons! tail item)))
(loop))
- (begin
- (if (null? tail)
- (car p)
- (begin
- (my s (car p)
- (if (not (string-null? s))
- (cons! tail s)))
- (if (null? (cdr tail))
- (car tail)
- (cons 'string-append (reverse tail))))))))))))
+ (if (null? tail)
+ (car p)
+ (begin
+ (my s (car p)
+ (if (not (string-null? s))
+ (cons! tail s)))
+ (if (and (null? (cdr tail)) (string? (car tail)))
+ (car tail)
+ (cons 'string-template (reverse tail)))))))))))
+
+(defmacro (string-template . items)
+ (if (null? items)
+ `(string)
+ (cons 'string-append
+ (map (lambda (item)
+ (cond
+ ((string? item) item)
+ ((and (cons? item)
+ (eq? (car item) 'unquote)
+ (cons? (cdr item))
+ (null? (cddr item)))
+ `(dwim-stringify ,(cadr item)))
+ (else `(structure->string ,item))))
+ items))))
;;;; Parsing of numbers
Index: stdenv.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/stdenv.wisp,v
retrieving revision 1.358
retrieving revision 1.359
diff -u -d -r1.358 -r1.359
--- stdenv.wisp 4 Sep 2002 14:36:25 -0000 1.358
+++ stdenv.wisp 4 Sep 2002 14:38:13 -0000 1.359
@@ -83,15 +83,15 @@
string-append string-concatenate string-copy
string-downcase string-downcase! string-fill! string-join
string-length string-move! string-null? string-ref
- string-upcase string-upcase! string<=? string<? string=?
- string>=? string>? string? structure->string sub subclass?
- substring superclass swap! swyde? symbol->string
- symbol-length symbol-ref symbol<=? symbol<? symbol>=?
- symbol>? symbol? system-constant tcchangeattr tcgetattr
- tcgetattr-raw tcsetattr-raw tenth third toposplit
- translate tree-copy truncate try tty? type type-of ubyte?
- unix-time unpack-be-integer unpack-le-integer
- unsure-collect use utf-8->c16string
+ string-template string-upcase string-upcase! string<=?
+ string<? string=? string>=? string>? string?
+ structure->string sub subclass? substring superclass swap!
+ swyde? symbol->string symbol-length symbol-ref symbol<=?
+ symbol<? symbol>=? symbol>? symbol? system-constant
+ tcchangeattr tcgetattr tcgetattr-raw tcsetattr-raw tenth
+ third toposplit translate tree-copy truncate try tty? type
+ type-of ubyte? unix-time unpack-be-integer
+ unpack-le-integer unsure-collect use utf-8->c16string
utf-8-first-byte->length uwyde? vector vector->list
vector-append vector-copy vector-fill! vector-length
vector-move! vector-ref vector? void? wisp-string-hash
|
