gdritter repos when-computer / ac3bbea
Reimplemented deps inline Getty Ritter 9 years ago
2 changed file(s) with 72 addition(s) and 0 deletion(s). Collapse all Expand all
+7
-0
generator/default.c.do less more
1 #!/bin/bash -e
2
3 echo $1 - $2 - $3
4 redo-ifchange $1.scm
5 TEMP=$(mktemp -u -p $(pwd) tmpXXXXXX)
6 csc -t -unit $1 $1.scm -o $TEMP
7 mv $TEMP.c $3
+65
-0
generator/libs.scm less more
1 (declare (unit libs))
2
3 ;; some library stuff
4
5 (define (intercalate x xs)
6 (define (go ls)
7 (if (null? ls) '()
8 (cons (car ls) (cons x (go (cdr ls))))))
9 (apply string-append (go xs)))
10
11 (define (scss->css scss)
12 (define (mk-selector selector)
13 (cond ((symbol? selector) (symbol->string selector))
14 ((and (list? selector)
15 (eq? (car selector) '=)
16 (eq? (cadr selector) 'class))
17 (format #f ".~a" (symbol->string (caddr selector))))
18 ((and (list? selector)
19 (eq? (car selector) '=)
20 (eq? (cadr selector) 'id))
21 (format #f "#~a" (symbol->string (caddr selector))))
22 ((and (list? selector)
23 (eq? (car selector) '//))
24 (intercalate " " (map mk-selector (cdr selector))))
25 ((and (list? selector)
26 (eq? (car selector) '&&))
27 (intercalate "," (map mk-selector (cdr selector))))
28 (else "...")))
29 (define (mk-line line)
30 (format #f "~a: ~a; " (car line) (cadr line)))
31 (define (mk-clause clause)
32 (string-append
33 (mk-selector (car clause))
34 " { "
35 (apply string-append (map mk-line (cdr clause)))
36 "} "))
37 (apply string-append (map mk-clause scss)))
38
39 (define (cadr? sexp)
40 (if (or (null? sexp)
41 (null? (cdr sexp))
42 (not (list? (cadr sexp))))
43 #f (cadr sexp)))
44
45 (define (serialize-sxml sxml)
46 (define (mk-prop prop)
47 (let ((key (car prop)) (val (cadr prop)))
48 (format #f " ~a=~a" key
49 (if (string? val) (format #f "\"~a\"" val) val))))
50 (cond ((null? sxml) "")
51 ((string? sxml) sxml)
52 ((symbol? sxml) (symbol->string sxml))
53 ((not (symbol? (car sxml)))
54 (apply string-append (map serialize-sxml sxml)))
55 (else
56 (let ((tag (car sxml))
57 (props (if (and (cadr? sxml) (eq? (caadr sxml) '@))
58 (cdadr sxml) '()))
59 (vals (if (and (cadr? sxml) (eq? (caadr sxml) '@))
60 (cddr sxml) (cdr sxml))))
61 (format #f "<~a~a>~a</~a>"
62 tag
63 (apply string-append (map mk-prop props))
64 (apply string-append (map serialize-sxml vals))
65 tag)))))