git @ Cat's Eye Technologies Pixley / aa1a06c
Rewrite tower to support implementations that can't load sexps. catseye 13 years ago
2 changed file(s) with 26 addition(s) and 28 deletion(s). Raw diff Collapse all Expand all
1111 SCRIPTDIR=`dirname ${SCRIPT}`
1212
1313 cd ${SCRIPTDIR}/..
14 cp src/tower.scm mytower.scm
15 echo -n '(tower (list ' >>mytower.scm
14 echo -n '' >init.scm
15 if [ $R5RS = your-weird-scheme ]; then
16 cat >>init.scm <<EOF
17 (stuff (to support your weird scheme))
18 EOF
19 fi
20 cat <src/tower.scm >>init.scm
21 echo '(tower (quote (' >>init.scm
1622 for SEXPFILE do
17 echo -n '"'$SEXPFILE'" ' >>mytower.scm
23 cat $SEXPFILE >>init.scm
1824 done
19 echo -n '))' >>mytower.scm
25 echo ')))' >>init.scm
2026
21 ${R5RS} mytower.scm
22 rm -f mytower.scm
27 ${R5RS} init.scm
28 rm -f init.scm
1212 ; If you're interested, you can look at earlier revisions of this
1313 ; file in the repository -- but you are probably not that interested.
1414
15 ; Load an S-expression from a named file.
16 (define load-sexp
17 (lambda (filename)
18 (with-input-from-file filename (lambda () (read)))))
19
2015 ; The pseudocode is:
2116 ;
22 ; pop the last file off the command line
23 ; load the sexp from it -> current sexp
24 ; while there are files remaining on the command line:
25 ; pop the last file off the command line
17 ; pop the top sexp off the tower -> current sexp
18 ; while there are sexps remaining on the tower:
19 ; pop the top sexp off the tower
2620 ; wrap the current sexp with it as an interpreter -> current sexp
2721 ; evaluate current sexp as Scheme
2822
3327 (interpret sexp))))
3428
3529 (define tower-rec
36 (lambda (filenames sexp)
37 (if (null? filenames)
30 (lambda (sexp-tower sexp)
31 (if (null? sexp-tower)
3832 (eval sexp (scheme-report-environment 5))
39 (let* ((filename (car filenames))
40 (rest (cdr filenames))
41 (sexp (wrap-sexp sexp (load-sexp filename))))
42 (tower-rec rest sexp)))))
43
33 (let* ((interpreter-sexp (car sexp-tower))
34 (rest (cdr sexp-tower)))
35 (tower-rec rest (wrap-sexp sexp interpreter-sexp))))))
36
4437 (define tower
45 (lambda (filenames)
46 (let* ((filenames (reverse filenames)))
47 (if (null? filenames)
38 (lambda (sexp-tower)
39 (let* ((sexp-tower (reverse sexp-tower)))
40 (if (null? sexp-tower)
4841 '()
49 (let* ((filename (car filenames))
50 (rest (cdr filenames))
51 (sexp (load-sexp filename)))
42 (let* ((sexp (car sexp-tower))
43 (rest (cdr sexp-tower)))
5244 (tower-rec rest sexp))))))