Presentation ready for racketfest

.gitignore

@@ -1,2 +1,3 @@
 *~
-/compiled/
+compiled/
+/doc/

demo-rkt.hl.rkt

@@ -0,0 +1,150 @@
+#lang hyper-literate #:꩜ envlang/rkt
+
+꩜title[#:tag "demo-rkt"]{Tests and examples for ꩜racketmodname[envlang/rkt]}
+
+꩜section{Identity}
+
+꩜chunk[<λ-using-app>
+       (\\ #hash() env args
+           (\\ (hash-set
+                (hash-set
+                 (hash-set
+                  empty-hash
+                  "arg-name" (symbol->string (@ promise-e env (car (@ force env args)))))
+                 "body" (car (cdr (@ force env args))))
+                "saved-env" env)
+               env
+               args
+               (@ (hash-ref closure "body")
+                  (hash-set (hash-ref closure "saved-env")
+                            (hash-ref closure "arg-name")
+                            (map (envlang->racket (\\ #hash() env args
+                                                      (@ force env (car args)))
+                                                  env)
+                                 (@ force env args)))
+                  args)))]
+
+꩜chunk[<λ>
+       (\\ closure env args
+           (\\ (@ hash-set env
+                  (delay (list (delay (@ hash-set env
+                                         (delay (list (delay (@ hash-set env
+                                                                (delay (list (delay (@ hash-set env
+                                                                                       (delay (list (delay empty-hash)
+                                                                                                    (delay "arg-name")
+                                                                                                    (delay (@ symbol->string env
+                                                                                                              (delay (list (delay (@ promise-e env
+                                                                                                                                     (@ car env (delay (list (delay (@ force env args)))))))))))))))
+                                                                             (delay "body")
+                                                                             (delay (@ car env (delay (list (delay (@ cdr env (delay (list (delay (@ force env args))))))))))))))
+                                                      (delay "saved-env")
+                                                      (delay env)))))
+                               (delay "saved-closure")
+                               (delay closure))))
+               env
+               args
+               (@ (@ hash-ref env (delay (list (delay closure) (delay "body"))))
+                  (@ hash-set env (delay (list (delay (@ hash-ref env (delay (list (delay closure) (delay "saved-env")))))
+                                               (delay (@ hash-ref env (delay (list (delay closure) (delay "arg-name")))))
+                                               (delay (@ map env (delay (list (delay (@ envlang->racket env (delay (list (delay  (\\ #hash() env args
+                                                                                                                                     (@ force env (@ car env (delay (list (delay args)))))))
+                                                                                                                         (delay env)))))
+                                                                              (delay (@ force env args)))))))))
+                  args)))]
+
+꩜chunk[<λ-env>
+       (@ hash-set env (delay (list (delay env) (delay "λλ") (delay <λ>))))]
+
+꩜chunk[<λ-app-env>
+       (@ hash-set env (delay (list (delay <λ-env>) (delay "envlang#%app") (delay <app>))))]
+
+꩜chunk[<λ-example-low-level-app>
+       (@ (\\ #hash() env args
+              (@ list env (delay (list (delay (@ (@ (@ λλ env (delay (list (delay x) (delay (@ λλ env (delay (list (delay x) (delay 1)))))))) env (delay (list (delay 1)))) env (delay (list (delay 2)))))
+                                       (delay (@ (@ (@ λλ env (delay (list (delay x) (delay (@ λλ env (delay (list (delay x) (delay x)))))))) env (delay (list (delay 1)))) env (delay (list (delay 2)))))
+                                       (delay (@ (@ (@ λλ env (delay (list (delay x) (delay (@ λλ env (delay (list (delay y) (delay y)))))))) env (delay (list (delay 1)))) env (delay (list (delay 2)))))
+                                       (delay (@ (@ (@ λλ env (delay (list (delay x) (delay (@ λλ env (delay (list (delay y) (delay x)))))))) env (delay (list (delay 1)))) env (delay (list (delay 2)))))))))
+          <λ-env>
+          #f)]
+
+꩜chunk[<app>
+       (\\ closure env args
+           (@ (\\
+              closure env args
+               (@ (@ force env (@ car env (delay (list (delay args)))))
+                  env
+                  (delay (@ cdr env (delay (list (delay args)))))))
+              env
+              (@ force env args)))]
+
+꩜chunk[<λ-example>
+       (@ (\\ #hash() env args
+              (list (((λλ x (λλ x 1)) 1) 2)
+                    (((λλ x (λλ x x)) 1) 2)
+                    (((λλ x (λλ y y)) 1) 2)
+                    (((λλ x (λλ y x)) 1) 2)))
+          <λ-app-env>
+          #f)]
+
+(list (((λλ x (λλ x 1)) 1) 2)
+                    (((λλ x (λλ x x)) 1) 2)
+(((λλ x (λλ y y)) 1) 2)
+(((λλ x (λλ y x)) 1) 2))
+
+꩜chunk[<let>
+       (\\ closure env args
+           (@ (\\ (@ hash-set env
+                  (delay (list (delay (@ hash-set env
+                                         (delay (list (delay (@ hash-set env
+                                                                (delay (list (delay (@ hash-set env
+                                                                                       (delay (list (delay (@ hash-set env
+                                                                                                              (delay (list (delay empty-hash)
+                                                                                                                           (delay "arg-name")
+                                                                                                                           (delay (@ symbol->string env
+                                                                                                                                     (delay (list (delay (@ promise-e env
+                                                                                                                                                            (@ car env (delay (list (delay (@ force env args)))))))))))))))
+                                                                                                    (delay "value")
+                                                                                                    (delay (@ car env (delay (list (delay (@ cdr env (delay (list (delay (@ force env args))))))))))))))
+                                                                             (delay "body")
+                                                                             (delay (@ car env (delay (list (delay (@ cdr env (delay (list (delay (@ cdr env (delay (list (delay (@ force env args))))))))))))))))))
+                                                      (delay "saved-env")
+                                                      (delay env)))))
+                               (delay "saved-closure")
+                               (delay closure))))
+               env
+               args
+               (@ (@ hash-ref env (delay (list (delay closure) (delay "body"))))
+                  (@ hash-set env (delay (list (delay (@ hash-ref env (delay (list (delay closure) (delay "saved-env")))))
+                                               (delay (@ hash-ref env (delay (list (delay closure) (delay "arg-name")))))
+                                               (delay (@ car env (delay (list (delay (@ map env (delay (list (delay (@ envlang->racket env (delay (list (delay  (\\ #hash() env args
+                                                                                                                                     (@ force env (@ car env (delay (list (delay args)))))))
+                                                                                                                         (delay env)))))
+                                                                              (delay (@ force env args)))))))))))))
+                  args))
+              env
+              (delay (list (delay (@ force env (@ car env (delay (list (delay (@ cdr env (delay (list (delay (@ force env args)))))))))))))))]
+
+                  env
+                  (hash-ref closure "value"))
+
+꩜chunk[<let-env>
+       (@ hash-set env (delay (list (delay env) (delay "let") (delay <let>))))]
+
+꩜chunk[<program>
+       (let x 1
+         (let x (let x x x)
+           x))]
+
+꩜chunk[<program-with-basic-env>
+       (@ (\\ #hash() env args
+              (@ (\\ #hash() env args
+                     <program>)
+                 <let-env>
+                 #f))
+          <λ-app-env>
+          #f)]
+
+꩜chunk[<*>
+       (begin
+         #;<λ-example>
+         <program-with-basic-env>)]

demo2-rkt.hl.rkt

@@ -0,0 +1,244 @@
+#lang hyper-literate #:꩜ envlang/rkt
+
+꩜title[#:tag "racketfest"]{Envlang @ racketfest}
+
+꩜section{Use cases for macros}
+
+꩜subsection{Environment manipulation}
+
+Adding bindings to the environment, getting bindings from the environment:
+
+꩜chunk[<use-case-bindings>
+       (let (var val) body)             ;; env += {var = val}
+       (define-struct name (field ...)) ;; env += {"$name-$field" = accessor-fn} …
+       (aif condition if-true if-false) ;; env += {it = condition}
+       (match v [(cons a b) body])      ;; env += {a = (car v)} {b = (cdr v)}
+       ]
+
+꩜subsection{Control flow}
+
+Changing the order of execution:
+
+꩜chunk[<use-case-order>
+       (if condition if-true if-false)
+       ;; can be expressed as:
+       #;(force (if condition
+                    (λ () if-true)
+                    (λ () if-false)))
+
+       (match v ([null if-null] [(cons a b) if-cons]))
+       ;; can be expressed as:
+       #;(force (if (null? v)
+                    (λ () if-null)
+                    (λ () (let ([a (car v)] [b (cdr v)]) if-cons))))
+       
+       (for/list ([x (in-list l)]) body)
+       ;; can be expressed as
+       #;(map (λ (x) body) l)]
+
+꩜subsection{Syntactic sugar}
+
+꩜chunk[<use-case-syntactic-sugar>
+       (1 + 2 * 3) ;; infix
+       (let x = 3 in (+ x 1))
+       (for/list x in (list 1 2 3) (+ x 1))
+       (let x:int = 3 in (+ x 1))]
+
+꩜subsection{Optimisations}
+
+Optimisations are semantics-preserving compile-time transformations of the program.
+
+꩜chunk[<use-case-optimisations>
+       pre-calculated hash table
+       loop unrolling
+       …]
+
+꩜subsection{Code analysis}
+
+Tracking and propagating annotations on the code:
+
+꩜chunk[<use-case-annotations>
+       typed/racket
+       source locations
+       tooltips]
+
+꩜section{Overview of the semantics}
+
+꩜chunk[<promise>
+       (f arg ...)
+       ;; is sugar for:
+       (@ f env (⧵ (env) arg) ...)]
+
+꩜chunk[<variables>
+       x
+       ;; is sugar for:
+       (hash-ref env x)]
+
+꩜section{First-class solutions}
+
+Adding bindings to the environment, getting bindings from the environment:
+
+꩜subsection{Environment manipulation}
+
+User-defined let:
+
+꩜chunk[<my-let>
+       (⧵ outer-env (var val body)
+          ;; evaluate body in outer env + var=val
+          (force (hash-set outer-env
+                           ;; var name
+                           (promise->string var)
+                           ;; evaluate val in outer env
+                           (force outer-env val))
+                 body))]
+
+User-defined let with different order for the arguments:
+
+꩜chunk[<use-return+where>
+       (return (+ x 1)
+               where x = 123)]
+
+꩜chunk[<return+where>
+       (⧵ outer-env (body kw-where var kw-= val)
+          (assert (string=? (promise->string kw-where) "where"))
+          (assert (string=? (promise->string kw-=)     "="))
+          (@ my-let outer-env var val body))]
+
+꩜subsection{Control flow}
+
+꩜chunk[<my-if>
+       (⧵ outer-env (condition if-true if-false)
+          (force env ((force env condition) if-true if-false)))]
+
+꩜subsection{Syntactic sugar}
+
+꩜subsubsection{Identifiers with different meanings}
+
+Bindings in the environment point to a table associating
+meanings to values. See ꩜racketmodname[polysemy].
+
+꩜chunk[<variables>
+       x
+       ;; becomes sugar for:
+       (hash-ref (hash-ref env x) "variable")]
+
+꩜racket[in] keyword used in different contexts:
+
+꩜chunk[<let-in-usage>
+       (let x = 3 in (+ x 1))]
+
+꩜chunk[<let-in>
+       (⧵ outer-env (var kw-= val kw-in body)
+          (assert (equal? (hash-ref (hash-ref env (promise->string kw-=))
+                                    "let-in keyword")
+                          let-in-=))
+          (assert (equal? (hash-ref (hash-ref env (promise->string kw-in))
+                                    "let-in keyword")
+                          let-in-in))
+          (@ my-let outer-env var val body))]
+
+꩜chunk[<for-in-usage>
+       (for/list x in (list 1 2 3) (+ x 1))]
+
+꩜chunk[<for-in>
+       (⧵ outer-env (var kw-in lst body)
+          (assert (equal? (hash-ref (hash-ref env (promise->string kw-in))
+                                    "for keyword")
+                          for-in))
+          (@ map outer-env  var val body))]
+
+It's easy to rename just the ꩜racket["let-in keyword"] part
+without renaming the ꩜racket["for keyword"] part.
+
+꩜subsubsection{Extra parentheses}
+
+꩜chunk[<use-let-paren>
+       (let [x 2]
+         (+ x 1))]
+
+꩜chunk[<let-paren>
+       (⧵ outer-env (binding body)
+          (let varval (force (hash-set "#%app" cons) binding)
+            (@ my-let outer-env (car varval) (cadr varval) body)))]
+
+꩜subsubsection{Infix}
+
+꩜chunk[<example-infix>
+       (1 + 2 * 3)]
+
+Needs external support in the language (or overloading
+꩜racket[#%app]). WIP prototype using
+꩜link["http://www.cse.chalmers.se/~nad/publications/danielsson-norell-mixfix.pdf" "mixfix"]
+on ꩜link["https://repl.it/@envlang/env"]{repl.it} and
+꩜link["https://github.com/envlang/env"]{github}.
+
+꩜subsubsection{Manipulating identifiers}
+
+꩜chunk[<example-postfix-ids>
+       (let x:int = 3 in (+ x 1))]
+
+꩜chunk[<postfix-ids>
+       (⧵ outer-env (var kw-= val kw-in body)
+          (let ([forced-val (force outer-env val)])
+            (when (ends-with (promise->string var) ":int")
+              (assert int? forced-val))
+            (@ my-let outer-env var val body)))]
+
+꩜section{Compile-time transformations}
+
+Wrap parts to be evaluated at compile-time, the wrapper acts
+like ꩜racket[unquote] where the whole program is in a
+꩜racket[quasiquote].
+
+꩜chunk[<compile-time-proposal>
+       (run-time
+        (let ([x (compile-time (+ 1 2 3))])
+          (* x x)))]
+
+꩜chunk[<compile-time-proposal-equivalent>
+       `(let ([x ,(+ 1 2 3)])
+          (* x x))]
+
+Semantics-preserving: removing the ꩜racket[run-time] and
+꩜racket[compile-time] markers must give an equivalent
+program.
+
+꩜section{Code analysis}
+
+꩜subsection{Type checking}
+
+These environment manipulations can be modeled with row types:
+
+꩜chunk[<row-type-example>
+       (λ (x : (struct [foo : int] [bar : string] . ρ))
+         : (struct [foo : int] [quux : int] . ρ)
+         (x without .bar
+            with .quux = (+ x.foo (string->int x.bar))))]
+
+
+꩜subsection{Implemented within the language}
+
+… to be explored?
+
+꩜section{Example use}
+
+꩜chunk[<program>
+       (my-let x 3
+         (let-paren [x 3]
+           (let-postfix x:int = 3 in
+             (return (for/list z in (compile-time (list 1 2 3))
+                       (+ z y))
+                     where y = (+ 1 x)))))]
+
+
+꩜chunk[<env+program>
+       (let* ([my-let <my-let>]
+              [return <return+where>]
+              [my-if <my-if>]
+              [let-paren <let-paren>]
+              [let-postfix <postfix-ids>]
+              )
+         <program>)]
+
+꩜chunk[<*>
+       #;<env+program>]

envlang-rkt-for-test.rkt

@@ -9,7 +9,9 @@
  (rename-out [check-for-test check])
  (filtered-out
   (λ (name) (substring name 1))
-  (combine-out -#%datum -#%top -#%app -#%module-begin -#%top-interaction -env -.. -@ -\\ -ffi -require/ffi -delay -force -inspect-promise-root -closure)))
+  (combine-out -#%datum -#%top -#%app -#%module-begin -#%top-interaction -env -.. -@ -\\ -ffi #;-require/ffi -list -delay -force -closure -begin)))
+
+(define-syntax-rule (-begin . rest) (begin . rest))
 
 ;; Printable procedure
 (struct pproc (proc repr)
@@ -17,12 +19,25 @@
   #:methods gen:custom-write
   [(define write-proc (λ (v port mode)
                         (match mode
-                          [#t (write (pproc-repr v) port)]
+                          [#t (display "#;pproc:" port) (write (pproc-repr v) port)]
-                          [#f (display (pproc-repr v) port)]
+                          [#f (display "#;pproc:" port) (display (pproc-repr v) port)]
-                          [_ (print (pproc-repr v) port 1)])))])
+                          [_  (display "#;pproc:" port) (print (pproc-repr v) port 1)])))])
 
 (define-for-syntax (ds stx symbol) (datum->syntax stx symbol stx stx))
-;(define-syntax-rule (quasisyntax/top-loc loc stx) #`stx)
+(define-syntax-rule (quasisyntax/top-loc loc stx) #`stx)
+
+(define -promise-e
+  (pproc (λ (.env x) (match (pproc-repr x) [`(\\ ,cl env arg ,body) body]))
+         'promise-e))
+
+(define -envlang->racket
+  (pproc (λ (.env args)
+           (parameterize ([envparam .env]) 
+             (let* ([forced-args (map (curry -force (envparam)) (-force (envparam) args))]
+                    [f (car forced-args)]
+                    [captured-env (cadr forced-args)])
+               (λ args (f captured-env args)))))
+         'envlang->racket))
 
 (define/contract (env-guard new-env)
   (-> hash? hash?)
@@ -38,8 +53,8 @@
           ["λ"       . ,(pproc (λ (.env args) (parameterize ([envparam .env])
                                                 (match (-force (envparam) args)
                                                   [(list arg-name-thunk body-thunk)
-                                                   (define arg-name (-inspect-promise-root (envparam) arg-name-thunk))
+                                                   (define arg-name (-promise-e (envparam) arg-name-thunk))
-                                                   (define body     (-inspect-promise-root (envparam) body-thunk))
+                                                   (define body     (-promise-e (envparam) body-thunk))
                                                    (let ([saved-env (envparam)])
                                                      (pproc (λ (.env args)
                                                               (parameterize ([envparam saved-env])
@@ -54,7 +69,16 @@
                                    (displayln (list (envparam) arg))
                                    (displayln (-force (envparam) arg))
                                    '()))
-                               'debug)])
+                               'debug)]
+          ["symbol->string" . ,(-ffi racket symbol->string)]
+          ["envlang->racket" . ,-envlang->racket]
+          ["hash-set" . ,(-ffi racket hash-set)]
+          ["hash-ref" . ,(-ffi racket hash-ref)]
+          ["car" . ,(-ffi racket car)]
+          ["cdr" . ,(-ffi racket cdr)]
+          ["map" . ,(-ffi racket map)]
+          ["empty-hash" . #hash()]
+          ["promise-e" . ,-promise-e])
    env-guard))
 
 (define-syntax-rule (-delay x)
@@ -64,7 +88,6 @@
          `(\\ #hash() env arg x)))
 
 (define (-force .env x) (parameterize ([envparam .env]) (x (envparam) '())))
-(define (-inspect-promise-root .env x) (match (pproc-repr x) [`(\\ ,cl env arg ,body) body]))
 (define-syntax (-env stx) (syntax-case stx () [-env (identifier? #'-env) #'(envparam)]))
 (define-syntax (-closure stx) (syntax-case stx () [-closure (identifier? #'-closure) #'(closureparam)]))
 
@@ -86,14 +109,29 @@
                               ...)))
 (define -.. hash-ref)
 
+(define-syntax (-list stx)
+  (syntax-case stx ()
+    [(-list . args) #'(#%app list . args)]
+    [-list (identifier? #'-list) #'(pproc (λ (.env args)
+                                            (parameterize ([envparam .env]) 
+                                              (apply (let () (local-require (only-in racket list)) list)
+                                                     (map (curry -force (envparam)) (-force (envparam) args)))))
+                                          '(ffi racket list f))]))
+
 (define-syntax (-#%top stx)
   (syntax-parse stx
     [(-#%top . var) (quasisyntax/top-loc stx (#%app -.. (#%app envparam) #,(symbol->string (syntax-e #'var))))]))
 
+(define (debug)
+  (displayln "lalal")
+  (displayln (closureparam))
+  (displayln (envparam))
+  (displayln ""))
+
 (define-syntax (-#%app stx)
   (syntax-parse stx
     [(-#%app {~and @ {~datum @}} f env-expr args) (quasisyntax/top-loc stx (#%app -@ f env-expr args))]
-    [(-#%app f arg ...) (quasisyntax/top-loc stx (-#%app @ f (#%app envparam) (-delay (list (-delay arg) ...))))]))
+    [(-#%app f arg ...) (quasisyntax/top-loc stx (-#%app @ (#%app -.. (#%app envparam) #,(symbol->string (syntax-e #'envlang#%app))) (#%app envparam) (-delay (-list (-delay f) (-delay arg) ...))))]))
 
 (define-syntax/parse (-#%datum . d) (quasisyntax/top-loc stx (#%app -@ (-#%top . #%datum) (#%app envparam) (-delay (#%datum d)))))
 (define-syntax-rule (-#%module-begin . body) (#%module-begin . body))

info.rkt

@@ -1,7 +1,11 @@
 #lang info
 (define collection "envlang")
-(define deps '("phc-toolkit"))
+(define deps '("base"
-(define build-deps '("reprovide-lang-lib"))
+               "rackunit-lib"
+               "phc-toolkit"))
+(define build-deps '("base"
+                     "reprovide-lang-lib"
+                     "polysemy"))
 (define scribblings '(("scribblings/envlang.scrbl" (multi-page))))
 (define pkg-desc "A language with first-class-environments")
 (define version "0.1")

scribblings/envlang.scrbl

@@ -0,0 +1,27 @@
+#lang scribble/manual
+
+@title{envlang: an experimental language with first-class environments}
+
+@author[@author+email["Suzanne Soy" "racket@suzanne.soy"]]
+
+@defmodule[envlang/rkt]
+
+An implementation which "escapes" to the Racket library for a certain number of basic building blocks
+
+@racket[@#,hash-lang[] @#,racketmodname[s-exp] @#,racketmodname[envlang/rkt]]
+
+See @racketmodname[test-rkt] for examples
+
+@defmodule[envlang/tiny]
+
+An implementation which starts with a tiny set of
+primitives, and builds the basic building blocks using
+those. The building blocks (lists, strings, associative
+tables) are built in a naive and inefficient way.
+
+@racket[@#,hash-lang[] @#,racketmodname[s-exp] @#,racketmodname[envlang/tiny]]
+
+@(table-of-contents)
+@include-section[(submod "../test-tiny.hl.rkt" doc)]
+@include-section[(submod "../demo-rkt.hl.rkt" doc)]
+@include-section[(submod "../demo2-rkt.hl.rkt" doc)]

test-rkt.rkt

@@ -127,7 +127,8 @@
    (list))
 
 (@ (\\ #hash() env args
-       (list (((λλ x (λλ x 1)) 1) 2)
+       ((λλ x 1) 1)
+       #;(list (((λλ x (λλ x 1)) 1) 2)
              (((λλ x (λλ x x)) 1) 2)
              (((λλ x (λλ y y)) 1) 2)
              (((λλ x (λλ y x)) 1) 2)))
@@ -137,7 +138,7 @@
                                     "saved-env" env)
                               env
                               args
-                              (@ (hash-ref closure "body")
+                              (hash-ref closure "body") #;(@ (hash-ref closure "body")
                                  (hash-set (hash-ref closure "saved-env")
                                            (hash-ref closure "arg-name")
                                            (map (make-racket-proc (\\ #hash() env args

test-tiny.hl.rkt

@@ -0,0 +1,563 @@
+#lang hyper-literate #:꩜ envlang/tiny
+
+꩜title[#:tag "test-tiny"]{Tests and examples for ꩜racketmodname[envlang/tiny]}
+
+꩜section{Identity}
+
+꩜chunk[<id-λ>
+       (λ (x) x)]
+꩜chunk[<id>
+       (⧵ env env args args)]
+꩜chunk[<id-result>
+       (⧵ #f env args args)]
+
+꩜section{Dummy value}
+
+꩜chunk[<dummy-λ>
+       <id-λ>]
+
+꩜chunk[<dummy>
+       <id>]
+
+꩜section{Example: identity applied to identity}
+
+꩜chunk[<id-id-λ>
+       (<id-λ> <id-λ>)]
+꩜chunk[<id-id>
+       (@ <id> env <id>)]
+꩜chunk[<id-id-result>
+       <id-result>]
+
+꩜section{False}
+
+a.k.a second-of-two
+
+꩜chunk[<false-λ>
+       (λ (if-true) (λ (if-false) if-false))]
+꩜chunk[<false>
+       (⧵ env env args (⧵ args env args args))]
+꩜chunk[<false-result>
+       (⧵ #f env args (⧵ args env args args))]
+
+꩜section{True}
+
+a.k.a first-of-two
+
+꩜chunk[<true-λ>
+       (λ (if-true) (λ (if-false) if-true))]
+꩜chunk[<true>
+       (⧵ env env args (⧵ args env args captured))]
+꩜chunk[<true-result>
+       (⧵ #f env args (⧵ args env args captured))]
+
+꩜subsection{Boolean usage example: if true}
+
+꩜chunk[<if-true-example-λ>
+       ((<true-λ> <true-λ>) <false-λ>)]
+꩜chunk[<if-true-example>
+       (@ (@ <true> env <true>) env <false>)]
+꩜chunk[<if-false-example-result>
+       <true-result>]
+
+꩜subsection{Boolean usage example: if false}
+
+꩜chunk[<if-false-example-λ>
+       ((<false-λ> <true-λ>) <false-λ>)]
+꩜chunk[<if-false-example>
+       (@ (@ <false> env <true>) env <false>)]
+꩜chunk[<if-false-example-result>
+       <false-result>]
+
+꩜; TODO: take my own red pill / blue pill picture
+꩜image{/tmp/Two-Buttons.jpg}
+
+꩜section{Pairs}
+
+꩜chunk[<pair-λ>
+       (λ (a) (λ (b) (λ (f) ((f a) b))))]
+꩜chunk[<pair-failed-attempt-1>
+       ;           ↑ a      a ↓      ↑ b        a ↓         f ↑       f ↓        a ↓
+       (⧵ env env args (⧵ args env args (⧵ captured env args (@ (@ args env captured) env BBBBBBBB))))]
+꩜chunk[<pair-failed-attempt-2>
+       ;           ↑ a      a ↓      ↑ b        b ↓         f ↑       f ↓                       b ↓
+       (⧵ env env args (⧵ args env args (⧵   args   env args (@ (@ args env AAAAAAAA) env captured))))]
+
+Can't be done because our capture can only close over a single value. We use a primitive:
+
+꩜chunk[<pair>
+       ×]
+
+꩜chunk[<pair-result>
+       ×]
+
+꩜chunk[<pair-example>
+       (@ × <true> <false>)]
+
+꩜chunk[<pair-example-result>
+       (⧵ #f env args (@ (@ args env <true-result>) env <false-result>))]
+
+꩜subsection{Fst}
+
+꩜chunk[<fst-λ>
+       (λ (p) (p <true-λ>))]
+
+꩜chunk[<fst>
+       (⧵ captured env args (@ args env <true>))]
+
+꩜subsection{Snd}
+
+꩜chunk[<snd-λ>
+       (λ (p) (p <false-λ>))]
+
+꩜chunk[<snd>
+       (⧵ captured env args (@ args env <false>))]
+
+꩜section{Either}
+
+꩜subsection{Left}
+
+꩜chunk[<left-λ>
+       (λ (v) (λ (if-left) (λ (if-right) (if-left v))))]
+꩜chunk[<left>
+       ;          ↑ v     v ↓     ↑ if-left         ↓ if-left    ↓ v        ↑ if-right    ↓ if-left × v
+       (⧵ env env args (⧵ args env args (⧵ (@ <pair> args      captured) env args       (@ captured      env <appfv>))))]
+꩜chunk[<appfv>
+       ;          ↑ f     f ↓      ↑ v       ↓ f       ↓ v
+       (⧵ env env args (⧵ args env args (@ captured env args)))]
+꩜chunk[<left-result>
+       (⧵ #f env args (⧵ args env args (⧵ (@ × args captured) env args (@ captured env (⧵ env env args (⧵ args env args (@ captured env args)))))))]
+
+꩜subsection{Right}
+
+꩜chunk[<right-λ>
+       (λ (v) (λ (if-left) (λ (if-right) (if-right v))))]
+꩜chunk[<right>
+       ;          ↑ v     ↓v↑    if-left    ↓ v ↑       ↑ if-right    ↓ if-right     ↓ v
+       (⧵ env env args (⧵ args env args (⧵ captured env args       (@ args       env captured))))]
+꩜chunk[<right-result>
+       (⧵ #f env args (⧵ args env args (⧵ captured env args (@ args env captured))))]
+
+꩜section{If}
+
+꩜chunk[<if-λ-long>
+       (λ (c) (λ (if-true) (λ (if-false) ((c if-true) if-false))))]
+
+When passed a boolean as the first argument (as should be the case), it is equivalent to:
+
+꩜chunk[<if-λ>
+       (λ (c) c)]
+
+꩜chunk[<if>
+       <id>]
+
+꩜chunk[<if-result>
+       <id-result>]
+
+꩜subsection{Match "either"}
+
+꩜chunk[<match-either-λ-long>
+       (λ (either) (λ (if-left) (λ (if-right) ((either if-true) if-false))))]
+
+When passed a constructor of the "either" variant as the first argument (as should be the case), it is equivalent to:
+
+꩜chunk[<match-either-λ>
+       <id-λ>]
+
+꩜chunk[<match-either>
+       <id>]
+
+꩜chunk[<match-either-result>
+       <id-result>]
+
+꩜chunk[<match-left-example-λ>
+       (((<match-either-λ> (<left-λ> <id-λ>)) <id-λ>) (λ (v) <false-λ>))]
+꩜chunk[<match-left-example>
+       (@ (@ (@ <match-either> env (@ <left> env <id>)) env <id>) env (⧵ captured env args <false>))]
+꩜chunk[<match-left-example-result>
+       <id-result>]
+
+꩜chunk[<match-right-example-λ>
+       (((<match-either-λ (<right-λ> <id-λ>)) (λ (v) <false-λ>)) <id-λ>)]
+꩜chunk[<match-right-example>
+       (@ (@ (@ <match-either> env (@ <right> env <id>)) env (⧵ captured env args <false>)) env <id>)]
+꩜chunk[<match-right-example-result>
+       <id-result>]
+
+꩜section{Null}
+
+꩜chunk[<null-λ>
+       (<left-λ> <dummy-λ>)]
+꩜chunk[<null>
+       (@ <left> env <dummy>)]
+꩜chunk[<null-result>
+       (⧵ (⧵ #f env args args) env args (⧵ (@ × args captured) env args (@ captured env (⧵ env env args (⧵ args env args (@ captured env args))))))]
+
+꩜section{Cons}
+
+꩜chunk[<cons-λ>
+       (λ (a) (λ (b) (<right-λ> (<pair-λ> a b))))]
+꩜chunk[<cons>
+       (⧵ captured env args (⧵ args env args (@ <right> env (@ <pair> captured args))))]
+꩜chunk[<cons-result>
+       (⧵ #f env args (⧵ args env args (@ (⧵ env env args (⧵ args env args (⧵ captured env args (@ args env captured)))) env (@ × captured args))))]
+
+꩜subsection{Match "list"}
+
+꩜chunk[<match-null-cons-λ>
+       <match-either-λ>]
+
+꩜chunk[<match-null-cons>
+       <match-either>]
+
+꩜section{null?}
+
+꩜chunk[<null?-λ>
+       (λ (l) (((<match-null-cons-λ> l) (λ (v) <true>)) (λ (v) <false-λ>)))]
+
+꩜chunk[<null?>
+       (⧵ captured env args (@ (@ (@ <match-null-cons> env args) env (⧵ captured env args <true>)) env (⧵ captured env args <false>)))]
+
+꩜section{Car}
+
+Since we don't have an error reporting mechanism, we make (car null) = null and (cdr null) = null
+
+꩜chunk[<car-λ>
+       (λ (l) (((<match-null-cons-λ> l) <null-λ>) <fst-λ>))]
+
+꩜chunk[<car>
+       (⧵ captured env args (@ (@ (@ <match-null-cons> env args) env (⧵ captured env args <null>)) env <fst>))]
+
+꩜chunk[<car-example>
+       (@ <car> env (@ (@ <cons> env <true>) env <null>))]
+
+꩜chunk[<car-example-result>
+       <true-result>]
+
+꩜chunk[<car-example2>
+       (@ <car> env (@ (@ <cons> env <false>) env <null>))]
+
+꩜chunk[<car-example2-result>
+       <false-result>]
+
+꩜chunk[<car-example3>
+       (@ <car> env <null>)]
+
+꩜chunk[<car-example3-result>
+       <null-result>]
+
+꩜section{Cdr}
+
+Since we don't have an error reporting mechanism, we make (car null) = null and (cdr null) = null
+
+꩜chunk[<cdr-λ>
+       (λ (l) (((<match-null-cons-λ> l) <null-λ>) <snd-λ>))]
+
+꩜chunk[<cdr>
+       (⧵ captured env args (@ (@ (@ <match-null-cons> env args) env (⧵ captured env args <null>)) env <snd>))]
+
+꩜chunk[<cdr-example>
+       (@ <cdr> env (@ (@ <cons> env <true>) env <null>))]
+
+꩜chunk[<cdr-example-result>
+       <true-result>]
+
+꩜chunk[<cdr-example2>
+       (@ <cdr> env (@ (@ <cons> env <true>) env (@ (@ <cons> env <false>) env <null>)))]
+
+꩜chunk[<cdr-example2-result>
+       <cdr-example2-list-false-result>]
+
+꩜chunk[<cdr-example2-list-false>
+       (@ (@ <cons> env <false>) env <null>)]
+
+꩜chunk[<cdr-example2-list-false-result>
+       (⧵ (⧵ #f env args (@ (@ args env <false-result>) env <null-result>))
+          env
+          args
+          (⧵ captured env args (@ args env captured)))]
+
+꩜chunk[<cdr-example3>
+       (@ <car> env (@ <cdr> env (@ (@ <cons> env <true>) env (@ (@ <cons> env <false>) env <null>))))]
+
+꩜chunk[<car-example3-result>
+       <false-result>]
+
+꩜section{Zero}
+
+꩜chunk[<zero-λ>
+       <null-λ>]
+
+꩜chunk[<zero>
+       <null>]
+
+꩜section{Not}
+
+꩜chunk[<not-λ>
+       (λ (a) (((<if-λ> a) <false>) <true>))]
+
+꩜chunk[<not>
+       (⧵ captured env args (@ (@ (@ <if> env args) env <false>) env <true>))]
+
+꩜section{And}
+
+꩜chunk[<and-λ>
+       (λ (a) (λ (b) (((<if-λ> a) b) <false-λ>)))]
+
+꩜chunk[<and>
+       ;                a       a       b                         a           b
+       (⧵ captured env args (⧵ args env args (@ (@ (@ <if> env captured) env args) env <false>)))]
+
+꩜chunk[<and-example-ff>
+       (@ (@ <and> env <false>) env <false>)]
+
+꩜chunk[<and-example-ft>
+       (@ (@ <and> env <false>) env <true>)]
+
+꩜chunk[<and-example-tf>
+       (@ (@ <and> env <true>) env <false>)]
+
+꩜chunk[<and-example-tt>
+       (@ (@ <and> env <true>) env <true>)]
+
+꩜section{Or}
+
+꩜chunk[<or-λ>
+       (λ (a) (λ (b) (((<if-λ> a) <true>) b)))]
+
+꩜chunk[<or>
+       ;                a       a       b                         a                      b
+       (⧵ captured env args (⧵ args env args (@ (@ (@ <if> env captured) env <true>) env args)))]
+
+꩜chunk[<or-example-ff>
+       (@ (@ <or> env <false>) env <false>)]
+
+꩜chunk[<or-example-ft>
+       (@ (@ <or> env <false>) env <true>)]
+
+꩜chunk[<or-example-tf>
+       (@ (@ <or> env <true>) env <false>)]
+
+꩜chunk[<or-example-tt>
+       (@ (@ <or> env <true>) env <true>)]
+
+꩜section{Equal bools}
+
+꩜chunk[<eqbool-λ>
+       (λ (a) (λ (b) (((<if-λ> a) b) (<not-λ> b))))]
+
+꩜chunk[<eqbool>
+       (⧵ captured env args (⧵ args env args (@ (@ (@ <if> env captured) env args) env (@ <not> env args))))]
+
+꩜chunk[<eqbool-example-ff>
+       (@ (@ <eqbool> env <false>) env <false>)]
+
+꩜chunk[<eqbool-example-ft>
+       (@ (@ <eqbool> env <false>) env <true>)]
+
+꩜chunk[<eqbool-example-tf>
+       (@ (@ <eqbool> env <true>) env <false>)]
+
+꩜chunk[<eqbool-example-tt>
+       (@ (@ <eqbool> env <true>) env <true>)]
+
+꩜section{Z combinator}
+
+꩜chunk[<Z-λ>
+       (λ (f) (<half-Z-λ> <half-Z-λ>))]
+
+꩜chunk[<half-Z-λ>
+       (λ (x) (f (λ (v) ((x x) v))))]
+
+꩜chunk[<Z>
+       ;               ↑ f
+       (⧵ captured env args (@ <half-Z> env <half-Z>))]
+
+꩜chunk[<half-Z>
+       ;  ↓f↑      ↑ x       ↓ f           ↓x↑      ↑v           ↓ x          ↓ x         ↓ v
+       (⧵ args env args (@ captured env (⧵ args env args (@ (@ captured env captured) env args))))]
+
+꩜section{Equality of lists}
+
+꩜chunk[<eqlist-λ>
+       (λ (recur)
+         (λ (cmp)
+           (λ (a)
+             (λ (b)
+               ((<if-λ> ((<or-λ> (<null?-λ> a)) (<null?-λ> b))
+                        (λ (_) ((<and-λ> (<null?-λ> a)) (<null?-λ> b)))
+                        (λ (_) ((<if-λ> ((cmp (<car-λ> a)) (<car-λ> b))
+                                        (λ (_) (((recur cmp) (<cdr-λ> a)) (<cdr-λ> b)))
+                                        (λ (_) <false-λ>))
+                                <dummy-λ>)))
+                <dummy-λ>)))))]
+
+꩜chunk[<eqlist-noZ>
+       ;   recur
+       (⧵ captured env args
+          ;  recur    cmp
+          (⧵ args env args
+             ;            recur    cmp       a
+             (⧵ (@ <pair> captured args) env args
+                ;            recur+cmp  a        b
+                (⧵ (@ <pair> captured args) env args
+                   ;                                                  a                                           b
+                   (@ (@ (@ (@ <if> env (@ (@ <or> env (@ <null?> env (@ <snd> env captured))) env (@ <null?> env args)))
+                            ;                                                               a                                           b
+                            env         (⧵ captured env args (@ (@ <and> env (@ <null?> env (@ <snd> env captured))) env (@ <null?> env args))))
+                         ;                                                                cmp                                                   a
+                         env            (⧵ captured env args (@ (@ (@ (@ <if> env (@ (@ (@ <snd> env (@ <fst> env captured)) env (@ <car> env (@ <snd> env captured)))
+                                                                                     ;                                                        b
+                                                                                     env                                         (@ <car> env args)))
+                                                                      env         (⧵ captured env args
+                                                                                     ;        recur
+                                                                                     (@ (@ (@ (@ <fst> env (@ <fst> env captured))
+                                                                                              ;                      cmp
+                                                                                              env                    (@ <snd> env (@ <fst> env captured)))
+                                                                                           ;                         a
+                                                                                           env          (@ <cdr> env (@ <snd> env captured)))
+                                                                                        ;                            b
+                                                                                        env             (@ <cdr> env args))))
+                                                                   env            (⧵ captured env args
+                                                                                     <false>))
+                                                                env
+                                                                args)))
+                      env
+                      args)))))]
+
+꩜chunk[<eqlist>
+       (@ <Z> env <eqlist-noZ>)]
+
+꩜chunk[<eqlist-bool>
+       (@ <eqlist> env <eqbool>)]
+
+꩜chunk[<eqlist-list-bool>
+       (@ <eqlist> env (@ <eqlist> env <eqbool>))]
+
+꩜chunk[<eqlist-examples>
+       ;; These return true
+       (@ (@ <eqlist-bool> env <null>) env <null>)
+       (@ (@ <eqlist-bool> env (@ (@ <cons> env <true>) env <null>)) env (@ (@ <cons> env <true>) env <null>))
+       (@ (@ <eqlist-bool> env (@ (@ <cons> env <false>) env <null>)) env (@ (@ <cons> env <false>) env <null>))
+       (@ (@ <eqlist-bool> env (@ (@ <cons> env <false>) env (@ (@ <cons> env <true>) env <null>))) env (@ (@ <cons> env <false>) env (@ (@ <cons> env <true>) env <null>)))
+       ;; These return false
+       (@ (@ <eqlist-bool> env <null>) env (@ (@ <cons> env <true>) env <null>))
+       (@ (@ <eqlist-bool> env (@ (@ <cons> env <true>) env <null>)) env <null>)
+       (@ (@ <eqlist-bool> env (@ (@ <cons> env <true>) env (@ (@ <cons> env <true>) env <null>))) env <null>)
+       (@ (@ <eqlist-bool> env <null>) env (@ (@ <cons> env <true>) env (@ (@ <cons> env <true>) env <null>)))
+       (@ (@ <eqlist-bool> env (@ (@ <cons> env <true>) env <null>)) env (@ (@ <cons> env <false>) env <null>))
+       (@ (@ <eqlist-bool> env (@ (@ <cons> env <false>) env (@ (@ <cons> env <true>) env <null>))) env (@ (@ <cons> env <false>) env (@ (@ <cons> env <false>) env <null>)))
+       ]
+
+꩜section{Associative lists}
+
+꩜chunk[<assoc-λ>
+       (λ (recur)
+         (λ (k)
+           (λ (l)
+             ((if (<null?-λ> l)
+                  (λ (_) <false-λ>)
+                  ((<if-λ> (<eqlist-list-bool-λ> (<fst-λ> (<car-λ> l)) k)
+                           (λ (_) (<snd-λ> (<car-λ> l)))
+                           (λ (_) (recur k (<cdr-λ> l))))
+                   <dummy-λ>))
+              <dummy-λ>))))]
+
+꩜chunk[<assoc-noZ>
+       ;               ↑recur
+       (⧵ captured env args
+          ;  ↓recur↑     ↓k↑
+          (⧵ args    env args
+             ;            ↓recur   ↓k        ↓l
+             (⧵ (@ <pair> captured args) env args
+                (@ ;                                ↓l
+                 (@ (@ (@ <if> env (@ <null?> env args))
+                       env         (⧵ captured env args <false>))
+                    env            (⧵ captured env args
+                                      ;                                                                                             ↓l          ↓k
+                                      (@ (@ (@ (@ <if> env (@ (@ <eqlist-list-bool> env (@ <car> env (@ <car> env args))) env (@ <snd> env captured)))
+                                               ;                                                         ↓l
+                                               env         (⧵ captured env args(@ <cdr> env (@ <car> env args))))
+                                            ;                                        ↓recur                     ↓k                                       ↓l
+                                            env            (⧵ captured env args(@ (@ (@ <fst> env captured) env (@ <snd> env captured)) env (@ <cdr> env args))))
+                                         env args)))
+                 env args))))]
+꩜chunk[<assoc>
+       (@ <Z> env <assoc-noZ>)]
+
+꩜chunk[<assoc-example-letter-a>
+       (@ (@ <cons-bits> env <bit-1>) env (@ (@ <cons-bits> env <bit-1>) env <null-bits>))]
+꩜chunk[<assoc-example-letter-b>
+       (@ (@ <cons-bits> env <bit-1>) env (@ (@ <cons-bits> env <bit-0>) env <null-bits>))]
+꩜chunk[<assoc-example-k>
+       (@ (@ <cons-bytes> env <assoc-example-letter-a>) env (@ (@ <cons-bytes> env <assoc-example-letter-b>) env <null-bytes>))]
+꩜chunk[<assoc-example-other-k>
+       (@ (@ <cons-bytes> env <assoc-example-letter-a>) env (@ (@ <cons-bytes> env <assoc-example-letter-a>) env <null-bytes>))]
+꩜chunk[<assoc-example-kv>
+       (@ (@ <cons-k-v> env <assoc-example-other-k>) env <false>)]
+꩜chunk[<assoc-example-other-kv>
+       (@ (@ <cons-k-v> env <assoc-example-k>) env <true>)]
+꩜chunk[<assoc-example-env>
+       (@ (@ <env-push> env <assoc-example-other-kv>)
+          env (@ (@ <env-push> env <assoc-example-kv>)
+                 env <env-null>))]
+꩜chunk[<assoc-example>
+       (@ (@ <env-ref> env <assoc-example-k>)
+          env
+          <assoc-example-env>)]
+
+꩜section{environment-manipulation functions}
+
+꩜chunk[<bit-0>
+       <false>]
+꩜chunk[<bit-1>
+       <true>]
+
+꩜chunk[<null-bits>
+       <null>]
+꩜chunk[<cons-bits>
+       <cons>]
+
+꩜chunk[<null-bytes>
+       <null>]
+꩜chunk[<cons-bytes>
+       <cons>]
+
+꩜chunk[<cons-k-v>
+       <cons>]
+
+꩜chunk[<env-null>
+       <null>]
+꩜chunk[<env-push>
+       <cons>]
+꩜chunk[<env-ref>
+       <assoc>]
+
+꩜section{todo}
+
+꩜chunk[<TODO>
+       (@ (⧵ #hash() env args
+             (list (((λλ x (λλ x 1)) 1) 2)
+                   (((λλ x (λλ x x)) 1) 2)
+                   (((λλ x (λλ y y)) 1) 2)
+                   (((λλ x (λλ y x)) 1) 2)))
+          (hash-set env "λλ" <todo-lam-impl>)
+          (list))]
+
+꩜chunk[<todo-lam-impl>
+       (⧵ #hash() env args
+          (⧵ (hash "arg-name" (symbol->string (@ inspect-promise-root env (car (@ force env args))))
+                   "body" (car (cdr (@ force env args)))
+                   "saved-env" env)
+             env
+             args
+             (@ (hash-ref closure "body")
+                (hash-set (hash-ref closure "saved-env")
+                          (hash-ref closure "arg-name")
+                          (map (make-racket-proc (⧵ #hash() env args
+                                                    (@ force env (car args)))
+                                                 env)
+                               (@ force env args)))
+                args)))]
+
+꩜chunk[<*>
+       <assoc-example>]

test-tiny.rkt

@@ -0,0 +1,86 @@
+#lang s-exp envlang/tiny
+
+; identity
+#;(λ (x) x)
+(⧵ env env args args)
+#;(|\| #f env args args)
+
+; identity applied to identity
+#;((λ (x) x) (λ (x) x))
+(@ (⧵ env env args args) env (⧵ env env args args))
+#;(|\| #f env args args)
+
+; false a.k.a second-of-two
+#;(λ (if-true) (λ (if-false) if-false))
+(⧵ env env args (⧵ args env args args))
+#;(|\| #f env args (|\| args env args args))
+
+; true a.k.a first-of-two
+#;(λ (if-true) (λ (if-false) if-true))
+(⧵ env env args (⧵ args env args captured))
+#;(|\| #f env args (|\| args env args captured))
+
+; (first-of-two first-of-two second-of-two)
+(@ (@ (⧵ env env args (⧵ args env args captured))
+      env
+      (⧵ env env args (⧵ args env args captured)))
+   env
+   (⧵ env env args (⧵ args env args args)))
+#;(|\| #f env args (|\| args env args captured))
+
+; (second-of-two first-of-two second-of-two)
+(@ (@ (⧵ env env args (⧵ args env args args))
+      env
+      (⧵ env env args (⧵ args env args captured)))
+   env
+   (⧵ env env args (⧵ args env args args)))
+#;(|\| #f env args (|\| args env args args))
+
+; pair
+#;(λ (a) (λ (b) (λ (f) ((f a) b))))
+
+;             ↑ a      a ↓      ↑ b        a ↓         f ↑       f ↓        a ↓
+#;(⧵ env env args (⧵ args env args (⧵ captured env args (@ (@ args env captured) env BBBBBBBB))))
+
+;             ↑ a      a ↓      ↑ b        b ↓         f ↑       f ↓                       b ↓
+#;(⧵ env env args (⧵ args env args (⧵   args   env args (@ (@ args env AAAAAAAA) env captured))))
+
+#;(@ pair
+   (⧵ env env args (⧵ args env args captured))
+   (⧵ env env args (⧵ args env args args)))
+
+;(@ (@ pair
+;      (⧵ env env args (⧵ args env args captured))
+;      (⧵ env env args (⧵ args env args args)))
+;   (⧵ env env args )
+
+; nil
+#;(λ (if-nil) (λ (if-cons) (if-nil 'dummy)))
+(⧵ env env args (⧵ args env args (@ captured env (⧵ env env args args))))
+
+; cons
+#;(λ (a) (λ (b) (λ (if-cons) (λ (if-nil) (if-cons a b)))))
+
+
+#;(|\| #f env args (|\| args env args captured))
+
+#;(@ (⧵ #hash() env args
+       (list (((λλ x (λλ x 1)) 1) 2)
+             (((λλ x (λλ x x)) 1) 2)
+             (((λλ x (λλ y y)) 1) 2)
+             (((λλ x (λλ y x)) 1) 2)))
+   (hash-set env "λλ" (⧵ #hash() env args
+                          (⧵ (hash "arg-name" (symbol->string (@ inspect-promise-root env (car (@ force env args))))
+                                    "body" (car (cdr (@ force env args)))
+                                    "saved-env" env)
+                              env
+                              args
+                              (@ (hash-ref closure "body")
+                                 (hash-set (hash-ref closure "saved-env")
+                                           (hash-ref closure "arg-name")
+                                           (map (make-racket-proc (⧵ #hash() env args
+                                                                      (@ force env (car args)))
+                                                                  env)
+                                                (@ force env args)))
+                                 args))))
+   (list))

tiny.rkt

@@ -0,0 +1,140 @@
+#lang racket
+
+(require racket/provide
+         phc-toolkit/untyped/syntax-parse
+         (for-syntax syntax/parse
+                     phc-toolkit/untyped/stx))
+
+(provide
+ (rename-out [check-for-test check])
+ (filtered-out
+  (λ (name) (substring name 1))
+  (combine-out -begin -@ -⧵ -env -captured -args -× -#%app -#%module-begin -#%top-interaction))) ; -#%datum -#%top -.. -⧵ -ffi -require/ffi -delay -force -inspect-promise-root
+
+;(define cons (gensym 'cons))
+
+;; Printable procedure
+(struct pproc (proc repr)
+  #:property prop:procedure (struct-field-index proc)
+  #:methods gen:custom-write
+  [(define write-proc (λ (v port mode)
+                        (match mode
+                          [#t (write (pproc-repr v) port)]
+                          [#f (display (pproc-repr v) port)]
+                          [_ (print (pproc-repr v) port 1)])))])
+
+(define-for-syntax (ds stx symbol) (datum->syntax stx symbol stx stx))
+;(define-syntax-rule (quasisyntax/top-loc loc stx) #`stx)
+
+(define (init-env-1 bit-0 bit-1 null-bits cons-bits null-bytes cons-bytes cons-k-v env-null env-push env-ref)
+  '…)
+
+(define init-env
+  (λ (env bit-0)
+    (λ (env bit-1)
+      (λ (env null-bits)
+        (λ (env cons-bits)
+          (λ (env null-bytes)
+            (λ (env cons-bytes)
+              (λ (env cons-k-v)
+                (λ (env env-null)
+                  (λ (env env-push)
+                    (λ (env env-ref)
+                      (init-env-1 bit-0 bit-1 null-bits cons-bits null-bytes cons-bytes cons-k-v env-null env-push env-ref))))))))))))
+
+(define capturedparam (make-parameter #f))
+(define envparam     (make-parameter init-env))
+(define argsparam    (make-parameter #f))
+
+(define-syntax-rule (-begin . rest) (begin . rest))
+
+;; our calculus can only capture one value at a time, the others are supplied by the caller (env
+(define -×
+  (pproc (λ (a b)
+           (pproc (λ (env args)
+                    ((args env a) env b))
+                  `(⧵ #f env args (@ (@ args env ,a) env ,b))))
+         '×))
+
+#;(define envparam
+  (make-parameter
+   `#hash()
+   #;(["#%datum" . ,(pproc (λ (.env args) (parameterize ([envparam .env])
+                                            (match (-force (envparam) args) [(list arg) (force arg)])))
+                           '#%datum)]
+      ["λ"       . ,(pproc (λ (.env args) (parameterize ([envparam .env])
+                                            (match (-force (envparam) args)
+                                              [(list arg-name-thunk body-thunk)
+                                               (define arg-name (-inspect-promise-root (envparam) arg-name-thunk))
+                                               (define body     (-inspect-promise-root (envparam) body-thunk))
+                                               (let ([saved-env (envparam)])
+                                                 (pproc (λ (.env args)
+                                                          (parameterize ([envparam saved-env])
+                                                            (parameterize ([envparam (hash-set (envparam)
+                                                                                               (symbol->string arg-name)
+                                                                                               (map (curry -force (envparam)) (-force (envparam) args)))])
+                                                              (-@ body-thunk (envparam) args))))
+                                                        `(λ ,arg-name ,body)))])))
+                           'λ)]
+      ["debug"   . ,(pproc (λ (.env arg)
+                             (parameterize ([envparam .env])
+                               (displayln (list (envparam) arg))
+                               (displayln (-force (envparam) arg))
+                               '()))
+                           'debug)])
+   env-guard))
+
+(define-syntax-rule (-delay x)
+  (pproc (λ (.env arg)
+           (parameterize ([envparam .env])
+             x))
+         `(⧵ #hash() env arg x)))
+
+(define (-force .env x) (parameterize ([envparam .env]) (x (envparam) '())))
+(define (-inspect-promise-root .env x) (match (pproc-repr x) [`(⧵ ,cl env arg ,body) body]))
+
+(define-syntax (-env     stx) (syntax-case stx () [-env     (identifier? #'-env)     #'(envparam)]))
+(define-syntax (-captured stx) (syntax-case stx () [-captured (identifier? #'-captured) #'(capturedparam)]))
+(define-syntax (-args    stx) (syntax-case stx () [-args    (identifier? #'-args)    #'(argsparam)]))
+
+(define (-@ f .env args) (parameterize ([envparam .env]) (f (envparam) args)))
+(define-syntax/parse (-⧵ capture {~and env-stx {~datum env}} {~and args {~datum args}} body)
+  #`(let ([saved-capture capture])
+      (pproc (λ (e args) (parameterize ([envparam e] [capturedparam saved-capture]) body))
+             `(⧵ ,saved-capture env-stx args body))))
+(define-syntax/parse (-ffi lib f)
+  (quasisyntax/top-loc stx
+                       (pproc (λ (.env args)
+                                (parameterize ([envparam .env]) 
+                                  (apply (let () (local-require (only-in lib f)) f)
+                                         (map (curry -force (envparam)) (-force (envparam) args)))))
+                              '(ffi lib f))))
+(define-syntax/parse (-require/ffi lib f ...)
+  (quasisyntax/top-loc stx
+                       (begin (define f (-ffi lib f))
+                              ...)))
+(define -.. hash-ref)
+
+(define-syntax (-#%top stx)
+  (syntax-parse stx
+    [(-#%top . var) (quasisyntax/top-loc stx (#%app -.. (#%app envparam) #,(symbol->string (syntax-e #'var))))]))
+
+(define-syntax (-#%app stx)
+  (syntax-parse stx
+    [(-#%app {~and @ {~datum @}} #:debug dbg f env-expr args) (quasisyntax/top-loc stx (begin (#%app displayln (#%datum dbg)) (#%app -@ f env-expr args)))]
+    [(-#%app {~and @ {~datum @}} f env-expr args) (quasisyntax/top-loc stx (#%app -@ f env-expr args))]
+    ;[(-#%app f arg ...) (quasisyntax/top-loc stx (-#%app @ f (#%app envparam) (-delay (list (-delay arg) ...))))]
+    ))
+
+(define-syntax/parse (-#%datum . d) (quasisyntax/top-loc stx (#%app -@ (-#%top . #%datum) (#%app envparam) (-delay (#%datum d)))))
+(define-syntax-rule (-#%module-begin . body) (#%module-begin . body))
+(define-syntax-rule (-#%top-interaction . body) (#%top-interaction . body))
+        
+(require rackunit)
+(define-syntax/parse (check-for-test expected-pattern actual)
+  (quasisyntax/top-loc
+   stx
+   (check-pred (match-lambda
+                 [#,(datum->syntax #'here (syntax->datum #'expected-pattern))
+                  #t])
+               actual)))