66 Commits
Author SHA1 Message Date
msyds d1588bd917 fix runtime parsing lol
build / build (push) Failing after 1m35s
2026-09-05 20:22:07 -06:00
msyds c495fc064a arith prims 2026-09-05 20:22:07 -06:00
msyds ac39175767 eval agian 2026-09-05 20:22:07 -06:00
msyds 31c610db34 superfuck 2026-09-05 20:22:07 -06:00
msyds 1ec3d35282 arith 2026-09-05 20:22:07 -06:00
msyds 9f37d10e4f ughhh evaluate cps 2026-09-05 20:22:07 -06:00
msyds ba5dc401d9 okay it's time for a hard reset and some thinking </3 2026-09-05 20:22:07 -06:00
msyds bc599df65f shared closures maybe 2026-09-05 20:22:07 -06:00
msyds f26ac50d4e hoist 2026-09-05 20:22:07 -06:00
msyds 3196d8db84 kexp 2026-09-05 20:22:07 -06:00
msyds 75e6c963c7 stupid 2026-09-05 20:22:07 -06:00
msyds 25f1f008bd wip: call/cc = capture/cc × invoke/cc 2026-09-05 20:22:06 -06:00
msyds 276c2c1249 fix: closure-conversion of recursive functions
build / build (push) Successful in 1m28s
2026-08-30 02:12:16 -06:00
msyds 03797d573b mark broken callcc tests 2026-08-30 02:12:16 -06:00
msyds 0df7280236 deconstruct closures only at the bytecode level 2026-08-30 02:12:16 -06:00
msyds a09c00badd works albeit comically inefficiently 2026-08-30 02:12:16 -06:00
msyds e7c0ae9161 return, pushcall
build / build (push) Failing after 1m23s
2026-08-29 07:25:48 -06:00
msyds 5ccb3f3e1a register & label newtypes 2026-08-28 11:39:37 -06:00
msyds 9cb169f9b8 new instrs, tail-call 2026-08-28 11:39:37 -06:00
msyds c0a44c89b4 wip: stack frames 2026-08-28 11:39:37 -06:00
msyds 49292d5d01 wip: call/cc primitives 2026-08-28 11:39:37 -06:00
msyds 679cc076ad fix html output
build / build (push) Successful in 1m21s
2026-08-27 02:16:52 -06:00
msyds 8048573cd8 fix tests
build / build (push) Successful in 1m19s
2026-08-27 02:01:32 -06:00
msyds bbb5d6e99f stack vm throws jalmot
build / build (push) Failing after 1m40s
2026-08-27 01:45:10 -06:00
msyds 1f40120740 dotted list and such 2026-08-27 01:43:42 -06:00
msyds 196dd0d1b3 blah 2026-08-27 01:02:16 -06:00
msyds 009a154a6e rrrg 2026-08-27 01:01:17 -06:00
msyds 21b9f0e69d allow multiple values in cps conversion 2026-08-27 00:57:09 -06:00
msyds 87baed9efc pass continuations as arguments, use normal stack
build / build (push) Successful in 28s
2026-08-24 23:41:52 -06:00
msyds 796b967686 continue takes var 2026-08-24 23:41:52 -06:00
msyds 99d9e460fc disable doctests conditionally 2026-08-24 05:06:01 -06:00
msyds c9eb8f6f85 fac 20 lol 2026-08-24 02:41:09 -06:00
msyds 030b36cd98 rename runtime → wasm-runtime
build / build (push) Successful in 29s
2026-08-24 02:12:04 -06:00
msyds bf2fc08ec4 disable hitlertest 2026-08-24 01:59:11 -06:00
msyds 950d123760 refactor stack vm to use a basic block ish structure
build / build (push) Failing after 1m46s
2026-08-24 01:12:34 -06:00
msyds 8a20c4f4aa envrc 2026-08-23 01:46:58 -06:00
msyds d4c1385225 remove doctest
build / build (push) Successful in 20s
2026-08-23 01:14:50 -06:00
msyds 2ceefdb3df remove sexp-grammar 2026-08-23 00:54:46 -06:00
msyds 7c0642655f tests pass!
build / build (push) Failing after 1m29s
2026-08-23 00:46:02 -06:00
msyds bf5595f185 qq 2026-08-22 23:06:30 -06:00
msyds bbcc924b34 fix all the reader tests lol 2026-08-22 18:13:04 -06:00
msyds 73063d2b2c parse meta vars
build / build (push) Failing after 1m36s
2026-08-22 18:05:35 -06:00
msyds 4beeb7c4cd datum grammar
build / build (push) Failing after 30s
2026-08-22 02:40:05 -06:00
msyds c340ede84f print begin
build / build (push) Successful in 1m13s
2026-08-21 16:25:04 -06:00
msyds 66386cda64 more tests }:) 2026-08-21 15:10:52 -06:00
msyds b234a52d4b wip: printer
build / build (push) Successful in 1m33s
2026-08-21 15:01:31 -06:00
msyds 6ff01a8607 parse lists
build / build (push) Successful in 1m15s
2026-08-21 02:25:58 -06:00
msyds 5200932944 wip: reader
build / build (push) Successful in 1m19s
2026-08-21 01:07:26 -06:00
msyds f9ed1274d9 r7rs datum ast
build / build (push) Successful in 1m13s
2026-08-20 22:05:57 -06:00
msyds 6c29f3779a fix completions
build / build (push) Successful in 1m12s
2026-08-20 18:45:22 -06:00
msyds 5a173a7a3b fix dir-locals hooks 2026-08-20 18:20:11 -06:00
msyds b329a42b71 remove CPS.ValLit
build / build (push) Successful in 40s
2026-08-20 18:14:46 -06:00
msyds 25ba8c03b8 tasty-discover 2026-08-20 17:21:42 -06:00
msyds fc8cf263aa cleanup
build / build (push) Successful in 1m32s
2026-08-20 05:32:21 -06:00
msyds c5f9bf1850 cli, cps interpreter, stack vm, closure-conversion, fixes, tests, LOL
build / build (push) Successful in 7m49s
2026-08-20 01:05:16 -06:00
msyds 94b1a5fb45 enable some working tests
build / build (push) Successful in 1m13s
2026-08-19 00:13:06 -06:00
msyds ca1b53f3d1 fix catching of exceptions in tests 2026-08-18 23:56:22 -06:00
msyds eb51f4fff7 call/cc 2026-08-18 23:13:32 -06:00
msyds 8bdbfafb9c fix some warnings 2026-08-18 21:14:50 -06:00
msyds 6949ff7fdf convert (limited) letrec
build / build (push) Successful in 20s
2026-08-18 20:38:17 -06:00
msyds a73b3ed89b correctly handle push-calls!!!!!!!!
build / build (push) Successful in 1m24s
2026-08-18 19:25:18 -06:00
msyds 1c13de4153 more stackification
build / build (push) Successful in 1m15s
2026-08-18 16:13:44 -06:00
msyds d91e059a84 wip: stackify
build / build (push) Successful in 1m30s
2026-08-18 02:27:02 -06:00
msyds c4bcf38374 factorial
build / build (push) Successful in 1m9s
2026-08-17 23:44:35 -06:00
msyds 745277ed1a wip: abstract stack/continuation machine
build / build (push) Successful in 1m12s
2026-08-17 22:31:45 -06:00
msyds c3c4866fa8 idk
build / build (push) Failing after 51s
2026-08-06 21:07:33 -06:00
172 changed files with 5676 additions and 1913 deletions
+16 -4
View File
@@ -1,7 +1,19 @@
((haskell-cabal-mode ((haskell-mode
. ((eval
. (progn (add-to-list 'haskell-font-lock-quasi-quote-modes
'("cps" . scheme-mode))
(add-to-list 'haskell-font-lock-quasi-quote-modes
'("scm" . scheme-mode))))))
(haskell-cabal-mode
. ((eval . ((eval
. (progn (defun apply-cabal-fmt-h () . (progn (defun apply-cabal-fmt-h ()
(haskell-mode-buffer-apply-command "cabal-fmt")) (haskell-mode-buffer-apply-command "cabal-fmt"))
(add-hook 'before-save-hook #'apply-cabal-fmt-h nil t) (add-hook 'before-save-hook #'apply-cabal-fmt-h nil t)))))
(add-to-list 'haskell-font-lock-quasi-quote-modes (scheme-mode
'("cps" . scheme-mode))))))) . ((eval . (dolist (s '(kappa κ prim))
(put s 'scheme-indent-function 1)))))
(nil
. ((eval
. (progn (defun display-ansi ()
(interactive)
(ansi-color-apply-on-region (point-min) (point-max))))))))
+2
View File
@@ -1 +1,3 @@
use flake use flake
watch_file gyehoek.cabal cabal.project
PATH_add $(dirname $(cabal list-bin gyehoek))
+2 -1
View File
@@ -8,4 +8,5 @@ dist-newstyle
*.tix *.tix
.direnv .direnv
result result
play/ play/
trace.html
+2 -2
View File
@@ -1,3 +1,3 @@
# gyehoek-hs (계획) # 계획
a (wip) toy compiler for a Scheme-like language. currently targetting [QBE](https://c9x.me/compile/). nabbing from GHC and GNU Guile. a WIP compiler for R⁷RS Scheme targeting WebAssembly.
+5
View File
@@ -1,5 +1,10 @@
packages: *.cabal packages: *.cabal
tests: True tests: True
-- required for doctest-parallel
write-ghc-environment-files: always
-- https://github.com/martijnbastiaan/doctest-parallel/pull/66
allow-older: Cabal:process
source-repository-package source-repository-package
type: git type: git
+218
View File
@@ -0,0 +1,218 @@
#+title: ABI
largely based on the Guile Hoot's [[https://codeberg.org/spritely/hoot/src/branch/main/design/ABI.md][ABI]].
* calling convention
** non-tail calls
- set the global variable ~$current-closure~ to the callee's closure.
- load arguments into globals ~$arg0~, ~$arg1~, ~$arg2~, …
- push return continuation onto ~$cont-stack~
* scratchpad
#+begin_src scheme
;; Scheme source
(define (silly f g h x)
(f (h x) (g x)))
;; continuation-passing style
(define (silly f g h x ktail)
(h x (κ (x0)
(g x (κ (x1)
(f x0 x1 ktail))))))
;; with explicit stacks
(define (silly)
(define f (pop!))
(define g (pop!))
(define h (pop!))
(define x (pop!))
(define ktail (pop-cont!))
(push-cont! (κ (x0)
(define x* (pop!))
(define g* (pop!))
(push-cont! (κ (x1)
(define f* (pop!))
(define x0* (pop!))
(push-cont! ktail)
(push! x0*)
(push! x1)
(call! f)))
(push! x*)
(call! g)))
(push! x)
(call! h))
#+end_src
** fac
*** Scheme source
#+begin_src scheme
(define fac
(λ (n)
(if (zero? n)
1
(* n (fac (- n 1))))))
(fac 3)
#+end_src
*** CPS
#+begin_src scheme
(define fac
(λ (n ktail)
(zero? n (κ (x0)
(if x0
1
(- n 1
(κ (x1)
(fac x1
(κ (x2)
(* n x2 ktail))))))))))
(fac 3 halt)
#+end_src
*** tailified
#+begin_src scheme
(define (fac-k1)
(define n (pop!))
(define x2 (pop!))
(define x3 (* n x2))
(define ktail (pop-cont!))
(push! x3)
(call! ktail))
(define (fac-k0)
(define x0 (pop!))
(define n (pop!))
(if x0
(begin (define ktail (pop-cont!))
(push! 1)
(call! ktail))
(begin (define x1 (- n 1))
(push! x1)
(push-cont! fac-k1)
(call! fac))))
(define (fac)
(define n (pop!))
(push! n)
(push-cont! fac-k0)
(push! n)
(call! zero?))
(push! 3)
(push-cont! halt)
(call! fac)
#+end_src
evaluation of ~(fac 0)~:
#+begin_src scheme
(push! 0) ; [] []
(push-cont! halt) ; [0] []
(call! fac) ; [0] [halt]
(define n (pop!)) ; [0] [halt]
(push! n) ; [] [halt]
(push-cont! fac-k0) ; [0] [halt]
(push! n) ; [0] [halt fac-k0]
(call! zero?) ; [0 0] [halt fac-k0]
#<internals of zero?> ; [0 0] [halt fac-k0]
(define x0 (pop!)) ; [0 #t] [halt]
(define n (pop!)) ; [0] [halt]
(define ktail (pop-cont!)) ; [] [halt]
(push! 1) ; [] []
(call! ktail) ; [1] []
#+end_src
evaluation of ~(fac 3)~
#+begin_src scheme
(push! 3) ; [] []
(push-cont! halt) ; [3] []
(call! fac) ; [3] [halt]
(define n (pop!)) ; [3] [halt]
(push! n) ; [] [halt]
(push-cont! fac-k0) ; [3] [halt]
(push! n) ; [3] [halt fac-k0]
(call! zero?) ; [3 3] [halt fac-k0]
#<internals of zero?> ; [3 3] [halt fac-k0]
(define x0 (pop!)) ; [3 #f] [halt]
(define n (pop!)) ; [3] [halt]
(define x1 (- n 1)) ; [] [halt]
(push! n) ; [] [halt]
(push! x1) ; [3] [halt]
(push-cont! fac-k1) ; [3 2] [halt]
(call! fac) ; [3 2] [halt fac-k1]
(define n (pop!)) ; [3 2] [halt fac-k1]
(push! n) ; [3 ] [halt fac-k1]
(push-cont! fac-k0) ; [3 2] [halt fac-k1]
(push! n) ; [3 2] [halt fac-k1 fac-k0]
(call! zero?) ; [3 2 2] [halt fac-k1 fac-k0]
#<internals of zero?> ; [3 2 2] [halt fac-k1 fac-k0]
(define x0 (pop!)) ; [3 2 #f] [halt fac-k1]
(define n (pop!)) ; [3 2] [halt fac-k1]
(define x1 (- n 1)) ; [3] [halt fac-k1]
(push! n) ; [3] [halt fac-k1]
(push! x1) ; [3 2] [halt fac-k1]
(push-cont! fac-k1) ; [3 2 1] [halt fac-k1]
(call! fac) ; [3 2 1] [halt fac-k1 fac-k1]
(define n (pop!)) ; [3 2 1] [halt fac-k1 fac-k1]
(push! n) ; [3 2] [halt fac-k1 fac-k1]
(push-cont! fac-k0) ; [3 2 1] [halt fac-k1 fac-k1]
(push! n) ; [3 2 1] [halt fac-k1 fac-k1 fac-k0]
(call! zero?) ; [3 2 1 1] [halt fac-k1 fac-k1 fac-k0]
#<internals of zero?> ; [3 2 1 1] [halt fac-k1 fac-k1 fac-k0]
(define x0 (pop!)) ; [3 2 1 #f] [halt fac-k1 fac-k1]
(define n (pop!)) ; [3 2 1] [halt fac-k1 fac-k1]
(define x1 (- n 1)) ; [3 2] [halt fac-k1 fac-k1]
(push! n) ; [3 2] [halt fac-k1]
(push! x1) ; [3 2 1] [halt fac-k1 fac-k1]
(push-cont! fac-k1) ; [3 2 1 0] [halt fac-k1 fac-k1]
(call! fac) ; [3 2 1 0] [halt fac-k1 fac-k1 fac-k1]
(define n (pop!)) ; [3 2 1 0] [halt fac-k1 fac-k1 fac-k1]
(push! n) ; [3 2 1] [halt fac-k1 fac-k1 fac-k1]
(push-cont! fac-k0) ; [3 2 1 0] [halt fac-k1 fac-k1 fac-k1]
(push! n) ; [3 2 1 0] [halt fac-k1 fac-k1 fac-k1 fac-k0]
(call! zero?) ; [3 2 1 0 0] [halt fac-k1 fac-k1 fac-k1 fac-k0]
#<internals of zero?> ; [3 2 1 0 0] [halt fac-k1 fac-k1 fac-k1 fac-k0]
(define x0 (pop!)) ; [3 2 1 0 #t] [halt fac-k1 fac-k1 fac-k1]
(define n (pop!)) ; [3 2 1 0] [halt fac-k1 fac-k1 fac-k1]
(define ktail (pop-cont!)) ; [3 2 1] [halt fac-k1 fac-k1 fac-k1]
(push! 1) ; [3 2 1 1] [halt fac-k1 fac-k1]
(call! ktail) ; [3 2 1 1] [halt fac-k1 fac-k1]
(define n (pop!)) ; [3 2 1 1] [halt fac-k1 fac-k1]
(define x2 (pop!)) ; [3 2 1] [halt fac-k1 fac-k1]
(define x3 (* n x2)) ; [3 2] [halt fac-k1 fac-k1]
(define ktail (pop-cont!)) ; [3 2] [halt fac-k1 fac-k1]
(push! x3) ; [3 2] [halt fac-k1]
(call! ktail) ; [3 2 1] [halt fac-k1]
(define n (pop!)) ; [3 2 1] [halt fac-k1]
(define x2 (pop!)) ; [3 2] [halt fac-k1]
(define x3 (* n x2)) ; [3] [halt fac-k1]
(define ktail (pop-cont!)) ; [3] [halt fac-k1]
(push! x3) ; [3] [halt]
(call! ktail) ; [3 2] [halt]
(define n (pop!)) ; [3 2] [halt]
(define x2 (pop!)) ; [3] [halt]
(define x3 (* n x2)) ; [] [halt]
(define ktail (pop-cont!)) ; [] [halt]
(push! x3) ; [] []
(call! ktail) ; [6] []
;; => (halt 6)
#+end_src
+165
View File
@@ -0,0 +1,165 @@
#+title: closure-conversion
the closure-conversion phase makes closed-over variables explicit by addition of the primitive ~make-closure~, taking a code pointer (in the CPS language, bare lambda) and the environment.
nice testable properties of closure-converted code:
- code pointers only appear in function position
- no function has free variables
multiple ~env-ref~ calls could probably be replaced with a primitive that loads the entire environment at once, returning multiple variables.
* scratchpad
** example
#+caption: scheme source
#+begin_src scheme
(letrec ((curried-add (λ (n)
(λ (m)
(+ n m)))))
((curried-add 3) 4))
#+end_src
#+caption: cps
#+begin_src scheme
(letrec ((curried-add
(λ (n ktail0)
(letrec ((curried-add-in
(λ (m ktail1)
(prim (+ n m)
(κ (x0) (continue ktail1 x0))))))
(continue ktail0 curried-add-in)))))
(letrec ((k0 (κ (adder) (adder 4 halt))))
(curried-add 3 k0)))
#+end_src
#+caption: closure-converted
#+begin_src scheme
(letrec ((curried-add
(λ (n ktail0)
(letrec ((curried-add-in-code
(λ (env m ktail1)
(prim (env-ref 0 env)
(κ (n)
(prim (+ n m)
(κ (x0) (continue ktail1 x0))))))))
(prim (make-closure curried-add-in-code n)
(κ (curried-add-in)
(continue ktail0 curried-add-in)))))))
(letrec ((k0 (κ (adder-closure)
(prim (closure-code adder-closure)
(κ (adder)
(adder adder-closure 4 halt))))))
(curried-add 3 k0)))
#+end_src
** wasm
#+begin_src scheme
(letrec ((make-adder
(lambda (n)
(lambda (x)
(+ n x)))))
((make-adder 3) 2))
#+end_src
#+begin_src scheme
(define add-code
(lambda (n env)
(+ n (env-ref env 'x))))
(define make-adder-code
(lambda (n)
(make-closure add-code ('x n))))
(define make-adder (make-closure make-adder-code))
(apply-closure (apply-closure make-addder 3) 2)
#+end_src
#+begin_src wat
(module
(type $heap-object (sub (struct (field $hash (mut i32)))))
(type $closure (sub $heap-object
(struct (field $hash (mut i32))
(field $code (ref $cont-type)))))
(type $closure1 (sub $closure
(struct (field $hash (mut i32))
(field $code (ref $cont-type))
(field $env0 (ref eq)))))
(global $arg0 (mut (ref null eq)) (ref.null eq))
(global $arg1 (mut (ref null eq)) (ref.null eq))
(global $arg2 (mut (ref null eq)) (ref.null eq))
(global $arg3 (mut (ref null eq)) (ref.null eq))
(global $arg4 (mut (ref null eq)) (ref.null eq))
(global $arg5 (mut (ref null eq)) (ref.null eq))
;; ⋮
;; (global $argn (mut (ref null eq)) (ref.null eq))
(global $current-closure (mut (ref null $closure)) (ref.null $closure))
(func $add-code (param $nargs i32)
(local $n (ref eq))
(local $x (ref eq))
(local.set $n (global.get $arg0))
(local.set $x (struct.get $closure1
(global.get $current-closure)
$env0))
(return (i32.add $n $x)))
(func $make-adder-code (param $nargs i32)
(local $n (ref eq))
(local.set $n (global.get $arg0))
(return (struct.new $closure1
0
$add-code)))
(func $main
(local.set $make-adder
(struct.new $closure
0
$make-adder-code))
(global.set $current-closure $make-adder)
(global.set $arg0 (i32.const 3))
(local.set $f (call (struct.get $closure
$make-adder
$code)
1))
(global.set $current-closure $f)
(global.set $arg0 (i32.const 2))
(return (call (struct.get $closure
$f
$code)
1))))
#+end_src
** example
#+begin_src scheme
(λ (n m ktail)
(letrec ((f (λ (x ktail-0) (+ x n ktail-0)))
(g (λ (y ktail-1) (+ y g ktail-1))))
(prim (cons f g) ktail)))
#+end_src
#+begin_src scheme
(λ (n m ktail)
(letrec ((f-code (λ (x ktail-0)
(prim (env-get 2)
(κ (n)
(+ x n ktail-0)))))
(g-code (λ (y ktail-1)
(prim (env-get 3)
(κ (m)
(+ y m ktail-1))))))
(letrec ((with-closure-code
(κ (f g)
(prim (get-env 0)
(κ (ktail)
(prim cons f g ktail))))))
(prim (make-shared-closure (with-closure-code)
ktail)
(κ (with-closure)
(prim (make-shared-closure (f-code g-code) n m)
with-closure))))))
#+end_src
+100
View File
@@ -0,0 +1,100 @@
* rationale?
previously, the VM's stack was used for storing local variables across blocks; a Scheme procedure was split into several low-level routines (one for the procedure itself and one for each continuation), and the stack was used as a communication channel for these separate routines. in contrast, registers were local to each routine. this aligns with Wasm's model of functions pretty well, with Wasm /locals/ acting as the VM's /registers/, and a global mutable stack serving as fallback.
this worked quite well until it became time to implement ~call/cc~.
we are considering making the following alterations to the VM:
- explicitly segment the stack into frames.
- passing procedures and return addresses on the stack.
- new instructions:
+ ~(tail-call /n/)~
+ ~(call /n/)~
+ ~(load /r/ /n/)~
+ ~(return /n/)~
* scratchpad
#+begin_src scheme
(letrec ((fac (λ (n)
(if (zero? n)
1
(* n (fac (- n 1)))))))
(fac 3))
#+end_src
#+begin_src scheme
(λ (ktail0)
(letrec ((fac
(λ (n ktail1)
(zero?
n
(κ (x0)
(if x0
(continue ktail1 1)
(- n 1
(κ (x1)
(fac x1
(κ (x2)
(* n x2 ktail1)))))))))))
(fac 3)))
#+end_src
#+begin_example
n ktail1
| |
| | x0
| | |
| | ^
| |
| | x1
| | |
| | ^
| |
| | x2
| | |
^ ^ ^
#+end_example
#+begin_src scheme
(define $fac-c0
(pop! %x0 0) ; [ x0 $fac-c0 n $fac ktail1 ]
(if %x0 ; [ $fac-c0 n $fac ktail1 ]
;; every variable but `ktail1' is dead so we pop them all.
;; this probably means that `if' should take two continuations
;; rather than two blocks.
(then (push! 1) ; [ $fac-c0 n $fac ktail1 ]
(return 1)) ; [ 1 $fac-c0 n $fac ktail1 ]
(else (load %n 1) ; [ $fac-c0 n $fac ktail1 ]
(prim %x1 (- %n 1)) ; [ $fac-c0 n $fac ktail1 ]
(push! $fac-c1) ; [ $fac-c0 n $fac ktail1 ]
(push! $fac) ; [ $fac-c1 $fac-c0 n $fac ktail1 ]
(push! %x1) ; [ $fac $fac-c1 $fac-c0 n $fac ktail1 ]
(call 1) ; [ x1 $fac $fac-c1 $fac-c0 n $fac ktail1 ]
)))
(define $fac-c1
(pop! %x2) ; [ x2 $fac-c1 $fac-c0 n $fac ktail1 ]
(load %n 3) ; [ $fac-c1 $fac-c0 n $fac ktail1 ]
(prim %x3 (* %n %x2))
(push! %x3) ; [ $fac-c1 $fac-c0 n $fac ktail1 ]
(return 1) ; [ x3 $fac-c1 $fac-c0 n $fac ktail1 ]
)
(define $fac
(load %ktail1 2) ; [ n $fac ktail1 ]
(load %n 0) ; [ n $fac ktail1 ]
(push! $fac-c0) ; [ n $fac ktail1 ]
(push! $zero?) ; [ $fac-c0 n $fac ktail1 ]
(push! %n) ; [ $zero? $fac-c0 n $fac ktail1 ]
(call 1) ; [ n $zero? $fac-c0 n $fac ktail1 ]
)
(define $start
(push! $fac) ; [ $start ktail0 ]
(push! 3) ; [ $fac $start ktail0 ]
(tail-call 1) ; [ 3 $fac $start ktail0 ]
;; ↑ `tail-call' knows how to dispose of the caller's stack frame.
)
#+end_src
+53
View File
@@ -0,0 +1,53 @@
#+title: assorted notes on compilation
* letrec
consider:
#+begin_src scheme
(letrec ((even? (lambda (n)
(if (zero? n)
#t
(odd? (- n 1)))))
(odd? (lambda (n)
(if (zero? n)
#f
(even? (- n 1))))))
(even? 12))
#+end_src
#+RESULTS:
: #t
since ~letrec~ is a primitive construct in the CPS language, the translation of mutually recursive functions is straightforward:
#+begin_src scheme
(define (-& x y k) (k (- x y)))
(define (zero?& x k) (k (zero? x)))
(define (halt x) x)
(letrec ((even? (lambda (n ktail)
(zero?& n
(lambda (x1)
(if x1
#t
(-& n 1
(lambda (x2)
(odd? x2 ktail))))))))
(odd? (lambda (n ktail)
(zero?& n
(lambda (x1)
(if x1
#f
(-& n 1
(lambda (x2)
(even? x2 ktail)))))))))
(even? 12 halt))
#+end_src
#+RESULTS:
: #t
however, Scheme permits ~letrec~-expressions with non-lambda right-hand sides, while the CPS language permits only kappa and lambda forms. thus, the handling of these forms is less trivial.
for now we'll just reject any ~letrec~ forms with non-lambda right-hand sides, lol. they aren't very important.
+12 -6
View File
@@ -20,13 +20,13 @@
overlays = [ overlays = [
haskellNix.overlay haskellNix.overlay
(final: prev: { (final: prev: {
shake-wrapper = final.callPackage ./shake-wrapper.nix {}; gyehoek-wasm-runtime = final.callPackage ./wasm-runtime {
gyehoek-runtime = final.callPackage ./runtime {
crane-lib = inputs.crane.mkLib final; crane-lib = inputs.crane.mkLib final;
}; };
gyehoek = final.haskell-nix.project' { gyehoek = final.haskell-nix.project' {
src = ./.; src = ./.;
compiler-nix-name = "ghc912"; compiler-nix-name = "ghc912";
configureArgs = "-f-doctest";
modules = [({ pkgs, lib, ...}: { modules = [({ pkgs, lib, ...}: {
packages.gyehoek.components.tests.test.preCheck = packages.gyehoek.components.tests.test.preCheck =
let let
@@ -34,14 +34,16 @@
pkgs.git # tasty uses git diff pkgs.git # tasty uses git diff
]; ];
in '' in ''
export GYEHOEK_RUNTIME=${lib.getExe final.gyehoek-runtime} export GYEHOEK_WASM_RUNTIME=${
lib.getExe final.gyehoek-wasm-runtime
}
export PATH=${lib.makeBinPath bin}:$PATH export PATH=${lib.makeBinPath bin}:$PATH
''; '';
})]; })];
shell = { shell = {
withHoogle = true; withHoogle = true;
inputsFrom = [ inputsFrom = [
final.gyehoek-runtime final.gyehoek-wasm-runtime
]; ];
tools = { tools = {
cabal = {}; cabal = {};
@@ -49,7 +51,6 @@
}; };
buildInputs = with final; [ buildInputs = with final; [
haskellPackages.cabal-fmt haskellPackages.cabal-fmt
shake-wrapper
wabt wabt
nodejs nodejs
wasm-tools wasm-tools
@@ -57,6 +58,11 @@
guile guile
rust-analyzer rust-analyzer
wasmtime wasmtime
# bashInteractive is necessary to work around an
# optparse-applicative issue
#
# https://github.com/pcapriotti/optparse-applicative/pull/408
bashInteractive
]; ];
}; };
}; };
@@ -88,7 +94,7 @@
hf.packages.${system} // lib.fix (packages: { hf.packages.${system} // lib.fix (packages: {
gyehoek = hf.packages.${system}."gyehoek:exe:gyehoek"; gyehoek = hf.packages.${system}."gyehoek:exe:gyehoek";
default = packages.gyehoek; default = packages.gyehoek;
inherit (pkgs) gyehoek-runtime shake-wrapper; inherit (pkgs) gyehoek-wasm-runtime;
})); }));
devShells = each-system devShells = each-system
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 9
+4
View File
@@ -0,0 +1,4 @@
(let ((make-adder (lambda (x)
(lambda (y)
(+ x y)))))
((make-adder 4) 5))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 17
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 10
+5
View File
@@ -0,0 +1,5 @@
((λ (f g x)
(f (g x)))
(λ (x) (+ x 4))
(λ (x) (* x 2))
3)
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 456
+1
View File
@@ -0,0 +1 @@
(begin 123 456) ; => 456
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 123
+1
View File
@@ -0,0 +1 @@
(call/cc (λ (cc) (cc 123)))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 1234
+1
View File
@@ -0,0 +1 @@
(call/cc (λ (_) 1234))
@@ -0,0 +1,12 @@
(letrec ((iter (λ (n f)
(if (zero? n)
#f
(begin (f n)
(iter (- n 1) f))))))
(call/cc
(λ (k)
(iter 10 (λ (n)
;; i don't feel like implementing (= n 5) right now lmfao
(if (zero? (- n 5))
(k #t)
#f))))))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > #t
@@ -0,0 +1,4 @@
(call/cc
(λ (k)
(begin (k #t)
#f)))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > #t
@@ -0,0 +1,5 @@
;; confer ../callcc-early-exit-4
(letrec ((app (λ (f x)
(begin (f x)
#f))))
(call/cc (λ (k) (app k #t))))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > #t
@@ -0,0 +1,5 @@
;; confer ../callcc-early-exit-3
(letrec ((app (λ (f x)
(begin (f x)
#f))))
(call/cc (λ (k) (app (λ (x) (k x)) #t))))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > #t
@@ -0,0 +1,4 @@
(call/cc
(λ (k)
(begin ((λ () (k #t)))
#f)))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 12
@@ -0,0 +1,4 @@
(* 2 (call/cc
(λ (k)
(begin (k 6)
3))))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 456
+5
View File
@@ -0,0 +1,5 @@
(call/cc
(λ (k1)
(call/cc
(λ (k2)
(k1 456)))))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 456
+5
View File
@@ -0,0 +1,5 @@
(call/cc
(λ (k1)
(call/cc
(λ (k2)
(k2 456)))))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 155
+10
View File
@@ -0,0 +1,10 @@
(letrec ((factorial (λ (n)
(if (zero? n)
1
(* n (factorial (- n 1)))))))
(letrec ((sum-of-factorials
(λ (n)
(if (zero? n)
0
(+ (factorial n) (sum-of-factorials (- n 1)))))))
(+ 2 (sum-of-factorials 5))))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > (6 . 7)
+1
View File
@@ -0,0 +1 @@
(cons 6 7)
+2
View File
@@ -0,0 +1,2 @@
(let ((p (cons 123 456)))
(cons (cdr p) (car p)))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 2432902008176640000
+5
View File
@@ -0,0 +1,5 @@
(letrec ((fac (λ (n)
(if (zero? n)
1
(* n (fac (- n 1)))))))
(fac 20))
+3
View File
@@ -0,0 +1,3 @@
(((λ (f) f)
(λ (x) (* x 4)))
32)
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 16
+2
View File
@@ -0,0 +1,2 @@
(let ((square (λ (x) (* x x))))
(square 4))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 16
+2
View File
@@ -0,0 +1,2 @@
(letrec ((square (λ (x) (* x x))))
(square 4))
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > 123
+1
View File
@@ -0,0 +1 @@
123
+2
View File
@@ -0,0 +1,2 @@
ret > ExitSuccess
out > #t
-1
View File
@@ -1 +0,0 @@
(((λ (f) f) (λ (x) (* x 4))) 32)
+4
View File
@@ -0,0 +1,4 @@
(begin
책을
더
먹으세요~!)
+4
View File
@@ -0,0 +1,4 @@
(begin
책을
더
먹으세요~!)
+5
View File
@@ -0,0 +1,5 @@
(lambda
(어간
어미)
(display
꾸깃))
+2
View File
@@ -0,0 +1,2 @@
(lambda (어간 어미)
(display 꾸깃))
+1
View File
@@ -0,0 +1 @@
()
+1
View File
@@ -0,0 +1 @@
((((()))))
+4
View File
@@ -0,0 +1,4 @@
(가
나
다
라)
+1
View File
@@ -0,0 +1 @@
(가 나 다 라)
+41
View File
@@ -0,0 +1,41 @@
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/bool/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 1
}
)
} :< SimpleF ( SimpleBoolean True )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/bool/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 4
}
)
} :< SimpleF ( SimpleBoolean True )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/bool/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 10
}
)
} :< SimpleF ( SimpleBoolean False )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/bool/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 13
}
)
} :< SimpleF ( SimpleBoolean False )
]
+1
View File
@@ -0,0 +1 @@
#t #true #f #false
+4
View File
@@ -0,0 +1,4 @@
#;(a datum comment can
span multiple lines)
(but it ends here)
+36
View File
@@ -0,0 +1,36 @@
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/decimal/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 1
}
)
} :< SimpleF
( SimpleNumber 45.0 )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/decimal/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 4
}
)
} :< SimpleF
( SimpleNumber 5667.0 )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/decimal/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 10
}
)
} :< SimpleF
( SimpleNumber
( -123.0 )
)
]
+1
View File
@@ -0,0 +1 @@
45 +5667 -123
+5
View File
@@ -0,0 +1,5 @@
[ Fix
( SimpleF
( Symbol "aaaa bc" )
)
]
@@ -0,0 +1 @@
|aaaa bc|
+1
View File
@@ -0,0 +1 @@
[]
View File
+62
View File
@@ -0,0 +1,62 @@
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-dot-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 1
}
)
} :< CompoundF
( DotListF
(
( MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-dot-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 2
}
)
} :< SimpleF
( SimpleSymbol "가" )
) :|
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-dot-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 5
}
)
} :< SimpleF
( SimpleSymbol "나" )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-dot-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 8
}
)
} :< SimpleF
( SimpleSymbol "다" )
]
)
( MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-dot-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 13
}
)
} :< SimpleF
( SimpleSymbol "라" )
)
)
]
+1
View File
@@ -0,0 +1 @@
( . )
+91
View File
@@ -0,0 +1,91 @@
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 1
}
)
} :< CompoundF
( ListF Ordinary
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 2
}
)
} :< SimpleF
( SimpleSymbol "가" )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 5
}
)
} :< SimpleF
( SimpleSymbol "나" )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 8
}
)
} :< SimpleF
( SimpleSymbol "다" )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 11
}
)
} :< SimpleF
( SimpleSymbol "라" )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 14
}
)
} :< SimpleF
( SimpleNumber 1.0 )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 16
}
)
} :< SimpleF
( SimpleNumber 2.0 )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list-flat/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 18
}
)
} :< SimpleF
( SimpleNumber 3.0 )
]
)
]
+1
View File
@@ -0,0 +1 @@
( 1 2 3)
+148
View File
@@ -0,0 +1,148 @@
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 1
}
)
} :< CompoundF
( DotListF
(
( MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 2
}
)
} :< SimpleF
( SimpleSymbol "a" )
) :|
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 4
}
)
} :< SimpleF
( SimpleSymbol "b" )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 6
}
)
} :< CompoundF
( ListF Ordinary
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 7
}
)
} :< SimpleF
( SimpleSymbol "c" )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 9
}
)
} :< SimpleF
( SimpleSymbol "d" )
]
)
]
)
( MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 14
}
)
} :< CompoundF
( ListF Ordinary
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 15
}
)
} :< SimpleF
( SimpleSymbol "가" )
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 18
}
)
} :< CompoundF
( DotListF
(
( MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 19
}
)
} :< SimpleF
( SimpleSymbol "나" )
) :| []
)
( MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 24
}
)
} :< SimpleF
( SimpleSymbol "다" )
)
)
, MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/list/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 28
}
)
} :< SimpleF
( SimpleSymbol "라" )
]
)
)
)
]
+1
View File
@@ -0,0 +1 @@
(a b (c d) . ( ( . ) ))
+11
View File
@@ -0,0 +1,11 @@
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/meta-expression/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 1
}
)
} :< MetaF "aHaskellVariable + abc * 2"
]
+1
View File
@@ -0,0 +1 @@
#{aHaskellVariable + abc * 2}
@@ -0,0 +1,2 @@
##{case 123 of { 123 -> blah
; xyz -> flah }}
+11
View File
@@ -0,0 +1,11 @@
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/meta-splice-expression/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 1
}
)
} :< MetaSpliceF "takeWhile (\x -> even x) aHaskellList"
]
@@ -0,0 +1 @@
##{takeWhile (\x -> even x) aHaskellList}
+11
View File
@@ -0,0 +1,11 @@
[ MkAnn
{ syntax = SynNone
, position = Just
( SourcePos
{ sourceName = "golden/read/meta-splice-variable/source.scm"
, sourceLine = Pos 1
, sourceColumn = Pos 1
}
)
} :< MetaSpliceF "aHaskellList"
]
@@ -0,0 +1 @@
##{aHaskellList}

Some files were not shown because too many files have changed in this diff Show More