www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | LICENSE

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))