internalize-argument passing

ih · Apr 4, 2011 · 18162c9 · 18162c9
1 parent a8516c0
commit 18162c9
Show file tree

Hide file tree

Showing 2 changed files with 11 additions and 7 deletions.
diff --git a/scheme/internalize-arguments.scm b/scheme/internalize-arguments.scm
@@ -1,5 +1,5 @@
 (library (internalize-arguments)
-         (export internalize-arguments has-arguments? find-variable-instances thunkify make-mixture-sexpr remove-abstraction-variable remove-ith-argument remove-application-argument)
+         (export internalize-arguments has-arguments? find-variable-instances thunkify make-mixture-sexpr remove-abstraction-variable remove-ith-argument remove-application-argument internalize-argument)
          (import (except (rnrs) string-hash string-ci-hash)
                  (abstract)
                  (_srfi :1)

diff --git a/scheme/tests/internalize-arguments-tests.scm b/scheme/tests/internalize-arguments-tests.scm
@@ -26,12 +26,16 @@
 ;;;change-applications
 (let* ([new-abstraction (make-named-abstraction 'F1 '(let ([V1 ((uniform-draw (list (lambda () (F1 1)) (lambda () 1))))]) (node V1)) '())]
        [program (make-program (list new-abstraction) '(F1 (F1 1)))]
-       [old-abstraction (make-named-abstraction 'F1 '(node V1) '(V1))])
-  (check (remove-application-argument program old-abstraction 'V1) => (sexpr->program '(let () (define F1 (lambda () (let ([V1 ((uniform-draw (list (lambda () (F1)) (lambda () 1))))]) (node V1)))) (F1))))
-  ;; ;;;internalize-argument
-  ;; (let* ([program (sexpr->program '(let () (define F1 (lambda (V1) (node V1))) (F1 (F1 1))))]
-  ;;        [abstraction (make-named-abstraction 'F1 '(node V1) '(V1))])
-  ;;   (check (internalize-argument program abstraction 'V1) => (sexpr->program '(let () (define (F1) (let ([V1 ((uniform-draw (list (lambda () (F1)) (lambda () 1))))]) (list V1)) ) (F1)))))
+       [old-abstraction (make-named-abstraction 'F1 '(node V1) '(V1))]
+       [correct-abstraction (make-named-abstraction 'F1 '(let ([V1 ((uniform-draw (list (lambda () (F1)) (lambda () 1))))]) (node V1)) '())]
+       [correct-program (make-program (list correct-abstraction) '(F1))])
+  (check (remove-application-argument program old-abstraction 'V1) => correct-program)
+;;;internalize-argument
+  (let* ([program (sexpr->program '(let () (define F1 (lambda (V1) (node V1))) (F1 (F1 1))))]
+         [abstraction (make-named-abstraction 'F1 '(node V1) '(V1))]
+         [correct-abstraction (make-named-abstraction 'F1 '(let ([V1 ((uniform-draw (list (lambda () (F1)) (lambda () 1))))]) (node V1)) '())]
+         [correct-program (make-program (list correct-abstraction) '(F1))])
+    (check (internalize-argument program abstraction 'V1) => correct-program))
 
   ;; ;;;abstraction-internalizations
   ;; (let* ([program (sexpr->program '(let () (define F1 (lambda (V1) (node V1))) (F1 (F1 1))))]