author | Tony Garnock-Jones <tonygarnockjones@gmail.com> |
Wed, 16 Jan 2019 17:15:58 +0000 | |
changeset 438 | 1fe179d53161 |
parent 335 | 431a3839afc9 |
permissions | -rw-r--r-- |
335
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
1 |
#lang racket/base |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
2 |
;; Based on pe.rkt but straying further afield from the original paper. |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
3 |
;; Started 2018-06-30 |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
4 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
5 |
(require racket/set) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
6 |
(require racket/match) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
7 |
(require racket/pretty) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
8 |
(require (only-in racket/list drop-right last partition append-map)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
9 |
(require (only-in racket/struct make-constructor-style-printer)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
10 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
11 |
(define-syntax-rule (define-node-struct N (F ...) extra ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
12 |
(struct N (F ...) #:transparent extra ...)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
13 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
14 |
(define-node-struct Lit (value)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
15 |
(define-node-struct Letrec (names inits body)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
16 |
(define-node-struct Ref (name)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
17 |
(define-node-struct Lambda (formals filter body)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
18 |
(define-node-struct If (test true false)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
19 |
(define-node-struct Apply (rator rands)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
20 |
(define-node-struct Bind (name init body)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
21 |
(define-node-struct Closure (formals filter body env) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
22 |
#:methods gen:custom-write |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
23 |
[(define write-proc |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
24 |
(make-constructor-style-printer (lambda (c) 'Closure) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
25 |
(lambda (c) (list (Closure-formals c) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
26 |
(Closure-filter c) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
27 |
(Closure-body c) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
28 |
(Closure-env c)))))]) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
29 |
(define-node-struct Prim (name handler)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
30 |
(define-node-struct Cons (a d)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
31 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
32 |
(define (sval-known? node) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
33 |
(or (Lit? node) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
34 |
(Cons? node) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
35 |
(Prim? node) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
36 |
(Closure? node))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
37 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
38 |
(define (parse exp) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
39 |
(let walk ((exp exp)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
40 |
(match exp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
41 |
[(? symbol?) (Ref exp)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
42 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
43 |
[`(quote ,e) (Lit e)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
44 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
45 |
[`(lambda (,formals ...) #:filter ,filter ,body-exps ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
46 |
(Lambda formals |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
47 |
(parse filter) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
48 |
(parse `(begin ,@body-exps)))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
49 |
[`(lambda (,formals ...) ,body-exps ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
50 |
(Lambda formals |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
51 |
#f |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
52 |
(parse `(begin ,@body-exps)))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
53 |
[`(lambda* (,formals ...) ,body-exps ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
54 |
(Lambda formals |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
55 |
(Lit 'unfold) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
56 |
(parse `(begin ,@body-exps)))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
57 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
58 |
[`(begin) (Lit (void))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
59 |
[`(begin ,e) (walk e)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
60 |
[`(begin ,e ,es ...) (walk `(let ((,(gensym 'ignored) ,e)) ,@es))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
61 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
62 |
[`(if ,test ,true) (If (walk test) (walk true) (Lit (void)))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
63 |
[`(if ,test ,true ,false) (If (walk test) (walk true) (walk false))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
64 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
65 |
[`(cond) (Lit (void))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
66 |
[`(cond (else ,es ...)) (walk `(begin ,@es))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
67 |
[`(cond (,test ,es ...) ,clauses ...) (walk `(if ,test (begin ,@es) (cond ,@clauses)))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
68 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
69 |
[`(let ,(? symbol? name) ((,names ,inits) ...) ,es ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
70 |
(walk `(letrec ((,name (lambda ,names ,@es))) (,name ,@inits)))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
71 |
[`(let ((,names ,inits) ...) ,es ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
72 |
(walk `((lambda* ,names ,@es) ,@inits))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
73 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
74 |
[`(letrec ((,names ,inits) ...) ,es ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
75 |
(if (null? names) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
76 |
(walk `(begin ,@es)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
77 |
(Letrec names (map parse inits) (parse `(begin ,@es))))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
78 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
79 |
[`(let* () ,es ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
80 |
(walk `(begin ,@es))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
81 |
[`(let* ((,name ,init) ,more ...) ,es ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
82 |
(walk `(let ((,name ,init)) (let* ,more ,@es)))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
83 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
84 |
[`(,rator ,rands ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
85 |
(Apply (walk rator) (map walk rands))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
86 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
87 |
[_ (Lit exp)]))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
88 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
89 |
(define *globals* (make-hash)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
90 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
91 |
(define (extend-env/undefined env names) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
92 |
(append (for/list [(name names)] (cons name (box #f))) env)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
93 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
94 |
(define (extend-env/ref env names) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
95 |
(append (for/list [(name names)] (cons name (box (list (Ref name))))) env)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
96 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
97 |
(define (extend-env env names inits) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
98 |
(append (for/list [(name names) (init inits)] (cons name (box (list init)))) env)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
99 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
100 |
(define (lookup-env env name) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
101 |
(or (assq name env) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
102 |
(and (hash-has-key? *globals* name) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
103 |
(cons name (hash-ref *globals* name))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
104 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
105 |
(define noisy? #f) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
106 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
107 |
(define (pe pexp env cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
108 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
109 |
(define (->value pexp env cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
110 |
(match pexp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
111 |
[(Lit _) pexp] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
112 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
113 |
[(Letrec names inits body) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
114 |
(define newenv (extend-env/undefined env names)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
115 |
(for [(name names) (init inits)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
116 |
(define binding-box (cdr (lookup-env newenv name))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
117 |
(set-box! binding-box (list (->value init newenv cache)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
118 |
;; BUG: need to collect free variables of the pe'd body, and if |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
119 |
;; there are references to any of this pexp's names, we need to |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
120 |
;; wrap the pe'd body in a letrec of the relevant names. |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
121 |
;; (Actually, iterate until we've pulled in everything we need.) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
122 |
(->value body newenv cache)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
123 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
124 |
[(Ref name) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
125 |
(match (lookup-env env name) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
126 |
[#f pexp] ;; TODO: unbound variable error instead? |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
127 |
[(cons _ (box #f)) pexp] ;; TODO: reference to not-yet-initialized-variable error instead? |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
128 |
[(cons _ (box (list v))) v])] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
129 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
130 |
[(Lambda formals filter body) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
131 |
(Closure formals filter (->code body (extend-env/ref env formals) cache) env)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
132 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
133 |
[(Bind name init body) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
134 |
(define value (->value init env cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
135 |
(->value body (extend-env env (list name) (list value)) cache)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
136 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
137 |
[(Cons a d) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
138 |
(Cons (->value a env cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
139 |
(->value d env cache))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
140 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
141 |
[(If test true false) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
142 |
(define val (->value test env cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
143 |
(if (sval-known? val) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
144 |
(if (and (Lit? val) (Lit-value val)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
145 |
(->value true env cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
146 |
(->value false env cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
147 |
(If val |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
148 |
(->value true env cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
149 |
(->value false env cache)))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
150 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
151 |
[(Apply rator0 rands0) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
152 |
(eval-many |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
153 |
->value |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
154 |
(cons rator0 rands0) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
155 |
env |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
156 |
cache |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
157 |
(lambda (rator . rands) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
158 |
(if (sval-known? rator) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
159 |
(match rator |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
160 |
[(Closure formals filter body rator-env) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
161 |
(define newenv (extend-env rator-env formals rands)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
162 |
(match (cond [filter (Lit-value (->value filter newenv cache))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
163 |
[(andmap sval-known? rands) 'unfold] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
164 |
[else (for/list [(f formals)] #f)]) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
165 |
['unfold (->value body newenv cache)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
166 |
[(list (? boolean? props) ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
167 |
(define cache-rands (for/list [(prop props) (formal formals) (rand rands)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
168 |
(if prop rand (Ref formal)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
169 |
(define cache-key (cons rator cache-rands)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
170 |
(match (assoc cache-key cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
171 |
[(list _ cached-rator) (Apply cached-rator rands)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
172 |
[#f |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
173 |
(define rec-proc |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
174 |
(let ((tmp-sym (gensym 'rec))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
175 |
(Letrec (list tmp-sym) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
176 |
(list |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
177 |
(Closure formals |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
178 |
filter |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
179 |
(->value body |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
180 |
(extend-env rator-env formals cache-rands) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
181 |
(cons (list cache-key (Ref tmp-sym)) cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
182 |
rator-env)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
183 |
(Ref tmp-sym)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
184 |
(->value body newenv (cons (list cache-key rec-proc) cache))])])] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
185 |
[(Prim name handler) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
186 |
(apply handler rands)]) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
187 |
(Apply rator rands))))])) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
188 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
189 |
(define (->code pexp env cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
190 |
(match pexp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
191 |
[(Lit _) pexp] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
192 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
193 |
[(Letrec names inits body) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
194 |
(define newenv (extend-env/ref env names)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
195 |
(Letrec names |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
196 |
(for/list [(init inits)] (->code init newenv cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
197 |
(->code body newenv cache))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
198 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
199 |
[(Ref name) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
200 |
(match (lookup-env env name) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
201 |
[#f pexp] ;; TODO: unbound variable error instead? |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
202 |
[(cons _ (box #f)) pexp] ;; TODO: reference to not-yet-initialized-variable error instead? |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
203 |
[(cons _ (box (list v))) v])] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
204 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
205 |
[(Lambda formals filter body) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
206 |
(Lambda formals filter (->code body (extend-env/ref env formals) cache))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
207 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
208 |
[(Bind name init body) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
209 |
;; (printf "B ~v ~v ~v\n" name init body) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
210 |
(define code (->code init env cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
211 |
(if (Lambda? code) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
212 |
(->code body (extend-env env (list name) (list code)) cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
213 |
(Bind name code (->code body (extend-env/ref env (list name)) cache))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
214 |
;; (Bind name (->code init env cache) (->code body (extend-env/ref env (list name)) cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
215 |
;; (->code body (extend-env env (list name) (list (->code init env cache))) cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
216 |
] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
217 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
218 |
[(Cons a d) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
219 |
(Cons (->code a env cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
220 |
(->code d env cache))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
221 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
222 |
[(If test true false) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
223 |
(define val (->value test env cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
224 |
(if (sval-known? val) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
225 |
(if (and (Lit? val) (Lit-value val)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
226 |
(->code true env cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
227 |
(->code false env cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
228 |
(If (->code test env cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
229 |
(->code true env cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
230 |
(->code false env cache)))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
231 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
232 |
[(Apply rator0 rands0) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
233 |
(eval-many |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
234 |
->code |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
235 |
(cons rator0 rands0) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
236 |
env |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
237 |
cache |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
238 |
(lambda (rator-code . rands) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
239 |
(define rator (->value rator0 env cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
240 |
(if (sval-known? rator) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
241 |
(match rator |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
242 |
[(Closure formals filter body rator-env) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
243 |
(define newenv (extend-env rator-env formals rands)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
244 |
(match (cond [filter (Lit-value (->value filter newenv cache))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
245 |
[(andmap sval-known? rands) 'unfold] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
246 |
[else (for/list [(f formals)] #f)]) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
247 |
['unfold (->code body newenv cache)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
248 |
[(list (? boolean? props) ...) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
249 |
(define cache-rands (for/list [(prop props) (formal formals) (rand rands)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
250 |
(if prop rand (Ref formal)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
251 |
(define cache-key (cons rator cache-rands)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
252 |
(match (assoc cache-key cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
253 |
[(list _ cached-rator) (Apply cached-rator rands)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
254 |
[#f |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
255 |
(define rec-proc |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
256 |
(let ((tmp-sym (gensym 'rec))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
257 |
(Letrec (list tmp-sym) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
258 |
(list |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
259 |
(Closure formals |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
260 |
filter |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
261 |
(->code body |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
262 |
(extend-env rator-env formals cache-rands) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
263 |
(cons (list cache-key (Ref tmp-sym)) cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
264 |
rator-env)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
265 |
(Ref tmp-sym)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
266 |
(->code body newenv (cons (list cache-key rec-proc) cache))])])] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
267 |
[(Prim name handler) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
268 |
(apply handler rands)]) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
269 |
(Apply rator-code rands))))])) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
270 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
271 |
(define (hoist-binds r k) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
272 |
(match r |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
273 |
[(Bind name init body) (Bind name init (hoist-binds body k))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
274 |
[_ (k r)])) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
275 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
276 |
(define (eval-many E pexps env cache k) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
277 |
(let loop ((pexps pexps) (acc-rev '())) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
278 |
(if (null? pexps) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
279 |
(apply k (reverse acc-rev)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
280 |
(let ((pexp (car pexps))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
281 |
(hoist-binds (E pexp env cache) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
282 |
(lambda (r) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
283 |
(if (or (sval-known? r) (Ref? r) (Lambda? r)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
284 |
(loop (cdr pexps) (cons r acc-rev)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
285 |
(let ((n (gensym 'seq))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
286 |
(Bind n r (loop (cdr pexps) (cons (Ref n) acc-rev))))))))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
287 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
288 |
(when noisy? |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
289 |
(local-require racket/trace) (trace ->code ->value)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
290 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
291 |
(->value pexp env cache)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
292 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
293 |
(define (free-names pexp) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
294 |
(match pexp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
295 |
[(Lit _) (seteq)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
296 |
[(Cons a d) (set-union (free-names a) (free-names d))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
297 |
[(Prim _ _) (seteq)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
298 |
[(or (Closure formals _ body _) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
299 |
(Lambda formals _ body)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
300 |
(set-subtract (free-names body) (list->seteq formals))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
301 |
[(Letrec names inits body) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
302 |
(set-subtract (apply set-union (free-names body) (map free-names inits)) (list->seteq names))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
303 |
[(Ref name) (seteq name)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
304 |
[(If test true false) (set-union (free-names test) (free-names true) (free-names false))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
305 |
[(Apply rator rands) (apply set-union (free-names rator) (map free-names rands))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
306 |
[(Bind name init body) (set-remove (free-names body) name)])) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
307 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
308 |
(struct cached-code ([use-count #:mutable] temp-var-sym [reduced-expr #:mutable]) #:transparent) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
309 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
310 |
(define (codegen pexp) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
311 |
(let walk ((pexp pexp)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
312 |
(match pexp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
313 |
[(Lit v) `(quote ,v)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
314 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
315 |
[(Cons a (Lit '())) `(LIST ,(walk a))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
316 |
[(Cons a d) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
317 |
(match (walk d) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
318 |
[(cons 'LIST r) `(LIST ,(walk a) ,@r)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
319 |
[dc `(cons ,(walk a) ,dc)])] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
320 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
321 |
[(Prim name _) name] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
322 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
323 |
[(Closure formals filter body env) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
324 |
`(let (,@(for/list [(fname (free-names pexp))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
325 |
(match (lookup-env env fname) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
326 |
[#f (list fname '_____)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
327 |
[(cons _name (box (list v))) (list fname (walk v))]))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
328 |
(lambda ,formals |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
329 |
,@(if filter |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
330 |
`(#:filter ,(walk filter)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
331 |
`()) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
332 |
,(walk body)))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
333 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
334 |
[(Letrec names inits body) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
335 |
`(letrec ,(for/list [(name names) (init inits)] (list name (walk init))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
336 |
,(walk body))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
337 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
338 |
[(Ref name) name] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
339 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
340 |
[(Lambda formals #f body) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
341 |
`(lambda ,formals ,(walk body))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
342 |
[(Lambda formals filter body) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
343 |
`(lambda ,formals #:filter ,(walk filter) ,(walk body))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
344 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
345 |
[(If test true false) `(if ,(walk test) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
346 |
,(walk true) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
347 |
,(walk false))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
348 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
349 |
[(Apply rator rands) `(,(walk rator) ,@(map walk rands))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
350 |
[(Bind name init body) `(let ((,name ,(walk init))) ,(walk body))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
351 |
))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
352 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
353 |
(define (residualize-apply name . args) (Apply (Ref name) args)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
354 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
355 |
(define (lift-residualize f-name f) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
356 |
(lambda args |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
357 |
(if (andmap sval-known? args) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
358 |
(Lit (apply f (map Lit-value args))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
359 |
(apply residualize-apply f-name args)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
360 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
361 |
(define (lift-residualize* f-name f) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
362 |
(lambda args |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
363 |
(if (andmap sval-known? args) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
364 |
(Lit (apply f args)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
365 |
(apply residualize-apply f-name args)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
366 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
367 |
(define (lift-commutative-associative-binop f-name f identity) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
368 |
(lambda vals |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
369 |
(define-values (known unknown) (partition sval-known? vals)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
370 |
(define part-val (apply f (map Lit-value known))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
371 |
(define part (Lit part-val)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
372 |
(cond [(null? unknown) part] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
373 |
[(= identity part-val) (apply residualize-apply f-name unknown)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
374 |
[else (apply residualize-apply f-name part unknown)]))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
375 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
376 |
(for-each (lambda (p) (hash-set! *globals* (Prim-name p) (box (list p)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
377 |
(list |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
378 |
(Prim 'sval-known? (lambda (x) (Lit (sval-known? x)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
379 |
(Prim '+ (lift-commutative-associative-binop '+ + 0)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
380 |
(Prim '* (lift-commutative-associative-binop '* * 1)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
381 |
(Prim '- (lift-residualize '- -)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
382 |
(Prim '< (lift-residualize '< <)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
383 |
(Prim 'cons (lambda (a d) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
384 |
(if (and (Lit? a) (Lit? d)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
385 |
(Lit (cons (Lit-value a) (Lit-value d))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
386 |
(Cons a d)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
387 |
(Prim 'null? (lift-residualize* 'null? (lambda (x) (and (Lit? x) (null? (Lit-value x)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
388 |
(Prim 'pair? (lift-residualize* 'pair? (lambda (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
389 |
(or (Cons? x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
390 |
(and (Lit? x) (pair? (Lit-value x))))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
391 |
(Prim 'number? (lift-residualize* 'number? (lambda (x) (and (Lit? x) (number? (Lit-value x)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
392 |
(Prim 'zero? (lift-residualize 'zero? zero?)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
393 |
(Prim 'eq? (lambda (x y) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
394 |
(if (and (Lit? x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
395 |
(Lit? y)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
396 |
(Lit (eq? (Lit-value x) (Lit-value y))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
397 |
(residualize-apply 'eq? x y)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
398 |
(Prim 'PRIMcar (lambda (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
399 |
(match x |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
400 |
[(Cons a _) a] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
401 |
[(Lit (cons a _)) (Lit a)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
402 |
[_ (residualize-apply 'PRIMcar x)]))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
403 |
(Prim 'PRIMcdr (lambda (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
404 |
(match x |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
405 |
[(Cons _ d) d] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
406 |
[(Lit (cons _ d)) (Lit d)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
407 |
[_ (residualize-apply 'PRIMcdr x)]))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
408 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
409 |
(define (extend-globals! entry) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
410 |
(hash-set! *globals* |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
411 |
(car entry) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
412 |
(box (list (pe (parse (cadr entry)) '() '()))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
413 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
414 |
(for-each extend-globals! |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
415 |
(list |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
416 |
(list 'car '(lambda (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
417 |
#:filter 'unfold |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
418 |
(if (pair? x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
419 |
(PRIMcar x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
420 |
(error "Not a pair in car" x)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
421 |
(list 'cdr '(lambda (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
422 |
#:filter 'unfold |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
423 |
(if (pair? x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
424 |
(PRIMcdr x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
425 |
(error "Not a pair in cdr" x)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
426 |
; (list 'car 'PRIMcar) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
427 |
; (list 'cdr 'PRIMcdr) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
428 |
(list 'reverse '(lambda (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
429 |
#:filter 'unfold |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
430 |
(let loop ((x x) (acc '())) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
431 |
(if (null? x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
432 |
acc |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
433 |
(loop (cdr x) (cons (car x) acc)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
434 |
(list 'fold '(lambda (f acc x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
435 |
#:filter (if (sval-known? f) 'unfold '(#f #f #f)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
436 |
(let loop ((x x) (acc acc)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
437 |
(if (null? x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
438 |
acc |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
439 |
(loop (cdr x) (f (car x) acc)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
440 |
(list 'fold-right '(lambda (f acc x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
441 |
#:filter (if (sval-known? f) 'unfold '(#f #f #f)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
442 |
(let loop ((x x)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
443 |
(if (null? x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
444 |
acc |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
445 |
(let ((head (car x))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
446 |
(f head (loop (cdr x)))))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
447 |
(list 'list? '(lambda (xs) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
448 |
(let loop ((xs xs)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
449 |
(if (null? xs) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
450 |
#t |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
451 |
(if (pair? xs) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
452 |
(loop (cdr xs)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
453 |
#f))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
454 |
(list 'list-of '(lambda (c) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
455 |
(lambda (xs) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
456 |
(let loop ((xs xs)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
457 |
(if (null? xs) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
458 |
#t |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
459 |
(if (pair? xs) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
460 |
(if (c (car xs)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
461 |
(loop (cdr xs)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
462 |
#f) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
463 |
#f)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
464 |
(list 'any/c '(lambda (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
465 |
#:filter 'unfold |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
466 |
#t)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
467 |
(list 'map '(lambda (f x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
468 |
#:filter 'unfold |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
469 |
(fold-right (lambda (v c) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
470 |
#:filter 'unfold |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
471 |
(cons (f v) c)) '() x))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
472 |
(list 'append '(lambda (a b) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
473 |
#:filter 'unfold |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
474 |
(fold-right cons b a))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
475 |
)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
476 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
477 |
(for-each extend-globals! |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
478 |
(list |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
479 |
(list 'make-stream '(lambda* (stepper state) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
480 |
(cons 'stream (cons stepper (cons state '()))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
481 |
(list 'stream-stepper '(lambda* (stream) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
482 |
(PRIMcar (PRIMcdr stream)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
483 |
(list 'stream-state '(lambda* (stream) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
484 |
(PRIMcar (PRIMcdr (PRIMcdr stream))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
485 |
(list 'stream-maker '(lambda* (stepper) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
486 |
(lambda* (state) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
487 |
(make-stream stepper state)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
488 |
(list 'list-stream-stepper '(lambda (l done skip yield) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
489 |
(if (null? l) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
490 |
(done) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
491 |
(yield (car l) (cdr l))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
492 |
(list 'list->stream '(stream-maker list-stream-stepper)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
493 |
(list 'string->stream '(lambda* (s) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
494 |
(make-stream (lambda (index done skip yield) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
495 |
#:filter '(#f #t #t #t) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
496 |
(if (= index (string-length s)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
497 |
(done) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
498 |
(yield (string-ref s index) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
499 |
(+ index 1)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
500 |
0))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
501 |
(list 'smap |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
502 |
'(lambda* (f stream) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
503 |
(let ((stepper (stream-stepper stream))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
504 |
(make-stream (lambda* (state done skip yield) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
505 |
(stepper state |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
506 |
done |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
507 |
skip |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
508 |
(lambda* (elt new-state) (yield (f elt) new-state)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
509 |
(stream-state stream))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
510 |
(list 'sfilter '(lambda* (pred stream) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
511 |
(let ((stepper (stream-stepper stream))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
512 |
(make-stream (lambda* (state done skip yield) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
513 |
(stepper state |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
514 |
done |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
515 |
skip |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
516 |
(lambda* (elt new-state) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
517 |
(if (pred elt) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
518 |
(yield elt new-state) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
519 |
(skip new-state))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
520 |
(stream-state stream))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
521 |
(list 'sfoldr |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
522 |
'(lambda* (kons knil stream) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
523 |
(let ((stepper (stream-stepper stream))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
524 |
(let loop ((state (stream-state stream))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
525 |
(stepper state |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
526 |
(lambda* () knil) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
527 |
(lambda* (new-state) (loop new-state)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
528 |
(lambda* (elt new-state) (kons elt (loop new-state)))))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
529 |
(list 'sfoldl |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
530 |
'(lambda* (kons knil stream) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
531 |
(let ((stepper (stream-stepper stream))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
532 |
(let loop ((knil knil) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
533 |
(state (stream-state stream))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
534 |
(stepper state |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
535 |
(lambda* () knil) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
536 |
(lambda* (new-state) (loop new-state)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
537 |
(lambda* (elt new-state) (loop (kons elt knil) new-state))))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
538 |
(list 'stream->list '(lambda* (stream) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
539 |
(sfoldr cons '() stream))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
540 |
(list 'make-szip-state '(lambda* (cell left right) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
541 |
(cons cell (cons left (cons right '()))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
542 |
(list 'szip-state-cell '(lambda* (s) (PRIMcar s))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
543 |
(list 'szip-state-left '(lambda* (s) (PRIMcar (PRIMcdr s)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
544 |
(list 'szip-state-right '(lambda* (s) (PRIMcar (PRIMcdr (PRIMcdr s))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
545 |
(list 'szip |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
546 |
'(lambda* (left right) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
547 |
(let ((left-stepper (stream-stepper left)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
548 |
(right-stepper (stream-stepper right))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
549 |
(make-stream |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
550 |
(lambda (state done skip yield) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
551 |
;;#:filter (if (sval-known? (szip-state-cell state)) 'unfold '(#f #f #f #f)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
552 |
(let ((cell (szip-state-cell state))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
553 |
(cond |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
554 |
((null? cell) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
555 |
(right-stepper |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
556 |
(szip-state-right state) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
557 |
done |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
558 |
(lambda* (new-right) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
559 |
(skip (make-szip-state '() (szip-state-left state) new-right))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
560 |
(lambda* (elt new-right) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
561 |
(skip (make-szip-state (cons elt '()) (szip-state-left state) new-right))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
562 |
(else |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
563 |
(left-stepper |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
564 |
(szip-state-left state) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
565 |
done |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
566 |
(lambda* (new-left) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
567 |
(skip (make-szip-state cell new-left (szip-state-right state)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
568 |
(lambda* (elt new-left) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
569 |
(yield (cons elt cell) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
570 |
(make-szip-state '() new-left (szip-state-right state))))))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
571 |
(make-szip-state '() (stream-state left) (stream-state right)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
572 |
(list 'make-sconcatmap-state '(lambda* (fstep fstate rs) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
573 |
(cons fstep (cons fstate (cons rs '()))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
574 |
(list 'sconcatmap-state-first-stepper '(lambda* (s) (PRIMcar s))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
575 |
(list 'sconcatmap-state-first-state '(lambda* (s) (PRIMcar (PRIMcdr s)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
576 |
(list 'sconcatmap-state-remaining-streams '(lambda* (s) (PRIMcar (PRIMcdr (PRIMcdr s))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
577 |
(list 'sconcatmap |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
578 |
'(lambda* (f streams) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
579 |
(let ((remaining-streams-stepper (stream-stepper streams))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
580 |
(make-stream (lambda (state done skip yield) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
581 |
(let ((first-stepper (sconcatmap-state-first-stepper state))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
582 |
(if first-stepper |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
583 |
(first-stepper |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
584 |
(sconcatmap-state-first-state state) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
585 |
(lambda* () |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
586 |
(skip (make-sconcatmap-state |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
587 |
#f #f |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
588 |
(sconcatmap-state-remaining-streams state)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
589 |
(lambda* (new-first-state) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
590 |
(skip (make-sconcatmap-state |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
591 |
first-stepper new-first-state |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
592 |
(sconcatmap-state-remaining-streams state)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
593 |
(lambda* (elt new-first-state) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
594 |
(yield elt |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
595 |
(make-sconcatmap-state |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
596 |
first-stepper new-first-state |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
597 |
(sconcatmap-state-remaining-streams state))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
598 |
(remaining-streams-stepper |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
599 |
(sconcatmap-state-remaining-streams state) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
600 |
done |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
601 |
(lambda* (new-remaining-streams) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
602 |
(skip (make-sconcatmap-state |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
603 |
#f #f |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
604 |
new-remaining-streams))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
605 |
(lambda* (first new-remaining-streams) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
606 |
(let ((first-stream (f first))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
607 |
(skip (make-sconcatmap-state |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
608 |
(stream-stepper first-stream) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
609 |
(stream-state first-stream) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
610 |
new-remaining-streams)))))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
611 |
(make-sconcatmap-state #f #f (stream-state streams)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
612 |
(list 'sconcatenate |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
613 |
'(lambda* (streams) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
614 |
(sconcatmap (lambda* (stream) stream) streams))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
615 |
)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
616 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
617 |
(define (test-exp exp) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
618 |
(printf "---------------------------------------------------------------------------\n") |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
619 |
(pe (parse exp) '() '())) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
620 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
621 |
(require racket/trace) (trace test-exp) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
622 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
623 |
(define (test) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
624 |
(let ((result (test-exp '(map (lambda (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
625 |
#:filter 'unfold |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
626 |
(+ x 1)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
627 |
(append '(1 2) rest))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
628 |
(pretty-print 'test-done) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
629 |
(pretty-print (codegen result)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
630 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
631 |
(define (popt exp) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
632 |
(pretty-print (codegen (test-exp exp)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
633 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
634 |
(define even-exp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
635 |
'(lambda (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
636 |
;; eta-conversion here to stop the letrec from being elided |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
637 |
;; because of bug described above. |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
638 |
(letrec ((odd? (lambda (x1) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
639 |
(if (zero? x1) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
640 |
#f |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
641 |
(even? (- x1 1))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
642 |
(even? (lambda (x2) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
643 |
#:filter 'unfold |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
644 |
(if (zero? x2) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
645 |
#t |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
646 |
(odd? (- x2 1)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
647 |
(even? x)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
648 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
649 |
(define fib-exp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
650 |
'(letrec ((fib (lambda (n) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
651 |
(if (< n 2) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
652 |
n |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
653 |
(+ (fib (- n 1)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
654 |
(fib (- n 2))))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
655 |
(fib arg))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
656 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
657 |
(define curried-exp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
658 |
'((((lambda (a) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
659 |
(lambda (b) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
660 |
(lambda (c) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
661 |
(do-something-with a b c)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
662 |
'aa) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
663 |
(bb)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
664 |
'cc)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
665 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
666 |
(define curried-exp* |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
667 |
'((((lambda* (a) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
668 |
(lambda* (b) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
669 |
(lambda* (c) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
670 |
(do-something-with a b c)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
671 |
'aa) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
672 |
(bb)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
673 |
'cc)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
674 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
675 |
(define curried-exp2 |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
676 |
'(let ((bv (bb))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
677 |
((((lambda (a) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
678 |
(lambda (b) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
679 |
(lambda (c) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
680 |
(do-something-with a b c)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
681 |
'aa) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
682 |
bv) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
683 |
'cc))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
684 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
685 |
(define curried-cps-exp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
686 |
'((lambda (k a) (k (lambda (k b) (k (lambda (k c) (do-something-with k a b c)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
687 |
(lambda (bf) (bf (lambda (cf) (cf (lambda (x) (begin x)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
688 |
'cc)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
689 |
(bb))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
690 |
'aa)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
691 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
692 |
(define curried-cps-exp* |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
693 |
'((lambda* (k a) (k (lambda* (k b) (k (lambda* (k c) (do-something-with k a b c)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
694 |
(lambda* (bf) (bf (lambda* (cf) (cf (lambda* (x) (begin x)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
695 |
'cc)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
696 |
(bb))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
697 |
'aa)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
698 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
699 |
(define code-duplication-exp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
700 |
'(let ((x (f a b c))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
701 |
(let ((y (g x x))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
702 |
(h y y)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
703 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
704 |
(define filtering-mapping-exp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
705 |
'(fold (lambda* (elt acc) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
706 |
(if (even? elt) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
707 |
(cons elt acc) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
708 |
acc)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
709 |
'() |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
710 |
(map (lambda* (x) (* x 2)) mylist))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
711 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
712 |
(define filtering-mapping-exp2 |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
713 |
'(fold (lambda* (elt acc) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
714 |
(if (even? elt) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
715 |
(cons elt acc) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
716 |
acc)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
717 |
'() |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
718 |
(map (lambda* (x) (* x 2)) '(1 2 3 4 5)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
719 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
720 |
(define sfiltering-smapping-exp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
721 |
'(stream->list |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
722 |
(sfilter (lambda* (elt) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
723 |
(even? elt)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
724 |
(smap (lambda* (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
725 |
(* x 2)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
726 |
(list->stream mylist))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
727 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
728 |
(define smapping-exp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
729 |
'(smap (lambda* (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
730 |
(* x 2)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
731 |
mystream)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
732 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
733 |
(define sfiltering-smapping-exp1 |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
734 |
'(sfilter (lambda* (elt) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
735 |
(even? elt)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
736 |
(smap (lambda* (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
737 |
(* x 2)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
738 |
mystream))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
739 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
740 |
(define sfiltering-smapping-exp2 |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
741 |
'(stream->list |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
742 |
(sfilter (lambda* (elt) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
743 |
(even? elt)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
744 |
(smap (lambda* (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
745 |
(* x 2)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
746 |
(list->stream '(1 2 3 4 5)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
747 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
748 |
(define list-serializer |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
749 |
'(letrec ((ser (lambda* (x emit k) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
750 |
(cond |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
751 |
[(pair? x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
752 |
(emit 'open |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
753 |
(lambda* (emit) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
754 |
(letrec ((serlist (lambda* (xs emit k) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
755 |
(if (pair? xs) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
756 |
(ser (car xs) emit |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
757 |
(lambda* (emit) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
758 |
(serlist (cdr xs) emit k))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
759 |
(k emit))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
760 |
(serlist x emit (lambda* (emit) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
761 |
(emit 'close k))))))] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
762 |
[(number? x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
763 |
(emit x k)] |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
764 |
[else |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
765 |
(error 'not-supported-in-ser)])))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
766 |
(letrec ((collect (lambda* (v k) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
767 |
(cons v (k collect))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
768 |
(ser '(12 22 32) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
769 |
collect |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
770 |
(lambda* (emit) '()))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
771 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
772 |
(define nonterminating-exp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
773 |
`(letrec ((y (lambda (x) (y x)))) (y z))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
774 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
775 |
(define nonterminating-exp2 |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
776 |
`(letrec ((y (lambda (x) #:filter '(#f) (y x)))) (y 1))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
777 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
778 |
;; 2018-07-01 11:53:03 At present, this `popt`s to: |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
779 |
;; |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
780 |
;; '(let ((g (let ((+ +)) (lambda (b) #:filter 'unfold (+ b '1)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
781 |
;; (f (let ((* *)) (lambda (a) #:filter 'unfold (* a '2))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
782 |
;; (lambda (x) #:filter 'unfold (f (g x)))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
783 |
;; |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
784 |
;; I would like it to also inline `f` and `g`. |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
785 |
;; |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
786 |
(define compose-exp |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
787 |
'(let ((compose (lambda* (f g) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
788 |
(lambda* (x) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
789 |
(f (g x)))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
790 |
(compose (lambda* (a) (* a 2)) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
791 |
(lambda* (b) (+ b 1))))) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
792 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
793 |
(set! noisy? #t) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
794 |
(require racket/trace) (trace pe) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
795 |
|
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
796 |
;;; Local Variables: |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
797 |
;;; eval: (put 'lambda* 'scheme-indent-function 1) |
431a3839afc9
Another confused and ultimately broken stab at partial evaluation
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
798 |
;;; End: |