Permalink
Branch: master
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
140 lines (121 sloc) 4.04 KB
(load "base.scm")
(load "pink.scm")
(load "test-check.scm")
(test "pink-code-1"
(evalms '() (trans `(code? 0 1) '()))
0
)
(test "pink-eval-code-1"
(evalms '((code? 0 1)) `((,pink-eval-exp1 (var 0)) nil-env))
0
)
(test "pink-code-lift-2"
(evalms '() (trans `(code? 0 (lift 2)) '()))
1
)
(test "pink-eval-code-lift-21"
(evalms '((code? 0 (lift 2))) `((,pink-eval-exp1 (var 0)) nil-env))
1
)
(test "pink-fac-4"
(evalms '() (trans `(,pink-fac 4) '()))
24
)
(test "pink-eval-fac-4"
(evalms (list pink-fac) `(((,pink-eval-exp1 (var 0)) nil-env) 4))
24
)
(test "pink-evalc-fac"
(reifyc (lambda () (evalms (list pink-fac) `((,pink-evalc-exp1 (var 0)) nil-env))))
base-fac-anf
)
(test "pink-eval-evalc-fac"
(reifyc (lambda () (evalms (list pink-fac pink-evalc-src) `((((,pink-eval-exp2 (var 1)) nil-env) (var 0)) nil-env))))
base-fac-anf
)
(test "pink-eval-eval-evalc-fac"
(reifyc (lambda () (evalms (list pink-fac pink-evalc-src pink-eval-src) `((((((,pink-eval-exp3 (var 2)) nil-env) (var 1)) nil-env) (var 0)) nil-env))))
base-fac-anf
)
;; slow but true
;; (test "pink-eval-eval-eval-evalc-fac"
;; (reifyc (lambda () (evalms (list pink-fac pink-evalc-src pink-eval-src) `((((((((,pink-eval-exp3 (var 2)) nil-env) (var 2)) nil-env) (var 1)) nil-env) (var 0)) nil-env))))
;; base-fac-anf
;; )
(test "pink-evalc-fac-4"
(let ((c (reifyc (lambda () (evalms (list pink-fac) `((,pink-evalc-exp1 (var 0)) nil-env))))))
(run (lambda () (evalms '() `(,c 4)))))
24
)
(test "pink-self-compilation"
(let ((c (reifyc (lambda () (evalms (list pink-eval-src) `((,pink-evalc-exp1 (var 0)) nil-env))))))
(run (lambda () (let ((v (evalms '() c)))
(evalms (list pink-fac v) '((((var 1) (var 0)) nil-env) 4))))))
24
)
(test "pink-trace-fac"
(evalms (list
'((delta-eval (lambda _ tie (lambda _ eval (lambda ev l (lambda _ exp (lambda _ env
(if (if (symbol? exp) (eq? 'n exp) 0) (log ((car l) 0) (((eval l) exp) env))
((((tie ev) l) exp) env)))))))
(lambda f n (if n (* n (f (- n 1))) 1))) 4))
`((,pink-eval-exp1 (var 0)) nil-env))
24
)
(test "pink-trace-fac-2"
(evalms (list
'(delta-eval (lambda _ tie (lambda _ eval (lambda ev l (lambda _ exp (lambda _ env
(if (if (symbol? exp) (eq? 'n exp) 0) (log ((car l) 0) (((eval l) exp) env))
((((tie ev) l) exp) env)))))))
(lambda f n (if n (* n (f (- n 1))) 1))))
`(((,pink-eval-exp1 (var 0)) nil-env) 4))
24
)
(test "pink-trace-fac-clambda"
(evalms (list
'(delta-eval (lambda _ tie (lambda _ eval (lambda ev l (lambda _ exp (lambda _ env
(if (if (symbol? exp) (eq? 'n exp) 0) (log ((car l) 0) (((eval l) exp) env))
((((tie ev) l) exp) env)))))))
(clambda f n (if n (* n (f (- n 1))) 1))))
`(((,pink-eval-exp1 (var 0)) nil-env) 4))
24
)
(test "pink-fac-clambda-code"
(let ((c (evalms (list
'(clambda f n (if n (* n (f (- n 1))) 1)))
`((,pink-eval-exp1 (var 0)) nil-env))))
(caddr c))
'(let (if [var 14]
[let (- (var 14) 1)
(let ([var 13] [var 15]) (let (* [var 14] [var 16]) (var 17)))]
1)
(var 15))
)
(test "pink-trace-fac-clambda-code"
(let ((c (evalms (list
'(delta-eval (lambda _ tie (lambda _ eval (lambda ev l (lambda _ exp (lambda _ env
(if (if (symbol? exp) (eq? 'n exp) 0) (log ((car l) 0) (((eval l) exp) env))
((((tie ev) l) exp) env)))))))
(clambda f n (if n (* n (f (- n 1))) 1))))
`((,pink-eval-exp1 (var 0)) nil-env))))
(caddr c))
'(let (log 0 [var 14])
(let (if
[var 15]
[let (log 0 (var 14))
(let (log 0 [var 14])
(let (- [var 17] 1)
(let ([var 13] [var 18]) (let (* [var 16] [var 19]) (var 20)))))]
1)
(var 16)))
)
(test "pink-unlift-oo"
(let ((c
(evalms (list `(clambda _ _
(let send (unlift (lambda _ o (unlift (lambda _ msg (o msg)))))
(let recv (unlift (lambda _ t t))
((send (recv (unlift (lambda _ msg (if (eq? msg 'hi) (lift 'hello) (lift 'error)))))) (unlift 'hi))))))
`((,pink-eval-exp1 (var 0)) nil-env))
)) (caddr c))
'hello
)