test-tiny.rkt (3199B)
1 #lang s-exp envlang/tiny 2 3 ; identity 4 #;(λ (x) x) 5 (⧵ env env args args) 6 #;(|\| #f env args args) 7 8 ; identity applied to identity 9 #;((λ (x) x) (λ (x) x)) 10 (@ (⧵ env env args args) env (⧵ env env args args)) 11 #;(|\| #f env args args) 12 13 ; false a.k.a second-of-two 14 #;(λ (if-true) (λ (if-false) if-false)) 15 (⧵ env env args (⧵ args env args args)) 16 #;(|\| #f env args (|\| args env args args)) 17 18 ; true a.k.a first-of-two 19 #;(λ (if-true) (λ (if-false) if-true)) 20 (⧵ env env args (⧵ args env args captured)) 21 #;(|\| #f env args (|\| args env args captured)) 22 23 ; (first-of-two first-of-two second-of-two) 24 (@ (@ (⧵ env env args (⧵ args env args captured)) 25 env 26 (⧵ env env args (⧵ args env args captured))) 27 env 28 (⧵ env env args (⧵ args env args args))) 29 #;(|\| #f env args (|\| args env args captured)) 30 31 ; (second-of-two first-of-two second-of-two) 32 (@ (@ (⧵ env env args (⧵ args env args args)) 33 env 34 (⧵ env env args (⧵ args env args captured))) 35 env 36 (⧵ env env args (⧵ args env args args))) 37 #;(|\| #f env args (|\| args env args args)) 38 39 ; pair 40 #;(λ (a) (λ (b) (λ (f) ((f a) b)))) 41 42 ; ↑ a a ↓ ↑ b a ↓ f ↑ f ↓ a ↓ 43 #;(⧵ env env args (⧵ args env args (⧵ captured env args (@ (@ args env captured) env BBBBBBBB)))) 44 45 ; ↑ a a ↓ ↑ b b ↓ f ↑ f ↓ b ↓ 46 #;(⧵ env env args (⧵ args env args (⧵ args env args (@ (@ args env AAAAAAAA) env captured)))) 47 48 #;(@ pair 49 (⧵ env env args (⧵ args env args captured)) 50 (⧵ env env args (⧵ args env args args))) 51 52 ;(@ (@ pair 53 ; (⧵ env env args (⧵ args env args captured)) 54 ; (⧵ env env args (⧵ args env args args))) 55 ; (⧵ env env args ) 56 57 ; nil 58 #;(λ (if-nil) (λ (if-cons) (if-nil 'dummy))) 59 (⧵ env env args (⧵ args env args (@ captured env (⧵ env env args args)))) 60 61 ; cons 62 #;(λ (a) (λ (b) (λ (if-cons) (λ (if-nil) (if-cons a b))))) 63 64 65 #;(|\| #f env args (|\| args env args captured)) 66 67 #;(@ (⧵ #hash() env args 68 (list (((λλ x (λλ x 1)) 1) 2) 69 (((λλ x (λλ x x)) 1) 2) 70 (((λλ x (λλ y y)) 1) 2) 71 (((λλ x (λλ y x)) 1) 2))) 72 (hash-set env "λλ" (⧵ #hash() env args 73 (⧵ (hash "arg-name" (symbol->string (@ inspect-promise-root env (car (@ force env args)))) 74 "body" (car (cdr (@ force env args))) 75 "saved-env" env) 76 env 77 args 78 (@ (hash-ref closure "body") 79 (hash-set (hash-ref closure "saved-env") 80 (hash-ref closure "arg-name") 81 (map (make-racket-proc (⧵ #hash() env args 82 (@ force env (car args))) 83 env) 84 (@ force env args))) 85 args)))) 86 (list))