/lib/template.arc

 1; originally from http://awwx.ws/template5.arc
 2
 3(load "lib/util.arc")
 4
 5(implicit guillemet pr)
 6
 7; turn adjacent characters into a string
 8
 9(def coalesce-chars (lst)
10  (xloop (lst lst a nil)
11    (if (no lst)
12         (rev a)
13         (let (chars rest) (span [is (type _) 'char] lst)
14           (if chars
15                (next rest (cons (coerce chars 'string) a))
16                (next cdr.lst (cons car.lst a)))))))
17
18(def slurp-template-field (closing port)
19  (read:string:accum a
20    (whiler c (readc port) [or (no _) (is _ closing)]
21      (a c))))
22
23(def slurp-template (port (o accum))
24  (cons 'template
25        (coalesce-chars:accum a
26          (whiler c (readc port) [or (no _) (is _ #\”)]
27            (a (if (is c #\«)
28                    (list 'guillemet (slurp-template-field #\» port))
29                   (is c #\⌊)
30                    (list 'pr (slurp-template-field #\⌋ port))
31                    c))))))
32
33(extend-readtable #\“ slurp-template)
34
35(mac template xs
36  `(do ,@(map [if (isa _ 'string)
37                   `(pr ,_)
38                   _]
39              xs)))