commit 7a010b3d60b5aa9ea231a64ffec59198b738fc90
parent 488d3afa75ca8e179c6f949c1c886e75e7bc2ff0
Author: Suzanne Soy <ligo@suzanne.soy>
Date: Sun, 21 Mar 2021 15:02:52 +0000
Presentation ready for racketfest
Diffstat:
11 files changed, 1273 insertions(+), 15 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -1,2 +1,3 @@
*~
-/compiled/
+compiled/
+/doc/
diff --git a/demo-rkt.hl.rkt b/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>)]
+\ No newline at end of file
diff --git a/demo2-rkt.hl.rkt b/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>]
diff --git a/envlang-rkt-for-test.rkt b/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)]
- [#f (display (pproc-repr v) port)]
- [_ (print (pproc-repr v) port 1)])))])
+ [#t (display "#;pproc:" port) (write (pproc-repr v) port)]
+ [#f (display "#;pproc:" port) (display (pproc-repr v) port)]
+ [_ (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 body (-inspect-promise-root (envparam) body-thunk))
+ (define arg-name (-promise-e (envparam) arg-name-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))
diff --git a/info.rkt b/info.rkt
@@ -1,7 +1,11 @@
#lang info
(define collection "envlang")
-(define deps '("phc-toolkit"))
-(define build-deps '("reprovide-lang-lib"))
+(define deps '("base"
+ "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")
diff --git a/envlang-rkt.rkt b/rkt.rkt
diff --git a/scribblings/envlang.scrbl b/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)]
diff --git a/test-rkt.rkt b/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
diff --git a/test-tiny.hl.rkt b/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>]
+\ No newline at end of file
diff --git a/test-tiny.rkt b/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))
+\ No newline at end of file
diff --git a/tiny.rkt b/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)))
+\ No newline at end of file
