Presentation ready for racketfest
This commit is contained in:
Suzanne Soy
parent
488d3afa75
commit
7a010b3d60
3
.gitignore
vendored
3
.gitignore
vendored
|
|
@ -1,2 +1,3 @@
|
|||
*~
|
||||
/compiled/
|
||||
compiled/
|
||||
/doc/
|
||||
|
|
|
|||
150
demo-rkt.hl.rkt
Normal file
150
demo-rkt.hl.rkt
Normal file
|
|
@ -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>)]
|
||||
244
demo2-rkt.hl.rkt
Normal file
244
demo2-rkt.hl.rkt
Normal file
|
|
@ -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>]
|
||||
|
|
@ -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))
|
||||
|
|
|
|||
8
info.rkt
8
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")
|
||||
|
|
|
|||
27
scribblings/envlang.scrbl
Normal file
27
scribblings/envlang.scrbl
Normal file
|
|
@ -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)]
|
||||
|
|
@ -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
|
||||
|
|
|
|||
563
test-tiny.hl.rkt
Normal file
563
test-tiny.hl.rkt
Normal file
|
|
@ -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>]
|
||||
86
test-tiny.rkt
Normal file
86
test-tiny.rkt
Normal file
|
|
@ -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))
|
||||
140
tiny.rkt
Normal file
140
tiny.rkt
Normal file
|
|
@ -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)))
|
||||
Loading…
Reference in New Issue
Block a user