44 lines
1.2 KiB
Text
44 lines
1.2 KiB
Text
|
#lang racket
|
||
|
|
(define segments '(exps (def a 12)
|
||
|
|
(def b 24)
|
||
|
|
(l (b x) (+ a b x))
|
||
|
|
(def c 24)
|
||
|
|
(+ b a 13)))
|
||
|
|
|
||
|
|
(define (prime? op) (memq op '(%+ %- %* %/)))
|
||
|
|
|
||
|
|
(define (find_fv x)
|
||
|
|
(match x
|
||
|
|
[`(def ,x ,y) (set-subtract (find_fv y) `(,x))]
|
||
|
|
[`(l ,args ,y) (set-subtract (find_fv y) args)]
|
||
|
|
[(? integer? _) '()]
|
||
|
|
[(? symbol? _) `(,x)]
|
||
|
|
[(list (? prime? op) args ...) (remove-duplicates (flatten (map find_fv args))) ]
|
||
|
|
[(list args ...) (remove-duplicates (flatten (map find_fv args))) ]
|
||
|
|
))
|
||
|
|
|
||
|
|
(find_fv `(+ a b b c))
|
||
|
|
(find_fv `(def x y))
|
||
|
|
(find_fv `(l (x y) (%+ x y z)))
|
||
|
|
(find_fv `(l (x y) (+ x y z)))
|
||
|
|
|
||
|
|
|
||
|
|
(define (replace-fv env fv_list body)
|
||
|
|
(match body
|
||
|
|
['() body]
|
||
|
|
[(? list? _) (cons (replace-fv env fv_list (car body)) (replace-fv env fv_list (cdr body)))]
|
||
|
|
[(? (lambda (x) (memq x fv_list))) `(arr-ref ,env ,(index-of fv_list body))]
|
||
|
|
[_ body]
|
||
|
|
))
|
||
|
|
|
||
|
|
(define (clos-conv clos)
|
||
|
|
(match clos
|
||
|
|
[`(l ,args ,body) (let ((env (gensym 'env)) (fv_list (find_fv clos))) `((FUN ,(append args `(,env)) ,(replace-fv env fv_list body)) (DEF ,env (ARR ,fv_list))))]
|
||
|
|
[_ clos]
|
||
|
|
|
||
|
|
)
|
||
|
|
)
|
||
|
|
|
||
|
|
(clos-conv '(l (x y) (+ y z)))
|
||
|
|
(clos-conv '(def foo (l (y) (%+ y z))))
|
||
|
|
(clos-conv '((l (y x) (%+ x y z)) 3 5))
|