From 33870aca016f660626f6531bd376890532739b05 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Thu, 9 Apr 2026 21:09:41 -0400 Subject: [PATCH 01/47] Fixes #66. --- mug/compile.rkt | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/mug/compile.rkt b/mug/compile.rkt index 5b2d1a6..ee04163 100644 --- a/mug/compile.rkt +++ b/mug/compile.rkt @@ -17,6 +17,7 @@ (define rsp 'rsp) ; stack (define rdi 'rdi) ; arg (define r15 'r15) ; stack pad (non-volatile) +(define r12 'r12) ;; type CEnv = (Listof [Maybe Id]) @@ -29,12 +30,14 @@ (Label 'entry) (Push rbx) ; save callee-saved register (Push r15) + (Push r12) (Mov rbx rdi) ; recv heap pointer (init-symbol-table p) (compile-defines-values ds) (compile-e e (reverse (define-ids ds)) #f) (Add rsp (* 8 (length ds))) ;; pop function definitions - (Pop r15) ; restore callee-save register + (Pop r12) ; restore callee-save register + (Pop r15) (Pop rbx) (Ret) (compile-defines ds) From 98f27b9ef59abda8fb922520d28bc70c46bf2a66 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Thu, 9 Apr 2026 21:35:03 -0400 Subject: [PATCH 02/47] Save/resore callee-saved register r12 in Mountebank. --- mountebank/compile.rkt | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/mountebank/compile.rkt b/mountebank/compile.rkt index 6d0028b..9c8c62a 100644 --- a/mountebank/compile.rkt +++ b/mountebank/compile.rkt @@ -15,6 +15,7 @@ (define rsp 'rsp) ; stack (define rdi 'rdi) ; arg (define r15 'r15) ; stack pad (non-volatile) +(define r12 'r12) ;; type CEnv = (Listof [Maybe Id]) @@ -27,12 +28,14 @@ (Label 'entry) (Push rbx) ; save callee-saved register (Push r15) + (Push r12) (Mov rbx rdi) ; recv heap pointer (init-symbol-table p) (compile-defines-values ds) (compile-e e (reverse (define-ids ds)) #f) (Add rsp (* 8 (length ds))) ;; pop function definitions - (Pop r15) ; restore callee-save register + (Pop r12) ; restore callee-save register + (Pop r15) (Pop rbx) (Ret) (compile-defines ds) From 083dce868ab25f9f12517159185c83c29a482bb3 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Thu, 9 Apr 2026 21:45:38 -0400 Subject: [PATCH 03/47] Save/restore r12 in Neerdowell. --- neerdowell/compile.rkt | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/neerdowell/compile.rkt b/neerdowell/compile.rkt index 6d0028b..9c8c62a 100644 --- a/neerdowell/compile.rkt +++ b/neerdowell/compile.rkt @@ -15,6 +15,7 @@ (define rsp 'rsp) ; stack (define rdi 'rdi) ; arg (define r15 'r15) ; stack pad (non-volatile) +(define r12 'r12) ;; type CEnv = (Listof [Maybe Id]) @@ -27,12 +28,14 @@ (Label 'entry) (Push rbx) ; save callee-saved register (Push r15) + (Push r12) (Mov rbx rdi) ; recv heap pointer (init-symbol-table p) (compile-defines-values ds) (compile-e e (reverse (define-ids ds)) #f) (Add rsp (* 8 (length ds))) ;; pop function definitions - (Pop r15) ; restore callee-save register + (Pop r12) ; restore callee-save register + (Pop r15) (Pop rbx) (Ret) (compile-defines ds) From ae1759697b63d28efd036b57010b7525055c1dfe Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 10 Apr 2026 14:42:22 -0400 Subject: [PATCH 04/47] Remove racket package caching. --- .github/workflows/ubuntu.yml | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index eed0128..4f55830 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -38,16 +38,6 @@ jobs: clang --version gcc --version - - name: Cache Racket packages - uses: actions/cache@v4 - with: - path: | - ~/.racket - ~/.cache/racket - ~/.local/share/racket - ~/Library/Caches/Racket - key: racket-${{ matrix.racket-variant }}-${{ matrix.racket-version }}-${{ matrix.os }} - - name: Install langs package run: | raco pkg install --auto ../langs/ From 393a236f21409b6fb9598eb20e83aa9b5a34177b Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 13 Apr 2026 23:39:45 -0400 Subject: [PATCH 05/47] Rework Neerdowell for new JIT. --- .github/workflows/ubuntu.yml | 15 ++- neerdowell/Makefile | 40 +++--- neerdowell/build-runtime.rkt | 14 --- neerdowell/{ => compiler}/compile-datum.rkt | 2 +- neerdowell/{ => compiler}/compile-define.rkt | 6 +- neerdowell/{ => compiler}/compile-expr.rkt | 8 +- .../{ => compiler}/compile-literals.rkt | 2 +- neerdowell/{ => compiler}/compile-ops.rkt | 5 +- neerdowell/{ => compiler}/compile-stdin.rkt | 5 +- neerdowell/{ => compiler}/compile.rkt | 8 +- neerdowell/{ => compiler}/utils.rkt | 0 neerdowell/executor/decode.rkt | 57 +++++++++ neerdowell/executor/exec.rkt | 95 ++++++++++++++ neerdowell/executor/run-stdin.rkt | 14 +++ neerdowell/executor/run.rkt | 21 ++++ neerdowell/{ => interpreter}/env.rkt | 0 neerdowell/{ => interpreter}/interp-defun.rkt | 2 +- neerdowell/{ => interpreter}/interp-io.rkt | 0 neerdowell/{ => interpreter}/interp-prims.rkt | 2 +- neerdowell/{ => interpreter}/interp-stdin.rkt | 4 +- neerdowell/{ => interpreter}/interp.rkt | 2 +- neerdowell/main.c | 40 ------ neerdowell/main.rkt | 20 +++ neerdowell/parse-file.rkt | 13 -- neerdowell/run.rkt | 18 --- neerdowell/runtime.h | 15 --- neerdowell/runtime/Makefile | 29 +++++ neerdowell/{ => runtime}/char.c | 0 neerdowell/runtime/error.c | 9 ++ neerdowell/{ => runtime}/heap.h | 0 neerdowell/{ => runtime}/io.c | 16 +-- neerdowell/runtime/main.c | 26 ++++ neerdowell/{ => runtime}/print.c | 0 neerdowell/{ => runtime}/print.h | 0 neerdowell/runtime/runtime.h | 27 ++++ neerdowell/{ => runtime}/symbol.c | 0 neerdowell/{ => runtime}/types.h | 39 +++--- neerdowell/{ => runtime}/types.rkt | 50 -------- neerdowell/{ => runtime}/values.c | 0 neerdowell/runtime/values.h | 119 ++++++++++++++++++ neerdowell/{ => syntax}/ast.rkt | 0 neerdowell/{ => syntax}/fv.rkt | 0 neerdowell/{ => syntax}/lambdas.rkt | 0 neerdowell/{ => syntax}/parse.rkt | 0 neerdowell/{ => syntax}/read-all.rkt | 0 neerdowell/test/build-runtime.rkt | 8 -- neerdowell/test/compile.rkt | 6 +- neerdowell/test/interp-defun.rkt | 6 +- neerdowell/test/interp.rkt | 6 +- neerdowell/values.h | 91 -------------- 50 files changed, 518 insertions(+), 322 deletions(-) delete mode 100644 neerdowell/build-runtime.rkt rename neerdowell/{ => compiler}/compile-datum.rkt (98%) rename neerdowell/{ => compiler}/compile-define.rkt (95%) rename neerdowell/{ => compiler}/compile-expr.rkt (98%) rename neerdowell/{ => compiler}/compile-literals.rkt (99%) rename neerdowell/{ => compiler}/compile-ops.rkt (99%) rename neerdowell/{ => compiler}/compile-stdin.rkt (64%) rename neerdowell/{ => compiler}/compile.rkt (91%) rename neerdowell/{ => compiler}/utils.rkt (100%) create mode 100644 neerdowell/executor/decode.rkt create mode 100644 neerdowell/executor/exec.rkt create mode 100644 neerdowell/executor/run-stdin.rkt create mode 100644 neerdowell/executor/run.rkt rename neerdowell/{ => interpreter}/env.rkt (100%) rename neerdowell/{ => interpreter}/interp-defun.rkt (99%) rename neerdowell/{ => interpreter}/interp-io.rkt (100%) rename neerdowell/{ => interpreter}/interp-prims.rkt (99%) rename neerdowell/{ => interpreter}/interp-stdin.rkt (73%) rename neerdowell/{ => interpreter}/interp.rkt (99%) delete mode 100644 neerdowell/main.c create mode 100644 neerdowell/main.rkt delete mode 100644 neerdowell/parse-file.rkt delete mode 100644 neerdowell/run.rkt delete mode 100644 neerdowell/runtime.h create mode 100644 neerdowell/runtime/Makefile rename neerdowell/{ => runtime}/char.c (100%) create mode 100644 neerdowell/runtime/error.c rename neerdowell/{ => runtime}/heap.h (100%) rename neerdowell/{ => runtime}/io.c (50%) create mode 100644 neerdowell/runtime/main.c rename neerdowell/{ => runtime}/print.c (100%) rename neerdowell/{ => runtime}/print.h (100%) create mode 100644 neerdowell/runtime/runtime.h rename neerdowell/{ => runtime}/symbol.c (100%) rename neerdowell/{ => runtime}/types.h (67%) rename neerdowell/{ => runtime}/types.rkt (51%) rename neerdowell/{ => runtime}/values.c (100%) create mode 100644 neerdowell/runtime/values.h rename neerdowell/{ => syntax}/ast.rkt (100%) rename neerdowell/{ => syntax}/fv.rkt (100%) rename neerdowell/{ => syntax}/lambdas.rkt (100%) rename neerdowell/{ => syntax}/parse.rkt (100%) rename neerdowell/{ => syntax}/read-all.rkt (100%) delete mode 100644 neerdowell/test/build-runtime.rkt delete mode 100644 neerdowell/values.h diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 4f55830..9cd49fb 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -29,15 +29,26 @@ jobs: variant: ${{ matrix.racket-variant }} version: ${{ matrix.racket-version }} - - name: Install clang + - name: Install LLVM + uses: ZhongRuoyu/setup-llvm@v0 + with: + llvm-version: 22 + + - name: Install libssl run: | - sudo apt install -y clang libssl-dev + sudo apt install -y libssl-dev - name: Version info run: | clang --version gcc --version + # Temporary: install the next branch of a86 while this is in development + # Once merged in main, remove this and let it grab main branch by default + - name: Install a86 next branch + run: | + raco pkg install --auto 'https://github.com/cmsc430/a86.git?#next' + - name: Install langs package run: | raco pkg install --auto ../langs/ diff --git a/neerdowell/Makefile b/neerdowell/Makefile index 3fc9599..5886d39 100644 --- a/neerdowell/Makefile +++ b/neerdowell/Makefile @@ -6,33 +6,33 @@ else LANGS_AS ?= clang -c endif -objs = \ - main.o \ - print.o \ - values.o \ - io.o \ - symbol.o +RACKET ?= racket -default: runtime.o +RUNTIME_DIR := runtime/standalone +RUNTIME := $(RUNTIME_DIR)/runtime.o -runtime.o: $(objs) - ld -r $(objs) -o runtime.o +# Example source extension for this language. +SRC_EXT := rkt -%.run: %.o runtime.o - $(LANGS_CC) runtime.o $< -o $@ +default: + @echo "example: make foo.run" -.c.o: - $(LANGS_CC) -fPIC -c -g -o $@ $< +# Build the runtime bundles if needed. +$(RUNTIME): + $(MAKE) -C $(RUNTIME_DIR) -.s.o: +# Compile source program to assembly. +%.s: %.$(SRC_EXT) + cat $< | $(RACKET) -t compiler/compile-stdin.rkt -m > $@ + +# Assemble to object. +%.o: %.s $(LANGS_AS) -o $@ $< -%.s: %.rkt - cat $< | racket -t compile-stdin.rkt -m > $@ +# Link standalone executable. +%.run: %.o $(RUNTIME) + $(LANGS_CC) -o $@ $^ clean: @$(RM) *.o *.s *.run ||: - @echo "$(shell basename $(shell pwd)): cleaned!" - -%.test: %.run %.rkt - @test "$(shell ./$(<))" = "$(shell racket $(word 2,$^))" + @$(MAKE) -C $(RUNTIME_DIR) clean diff --git a/neerdowell/build-runtime.rkt b/neerdowell/build-runtime.rkt deleted file mode 100644 index 66aad89..0000000 --- a/neerdowell/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require racket/runtime-path) -(provide runtime-path) - -(define-runtime-path here ".") - -(void - (system (string-append "make -C '" - (path->string (normalize-path here)) - "' runtime.o"))) - -(define runtime-path - (path->string - (normalize-path (build-path here "runtime.o")))) diff --git a/neerdowell/compile-datum.rkt b/neerdowell/compiler/compile-datum.rkt similarity index 98% rename from neerdowell/compile-datum.rkt rename to neerdowell/compiler/compile-datum.rkt index 9fe2720..a7ab58a 100644 --- a/neerdowell/compile-datum.rkt +++ b/neerdowell/compiler/compile-datum.rkt @@ -1,6 +1,6 @@ #lang racket (provide compile-datum) -(require "types.rkt" +(require "../runtime/types.rkt" "utils.rkt" a86/ast) diff --git a/neerdowell/compile-define.rkt b/neerdowell/compiler/compile-define.rkt similarity index 95% rename from neerdowell/compile-define.rkt rename to neerdowell/compiler/compile-define.rkt index a8a6992..3b2c2d4 100644 --- a/neerdowell/compile-define.rkt +++ b/neerdowell/compiler/compile-define.rkt @@ -1,8 +1,8 @@ #lang racket (provide compile-define compile-defines-values define-ids compile-defines) -(require "ast.rkt" - "types.rkt" - "fv.rkt" +(require "../syntax/ast.rkt" + "../syntax/fv.rkt" + "../runtime/types.rkt" "utils.rkt" "compile-expr.rkt" a86/ast) diff --git a/neerdowell/compile-expr.rkt b/neerdowell/compiler/compile-expr.rkt similarity index 98% rename from neerdowell/compile-expr.rkt rename to neerdowell/compiler/compile-expr.rkt index f309fd2..13e67ba 100644 --- a/neerdowell/compile-expr.rkt +++ b/neerdowell/compiler/compile-expr.rkt @@ -1,9 +1,9 @@ #lang racket (provide compile-e compile-lambda-define compile-lambda-defines free-vars-to-heap) -(require "ast.rkt" - "types.rkt" - "lambdas.rkt" - "fv.rkt" +(require "../syntax/ast.rkt" + "../syntax/lambdas.rkt" + "../syntax/fv.rkt" + "../runtime/types.rkt" "utils.rkt" "compile-ops.rkt" "compile-datum.rkt" diff --git a/neerdowell/compile-literals.rkt b/neerdowell/compiler/compile-literals.rkt similarity index 99% rename from neerdowell/compile-literals.rkt rename to neerdowell/compiler/compile-literals.rkt index 7530b30..19317b5 100644 --- a/neerdowell/compile-literals.rkt +++ b/neerdowell/compiler/compile-literals.rkt @@ -1,6 +1,6 @@ #lang racket (provide compile-literals init-symbol-table literals) -(require "ast.rkt" +(require "../syntax/ast.rkt" "utils.rkt" a86/ast) diff --git a/neerdowell/compile-ops.rkt b/neerdowell/compiler/compile-ops.rkt similarity index 99% rename from neerdowell/compile-ops.rkt rename to neerdowell/compiler/compile-ops.rkt index 5c492fd..8e25308 100644 --- a/neerdowell/compile-ops.rkt +++ b/neerdowell/compiler/compile-ops.rkt @@ -2,7 +2,10 @@ (provide compile-op pad-stack unpad-stack assert-proc compile-make-struct ; for notes assert-cons) -(require "ast.rkt" "types.rkt" "utils.rkt" a86/ast) +(require "../syntax/ast.rkt" + "../runtime/types.rkt" + "utils.rkt" + a86/ast) (define rax 'rax) ; return (define eax 'eax) ; 32-bit load/store diff --git a/neerdowell/compile-stdin.rkt b/neerdowell/compiler/compile-stdin.rkt similarity index 64% rename from neerdowell/compile-stdin.rkt rename to neerdowell/compiler/compile-stdin.rkt index cfa1510..91ca4cc 100644 --- a/neerdowell/compile-stdin.rkt +++ b/neerdowell/compiler/compile-stdin.rkt @@ -1,6 +1,9 @@ #lang racket (provide main) -(require "parse.rkt" "compile.rkt" "read-all.rkt" a86/printer) +(require "../syntax/parse.rkt" + "../syntax/read-all.rkt" + "compile.rkt" + a86/printer) ;; -> Void ;; Compile contents of stdin, diff --git a/neerdowell/compile.rkt b/neerdowell/compiler/compile.rkt similarity index 91% rename from neerdowell/compile.rkt rename to neerdowell/compiler/compile.rkt index 9c8c62a..f97074a 100644 --- a/neerdowell/compile.rkt +++ b/neerdowell/compiler/compile.rkt @@ -1,9 +1,9 @@ #lang racket (provide compile compile-e) -(require "ast.rkt" - "types.rkt" - "lambdas.rkt" - "fv.rkt" +(require "../syntax/ast.rkt" + "../syntax/lambdas.rkt" + "../syntax/fv.rkt" + "../runtime/types.rkt" "utils.rkt" "compile-define.rkt" "compile-expr.rkt" diff --git a/neerdowell/utils.rkt b/neerdowell/compiler/utils.rkt similarity index 100% rename from neerdowell/utils.rkt rename to neerdowell/compiler/utils.rkt diff --git a/neerdowell/executor/decode.rkt b/neerdowell/executor/decode.rkt new file mode 100644 index 0000000..033b020 --- /dev/null +++ b/neerdowell/executor/decode.rkt @@ -0,0 +1,57 @@ +#lang racket +(provide bits->value _val) + +(require "../runtime/types.rkt" + ffi/unsafe) + +(struct struct-val () #:transparent) + +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(= b (value->bits eof)) eof] + [(= b (value->bits (void))) (void)] + [(= b (value->bits '())) '()] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [(char-bits? b) + (integer->char (arithmetic-shift b (- char-shift)))] + [(box-bits? b) + (box (bits->value (heap-ref b)))] + [(cons-bits? b) + (cons (bits->value (heap-ref (+ b 8))) + (bits->value (heap-ref b)))] + [(vect-bits? b) + (if (zero? (untag b)) + (vector) + (build-vector (heap-ref b) + (lambda (j) + (bits->value (heap-ref (+ b (* 8 (add1 j))))))))] + [(str-bits? b) + (if (zero? (untag b)) + (string) + (build-string (heap-ref b) + (lambda (j) + (char-ref (+ b 8) j))))] + [(symb-bits? b) + (string->symbol + (if (zero? (untag b)) + (string) + (build-string (heap-ref b) + (lambda (j) + (char-ref (+ b 8) j)))))] + [(struct-bits? b) + (struct-val)] + [(proc-bits? b) + (lambda _ + (error "This function is not callable."))] + [else (error "invalid bits")])) + +(define (heap-ref i) + (ptr-ref (cast (untag i) _int64 _pointer) _int64)) + +(define (char-ref i j) + (integer->char (ptr-ref (cast (untag i) _int64 _pointer) _uint32 j))) + +(define _val + (make-ctype _int64 value->bits bits->value)) diff --git a/neerdowell/executor/exec.rkt b/neerdowell/executor/exec.rkt new file mode 100644 index 0000000..5e2f7fd --- /dev/null +++ b/neerdowell/executor/exec.rkt @@ -0,0 +1,95 @@ +#lang racket + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe + "decode.rkt" + "../runtime/types.rkt") + +(struct exec-state (program heap) #:transparent) + +;; ------------------------------------------------------------ +;; symbol helpers + +;; Runtime layout of val_symb_t: +;; uint64_t len; +;; uint32_t codepoints[]; + +(define (symb-ptr->string p) + (define len (ptr-ref p _uint64 0)) + (define cp-base (ptr-add p 8 _byte)) + (build-string + len + (λ (i) + (integer->char (ptr-ref cp-base _uint32 i))))) + +(define (string-compare a b) + (cond + [(stringstring p1) + (symb-ptr->string p2))) + +;; ------------------------------------------------------------ +;; low-level execution + +(define (exec/state prog) + (define intern-table (make-hash)) + (define (intern-symbol/cb p) + (define s (symb-ptr->string p)) + (hash-ref! intern-table s (λ () p))) + + (define heap (malloc _int64 10000)) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)) + (extern 'raise_error + (λ () (raise 'err)) + (_fun -> _void)) + (extern 'intern_symbol + intern-symbol/cb + (_fun _pointer -> _pointer)) + (extern 'symb_cmp + symb-cmp/cb + (_fun _pointer _pointer -> _int)))]) + (asm-load prog)) + heap)) + +(define (exec-call st) + (match-define (exec-state program heap) st) + (with-handlers ([(λ (x) (eq? x 'err)) identity]) + (asm-call program 'entry heap))) + +(define (exec-unload st) + (match-define (exec-state program heap) st) + (asm-unload program)) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/neerdowell/executor/run-stdin.rkt b/neerdowell/executor/run-stdin.rkt new file mode 100644 index 0000000..50f0958 --- /dev/null +++ b/neerdowell/executor/run-stdin.rkt @@ -0,0 +1,14 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt" + "../syntax/read-all.rkt" + "../compiler/compile.rkt" + "run.rkt" + a86/printer) + +;; -> Void +;; Compile contents of stdin, +;; emit asm code on stdout +(define (main) + (read-line) ; ignore #lang racket line + (run (parse (read-all)))) diff --git a/neerdowell/executor/run.rkt b/neerdowell/executor/run.rkt new file mode 100644 index 0000000..c9620a5 --- /dev/null +++ b/neerdowell/executor/run.rkt @@ -0,0 +1,21 @@ +#lang racket + +(provide run run/io) + +(require "exec.rkt" + "decode.rkt") + +;; Asm -> Value +(define (run asm) + (call-with-exec + asm + (λ (r) + (match r + ['err 'err] + [b (bits->value b)])))) + +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) diff --git a/neerdowell/env.rkt b/neerdowell/interpreter/env.rkt similarity index 100% rename from neerdowell/env.rkt rename to neerdowell/interpreter/env.rkt diff --git a/neerdowell/interp-defun.rkt b/neerdowell/interpreter/interp-defun.rkt similarity index 99% rename from neerdowell/interp-defun.rkt rename to neerdowell/interpreter/interp-defun.rkt index 6692231..a548046 100644 --- a/neerdowell/interp-defun.rkt +++ b/neerdowell/interpreter/interp-defun.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp interp-env (struct-out Closure) zip) -(require "ast.rkt" +(require "../syntax/ast.rkt" "env.rkt" "interp-prims.rkt") diff --git a/neerdowell/interp-io.rkt b/neerdowell/interpreter/interp-io.rkt similarity index 100% rename from neerdowell/interp-io.rkt rename to neerdowell/interpreter/interp-io.rkt diff --git a/neerdowell/interp-prims.rkt b/neerdowell/interpreter/interp-prims.rkt similarity index 99% rename from neerdowell/interp-prims.rkt rename to neerdowell/interpreter/interp-prims.rkt index 9f4cdfa..c130b6e 100644 --- a/neerdowell/interp-prims.rkt +++ b/neerdowell/interpreter/interp-prims.rkt @@ -1,5 +1,5 @@ #lang racket -(require "ast.rkt") +(require "../syntax/ast.rkt") (provide interp-prim StructVal) ;; type Struct = (StructVal Symbol (Vectorof Value)) diff --git a/neerdowell/interp-stdin.rkt b/neerdowell/interpreter/interp-stdin.rkt similarity index 73% rename from neerdowell/interp-stdin.rkt rename to neerdowell/interpreter/interp-stdin.rkt index 965b9cc..1da0197 100644 --- a/neerdowell/interp-stdin.rkt +++ b/neerdowell/interpreter/interp-stdin.rkt @@ -1,6 +1,8 @@ #lang racket (provide main) -(require "parse.rkt" "interp.rkt" "read-all.rkt") +(require "../syntax/parse.rkt" + "../syntax/read-all.rkt" + "interp.rkt") ;; -> Void ;; Parse and interpret contents of stdin, diff --git a/neerdowell/interp.rkt b/neerdowell/interpreter/interp.rkt similarity index 99% rename from neerdowell/interp.rkt rename to neerdowell/interpreter/interp.rkt index 1ee5d9f..2a67244 100644 --- a/neerdowell/interp.rkt +++ b/neerdowell/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp interp-env) -(require "ast.rkt" +(require "../syntax/ast.rkt" "env.rkt" "interp-prims.rkt") diff --git a/neerdowell/main.c b/neerdowell/main.c deleted file mode 100644 index 1ca6115..0000000 --- a/neerdowell/main.c +++ /dev/null @@ -1,40 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); -val_t *heap; - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - heap = malloc(8 * heap_size); - - val_t result; - - result = entry(heap); - - print_result(result); - if (val_typeof(result) != T_VOID) - putchar('\n'); - - free(heap); - return 0; -} diff --git a/neerdowell/main.rkt b/neerdowell/main.rkt new file mode 100644 index 0000000..4299806 --- /dev/null +++ b/neerdowell/main.rkt @@ -0,0 +1,20 @@ +#lang racket +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/decode.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/decode.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) + diff --git a/neerdowell/parse-file.rkt b/neerdowell/parse-file.rkt deleted file mode 100644 index a502132..0000000 --- a/neerdowell/parse-file.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt" "compile.rkt" "read-all.rkt" a86/printer) - -;; String -> Void -;; Compile contents of given file name, -;; emit asm code on stdout -(define (main fn) - (let ((p (open-input-file fn))) - (begin - (read-line p) ; ignore #lang racket line - (displayln (parse (read-all p))) - (close-input-port p)))) diff --git a/neerdowell/run.rkt b/neerdowell/run.rkt deleted file mode 100644 index eaa53eb..0000000 --- a/neerdowell/run.rkt +++ /dev/null @@ -1,18 +0,0 @@ -#lang racket -(provide run run/io) -(require "types.rkt" "build-runtime.rkt" - a86/interp) - -;; Asm -> Answer -(define (run is) - (parameterize ((current-objs (list runtime-path))) - (match (asm-interp is) - ['err 'err] - [b (bits->value b)]))) - -;; Asm String -> (cons Answer String) -(define (run/io is s) - (parameterize ((current-objs (list runtime-path))) - (match (asm-interp/io is s) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) diff --git a/neerdowell/runtime.h b/neerdowell/runtime.h deleted file mode 100644 index cf6a73c..0000000 --- a/neerdowell/runtime.h +++ /dev/null @@ -1,15 +0,0 @@ -#ifndef RUNTIME_H -#define RUNTIME_H - -#include "values.h" - -val_t entry(val_t*); -extern FILE* in; -extern FILE* out; -extern void (*error_handler)(); - -// in words -#define heap_size 10000 -extern val_t *heap; - -#endif /* RUNTIME_H */ diff --git a/neerdowell/runtime/Makefile b/neerdowell/runtime/Makefile new file mode 100644 index 0000000..ee8ff93 --- /dev/null +++ b/neerdowell/runtime/Makefile @@ -0,0 +1,29 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + values.o \ + print.o \ + io.o \ + symbol.o \ + error.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/neerdowell/char.c b/neerdowell/runtime/char.c similarity index 100% rename from neerdowell/char.c rename to neerdowell/runtime/char.c diff --git a/neerdowell/runtime/error.c b/neerdowell/runtime/error.c new file mode 100644 index 0000000..69a535a --- /dev/null +++ b/neerdowell/runtime/error.c @@ -0,0 +1,9 @@ +#include +#include +#include "runtime.h" + +_Noreturn void raise_error(void) +{ + printf("err\n"); + exit(1); +} diff --git a/neerdowell/heap.h b/neerdowell/runtime/heap.h similarity index 100% rename from neerdowell/heap.h rename to neerdowell/runtime/heap.h diff --git a/neerdowell/io.c b/neerdowell/runtime/io.c similarity index 50% rename from neerdowell/io.c rename to neerdowell/runtime/io.c index 7ef8228..9f1fc45 100644 --- a/neerdowell/io.c +++ b/neerdowell/runtime/io.c @@ -1,25 +1,25 @@ #include -#include -#include "types.h" +#include #include "values.h" #include "runtime.h" val_t read_byte(void) { - char c = getc(in); - return (c == EOF) ? val_wrap_eof() : val_wrap_int(c); + int c = getc(stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_int(c); } val_t peek_byte(void) { - char c = getc(in); - ungetc(c, in); + int c = getc(stdin); + if (c != EOF) + ungetc(c, stdin); return (c == EOF) ? val_wrap_eof() : val_wrap_int(c); - } val_t write_byte(val_t c) { - putc((char) val_unwrap_int(c), out); + int b = val_unwrap_int(c); + putc((unsigned char)b, stdout); return val_wrap_void(); } diff --git a/neerdowell/runtime/main.c b/neerdowell/runtime/main.c new file mode 100644 index 0000000..610b2bf --- /dev/null +++ b/neerdowell/runtime/main.c @@ -0,0 +1,26 @@ +#include +#include +#include "values.h" +#include "print.h" +#include "runtime.h" + +/* in words */ +#define heap_size 10000 + +int main(int argc, char **argv) +{ + val_t *heap = malloc(8 * heap_size); + if (!heap) { + fprintf(stderr, "out of memory\n"); + return 1; + } + + val_t result = entry(heap); + + print_result(result); + if (val_typeof(result) != T_VOID) + putchar('\n'); + + free(heap); + return 0; +} diff --git a/neerdowell/print.c b/neerdowell/runtime/print.c similarity index 100% rename from neerdowell/print.c rename to neerdowell/runtime/print.c diff --git a/neerdowell/print.h b/neerdowell/runtime/print.h similarity index 100% rename from neerdowell/print.h rename to neerdowell/runtime/print.h diff --git a/neerdowell/runtime/runtime.h b/neerdowell/runtime/runtime.h new file mode 100644 index 0000000..2ec5ef1 --- /dev/null +++ b/neerdowell/runtime/runtime.h @@ -0,0 +1,27 @@ +#ifndef RUNTIME_H +#define RUNTIME_H + +#include "values.h" + +/* + * Entry point for compiled programs. + * + * The caller supplies the heap pointer. Compiled code may use this as its + * initial allocation pointer / runtime heap base according to the language's + * calling convention. + */ +val_t entry(val_t *heap); + +/* + * Language-facing runtime operations used by compiled code. + * + * These are implemented by the runtime core, typically in terms of lower-level + * host hooks declared in host.h. + */ +val_t read_byte(void); +val_t peek_byte(void); +val_t write_byte(val_t); + +_Noreturn void raise_error(void); + +#endif /* RUNTIME_H */ diff --git a/neerdowell/symbol.c b/neerdowell/runtime/symbol.c similarity index 100% rename from neerdowell/symbol.c rename to neerdowell/runtime/symbol.c diff --git a/neerdowell/types.h b/neerdowell/runtime/types.h similarity index 67% rename from neerdowell/types.h rename to neerdowell/runtime/types.h index ec7db8b..084310e 100644 --- a/neerdowell/types.h +++ b/neerdowell/runtime/types.h @@ -2,23 +2,26 @@ #define TYPES_H /* - Bit layout of values + * Bit layout of runtime values + * + * Values are either: + * - immediates, tagged with low bits ending in #b000 + * - pointers, tagged with one of the pointer tags below + * + * Immediates include: + * - integers + * - characters + * - booleans + * - eof + * - void + * - empty list + */ - Values are either: - - Immediates: end in #b000 - - Pointers - - Immediates are either - - Integers: end in #b0 000 - - Characters: end in #b01 000 - - True: #b11 000 - - False: #b1 11 000 - - Eof: #b10 11 000 - - Void: #b11 11 000 - - Empty: #b100 11 000 -*/ +/* low bits reserved for pointer/immediate discrimination */ #define imm_shift 3 #define ptr_type_mask ((1 << imm_shift) - 1) + +/* pointer tags */ #define box_type_tag 1 #define cons_type_tag 2 #define vect_type_tag 3 @@ -26,18 +29,24 @@ #define proc_type_tag 5 #define symb_type_tag 6 #define struct_type_tag 7 + +/* integer immediates */ #define int_shift (1 + imm_shift) #define int_type_mask ((1 << int_shift) - 1) #define int_type_tag (0 << (int_shift - 1)) #define nonint_type_tag (1 << (int_shift - 1)) + +/* character immediates */ #define char_shift (int_shift + 1) #define char_type_mask ((1 << char_shift) - 1) #define char_type_tag ((0 << (char_shift - 1)) | nonint_type_tag) #define nonchar_type_tag ((1 << (char_shift - 1)) | nonint_type_tag) + +/* distinguished immediate constants */ #define val_true ((0 << char_shift) | nonchar_type_tag) #define val_false ((1 << char_shift) | nonchar_type_tag) #define val_eof ((2 << char_shift) | nonchar_type_tag) #define val_void ((3 << char_shift) | nonchar_type_tag) #define val_empty ((4 << char_shift) | nonchar_type_tag) -#endif +#endif /* TYPES_H */ diff --git a/neerdowell/types.rkt b/neerdowell/runtime/types.rkt similarity index 51% rename from neerdowell/types.rkt rename to neerdowell/runtime/types.rkt index 9375b78..f37867c 100644 --- a/neerdowell/types.rkt +++ b/neerdowell/runtime/types.rkt @@ -1,6 +1,5 @@ #lang racket (provide (all-defined-out)) -(require ffi/unsafe) (define imm-shift 3) (define imm-mask #b111) @@ -19,49 +18,6 @@ (define type-char #b01000) (define mask-char #b11111) -(struct struct-val () #:transparent) - -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(= b (value->bits eof)) eof] - [(= b (value->bits (void))) (void)] - [(= b (value->bits '())) '()] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [(box-bits? b) - (box (bits->value (heap-ref b)))] - [(cons-bits? b) - (cons (bits->value (heap-ref (+ b 8))) - (bits->value (heap-ref b)))] - [(vect-bits? b) - (if (zero? (untag b)) - (vector) - (build-vector (heap-ref b) - (lambda (j) - (bits->value (heap-ref (+ b (* 8 (add1 j))))))))] - [(str-bits? b) - (if (zero? (untag b)) - (string) - (build-string (heap-ref b) - (lambda (j) - (char-ref (+ b 8) j))))] - [(symb-bits? b) - (string->symbol - (if (zero? (untag b)) - (string) - (build-string (heap-ref b) - (lambda (j) - (char-ref (+ b 8) j)))))] - [(struct-bits? b) - (struct-val)] - [(proc-bits? b) - (lambda _ - (error "This function is not callable."))] - [else (error "invalid bits")])) - (define (value->bits v) (cond [(eq? v #t) #b00011000] [(eq? v #f) #b00111000] @@ -108,9 +64,3 @@ (define (untag i) (arithmetic-shift (arithmetic-shift i (- (integer-length ptr-mask))) (integer-length ptr-mask))) - -(define (heap-ref i) - (ptr-ref (cast (untag i) _int64 _pointer) _int64)) - -(define (char-ref i j) - (integer->char (ptr-ref (cast (untag i) _int64 _pointer) _uint32 j))) diff --git a/neerdowell/values.c b/neerdowell/runtime/values.c similarity index 100% rename from neerdowell/values.c rename to neerdowell/runtime/values.c diff --git a/neerdowell/runtime/values.h b/neerdowell/runtime/values.h new file mode 100644 index 0000000..5c41275 --- /dev/null +++ b/neerdowell/runtime/values.h @@ -0,0 +1,119 @@ +#ifndef VALUES_H +#define VALUES_H + +#include + +/* + * Abstract runtime value. + * + * All language values are represented as a tagged 64-bit word. + */ +typedef int64_t val_t; + +/* + * Dynamic type tags used by the runtime and printing code. + */ +typedef enum type_t { + T_INVALID = -1, + + /* immediates */ + T_INT, + T_BOOL, + T_CHAR, + T_EOF, + T_VOID, + T_EMPTY, + + /* heap objects */ + T_BOX, + T_CONS, + T_VECT, + T_STR, + T_SYMB, + T_PROC, + T_STRUCT, +} type_t; + +typedef uint32_t val_char_t; + +/* + * Heap object layouts. + * + * These layouts correspond to the pointer-tagged representations in types.h. + */ +typedef struct val_box_t { + val_t val; +} val_box_t; + +typedef struct val_cons_t { + val_t snd; + val_t fst; +} val_cons_t; + +typedef struct val_vect_t { + uint64_t len; + val_t elems[]; +} val_vect_t; + +typedef struct val_str_t { + uint64_t len; + val_char_t codepoints[]; +} val_str_t; + +typedef struct val_symb_t { + uint64_t len; + val_char_t codepoints[]; +} val_symb_t; + +typedef struct val_struct_t { + val_t name; + val_t *vals; +} val_struct_t; + +/* + * Classify a runtime value. + */ +type_t val_typeof(val_t x); + +/* + * Wrap/unwrap operations. + * + * The behavior of unwrap functions is undefined on type mismatch. + */ + +/* integers */ +int64_t val_unwrap_int(val_t x); +val_t val_wrap_int(int64_t i); + +/* booleans */ +int val_unwrap_bool(val_t x); +val_t val_wrap_bool(int b); + +/* characters */ +val_char_t val_unwrap_char(val_t x); +val_t val_wrap_char(val_char_t c); + +/* special values */ +val_t val_wrap_eof(void); +val_t val_wrap_void(void); + +/* heap objects */ +val_box_t *val_unwrap_box(val_t x); +val_t val_wrap_box(val_box_t *b); + +val_cons_t *val_unwrap_cons(val_t x); +val_t val_wrap_cons(val_cons_t *c); + +val_vect_t *val_unwrap_vect(val_t x); +val_t val_wrap_vect(val_vect_t *v); + +val_str_t *val_unwrap_str(val_t x); +val_t val_wrap_str(val_str_t *v); + +val_symb_t *val_unwrap_symb(val_t x); +val_t val_wrap_symb(val_symb_t *v); + +val_struct_t *val_unwrap_struct(val_t x); +val_t val_wrap_struct(val_struct_t *v); + +#endif /* VALUES_H */ diff --git a/neerdowell/ast.rkt b/neerdowell/syntax/ast.rkt similarity index 100% rename from neerdowell/ast.rkt rename to neerdowell/syntax/ast.rkt diff --git a/neerdowell/fv.rkt b/neerdowell/syntax/fv.rkt similarity index 100% rename from neerdowell/fv.rkt rename to neerdowell/syntax/fv.rkt diff --git a/neerdowell/lambdas.rkt b/neerdowell/syntax/lambdas.rkt similarity index 100% rename from neerdowell/lambdas.rkt rename to neerdowell/syntax/lambdas.rkt diff --git a/neerdowell/parse.rkt b/neerdowell/syntax/parse.rkt similarity index 100% rename from neerdowell/parse.rkt rename to neerdowell/syntax/parse.rkt diff --git a/neerdowell/read-all.rkt b/neerdowell/syntax/read-all.rkt similarity index 100% rename from neerdowell/read-all.rkt rename to neerdowell/syntax/read-all.rkt diff --git a/neerdowell/test/build-runtime.rkt b/neerdowell/test/build-runtime.rkt deleted file mode 100644 index 7023ee0..0000000 --- a/neerdowell/test/build-runtime.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require a86/interp) - -;; link with runtime for IO operations -(unless (file-exists? "../runtime.o") - (system "make -C .. runtime.o")) -(current-objs - (list (path->string (normalize-path "../runtime.o")))) diff --git a/neerdowell/test/compile.rkt b/neerdowell/test/compile.rkt index ee289de..a94773c 100644 --- a/neerdowell/test/compile.rkt +++ b/neerdowell/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket (require "test-runner.rkt" - "../parse.rkt" - "../compile.rkt" - "../run.rkt") + "../syntax/parse.rkt" + "../compiler/compile.rkt" + "../executor/run.rkt") (test-runner (λ p (run (compile (parse p))))) (test-runner-io (λ (s . p) (run/io (compile (parse p)) s))) diff --git a/neerdowell/test/interp-defun.rkt b/neerdowell/test/interp-defun.rkt index 68ef419..82da55d 100644 --- a/neerdowell/test/interp-defun.rkt +++ b/neerdowell/test/interp-defun.rkt @@ -1,8 +1,8 @@ #lang racket (require "test-runner.rkt" - "../parse.rkt" - "../interp-defun.rkt" - "../interp-io.rkt") + "../syntax/parse.rkt" + "../interpreter/interp-defun.rkt" + "../interpreter/interp-io.rkt") (define (closure->proc xs e r) ;; Could make this better by calling the interpreter, diff --git a/neerdowell/test/interp.rkt b/neerdowell/test/interp.rkt index cd7b654..5338128 100644 --- a/neerdowell/test/interp.rkt +++ b/neerdowell/test/interp.rkt @@ -1,8 +1,8 @@ #lang racket (require "test-runner.rkt" - "../parse.rkt" - "../interp.rkt" - "../interp-io.rkt") + "../syntax/parse.rkt" + "../interpreter/interp.rkt" + "../interpreter/interp-io.rkt") (test-runner (λ p (interp (parse p)))) (test-runner-io (λ (s . p) (interp/io (parse p) s))) diff --git a/neerdowell/values.h b/neerdowell/values.h deleted file mode 100644 index 1f1dafa..0000000 --- a/neerdowell/values.h +++ /dev/null @@ -1,91 +0,0 @@ -#ifndef VALUES_H -#define VALUES_H - -#include - -/* any abstract value */ -typedef int64_t val_t; - -typedef enum type_t { - T_INVALID = -1, - /* immediates */ - T_INT, - T_BOOL, - T_CHAR, - T_EOF, - T_VOID, - T_EMPTY, - /* pointers */ - T_BOX, - T_CONS, - T_VECT, - T_STR, - T_SYMB, - T_PROC, - T_STRUCT, -} type_t; - -typedef uint32_t val_char_t; -typedef struct val_box_t { - val_t val; -} val_box_t; -typedef struct val_cons_t { - val_t snd; - val_t fst; -} val_cons_t; -typedef struct val_vect_t { - uint64_t len; - val_t elems[]; -} val_vect_t; -typedef struct val_str_t { - uint64_t len; - val_char_t codepoints[]; -} val_str_t; -typedef struct val_symb_t { - uint64_t len; - val_char_t codepoints[]; -} val_symb_t; -typedef struct val_struct_t { - val_t name; - val_t* vals; -} val_struct_t; -/* return the type of x */ -type_t val_typeof(val_t x); - -/** - * Wrap/unwrap values - * - * The behavior of unwrap functions are undefined on type mismatch. - */ -int64_t val_unwrap_int(val_t x); -val_t val_wrap_int(int64_t i); - -int val_unwrap_bool(val_t x); -val_t val_wrap_bool(int b); - -val_char_t val_unwrap_char(val_t x); -val_t val_wrap_char(val_char_t b); - -val_t val_wrap_eof(); - -val_t val_wrap_void(); - -val_box_t* val_unwrap_box(val_t x); -val_t val_wrap_box(val_box_t* b); - -val_cons_t* val_unwrap_cons(val_t x); -val_t val_wrap_cons(val_cons_t* c); - -val_vect_t* val_unwrap_vect(val_t x); -val_t val_wrap_vect(val_vect_t* c); - -val_str_t* val_unwrap_str(val_t x); -val_t val_wrap_str(val_str_t* c); - -val_symb_t* val_unwrap_symb(val_t x); -val_t val_wrap_symb(val_symb_t* c); - -val_struct_t* val_unwrap_struct(val_t x); -val_t val_wrap_struct(val_struct_t* c); - -#endif From 5cb3aff3a482fc246d805af609b02811b57f8240 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Tue, 14 Apr 2026 23:44:38 -0400 Subject: [PATCH 06/47] Rework Abscond through Loot for new JIT. --- abscond/Makefile | 37 +- abscond/{ => compiler}/compile-stdin.rkt | 2 +- abscond/{ => compiler}/compile.rkt | 2 +- abscond/correct.rkt | 7 +- abscond/exec.rkt | 10 - abscond/executor/exec.rkt | 44 +++ {blackmail => abscond/executor}/run-stdin.rkt | 4 +- abscond/executor/run.rkt | 11 + .../interpreter}/interp-stdin.rkt | 2 +- abscond/{ => interpreter}/interp.rkt | 2 +- abscond/main.rkt | 24 +- abscond/run.rkt | 13 - abscond/runtime/Makefile | 25 ++ abscond/{ => runtime}/main.c | 4 +- abscond/{ => runtime}/print.c | 0 abscond/{ => runtime}/print.h | 0 abscond/{ => syntax}/ast.rkt | 0 abscond/{ => syntax}/parse.rkt | 0 abscond/test/compile.rkt | 8 +- abscond/test/interp.rkt | 4 +- abscond/test/parse.rkt | 4 +- {con => blackmail/compiler}/compile-ops.rkt | 2 +- {con => blackmail/compiler}/compile-stdin.rkt | 2 +- blackmail/{ => compiler}/compile.rkt | 2 +- blackmail/correct.rkt | 7 +- blackmail/exec.rkt | 10 - blackmail/executor/exec.rkt | 44 +++ {abscond => blackmail/executor}/run-stdin.rkt | 4 +- blackmail/executor/run.rkt | 11 + blackmail/{ => interpreter}/interp-prim.rkt | 0 .../interpreter}/interp-stdin.rkt | 2 +- blackmail/{ => interpreter}/interp.rkt | 2 +- blackmail/main.rkt | 24 +- blackmail/run.rkt | 13 - blackmail/runtime/Makefile | 25 ++ blackmail/{ => runtime}/main.c | 4 +- blackmail/{ => runtime}/print.c | 0 blackmail/{ => runtime}/print.h | 0 blackmail/semantics.rkt | 30 -- blackmail/{ => syntax}/ast.rkt | 0 blackmail/{ => syntax}/parse.rkt | 0 blackmail/{ => syntax}/random.rkt | 0 blackmail/test/compile.rkt | 8 +- blackmail/test/interp.rkt | 4 +- blackmail/test/parse.rkt | 4 +- {blackmail => con/compiler}/compile-ops.rkt | 2 +- {blackmail => con/compiler}/compile-stdin.rkt | 2 +- con/{ => compiler}/compile.rkt | 2 +- con/correct.rkt | 7 +- con/exec.rkt | 10 - con/executor/exec.rkt | 44 +++ con/{ => executor}/run-stdin.rkt | 4 +- con/executor/run.rkt | 11 + con/{ => interpreter}/interp-prim.rkt | 0 {dodger => con/interpreter}/interp-stdin.rkt | 2 +- con/{ => interpreter}/interp.rkt | 2 +- con/main.rkt | 24 +- con/run.rkt | 13 - con/runtime/Makefile | 25 ++ con/{ => runtime}/main.c | 4 +- con/{ => runtime}/print.c | 0 con/{ => runtime}/print.h | 0 con/semantics.rkt | 37 -- con/{ => syntax}/ast.rkt | 0 con/{ => syntax}/parse.rkt | 0 con/{ => syntax}/random.rkt | 2 +- con/test/compile.rkt | 8 +- con/test/interp.rkt | 4 +- con/test/parse.rkt | 4 +- con/types.rkt | 17 - dodger/Makefile | 3 +- dodger/{ => compiler}/compile-ops.rkt | 4 +- dodger/{ => compiler}/compile-stdin.rkt | 2 +- {dupe => dodger/compiler}/compile.rkt | 4 +- dodger/correct.rkt | 7 +- dodger/exec.rkt | 10 - dodger/executor/decode.rkt | 20 + dodger/executor/exec.rkt | 44 +++ dodger/{ => executor}/run-stdin.rkt | 4 +- dodger/executor/run.rkt | 11 + dodger/interp-bits.rkt | 41 -- dodger/{ => interpreter}/interp-prim.rkt | 0 .../interpreter}/interp-stdin.rkt | 2 +- dodger/{ => interpreter}/interp.rkt | 2 +- dodger/main.rkt | 28 +- dodger/run.rkt | 15 - dodger/runtime/Makefile | 26 ++ {dupe => dodger/runtime}/main.c | 4 +- dodger/{ => runtime}/print.c | 0 dodger/{ => runtime}/print.h | 0 dodger/{ => runtime}/types.h | 0 dodger/{ => runtime}/types.rkt | 10 - dodger/{ => runtime}/values.c | 0 dodger/{ => runtime}/values.h | 0 dodger/{ => syntax}/ast.rkt | 0 dodger/{ => syntax}/parse.rkt | 0 dodger/{ => syntax}/random.rkt | 0 dodger/test/all.rkt | 57 --- dodger/test/compile.rkt | 8 +- dodger/test/interp.rkt | 4 +- dodger/test/parse.rkt | 4 +- dupe/Makefile | 3 +- dupe/compile-stdin.rkt | 13 - dupe/{ => compiler}/compile-ops.rkt | 4 +- dupe/compiler/compile-stdin.rkt | 13 + {dodger => dupe/compiler}/compile.rkt | 4 +- dupe/correct.rkt | 7 +- dupe/exec.rkt | 10 - dupe/executor/decode.rkt | 18 + dupe/executor/exec.rkt | 44 +++ dupe/executor/run-stdin.rkt | 12 + dupe/executor/run.rkt | 11 + dupe/interp-bits-wrap.rkt | 42 --- dupe/interp-bits.rkt | 18 - dupe/interp-prim-bits.rkt | 10 - dupe/interp-stdin.rkt | 12 - dupe/{ => interpreter}/interp-prim.rkt | 0 dupe/interpreter/interp-stdin.rkt | 12 + dupe/{ => interpreter}/interp.rkt | 2 +- dupe/main.rkt | 28 +- dupe/run-stdin.rkt | 12 - dupe/run.rkt | 15 - dupe/runtime/Makefile | 26 ++ {dodger => dupe/runtime}/main.c | 6 +- dupe/{ => runtime}/print.c | 0 dupe/{ => runtime}/print.h | 0 dupe/{ => runtime}/types.h | 0 dupe/{ => runtime}/types.rkt | 8 - dupe/{ => runtime}/values.c | 0 dupe/{ => runtime}/values.h | 0 dupe/semantics.rkt | 74 ---- dupe/{ => syntax}/ast.rkt | 0 dupe/{ => syntax}/parse.rkt | 0 dupe/{ => syntax}/random.rkt | 0 dupe/test/all.rkt | 47 --- dupe/test/compile.rkt | 8 +- dupe/test/interp.rkt | 4 +- dupe/test/parse.rkt | 4 +- evildoer/Makefile | 4 +- evildoer/build-runtime.rkt | 14 - evildoer/compile-stdin.rkt | 13 - evildoer/{ => compiler}/compile-ops.rkt | 4 +- evildoer/compiler/compile-stdin.rkt | 13 + evildoer/{ => compiler}/compile.rkt | 4 +- evildoer/correct.rkt | 7 +- evildoer/exec-io.rkt | 13 - evildoer/exec.rkt | 15 - evildoer/executor/decode.rkt | 22 ++ evildoer/executor/exec.rkt | 50 +++ evildoer/executor/run-stdin.rkt | 12 + evildoer/executor/run.rkt | 19 + evildoer/interp-stdin.rkt | 12 - evildoer/{ => interpreter}/interp-io.rkt | 0 evildoer/{ => interpreter}/interp-prim.rkt | 0 evildoer/interpreter/interp-stdin.rkt | 12 + evildoer/{ => interpreter}/interp.rkt | 2 +- evildoer/main.rkt | 32 +- evildoer/run-stdin.rkt | 12 - evildoer/run.rkt | 22 -- evildoer/runtime/Makefile | 27 ++ evildoer/{ => runtime}/gcd.c | 0 evildoer/{ => runtime}/io.c | 8 +- evildoer/runtime/main.c | 15 + evildoer/{ => runtime}/print.c | 0 evildoer/{ => runtime}/print.h | 0 evildoer/{ => runtime}/runtime.h | 3 +- evildoer/{ => runtime}/types.h | 0 {extort => evildoer/runtime}/types.rkt | 12 - evildoer/{ => runtime}/values.c | 0 evildoer/{ => runtime}/values.h | 0 evildoer/{ => syntax}/ast.rkt | 0 evildoer/{ => syntax}/parse.rkt | 0 evildoer/{ => syntax}/random.rkt | 0 evildoer/test/all.rkt | 90 ----- evildoer/test/compile.rkt | 10 +- evildoer/test/interp.rkt | 6 +- evildoer/test/parse.rkt | 4 +- extort/Makefile | 5 +- extort/build-runtime.rkt | 14 - extort/compile-stdin.rkt | 13 - extort/{ => compiler}/assert.rkt | 2 +- extort/{ => compiler}/compile-ops.rkt | 4 +- extort/compiler/compile-stdin.rkt | 13 + extort/{ => compiler}/compile.rkt | 4 +- extort/correct.rkt | 7 +- extort/exec-io.rkt | 14 - extort/exec.rkt | 15 - extort/executor/decode.rkt | 22 ++ extort/executor/exec.rkt | 54 +++ extort/executor/run-stdin.rkt | 12 + extort/executor/run.rkt | 20 + extort/interp-cps.rkt | 26 -- extort/interp-stdin.rkt | 12 - extort/{ => interpreter}/interp-io.rkt | 0 extort/{ => interpreter}/interp-prim.rkt | 0 extort/interpreter/interp-stdin.rkt | 12 + extort/{ => interpreter}/interp.rkt | 2 +- extort/main.c | 36 -- extort/main.rkt | 32 +- extort/run-stdin.rkt | 12 - extort/run.rkt | 24 -- extort/runtime.h | 10 - extort/runtime/Makefile | 28 ++ extort/runtime/error.c | 9 + {fraud => extort/runtime}/io.c | 8 +- {evildoer => extort/runtime}/main.c | 9 +- extort/{ => runtime}/print.c | 0 extort/{ => runtime}/print.h | 0 extort/runtime/runtime.h | 14 + extort/{ => runtime}/types.h | 0 {evildoer => extort/runtime}/types.rkt | 12 - extort/{ => runtime}/values.c | 0 extort/{ => runtime}/values.h | 0 extort/semantics.rkt | 75 ---- extort/{ => syntax}/ast.rkt | 0 extort/{ => syntax}/parse.rkt | 0 extort/{ => syntax}/random.rkt | 0 extort/test/all.rkt | 111 ------ extort/test/compile.rkt | 10 +- extort/test/interp.rkt | 6 +- extort/test/parse.rkt | 4 +- fraud/Makefile | 4 +- fraud/build-runtime.rkt | 14 - fraud/{ => compiler}/assert.rkt | 2 +- fraud/{ => compiler}/compile-ops.rkt | 4 +- fraud/{ => compiler}/compile-stdin.rkt | 2 +- fraud/{ => compiler}/compile.rkt | 4 +- fraud/correct.rkt | 7 +- fraud/correctness.rkt | 10 - fraud/exec-io.rkt | 14 - fraud/exec.rkt | 15 - fraud/executor/decode.rkt | 22 ++ fraud/executor/exec.rkt | 54 +++ fraud/executor/run-stdin.rkt | 12 + fraud/executor/run.rkt | 20 + fraud/interp-lexical.rkt | 42 --- fraud/{ => interpreter}/env.rkt | 0 fraud/{ => interpreter}/interp-io.rkt | 0 fraud/{ => interpreter}/interp-prim.rkt | 0 fraud/{ => interpreter}/interp-stdin.rkt | 2 +- fraud/{ => interpreter}/interp.rkt | 2 +- fraud/main.c | 36 -- fraud/main.rkt | 32 +- fraud/run-stdin.rkt | 12 - fraud/run.rkt | 24 -- fraud/runtime.h | 10 - fraud/runtime/Makefile | 28 ++ fraud/runtime/error.c | 9 + {hoax => fraud/runtime}/io.c | 8 +- fraud/runtime/main.c | 16 + fraud/{ => runtime}/print.c | 0 fraud/{ => runtime}/print.h | 0 fraud/runtime/runtime.h | 14 + fraud/{ => runtime}/types.h | 0 fraud/{ => runtime}/types.rkt | 12 - fraud/{ => runtime}/values.c | 0 fraud/{ => runtime}/values.h | 0 fraud/semantics.rkt | 297 --------------- fraud/{ => syntax}/ast.rkt | 0 fraud/{ => syntax}/parse.rkt | 0 fraud/{ => syntax}/random.rkt | 0 fraud/{ => syntax}/translate.rkt | 0 fraud/test/compile.rkt | 10 +- fraud/test/interp-lexical.rkt | 10 - fraud/test/interp.rkt | 6 +- fraud/test/parse.rkt | 4 +- fraud/test/test-progs.rkt | 4 - fraud/test/translate.rkt | 6 +- hoax/Makefile | 7 +- hoax/build-runtime.rkt | 14 - {iniquity => hoax/compiler}/assert.rkt | 2 +- {knock => hoax/compiler}/compile-ops.rkt | 8 +- hoax/{ => compiler}/compile-stdin.rkt | 2 +- hoax/{ => compiler}/compile.rkt | 4 +- hoax/correct.rkt | 7 +- hoax/exec-io.rkt | 14 - hoax/exec.rkt | 15 - knock/types.rkt => hoax/executor/decode.rkt | 55 +-- hoax/executor/exec.rkt | 55 +++ hoax/executor/run-stdin.rkt | 12 + hoax/executor/run.rkt | 20 + hoax/{ => interpreter}/env.rkt | 0 hoax/{ => interpreter}/heap-bits.rkt | 2 +- hoax/{ => interpreter}/heap.rkt | 0 hoax/{ => interpreter}/interp-heap-bits.rkt | 4 +- hoax/{ => interpreter}/interp-heap.rkt | 2 +- hoax/{ => interpreter}/interp-io.rkt | 0 hoax/{ => interpreter}/interp-prim.rkt | 0 .../interp-prims-heap-bits.rkt | 2 +- hoax/{ => interpreter}/interp-prims-heap.rkt | 0 hoax/{ => interpreter}/interp-stdin.rkt | 2 +- hoax/{ => interpreter}/interp.rkt | 2 +- hoax/{ => interpreter}/unload-bits.rkt | 3 +- hoax/{ => interpreter}/unload.rkt | 0 hoax/main.c | 40 -- hoax/main.rkt | 32 +- hoax/run-stdin.rkt | 12 - hoax/run.rkt | 24 -- hoax/runtime/Makefile | 28 ++ hoax/runtime/error.c | 9 + {extort => hoax/runtime}/io.c | 8 +- hoax/runtime/main.c | 26 ++ hoax/{ => runtime}/print.c | 0 hoax/{ => runtime}/print.h | 0 hoax/runtime/runtime.h | 14 + hoax/{ => runtime}/types.h | 0 {hustle => hoax/runtime}/types.rkt | 28 +- hoax/{ => runtime}/values.c | 0 hoax/{ => runtime}/values.h | 0 hoax/{ => syntax}/ast.rkt | 0 hoax/{ => syntax}/parse.rkt | 0 hoax/test/compile.rkt | 10 +- hoax/test/interp-heap-bits.rkt | 6 +- hoax/test/interp-heap.rkt | 6 +- hoax/test/interp.rkt | 6 +- hoax/test/parse.rkt | 4 +- hoax/test/test-progs.rkt | 6 - hustle/build-runtime.rkt | 14 - hustle/{ => compiler}/assert.rkt | 2 +- hustle/{ => compiler}/compile-ops.rkt | 4 +- hustle/{ => compiler}/compile-stdin.rkt | 2 +- hustle/{ => compiler}/compile.rkt | 4 +- hustle/correct.rkt | 7 +- hustle/correctness.rkt | 14 - hustle/exec-io.rkt | 14 - hustle/exec.rkt | 15 - hustle/executor/decode.rkt | 31 ++ hustle/executor/exec.rkt | 55 +++ hustle/executor/run-stdin.rkt | 12 + hustle/executor/run.rkt | 20 + hustle/{ => interpreter}/env.rkt | 0 hustle/{ => interpreter}/heap-bits.rkt | 2 +- hustle/{ => interpreter}/heap.rkt | 0 hustle/{ => interpreter}/interp-heap-bits.rkt | 4 +- hustle/{ => interpreter}/interp-heap.rkt | 2 +- hustle/{ => interpreter}/interp-io.rkt | 0 hustle/{ => interpreter}/interp-prim.rkt | 0 .../interp-prims-heap-bits.rkt | 2 +- .../{ => interpreter}/interp-prims-heap.rkt | 0 hustle/{ => interpreter}/interp-stdin.rkt | 2 +- hustle/{ => interpreter}/interp.rkt | 2 +- hustle/{ => interpreter}/unload-bits.rkt | 3 +- hustle/{ => interpreter}/unload.rkt | 0 hustle/io.c | 25 -- hustle/main.c | 40 -- hustle/main.rkt | 32 +- hustle/run-stdin.rkt | 12 - hustle/run.rkt | 24 -- hustle/runtime/Makefile | 28 ++ hustle/runtime/error.c | 9 + hustle/runtime/io.c | 25 ++ hustle/runtime/main.c | 26 ++ hustle/{ => runtime}/print.c | 0 hustle/{ => runtime}/print.h | 0 hustle/runtime/runtime.h | 14 + hustle/{ => runtime}/types.h | 0 hustle/runtime/types.rkt | 44 +++ hustle/{ => runtime}/values.c | 0 hustle/{ => runtime}/values.h | 0 hustle/semantics.rkt | 351 ------------------ hustle/{ => syntax}/ast.rkt | 0 hustle/{ => syntax}/parse.rkt | 0 hustle/{ => syntax}/random.rkt | 0 hustle/test/compile.rkt | 10 +- hustle/test/interp-heap-bits.rkt | 6 +- hustle/test/interp-heap.rkt | 6 +- hustle/test/interp.rkt | 6 +- hustle/test/parse.rkt | 4 +- iniquity/build-runtime.rkt | 14 - {hoax => iniquity/compiler}/assert.rkt | 2 +- {jig => iniquity/compiler}/compile-ops.rkt | 8 +- iniquity/{ => compiler}/compile-stdin.rkt | 4 +- iniquity/{ => compiler}/compile.rkt | 7 +- iniquity/correct.rkt | 7 +- iniquity/exec-io.rkt | 13 - iniquity/exec.rkt | 14 - iniquity/executor/decode.rkt | 45 +++ iniquity/executor/exec.rkt | 55 +++ iniquity/executor/run.rkt | 20 + iniquity/interp-prims.rkt | 69 ---- iniquity/{ => interpreter}/env.rkt | 0 iniquity/{ => interpreter}/interp-io.rkt | 0 iniquity/{ => interpreter}/interp-prim.rkt | 0 iniquity/{ => interpreter}/interp-stdin.rkt | 4 +- {jig => iniquity/interpreter}/interp.rkt | 2 +- iniquity/io.c | 25 -- iniquity/main.c | 41 -- iniquity/main.rkt | 32 +- iniquity/run.rkt | 24 -- iniquity/runtime.h | 15 - iniquity/runtime/Makefile | 28 ++ iniquity/runtime/error.c | 9 + iniquity/runtime/io.c | 25 ++ iniquity/runtime/main.c | 26 ++ iniquity/{ => runtime}/print.c | 0 iniquity/{ => runtime}/print.h | 0 iniquity/runtime/runtime.h | 14 + iniquity/{ => runtime}/types.h | 0 iniquity/{ => runtime}/types.rkt | 36 -- iniquity/{ => runtime}/values.c | 0 iniquity/{ => runtime}/values.h | 0 iniquity/{ => syntax}/ast.rkt | 0 iniquity/{ => syntax}/parse.rkt | 4 +- iniquity/{ => syntax}/read-all.rkt | 0 iniquity/test/all.rkt | 5 - iniquity/test/compile.rkt | 10 +- iniquity/test/interp.rkt | 6 +- iniquity/test/parse.rkt | 18 +- iniquity/test/test-runner.rkt | 6 + jig/build-runtime.rkt | 14 - jig/{ => compiler}/assert.rkt | 2 +- {hoax => jig/compiler}/compile-ops.rkt | 8 +- jig/{ => compiler}/compile-stdin.rkt | 4 +- jig/{ => compiler}/compile.rkt | 8 +- jig/correct.rkt | 7 +- jig/exec-io.rkt | 13 - jig/exec.rkt | 14 - jig/executor/decode.rkt | 45 +++ jig/executor/exec.rkt | 55 +++ jig/executor/run-stdin.rkt | 12 + jig/executor/run.rkt | 20 + jig/interp-prims.rkt | 69 ---- jig/{ => interpreter}/env.rkt | 0 jig/{ => interpreter}/interp-io.rkt | 0 jig/{ => interpreter}/interp-prim.rkt | 0 jig/{ => interpreter}/interp-stdin.rkt | 4 +- {iniquity => jig/interpreter}/interp.rkt | 2 +- jig/io.c | 25 -- jig/main.c | 40 -- jig/main.rkt | 32 +- jig/run-stdin.rkt | 12 - jig/run.rkt | 24 -- jig/runtime.h | 15 - jig/runtime/Makefile | 28 ++ jig/{ => runtime}/char.c | 0 jig/runtime/error.c | 9 + jig/{ => runtime}/heap.h | 0 jig/runtime/io.c | 25 ++ jig/runtime/main.c | 26 ++ jig/{ => runtime}/print.c | 0 jig/{ => runtime}/print.h | 0 jig/runtime/runtime.h | 14 + jig/{ => runtime}/types.h | 0 jig/{ => runtime}/types.rkt | 36 -- jig/{ => runtime}/values.c | 0 jig/{ => runtime}/values.h | 0 jig/{ => syntax}/ast.rkt | 0 jig/{ => syntax}/parse.rkt | 4 +- jig/{ => syntax}/read-all.rkt | 0 jig/test/build-runtime.rkt | 8 - jig/test/compile.rkt | 10 +- jig/test/interp.rkt | 6 +- jig/test/parse.rkt | 5 +- jig/test/test-progs.rkt | 6 - jig/test/test-runner.rkt | 6 + knock/build-runtime.rkt | 14 - knock/{ => compiler}/assert.rkt | 2 +- {iniquity => knock/compiler}/compile-ops.rkt | 8 +- knock/{ => compiler}/compile-stdin.rkt | 4 +- knock/{ => compiler}/compile.rkt | 8 +- knock/correct.rkt | 7 +- knock/exec-io.rkt | 13 - knock/exec.rkt | 14 - knock/executor/decode.rkt | 45 +++ knock/executor/exec.rkt | 55 +++ knock/executor/run-stdin.rkt | 12 + knock/executor/run.rkt | 20 + knock/interp-prims.rkt | 69 ---- knock/{ => interpreter}/env.rkt | 0 knock/{ => interpreter}/interp-io.rkt | 0 knock/{ => interpreter}/interp-prim.rkt | 0 knock/{ => interpreter}/interp-stdin.rkt | 4 +- knock/{ => interpreter}/interp.rkt | 2 +- knock/io.c | 25 -- knock/main.c | 40 -- knock/main.rkt | 32 +- knock/run-stdin.rkt | 12 - knock/run.rkt | 24 -- knock/runtime.h | 15 - knock/runtime/Makefile | 28 ++ knock/{ => runtime}/char.c | 0 knock/runtime/error.c | 9 + knock/{ => runtime}/gc.c | 0 knock/{ => runtime}/heap.h | 0 knock/runtime/io.c | 25 ++ knock/runtime/main.c | 26 ++ knock/{ => runtime}/print.c | 0 knock/{ => runtime}/print.h | 0 {hoax => knock/runtime}/runtime.h | 0 knock/{ => runtime}/types.h | 0 knock/runtime/types.rkt | 52 +++ knock/{ => runtime}/values.c | 0 knock/{ => runtime}/values.h | 0 knock/{ => syntax}/ast.rkt | 0 knock/{ => syntax}/parse.rkt | 20 +- knock/{ => syntax}/read-all.rkt | 0 knock/test/build-runtime.rkt | 8 - knock/test/compile.rkt | 10 +- knock/test/interp.rkt | 6 +- knock/test/parse.rkt | 5 +- knock/test/test-runner.rkt | 6 + loot/build-runtime.rkt | 14 - loot/{ => compiler}/assert.rkt | 2 +- loot/{ => compiler}/compile-ops.rkt | 8 +- loot/{ => compiler}/compile-stdin.rkt | 4 +- loot/{ => compiler}/compile.rkt | 12 +- loot/correct.rkt | 7 +- loot/exec-io.rkt | 13 - loot/exec.rkt | 14 - loot/{types.rkt => executor/decode.rkt} | 57 +-- loot/executor/exec.rkt | 55 +++ loot/executor/run-stdin.rkt | 12 + loot/executor/run.rkt | 20 + loot/interp-prims.rkt | 69 ---- loot/{ => interpreter}/env.rkt | 0 loot/{ => interpreter}/interp-defun.rkt | 2 +- loot/{ => interpreter}/interp-io.rkt | 0 loot/{ => interpreter}/interp-prim.rkt | 0 loot/{ => interpreter}/interp-stdin.rkt | 4 +- loot/{ => interpreter}/interp.rkt | 2 +- loot/io.c | 25 -- loot/main.c | 40 -- loot/main.rkt | 32 +- loot/parse-file.rkt | 13 - loot/run-stdin.rkt | 12 - loot/run.rkt | 24 -- loot/runtime.h | 15 - loot/runtime/Makefile | 28 ++ loot/{ => runtime}/char.c | 0 loot/runtime/error.c | 9 + loot/{ => runtime}/heap.h | 0 loot/runtime/io.c | 25 ++ loot/runtime/main.c | 26 ++ loot/{ => runtime}/print.c | 0 loot/{ => runtime}/print.h | 0 {hustle => loot/runtime}/runtime.h | 0 loot/{ => runtime}/types.h | 0 {hoax => loot/runtime}/types.rkt | 38 +- loot/{ => runtime}/values.c | 0 loot/{ => runtime}/values.h | 0 loot/{ => syntax}/ast.rkt | 0 loot/{ => syntax}/fv.rkt | 0 loot/{ => syntax}/lambdas.rkt | 0 loot/{ => syntax}/parse.rkt | 18 +- loot/{ => syntax}/read-all.rkt | 0 loot/test/build-runtime.rkt | 8 - loot/test/compile.rkt | 10 +- loot/test/interp.rkt | 6 +- loot/test/parse.rkt | 6 +- loot/test/test-runner.rkt | 6 + neerdowell/Makefile | 6 +- 551 files changed, 3037 insertions(+), 4063 deletions(-) rename abscond/{ => compiler}/compile-stdin.rkt (88%) rename abscond/{ => compiler}/compile.rkt (90%) delete mode 100644 abscond/exec.rkt create mode 100644 abscond/executor/exec.rkt rename {blackmail => abscond/executor}/run-stdin.rkt (75%) create mode 100644 abscond/executor/run.rkt rename {blackmail => abscond/interpreter}/interp-stdin.rkt (87%) rename abscond/{ => interpreter}/interp.rkt (76%) delete mode 100644 abscond/run.rkt create mode 100644 abscond/runtime/Makefile rename abscond/{ => runtime}/main.c (81%) rename abscond/{ => runtime}/print.c (100%) rename abscond/{ => runtime}/print.h (100%) rename abscond/{ => syntax}/ast.rkt (100%) rename abscond/{ => syntax}/parse.rkt (100%) rename {con => blackmail/compiler}/compile-ops.rkt (84%) rename {con => blackmail/compiler}/compile-stdin.rkt (88%) rename blackmail/{ => compiler}/compile.rkt (93%) delete mode 100644 blackmail/exec.rkt create mode 100644 blackmail/executor/exec.rkt rename {abscond => blackmail/executor}/run-stdin.rkt (75%) create mode 100644 blackmail/executor/run.rkt rename blackmail/{ => interpreter}/interp-prim.rkt (100%) rename {con => blackmail/interpreter}/interp-stdin.rkt (87%) rename blackmail/{ => interpreter}/interp.rkt (85%) delete mode 100644 blackmail/run.rkt create mode 100644 blackmail/runtime/Makefile rename blackmail/{ => runtime}/main.c (81%) rename blackmail/{ => runtime}/print.c (100%) rename blackmail/{ => runtime}/print.h (100%) delete mode 100644 blackmail/semantics.rkt rename blackmail/{ => syntax}/ast.rkt (100%) rename blackmail/{ => syntax}/parse.rkt (100%) rename blackmail/{ => syntax}/random.rkt (100%) rename {blackmail => con/compiler}/compile-ops.rkt (84%) rename {blackmail => con/compiler}/compile-stdin.rkt (88%) rename con/{ => compiler}/compile.rkt (96%) delete mode 100644 con/exec.rkt create mode 100644 con/executor/exec.rkt rename con/{ => executor}/run-stdin.rkt (75%) create mode 100644 con/executor/run.rkt rename con/{ => interpreter}/interp-prim.rkt (100%) rename {dodger => con/interpreter}/interp-stdin.rkt (87%) rename con/{ => interpreter}/interp.rkt (90%) delete mode 100644 con/run.rkt create mode 100644 con/runtime/Makefile rename con/{ => runtime}/main.c (81%) rename con/{ => runtime}/print.c (100%) rename con/{ => runtime}/print.h (100%) delete mode 100644 con/semantics.rkt rename con/{ => syntax}/ast.rkt (100%) rename con/{ => syntax}/parse.rkt (100%) rename con/{ => syntax}/random.rkt (93%) delete mode 100644 con/types.rkt rename dodger/{ => compiler}/compile-ops.rkt (92%) rename dodger/{ => compiler}/compile-stdin.rkt (88%) rename {dupe => dodger/compiler}/compile.rkt (93%) delete mode 100644 dodger/exec.rkt create mode 100644 dodger/executor/decode.rkt create mode 100644 dodger/executor/exec.rkt rename dodger/{ => executor}/run-stdin.rkt (75%) create mode 100644 dodger/executor/run.rkt delete mode 100644 dodger/interp-bits.rkt rename dodger/{ => interpreter}/interp-prim.rkt (100%) rename {abscond => dodger/interpreter}/interp-stdin.rkt (87%) rename dodger/{ => interpreter}/interp.rkt (91%) delete mode 100644 dodger/run.rkt create mode 100644 dodger/runtime/Makefile rename {dupe => dodger/runtime}/main.c (81%) rename dodger/{ => runtime}/print.c (100%) rename dodger/{ => runtime}/print.h (100%) rename dodger/{ => runtime}/types.h (100%) rename dodger/{ => runtime}/types.rkt (65%) rename dodger/{ => runtime}/values.c (100%) rename dodger/{ => runtime}/values.h (100%) rename dodger/{ => syntax}/ast.rkt (100%) rename dodger/{ => syntax}/parse.rkt (100%) rename dodger/{ => syntax}/random.rkt (100%) delete mode 100644 dodger/test/all.rkt delete mode 100644 dupe/compile-stdin.rkt rename dupe/{ => compiler}/compile-ops.rkt (84%) create mode 100644 dupe/compiler/compile-stdin.rkt rename {dodger => dupe/compiler}/compile.rkt (93%) delete mode 100644 dupe/exec.rkt create mode 100644 dupe/executor/decode.rkt create mode 100644 dupe/executor/exec.rkt create mode 100644 dupe/executor/run-stdin.rkt create mode 100644 dupe/executor/run.rkt delete mode 100644 dupe/interp-bits-wrap.rkt delete mode 100644 dupe/interp-bits.rkt delete mode 100644 dupe/interp-prim-bits.rkt delete mode 100644 dupe/interp-stdin.rkt rename dupe/{ => interpreter}/interp-prim.rkt (100%) create mode 100644 dupe/interpreter/interp-stdin.rkt rename dupe/{ => interpreter}/interp.rkt (90%) delete mode 100644 dupe/run-stdin.rkt delete mode 100644 dupe/run.rkt create mode 100644 dupe/runtime/Makefile rename {dodger => dupe/runtime}/main.c (67%) rename dupe/{ => runtime}/print.c (100%) rename dupe/{ => runtime}/print.h (100%) rename dupe/{ => runtime}/types.h (100%) rename dupe/{ => runtime}/types.rkt (59%) rename dupe/{ => runtime}/values.c (100%) rename dupe/{ => runtime}/values.h (100%) delete mode 100644 dupe/semantics.rkt rename dupe/{ => syntax}/ast.rkt (100%) rename dupe/{ => syntax}/parse.rkt (100%) rename dupe/{ => syntax}/random.rkt (100%) delete mode 100644 dupe/test/all.rkt delete mode 100644 evildoer/build-runtime.rkt delete mode 100644 evildoer/compile-stdin.rkt rename evildoer/{ => compiler}/compile-ops.rkt (94%) create mode 100644 evildoer/compiler/compile-stdin.rkt rename evildoer/{ => compiler}/compile.rkt (94%) delete mode 100644 evildoer/exec-io.rkt delete mode 100644 evildoer/exec.rkt create mode 100644 evildoer/executor/decode.rkt create mode 100644 evildoer/executor/exec.rkt create mode 100644 evildoer/executor/run-stdin.rkt create mode 100644 evildoer/executor/run.rkt delete mode 100644 evildoer/interp-stdin.rkt rename evildoer/{ => interpreter}/interp-io.rkt (100%) rename evildoer/{ => interpreter}/interp-prim.rkt (100%) create mode 100644 evildoer/interpreter/interp-stdin.rkt rename evildoer/{ => interpreter}/interp.rkt (93%) delete mode 100644 evildoer/run-stdin.rkt delete mode 100644 evildoer/run.rkt create mode 100644 evildoer/runtime/Makefile rename evildoer/{ => runtime}/gcd.c (100%) rename evildoer/{ => runtime}/io.c (74%) create mode 100644 evildoer/runtime/main.c rename evildoer/{ => runtime}/print.c (100%) rename evildoer/{ => runtime}/print.h (100%) rename evildoer/{ => runtime}/runtime.h (73%) rename evildoer/{ => runtime}/types.h (100%) rename {extort => evildoer/runtime}/types.rkt (62%) rename evildoer/{ => runtime}/values.c (100%) rename evildoer/{ => runtime}/values.h (100%) rename evildoer/{ => syntax}/ast.rkt (100%) rename evildoer/{ => syntax}/parse.rkt (100%) rename evildoer/{ => syntax}/random.rkt (100%) delete mode 100644 evildoer/test/all.rkt delete mode 100644 extort/build-runtime.rkt delete mode 100644 extort/compile-stdin.rkt rename extort/{ => compiler}/assert.rkt (96%) rename extort/{ => compiler}/compile-ops.rkt (95%) create mode 100644 extort/compiler/compile-stdin.rkt rename extort/{ => compiler}/compile.rkt (95%) delete mode 100644 extort/exec-io.rkt delete mode 100644 extort/exec.rkt create mode 100644 extort/executor/decode.rkt create mode 100644 extort/executor/exec.rkt create mode 100644 extort/executor/run-stdin.rkt create mode 100644 extort/executor/run.rkt delete mode 100644 extort/interp-cps.rkt delete mode 100644 extort/interp-stdin.rkt rename extort/{ => interpreter}/interp-io.rkt (100%) rename extort/{ => interpreter}/interp-prim.rkt (100%) create mode 100644 extort/interpreter/interp-stdin.rkt rename extort/{ => interpreter}/interp.rkt (95%) delete mode 100644 extort/main.c delete mode 100644 extort/run-stdin.rkt delete mode 100644 extort/run.rkt delete mode 100644 extort/runtime.h create mode 100644 extort/runtime/Makefile create mode 100644 extort/runtime/error.c rename {fraud => extort/runtime}/io.c (74%) rename {evildoer => extort/runtime}/main.c (70%) rename extort/{ => runtime}/print.c (100%) rename extort/{ => runtime}/print.h (100%) create mode 100644 extort/runtime/runtime.h rename extort/{ => runtime}/types.h (100%) rename {evildoer => extort/runtime}/types.rkt (62%) rename extort/{ => runtime}/values.c (100%) rename extort/{ => runtime}/values.h (100%) delete mode 100644 extort/semantics.rkt rename extort/{ => syntax}/ast.rkt (100%) rename extort/{ => syntax}/parse.rkt (100%) rename extort/{ => syntax}/random.rkt (100%) delete mode 100644 extort/test/all.rkt delete mode 100644 fraud/build-runtime.rkt rename fraud/{ => compiler}/assert.rkt (96%) rename fraud/{ => compiler}/compile-ops.rkt (97%) rename fraud/{ => compiler}/compile-stdin.rkt (88%) rename fraud/{ => compiler}/compile.rkt (97%) delete mode 100644 fraud/correctness.rkt delete mode 100644 fraud/exec-io.rkt delete mode 100644 fraud/exec.rkt create mode 100644 fraud/executor/decode.rkt create mode 100644 fraud/executor/exec.rkt create mode 100644 fraud/executor/run-stdin.rkt create mode 100644 fraud/executor/run.rkt delete mode 100644 fraud/interp-lexical.rkt rename fraud/{ => interpreter}/env.rkt (100%) rename fraud/{ => interpreter}/interp-io.rkt (100%) rename fraud/{ => interpreter}/interp-prim.rkt (100%) rename fraud/{ => interpreter}/interp-stdin.rkt (87%) rename fraud/{ => interpreter}/interp.rkt (97%) delete mode 100644 fraud/main.c delete mode 100644 fraud/run-stdin.rkt delete mode 100644 fraud/run.rkt delete mode 100644 fraud/runtime.h create mode 100644 fraud/runtime/Makefile create mode 100644 fraud/runtime/error.c rename {hoax => fraud/runtime}/io.c (74%) create mode 100644 fraud/runtime/main.c rename fraud/{ => runtime}/print.c (100%) rename fraud/{ => runtime}/print.h (100%) create mode 100644 fraud/runtime/runtime.h rename fraud/{ => runtime}/types.h (100%) rename fraud/{ => runtime}/types.rkt (62%) rename fraud/{ => runtime}/values.c (100%) rename fraud/{ => runtime}/values.h (100%) delete mode 100644 fraud/semantics.rkt rename fraud/{ => syntax}/ast.rkt (100%) rename fraud/{ => syntax}/parse.rkt (100%) rename fraud/{ => syntax}/random.rkt (100%) rename fraud/{ => syntax}/translate.rkt (100%) delete mode 100644 fraud/test/interp-lexical.rkt delete mode 100644 fraud/test/test-progs.rkt delete mode 100644 hoax/build-runtime.rkt rename {iniquity => hoax/compiler}/assert.rkt (97%) rename {knock => hoax/compiler}/compile-ops.rkt (97%) rename hoax/{ => compiler}/compile-stdin.rkt (88%) rename hoax/{ => compiler}/compile.rkt (98%) delete mode 100644 hoax/exec-io.rkt delete mode 100644 hoax/exec.rkt rename knock/types.rkt => hoax/executor/decode.rkt (50%) create mode 100644 hoax/executor/exec.rkt create mode 100644 hoax/executor/run-stdin.rkt create mode 100644 hoax/executor/run.rkt rename hoax/{ => interpreter}/env.rkt (100%) rename hoax/{ => interpreter}/heap-bits.rkt (98%) rename hoax/{ => interpreter}/heap.rkt (100%) rename hoax/{ => interpreter}/interp-heap-bits.rkt (97%) rename hoax/{ => interpreter}/interp-heap.rkt (98%) rename hoax/{ => interpreter}/interp-io.rkt (100%) rename hoax/{ => interpreter}/interp-prim.rkt (100%) rename hoax/{ => interpreter}/interp-prims-heap-bits.rkt (99%) rename hoax/{ => interpreter}/interp-prims-heap.rkt (100%) rename hoax/{ => interpreter}/interp-stdin.rkt (87%) rename hoax/{ => interpreter}/interp.rkt (97%) rename hoax/{ => interpreter}/unload-bits.rkt (93%) rename hoax/{ => interpreter}/unload.rkt (100%) delete mode 100644 hoax/main.c delete mode 100644 hoax/run-stdin.rkt delete mode 100644 hoax/run.rkt create mode 100644 hoax/runtime/Makefile create mode 100644 hoax/runtime/error.c rename {extort => hoax/runtime}/io.c (74%) create mode 100644 hoax/runtime/main.c rename hoax/{ => runtime}/print.c (100%) rename hoax/{ => runtime}/print.h (100%) create mode 100644 hoax/runtime/runtime.h rename hoax/{ => runtime}/types.h (100%) rename {hustle => hoax/runtime}/types.rkt (60%) rename hoax/{ => runtime}/values.c (100%) rename hoax/{ => runtime}/values.h (100%) rename hoax/{ => syntax}/ast.rkt (100%) rename hoax/{ => syntax}/parse.rkt (100%) delete mode 100644 hoax/test/test-progs.rkt delete mode 100644 hustle/build-runtime.rkt rename hustle/{ => compiler}/assert.rkt (97%) rename hustle/{ => compiler}/compile-ops.rkt (98%) rename hustle/{ => compiler}/compile-stdin.rkt (88%) rename hustle/{ => compiler}/compile.rkt (97%) delete mode 100644 hustle/correctness.rkt delete mode 100644 hustle/exec-io.rkt delete mode 100644 hustle/exec.rkt create mode 100644 hustle/executor/decode.rkt create mode 100644 hustle/executor/exec.rkt create mode 100644 hustle/executor/run-stdin.rkt create mode 100644 hustle/executor/run.rkt rename hustle/{ => interpreter}/env.rkt (100%) rename hustle/{ => interpreter}/heap-bits.rkt (95%) rename hustle/{ => interpreter}/heap.rkt (100%) rename hustle/{ => interpreter}/interp-heap-bits.rkt (96%) rename hustle/{ => interpreter}/interp-heap.rkt (98%) rename hustle/{ => interpreter}/interp-io.rkt (100%) rename hustle/{ => interpreter}/interp-prim.rkt (100%) rename hustle/{ => interpreter}/interp-prims-heap-bits.rkt (98%) rename hustle/{ => interpreter}/interp-prims-heap.rkt (100%) rename hustle/{ => interpreter}/interp-stdin.rkt (87%) rename hustle/{ => interpreter}/interp.rkt (97%) rename hustle/{ => interpreter}/unload-bits.rkt (88%) rename hustle/{ => interpreter}/unload.rkt (100%) delete mode 100644 hustle/io.c delete mode 100644 hustle/main.c delete mode 100644 hustle/run-stdin.rkt delete mode 100644 hustle/run.rkt create mode 100644 hustle/runtime/Makefile create mode 100644 hustle/runtime/error.c create mode 100644 hustle/runtime/io.c create mode 100644 hustle/runtime/main.c rename hustle/{ => runtime}/print.c (100%) rename hustle/{ => runtime}/print.h (100%) create mode 100644 hustle/runtime/runtime.h rename hustle/{ => runtime}/types.h (100%) create mode 100644 hustle/runtime/types.rkt rename hustle/{ => runtime}/values.c (100%) rename hustle/{ => runtime}/values.h (100%) delete mode 100644 hustle/semantics.rkt rename hustle/{ => syntax}/ast.rkt (100%) rename hustle/{ => syntax}/parse.rkt (100%) rename hustle/{ => syntax}/random.rkt (100%) delete mode 100644 iniquity/build-runtime.rkt rename {hoax => iniquity/compiler}/assert.rkt (97%) rename {jig => iniquity/compiler}/compile-ops.rkt (97%) rename iniquity/{ => compiler}/compile-stdin.rkt (79%) rename iniquity/{ => compiler}/compile.rkt (96%) delete mode 100644 iniquity/exec-io.rkt delete mode 100644 iniquity/exec.rkt create mode 100644 iniquity/executor/decode.rkt create mode 100644 iniquity/executor/exec.rkt create mode 100644 iniquity/executor/run.rkt delete mode 100644 iniquity/interp-prims.rkt rename iniquity/{ => interpreter}/env.rkt (100%) rename iniquity/{ => interpreter}/interp-io.rkt (100%) rename iniquity/{ => interpreter}/interp-prim.rkt (100%) rename iniquity/{ => interpreter}/interp-stdin.rkt (78%) rename {jig => iniquity/interpreter}/interp.rkt (98%) delete mode 100644 iniquity/io.c delete mode 100644 iniquity/main.c delete mode 100644 iniquity/run.rkt delete mode 100644 iniquity/runtime.h create mode 100644 iniquity/runtime/Makefile create mode 100644 iniquity/runtime/error.c create mode 100644 iniquity/runtime/io.c create mode 100644 iniquity/runtime/main.c rename iniquity/{ => runtime}/print.c (100%) rename iniquity/{ => runtime}/print.h (100%) create mode 100644 iniquity/runtime/runtime.h rename iniquity/{ => runtime}/types.h (100%) rename iniquity/{ => runtime}/types.rkt (51%) rename iniquity/{ => runtime}/values.c (100%) rename iniquity/{ => runtime}/values.h (100%) rename iniquity/{ => syntax}/ast.rkt (100%) rename iniquity/{ => syntax}/parse.rkt (98%) rename iniquity/{ => syntax}/read-all.rkt (100%) delete mode 100644 iniquity/test/all.rkt delete mode 100644 jig/build-runtime.rkt rename jig/{ => compiler}/assert.rkt (97%) rename {hoax => jig/compiler}/compile-ops.rkt (97%) rename jig/{ => compiler}/compile-stdin.rkt (79%) rename jig/{ => compiler}/compile.rkt (95%) delete mode 100644 jig/exec-io.rkt delete mode 100644 jig/exec.rkt create mode 100644 jig/executor/decode.rkt create mode 100644 jig/executor/exec.rkt create mode 100644 jig/executor/run-stdin.rkt create mode 100644 jig/executor/run.rkt delete mode 100644 jig/interp-prims.rkt rename jig/{ => interpreter}/env.rkt (100%) rename jig/{ => interpreter}/interp-io.rkt (100%) rename jig/{ => interpreter}/interp-prim.rkt (100%) rename jig/{ => interpreter}/interp-stdin.rkt (78%) rename {iniquity => jig/interpreter}/interp.rkt (98%) delete mode 100644 jig/io.c delete mode 100644 jig/main.c delete mode 100644 jig/run-stdin.rkt delete mode 100644 jig/run.rkt delete mode 100644 jig/runtime.h create mode 100644 jig/runtime/Makefile rename jig/{ => runtime}/char.c (100%) create mode 100644 jig/runtime/error.c rename jig/{ => runtime}/heap.h (100%) create mode 100644 jig/runtime/io.c create mode 100644 jig/runtime/main.c rename jig/{ => runtime}/print.c (100%) rename jig/{ => runtime}/print.h (100%) create mode 100644 jig/runtime/runtime.h rename jig/{ => runtime}/types.h (100%) rename jig/{ => runtime}/types.rkt (51%) rename jig/{ => runtime}/values.c (100%) rename jig/{ => runtime}/values.h (100%) rename jig/{ => syntax}/ast.rkt (100%) rename jig/{ => syntax}/parse.rkt (98%) rename jig/{ => syntax}/read-all.rkt (100%) delete mode 100644 jig/test/build-runtime.rkt delete mode 100644 jig/test/test-progs.rkt delete mode 100644 knock/build-runtime.rkt rename knock/{ => compiler}/assert.rkt (97%) rename {iniquity => knock/compiler}/compile-ops.rkt (97%) rename knock/{ => compiler}/compile-stdin.rkt (79%) rename knock/{ => compiler}/compile.rkt (97%) delete mode 100644 knock/exec-io.rkt delete mode 100644 knock/exec.rkt create mode 100644 knock/executor/decode.rkt create mode 100644 knock/executor/exec.rkt create mode 100644 knock/executor/run-stdin.rkt create mode 100644 knock/executor/run.rkt delete mode 100644 knock/interp-prims.rkt rename knock/{ => interpreter}/env.rkt (100%) rename knock/{ => interpreter}/interp-io.rkt (100%) rename knock/{ => interpreter}/interp-prim.rkt (100%) rename knock/{ => interpreter}/interp-stdin.rkt (78%) rename knock/{ => interpreter}/interp.rkt (99%) delete mode 100644 knock/io.c delete mode 100644 knock/main.c delete mode 100644 knock/run-stdin.rkt delete mode 100644 knock/run.rkt delete mode 100644 knock/runtime.h create mode 100644 knock/runtime/Makefile rename knock/{ => runtime}/char.c (100%) create mode 100644 knock/runtime/error.c rename knock/{ => runtime}/gc.c (100%) rename knock/{ => runtime}/heap.h (100%) create mode 100644 knock/runtime/io.c create mode 100644 knock/runtime/main.c rename knock/{ => runtime}/print.c (100%) rename knock/{ => runtime}/print.h (100%) rename {hoax => knock/runtime}/runtime.h (100%) rename knock/{ => runtime}/types.h (100%) create mode 100644 knock/runtime/types.rkt rename knock/{ => runtime}/values.c (100%) rename knock/{ => runtime}/values.h (100%) rename knock/{ => syntax}/ast.rkt (100%) rename knock/{ => syntax}/parse.rkt (95%) rename knock/{ => syntax}/read-all.rkt (100%) delete mode 100644 knock/test/build-runtime.rkt delete mode 100644 loot/build-runtime.rkt rename loot/{ => compiler}/assert.rkt (97%) rename loot/{ => compiler}/compile-ops.rkt (97%) rename loot/{ => compiler}/compile-stdin.rkt (79%) rename loot/{ => compiler}/compile.rkt (97%) delete mode 100644 loot/exec-io.rkt delete mode 100644 loot/exec.rkt rename loot/{types.rkt => executor/decode.rkt} (50%) create mode 100644 loot/executor/exec.rkt create mode 100644 loot/executor/run-stdin.rkt create mode 100644 loot/executor/run.rkt delete mode 100644 loot/interp-prims.rkt rename loot/{ => interpreter}/env.rkt (100%) rename loot/{ => interpreter}/interp-defun.rkt (99%) rename loot/{ => interpreter}/interp-io.rkt (100%) rename loot/{ => interpreter}/interp-prim.rkt (100%) rename loot/{ => interpreter}/interp-stdin.rkt (78%) rename loot/{ => interpreter}/interp.rkt (99%) delete mode 100644 loot/io.c delete mode 100644 loot/main.c delete mode 100644 loot/parse-file.rkt delete mode 100644 loot/run-stdin.rkt delete mode 100644 loot/run.rkt delete mode 100644 loot/runtime.h create mode 100644 loot/runtime/Makefile rename loot/{ => runtime}/char.c (100%) create mode 100644 loot/runtime/error.c rename loot/{ => runtime}/heap.h (100%) create mode 100644 loot/runtime/io.c create mode 100644 loot/runtime/main.c rename loot/{ => runtime}/print.c (100%) rename loot/{ => runtime}/print.h (100%) rename {hustle => loot/runtime}/runtime.h (100%) rename loot/{ => runtime}/types.h (100%) rename {hoax => loot/runtime}/types.rkt (51%) rename loot/{ => runtime}/values.c (100%) rename loot/{ => runtime}/values.h (100%) rename loot/{ => syntax}/ast.rkt (100%) rename loot/{ => syntax}/fv.rkt (100%) rename loot/{ => syntax}/lambdas.rkt (100%) rename loot/{ => syntax}/parse.rkt (95%) rename loot/{ => syntax}/read-all.rkt (100%) delete mode 100644 loot/test/build-runtime.rkt diff --git a/abscond/Makefile b/abscond/Makefile index 5205a2f..2d442f8 100644 --- a/abscond/Makefile +++ b/abscond/Makefile @@ -6,30 +6,33 @@ else LANGS_AS ?= clang -c endif -objs = \ - main.o \ - print.o +RACKET ?= racket -default: runtime.o +RUNTIME_DIR := runtime +RUNTIME := $(RUNTIME_DIR)/runtime.o -runtime.o: $(objs) - ld -r $(objs) -o runtime.o +# Example source extension for this language. +SRC_EXT := rkt -%.run: %.o runtime.o - $(LANGS_CC) runtime.o $< -o $@ +default: + @echo "example: make foo.run" -.c.o: - $(LANGS_CC) -fPIC -c -g -o $@ $< +# Build the runtime bundles if needed. +$(RUNTIME): + $(MAKE) -C $(RUNTIME_DIR) -.s.o: +# Compile source program to assembly. +%.s: %.$(SRC_EXT) + cat $< | $(RACKET) -t compiler/compile-stdin.rkt -m > $@ + +# Assemble to object. +%.o: %.s $(LANGS_AS) -o $@ $< -%.s: %.rkt - cat $< | racket -t compile-stdin.rkt -m > $@ +# Link standalone executable. +%.run: %.o $(RUNTIME) + $(LANGS_CC) -o $@ $^ clean: @$(RM) *.o *.s *.run ||: - @echo "$(shell basename $(shell pwd)): cleaned!" - -%.test: %.run %.rkt - @test "$(shell ./$(<))" = "$(shell racket $(word 2,$^))" + @$(MAKE) -C $(RUNTIME_DIR) clean diff --git a/abscond/compile-stdin.rkt b/abscond/compiler/compile-stdin.rkt similarity index 88% rename from abscond/compile-stdin.rkt rename to abscond/compiler/compile-stdin.rkt index 532ee0e..a11acf3 100644 --- a/abscond/compile-stdin.rkt +++ b/abscond/compiler/compile-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "compile.rkt") (require a86/printer) diff --git a/abscond/compile.rkt b/abscond/compiler/compile.rkt similarity index 90% rename from abscond/compile.rkt rename to abscond/compiler/compile.rkt index a216676..e67640c 100644 --- a/abscond/compile.rkt +++ b/abscond/compiler/compile.rkt @@ -2,7 +2,7 @@ (provide compile compile-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require a86/ast a86/registers) ;; Expr -> Asm diff --git a/abscond/correct.rkt b/abscond/correct.rkt index bbbacf9..9ee319c 100644 --- a/abscond/correct.rkt +++ b/abscond/correct.rkt @@ -1,11 +1,12 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp.rkt") -(require "exec.rkt") +(require "interpreter/interp.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; Expr -> Void (define (check-compiler e) (check-equal? (interp e) - (exec e))) + (run (compile e)))) diff --git a/abscond/exec.rkt b/abscond/exec.rkt deleted file mode 100644 index 408672f..0000000 --- a/abscond/exec.rkt +++ /dev/null @@ -1,10 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(provide exec) - -;; Expr -> Integer -(define (exec e) - (run (compile e))) - diff --git a/abscond/executor/exec.rkt b/abscond/executor/exec.rkt new file mode 100644 index 0000000..7800ef5 --- /dev/null +++ b/abscond/executor/exec.rkt @@ -0,0 +1,44 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) + +(struct exec-state (program) #:transparent) + +(define _val _int64) + +(define (exec/state prog) + (exec-state + (asm-load prog))) + +(define (exec-call st) + (match-define (exec-state program) st) + (asm-call program 'entry)) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/blackmail/run-stdin.rkt b/abscond/executor/run-stdin.rkt similarity index 75% rename from blackmail/run-stdin.rkt rename to abscond/executor/run-stdin.rkt index 16cf99e..7e7170f 100644 --- a/blackmail/run-stdin.rkt +++ b/abscond/executor/run-stdin.rkt @@ -1,7 +1,7 @@ #lang racket (provide main) -(require "parse.rkt") -(require "compile.rkt") +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") (require "run.rkt") ;; -> Void diff --git a/abscond/executor/run.rkt b/abscond/executor/run.rkt new file mode 100644 index 0000000..39c354a --- /dev/null +++ b/abscond/executor/run.rkt @@ -0,0 +1,11 @@ +#lang racket +(require a86/interp) +(require "exec.rkt") +(provide run) + +;; Asm -> Integer +(define (run asm) + (call-with-exec + asm + identity)) + diff --git a/blackmail/interp-stdin.rkt b/abscond/interpreter/interp-stdin.rkt similarity index 87% rename from blackmail/interp-stdin.rkt rename to abscond/interpreter/interp-stdin.rkt index ce4885f..e620f5c 100644 --- a/blackmail/interp-stdin.rkt +++ b/abscond/interpreter/interp-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "interp.rkt") ;; -> Void diff --git a/abscond/interp.rkt b/abscond/interpreter/interp.rkt similarity index 76% rename from abscond/interp.rkt rename to abscond/interpreter/interp.rkt index 0cfe6c4..b3441d6 100644 --- a/abscond/interp.rkt +++ b/abscond/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp) -(require "ast.rkt") +(require "../syntax/ast.rkt") ;; Expr -> Integer (define (interp e) diff --git a/abscond/main.rkt b/abscond/main.rkt index 9a97f8b..16c671d 100644 --- a/abscond/main.rkt +++ b/abscond/main.rkt @@ -1,14 +1,14 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "compile.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "compiler/compile.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/abscond/run.rkt b/abscond/run.rkt deleted file mode 100644 index 33c496c..0000000 --- a/abscond/run.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(require a86/interp) -(provide run) - -;; Run instructions with run-time system linked in -;; Asm -> Integer -(define (run is) - (asm-interp is)) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - - diff --git a/abscond/runtime/Makefile b/abscond/runtime/Makefile new file mode 100644 index 0000000..8b22999 --- /dev/null +++ b/abscond/runtime/Makefile @@ -0,0 +1,25 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/abscond/main.c b/abscond/runtime/main.c similarity index 81% rename from abscond/main.c rename to abscond/runtime/main.c index 2e030ba..4c8ad77 100644 --- a/abscond/main.c +++ b/abscond/runtime/main.c @@ -6,9 +6,7 @@ int64_t entry(); int main(int argc, char** argv) { - int64_t result; - - result = entry(); + int64_t result = entry(); print_result(result); putchar('\n'); return 0; diff --git a/abscond/print.c b/abscond/runtime/print.c similarity index 100% rename from abscond/print.c rename to abscond/runtime/print.c diff --git a/abscond/print.h b/abscond/runtime/print.h similarity index 100% rename from abscond/print.h rename to abscond/runtime/print.h diff --git a/abscond/ast.rkt b/abscond/syntax/ast.rkt similarity index 100% rename from abscond/ast.rkt rename to abscond/syntax/ast.rkt diff --git a/abscond/parse.rkt b/abscond/syntax/parse.rkt similarity index 100% rename from abscond/parse.rkt rename to abscond/syntax/parse.rkt diff --git a/abscond/test/compile.rkt b/abscond/test/compile.rkt index cf7ce11..db295e3 100644 --- a/abscond/test/compile.rkt +++ b/abscond/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ (e) (exec (parse e)))) +(test (λ (e) (run (compile (parse e))))) diff --git a/abscond/test/interp.rkt b/abscond/test/interp.rkt index dc33c12..4ed7882 100644 --- a/abscond/test/interp.rkt +++ b/abscond/test/interp.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../interp.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ (e) (interp (parse e)))) diff --git a/abscond/test/parse.rkt b/abscond/test/parse.rkt index 2fabd5f..cd5974f 100644 --- a/abscond/test/parse.rkt +++ b/abscond/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) diff --git a/con/compile-ops.rkt b/blackmail/compiler/compile-ops.rkt similarity index 84% rename from con/compile-ops.rkt rename to blackmail/compiler/compile-ops.rkt index dc1119b..a6e9b97 100644 --- a/con/compile-ops.rkt +++ b/blackmail/compiler/compile-ops.rkt @@ -1,6 +1,6 @@ #lang racket (provide compile-op1) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require a86/ast a86/registers) ;; Op1 -> Asm diff --git a/con/compile-stdin.rkt b/blackmail/compiler/compile-stdin.rkt similarity index 88% rename from con/compile-stdin.rkt rename to blackmail/compiler/compile-stdin.rkt index 532ee0e..a11acf3 100644 --- a/con/compile-stdin.rkt +++ b/blackmail/compiler/compile-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "compile.rkt") (require a86/printer) diff --git a/blackmail/compile.rkt b/blackmail/compiler/compile.rkt similarity index 93% rename from blackmail/compile.rkt rename to blackmail/compiler/compile.rkt index 3b22b6f..274b223 100644 --- a/blackmail/compile.rkt +++ b/blackmail/compiler/compile.rkt @@ -2,7 +2,7 @@ (provide compile compile-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") (require a86/ast a86/registers) diff --git a/blackmail/correct.rkt b/blackmail/correct.rkt index bbbacf9..9ee319c 100644 --- a/blackmail/correct.rkt +++ b/blackmail/correct.rkt @@ -1,11 +1,12 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp.rkt") -(require "exec.rkt") +(require "interpreter/interp.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; Expr -> Void (define (check-compiler e) (check-equal? (interp e) - (exec e))) + (run (compile e)))) diff --git a/blackmail/exec.rkt b/blackmail/exec.rkt deleted file mode 100644 index 408672f..0000000 --- a/blackmail/exec.rkt +++ /dev/null @@ -1,10 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(provide exec) - -;; Expr -> Integer -(define (exec e) - (run (compile e))) - diff --git a/blackmail/executor/exec.rkt b/blackmail/executor/exec.rkt new file mode 100644 index 0000000..7800ef5 --- /dev/null +++ b/blackmail/executor/exec.rkt @@ -0,0 +1,44 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) + +(struct exec-state (program) #:transparent) + +(define _val _int64) + +(define (exec/state prog) + (exec-state + (asm-load prog))) + +(define (exec-call st) + (match-define (exec-state program) st) + (asm-call program 'entry)) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/abscond/run-stdin.rkt b/blackmail/executor/run-stdin.rkt similarity index 75% rename from abscond/run-stdin.rkt rename to blackmail/executor/run-stdin.rkt index 16cf99e..7e7170f 100644 --- a/abscond/run-stdin.rkt +++ b/blackmail/executor/run-stdin.rkt @@ -1,7 +1,7 @@ #lang racket (provide main) -(require "parse.rkt") -(require "compile.rkt") +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") (require "run.rkt") ;; -> Void diff --git a/blackmail/executor/run.rkt b/blackmail/executor/run.rkt new file mode 100644 index 0000000..39c354a --- /dev/null +++ b/blackmail/executor/run.rkt @@ -0,0 +1,11 @@ +#lang racket +(require a86/interp) +(require "exec.rkt") +(provide run) + +;; Asm -> Integer +(define (run asm) + (call-with-exec + asm + identity)) + diff --git a/blackmail/interp-prim.rkt b/blackmail/interpreter/interp-prim.rkt similarity index 100% rename from blackmail/interp-prim.rkt rename to blackmail/interpreter/interp-prim.rkt diff --git a/con/interp-stdin.rkt b/blackmail/interpreter/interp-stdin.rkt similarity index 87% rename from con/interp-stdin.rkt rename to blackmail/interpreter/interp-stdin.rkt index ce4885f..e620f5c 100644 --- a/con/interp-stdin.rkt +++ b/blackmail/interpreter/interp-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "interp.rkt") ;; -> Void diff --git a/blackmail/interp.rkt b/blackmail/interpreter/interp.rkt similarity index 85% rename from blackmail/interp.rkt rename to blackmail/interpreter/interp.rkt index 044f5b0..04cec38 100644 --- a/blackmail/interp.rkt +++ b/blackmail/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") ;; Expr -> Integer diff --git a/blackmail/main.rkt b/blackmail/main.rkt index 9a97f8b..16c671d 100644 --- a/blackmail/main.rkt +++ b/blackmail/main.rkt @@ -1,14 +1,14 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "compile.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "compiler/compile.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/blackmail/run.rkt b/blackmail/run.rkt deleted file mode 100644 index 33c496c..0000000 --- a/blackmail/run.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(require a86/interp) -(provide run) - -;; Run instructions with run-time system linked in -;; Asm -> Integer -(define (run is) - (asm-interp is)) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - - diff --git a/blackmail/runtime/Makefile b/blackmail/runtime/Makefile new file mode 100644 index 0000000..8b22999 --- /dev/null +++ b/blackmail/runtime/Makefile @@ -0,0 +1,25 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/blackmail/main.c b/blackmail/runtime/main.c similarity index 81% rename from blackmail/main.c rename to blackmail/runtime/main.c index 2e030ba..4c8ad77 100644 --- a/blackmail/main.c +++ b/blackmail/runtime/main.c @@ -6,9 +6,7 @@ int64_t entry(); int main(int argc, char** argv) { - int64_t result; - - result = entry(); + int64_t result = entry(); print_result(result); putchar('\n'); return 0; diff --git a/blackmail/print.c b/blackmail/runtime/print.c similarity index 100% rename from blackmail/print.c rename to blackmail/runtime/print.c diff --git a/blackmail/print.h b/blackmail/runtime/print.h similarity index 100% rename from blackmail/print.h rename to blackmail/runtime/print.h diff --git a/blackmail/semantics.rkt b/blackmail/semantics.rkt deleted file mode 100644 index 7864b96..0000000 --- a/blackmail/semantics.rkt +++ /dev/null @@ -1,30 +0,0 @@ -#lang racket -(provide B-concrete B 𝑩) -(require redex/reduction-semantics) - -(define-language B-concrete - (e ::= integer (add1 e) (sub1 e))) - -(define-language B - (e ::= (Int i) (Prim1 p1 e)) - (i ::= integer) - (p1 ::= 'add1 'sub1)) - -(define-judgment-form B - #:mode (𝑩 I O) - #:contract (𝑩 e i) - [---------- - (𝑩 (Int i) i)] - - [(𝑩 e_0 i_0) (where i_1 ,(+ (term i_0) 1)) - ----------- - (𝑩 (Prim1 'add1 e_0) i_1)] - - [(𝑩 e_0 i_0) (where i_1 ,(- (term i_0) 1)) - ----------- - (𝑩 (Prim1 'sub1 e_0) i_1)]) - -(module+ test - (test-judgment-holds (𝑩 (Int 7) 7)) - (test-judgment-holds (𝑩 (Prim1 'add1 (Int 8)) 9)) - (test-judgment-holds (𝑩 (Prim1 'sub1 (Int 8)) 7))) diff --git a/blackmail/ast.rkt b/blackmail/syntax/ast.rkt similarity index 100% rename from blackmail/ast.rkt rename to blackmail/syntax/ast.rkt diff --git a/blackmail/parse.rkt b/blackmail/syntax/parse.rkt similarity index 100% rename from blackmail/parse.rkt rename to blackmail/syntax/parse.rkt diff --git a/blackmail/random.rkt b/blackmail/syntax/random.rkt similarity index 100% rename from blackmail/random.rkt rename to blackmail/syntax/random.rkt diff --git a/blackmail/test/compile.rkt b/blackmail/test/compile.rkt index cf7ce11..db295e3 100644 --- a/blackmail/test/compile.rkt +++ b/blackmail/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ (e) (exec (parse e)))) +(test (λ (e) (run (compile (parse e))))) diff --git a/blackmail/test/interp.rkt b/blackmail/test/interp.rkt index dc33c12..4ed7882 100644 --- a/blackmail/test/interp.rkt +++ b/blackmail/test/interp.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../interp.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ (e) (interp (parse e)))) diff --git a/blackmail/test/parse.rkt b/blackmail/test/parse.rkt index 59ac5ec..c67a08d 100644 --- a/blackmail/test/parse.rkt +++ b/blackmail/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) diff --git a/blackmail/compile-ops.rkt b/con/compiler/compile-ops.rkt similarity index 84% rename from blackmail/compile-ops.rkt rename to con/compiler/compile-ops.rkt index dc1119b..a6e9b97 100644 --- a/blackmail/compile-ops.rkt +++ b/con/compiler/compile-ops.rkt @@ -1,6 +1,6 @@ #lang racket (provide compile-op1) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require a86/ast a86/registers) ;; Op1 -> Asm diff --git a/blackmail/compile-stdin.rkt b/con/compiler/compile-stdin.rkt similarity index 88% rename from blackmail/compile-stdin.rkt rename to con/compiler/compile-stdin.rkt index 532ee0e..a11acf3 100644 --- a/blackmail/compile-stdin.rkt +++ b/con/compiler/compile-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "compile.rkt") (require a86/printer) diff --git a/con/compile.rkt b/con/compiler/compile.rkt similarity index 96% rename from con/compile.rkt rename to con/compiler/compile.rkt index 4ec5fbc..725bff8 100644 --- a/con/compile.rkt +++ b/con/compiler/compile.rkt @@ -2,7 +2,7 @@ (provide compile compile-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") (require a86/ast a86/registers) diff --git a/con/correct.rkt b/con/correct.rkt index bbbacf9..9ee319c 100644 --- a/con/correct.rkt +++ b/con/correct.rkt @@ -1,11 +1,12 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp.rkt") -(require "exec.rkt") +(require "interpreter/interp.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; Expr -> Void (define (check-compiler e) (check-equal? (interp e) - (exec e))) + (run (compile e)))) diff --git a/con/exec.rkt b/con/exec.rkt deleted file mode 100644 index 408672f..0000000 --- a/con/exec.rkt +++ /dev/null @@ -1,10 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(provide exec) - -;; Expr -> Integer -(define (exec e) - (run (compile e))) - diff --git a/con/executor/exec.rkt b/con/executor/exec.rkt new file mode 100644 index 0000000..7800ef5 --- /dev/null +++ b/con/executor/exec.rkt @@ -0,0 +1,44 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) + +(struct exec-state (program) #:transparent) + +(define _val _int64) + +(define (exec/state prog) + (exec-state + (asm-load prog))) + +(define (exec-call st) + (match-define (exec-state program) st) + (asm-call program 'entry)) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/con/run-stdin.rkt b/con/executor/run-stdin.rkt similarity index 75% rename from con/run-stdin.rkt rename to con/executor/run-stdin.rkt index 16cf99e..7e7170f 100644 --- a/con/run-stdin.rkt +++ b/con/executor/run-stdin.rkt @@ -1,7 +1,7 @@ #lang racket (provide main) -(require "parse.rkt") -(require "compile.rkt") +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") (require "run.rkt") ;; -> Void diff --git a/con/executor/run.rkt b/con/executor/run.rkt new file mode 100644 index 0000000..39c354a --- /dev/null +++ b/con/executor/run.rkt @@ -0,0 +1,11 @@ +#lang racket +(require a86/interp) +(require "exec.rkt") +(provide run) + +;; Asm -> Integer +(define (run asm) + (call-with-exec + asm + identity)) + diff --git a/con/interp-prim.rkt b/con/interpreter/interp-prim.rkt similarity index 100% rename from con/interp-prim.rkt rename to con/interpreter/interp-prim.rkt diff --git a/dodger/interp-stdin.rkt b/con/interpreter/interp-stdin.rkt similarity index 87% rename from dodger/interp-stdin.rkt rename to con/interpreter/interp-stdin.rkt index ce4885f..e620f5c 100644 --- a/dodger/interp-stdin.rkt +++ b/con/interpreter/interp-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "interp.rkt") ;; -> Void diff --git a/con/interp.rkt b/con/interpreter/interp.rkt similarity index 90% rename from con/interp.rkt rename to con/interpreter/interp.rkt index f87824e..b0a83ae 100644 --- a/con/interp.rkt +++ b/con/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") ;; Expr -> Integer diff --git a/con/main.rkt b/con/main.rkt index 9a97f8b..16c671d 100644 --- a/con/main.rkt +++ b/con/main.rkt @@ -1,14 +1,14 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "compile.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "compiler/compile.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/con/run.rkt b/con/run.rkt deleted file mode 100644 index 33c496c..0000000 --- a/con/run.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(require a86/interp) -(provide run) - -;; Run instructions with run-time system linked in -;; Asm -> Integer -(define (run is) - (asm-interp is)) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - - diff --git a/con/runtime/Makefile b/con/runtime/Makefile new file mode 100644 index 0000000..8b22999 --- /dev/null +++ b/con/runtime/Makefile @@ -0,0 +1,25 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/con/main.c b/con/runtime/main.c similarity index 81% rename from con/main.c rename to con/runtime/main.c index 2e030ba..c608bf9 100644 --- a/con/main.c +++ b/con/runtime/main.c @@ -6,9 +6,7 @@ int64_t entry(); int main(int argc, char** argv) { - int64_t result; - - result = entry(); + int64_t result = entry(); print_result(result); putchar('\n'); return 0; diff --git a/con/print.c b/con/runtime/print.c similarity index 100% rename from con/print.c rename to con/runtime/print.c diff --git a/con/print.h b/con/runtime/print.h similarity index 100% rename from con/print.h rename to con/runtime/print.h diff --git a/con/semantics.rkt b/con/semantics.rkt deleted file mode 100644 index 8b3762f..0000000 --- a/con/semantics.rkt +++ /dev/null @@ -1,37 +0,0 @@ -#lang racket -(provide C-concrete C 𝑪) -(require redex/reduction-semantics - (only-in "../blackmail/semantics.rkt" B B-concrete 𝑩)) - -(define-extended-language C-concrete B-concrete - (e ::= .... (if (zero? e) e e))) - -(define-extended-language C B - (e ::= .... (IfZero e e e))) - -(define-extended-judgment-form C 𝑩 - #:mode (𝑪 I O) - #:contract (𝑪 e i) - [(𝑪 e_0 i_0) (side-condition ,(= (term i_0) 0)) (𝑪 e_1 i_1) - -------- - (𝑪 (IfZero e_0 e_1 e_2) i_1)] - - [(𝑪 e_0 i_0) (side-condition ,(!= (term i_0) 0)) (𝑪 e_2 i_2) - -------- - (𝑪 (IfZero e_0 e_1 e_2) i_2)]) - -(define (!= n1 n2) - (not (= n1 n2))) - -(module+ test - (test-judgment-holds (𝑪 (Int 7) 7)) - (test-judgment-holds (𝑪 (Prim1 'add1 (Int 8)) 9)) - (test-judgment-holds (𝑪 (Prim1 'sub1 (Int 8)) 7)) - (test-judgment-holds (𝑪 (IfZero (Prim1 'sub1 (Int 1)) - (Int 3) - (Int 4)) - 3)) - (test-judgment-holds (𝑪 (IfZero (Prim1 'add1 (Int 1)) - (Int 3) - (Int 4)) - 4))) diff --git a/con/ast.rkt b/con/syntax/ast.rkt similarity index 100% rename from con/ast.rkt rename to con/syntax/ast.rkt diff --git a/con/parse.rkt b/con/syntax/parse.rkt similarity index 100% rename from con/parse.rkt rename to con/syntax/parse.rkt diff --git a/con/random.rkt b/con/syntax/random.rkt similarity index 93% rename from con/random.rkt rename to con/syntax/random.rkt index 9119d23..5318a89 100644 --- a/con/random.rkt +++ b/con/syntax/random.rkt @@ -1,6 +1,6 @@ #lang racket (provide (all-defined-out)) -(require "parse.rkt") +(require "../parse.rkt") ;; Randomly generate an expression (define (random-expr) diff --git a/con/test/compile.rkt b/con/test/compile.rkt index cf7ce11..db295e3 100644 --- a/con/test/compile.rkt +++ b/con/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ (e) (exec (parse e)))) +(test (λ (e) (run (compile (parse e))))) diff --git a/con/test/interp.rkt b/con/test/interp.rkt index dc33c12..4ed7882 100644 --- a/con/test/interp.rkt +++ b/con/test/interp.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../interp.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ (e) (interp (parse e)))) diff --git a/con/test/parse.rkt b/con/test/parse.rkt index b25786d..f3984a5 100644 --- a/con/test/parse.rkt +++ b/con/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) diff --git a/con/types.rkt b/con/types.rkt deleted file mode 100644 index cb09c66..0000000 --- a/con/types.rkt +++ /dev/null @@ -1,17 +0,0 @@ -#lang racket -(provide (all-defined-out)) - -;; type Value = -;; | Integer - -;; type Bits = Integer - -(define int-shift 0) - -;; Bits -> Value -(define (bits->value b) b) - -;; Value -> Bits -(define (value->bits v) - (match v - [(? integer?) (arithmetic-shift v int-shift)])) diff --git a/dodger/Makefile b/dodger/Makefile index 398e3cf..5205a2f 100644 --- a/dodger/Makefile +++ b/dodger/Makefile @@ -8,8 +8,7 @@ endif objs = \ main.o \ - print.o \ - values.o + print.o default: runtime.o diff --git a/dodger/compile-ops.rkt b/dodger/compiler/compile-ops.rkt similarity index 92% rename from dodger/compile-ops.rkt rename to dodger/compiler/compile-ops.rkt index 5f3eb1e..8c23c01 100644 --- a/dodger/compile-ops.rkt +++ b/dodger/compiler/compile-ops.rkt @@ -1,7 +1,7 @@ #lang racket (provide compile-op1) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; Op1 -> Asm diff --git a/dodger/compile-stdin.rkt b/dodger/compiler/compile-stdin.rkt similarity index 88% rename from dodger/compile-stdin.rkt rename to dodger/compiler/compile-stdin.rkt index 532ee0e..a11acf3 100644 --- a/dodger/compile-stdin.rkt +++ b/dodger/compiler/compile-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "compile.rkt") (require a86/printer) diff --git a/dupe/compile.rkt b/dodger/compiler/compile.rkt similarity index 93% rename from dupe/compile.rkt rename to dodger/compiler/compile.rkt index 593445a..2095e20 100644 --- a/dupe/compile.rkt +++ b/dodger/compiler/compile.rkt @@ -2,9 +2,9 @@ (provide compile compile-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; Expr -> Asm diff --git a/dodger/correct.rkt b/dodger/correct.rkt index ae6e1ae..2129ca0 100644 --- a/dodger/correct.rkt +++ b/dodger/correct.rkt @@ -1,13 +1,14 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp.rkt") -(require "exec.rkt") +(require "interpreter/interp.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; Expr -> Void (define (check-compiler e) (let ((r (with-handlers ([exn:fail? identity]) (interp e)))) (unless (exn? r) - (check-equal? r (exec e))))) + (check-equal? r (run (compile e)))))) diff --git a/dodger/exec.rkt b/dodger/exec.rkt deleted file mode 100644 index 114a56e..0000000 --- a/dodger/exec.rkt +++ /dev/null @@ -1,10 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(require "types.rkt") -(provide exec) -;; Expr -> Value -(define (exec e) - (run (compile e))) - diff --git a/dodger/executor/decode.rkt b/dodger/executor/decode.rkt new file mode 100644 index 0000000..efaeb49 --- /dev/null +++ b/dodger/executor/decode.rkt @@ -0,0 +1,20 @@ +#lang racket + +(require "../runtime/types.rkt") +(require ffi/unsafe) + +(provide (all-defined-out)) + +;; Integer -> Value +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [(char-bits? b) + (integer->char (arithmetic-shift b (- char-shift)))] + [else (error "invalid bits")])) + +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/dodger/executor/exec.rkt b/dodger/executor/exec.rkt new file mode 100644 index 0000000..8b8c3be --- /dev/null +++ b/dodger/executor/exec.rkt @@ -0,0 +1,44 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") + +(struct exec-state (program) #:transparent) + +(define (exec/state prog) + (exec-state + (asm-load prog))) + +(define (exec-call st) + (match-define (exec-state program) st) + (asm-call program 'entry)) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/dodger/run-stdin.rkt b/dodger/executor/run-stdin.rkt similarity index 75% rename from dodger/run-stdin.rkt rename to dodger/executor/run-stdin.rkt index 16cf99e..7e7170f 100644 --- a/dodger/run-stdin.rkt +++ b/dodger/executor/run-stdin.rkt @@ -1,7 +1,7 @@ #lang racket (provide main) -(require "parse.rkt") -(require "compile.rkt") +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") (require "run.rkt") ;; -> Void diff --git a/dodger/executor/run.rkt b/dodger/executor/run.rkt new file mode 100644 index 0000000..5b4c9cd --- /dev/null +++ b/dodger/executor/run.rkt @@ -0,0 +1,11 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run) +(define (run asm) + (call-with-exec + asm + (λ (r) + (bits->value r)))) + diff --git a/dodger/interp-bits.rkt b/dodger/interp-bits.rkt deleted file mode 100644 index 6f65d55..0000000 --- a/dodger/interp-bits.rkt +++ /dev/null @@ -1,41 +0,0 @@ -#lang racket -(provide interp interp-bits) -(require "ast.rkt" "types.rkt") - -;; type Value = -;; | Integer -;; | Boolean -;; | Character - -;; type Bits = Integer - -;; Expr -> Value -(define (interp e) - (bits->value (interp-bits e))) - -;; Expr -> Bits -(define (interp-bits e) - (match e - [(Lit d) (value->bits d)] - [(Prim1 'add1 e0) - (+ (interp-bits e0) (value->bits 1))] - [(Prim1 'sub1 e0) - (- (interp-bits e0) (value->bits 1))] - [(Prim1 'zero? e) - (value->bits (zero? (interp-bits e)))] - [(Prim1 'char? e0) - (value->bits (char-bits? (interp-bits e0)))] - [(Prim1 'char->integer e0) - (arithmetic-shift - (arithmetic-shift (interp-bits e0) (- char-shift)) - int-shift)] - [(Prim1 'integer->char e0) - (bitwise-ior - (arithmetic-shift - (arithmetic-shift (interp-bits e0) (- int-shift)) - char-shift) - type-char)] - [(If e1 e2 e3) - (if (= (interp-bits e1) (value->bits #f)) - (interp-bits e3) - (interp-bits e2))])) diff --git a/dodger/interp-prim.rkt b/dodger/interpreter/interp-prim.rkt similarity index 100% rename from dodger/interp-prim.rkt rename to dodger/interpreter/interp-prim.rkt diff --git a/abscond/interp-stdin.rkt b/dodger/interpreter/interp-stdin.rkt similarity index 87% rename from abscond/interp-stdin.rkt rename to dodger/interpreter/interp-stdin.rkt index ce4885f..e620f5c 100644 --- a/abscond/interp-stdin.rkt +++ b/dodger/interpreter/interp-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "interp.rkt") ;; -> Void diff --git a/dodger/interp.rkt b/dodger/interpreter/interp.rkt similarity index 91% rename from dodger/interp.rkt rename to dodger/interpreter/interp.rkt index e8a0bff..9838b09 100644 --- a/dodger/interp.rkt +++ b/dodger/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") ;; type Value = diff --git a/dodger/main.rkt b/dodger/main.rkt index 67ea8be..d6a5d90 100644 --- a/dodger/main.rkt +++ b/dodger/main.rkt @@ -1,16 +1,16 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "types.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/dodger/run.rkt b/dodger/run.rkt deleted file mode 100644 index 982b94d..0000000 --- a/dodger/run.rkt +++ /dev/null @@ -1,15 +0,0 @@ -#lang racket -(require a86/interp) -(require "types.rkt") -(provide run) - -;; Run instructions with run-time system linked in - -;; Asm -> Value -(define (run is) - (bits->value (asm-interp is))) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - - diff --git a/dodger/runtime/Makefile b/dodger/runtime/Makefile new file mode 100644 index 0000000..cf0e413 --- /dev/null +++ b/dodger/runtime/Makefile @@ -0,0 +1,26 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o \ + values.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/dupe/main.c b/dodger/runtime/main.c similarity index 81% rename from dupe/main.c rename to dodger/runtime/main.c index c6f67be..27e672f 100644 --- a/dupe/main.c +++ b/dodger/runtime/main.c @@ -6,9 +6,7 @@ val_t entry(); int main(int argc, char** argv) { - val_t result; - - result = entry(); + val_t result = entry(); print_result(result); putchar('\n'); return 0; diff --git a/dodger/print.c b/dodger/runtime/print.c similarity index 100% rename from dodger/print.c rename to dodger/runtime/print.c diff --git a/dodger/print.h b/dodger/runtime/print.h similarity index 100% rename from dodger/print.h rename to dodger/runtime/print.h diff --git a/dodger/types.h b/dodger/runtime/types.h similarity index 100% rename from dodger/types.h rename to dodger/runtime/types.h diff --git a/dodger/types.rkt b/dodger/runtime/types.rkt similarity index 65% rename from dodger/types.rkt rename to dodger/runtime/types.rkt index 0bd20c6..c372831 100644 --- a/dodger/types.rkt +++ b/dodger/runtime/types.rkt @@ -7,16 +7,6 @@ (define type-char #b01) (define mask-char #b11) -;; Integer -> Value -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [else (error "invalid bits")])) - ;; Value -> Integer (define (value->bits v) diff --git a/dodger/values.c b/dodger/runtime/values.c similarity index 100% rename from dodger/values.c rename to dodger/runtime/values.c diff --git a/dodger/values.h b/dodger/runtime/values.h similarity index 100% rename from dodger/values.h rename to dodger/runtime/values.h diff --git a/dodger/ast.rkt b/dodger/syntax/ast.rkt similarity index 100% rename from dodger/ast.rkt rename to dodger/syntax/ast.rkt diff --git a/dodger/parse.rkt b/dodger/syntax/parse.rkt similarity index 100% rename from dodger/parse.rkt rename to dodger/syntax/parse.rkt diff --git a/dodger/random.rkt b/dodger/syntax/random.rkt similarity index 100% rename from dodger/random.rkt rename to dodger/syntax/random.rkt diff --git a/dodger/test/all.rkt b/dodger/test/all.rkt deleted file mode 100644 index b7c04c1..0000000 --- a/dodger/test/all.rkt +++ /dev/null @@ -1,57 +0,0 @@ -#lang racket -(require "../compile.rkt" - "../interp.rkt" - "../parse.rkt" - "../types.rkt" - (prefix-in bit: "../interp-bits.rkt") - a86/interp - rackunit) - -(define (test-runner run) - ;; Abscond examples - (check-equal? (run 7) 7) - (check-equal? (run -8) -8) - - ;; Blackmail examples - (check-equal? (run '(add1 (add1 7))) 9) - (check-equal? (run '(add1 (sub1 7))) 7) - - ;; Con examples - (check-equal? (run '(if (zero? 0) 1 2)) 1) - (check-equal? (run '(if (zero? 1) 1 2)) 2) - (check-equal? (run '(if (zero? -7) 1 2)) 2) - (check-equal? (run '(if (zero? 0) - (if (zero? 1) 1 2) - 7)) - 2) - (check-equal? (run '(if (zero? (if (zero? 0) 1 0)) - (if (zero? 1) 1 2) - 7)) - 7) - - ;; Dupe examples - (check-equal? (run #t) #t) - (check-equal? (run #f) #f) - (check-equal? (run '(if #t 1 2)) 1) - (check-equal? (run '(if #f 1 2)) 2) - (check-equal? (run '(if 0 1 2)) 1) - (check-equal? (run '(if #t 3 4)) 3) - (check-equal? (run '(if #f 3 4)) 4) - (check-equal? (run '(if 0 3 4)) 3) - (check-equal? (run '(zero? 4)) #f) - (check-equal? (run '(zero? 0)) #t) - - ;; Dodger examples - (check-equal? (run #\a) #\a) - (check-equal? (run #\b) #\b) - (check-equal? (run '(char? #\a)) #t) - (check-equal? (run '(char? #t)) #f) - (check-equal? (run '(char? 8)) #f) - (check-equal? (run '(char->integer #\a)) (char->integer #\a)) - (check-equal? (run '(integer->char 955)) #\λ)) - -(test-runner (λ (e) (bit:interp (parse e)))) -(test-runner (λ (e) (interp (parse e)))) -(test-runner (λ (e) (bits->value (asm-interp (compile (parse e)))))) - - diff --git a/dodger/test/compile.rkt b/dodger/test/compile.rkt index cf7ce11..db295e3 100644 --- a/dodger/test/compile.rkt +++ b/dodger/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ (e) (exec (parse e)))) +(test (λ (e) (run (compile (parse e))))) diff --git a/dodger/test/interp.rkt b/dodger/test/interp.rkt index dc33c12..4ed7882 100644 --- a/dodger/test/interp.rkt +++ b/dodger/test/interp.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../interp.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ (e) (interp (parse e)))) diff --git a/dodger/test/parse.rkt b/dodger/test/parse.rkt index b3913b8..fd707c8 100644 --- a/dodger/test/parse.rkt +++ b/dodger/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) diff --git a/dupe/Makefile b/dupe/Makefile index 398e3cf..5205a2f 100644 --- a/dupe/Makefile +++ b/dupe/Makefile @@ -8,8 +8,7 @@ endif objs = \ main.o \ - print.o \ - values.o + print.o default: runtime.o diff --git a/dupe/compile-stdin.rkt b/dupe/compile-stdin.rkt deleted file mode 100644 index 532ee0e..0000000 --- a/dupe/compile-stdin.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require a86/printer) - -;; -> Void -;; Compile contents of stdin, -;; emit asm code on stdout -(define (main) - (read-line) ; ignore #lang racket line - (asm-display (compile (parse (read))))) - diff --git a/dupe/compile-ops.rkt b/dupe/compiler/compile-ops.rkt similarity index 84% rename from dupe/compile-ops.rkt rename to dupe/compiler/compile-ops.rkt index 9d17339..e92d21b 100644 --- a/dupe/compile-ops.rkt +++ b/dupe/compiler/compile-ops.rkt @@ -1,7 +1,7 @@ #lang racket (provide compile-op1) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; Op1 -> Asm diff --git a/dupe/compiler/compile-stdin.rkt b/dupe/compiler/compile-stdin.rkt new file mode 100644 index 0000000..a11acf3 --- /dev/null +++ b/dupe/compiler/compile-stdin.rkt @@ -0,0 +1,13 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "compile.rkt") +(require a86/printer) + +;; -> Void +;; Compile contents of stdin, +;; emit asm code on stdout +(define (main) + (read-line) ; ignore #lang racket line + (asm-display (compile (parse (read))))) + diff --git a/dodger/compile.rkt b/dupe/compiler/compile.rkt similarity index 93% rename from dodger/compile.rkt rename to dupe/compiler/compile.rkt index 593445a..2095e20 100644 --- a/dodger/compile.rkt +++ b/dupe/compiler/compile.rkt @@ -2,9 +2,9 @@ (provide compile compile-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; Expr -> Asm diff --git a/dupe/correct.rkt b/dupe/correct.rkt index ae6e1ae..2129ca0 100644 --- a/dupe/correct.rkt +++ b/dupe/correct.rkt @@ -1,13 +1,14 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp.rkt") -(require "exec.rkt") +(require "interpreter/interp.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; Expr -> Void (define (check-compiler e) (let ((r (with-handlers ([exn:fail? identity]) (interp e)))) (unless (exn? r) - (check-equal? r (exec e))))) + (check-equal? r (run (compile e)))))) diff --git a/dupe/exec.rkt b/dupe/exec.rkt deleted file mode 100644 index 114a56e..0000000 --- a/dupe/exec.rkt +++ /dev/null @@ -1,10 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(require "types.rkt") -(provide exec) -;; Expr -> Value -(define (exec e) - (run (compile e))) - diff --git a/dupe/executor/decode.rkt b/dupe/executor/decode.rkt new file mode 100644 index 0000000..465ef49 --- /dev/null +++ b/dupe/executor/decode.rkt @@ -0,0 +1,18 @@ +#lang racket + +(require "../runtime/types.rkt") +(require ffi/unsafe) + +(provide (all-defined-out)) + +;; Integer -> Value +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [else (error "invalid bits")])) + +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/dupe/executor/exec.rkt b/dupe/executor/exec.rkt new file mode 100644 index 0000000..8b8c3be --- /dev/null +++ b/dupe/executor/exec.rkt @@ -0,0 +1,44 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") + +(struct exec-state (program) #:transparent) + +(define (exec/state prog) + (exec-state + (asm-load prog))) + +(define (exec-call st) + (match-define (exec-state program) st) + (asm-call program 'entry)) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/dupe/executor/run-stdin.rkt b/dupe/executor/run-stdin.rkt new file mode 100644 index 0000000..7e7170f --- /dev/null +++ b/dupe/executor/run-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") +(require "run.rkt") + +;; -> Void +;; Compile contents of stdin and use asm-interp to run +(define (main) + (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) + diff --git a/dupe/executor/run.rkt b/dupe/executor/run.rkt new file mode 100644 index 0000000..5b4c9cd --- /dev/null +++ b/dupe/executor/run.rkt @@ -0,0 +1,11 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run) +(define (run asm) + (call-with-exec + asm + (λ (r) + (bits->value r)))) + diff --git a/dupe/interp-bits-wrap.rkt b/dupe/interp-bits-wrap.rkt deleted file mode 100644 index 6c71a47..0000000 --- a/dupe/interp-bits-wrap.rkt +++ /dev/null @@ -1,42 +0,0 @@ -#lang racket -(provide interp-wrap interp-bits-wrap) -(require "ast.rkt" "types.rkt") - -;; type Value = -;; | Integer -;; | Boolean - -(define word-size 64) - -(define shift 1) - -;; type Bits = Integer - -;; Expr -> Bits -(define (interp-bits-wrap e) - (match e - [(Lit i) (value->bits i)] - [(Prim1 'add1 e0) - (wrap (add1 (interp-bits-wrap e0)))] - [(Prim1 'sub1 e0) - (wrap (sub1 (interp-bits-wrap e0)))] - [(Prim1 'zero? e) - (value->bits (zero? (interp-bits-wrap e)))] - [(If e1 e2 e3) - (if (= (interp-bits-wrap e1) (value->bits #f)) - (interp-bits-wrap e3) - (interp-bits-wrap e2))])) - -(define (interp-wrap e) - (bits->value (interp-bits-wrap e))) - -(define (wrap n) - (if (>= (integer-length n) (- word-size shift)) - (- (truncate n)) - n)) - -(define (truncate n) - (bitwise-bit-field n - (max 0 (- (integer-length n) - (- word-size shift))) - (- word-size shift))) diff --git a/dupe/interp-bits.rkt b/dupe/interp-bits.rkt deleted file mode 100644 index 9d47563..0000000 --- a/dupe/interp-bits.rkt +++ /dev/null @@ -1,18 +0,0 @@ -#lang racket -(provide interp interp-bits) -(require "ast.rkt" "types.rkt" "interp-prim-bits.rkt") - -;; Expr -> Value -(define (interp e) - (bits->value (interp-bits e))) - -;; Expr -> Bits -(define (interp-bits e) - (match e - [(Lit d) (value->bits d)] - [(Prim1 p e) - (interp-prim1-bits p (interp-bits e))] - [(If e1 e2 e3) - (if (= (interp-bits e1) (value->bits #f)) - (interp-bits e3) - (interp-bits e2))])) diff --git a/dupe/interp-prim-bits.rkt b/dupe/interp-prim-bits.rkt deleted file mode 100644 index 330dcec..0000000 --- a/dupe/interp-prim-bits.rkt +++ /dev/null @@ -1,10 +0,0 @@ -#lang racket -(require "types.rkt") -(provide interp-prim1-bits) - -;; Op Bits -> Bits -(define (interp-prim1-bits op b) - (match op - ['add1 (+ b (value->bits 1))] - ['sub1 (- b (value->bits 1))] - ['zero? (if (zero? b) (value->bits #t) (value->bits #f))])) diff --git a/dupe/interp-stdin.rkt b/dupe/interp-stdin.rkt deleted file mode 100644 index ce4885f..0000000 --- a/dupe/interp-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "interp.rkt") - -;; -> Void -;; Parse and interpret contents of stdin, -;; print result on stdout -(define (main) - (read-line) ; ignore #lang racket line - (println (interp (parse (read))))) - diff --git a/dupe/interp-prim.rkt b/dupe/interpreter/interp-prim.rkt similarity index 100% rename from dupe/interp-prim.rkt rename to dupe/interpreter/interp-prim.rkt diff --git a/dupe/interpreter/interp-stdin.rkt b/dupe/interpreter/interp-stdin.rkt new file mode 100644 index 0000000..e620f5c --- /dev/null +++ b/dupe/interpreter/interp-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "interp.rkt") + +;; -> Void +;; Parse and interpret contents of stdin, +;; print result on stdout +(define (main) + (read-line) ; ignore #lang racket line + (println (interp (parse (read))))) + diff --git a/dupe/interp.rkt b/dupe/interpreter/interp.rkt similarity index 90% rename from dupe/interp.rkt rename to dupe/interpreter/interp.rkt index ade0993..27bec6b 100644 --- a/dupe/interp.rkt +++ b/dupe/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") ;; type Value = diff --git a/dupe/main.rkt b/dupe/main.rkt index 67ea8be..d6a5d90 100644 --- a/dupe/main.rkt +++ b/dupe/main.rkt @@ -1,16 +1,16 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "types.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/dupe/run-stdin.rkt b/dupe/run-stdin.rkt deleted file mode 100644 index 16cf99e..0000000 --- a/dupe/run-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require "run.rkt") - -;; -> Void -;; Compile contents of stdin and use asm-interp to run -(define (main) - (read-line) ; ignore #lang racket line - (run (compile (parse (read))))) - diff --git a/dupe/run.rkt b/dupe/run.rkt deleted file mode 100644 index 982b94d..0000000 --- a/dupe/run.rkt +++ /dev/null @@ -1,15 +0,0 @@ -#lang racket -(require a86/interp) -(require "types.rkt") -(provide run) - -;; Run instructions with run-time system linked in - -;; Asm -> Value -(define (run is) - (bits->value (asm-interp is))) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - - diff --git a/dupe/runtime/Makefile b/dupe/runtime/Makefile new file mode 100644 index 0000000..cf0e413 --- /dev/null +++ b/dupe/runtime/Makefile @@ -0,0 +1,26 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o \ + values.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/dodger/main.c b/dupe/runtime/main.c similarity index 67% rename from dodger/main.c rename to dupe/runtime/main.c index a51b53f..27e672f 100644 --- a/dodger/main.c +++ b/dupe/runtime/main.c @@ -1,3 +1,4 @@ +#include #include "values.h" #include "print.h" @@ -5,9 +6,8 @@ val_t entry(); int main(int argc, char** argv) { - val_t result; - - result = entry(); + val_t result = entry(); print_result(result); + putchar('\n'); return 0; } diff --git a/dupe/print.c b/dupe/runtime/print.c similarity index 100% rename from dupe/print.c rename to dupe/runtime/print.c diff --git a/dupe/print.h b/dupe/runtime/print.h similarity index 100% rename from dupe/print.h rename to dupe/runtime/print.h diff --git a/dupe/types.h b/dupe/runtime/types.h similarity index 100% rename from dupe/types.h rename to dupe/runtime/types.h diff --git a/dupe/types.rkt b/dupe/runtime/types.rkt similarity index 59% rename from dupe/types.rkt rename to dupe/runtime/types.rkt index 865b0c7..d2450a3 100644 --- a/dupe/types.rkt +++ b/dupe/runtime/types.rkt @@ -4,14 +4,6 @@ (define mask-int #b1) (define type-int #b0) -;; Integer -> Value -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [else (error "invalid bits")])) - ;; Value -> Integer (define (value->bits v) diff --git a/dupe/values.c b/dupe/runtime/values.c similarity index 100% rename from dupe/values.c rename to dupe/runtime/values.c diff --git a/dupe/values.h b/dupe/runtime/values.h similarity index 100% rename from dupe/values.h rename to dupe/runtime/values.h diff --git a/dupe/semantics.rkt b/dupe/semantics.rkt deleted file mode 100644 index ce29a45..0000000 --- a/dupe/semantics.rkt +++ /dev/null @@ -1,74 +0,0 @@ -#lang racket -(provide D-concrete D 𝑫 𝑫-𝒑𝒓𝒊𝒎 is-true is-false) -(require redex/reduction-semantics - (only-in "../con/semantics.rkt" C C-concrete)) - -(define-extended-language D-concrete C-concrete - (e ::= .... boolean (if e e e) (zero? e))) - -(define-extended-language D C - ; new defn to get rid of IfZero - (e ::= (Int i) (Bool b) (Prim1 p1 e) (If e e e)) - (p1 ::= .... 'zero?) - (v ::= i b) - (b ::= #t #f)) - -(define-judgment-form D - #:mode (𝑫 I O) - #:contract (𝑫 e v) - [-------- - (𝑫 (Int i) i)] - - [-------- - (𝑫 (Bool b) b)] - - [(𝑫 e_0 v_0) (where v_1 (𝑫-𝒑𝒓𝒊𝒎 p1 v_0)) - ----------- - (𝑫 (Prim1 p1 e_0) v_1)] - - [(𝑫 e_0 v_0) (is-true v_0) (𝑫 e_1 v_1) - -------- - (𝑫 (If e_0 e_1 e_2) v_1)] - - [(𝑫 e_0 v_0) (is-false v_0) (𝑫 e_2 v_2) - -------- - (𝑫 (If e_0 e_1 e_2) v_2)]) - -(define-metafunction D - 𝑫-𝒑𝒓𝒊𝒎 : p1 v -> v or ⊥ - [(𝑫-𝒑𝒓𝒊𝒎 'add1 i) ,(+ (term i) (term 1))] - [(𝑫-𝒑𝒓𝒊𝒎 'sub1 i) ,(- (term i) (term 1))] - [(𝑫-𝒑𝒓𝒊𝒎 'zero? 0) #t] - [(𝑫-𝒑𝒓𝒊𝒎 'zero? i) #f] - [(𝑫-𝒑𝒓𝒊𝒎 _ _) ⊥]) - -(module+ test - (test-judgment-holds (𝑫 (Int 7) 7)) - (test-judgment-holds (𝑫 (Bool #f) #f)) - (test-judgment-holds (𝑫 (Bool #t) #t)) - (test-judgment-holds (𝑫 (Prim1 'add1 (Int 8)) 9)) - (test-judgment-holds (𝑫 (Prim1 'sub1 (Int 8)) 7)) - - (test-judgment-holds (𝑫 (If (Bool #f) (Int 3) (Int 4)) 4)) - (test-judgment-holds (𝑫 (If (Bool #t) (Int 3) (Int 4)) 3)) - (test-judgment-holds (𝑫 (Prim1 'zero? (Int 0)) #t)) - (test-judgment-holds (𝑫 (Prim1 'zero? (Int 1)) #f)) - (test-judgment-holds (𝑫 (If (Prim1 'zero? (Int 0)) (Int 3) (Int 4)) 3)) - (test-judgment-holds (𝑫 (If (Prim1 'zero? (Int 1)) (Int 3) (Int 4)) 4))) - -(define-judgment-form D - #:mode (is-true I) - #:contract (is-true v) - [----------- - (is-true #t)] - [---------- - (is-true i)]) - -(define-judgment-form D - #:mode (is-false I) - #:contract (is-false v) - [----------- - (is-false #f)]) - -(define (!= n m) - (not (= n m))) diff --git a/dupe/ast.rkt b/dupe/syntax/ast.rkt similarity index 100% rename from dupe/ast.rkt rename to dupe/syntax/ast.rkt diff --git a/dupe/parse.rkt b/dupe/syntax/parse.rkt similarity index 100% rename from dupe/parse.rkt rename to dupe/syntax/parse.rkt diff --git a/dupe/random.rkt b/dupe/syntax/random.rkt similarity index 100% rename from dupe/random.rkt rename to dupe/syntax/random.rkt diff --git a/dupe/test/all.rkt b/dupe/test/all.rkt deleted file mode 100644 index e836ef6..0000000 --- a/dupe/test/all.rkt +++ /dev/null @@ -1,47 +0,0 @@ -#lang racket -(require "../compile.rkt" - "../interp.rkt" - "../parse.rkt" - "../types.rkt" - (prefix-in bit: "../interp-bits.rkt") - a86/interp - rackunit) - -(define (test-runner run) - - ;; Abscond examples - (check-equal? (run 7) 7) - (check-equal? (run -8) -8) - - ;; Blackmail examples - (check-equal? (run '(add1 (add1 7))) 9) - (check-equal? (run '(add1 (sub1 7))) 7) - - ;; Con examples - (check-equal? (run '(if (zero? 0) 1 2)) 1) - (check-equal? (run '(if (zero? 1) 1 2)) 2) - (check-equal? (run '(if (zero? -7) 1 2)) 2) - (check-equal? (run '(if (zero? 0) - (if (zero? 1) 1 2) - 7)) - 2) - (check-equal? (run '(if (zero? (if (zero? 0) 1 0)) - (if (zero? 1) 1 2) - 7)) - 7) - - ;; Dupe examples - (check-equal? (run #t) #t) - (check-equal? (run #f) #f) - (check-equal? (run '(if #t 1 2)) 1) - (check-equal? (run '(if #f 1 2)) 2) - (check-equal? (run '(if 0 1 2)) 1) - (check-equal? (run '(if #t 3 4)) 3) - (check-equal? (run '(if #f 3 4)) 4) - (check-equal? (run '(if 0 3 4)) 3) - (check-equal? (run '(zero? 4)) #f) - (check-equal? (run '(zero? 0)) #t)) - -(test-runner (λ (e) (interp (parse e)))) -(test-runner (λ (e) (bit:interp (parse e)))) -(test-runner (λ (e) (bits->value (asm-interp (compile (parse e)))))) diff --git a/dupe/test/compile.rkt b/dupe/test/compile.rkt index cf7ce11..db295e3 100644 --- a/dupe/test/compile.rkt +++ b/dupe/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ (e) (exec (parse e)))) +(test (λ (e) (run (compile (parse e))))) diff --git a/dupe/test/interp.rkt b/dupe/test/interp.rkt index dc33c12..4ed7882 100644 --- a/dupe/test/interp.rkt +++ b/dupe/test/interp.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../interp.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ (e) (interp (parse e)))) diff --git a/dupe/test/parse.rkt b/dupe/test/parse.rkt index 8fd1122..2ca5075 100644 --- a/dupe/test/parse.rkt +++ b/dupe/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) diff --git a/evildoer/Makefile b/evildoer/Makefile index d88e2b9..5205a2f 100644 --- a/evildoer/Makefile +++ b/evildoer/Makefile @@ -8,9 +8,7 @@ endif objs = \ main.o \ - print.o \ - values.o \ - io.o + print.o default: runtime.o diff --git a/evildoer/build-runtime.rkt b/evildoer/build-runtime.rkt deleted file mode 100644 index 6699852..0000000 --- a/evildoer/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(provide runtime-path) - -(require racket/runtime-path) -(define-runtime-path here ".") - -(unless (system (string-append "make -C '" - (path->string (normalize-path here)) - "' --no-print-directory -s runtime.o")) - (error 'build-runtime "could not build runtime")) - -(define runtime-path - (normalize-path (build-path here "runtime.o"))) - diff --git a/evildoer/compile-stdin.rkt b/evildoer/compile-stdin.rkt deleted file mode 100644 index 532ee0e..0000000 --- a/evildoer/compile-stdin.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require a86/printer) - -;; -> Void -;; Compile contents of stdin, -;; emit asm code on stdout -(define (main) - (read-line) ; ignore #lang racket line - (asm-display (compile (parse (read))))) - diff --git a/evildoer/compile-ops.rkt b/evildoer/compiler/compile-ops.rkt similarity index 94% rename from evildoer/compile-ops.rkt rename to evildoer/compiler/compile-ops.rkt index 216179c..4f6d7e2 100644 --- a/evildoer/compile-ops.rkt +++ b/evildoer/compiler/compile-ops.rkt @@ -1,7 +1,7 @@ #lang racket (provide compile-op0 compile-op1) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; Op0 -> Asm diff --git a/evildoer/compiler/compile-stdin.rkt b/evildoer/compiler/compile-stdin.rkt new file mode 100644 index 0000000..a11acf3 --- /dev/null +++ b/evildoer/compiler/compile-stdin.rkt @@ -0,0 +1,13 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "compile.rkt") +(require a86/printer) + +;; -> Void +;; Compile contents of stdin, +;; emit asm code on stdout +(define (main) + (read-line) ; ignore #lang racket line + (asm-display (compile (parse (read))))) + diff --git a/evildoer/compile.rkt b/evildoer/compiler/compile.rkt similarity index 94% rename from evildoer/compile.rkt rename to evildoer/compiler/compile.rkt index 241d45e..03a3d5c 100644 --- a/evildoer/compile.rkt +++ b/evildoer/compiler/compile.rkt @@ -2,9 +2,9 @@ (provide compile compile-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; Expr -> Asm diff --git a/evildoer/correct.rkt b/evildoer/correct.rkt index 0c4896d..01914a1 100644 --- a/evildoer/correct.rkt +++ b/evildoer/correct.rkt @@ -1,12 +1,13 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp-io.rkt") -(require "exec.rkt") +(require "interpreter/interp-io.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; Expr String -> Void (define (check-compiler e i) (let ((r (with-handlers ([exn:fail? identity]) (interp/io e i)))) (unless (exn? r) - (check-equal? r (exec/io e i))))) + (check-equal? r (run/io (compile e) i))))) diff --git a/evildoer/exec-io.rkt b/evildoer/exec-io.rkt deleted file mode 100644 index 9578890..0000000 --- a/evildoer/exec-io.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(require a86/interp) -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec/io) - -;; Expr String -> (cons Answer String) -(define (exec/io e in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io (compile e) in) - [(cons b o) (cons (bits->value b) o)]))) - diff --git a/evildoer/exec.rkt b/evildoer/exec.rkt deleted file mode 100644 index ff8b714..0000000 --- a/evildoer/exec.rkt +++ /dev/null @@ -1,15 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec exec/io) -;; Expr -> Value -(define (exec e) - (run (compile e))) - -;; Expr String -> (cons Answer String) -(define (exec/io e in) - (run/io (compile e) in)) - diff --git a/evildoer/executor/decode.rkt b/evildoer/executor/decode.rkt new file mode 100644 index 0000000..89f3464 --- /dev/null +++ b/evildoer/executor/decode.rkt @@ -0,0 +1,22 @@ +#lang racket + +(require "../runtime/types.rkt") +(require ffi/unsafe) + +(provide (all-defined-out)) + +;; Integer -> Value +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(= b (value->bits eof)) eof] + [(= b (value->bits (void))) (void)] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [(char-bits? b) + (integer->char (arithmetic-shift b (- char-shift)))] + [else (error "invalid bits")])) + +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/evildoer/executor/exec.rkt b/evildoer/executor/exec.rkt new file mode 100644 index 0000000..34d9d42 --- /dev/null +++ b/evildoer/executor/exec.rkt @@ -0,0 +1,50 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") + +(struct exec-state (program) #:transparent) + +(define (exec/state prog) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)))]) + (asm-load prog)))) + +(define (exec-call st) + (match-define (exec-state program) st) + (asm-call program 'entry)) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/evildoer/executor/run-stdin.rkt b/evildoer/executor/run-stdin.rkt new file mode 100644 index 0000000..7e7170f --- /dev/null +++ b/evildoer/executor/run-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") +(require "run.rkt") + +;; -> Void +;; Compile contents of stdin and use asm-interp to run +(define (main) + (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) + diff --git a/evildoer/executor/run.rkt b/evildoer/executor/run.rkt new file mode 100644 index 0000000..e568605 --- /dev/null +++ b/evildoer/executor/run.rkt @@ -0,0 +1,19 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run run/io) +;; Asm -> Value +(define (run asm) + (call-with-exec + asm + (λ (r) + (bits->value r)))) + +;; Asm String -> (cons Value String) +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) + diff --git a/evildoer/interp-stdin.rkt b/evildoer/interp-stdin.rkt deleted file mode 100644 index ce4885f..0000000 --- a/evildoer/interp-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "interp.rkt") - -;; -> Void -;; Parse and interpret contents of stdin, -;; print result on stdout -(define (main) - (read-line) ; ignore #lang racket line - (println (interp (parse (read))))) - diff --git a/evildoer/interp-io.rkt b/evildoer/interpreter/interp-io.rkt similarity index 100% rename from evildoer/interp-io.rkt rename to evildoer/interpreter/interp-io.rkt diff --git a/evildoer/interp-prim.rkt b/evildoer/interpreter/interp-prim.rkt similarity index 100% rename from evildoer/interp-prim.rkt rename to evildoer/interpreter/interp-prim.rkt diff --git a/evildoer/interpreter/interp-stdin.rkt b/evildoer/interpreter/interp-stdin.rkt new file mode 100644 index 0000000..e620f5c --- /dev/null +++ b/evildoer/interpreter/interp-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "interp.rkt") + +;; -> Void +;; Parse and interpret contents of stdin, +;; print result on stdout +(define (main) + (read-line) ; ignore #lang racket line + (println (interp (parse (read))))) + diff --git a/evildoer/interp.rkt b/evildoer/interpreter/interp.rkt similarity index 93% rename from evildoer/interp.rkt rename to evildoer/interpreter/interp.rkt index 4c6e520..59edb74 100644 --- a/evildoer/interp.rkt +++ b/evildoer/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") ;; type Value = diff --git a/evildoer/main.rkt b/evildoer/main.rkt index 50cf56e..f9851a3 100644 --- a/evildoer/main.rkt +++ b/evildoer/main.rkt @@ -1,18 +1,18 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "interp-io.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "interp-io.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "types.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/evildoer/run-stdin.rkt b/evildoer/run-stdin.rkt deleted file mode 100644 index 16cf99e..0000000 --- a/evildoer/run-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require "run.rkt") - -;; -> Void -;; Compile contents of stdin and use asm-interp to run -(define (main) - (read-line) ; ignore #lang racket line - (run (compile (parse (read))))) - diff --git a/evildoer/run.rkt b/evildoer/run.rkt deleted file mode 100644 index 34a053d..0000000 --- a/evildoer/run.rkt +++ /dev/null @@ -1,22 +0,0 @@ -#lang racket -(require a86/interp) -(require "types.rkt") -(require "build-runtime.rkt") -(provide run run/io) - -;; Run instructions with run-time system linked in - -;; Asm -> Value -(define (run is) - (match (run/io is "") - [(cons r out) (begin (display out) r)])) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) -;; Asm String -> (cons Value String) -(define (run/io is in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io is in) - [(cons b out) - (cons (bits->value b) out)]))) - diff --git a/evildoer/runtime/Makefile b/evildoer/runtime/Makefile new file mode 100644 index 0000000..9b47733 --- /dev/null +++ b/evildoer/runtime/Makefile @@ -0,0 +1,27 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o \ + values.o \ + io.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/evildoer/gcd.c b/evildoer/runtime/gcd.c similarity index 100% rename from evildoer/gcd.c rename to evildoer/runtime/gcd.c diff --git a/evildoer/io.c b/evildoer/runtime/io.c similarity index 74% rename from evildoer/io.c rename to evildoer/runtime/io.c index 8a417c9..139dccb 100644 --- a/evildoer/io.c +++ b/evildoer/runtime/io.c @@ -6,20 +6,20 @@ val_t read_byte(void) { - char c = getc(in); + char c = getc(stdin); return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); } val_t peek_byte(void) { - char c = getc(in); - ungetc(c, in); + char c = getc(stdin); + ungetc(c, stdin); return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); } val_t write_byte(val_t c) { - putc((char) val_unwrap_int(c), out); + putc((char) val_unwrap_int(c), stdout); return val_wrap_void(); } diff --git a/evildoer/runtime/main.c b/evildoer/runtime/main.c new file mode 100644 index 0000000..d75fd8d --- /dev/null +++ b/evildoer/runtime/main.c @@ -0,0 +1,15 @@ +#include +#include "values.h" +#include "print.h" +#include "runtime.h" + +int main(int argc, char** argv) +{ + val_t result = entry(); + + print_result(result); + if (val_typeof(result) != T_VOID) + putchar('\n'); + + return 0; +} diff --git a/evildoer/print.c b/evildoer/runtime/print.c similarity index 100% rename from evildoer/print.c rename to evildoer/runtime/print.c diff --git a/evildoer/print.h b/evildoer/runtime/print.h similarity index 100% rename from evildoer/print.h rename to evildoer/runtime/print.h diff --git a/evildoer/runtime.h b/evildoer/runtime/runtime.h similarity index 73% rename from evildoer/runtime.h rename to evildoer/runtime/runtime.h index 4d4ebf1..8f6d8ca 100644 --- a/evildoer/runtime.h +++ b/evildoer/runtime/runtime.h @@ -4,6 +4,5 @@ #include "values.h" val_t entry(); -extern FILE* in; -extern FILE* out; + #endif /* RUNTIME_H */ diff --git a/evildoer/types.h b/evildoer/runtime/types.h similarity index 100% rename from evildoer/types.h rename to evildoer/runtime/types.h diff --git a/extort/types.rkt b/evildoer/runtime/types.rkt similarity index 62% rename from extort/types.rkt rename to evildoer/runtime/types.rkt index 827e0f1..7a5f023 100644 --- a/extort/types.rkt +++ b/evildoer/runtime/types.rkt @@ -7,18 +7,6 @@ (define type-char #b01) (define mask-char #b11) -;; Integer -> Value -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(= b (value->bits eof)) eof] - [(= b (value->bits (void))) (void)] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [else (error "invalid bits")])) - ;; Value -> Integer (define (value->bits v) diff --git a/evildoer/values.c b/evildoer/runtime/values.c similarity index 100% rename from evildoer/values.c rename to evildoer/runtime/values.c diff --git a/evildoer/values.h b/evildoer/runtime/values.h similarity index 100% rename from evildoer/values.h rename to evildoer/runtime/values.h diff --git a/evildoer/ast.rkt b/evildoer/syntax/ast.rkt similarity index 100% rename from evildoer/ast.rkt rename to evildoer/syntax/ast.rkt diff --git a/evildoer/parse.rkt b/evildoer/syntax/parse.rkt similarity index 100% rename from evildoer/parse.rkt rename to evildoer/syntax/parse.rkt diff --git a/evildoer/random.rkt b/evildoer/syntax/random.rkt similarity index 100% rename from evildoer/random.rkt rename to evildoer/syntax/random.rkt diff --git a/evildoer/test/all.rkt b/evildoer/test/all.rkt deleted file mode 100644 index 4b456a1..0000000 --- a/evildoer/test/all.rkt +++ /dev/null @@ -1,90 +0,0 @@ -#lang racket -(require "../compile.rkt" - "../interp.rkt" - "../interp-io.rkt" - "../parse.rkt" - "../types.rkt" - "../build-runtime.rkt" - a86/interp - rackunit) - -;; link with runtime for IO operations -(current-objs - (list (path->string runtime-path))) - -(define (test-runner run) - ;; Abscond examples - (check-equal? (run 7) 7) - (check-equal? (run -8) -8) - - ;; Blackmail examples - (check-equal? (run '(add1 (add1 7))) 9) - (check-equal? (run '(add1 (sub1 7))) 7) - - ;; Con examples - (check-equal? (run '(if (zero? 0) 1 2)) 1) - (check-equal? (run '(if (zero? 1) 1 2)) 2) - (check-equal? (run '(if (zero? -7) 1 2)) 2) - (check-equal? (run '(if (zero? 0) - (if (zero? 1) 1 2) - 7)) - 2) - (check-equal? (run '(if (zero? (if (zero? 0) 1 0)) - (if (zero? 1) 1 2) - 7)) - 7) - - ;; Dupe examples - (check-equal? (run #t) #t) - (check-equal? (run #f) #f) - (check-equal? (run '(if #t 1 2)) 1) - (check-equal? (run '(if #f 1 2)) 2) - (check-equal? (run '(if 0 1 2)) 1) - (check-equal? (run '(if #t 3 4)) 3) - (check-equal? (run '(if #f 3 4)) 4) - (check-equal? (run '(if 0 3 4)) 3) - (check-equal? (run '(zero? 4)) #f) - (check-equal? (run '(zero? 0)) #t) - - ;; Dodger examples - (check-equal? (run #\a) #\a) - (check-equal? (run #\b) #\b) - (check-equal? (run '(char? #\a)) #t) - (check-equal? (run '(char? #t)) #f) - (check-equal? (run '(char? 8)) #f) - (check-equal? (run '(char->integer #\a)) (char->integer #\a)) - (check-equal? (run '(integer->char 955)) #\λ) - - ;; Evildoer examples - (check-equal? (run '(void)) (void)) - (check-equal? (run '(begin 1 2)) 2) - (check-equal? (run '(eof-object? (void))) #f)) - -(test-runner (λ (e) (interp (parse e)))) -(test-runner (λ (e) (bits->value (asm-interp (compile (parse e)))))) - -(define (test-runner-io run) - ;; Evildoer examples - (check-equal? (run 7 "") (cons 7 "")) - (check-equal? (run '(write-byte 97) "") (cons (void) "a")) - (check-equal? (run '(read-byte) "a") (cons 97 "")) - (check-equal? (run '(begin (write-byte 97) (read-byte)) "b") - (cons 98 "a")) - (check-equal? (run '(read-byte) "") (cons eof "")) - (check-equal? (run '(eof-object? (read-byte)) "") (cons #t "")) - (check-equal? (run '(eof-object? (read-byte)) "a") (cons #f "")) - (check-equal? (run '(begin (write-byte 97) (write-byte 98)) "") - (cons (void) "ab")) - - (check-equal? (run '(peek-byte) "ab") (cons 97 "")) - (check-equal? (run '(begin (peek-byte) (read-byte)) "ab") (cons 97 ""))) - -(test-runner-io (λ (e s) (interp/io (parse e) s))) -(test-runner-io (λ (e s) - (match (asm-interp/io (compile (parse e)) s) - [(cons r o) - (cons (bits->value r) o)]))) - -;; run command line compiler and compare against Racket as refernece implementation -(require rackunit "../../test-programs/get-progs.rkt") -(for-each test-prog (get-progs "evildoer")) diff --git a/evildoer/test/compile.rkt b/evildoer/test/compile.rkt index 38cb738..aaeb50f 100644 --- a/evildoer/test/compile.rkt +++ b/evildoer/test/compile.rkt @@ -1,10 +1,10 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ (e) (exec (parse e)))) +(test (λ (e) (run (compile (parse e))))) -(test/io (λ (i e) (exec/io (parse e) i))) +(test/io (λ (i e) (run/io (compile (parse e)) i))) diff --git a/evildoer/test/interp.rkt b/evildoer/test/interp.rkt index 74d4a05..a987b86 100644 --- a/evildoer/test/interp.rkt +++ b/evildoer/test/interp.rkt @@ -1,7 +1,7 @@ #lang racket -(require "../interp.rkt") -(require "../interp-io.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ (e) (interp (parse e)))) diff --git a/evildoer/test/parse.rkt b/evildoer/test/parse.rkt index cefbeba..2aec3f6 100644 --- a/evildoer/test/parse.rkt +++ b/evildoer/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) diff --git a/extort/Makefile b/extort/Makefile index 6fe052b..5205a2f 100644 --- a/extort/Makefile +++ b/extort/Makefile @@ -5,11 +5,10 @@ else LANGS_CC ?= clang LANGS_AS ?= clang -c endif + objs = \ main.o \ - print.o \ - values.o \ - io.o + print.o default: runtime.o diff --git a/extort/build-runtime.rkt b/extort/build-runtime.rkt deleted file mode 100644 index 6699852..0000000 --- a/extort/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(provide runtime-path) - -(require racket/runtime-path) -(define-runtime-path here ".") - -(unless (system (string-append "make -C '" - (path->string (normalize-path here)) - "' --no-print-directory -s runtime.o")) - (error 'build-runtime "could not build runtime")) - -(define runtime-path - (normalize-path (build-path here "runtime.o"))) - diff --git a/extort/compile-stdin.rkt b/extort/compile-stdin.rkt deleted file mode 100644 index 532ee0e..0000000 --- a/extort/compile-stdin.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require a86/printer) - -;; -> Void -;; Compile contents of stdin, -;; emit asm code on stdout -(define (main) - (read-line) ; ignore #lang racket line - (asm-display (compile (parse (read))))) - diff --git a/extort/assert.rkt b/extort/compiler/assert.rkt similarity index 96% rename from extort/assert.rkt rename to extort/compiler/assert.rkt index 9d88901..a22f93d 100644 --- a/extort/assert.rkt +++ b/extort/compiler/assert.rkt @@ -1,7 +1,7 @@ #lang racket (provide assert-integer assert-char assert-byte assert-codepoint) (require a86/ast) -(require "types.rkt") +(require "../runtime/types.rkt") ;; Register -> Asm (define (assert-integer r) diff --git a/extort/compile-ops.rkt b/extort/compiler/compile-ops.rkt similarity index 95% rename from extort/compile-ops.rkt rename to extort/compiler/compile-ops.rkt index 8cc5ea8..ac14266 100644 --- a/extort/compile-ops.rkt +++ b/extort/compiler/compile-ops.rkt @@ -1,7 +1,7 @@ #lang racket (provide compile-op0 compile-op1) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require "assert.rkt") (require a86/ast a86/registers) diff --git a/extort/compiler/compile-stdin.rkt b/extort/compiler/compile-stdin.rkt new file mode 100644 index 0000000..a11acf3 --- /dev/null +++ b/extort/compiler/compile-stdin.rkt @@ -0,0 +1,13 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "compile.rkt") +(require a86/printer) + +;; -> Void +;; Compile contents of stdin, +;; emit asm code on stdout +(define (main) + (read-line) ; ignore #lang racket line + (asm-display (compile (parse (read))))) + diff --git a/extort/compile.rkt b/extort/compiler/compile.rkt similarity index 95% rename from extort/compile.rkt rename to extort/compiler/compile.rkt index 4ecdd07..b9cf54c 100644 --- a/extort/compile.rkt +++ b/extort/compiler/compile.rkt @@ -2,9 +2,9 @@ (provide compile compile-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; Expr -> Asm diff --git a/extort/correct.rkt b/extort/correct.rkt index 8a8a601..5909846 100644 --- a/extort/correct.rkt +++ b/extort/correct.rkt @@ -1,10 +1,11 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp-io.rkt") -(require "exec.rkt") +(require "interpreter/interp-io.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; Expr String -> Void (define (check-compiler e i) (check-equal? (interp/io e i) - (exec/io e i))) + (run/io (compile e) i))) diff --git a/extort/exec-io.rkt b/extort/exec-io.rkt deleted file mode 100644 index d385fc4..0000000 --- a/extort/exec-io.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require a86/interp) -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec/io) - -;; Expr String -> (cons Answer String) -(define (exec/io e in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io (compile e) in) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) - diff --git a/extort/exec.rkt b/extort/exec.rkt deleted file mode 100644 index 4ad3df2..0000000 --- a/extort/exec.rkt +++ /dev/null @@ -1,15 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec exec/io) -;; Expr -> Answer -(define (exec e) - (run (compile e))) - -;; Expr String -> (cons Answer String) -(define (exec/io e in) - (run/io (compile e) in)) - diff --git a/extort/executor/decode.rkt b/extort/executor/decode.rkt new file mode 100644 index 0000000..89f3464 --- /dev/null +++ b/extort/executor/decode.rkt @@ -0,0 +1,22 @@ +#lang racket + +(require "../runtime/types.rkt") +(require ffi/unsafe) + +(provide (all-defined-out)) + +;; Integer -> Value +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(= b (value->bits eof)) eof] + [(= b (value->bits (void))) (void)] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [(char-bits? b) + (integer->char (arithmetic-shift b (- char-shift)))] + [else (error "invalid bits")])) + +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/extort/executor/exec.rkt b/extort/executor/exec.rkt new file mode 100644 index 0000000..f6fccb2 --- /dev/null +++ b/extort/executor/exec.rkt @@ -0,0 +1,54 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") + +(struct exec-state (program) #:transparent) + +(define (exec/state prog) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)) + (extern 'raise_error + (λ () (raise 'err)) + (_fun -> _void)))]) + (asm-load prog)))) + +(define (exec-call st) + (match-define (exec-state program) st) + (with-handlers ([(λ (x) (eq? x 'err)) identity]) + (asm-call program 'entry))) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/extort/executor/run-stdin.rkt b/extort/executor/run-stdin.rkt new file mode 100644 index 0000000..7e7170f --- /dev/null +++ b/extort/executor/run-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") +(require "run.rkt") + +;; -> Void +;; Compile contents of stdin and use asm-interp to run +(define (main) + (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) + diff --git a/extort/executor/run.rkt b/extort/executor/run.rkt new file mode 100644 index 0000000..d96fe18 --- /dev/null +++ b/extort/executor/run.rkt @@ -0,0 +1,20 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run run/io) +;; Asm -> Answer +(define (run asm) + (call-with-exec + asm + (λ (r) + (match r + ['err 'err] + [b (bits->value b)])))) +;; Asm String -> (cons Answer String) +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) + diff --git a/extort/interp-cps.rkt b/extort/interp-cps.rkt deleted file mode 100644 index 5043ad0..0000000 --- a/extort/interp-cps.rkt +++ /dev/null @@ -1,26 +0,0 @@ -#lang racket -(provide (all-defined-out)) - -;; Expr (Value -> Answer) -> Answer -(define (interp/cps e k) - (match e - [(? integer? i) (k i)] - [(? boolean? b) (k b)] - [`(add1 ,e0) - (interp/cps e0 (assert integer? add1))] - [`(sub1 ,e0) - (interp/cps e0 (assert integer? sub1))] - [`(zero? ,e0) - (interp/cps e0 (assert integer? zero?))] - [`(if ,e0 ,e1 ,e2) - (interp/cps e0 (λ (v) - (if v - (interp/cps e1 k) - (interp/cps e2 k))))])) - -;; (Value -> Boolean) (Value -> Answer) -> (Value -> Answer) -(define (assert pred k) - (λ (v) - (if (pred v) - (k v) - 'error))) diff --git a/extort/interp-stdin.rkt b/extort/interp-stdin.rkt deleted file mode 100644 index ce4885f..0000000 --- a/extort/interp-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "interp.rkt") - -;; -> Void -;; Parse and interpret contents of stdin, -;; print result on stdout -(define (main) - (read-line) ; ignore #lang racket line - (println (interp (parse (read))))) - diff --git a/extort/interp-io.rkt b/extort/interpreter/interp-io.rkt similarity index 100% rename from extort/interp-io.rkt rename to extort/interpreter/interp-io.rkt diff --git a/extort/interp-prim.rkt b/extort/interpreter/interp-prim.rkt similarity index 100% rename from extort/interp-prim.rkt rename to extort/interpreter/interp-prim.rkt diff --git a/extort/interpreter/interp-stdin.rkt b/extort/interpreter/interp-stdin.rkt new file mode 100644 index 0000000..e620f5c --- /dev/null +++ b/extort/interpreter/interp-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "interp.rkt") + +;; -> Void +;; Parse and interpret contents of stdin, +;; print result on stdout +(define (main) + (read-line) ; ignore #lang racket line + (println (interp (parse (read))))) + diff --git a/extort/interp.rkt b/extort/interpreter/interp.rkt similarity index 95% rename from extort/interp.rkt rename to extort/interpreter/interp.rkt index a3e3925..04d0efc 100644 --- a/extort/interp.rkt +++ b/extort/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp interp-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") ;; type Value = diff --git a/extort/main.c b/extort/main.c deleted file mode 100644 index 5f17cbd..0000000 --- a/extort/main.c +++ /dev/null @@ -1,36 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - - val_t result; - - result = entry(); - print_result(result); - if (val_typeof(result) != T_VOID) - putchar('\n'); - - return 0; -} diff --git a/extort/main.rkt b/extort/main.rkt index 50cf56e..f9851a3 100644 --- a/extort/main.rkt +++ b/extort/main.rkt @@ -1,18 +1,18 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "interp-io.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "interp-io.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "types.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/extort/run-stdin.rkt b/extort/run-stdin.rkt deleted file mode 100644 index 16cf99e..0000000 --- a/extort/run-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require "run.rkt") - -;; -> Void -;; Compile contents of stdin and use asm-interp to run -(define (main) - (read-line) ; ignore #lang racket line - (run (compile (parse (read))))) - diff --git a/extort/run.rkt b/extort/run.rkt deleted file mode 100644 index e707f3b..0000000 --- a/extort/run.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require a86/interp) -(require "types.rkt") -(require "build-runtime.rkt") -(provide run run/io) - -;; Run instructions with run-time system linked in - -;; Asm -> Answer -(define (run is) - (match (run/io is "") - [(cons r out) (begin (display out) r)])) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - -;; Asm String -> (cons Answer String) -(define (run/io is in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io is in) - [(cons 'err out) (cons 'err out)] - [(cons b out) - (cons (bits->value b) out)]))) - diff --git a/extort/runtime.h b/extort/runtime.h deleted file mode 100644 index 0a066ad..0000000 --- a/extort/runtime.h +++ /dev/null @@ -1,10 +0,0 @@ -#ifndef RUNTIME_H -#define RUNTIME_H - -#include "values.h" - -val_t entry(); -extern FILE* in; -extern FILE* out; -extern void (*error_handler)(); -#endif /* RUNTIME_H */ diff --git a/extort/runtime/Makefile b/extort/runtime/Makefile new file mode 100644 index 0000000..5582813 --- /dev/null +++ b/extort/runtime/Makefile @@ -0,0 +1,28 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o \ + values.o \ + io.o \ + error.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/extort/runtime/error.c b/extort/runtime/error.c new file mode 100644 index 0000000..69a535a --- /dev/null +++ b/extort/runtime/error.c @@ -0,0 +1,9 @@ +#include +#include +#include "runtime.h" + +_Noreturn void raise_error(void) +{ + printf("err\n"); + exit(1); +} diff --git a/fraud/io.c b/extort/runtime/io.c similarity index 74% rename from fraud/io.c rename to extort/runtime/io.c index 8a417c9..139dccb 100644 --- a/fraud/io.c +++ b/extort/runtime/io.c @@ -6,20 +6,20 @@ val_t read_byte(void) { - char c = getc(in); + char c = getc(stdin); return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); } val_t peek_byte(void) { - char c = getc(in); - ungetc(c, in); + char c = getc(stdin); + ungetc(c, stdin); return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); } val_t write_byte(val_t c) { - putc((char) val_unwrap_int(c), out); + putc((char) val_unwrap_int(c), stdout); return val_wrap_void(); } diff --git a/evildoer/main.c b/extort/runtime/main.c similarity index 70% rename from evildoer/main.c rename to extort/runtime/main.c index b79bfa7..4d814bd 100644 --- a/evildoer/main.c +++ b/extort/runtime/main.c @@ -3,17 +3,10 @@ #include "print.h" #include "runtime.h" -FILE* in; -FILE* out; - int main(int argc, char** argv) { - in = stdin; - out = stdout; + val_t result = entry(); - val_t result; - - result = entry(); print_result(result); if (val_typeof(result) != T_VOID) putchar('\n'); diff --git a/extort/print.c b/extort/runtime/print.c similarity index 100% rename from extort/print.c rename to extort/runtime/print.c diff --git a/extort/print.h b/extort/runtime/print.h similarity index 100% rename from extort/print.h rename to extort/runtime/print.h diff --git a/extort/runtime/runtime.h b/extort/runtime/runtime.h new file mode 100644 index 0000000..fb6a288 --- /dev/null +++ b/extort/runtime/runtime.h @@ -0,0 +1,14 @@ +#ifndef RUNTIME_H +#define RUNTIME_H + +#include "values.h" + +val_t entry(); + +val_t read_byte(void); +val_t peek_byte(void); +val_t write_byte(val_t); + +_Noreturn void raise_error(void); + +#endif /* RUNTIME_H */ diff --git a/extort/types.h b/extort/runtime/types.h similarity index 100% rename from extort/types.h rename to extort/runtime/types.h diff --git a/evildoer/types.rkt b/extort/runtime/types.rkt similarity index 62% rename from evildoer/types.rkt rename to extort/runtime/types.rkt index 827e0f1..7a5f023 100644 --- a/evildoer/types.rkt +++ b/extort/runtime/types.rkt @@ -7,18 +7,6 @@ (define type-char #b01) (define mask-char #b11) -;; Integer -> Value -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(= b (value->bits eof)) eof] - [(= b (value->bits (void))) (void)] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [else (error "invalid bits")])) - ;; Value -> Integer (define (value->bits v) diff --git a/extort/values.c b/extort/runtime/values.c similarity index 100% rename from extort/values.c rename to extort/runtime/values.c diff --git a/extort/values.h b/extort/runtime/values.h similarity index 100% rename from extort/values.h rename to extort/runtime/values.h diff --git a/extort/semantics.rkt b/extort/semantics.rkt deleted file mode 100644 index 056e868..0000000 --- a/extort/semantics.rkt +++ /dev/null @@ -1,75 +0,0 @@ -#lang racket -(provide E-concrete E 𝑬) -(require redex/reduction-semantics - (only-in "../dupe/semantics.rkt" D-concrete D 𝑫)) - -(define-extended-language E-concrete D-concrete - (e ::= ....) - (a ::= v err)) - -(define-extended-language E D - (e ::= ....) - (a ::= v err)) - -(define-extended-judgment-form E 𝑫 - #:mode (𝑬 I O) - #:contract (𝑬 e a) - [(𝑬 e b) - -------- - (𝑬 (Prim1 'add1 e) err)] - - [(𝑬 e b) - ----------- - (𝑬 (Prim1 'sub1 e) err)] - - [(𝑬 e b) - ----------- - (𝑬 (Prim1 'zero? e) err)] - - [(𝑬 e err) - ----------- - (𝑬 (Prim1 'zero? e) err)] - - [(𝑬 e err) - ----------- - (𝑬 (Prim1 'add1 e) err)] - - [(𝑬 e err) - ----------- - (𝑬 (Prim1 'sub1 e) err)] - - [(𝑬 e err) - ----------- - (𝑬 (If e e_0 e_1) err)]) - - -(module+ test - (test-judgment-holds (𝑬 (Int 7) 7)) - (test-judgment-holds (𝑬 (Bool #f) #f)) - (test-judgment-holds (𝑬 (Bool #t) #t)) - (test-judgment-holds (𝑬 (Prim1 'add1 (Int 8)) 9)) - (test-judgment-holds (𝑬 (Prim1 'sub1 (Int 8)) 7)) - - (test-judgment-holds (𝑬 (If (Bool #f) (Int 3) (Int 4)) 4)) - (test-judgment-holds (𝑬 (If (Bool #t) (Int 3) (Int 4)) 3)) - (test-judgment-holds (𝑬 (Prim1 'zero? (Int 0)) #t)) - (test-judgment-holds (𝑬 (Prim1 'zero? (Int 1)) #f)) - (test-judgment-holds (𝑬 (If (Prim1 'zero? (Int 0)) (Int 3) (Int 4)) 3)) - (test-judgment-holds (𝑬 (If (Prim1 'zero? (Int 1)) (Int 3) (Int 4)) 4)) - - - (test-judgment-holds (𝑬 (Prim1 'add1 (Bool #t)) err)) - (test-judgment-holds (𝑬 (Prim1 'add1 (Bool #f)) err)) - (test-judgment-holds (𝑬 (Prim1 'sub1 (Bool #t)) err)) - (test-judgment-holds (𝑬 (Prim1 'sub1 (Bool #f)) err)) - (test-judgment-holds (𝑬 (Prim1 'zero? (Bool #t)) err)) - (test-judgment-holds (𝑬 (Prim1 'zero? (Bool #f)) err)) - - (test-judgment-holds (𝑬 (Prim1 'add1 (If (Bool #t) (Bool #t) (Bool #t))) err)) - (test-judgment-holds (𝑬 (Prim1 'sub1 (If (Bool #t) (Bool #t) (Bool #t))) err)) - (test-judgment-holds (𝑬 (Prim1 'zero? (If (Bool #t) (Bool #t) (Bool #t))) err)) - - (test-judgment-holds (𝑬 (Prim1 'add1 (Prim1 'zero? (Bool #f))) err)) - (test-judgment-holds (𝑬 (Prim1 'sub1 (Prim1 'zero? (Bool #f))) err)) - (test-judgment-holds (𝑬 (Prim1 'zero? (Prim1 'zero? (Bool #f))) err)) - (test-judgment-holds (𝑬 (If (Prim1 'zero? (Bool #f)) (Int 1) (Int 2)) err))) diff --git a/extort/ast.rkt b/extort/syntax/ast.rkt similarity index 100% rename from extort/ast.rkt rename to extort/syntax/ast.rkt diff --git a/extort/parse.rkt b/extort/syntax/parse.rkt similarity index 100% rename from extort/parse.rkt rename to extort/syntax/parse.rkt diff --git a/extort/random.rkt b/extort/syntax/random.rkt similarity index 100% rename from extort/random.rkt rename to extort/syntax/random.rkt diff --git a/extort/test/all.rkt b/extort/test/all.rkt deleted file mode 100644 index 9bc3e3a..0000000 --- a/extort/test/all.rkt +++ /dev/null @@ -1,111 +0,0 @@ -#lang racket -(require "../compile.rkt" - "../interp.rkt" - "../interp-io.rkt" - "../parse.rkt" - "../types.rkt" - "../build-runtime.rkt" - a86/interp - rackunit) - -;; link with runtime for IO operations -;(unless (file-exists? "../runtime.o") -; (system "make -C .. runtime.o")) -(current-objs - (list (path->string runtime-path))) - -(define (test-runner run) - - ;; Abscond examples - (check-equal? (run 7) 7) - (check-equal? (run -8) -8) - - ;; Blackmail examples - (check-equal? (run '(add1 (add1 7))) 9) - (check-equal? (run '(add1 (sub1 7))) 7) - - ;; Con examples - (check-equal? (run '(if (zero? 0) 1 2)) 1) - (check-equal? (run '(if (zero? 1) 1 2)) 2) - (check-equal? (run '(if (zero? -7) 1 2)) 2) - (check-equal? (run '(if (zero? 0) - (if (zero? 1) 1 2) - 7)) - 2) - (check-equal? (run '(if (zero? (if (zero? 0) 1 0)) - (if (zero? 1) 1 2) - 7)) - 7) - - ;; Dupe examples - (check-equal? (run #t) #t) - (check-equal? (run #f) #f) - (check-equal? (run '(if #t 1 2)) 1) - (check-equal? (run '(if #f 1 2)) 2) - (check-equal? (run '(if 0 1 2)) 1) - (check-equal? (run '(if #t 3 4)) 3) - (check-equal? (run '(if #f 3 4)) 4) - (check-equal? (run '(if 0 3 4)) 3) - (check-equal? (run '(zero? 4)) #f) - (check-equal? (run '(zero? 0)) #t) - ;; Dodger examples - (check-equal? (run #\a) #\a) - (check-equal? (run #\b) #\b) - (check-equal? (run '(char? #\a)) #t) - (check-equal? (run '(char? #t)) #f) - (check-equal? (run '(char? 8)) #f) - (check-equal? (run '(char->integer #\a)) (char->integer #\a)) - (check-equal? (run '(integer->char 955)) #\λ) - - ;; Evildoer examples - (check-equal? (run '(void)) (void)) - (check-equal? (run '(begin 1 2)) 2) - (check-equal? (run '(eof-object? (void))) #f) - - ;; Extort examples - (check-equal? (run '(add1 #f)) 'err) - (check-equal? (run '(sub1 #f)) 'err) - (check-equal? (run '(zero? #f)) 'err) - (check-equal? (run '(char->integer #f)) 'err) - (check-equal? (run '(integer->char #f)) 'err) - (check-equal? (run '(integer->char -1)) 'err) - (check-equal? (run '(write-byte #f)) 'err) - (check-equal? (run '(write-byte -1)) 'err) - (check-equal? (run '(write-byte 256)) 'err) - (check-equal? (run '(begin (integer->char 97) - (integer->char 98))) - #\b)) - -(test-runner (λ (e) (interp (parse e)))) -(test-runner (λ (e) (match (asm-interp (compile (parse e))) - ['err 'err] - [bs (bits->value bs)]))) - -(define (test-runner-io run) - ;; Evildoer examples - (check-equal? (run 7 "") (cons 7 "")) - (check-equal? (run '(write-byte 97) "") (cons (void) "a")) - (check-equal? (run '(read-byte) "a") (cons 97 "")) - (check-equal? (run '(begin (write-byte 97) (read-byte)) "b") - (cons 98 "a")) - (check-equal? (run '(read-byte) "") (cons eof "")) - (check-equal? (run '(eof-object? (read-byte)) "") (cons #t "")) - (check-equal? (run '(eof-object? (read-byte)) "a") (cons #f "")) - (check-equal? (run '(begin (write-byte 97) (write-byte 98)) "") - (cons (void) "ab")) - - (check-equal? (run '(peek-byte) "ab") (cons 97 "")) - (check-equal? (run '(begin (peek-byte) (read-byte)) "ab") (cons 97 "")) - ;; Extort examples - (check-equal? (run '(write-byte #t) "") (cons 'err ""))) - -(test-runner-io (λ (e s) (interp/io (parse e) s))) -(test-runner-io (λ (e s) - (match (asm-interp/io (compile (parse e)) s) - [(cons 'err o) (cons 'err o)] - [(cons r o) - (cons (bits->value r) o)]))) - -;; run command line compiler and compare against Racket as refernece implementation -(require rackunit "../../test-programs/get-progs.rkt") -(for-each test-prog (get-progs "extort")) diff --git a/extort/test/compile.rkt b/extort/test/compile.rkt index 38cb738..aaeb50f 100644 --- a/extort/test/compile.rkt +++ b/extort/test/compile.rkt @@ -1,10 +1,10 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ (e) (exec (parse e)))) +(test (λ (e) (run (compile (parse e))))) -(test/io (λ (i e) (exec/io (parse e) i))) +(test/io (λ (i e) (run/io (compile (parse e)) i))) diff --git a/extort/test/interp.rkt b/extort/test/interp.rkt index 74d4a05..a987b86 100644 --- a/extort/test/interp.rkt +++ b/extort/test/interp.rkt @@ -1,7 +1,7 @@ #lang racket -(require "../interp.rkt") -(require "../interp-io.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ (e) (interp (parse e)))) diff --git a/extort/test/parse.rkt b/extort/test/parse.rkt index cefbeba..2aec3f6 100644 --- a/extort/test/parse.rkt +++ b/extort/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) diff --git a/fraud/Makefile b/fraud/Makefile index d88e2b9..5205a2f 100644 --- a/fraud/Makefile +++ b/fraud/Makefile @@ -8,9 +8,7 @@ endif objs = \ main.o \ - print.o \ - values.o \ - io.o + print.o default: runtime.o diff --git a/fraud/build-runtime.rkt b/fraud/build-runtime.rkt deleted file mode 100644 index 6699852..0000000 --- a/fraud/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(provide runtime-path) - -(require racket/runtime-path) -(define-runtime-path here ".") - -(unless (system (string-append "make -C '" - (path->string (normalize-path here)) - "' --no-print-directory -s runtime.o")) - (error 'build-runtime "could not build runtime")) - -(define runtime-path - (normalize-path (build-path here "runtime.o"))) - diff --git a/fraud/assert.rkt b/fraud/compiler/assert.rkt similarity index 96% rename from fraud/assert.rkt rename to fraud/compiler/assert.rkt index 9d88901..a22f93d 100644 --- a/fraud/assert.rkt +++ b/fraud/compiler/assert.rkt @@ -1,7 +1,7 @@ #lang racket (provide assert-integer assert-char assert-byte assert-codepoint) (require a86/ast) -(require "types.rkt") +(require "../runtime/types.rkt") ;; Register -> Asm (define (assert-integer r) diff --git a/fraud/compile-ops.rkt b/fraud/compiler/compile-ops.rkt similarity index 97% rename from fraud/compile-ops.rkt rename to fraud/compiler/compile-ops.rkt index dae38c3..f46c570 100644 --- a/fraud/compile-ops.rkt +++ b/fraud/compiler/compile-ops.rkt @@ -1,7 +1,7 @@ #lang racket (provide compile-op0 compile-op1 compile-op2 pad-stack) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require "assert.rkt") (require a86/ast a86/registers) diff --git a/fraud/compile-stdin.rkt b/fraud/compiler/compile-stdin.rkt similarity index 88% rename from fraud/compile-stdin.rkt rename to fraud/compiler/compile-stdin.rkt index b8e500c..dce355a 100644 --- a/fraud/compile-stdin.rkt +++ b/fraud/compiler/compile-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "compile.rkt") (require a86/printer) diff --git a/fraud/compile.rkt b/fraud/compiler/compile.rkt similarity index 97% rename from fraud/compile.rkt rename to fraud/compiler/compile.rkt index 40e2a15..c382f58 100644 --- a/fraud/compile.rkt +++ b/fraud/compiler/compile.rkt @@ -2,9 +2,9 @@ (provide compile compile-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; ClosedExpr -> Asm (define (compile e) diff --git a/fraud/correct.rkt b/fraud/correct.rkt index d286ba1..1a7846d 100644 --- a/fraud/correct.rkt +++ b/fraud/correct.rkt @@ -1,10 +1,11 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp-io.rkt") -(require "exec.rkt") +(require "interpreter/interp-io.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; ClosedExpr String -> Void (define (check-compiler e i) (check-equal? (interp/io e i) - (exec/io e i))) + (run/io (compile e) i))) diff --git a/fraud/correctness.rkt b/fraud/correctness.rkt deleted file mode 100644 index 2f05ab7..0000000 --- a/fraud/correctness.rkt +++ /dev/null @@ -1,10 +0,0 @@ -#lang racket -(provide (all-defined-out)) -(require "interp.rkt" "compile.rkt" "types.rkt" a86 rackunit) - -(define (check-compiler e) - (check-eqv? (match (asm-interp (compile e)) - ['err 'err] - [b (bits->value b)]) - (interp e) - e)) diff --git a/fraud/exec-io.rkt b/fraud/exec-io.rkt deleted file mode 100644 index d385fc4..0000000 --- a/fraud/exec-io.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require a86/interp) -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec/io) - -;; Expr String -> (cons Answer String) -(define (exec/io e in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io (compile e) in) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) - diff --git a/fraud/exec.rkt b/fraud/exec.rkt deleted file mode 100644 index 4ad3df2..0000000 --- a/fraud/exec.rkt +++ /dev/null @@ -1,15 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec exec/io) -;; Expr -> Answer -(define (exec e) - (run (compile e))) - -;; Expr String -> (cons Answer String) -(define (exec/io e in) - (run/io (compile e) in)) - diff --git a/fraud/executor/decode.rkt b/fraud/executor/decode.rkt new file mode 100644 index 0000000..89f3464 --- /dev/null +++ b/fraud/executor/decode.rkt @@ -0,0 +1,22 @@ +#lang racket + +(require "../runtime/types.rkt") +(require ffi/unsafe) + +(provide (all-defined-out)) + +;; Integer -> Value +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(= b (value->bits eof)) eof] + [(= b (value->bits (void))) (void)] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [(char-bits? b) + (integer->char (arithmetic-shift b (- char-shift)))] + [else (error "invalid bits")])) + +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/fraud/executor/exec.rkt b/fraud/executor/exec.rkt new file mode 100644 index 0000000..f6fccb2 --- /dev/null +++ b/fraud/executor/exec.rkt @@ -0,0 +1,54 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") + +(struct exec-state (program) #:transparent) + +(define (exec/state prog) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)) + (extern 'raise_error + (λ () (raise 'err)) + (_fun -> _void)))]) + (asm-load prog)))) + +(define (exec-call st) + (match-define (exec-state program) st) + (with-handlers ([(λ (x) (eq? x 'err)) identity]) + (asm-call program 'entry))) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/fraud/executor/run-stdin.rkt b/fraud/executor/run-stdin.rkt new file mode 100644 index 0000000..7e7170f --- /dev/null +++ b/fraud/executor/run-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") +(require "run.rkt") + +;; -> Void +;; Compile contents of stdin and use asm-interp to run +(define (main) + (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) + diff --git a/fraud/executor/run.rkt b/fraud/executor/run.rkt new file mode 100644 index 0000000..d96fe18 --- /dev/null +++ b/fraud/executor/run.rkt @@ -0,0 +1,20 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run run/io) +;; Asm -> Answer +(define (run asm) + (call-with-exec + asm + (λ (r) + (match r + ['err 'err] + [b (bits->value b)])))) +;; Asm String -> (cons Answer String) +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) + diff --git a/fraud/interp-lexical.rkt b/fraud/interp-lexical.rkt deleted file mode 100644 index 0d12198..0000000 --- a/fraud/interp-lexical.rkt +++ /dev/null @@ -1,42 +0,0 @@ -#lang racket -(provide (all-defined-out)) -(require "ast.rkt" "translate.rkt" "interp-prim.rkt") - -;; type VEnv = (Listof Value) - -;; Expr -> Answer -(define (interp e) - (interp-env (translate e) '())) - -;; IExpr VEnv -> Answer -(define (interp-env e r) - (match e - [(Lit d) d] - [(Eof) eof] - [(Var a) (list-ref r a)] - [(Prim0 p) (interp-prim0 p)] - [(Prim1 p e) - (match (interp-env e r) - ['err 'err] - [v (interp-prim1 p v)])] - [(Prim2 p e1 e2) - (match (interp-env e1 r) - ['err 'err] - [v1 (match (interp-env e2 r) - ['err 'err] - [v2 (interp-prim2 p v1 v2)])])] - [(If p e1 e2) - (match (interp-env p r) - ['err 'err] - [v - (if v - (interp-env e1 r) - (interp-env e2 r))])] - [(Begin e1 e2) - (match (interp-env e1 r) - ['err 'err] - [v (interp-env e2 r)])] - [(Let '_ e1 e2) - (match (interp-env e1 r) - ['err 'err] - [v (interp-env e2 (cons v r))])])) diff --git a/fraud/env.rkt b/fraud/interpreter/env.rkt similarity index 100% rename from fraud/env.rkt rename to fraud/interpreter/env.rkt diff --git a/fraud/interp-io.rkt b/fraud/interpreter/interp-io.rkt similarity index 100% rename from fraud/interp-io.rkt rename to fraud/interpreter/interp-io.rkt diff --git a/fraud/interp-prim.rkt b/fraud/interpreter/interp-prim.rkt similarity index 100% rename from fraud/interp-prim.rkt rename to fraud/interpreter/interp-prim.rkt diff --git a/fraud/interp-stdin.rkt b/fraud/interpreter/interp-stdin.rkt similarity index 87% rename from fraud/interp-stdin.rkt rename to fraud/interpreter/interp-stdin.rkt index 0a8c3e6..35ce332 100644 --- a/fraud/interp-stdin.rkt +++ b/fraud/interpreter/interp-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "interp.rkt") ;; -> Void diff --git a/fraud/interp.rkt b/fraud/interpreter/interp.rkt similarity index 97% rename from fraud/interp.rkt rename to fraud/interpreter/interp.rkt index 959c1a0..0f2e86d 100644 --- a/fraud/interp.rkt +++ b/fraud/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp interp-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") (require "env.rkt") diff --git a/fraud/main.c b/fraud/main.c deleted file mode 100644 index 5f17cbd..0000000 --- a/fraud/main.c +++ /dev/null @@ -1,36 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - - val_t result; - - result = entry(); - print_result(result); - if (val_typeof(result) != T_VOID) - putchar('\n'); - - return 0; -} diff --git a/fraud/main.rkt b/fraud/main.rkt index 50cf56e..f9851a3 100644 --- a/fraud/main.rkt +++ b/fraud/main.rkt @@ -1,18 +1,18 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "interp-io.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "interp-io.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "types.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/fraud/run-stdin.rkt b/fraud/run-stdin.rkt deleted file mode 100644 index 16cf99e..0000000 --- a/fraud/run-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require "run.rkt") - -;; -> Void -;; Compile contents of stdin and use asm-interp to run -(define (main) - (read-line) ; ignore #lang racket line - (run (compile (parse (read))))) - diff --git a/fraud/run.rkt b/fraud/run.rkt deleted file mode 100644 index e707f3b..0000000 --- a/fraud/run.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require a86/interp) -(require "types.rkt") -(require "build-runtime.rkt") -(provide run run/io) - -;; Run instructions with run-time system linked in - -;; Asm -> Answer -(define (run is) - (match (run/io is "") - [(cons r out) (begin (display out) r)])) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - -;; Asm String -> (cons Answer String) -(define (run/io is in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io is in) - [(cons 'err out) (cons 'err out)] - [(cons b out) - (cons (bits->value b) out)]))) - diff --git a/fraud/runtime.h b/fraud/runtime.h deleted file mode 100644 index 0a066ad..0000000 --- a/fraud/runtime.h +++ /dev/null @@ -1,10 +0,0 @@ -#ifndef RUNTIME_H -#define RUNTIME_H - -#include "values.h" - -val_t entry(); -extern FILE* in; -extern FILE* out; -extern void (*error_handler)(); -#endif /* RUNTIME_H */ diff --git a/fraud/runtime/Makefile b/fraud/runtime/Makefile new file mode 100644 index 0000000..5582813 --- /dev/null +++ b/fraud/runtime/Makefile @@ -0,0 +1,28 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o \ + values.o \ + io.o \ + error.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/fraud/runtime/error.c b/fraud/runtime/error.c new file mode 100644 index 0000000..69a535a --- /dev/null +++ b/fraud/runtime/error.c @@ -0,0 +1,9 @@ +#include +#include +#include "runtime.h" + +_Noreturn void raise_error(void) +{ + printf("err\n"); + exit(1); +} diff --git a/hoax/io.c b/fraud/runtime/io.c similarity index 74% rename from hoax/io.c rename to fraud/runtime/io.c index 8a417c9..139dccb 100644 --- a/hoax/io.c +++ b/fraud/runtime/io.c @@ -6,20 +6,20 @@ val_t read_byte(void) { - char c = getc(in); + char c = getc(stdin); return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); } val_t peek_byte(void) { - char c = getc(in); - ungetc(c, in); + char c = getc(stdin); + ungetc(c, stdin); return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); } val_t write_byte(val_t c) { - putc((char) val_unwrap_int(c), out); + putc((char) val_unwrap_int(c), stdout); return val_wrap_void(); } diff --git a/fraud/runtime/main.c b/fraud/runtime/main.c new file mode 100644 index 0000000..bac0f02 --- /dev/null +++ b/fraud/runtime/main.c @@ -0,0 +1,16 @@ +#include +#include +#include "values.h" +#include "print.h" +#include "runtime.h" + +int main(int argc, char** argv) +{ + val_t result = entry(); + + print_result(result); + if (val_typeof(result) != T_VOID) + putchar('\n'); + + return 0; +} diff --git a/fraud/print.c b/fraud/runtime/print.c similarity index 100% rename from fraud/print.c rename to fraud/runtime/print.c diff --git a/fraud/print.h b/fraud/runtime/print.h similarity index 100% rename from fraud/print.h rename to fraud/runtime/print.h diff --git a/fraud/runtime/runtime.h b/fraud/runtime/runtime.h new file mode 100644 index 0000000..fb6a288 --- /dev/null +++ b/fraud/runtime/runtime.h @@ -0,0 +1,14 @@ +#ifndef RUNTIME_H +#define RUNTIME_H + +#include "values.h" + +val_t entry(); + +val_t read_byte(void); +val_t peek_byte(void); +val_t write_byte(val_t); + +_Noreturn void raise_error(void); + +#endif /* RUNTIME_H */ diff --git a/fraud/types.h b/fraud/runtime/types.h similarity index 100% rename from fraud/types.h rename to fraud/runtime/types.h diff --git a/fraud/types.rkt b/fraud/runtime/types.rkt similarity index 62% rename from fraud/types.rkt rename to fraud/runtime/types.rkt index 827e0f1..7a5f023 100644 --- a/fraud/types.rkt +++ b/fraud/runtime/types.rkt @@ -7,18 +7,6 @@ (define type-char #b01) (define mask-char #b11) -;; Integer -> Value -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(= b (value->bits eof)) eof] - [(= b (value->bits (void))) (void)] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [else (error "invalid bits")])) - ;; Value -> Integer (define (value->bits v) diff --git a/fraud/values.c b/fraud/runtime/values.c similarity index 100% rename from fraud/values.c rename to fraud/runtime/values.c diff --git a/fraud/values.h b/fraud/runtime/values.h similarity index 100% rename from fraud/values.h rename to fraud/runtime/values.h diff --git a/fraud/semantics.rkt b/fraud/semantics.rkt deleted file mode 100644 index 47abe97..0000000 --- a/fraud/semantics.rkt +++ /dev/null @@ -1,297 +0,0 @@ -#lang racket -(provide F F-concrete F-pre 𝑭 𝑭-𝒆𝒏𝒗 lookup ext) -(require redex/reduction-semantics - "../extort/semantics.rkt") - -; for use in presentations (informally noting x can't be let, etc.) -(define-extended-language F-pre E-concrete - (e ::= .... x (let ((x e)) e) (p e)) - (p ::= add1 sub1 zero?) - (x ::= variable)) - -;; the real grammar language -(define-extended-language F-concrete F-pre - (x ::= variable-not-otherwise-mentioned) - (r ::= ((x v) ...))) - -(define-extended-language F E - (x ::= variable) - (r ::= ((x v) ...)) - (e ::= .... (Var x) (Let x e e))) - -(module+ test - (test-equal (redex-match? F-concrete e (term x)) #t) - (test-equal (redex-match? F-concrete e (term let)) #f) - (test-equal (redex-match? F-concrete e (term (let ((x 1)) x))) #t) - (test-equal (redex-match? F-concrete e (term (let ((let 1)) 3))) #f)) - -(module+ test - (test-equal (redex-match? F-pre e (term x)) #t) - (test-equal (redex-match? F-pre e (term let)) #t) - (test-equal (redex-match? F-pre e (term (let ((x 1)) x))) #t) - (test-equal (redex-match? F-pre e (term (let ((let 1)) 3))) #t)) - -(module+ test - (test-equal (redex-match? F e (term (Var x))) #t) - (test-equal (redex-match? F e (term (Var let))) #t) - (test-equal (redex-match? F e (term (Let x (Int 1) (Var x)))) #t) - (test-equal (redex-match? F e (term (Let let (Int 1) (Int 3)))) #t)) - -(define-judgment-form F - #:contract (𝑭 e a) - #:mode (𝑭 I O) - [(𝑭-𝒆𝒏𝒗 e () a) - ---------- "mt-env" - (𝑭 e a)]) - -(define-judgment-form F - #:contract (𝑭-𝒆𝒏𝒗 e r a) - #:mode (𝑭-𝒆𝒏𝒗 I I O) - - ;; Value - [----------- "int-lit" - (𝑭-𝒆𝒏𝒗 (Int i) r i)] - [----------- "bool-lit" - (𝑭-𝒆𝒏𝒗 (Bool b) r b)] - - ;; If - [(𝑭-𝒆𝒏𝒗 e_0 r v_0) (side-condition (is-true v_0)) (𝑭-𝒆𝒏𝒗 e_1 r a) - -------- "if-true" - (𝑭-𝒆𝒏𝒗 (If e_0 e_1 e_2) r a)] - - [(𝑭-𝒆𝒏𝒗 e_0 r v_0) (side-condition (is-false v_0)) (𝑭-𝒆𝒏𝒗 e_2 r a) - -------- "if-false" - (𝑭-𝒆𝒏𝒗 (If e_0 e_1 e_2) r a)] - - [(𝑭-𝒆𝒏𝒗 e_0 r err) - -------- "if-err" - (𝑭-𝒆𝒏𝒗 (If e_0 e_1 e_2) r err)] - - ;; Let and variable - [(where a (lookup r x)) - ----------- "var" - (𝑭-𝒆𝒏𝒗 (Var x) r a)] - - [(𝑭-𝒆𝒏𝒗 e_0 r v_0) (𝑭-𝒆𝒏𝒗 e_1 (ext r x v_0) a) - ----- "let" - (𝑭-𝒆𝒏𝒗 (Let x e_0 e_1) r a)] - - [(𝑭-𝒆𝒏𝒗 e_0 r err) - ----------- "let-err" - (𝑭-𝒆𝒏𝒗 (Let x e_0 e_1) r err)] - - ;; Primitive application - [(𝑭-𝒆𝒏𝒗 e_0 r a_0) - ----------- "prim" - (𝑭-𝒆𝒏𝒗 (Prim1 p1 e_0) r (𝑭-𝒑𝒓𝒊𝒎 p1 a_0))]) - -(module+ test - (test-judgment-holds (𝑭 (Int 7) 7)) - (test-judgment-holds (𝑭 (Prim1 'add1 (Int 7)) 8)) - - (test-judgment-holds (𝑭 (Prim1 'add1 (Bool #f)) err)) - - (test-judgment-holds (𝑭 (Let x (Int 7) (Int 8)) 8)) - (test-judgment-holds (𝑭 (Let x (Int 7) (Var x)) 7)) - (test-judgment-holds (𝑭 (Let x (Int 7) (Prim1 'add1 (Var x))) 8)) - (test-judgment-holds (𝑭 (Prim1 'sub1 (Let x (Int 7) (Prim1 'add1 (Var x)))) 7)) - (test-judgment-holds (𝑭 (Prim1 'sub1 (Let x (Int 7) - (Let y (Var x) - (Prim1 'add1 (Var x))))) - 7)) - (test-judgment-holds (𝑭 (Prim1 'sub1 (Let x (Int 7) - (Let x (Int 8) - (Prim1 'add1 (Var x))))) - 8))) - -;; replace any free variables with 0 -(define-metafunction F - F-close-with-zero : e (x ...) -> e - [(F-close-with-zero (Var x) (x_0 ... x x_1 ...)) (Var x)] - [(F-close-with-zero (Var x) any) (Int 0)] - [(F-close-with-zero (Int i) any) (Int i)] - [(F-close-with-zero (Bool b) any) (Bool b)] - [(F-close-with-zero (If e_1 e_2 e_3) any_r) - (If (F-close-with-zero e_1 any_r) - (F-close-with-zero e_2 any_r) - (F-close-with-zero e_3 any_r))] - [(F-close-with-zero (Prim1 p1 e_1) any_r) - (Prim1 p1 (close-with-zero e_1 any_r))] - #;[(F-close-with-zero (Prim2 p2 e_1 e_2) any_r) - (Prim2 p2 - (close-with-zero e_1 any_r) - (close-with-zero e_2 any_r))] - [(F-close-with-zero (Let x e_1 e_2) (x_0 ...)) - (Let x (close-with-zero e_1 (x_0 ...)) - (close-with-zero e_2 (x x_0 ...)))]) - - -(module+ test - (require rackunit) - ;; Check that the semantics is total function on closed expressions - (redex-check F e - (redex-let F ([e_0 (term (F-close-with-zero e ()))]) - (check-true (redex-match? F (a_0) (judgment-holds (𝑭 e_0 a) a)) (format "~a" (term e)))) - #:print? #f)) - - - -;;;;;;; - - -(provide G G-concrete 𝑮 𝑮-𝒆𝒏𝒗 𝑭-𝒑𝒓𝒊𝒎) - -(define-extended-language G-concrete F-concrete - (e ::= x i b (if e e e) (let ((x e)) e) (p1 e) (p2 e e)) - (p2 ::= + - < =) - (p1 ::= add1 sub1 zero?) - (p ::= p1 p2)) - -(define-extended-language G F - (e ::= .... (Prim2 p2 e e)) - (p2 ::= '+ '- '< '=) - (p ::= p1 p2)) - -(define-judgment-form G - #:contract (𝑮 e a) - #:mode (𝑮 I O) - [(𝑮-𝒆𝒏𝒗 e () a) - ---------- - (𝑮 e a)]) - -(define-judgment-form G - #:contract (𝑮-𝒆𝒏𝒗 e r a) - #:mode (𝑮-𝒆𝒏𝒗 I I O) - - ;; Value - [----------- "int-lit" - (𝑮-𝒆𝒏𝒗 (Int i) r i)] - [----------- "bool-lit" - (𝑮-𝒆𝒏𝒗 (Bool b) r b)] - - ;; If - [(𝑮-𝒆𝒏𝒗 e_0 r v_0) (side-condition (is-true v_0)) (𝑮-𝒆𝒏𝒗 e_1 r a) - -------- "if-true" - (𝑮-𝒆𝒏𝒗 (If e_0 e_1 e_2) r a)] - - [(𝑮-𝒆𝒏𝒗 e_0 r v_0) (side-condition (is-false v_0)) (𝑮-𝒆𝒏𝒗 e_2 r a) - -------- "if-false" - (𝑮-𝒆𝒏𝒗 (If e_0 e_1 e_2) r a)] - - [(𝑮-𝒆𝒏𝒗 e_0 r err) - -------- "if-err" - (𝑮-𝒆𝒏𝒗 (If e_0 e_1 e_2) r err)] - - ;; Let and variable - [(where a (lookup r x)) - ----------- "var" - (𝑮-𝒆𝒏𝒗 (Var x) r a)] - - [(𝑮-𝒆𝒏𝒗 e_0 r v_0) (𝑮-𝒆𝒏𝒗 e_1 (ext r x v_0) a) - ----- "let" - (𝑮-𝒆𝒏𝒗 (Let x e_0 e_1) r a)] - - [(𝑮-𝒆𝒏𝒗 e_0 r err) - ----------- "let-err" - (𝑮-𝒆𝒏𝒗 (Let x e_0 e_1) r err)] - - ;; Primitive application - [(𝑮-𝒆𝒏𝒗 e_0 r a_0) - ----------- "prim1" - (𝑮-𝒆𝒏𝒗 (Prim1 p1 e_0) r (𝑭-𝒑𝒓𝒊𝒎 p1 a_0))] - - [(𝑮-𝒆𝒏𝒗 e_0 r a_0) - (𝑮-𝒆𝒏𝒗 e_1 r a_1) - ----------- "prim2" - (𝑮-𝒆𝒏𝒗 (Prim2 p2 e_0 e_1) r (𝑭-𝒑𝒓𝒊𝒎 p2 a_0 a_1))]) - -(define-metafunction G - 𝑭-𝒑𝒓𝒊𝒎 : p a ... -> a - [(𝑭-𝒑𝒓𝒊𝒎 p v ... err _ ...) err] - [(𝑭-𝒑𝒓𝒊𝒎 'add1 i_0) ,(+ (term i_0) (term 1))] - [(𝑭-𝒑𝒓𝒊𝒎 'sub1 i_0) ,(- (term i_0) (term 1))] - [(𝑭-𝒑𝒓𝒊𝒎 'zero? 0) #t] - [(𝑭-𝒑𝒓𝒊𝒎 'zero? i) #f] - [(𝑭-𝒑𝒓𝒊𝒎 '+ i_0 i_1) ,(+ (term i_0) (term i_1))] - [(𝑭-𝒑𝒓𝒊𝒎 '- i_0 i_1) ,(- (term i_0) (term i_1))] - [(𝑭-𝒑𝒓𝒊𝒎 '< i_0 i_1) ,(< (term i_0) (term i_1))] - [(𝑭-𝒑𝒓𝒊𝒎 '= i_0 i_1) ,(< (term i_0) (term i_1))] - [(𝑭-𝒑𝒓𝒊𝒎 _ ...) err]) - -(define-metafunction G - ext : r x v -> r - [(ext ((x_0 v_0) ...) x v) - ((x v) (x_0 v_0) ...)]) - -(define-metafunction G - lookup : r x -> a - [(lookup ((x v) (x_1 v_1) ...) x) v] - [(lookup ((x_0 v_0) (x_1 v_1) ...) x) - (lookup ((x_1 v_1) ...) x)]) - -(define-metafunction G - is-true : v -> boolean - [(is-true #f) #f] - [(is-true v) #t]) - -(define-metafunction G - is-false : v -> boolean - [(is-false #f) #t] - [(is-false v) #f]) - -(module+ test - (test-judgment-holds (𝑮 (Int 7) 7)) - (test-judgment-holds (𝑮 (Prim1 'add1 (Int 7)) 8)) - - (test-judgment-holds (𝑮 (Prim1 'add1 (Bool #f)) err)) - - (test-judgment-holds (𝑮 (Let x (Int 7) (Int 8)) 8)) - (test-judgment-holds (𝑮 (Let x (Int 7) (Var x)) 7)) - (test-judgment-holds (𝑮 (Let x (Int 7) (Prim1 'add1 (Var x))) 8)) - (test-judgment-holds (𝑮 (Prim1 'sub1 (Let x (Int 7) (Prim1 'add1 (Var x)))) 7)) - (test-judgment-holds (𝑮 (Prim1 'sub1 (Let x (Int 7) - (Let y (Var x) - (Prim1 'add1 (Var x))))) - 7)) - (test-judgment-holds (𝑮 (Prim1 'sub1 (Let x (Int 7) - (Let x (Int 8) - (Prim1 'add1 (Var x))))) - 8)) - - (test-judgment-holds (𝑮 (Prim2 '+ (Int 1) (Int 2)) 3)) - (test-judgment-holds (𝑮 (Prim2 '- (Int 1) (Int 2)) -1)) - (test-judgment-holds (𝑮 (Prim1 'add1 (Bool #f)) err)) - (test-judgment-holds (𝑮 (If (Prim1 'add1 (Bool #f)) (Int 1) (Int 2)) err)) - (test-judgment-holds (𝑮 (Prim2 '+ (Int 1) (Prim1 'add1 (Bool #f))) err)) - (test-judgment-holds (𝑮 (Prim2 '+ (Int 1) (Bool #f)) err)) - (test-judgment-holds (𝑮 (Prim2 '- (Int 1) (Bool #f)) err)) - (test-judgment-holds (𝑮 (Prim2 '- (Prim1 'add1 (Bool #f)) (Bool #f)) err))) - -;; replace any free variables with 0 -(define-metafunction G - close-with-zero : e (x ...) -> e - [(close-with-zero (Var x) (x_0 ... x x_1 ...)) (Var x)] - [(close-with-zero (Var x) any) (Int 0)] - [(close-with-zero (Int i) any) (Int i)] - [(close-with-zero (Bool b) any) (Bool b)] - [(close-with-zero (If e_1 e_2 e_3) any_r) - (If (close-with-zero e_1 any_r) - (close-with-zero e_2 any_r) - (close-with-zero e_3 any_r))] - [(close-with-zero (Prim1 p1 e_1) any_r) - (Prim1 p1 (close-with-zero e_1 any_r))] - [(close-with-zero (Prim2 p2 e_1 e_2) any_r) - (Prim2 p2 - (close-with-zero e_1 any_r) - (close-with-zero e_2 any_r))] - [(close-with-zero (Let x e_1 e_2) (x_0 ...)) - (Let x (close-with-zero e_1 (x_0 ...)) - (close-with-zero e_2 (x x_0 ...)))]) - -(module+ test - (require rackunit) - ;; Check that the semantics is total function -- for closed expressions - (redex-check G e - (redex-let G ([e_0 (term (close-with-zero e ()))]) - (check-true (redex-match? G (a_0) (judgment-holds (𝑮 e_0 a) a)))) - #:print? #f)) diff --git a/fraud/ast.rkt b/fraud/syntax/ast.rkt similarity index 100% rename from fraud/ast.rkt rename to fraud/syntax/ast.rkt diff --git a/fraud/parse.rkt b/fraud/syntax/parse.rkt similarity index 100% rename from fraud/parse.rkt rename to fraud/syntax/parse.rkt diff --git a/fraud/random.rkt b/fraud/syntax/random.rkt similarity index 100% rename from fraud/random.rkt rename to fraud/syntax/random.rkt diff --git a/fraud/translate.rkt b/fraud/syntax/translate.rkt similarity index 100% rename from fraud/translate.rkt rename to fraud/syntax/translate.rkt diff --git a/fraud/test/compile.rkt b/fraud/test/compile.rkt index 3d22968..fabb24f 100644 --- a/fraud/test/compile.rkt +++ b/fraud/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ (e) (exec (parse-closed e)))) -(test/io (λ (i e) (exec/io (parse-closed e) i))) +(test (λ (e) (run (compile (parse-closed e))))) +(test/io (λ (i e) (run/io (compile (parse-closed e)) i))) diff --git a/fraud/test/interp-lexical.rkt b/fraud/test/interp-lexical.rkt deleted file mode 100644 index cc6eda1..0000000 --- a/fraud/test/interp-lexical.rkt +++ /dev/null @@ -1,10 +0,0 @@ -#lang racket -(require rackunit) -(require "../interp-lexical.rkt" "../parse.rkt") -(define (run p) - (interp (parse p))) -(check-equal? (run 5) 5) -(check-equal? (run '(let ((x 0)) x)) 0) -(check-equal? (run '(let ((x 0)) (let ((y 1)) x))) 0) -(check-equal? (run '(let ((x 0)) (let ((y 1)) y))) 1) -(check-equal? (run '(let ((x 0)) (let ((y x)) y))) 0) diff --git a/fraud/test/interp.rkt b/fraud/test/interp.rkt index 0a2dab1..acb6a86 100644 --- a/fraud/test/interp.rkt +++ b/fraud/test/interp.rkt @@ -1,7 +1,7 @@ #lang racket -(require "../interp.rkt") -(require "../interp-io.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ (e) (interp (parse-closed e)))) (test/io (λ (in e) (interp/io (parse-closed e) in))) diff --git a/fraud/test/parse.rkt b/fraud/test/parse.rkt index 9573d4f..5b11a10 100644 --- a/fraud/test/parse.rkt +++ b/fraud/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) diff --git a/fraud/test/test-progs.rkt b/fraud/test/test-progs.rkt deleted file mode 100644 index b765151..0000000 --- a/fraud/test/test-progs.rkt +++ /dev/null @@ -1,4 +0,0 @@ -#lang racket -;; run command line compiler and compare against Racket as refernece implementation -(require rackunit "../../test-programs/get-progs.rkt") -(for-each test-prog (get-progs "fraud")) diff --git a/fraud/test/translate.rkt b/fraud/test/translate.rkt index f83844b..b29bb3f 100644 --- a/fraud/test/translate.rkt +++ b/fraud/test/translate.rkt @@ -1,7 +1,7 @@ #lang racket -(require "../translate.rkt") -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/translate.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (check-equal? (translate (parse '(let ((x 0)) x))) (Let '_ (Lit 0) (Var 0))) diff --git a/hoax/Makefile b/hoax/Makefile index a835720..d88e2b9 100644 --- a/hoax/Makefile +++ b/hoax/Makefile @@ -12,12 +12,7 @@ objs = \ values.o \ io.o -default: submit.zip - -submit.zip: - zip submit.zip -r * \ - -x \*.[os] -x \*~ -x \*zip \ - -x \*Zone.Identifier -x \*\*compiled\*\* +default: runtime.o runtime.o: $(objs) ld -r $(objs) -o runtime.o diff --git a/hoax/build-runtime.rkt b/hoax/build-runtime.rkt deleted file mode 100644 index 6699852..0000000 --- a/hoax/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(provide runtime-path) - -(require racket/runtime-path) -(define-runtime-path here ".") - -(unless (system (string-append "make -C '" - (path->string (normalize-path here)) - "' --no-print-directory -s runtime.o")) - (error 'build-runtime "could not build runtime")) - -(define runtime-path - (normalize-path (build-path here "runtime.o"))) - diff --git a/iniquity/assert.rkt b/hoax/compiler/assert.rkt similarity index 97% rename from iniquity/assert.rkt rename to hoax/compiler/assert.rkt index cfc110a..380fc8d 100644 --- a/iniquity/assert.rkt +++ b/hoax/compiler/assert.rkt @@ -3,7 +3,7 @@ assert-box assert-cons assert-natural assert-vector assert-string) (require a86/ast) -(require "types.rkt") +(require "../runtime/types.rkt") (define (assert-type mask type) (λ (r) diff --git a/knock/compile-ops.rkt b/hoax/compiler/compile-ops.rkt similarity index 97% rename from knock/compile-ops.rkt rename to hoax/compiler/compile-ops.rkt index 1bb76cb..1a58a86 100644 --- a/knock/compile-ops.rkt +++ b/hoax/compiler/compile-ops.rkt @@ -1,7 +1,7 @@ #lang racket (provide compile-op0 compile-op1 compile-op2 compile-op3 pad-stack) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require "assert.rkt") (require a86/ast a86/registers) @@ -222,8 +222,8 @@ (Mov r9 (Mem r8 (- type-vect))) (Cmp r10 r9) (Jge 'err) - (Sar r10 1) ; convert to byte offset - (Mov (Mem r8 r10 (- 8 type-vect)) rax) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) (Mov rax (value->bits (void))))])) (define (type-pred mask type) diff --git a/hoax/compile-stdin.rkt b/hoax/compiler/compile-stdin.rkt similarity index 88% rename from hoax/compile-stdin.rkt rename to hoax/compiler/compile-stdin.rkt index b8e500c..dce355a 100644 --- a/hoax/compile-stdin.rkt +++ b/hoax/compiler/compile-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "compile.rkt") (require a86/printer) diff --git a/hoax/compile.rkt b/hoax/compiler/compile.rkt similarity index 98% rename from hoax/compile.rkt rename to hoax/compiler/compile.rkt index 6b1b86f..40e2570 100644 --- a/hoax/compile.rkt +++ b/hoax/compiler/compile.rkt @@ -2,9 +2,9 @@ (provide compile compile-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; ClosedExpr -> Asm (define (compile e) diff --git a/hoax/correct.rkt b/hoax/correct.rkt index d286ba1..1a7846d 100644 --- a/hoax/correct.rkt +++ b/hoax/correct.rkt @@ -1,10 +1,11 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp-io.rkt") -(require "exec.rkt") +(require "interpreter/interp-io.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; ClosedExpr String -> Void (define (check-compiler e i) (check-equal? (interp/io e i) - (exec/io e i))) + (run/io (compile e) i))) diff --git a/hoax/exec-io.rkt b/hoax/exec-io.rkt deleted file mode 100644 index d385fc4..0000000 --- a/hoax/exec-io.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require a86/interp) -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec/io) - -;; Expr String -> (cons Answer String) -(define (exec/io e in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io (compile e) in) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) - diff --git a/hoax/exec.rkt b/hoax/exec.rkt deleted file mode 100644 index 4ad3df2..0000000 --- a/hoax/exec.rkt +++ /dev/null @@ -1,15 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec exec/io) -;; Expr -> Answer -(define (exec e) - (run (compile e))) - -;; Expr String -> (cons Answer String) -(define (exec/io e in) - (run/io (compile e) in)) - diff --git a/knock/types.rkt b/hoax/executor/decode.rkt similarity index 50% rename from knock/types.rkt rename to hoax/executor/decode.rkt index c0c1d70..6ee214f 100644 --- a/knock/types.rkt +++ b/hoax/executor/decode.rkt @@ -1,20 +1,9 @@ #lang racket -(provide (all-defined-out)) + +(require "../runtime/types.rkt") (require ffi/unsafe) -(define imm-shift 3) -(define imm-mask #b111) -(define ptr-mask #b111) -(define type-box #b001) -(define type-cons #b010) -(define type-vect #b011) -(define type-str #b100) -(define int-shift (+ 1 imm-shift)) -(define mask-int #b1111) -(define char-shift (+ 2 imm-shift)) -(define type-int #b0000) -(define type-char #b01000) -(define mask-char #b11111) +(provide (all-defined-out)) ;; Integer -> Value (define (bits->value b) @@ -45,44 +34,12 @@ (integer->char (mem-ref32 (+ p 8 (* 4 j)))))))] [else (error "invalid bits")])) -;; Value -> Integer -;; v must be an immediate -(define (value->bits v) - (cond [(eq? v #t) #b00011000] - [(eq? v #f) #b00111000] - [(eq? v eof) #b01011000] - [(eq? v (void)) #b01111000] - [(eq? v '()) #b10011000] - [(integer? v) (arithmetic-shift v int-shift)] - [(char? v) - (bitwise-ior type-char - (arithmetic-shift (char->integer v) char-shift))] - [else (error "not an immediate value" v)])) - -(define (int-bits? v) - (= type-int (bitwise-and v mask-int))) - -(define (char-bits? v) - (= type-char (bitwise-and v mask-char))) - -(define (imm-bits? v) - (zero? (bitwise-and v imm-mask))) - -(define (cons-bits? v) - (= type-cons (bitwise-and v imm-mask))) - -(define (box-bits? v) - (= type-box (bitwise-and v imm-mask))) - -(define (vect-bits? v) - (= type-vect (bitwise-and v imm-mask))) - -(define (str-bits? v) - (= type-str (bitwise-and v imm-mask))) - (define (mem-ref i) (ptr-ref (cast i _int64 _pointer) _int64)) (define (mem-ref32 i) (ptr-ref (cast i _int64 _pointer) _int32)) +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/hoax/executor/exec.rkt b/hoax/executor/exec.rkt new file mode 100644 index 0000000..cd5745e --- /dev/null +++ b/hoax/executor/exec.rkt @@ -0,0 +1,55 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") +(struct exec-state (program heap) #:transparent) + +(define (exec/state prog) + (define heap (malloc _int64 10000)) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)) + (extern 'raise_error + (λ () (raise 'err)) + (_fun -> _void)))]) + (asm-load prog)) + heap)) + +(define (exec-call st) + (match-define (exec-state program heap) st) + (with-handlers ([(λ (x) (eq? x 'err)) identity]) + (asm-call program 'entry heap))) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/hoax/executor/run-stdin.rkt b/hoax/executor/run-stdin.rkt new file mode 100644 index 0000000..7e7170f --- /dev/null +++ b/hoax/executor/run-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") +(require "run.rkt") + +;; -> Void +;; Compile contents of stdin and use asm-interp to run +(define (main) + (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) + diff --git a/hoax/executor/run.rkt b/hoax/executor/run.rkt new file mode 100644 index 0000000..d96fe18 --- /dev/null +++ b/hoax/executor/run.rkt @@ -0,0 +1,20 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run run/io) +;; Asm -> Answer +(define (run asm) + (call-with-exec + asm + (λ (r) + (match r + ['err 'err] + [b (bits->value b)])))) +;; Asm String -> (cons Answer String) +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) + diff --git a/hoax/env.rkt b/hoax/interpreter/env.rkt similarity index 100% rename from hoax/env.rkt rename to hoax/interpreter/env.rkt diff --git a/hoax/heap-bits.rkt b/hoax/interpreter/heap-bits.rkt similarity index 98% rename from hoax/heap-bits.rkt rename to hoax/interpreter/heap-bits.rkt index 961044e..7d8d4c8 100644 --- a/hoax/heap-bits.rkt +++ b/hoax/interpreter/heap-bits.rkt @@ -1,5 +1,5 @@ #lang racket -(require "types.rkt") +(require "../runtime/types.rkt") (provide (struct-out heap) heap-ref heap-set! alloc-box alloc-cons alloc-vect alloc-str) diff --git a/hoax/heap.rkt b/hoax/interpreter/heap.rkt similarity index 100% rename from hoax/heap.rkt rename to hoax/interpreter/heap.rkt diff --git a/hoax/interp-heap-bits.rkt b/hoax/interpreter/interp-heap-bits.rkt similarity index 97% rename from hoax/interp-heap-bits.rkt rename to hoax/interpreter/interp-heap-bits.rkt index 60991ae..63e46d2 100644 --- a/hoax/interp-heap-bits.rkt +++ b/hoax/interpreter/interp-heap-bits.rkt @@ -1,7 +1,7 @@ #lang racket (provide interp) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require "env.rkt") (require "heap-bits.rkt") (require "interp-prims-heap-bits.rkt") diff --git a/hoax/interp-heap.rkt b/hoax/interpreter/interp-heap.rkt similarity index 98% rename from hoax/interp-heap.rkt rename to hoax/interpreter/interp-heap.rkt index 9244824..4e3e85c 100644 --- a/hoax/interp-heap.rkt +++ b/hoax/interpreter/interp-heap.rkt @@ -3,7 +3,7 @@ (require "env.rkt") (require "unload.rkt") (require "interp-prims-heap.rkt") -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "heap.rkt") ;; type Answer* = diff --git a/hoax/interp-io.rkt b/hoax/interpreter/interp-io.rkt similarity index 100% rename from hoax/interp-io.rkt rename to hoax/interpreter/interp-io.rkt diff --git a/hoax/interp-prim.rkt b/hoax/interpreter/interp-prim.rkt similarity index 100% rename from hoax/interp-prim.rkt rename to hoax/interpreter/interp-prim.rkt diff --git a/hoax/interp-prims-heap-bits.rkt b/hoax/interpreter/interp-prims-heap-bits.rkt similarity index 99% rename from hoax/interp-prims-heap-bits.rkt rename to hoax/interpreter/interp-prims-heap-bits.rkt index c8dab81..0e27e98 100644 --- a/hoax/interp-prims-heap-bits.rkt +++ b/hoax/interpreter/interp-prims-heap-bits.rkt @@ -1,7 +1,7 @@ #lang racket (provide interp-prim0 interp-prim1 interp-prim2 interp-prim3) (require "heap-bits.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") ;; Op0 Heap -> Answer* (define (interp-prim0 op h) diff --git a/hoax/interp-prims-heap.rkt b/hoax/interpreter/interp-prims-heap.rkt similarity index 100% rename from hoax/interp-prims-heap.rkt rename to hoax/interpreter/interp-prims-heap.rkt diff --git a/hoax/interp-stdin.rkt b/hoax/interpreter/interp-stdin.rkt similarity index 87% rename from hoax/interp-stdin.rkt rename to hoax/interpreter/interp-stdin.rkt index 0a8c3e6..35ce332 100644 --- a/hoax/interp-stdin.rkt +++ b/hoax/interpreter/interp-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "interp.rkt") ;; -> Void diff --git a/hoax/interp.rkt b/hoax/interpreter/interp.rkt similarity index 97% rename from hoax/interp.rkt rename to hoax/interpreter/interp.rkt index b99d935..3d72526 100644 --- a/hoax/interp.rkt +++ b/hoax/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp interp-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") (require "env.rkt") diff --git a/hoax/unload-bits.rkt b/hoax/interpreter/unload-bits.rkt similarity index 93% rename from hoax/unload-bits.rkt rename to hoax/interpreter/unload-bits.rkt index eb70337..a5acd3c 100644 --- a/hoax/unload-bits.rkt +++ b/hoax/interpreter/unload-bits.rkt @@ -1,7 +1,8 @@ #lang racket (provide unload unload-value) (require "heap-bits.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") +(require "../executor/decode.rkt") ;; Heap Answer* -> Answer (define (unload h a) diff --git a/hoax/unload.rkt b/hoax/interpreter/unload.rkt similarity index 100% rename from hoax/unload.rkt rename to hoax/interpreter/unload.rkt diff --git a/hoax/main.c b/hoax/main.c deleted file mode 100644 index 1ca6115..0000000 --- a/hoax/main.c +++ /dev/null @@ -1,40 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); -val_t *heap; - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - heap = malloc(8 * heap_size); - - val_t result; - - result = entry(heap); - - print_result(result); - if (val_typeof(result) != T_VOID) - putchar('\n'); - - free(heap); - return 0; -} diff --git a/hoax/main.rkt b/hoax/main.rkt index 50cf56e..f9851a3 100644 --- a/hoax/main.rkt +++ b/hoax/main.rkt @@ -1,18 +1,18 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "interp-io.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "interp-io.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "types.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/hoax/run-stdin.rkt b/hoax/run-stdin.rkt deleted file mode 100644 index 16cf99e..0000000 --- a/hoax/run-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require "run.rkt") - -;; -> Void -;; Compile contents of stdin and use asm-interp to run -(define (main) - (read-line) ; ignore #lang racket line - (run (compile (parse (read))))) - diff --git a/hoax/run.rkt b/hoax/run.rkt deleted file mode 100644 index e707f3b..0000000 --- a/hoax/run.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require a86/interp) -(require "types.rkt") -(require "build-runtime.rkt") -(provide run run/io) - -;; Run instructions with run-time system linked in - -;; Asm -> Answer -(define (run is) - (match (run/io is "") - [(cons r out) (begin (display out) r)])) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - -;; Asm String -> (cons Answer String) -(define (run/io is in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io is in) - [(cons 'err out) (cons 'err out)] - [(cons b out) - (cons (bits->value b) out)]))) - diff --git a/hoax/runtime/Makefile b/hoax/runtime/Makefile new file mode 100644 index 0000000..5582813 --- /dev/null +++ b/hoax/runtime/Makefile @@ -0,0 +1,28 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o \ + values.o \ + io.o \ + error.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/hoax/runtime/error.c b/hoax/runtime/error.c new file mode 100644 index 0000000..69a535a --- /dev/null +++ b/hoax/runtime/error.c @@ -0,0 +1,9 @@ +#include +#include +#include "runtime.h" + +_Noreturn void raise_error(void) +{ + printf("err\n"); + exit(1); +} diff --git a/extort/io.c b/hoax/runtime/io.c similarity index 74% rename from extort/io.c rename to hoax/runtime/io.c index 8a417c9..139dccb 100644 --- a/extort/io.c +++ b/hoax/runtime/io.c @@ -6,20 +6,20 @@ val_t read_byte(void) { - char c = getc(in); + char c = getc(stdin); return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); } val_t peek_byte(void) { - char c = getc(in); - ungetc(c, in); + char c = getc(stdin); + ungetc(c, stdin); return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); } val_t write_byte(val_t c) { - putc((char) val_unwrap_int(c), out); + putc((char) val_unwrap_int(c), stdout); return val_wrap_void(); } diff --git a/hoax/runtime/main.c b/hoax/runtime/main.c new file mode 100644 index 0000000..6fa3ab3 --- /dev/null +++ b/hoax/runtime/main.c @@ -0,0 +1,26 @@ +#include +#include +#include "values.h" +#include "print.h" +#include "runtime.h" + +/* in words */ +#define heap_size 10000 + +int main(int argc, char **argv) +{ + val_t *heap = malloc(8 * heap_size); + if (!heap) { + fprintf(stderr, "out of memory\n"); + return 1; + } + + val_t result = entry(heap); + + print_result(result); + if (val_typeof(result) != T_VOID) + putchar('\n'); + + free(heap); + return 0; +} diff --git a/hoax/print.c b/hoax/runtime/print.c similarity index 100% rename from hoax/print.c rename to hoax/runtime/print.c diff --git a/hoax/print.h b/hoax/runtime/print.h similarity index 100% rename from hoax/print.h rename to hoax/runtime/print.h diff --git a/hoax/runtime/runtime.h b/hoax/runtime/runtime.h new file mode 100644 index 0000000..ec422c7 --- /dev/null +++ b/hoax/runtime/runtime.h @@ -0,0 +1,14 @@ +#ifndef RUNTIME_H +#define RUNTIME_H + +#include "values.h" + +val_t entry(val_t *heap); + +val_t read_byte(void); +val_t peek_byte(void); +val_t write_byte(val_t); + +_Noreturn void raise_error(void); + +#endif /* RUNTIME_H */ diff --git a/hoax/types.h b/hoax/runtime/types.h similarity index 100% rename from hoax/types.h rename to hoax/runtime/types.h diff --git a/hustle/types.rkt b/hoax/runtime/types.rkt similarity index 60% rename from hustle/types.rkt rename to hoax/runtime/types.rkt index 14e9328..b9198f9 100644 --- a/hustle/types.rkt +++ b/hoax/runtime/types.rkt @@ -1,12 +1,13 @@ #lang racket (provide (all-defined-out)) -(require ffi/unsafe) (define imm-shift 3) (define imm-mask #b111) (define ptr-mask #b111) (define type-box #b001) (define type-cons #b010) +(define type-vect #b011) +(define type-str #b100) (define int-shift (+ 1 imm-shift)) (define mask-int #b1111) (define char-shift (+ 2 imm-shift)) @@ -14,24 +15,6 @@ (define type-char #b01000) (define mask-char #b11111) -;; Integer -> Value -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(= b (value->bits eof)) eof] - [(= b (value->bits (void))) (void)] - [(= b (value->bits '())) '()] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [(box-bits? b) - (box (bits->value (mem-ref (- b type-box))))] - [(cons-bits? b) - (cons (bits->value (mem-ref (+ 0 (- b type-cons)))) - (bits->value (mem-ref (+ 8 (- b type-cons)))))] - [else (error "invalid bits")])) - ;; Value -> Integer ;; v must be an immediate (define (value->bits v) @@ -61,6 +44,9 @@ (define (box-bits? v) (= type-box (bitwise-and v imm-mask))) -(define (mem-ref i) - (ptr-ref (cast i _int64 _pointer) _int64)) +(define (vect-bits? v) + (= type-vect (bitwise-and v imm-mask))) + +(define (str-bits? v) + (= type-str (bitwise-and v imm-mask))) diff --git a/hoax/values.c b/hoax/runtime/values.c similarity index 100% rename from hoax/values.c rename to hoax/runtime/values.c diff --git a/hoax/values.h b/hoax/runtime/values.h similarity index 100% rename from hoax/values.h rename to hoax/runtime/values.h diff --git a/hoax/ast.rkt b/hoax/syntax/ast.rkt similarity index 100% rename from hoax/ast.rkt rename to hoax/syntax/ast.rkt diff --git a/hoax/parse.rkt b/hoax/syntax/parse.rkt similarity index 100% rename from hoax/parse.rkt rename to hoax/syntax/parse.rkt diff --git a/hoax/test/compile.rkt b/hoax/test/compile.rkt index 3d22968..fabb24f 100644 --- a/hoax/test/compile.rkt +++ b/hoax/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ (e) (exec (parse-closed e)))) -(test/io (λ (i e) (exec/io (parse-closed e) i))) +(test (λ (e) (run (compile (parse-closed e))))) +(test/io (λ (i e) (run/io (compile (parse-closed e)) i))) diff --git a/hoax/test/interp-heap-bits.rkt b/hoax/test/interp-heap-bits.rkt index be21e60..a6525cf 100644 --- a/hoax/test/interp-heap-bits.rkt +++ b/hoax/test/interp-heap-bits.rkt @@ -1,8 +1,8 @@ #lang racket (require "test-runner.rkt") -(require "../parse.rkt") -(require "../interp-heap-bits.rkt") -(require "../interp-io.rkt") +(require "../syntax/parse.rkt") +(require "../interpreter/interp-heap-bits.rkt") +(require "../interpreter/interp-io.rkt") (test (λ (e) (interp (parse e)))) diff --git a/hoax/test/interp-heap.rkt b/hoax/test/interp-heap.rkt index 6ad0cb9..14d7068 100644 --- a/hoax/test/interp-heap.rkt +++ b/hoax/test/interp-heap.rkt @@ -1,8 +1,8 @@ #lang racket (require "test-runner.rkt") -(require "../parse.rkt") -(require "../interp-heap.rkt") -(require "../interp-io.rkt") +(require "../syntax/parse.rkt") +(require "../interpreter/interp-heap.rkt") +(require "../interpreter/interp-io.rkt") (test (λ (e) (interp (parse e)))) diff --git a/hoax/test/interp.rkt b/hoax/test/interp.rkt index 0a2dab1..acb6a86 100644 --- a/hoax/test/interp.rkt +++ b/hoax/test/interp.rkt @@ -1,7 +1,7 @@ #lang racket -(require "../interp.rkt") -(require "../interp-io.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ (e) (interp (parse-closed e)))) (test/io (λ (in e) (interp/io (parse-closed e) in))) diff --git a/hoax/test/parse.rkt b/hoax/test/parse.rkt index 244f4a5..22b6a45 100644 --- a/hoax/test/parse.rkt +++ b/hoax/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) diff --git a/hoax/test/test-progs.rkt b/hoax/test/test-progs.rkt deleted file mode 100644 index 0eca217..0000000 --- a/hoax/test/test-progs.rkt +++ /dev/null @@ -1,6 +0,0 @@ -#lang racket -;; run command line compiler and compare against Racket as refernece implementation -(require rackunit - "../../test-programs/get-progs.rkt" - "../run.rkt") -(for-each test-prog (get-progs "hoax")) diff --git a/hustle/build-runtime.rkt b/hustle/build-runtime.rkt deleted file mode 100644 index 6699852..0000000 --- a/hustle/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(provide runtime-path) - -(require racket/runtime-path) -(define-runtime-path here ".") - -(unless (system (string-append "make -C '" - (path->string (normalize-path here)) - "' --no-print-directory -s runtime.o")) - (error 'build-runtime "could not build runtime")) - -(define runtime-path - (normalize-path (build-path here "runtime.o"))) - diff --git a/hustle/assert.rkt b/hustle/compiler/assert.rkt similarity index 97% rename from hustle/assert.rkt rename to hustle/compiler/assert.rkt index 4a4d79a..c7b9c05 100644 --- a/hustle/assert.rkt +++ b/hustle/compiler/assert.rkt @@ -2,7 +2,7 @@ (provide assert-integer assert-char assert-byte assert-codepoint assert-box assert-cons) (require a86/ast) -(require "types.rkt") +(require "../runtime/types.rkt") (define (assert-type mask type) (λ (r) diff --git a/hustle/compile-ops.rkt b/hustle/compiler/compile-ops.rkt similarity index 98% rename from hustle/compile-ops.rkt rename to hustle/compiler/compile-ops.rkt index a6be158..fcfc4d1 100644 --- a/hustle/compile-ops.rkt +++ b/hustle/compiler/compile-ops.rkt @@ -1,7 +1,7 @@ #lang racket (provide compile-op0 compile-op1 compile-op2 pad-stack) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require "assert.rkt") (require a86/ast a86/registers) diff --git a/hustle/compile-stdin.rkt b/hustle/compiler/compile-stdin.rkt similarity index 88% rename from hustle/compile-stdin.rkt rename to hustle/compiler/compile-stdin.rkt index b8e500c..dce355a 100644 --- a/hustle/compile-stdin.rkt +++ b/hustle/compiler/compile-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "compile.rkt") (require a86/printer) diff --git a/hustle/compile.rkt b/hustle/compiler/compile.rkt similarity index 97% rename from hustle/compile.rkt rename to hustle/compiler/compile.rkt index bdd5add..d452a66 100644 --- a/hustle/compile.rkt +++ b/hustle/compiler/compile.rkt @@ -2,9 +2,9 @@ (provide compile compile-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; ClosedExpr -> Asm (define (compile e) diff --git a/hustle/correct.rkt b/hustle/correct.rkt index d286ba1..1a7846d 100644 --- a/hustle/correct.rkt +++ b/hustle/correct.rkt @@ -1,10 +1,11 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp-io.rkt") -(require "exec.rkt") +(require "interpreter/interp-io.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; ClosedExpr String -> Void (define (check-compiler e i) (check-equal? (interp/io e i) - (exec/io e i))) + (run/io (compile e) i))) diff --git a/hustle/correctness.rkt b/hustle/correctness.rkt deleted file mode 100644 index b117f26..0000000 --- a/hustle/correctness.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(provide (all-defined-out)) -(require "interp.rkt" - "compile.rkt" - "types.rkt" - "parse.rkt" - "run.rkt" - rackunit) - - -(define (check-compiler e) - (check-equal? (run (compile (parse e))) - (interp (parse e)) - e)) diff --git a/hustle/exec-io.rkt b/hustle/exec-io.rkt deleted file mode 100644 index d385fc4..0000000 --- a/hustle/exec-io.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require a86/interp) -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec/io) - -;; Expr String -> (cons Answer String) -(define (exec/io e in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io (compile e) in) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) - diff --git a/hustle/exec.rkt b/hustle/exec.rkt deleted file mode 100644 index 4ad3df2..0000000 --- a/hustle/exec.rkt +++ /dev/null @@ -1,15 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec exec/io) -;; Expr -> Answer -(define (exec e) - (run (compile e))) - -;; Expr String -> (cons Answer String) -(define (exec/io e in) - (run/io (compile e) in)) - diff --git a/hustle/executor/decode.rkt b/hustle/executor/decode.rkt new file mode 100644 index 0000000..3f1025e --- /dev/null +++ b/hustle/executor/decode.rkt @@ -0,0 +1,31 @@ +#lang racket + +(require "../runtime/types.rkt") +(require ffi/unsafe) + +(provide (all-defined-out)) + +;; Integer -> Value +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(= b (value->bits eof)) eof] + [(= b (value->bits (void))) (void)] + [(= b (value->bits '())) '()] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [(char-bits? b) + (integer->char (arithmetic-shift b (- char-shift)))] + [(box-bits? b) + (box (bits->value (mem-ref (- b type-box))))] + [(cons-bits? b) + (cons (bits->value (mem-ref (+ 0 (- b type-cons)))) + (bits->value (mem-ref (+ 8 (- b type-cons)))))] + [else (error "invalid bits")])) + +(define (mem-ref i) + (ptr-ref (cast i _int64 _pointer) _int64)) + +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/hustle/executor/exec.rkt b/hustle/executor/exec.rkt new file mode 100644 index 0000000..cd5745e --- /dev/null +++ b/hustle/executor/exec.rkt @@ -0,0 +1,55 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") +(struct exec-state (program heap) #:transparent) + +(define (exec/state prog) + (define heap (malloc _int64 10000)) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)) + (extern 'raise_error + (λ () (raise 'err)) + (_fun -> _void)))]) + (asm-load prog)) + heap)) + +(define (exec-call st) + (match-define (exec-state program heap) st) + (with-handlers ([(λ (x) (eq? x 'err)) identity]) + (asm-call program 'entry heap))) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/hustle/executor/run-stdin.rkt b/hustle/executor/run-stdin.rkt new file mode 100644 index 0000000..7e7170f --- /dev/null +++ b/hustle/executor/run-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") +(require "run.rkt") + +;; -> Void +;; Compile contents of stdin and use asm-interp to run +(define (main) + (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) + diff --git a/hustle/executor/run.rkt b/hustle/executor/run.rkt new file mode 100644 index 0000000..d96fe18 --- /dev/null +++ b/hustle/executor/run.rkt @@ -0,0 +1,20 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run run/io) +;; Asm -> Answer +(define (run asm) + (call-with-exec + asm + (λ (r) + (match r + ['err 'err] + [b (bits->value b)])))) +;; Asm String -> (cons Answer String) +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) + diff --git a/hustle/env.rkt b/hustle/interpreter/env.rkt similarity index 100% rename from hustle/env.rkt rename to hustle/interpreter/env.rkt diff --git a/hustle/heap-bits.rkt b/hustle/interpreter/heap-bits.rkt similarity index 95% rename from hustle/heap-bits.rkt rename to hustle/interpreter/heap-bits.rkt index 43cd566..24aa14c 100644 --- a/hustle/heap-bits.rkt +++ b/hustle/interpreter/heap-bits.rkt @@ -1,5 +1,5 @@ #lang racket -(require "types.rkt") +(require "../runtime/types.rkt") (provide (struct-out heap) heap-ref alloc-box alloc-cons) diff --git a/hustle/heap.rkt b/hustle/interpreter/heap.rkt similarity index 100% rename from hustle/heap.rkt rename to hustle/interpreter/heap.rkt diff --git a/hustle/interp-heap-bits.rkt b/hustle/interpreter/interp-heap-bits.rkt similarity index 96% rename from hustle/interp-heap-bits.rkt rename to hustle/interpreter/interp-heap-bits.rkt index 6d2ef99..f399256 100644 --- a/hustle/interp-heap-bits.rkt +++ b/hustle/interpreter/interp-heap-bits.rkt @@ -1,7 +1,7 @@ #lang racket (provide interp) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require "env.rkt") (require "heap-bits.rkt") (require "interp-prims-heap-bits.rkt") diff --git a/hustle/interp-heap.rkt b/hustle/interpreter/interp-heap.rkt similarity index 98% rename from hustle/interp-heap.rkt rename to hustle/interpreter/interp-heap.rkt index 9d9c198..e17005e 100644 --- a/hustle/interp-heap.rkt +++ b/hustle/interpreter/interp-heap.rkt @@ -3,7 +3,7 @@ (require "env.rkt") (require "unload.rkt") (require "interp-prims-heap.rkt") -(require "ast.rkt") +(require "../syntax/ast.rkt") ;; type Answer* = ;; | (cons Heap Value*) diff --git a/hustle/interp-io.rkt b/hustle/interpreter/interp-io.rkt similarity index 100% rename from hustle/interp-io.rkt rename to hustle/interpreter/interp-io.rkt diff --git a/hustle/interp-prim.rkt b/hustle/interpreter/interp-prim.rkt similarity index 100% rename from hustle/interp-prim.rkt rename to hustle/interpreter/interp-prim.rkt diff --git a/hustle/interp-prims-heap-bits.rkt b/hustle/interpreter/interp-prims-heap-bits.rkt similarity index 98% rename from hustle/interp-prims-heap-bits.rkt rename to hustle/interpreter/interp-prims-heap-bits.rkt index 393eeac..bfdcdc6 100644 --- a/hustle/interp-prims-heap-bits.rkt +++ b/hustle/interpreter/interp-prims-heap-bits.rkt @@ -1,7 +1,7 @@ #lang racket (provide interp-prim0 interp-prim1 interp-prim2) (require "heap-bits.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") ;; Op0 Heap -> Answer* (define (interp-prim0 op h) diff --git a/hustle/interp-prims-heap.rkt b/hustle/interpreter/interp-prims-heap.rkt similarity index 100% rename from hustle/interp-prims-heap.rkt rename to hustle/interpreter/interp-prims-heap.rkt diff --git a/hustle/interp-stdin.rkt b/hustle/interpreter/interp-stdin.rkt similarity index 87% rename from hustle/interp-stdin.rkt rename to hustle/interpreter/interp-stdin.rkt index 0a8c3e6..35ce332 100644 --- a/hustle/interp-stdin.rkt +++ b/hustle/interpreter/interp-stdin.rkt @@ -1,6 +1,6 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "interp.rkt") ;; -> Void diff --git a/hustle/interp.rkt b/hustle/interpreter/interp.rkt similarity index 97% rename from hustle/interp.rkt rename to hustle/interpreter/interp.rkt index e2d305c..a97c98a 100644 --- a/hustle/interp.rkt +++ b/hustle/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp interp-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") (require "env.rkt") diff --git a/hustle/unload-bits.rkt b/hustle/interpreter/unload-bits.rkt similarity index 88% rename from hustle/unload-bits.rkt rename to hustle/interpreter/unload-bits.rkt index d9b0a73..eef7a02 100644 --- a/hustle/unload-bits.rkt +++ b/hustle/interpreter/unload-bits.rkt @@ -1,7 +1,8 @@ #lang racket (provide unload unload-value) (require "heap-bits.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") +(require "../executor/decode.rkt") ;; Heap Answer* -> Answer (define (unload h a) diff --git a/hustle/unload.rkt b/hustle/interpreter/unload.rkt similarity index 100% rename from hustle/unload.rkt rename to hustle/interpreter/unload.rkt diff --git a/hustle/io.c b/hustle/io.c deleted file mode 100644 index 8a417c9..0000000 --- a/hustle/io.c +++ /dev/null @@ -1,25 +0,0 @@ -#include -#include -#include "types.h" -#include "values.h" -#include "runtime.h" - -val_t read_byte(void) -{ - char c = getc(in); - return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); -} - -val_t peek_byte(void) -{ - char c = getc(in); - ungetc(c, in); - return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); - -} - -val_t write_byte(val_t c) -{ - putc((char) val_unwrap_int(c), out); - return val_wrap_void(); -} diff --git a/hustle/main.c b/hustle/main.c deleted file mode 100644 index 1ca6115..0000000 --- a/hustle/main.c +++ /dev/null @@ -1,40 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); -val_t *heap; - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - heap = malloc(8 * heap_size); - - val_t result; - - result = entry(heap); - - print_result(result); - if (val_typeof(result) != T_VOID) - putchar('\n'); - - free(heap); - return 0; -} diff --git a/hustle/main.rkt b/hustle/main.rkt index 50cf56e..f9851a3 100644 --- a/hustle/main.rkt +++ b/hustle/main.rkt @@ -1,18 +1,18 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "interp-io.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "interp-io.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "types.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/hustle/run-stdin.rkt b/hustle/run-stdin.rkt deleted file mode 100644 index 16cf99e..0000000 --- a/hustle/run-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require "run.rkt") - -;; -> Void -;; Compile contents of stdin and use asm-interp to run -(define (main) - (read-line) ; ignore #lang racket line - (run (compile (parse (read))))) - diff --git a/hustle/run.rkt b/hustle/run.rkt deleted file mode 100644 index e707f3b..0000000 --- a/hustle/run.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require a86/interp) -(require "types.rkt") -(require "build-runtime.rkt") -(provide run run/io) - -;; Run instructions with run-time system linked in - -;; Asm -> Answer -(define (run is) - (match (run/io is "") - [(cons r out) (begin (display out) r)])) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - -;; Asm String -> (cons Answer String) -(define (run/io is in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io is in) - [(cons 'err out) (cons 'err out)] - [(cons b out) - (cons (bits->value b) out)]))) - diff --git a/hustle/runtime/Makefile b/hustle/runtime/Makefile new file mode 100644 index 0000000..5582813 --- /dev/null +++ b/hustle/runtime/Makefile @@ -0,0 +1,28 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o \ + values.o \ + io.o \ + error.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/hustle/runtime/error.c b/hustle/runtime/error.c new file mode 100644 index 0000000..69a535a --- /dev/null +++ b/hustle/runtime/error.c @@ -0,0 +1,9 @@ +#include +#include +#include "runtime.h" + +_Noreturn void raise_error(void) +{ + printf("err\n"); + exit(1); +} diff --git a/hustle/runtime/io.c b/hustle/runtime/io.c new file mode 100644 index 0000000..139dccb --- /dev/null +++ b/hustle/runtime/io.c @@ -0,0 +1,25 @@ +#include +#include +#include "types.h" +#include "values.h" +#include "runtime.h" + +val_t read_byte(void) +{ + char c = getc(stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); +} + +val_t peek_byte(void) +{ + char c = getc(stdin); + ungetc(c, stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); + +} + +val_t write_byte(val_t c) +{ + putc((char) val_unwrap_int(c), stdout); + return val_wrap_void(); +} diff --git a/hustle/runtime/main.c b/hustle/runtime/main.c new file mode 100644 index 0000000..6fa3ab3 --- /dev/null +++ b/hustle/runtime/main.c @@ -0,0 +1,26 @@ +#include +#include +#include "values.h" +#include "print.h" +#include "runtime.h" + +/* in words */ +#define heap_size 10000 + +int main(int argc, char **argv) +{ + val_t *heap = malloc(8 * heap_size); + if (!heap) { + fprintf(stderr, "out of memory\n"); + return 1; + } + + val_t result = entry(heap); + + print_result(result); + if (val_typeof(result) != T_VOID) + putchar('\n'); + + free(heap); + return 0; +} diff --git a/hustle/print.c b/hustle/runtime/print.c similarity index 100% rename from hustle/print.c rename to hustle/runtime/print.c diff --git a/hustle/print.h b/hustle/runtime/print.h similarity index 100% rename from hustle/print.h rename to hustle/runtime/print.h diff --git a/hustle/runtime/runtime.h b/hustle/runtime/runtime.h new file mode 100644 index 0000000..ec422c7 --- /dev/null +++ b/hustle/runtime/runtime.h @@ -0,0 +1,14 @@ +#ifndef RUNTIME_H +#define RUNTIME_H + +#include "values.h" + +val_t entry(val_t *heap); + +val_t read_byte(void); +val_t peek_byte(void); +val_t write_byte(val_t); + +_Noreturn void raise_error(void); + +#endif /* RUNTIME_H */ diff --git a/hustle/types.h b/hustle/runtime/types.h similarity index 100% rename from hustle/types.h rename to hustle/runtime/types.h diff --git a/hustle/runtime/types.rkt b/hustle/runtime/types.rkt new file mode 100644 index 0000000..5569f65 --- /dev/null +++ b/hustle/runtime/types.rkt @@ -0,0 +1,44 @@ +#lang racket +(provide (all-defined-out)) + +(define imm-shift 3) +(define imm-mask #b111) +(define ptr-mask #b111) +(define type-box #b001) +(define type-cons #b010) +(define int-shift (+ 1 imm-shift)) +(define mask-int #b1111) +(define char-shift (+ 2 imm-shift)) +(define type-int #b0000) +(define type-char #b01000) +(define mask-char #b11111) + +;; Value -> Integer +;; v must be an immediate +(define (value->bits v) + (cond [(eq? v #t) #b00011000] + [(eq? v #f) #b00111000] + [(eq? v eof) #b01011000] + [(eq? v (void)) #b01111000] + [(eq? v '()) #b10011000] + [(integer? v) (arithmetic-shift v int-shift)] + [(char? v) + (bitwise-ior type-char + (arithmetic-shift (char->integer v) char-shift))] + [else (error "not an immediate value" v)])) + +(define (int-bits? v) + (= type-int (bitwise-and v mask-int))) + +(define (char-bits? v) + (= type-char (bitwise-and v mask-char))) + +(define (imm-bits? v) + (zero? (bitwise-and v imm-mask))) + +(define (cons-bits? v) + (= type-cons (bitwise-and v imm-mask))) + +(define (box-bits? v) + (= type-box (bitwise-and v imm-mask))) + diff --git a/hustle/values.c b/hustle/runtime/values.c similarity index 100% rename from hustle/values.c rename to hustle/runtime/values.c diff --git a/hustle/values.h b/hustle/runtime/values.h similarity index 100% rename from hustle/values.h rename to hustle/runtime/values.h diff --git a/hustle/semantics.rkt b/hustle/semantics.rkt deleted file mode 100644 index 7e416ab..0000000 --- a/hustle/semantics.rkt +++ /dev/null @@ -1,351 +0,0 @@ -#lang racket -(provide H Hm H-concrete 𝑯 𝑯′ 𝑯-𝒆𝒏𝒗 𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 𝑯-𝒑𝒓𝒊𝒎 𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 lookup ext convert unload) -(require redex/reduction-semantics - (only-in "../fraud/semantics.rkt" G G-concrete)) - -(define-extended-language H-concrete G-concrete - (p2 ::= .... cons) - (p1 ::= .... box unbox car cdr)) - -(define-extended-language H G - (p2 ::= .... 'cons) - (p1 ::= .... 'box 'unbox 'car 'cdr) - (e ::= .... (Empty)) - (v ::= .... (box v) (cons v v) '())) - - -(module+ test - (test-equal (redex-match? H e (term (Empty))) #t) - (test-equal (redex-match? H e (term (Prim2 'cons (Int 3) (Empty)))) #t) - (test-equal (redex-match? H e (term (Prim2 'cons (Var x) (Var y)))) #t) - (test-equal (redex-match? H v (term (cons 1 2))) #t) - (test-equal (redex-match? H v (term (cons 1 (cons 2 '())))) #t)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define-judgment-form H - #:contract (𝑯 e a) - #:mode (𝑯 I O) - [(𝑯-𝒆𝒏𝒗 e () a) - ---------- - (𝑯 e a)]) - -;; Identical to 𝑮-𝒆𝒏𝒗 -(define-judgment-form H - #:contract (𝑯-𝒆𝒏𝒗 e r a) - #:mode (𝑯-𝒆𝒏𝒗 I I O) - - ;; Value - [----------- "int-lit" - (𝑯-𝒆𝒏𝒗 (Int i) r i)] - [----------- "bool-lit" - (𝑯-𝒆𝒏𝒗 (Bool b) r b)] - [----------- "empty-lit" - (𝑯-𝒆𝒏𝒗 (Empty) r '())] - - ;; If - [(𝑯-𝒆𝒏𝒗 e_0 r v_0) (side-condition (is-true v_0)) (𝑯-𝒆𝒏𝒗 e_1 r a) - -------- "if-true" - (𝑯-𝒆𝒏𝒗 (If e_0 e_1 e_2) r a)] - - [(𝑯-𝒆𝒏𝒗 e_0 r v_0) (side-condition (is-false v_0)) (𝑯-𝒆𝒏𝒗 e_2 r a) - -------- "if-false" - (𝑯-𝒆𝒏𝒗 (If e_0 e_1 e_2) r a)] - - [(𝑯-𝒆𝒏𝒗 e_0 r err) - -------- "if-err" - (𝑯-𝒆𝒏𝒗 (If e_0 e_1 e_2) r err)] - - ;; Let and variable - [(where a (lookup r x)) - ----------- "var" - (𝑯-𝒆𝒏𝒗 (Var x) r a)] - - [(𝑯-𝒆𝒏𝒗 e_0 r v_0) (𝑯-𝒆𝒏𝒗 e_1 (ext r x v_0) a) - ----- "let" - (𝑯-𝒆𝒏𝒗 (Let x e_0 e_1) r a)] - - [(𝑯-𝒆𝒏𝒗 e_0 r err) - ----------- "let-err" - (𝑯-𝒆𝒏𝒗 (Let x e_0 e_1) r err)] - - ;; Primitive application - [(𝑯-𝒆𝒏𝒗 e_0 r a_0) - ----------- "prim1" - (𝑯-𝒆𝒏𝒗 (Prim1 p e_0) r (𝑯-𝒑𝒓𝒊𝒎 p a_0))] - - [(𝑯-𝒆𝒏𝒗 e_0 r a_0) - (𝑯-𝒆𝒏𝒗 e_1 r a_1) - ----------- "prim2" - (𝑯-𝒆𝒏𝒗 (Prim2 p e_0 e_1) r (𝑯-𝒑𝒓𝒊𝒎 p a_0 a_1))]) - -(define-metafunction H - 𝑯-𝒑𝒓𝒊𝒎 : p a ... -> a - [(𝑯-𝒑𝒓𝒊𝒎 p v ... err _ ...) err] - [(𝑯-𝒑𝒓𝒊𝒎 'add1 i_0) ,(+ (term i_0) (term 1))] - [(𝑯-𝒑𝒓𝒊𝒎 'sub1 i_0) ,(- (term i_0) (term 1))] - [(𝑯-𝒑𝒓𝒊𝒎 'zero? 0) #t] - [(𝑯-𝒑𝒓𝒊𝒎 'zero? i) #f] - [(𝑯-𝒑𝒓𝒊𝒎 '+ i_0 i_1) ,(+ (term i_0) (term i_1))] - [(𝑯-𝒑𝒓𝒊𝒎 '- i_0 i_1) ,(- (term i_0) (term i_1))] - [(𝑯-𝒑𝒓𝒊𝒎 'box v) (box v)] - [(𝑯-𝒑𝒓𝒊𝒎 'unbox (box v)) v] - [(𝑯-𝒑𝒓𝒊𝒎 'cons v_1 v_2) (cons v_1 v_2)] - [(𝑯-𝒑𝒓𝒊𝒎 'car (cons v_1 v_2)) v_1] - [(𝑯-𝒑𝒓𝒊𝒎 'cdr (cons v_1 v_2)) v_2] - [(𝑯-𝒑𝒓𝒊𝒎 _ ...) err]) - - -(define-metafunction H - ext : r x v -> r - [(ext ((x_0 v_0) ...) x v) - ((x v) (x_0 v_0) ...)]) - -(define-metafunction H - lookup : r x -> a - [(lookup () x) err] - [(lookup ((x v) (x_1 v_1) ...) x) v] - [(lookup ((x_0 v_0) (x_1 v_1) ...) x) - (lookup ((x_1 v_1) ...) x)]) - -(define-metafunction H - is-true : v -> boolean - [(is-true #f) #f] - [(is-true v) #t]) - -(define-metafunction H - is-false : v -> boolean - [(is-false #f) #t] - [(is-false v) #f]) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(define-extended-language Hm_hidden H - ( ::= (& natural))) - -(define-extended-language Hm Hm_hidden - (α ::= ) - (v ::= integer boolean (box α) (cons α) '()) - (s ::= (v) (v v)) - (σ ::= ((α s) ...))) - -(define-judgment-form Hm - #:contract (𝑯′ e any) - #:mode (𝑯′ I O) - [(𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e () () σ a) - ----------------------- - (𝑯′ e (unload σ a))]) - - -(define-judgment-form Hm - #:contract (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e r σ σ a) - #:mode (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 I I I O O) - - ;; Value - [----------- "int-lit" - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 (Int i) r σ σ i)] - [----------- "bool-lit" - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 (Bool b) r σ σ b)] - [----------- "empty-lit" - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 (Empty) r σ σ '())] - - ;; If - [(𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e_0 r σ_0 σ_1 v) - (side-condition (is-true v)) - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e_0 r σ_1 σ_2 a) - -------- "if-true" - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 (If e_0 e_1 e_2) r σ_0 σ_2 a)] - - [(𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e_0 r σ_0 σ_1 v) - (side-condition (is-false v)) - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e_2 r σ_1 σ_2 a) - -------- "if-false" - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 (If e_0 e_1 e_2) r σ_0 σ_2 a)] - - [(𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e_0 r σ_0 σ_1 err) - -------- "if-err" - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 (If e_0 e_1 e_2) r σ_0 σ_1 err)] - - ;; Let and variable - [(where a (lookup r x)) - ----------- "var" - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 (Var x) r σ σ a)] - - [(𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e_0 r σ_0 σ_1 v_0) - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e_1 (ext r x v_0) σ_1 σ_2 a) - ----- "let" - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 (Let x e_0 e_1) r σ_0 σ_2 a)] - - [(𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e_0 r σ_0 σ_1 err) - ----------- "let-err" - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 (Let x e_0 e_1) r σ_0 σ_1 err)] - - ;; Primitive application - [(𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e_0 r σ_0 σ_1 a_0) - (where (σ_2 a) (𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 p a_0 σ_1)) - ----------- "prim1" - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 (Prim1 p e_0) r σ_0 σ_2 a)] - - [(𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e_0 r σ_0 σ_1 a_0) - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 e_1 r σ_1 σ_2 a_1) - (where (σ_3 a) (𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 p a_0 a_1 σ_2)) - ----------- "prim2" - (𝑯-𝒎𝒆𝒎-𝒆𝒏𝒗 (Prim2 p e_0 e_1) r σ_0 σ_3 a)]) - -(define-metafunction Hm - 𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 : p a ... σ -> (σ a) - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 p v ... err _ ... σ) (σ err)] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 'add1 i_0 σ) (σ ,(+ (term i_0) 1))] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 'sub1 i_0 σ) (σ ,(- (term i_0) 1))] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 'zero? 0 σ) (σ #t)] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 'zero? i σ) (σ #f)] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 '+ i_0 i_1 σ) (σ ,(+ (term i_0) (term i_1)))] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 '- i_0 i_1 σ) (σ ,(- (term i_0) (term i_1)))] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 'box v σ) (alloc σ (box v))] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 'unbox (box α) σ) (σ v) (where (_ ... (α (v)) _ ...) σ)] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 'cons v_1 v_2 σ) (alloc σ (cons v_1 v_2))] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 'car (cons α) σ) (σ v) (where (_ ... (α (v _)) _ ...) σ)] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 'cdr (cons α) σ) (σ v) (where (_ ... (α (_ v)) _ ...) σ)] - [(𝑯-𝒎𝒆𝒎-𝒑𝒓𝒊𝒎 _ ... σ) (σ err)]) - -(define-metafunction Hm - alloc : σ (_ v ...) -> (σ v) - [(alloc () (any_cons v ...)) ((((& 0) (v ...))) (any_cons (& 0)))] - [(alloc ((α_0 s_0) ... ((& i) s_n)) (any_cons v ...)) - (((α_0 s_0) ... ((& i) s_n) ((& ,(add1 (term i))) (v ...))) - (any_cons (& ,(add1 (term i)))))]) - - -(define-metafunction Hm - unload : σ a -> any_H_a - [(unload σ err) err] - [(unload σ i) i] - [(unload σ b) b] - [(unload σ '()) '()] - [(unload σ (box α)) - (box (unload σ v)) - (where (_ ... (α (v)) _ ...) σ)] - [(unload σ (cons α)) - (cons (unload σ v_1) - (unload σ v_2)) - (where (_ ... (α (v_1 v_2)) _ ...) σ)]) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Convert v to using Racket pairs, boxes, and null -(define-metafunction H - convert : a -> any - [(convert '()) ()] - [(convert (box v_0)) ,(box (term (convert v_0)))] - [(convert (cons v_0 v_1)) ,(cons (term (convert v_0)) (term (convert v_1)))] - [(convert a) a]) - -(module+ test - (test-judgment-holds (𝑯 (Int 7) 7)) - (test-judgment-holds (𝑯 (Prim1 'add1 (Int 7)) 8)) - - (test-judgment-holds (𝑯 (Prim1 'add1 (Bool #f)) err)) - - (test-judgment-holds (𝑯 (Let x (Int 7) (Int 8)) 8)) - (test-judgment-holds (𝑯 (Let x (Int 7) (Var x)) 7)) - (test-judgment-holds (𝑯 (Let x (Int 7) (Prim1 'add1 (Var x))) 8)) - (test-judgment-holds (𝑯 (Prim1 'sub1 (Let x (Int 7) (Prim1 'add1 (Var x)))) 7)) - (test-judgment-holds (𝑯 (Prim1 'sub1 (Let x (Int 7) - (Let y (Var x) - (Prim1 'add1 (Var x))))) - 7)) - (test-judgment-holds (𝑯 (Prim1 'sub1 (Let x (Int 7) - (Let x (Int 8) - (Prim1 'add1 (Var x))))) - 8)) - - (test-judgment-holds (𝑯 (Prim1 'zero? (Int 0)) #t)) - (test-judgment-holds (𝑯 (Prim1 'zero? (Int 1)) #f)) - (test-judgment-holds (𝑯 (Prim1 'zero? (Bool #f)) err)) - - (test-judgment-holds (𝑯 (Prim2 '+ (Int 1) (Int 2)) 3)) - (test-judgment-holds (𝑯 (Prim2 '- (Int 1) (Int 2)) -1)) - (test-judgment-holds (𝑯 (Prim1 'add1 (Bool #f)) err)) - (test-judgment-holds (𝑯 (If (Prim1 'add1 (Bool #f)) (Int 1) (Int 2)) err)) - (test-judgment-holds (𝑯 (If (Prim1 'zero? (Bool #t)) (Prim1 'add1 (Bool #f)) (Int 2)) err)) - (test-judgment-holds (𝑯 (Prim2 '+ (Int 1) (Prim1 'add1 (Bool #f))) err)) - (test-judgment-holds (𝑯 (Prim2 '+ (Int 1) (Bool #f)) err)) - (test-judgment-holds (𝑯 (Prim2 '- (Int 1) (Bool #f)) err)) - (test-judgment-holds (𝑯 (Prim2 '- (Prim1 'add1 (Bool #f)) (Bool #f)) err)) - - (test-judgment-holds (𝑯 (Empty) '())) - (test-judgment-holds (𝑯 (Prim2 'cons (Int 1) (Int 2)) (cons 1 2))) - (test-judgment-holds (𝑯 (Prim2 'cons (Int 1) (Prim1 'add1 (Bool #f))) err)) - (test-judgment-holds (𝑯 (Let x (Int 1) - (Let y (Int 2) - (Prim2 'cons (Var x) (Var y)))) - (cons 1 2))) - (test-judgment-holds (𝑯 (Prim1 'car (Prim2 'cons (Int 1) (Int 2))) 1)) - (test-judgment-holds (𝑯 (Prim1 'cdr (Prim2 'cons (Int 1) (Int 2))) 2)) - (test-judgment-holds (𝑯 (Prim1 'cdr (Prim2 'cons (Int 1) (Prim2 'cons (Int 2) (Empty)))) (cons 2 '()))) - (test-judgment-holds (𝑯 (Prim1 'car (Prim2 'cons (Prim1 'add1 (Int 7)) (Empty))) 8)) - (test-judgment-holds (𝑯 (Prim1 'box (Int 7)) (box 7))) - (test-judgment-holds (𝑯 (Prim1 'unbox (Prim1 'box (Int 7))) 7)) - (test-judgment-holds (𝑯 (Prim1 'unbox (Prim1 'unbox (Int 7))) err)) - - (test-equal (term (convert '())) '()) - (test-equal (term (convert (cons 1 2))) '(1 . 2))) - -(module+ test - (test-judgment-holds (𝑯′ (Int 7) 7)) - (test-judgment-holds (𝑯′ (Prim1 'add1 (Int 7)) 8)) - - (test-judgment-holds (𝑯′ (Prim1 'add1 (Bool #f)) err)) - - (test-judgment-holds (𝑯′ (Let x (Int 7) (Int 8)) 8)) - (test-judgment-holds (𝑯′ (Let x (Int 7) (Var x)) 7)) - (test-judgment-holds (𝑯′ (Let x (Int 7) (Prim1 'add1 (Var x))) 8)) - (test-judgment-holds (𝑯′ (Prim1 'sub1 (Let x (Int 7) (Prim1 'add1 (Var x)))) 7)) - (test-judgment-holds (𝑯′ (Prim1 'sub1 (Let x (Int 7) - (Let y (Var x) - (Prim1 'add1 (Var x))))) - 7)) - (test-judgment-holds (𝑯′ (Prim1 'sub1 (Let x (Int 7) - (Let x (Int 8) - (Prim1 'add1 (Var x))))) - 8)) - - (test-judgment-holds (𝑯′ (Prim1 'zero? (Int 0)) #t)) - (test-judgment-holds (𝑯′ (Prim1 'zero? (Int 1)) #f)) - (test-judgment-holds (𝑯′ (Prim1 'zero? (Bool #f)) err)) - - (test-judgment-holds (𝑯′ (Prim2 '+ (Int 1) (Int 2)) 3)) - (test-judgment-holds (𝑯′ (Prim2 '- (Int 1) (Int 2)) -1)) - (test-judgment-holds (𝑯′ (Prim1 'add1 (Bool #f)) err)) - (test-judgment-holds (𝑯′ (If (Prim1 'add1 (Bool #f)) (Int 1) (Int 2)) err)) - (test-judgment-holds (𝑯′ (If (Prim1 'zero? (Bool #t)) (Prim1 'add1 (Bool #f)) (Int 2)) err)) - (test-judgment-holds (𝑯′ (Prim2 '+ (Int 1) (Prim1 'add1 (Bool #f))) err)) - (test-judgment-holds (𝑯′ (Prim2 '+ (Int 1) (Bool #f)) err)) - (test-judgment-holds (𝑯′ (Prim2 '- (Int 1) (Bool #f)) err)) - (test-judgment-holds (𝑯′ (Prim2 '- (Prim1 'add1 (Bool #f)) (Bool #f)) err)) - - (test-judgment-holds (𝑯′ (Empty) '())) - (test-judgment-holds (𝑯′ (Prim2 'cons (Int 1) (Int 2)) (cons 1 2))) - (test-judgment-holds (𝑯′ (Prim2 'cons (Int 1) (Prim1 'add1 (Bool #f))) err)) - (test-judgment-holds (𝑯′ (Let x (Int 1) - (Let y (Int 2) - (Prim2 'cons (Var x) (Var y)))) - (cons 1 2))) - (test-judgment-holds (𝑯′ (Prim1 'car (Prim2 'cons (Int 1) (Int 2))) 1)) - (test-judgment-holds (𝑯′ (Prim1 'cdr (Prim2 'cons (Int 1) (Int 2))) 2)) - (test-judgment-holds (𝑯′ (Prim1 'cdr (Prim2 'cons (Int 1) (Prim2 'cons (Int 2) (Empty)))) (cons 2 '()))) - (test-judgment-holds (𝑯′ (Prim1 'car (Prim2 'cons (Prim1 'add1 (Int 7)) (Empty))) 8)) - (test-judgment-holds (𝑯′ (Prim1 'box (Int 7)) (box 7))) - (test-judgment-holds (𝑯′ (Prim1 'unbox (Prim1 'box (Int 7))) 7)) - (test-judgment-holds (𝑯′ (Prim1 'unbox (Prim1 'unbox (Int 7))) err))) - - - -(module+ test - ;; Check that the semantics is total function - (redex-check H e (redex-match? H (a_0) (judgment-holds (𝑯 e a) a)))) diff --git a/hustle/ast.rkt b/hustle/syntax/ast.rkt similarity index 100% rename from hustle/ast.rkt rename to hustle/syntax/ast.rkt diff --git a/hustle/parse.rkt b/hustle/syntax/parse.rkt similarity index 100% rename from hustle/parse.rkt rename to hustle/syntax/parse.rkt diff --git a/hustle/random.rkt b/hustle/syntax/random.rkt similarity index 100% rename from hustle/random.rkt rename to hustle/syntax/random.rkt diff --git a/hustle/test/compile.rkt b/hustle/test/compile.rkt index 3d22968..fabb24f 100644 --- a/hustle/test/compile.rkt +++ b/hustle/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ (e) (exec (parse-closed e)))) -(test/io (λ (i e) (exec/io (parse-closed e) i))) +(test (λ (e) (run (compile (parse-closed e))))) +(test/io (λ (i e) (run/io (compile (parse-closed e)) i))) diff --git a/hustle/test/interp-heap-bits.rkt b/hustle/test/interp-heap-bits.rkt index be21e60..a6525cf 100644 --- a/hustle/test/interp-heap-bits.rkt +++ b/hustle/test/interp-heap-bits.rkt @@ -1,8 +1,8 @@ #lang racket (require "test-runner.rkt") -(require "../parse.rkt") -(require "../interp-heap-bits.rkt") -(require "../interp-io.rkt") +(require "../syntax/parse.rkt") +(require "../interpreter/interp-heap-bits.rkt") +(require "../interpreter/interp-io.rkt") (test (λ (e) (interp (parse e)))) diff --git a/hustle/test/interp-heap.rkt b/hustle/test/interp-heap.rkt index 6ad0cb9..14d7068 100644 --- a/hustle/test/interp-heap.rkt +++ b/hustle/test/interp-heap.rkt @@ -1,8 +1,8 @@ #lang racket (require "test-runner.rkt") -(require "../parse.rkt") -(require "../interp-heap.rkt") -(require "../interp-io.rkt") +(require "../syntax/parse.rkt") +(require "../interpreter/interp-heap.rkt") +(require "../interpreter/interp-io.rkt") (test (λ (e) (interp (parse e)))) diff --git a/hustle/test/interp.rkt b/hustle/test/interp.rkt index 0a2dab1..acb6a86 100644 --- a/hustle/test/interp.rkt +++ b/hustle/test/interp.rkt @@ -1,7 +1,7 @@ #lang racket -(require "../interp.rkt") -(require "../interp-io.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ (e) (interp (parse-closed e)))) (test/io (λ (in e) (interp/io (parse-closed e) in))) diff --git a/hustle/test/parse.rkt b/hustle/test/parse.rkt index 2624a74..997e985 100644 --- a/hustle/test/parse.rkt +++ b/hustle/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) diff --git a/iniquity/build-runtime.rkt b/iniquity/build-runtime.rkt deleted file mode 100644 index 6699852..0000000 --- a/iniquity/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(provide runtime-path) - -(require racket/runtime-path) -(define-runtime-path here ".") - -(unless (system (string-append "make -C '" - (path->string (normalize-path here)) - "' --no-print-directory -s runtime.o")) - (error 'build-runtime "could not build runtime")) - -(define runtime-path - (normalize-path (build-path here "runtime.o"))) - diff --git a/hoax/assert.rkt b/iniquity/compiler/assert.rkt similarity index 97% rename from hoax/assert.rkt rename to iniquity/compiler/assert.rkt index cfc110a..380fc8d 100644 --- a/hoax/assert.rkt +++ b/iniquity/compiler/assert.rkt @@ -3,7 +3,7 @@ assert-box assert-cons assert-natural assert-vector assert-string) (require a86/ast) -(require "types.rkt") +(require "../runtime/types.rkt") (define (assert-type mask type) (λ (r) diff --git a/jig/compile-ops.rkt b/iniquity/compiler/compile-ops.rkt similarity index 97% rename from jig/compile-ops.rkt rename to iniquity/compiler/compile-ops.rkt index 1bb76cb..1a58a86 100644 --- a/jig/compile-ops.rkt +++ b/iniquity/compiler/compile-ops.rkt @@ -1,7 +1,7 @@ #lang racket (provide compile-op0 compile-op1 compile-op2 compile-op3 pad-stack) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require "assert.rkt") (require a86/ast a86/registers) @@ -222,8 +222,8 @@ (Mov r9 (Mem r8 (- type-vect))) (Cmp r10 r9) (Jge 'err) - (Sar r10 1) ; convert to byte offset - (Mov (Mem r8 r10 (- 8 type-vect)) rax) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) (Mov rax (value->bits (void))))])) (define (type-pred mask type) diff --git a/iniquity/compile-stdin.rkt b/iniquity/compiler/compile-stdin.rkt similarity index 79% rename from iniquity/compile-stdin.rkt rename to iniquity/compiler/compile-stdin.rkt index ed18b5e..f25989a 100644 --- a/iniquity/compile-stdin.rkt +++ b/iniquity/compiler/compile-stdin.rkt @@ -1,8 +1,8 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "compile.rkt") -(require "read-all.rkt") +(require "../syntax/read-all.rkt") (require a86/printer) ;; -> Void diff --git a/iniquity/compile.rkt b/iniquity/compiler/compile.rkt similarity index 96% rename from iniquity/compile.rkt rename to iniquity/compiler/compile.rkt index 55f8fa9..d79d077 100644 --- a/iniquity/compile.rkt +++ b/iniquity/compiler/compile.rkt @@ -7,9 +7,9 @@ ; for notes (provide rsp) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; Prog -> Asm @@ -48,6 +48,8 @@ (match d [(Defn f xs e) (seq (Label (symbol->label f)) + (Cmp r8 (length xs)) ; arity check + (Jne 'err) (compile-e e (reverse xs)) (Add rsp (* 8 (length xs))) ; pop args (Ret))])) @@ -158,6 +160,7 @@ (seq (Lea rax r) (Push rax) (compile-es es (cons #f c)) + (Mov r8 (length es)) ; pass arity info (Jmp (symbol->label f)) (Label r)))) diff --git a/iniquity/correct.rkt b/iniquity/correct.rkt index d286ba1..1a7846d 100644 --- a/iniquity/correct.rkt +++ b/iniquity/correct.rkt @@ -1,10 +1,11 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp-io.rkt") -(require "exec.rkt") +(require "interpreter/interp-io.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; ClosedExpr String -> Void (define (check-compiler e i) (check-equal? (interp/io e i) - (exec/io e i))) + (run/io (compile e) i))) diff --git a/iniquity/exec-io.rkt b/iniquity/exec-io.rkt deleted file mode 100644 index fb1d306..0000000 --- a/iniquity/exec-io.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(require a86/interp) -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec/io) -;; Prog String -> (cons Answer String) -(define (exec/io p in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io (compile p) in) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) - diff --git a/iniquity/exec.rkt b/iniquity/exec.rkt deleted file mode 100644 index 59f36bf..0000000 --- a/iniquity/exec.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec exec/io) -;; Prog -> Answer -(define (exec p) - (run (compile p))) -;; Prog String -> (cons Answer String) -(define (exec/io p in) - (run/io (compile p) in)) - diff --git a/iniquity/executor/decode.rkt b/iniquity/executor/decode.rkt new file mode 100644 index 0000000..6ee214f --- /dev/null +++ b/iniquity/executor/decode.rkt @@ -0,0 +1,45 @@ +#lang racket + +(require "../runtime/types.rkt") +(require ffi/unsafe) + +(provide (all-defined-out)) + +;; Integer -> Value +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(= b (value->bits eof)) eof] + [(= b (value->bits (void))) (void)] + [(= b (value->bits '())) '()] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [(char-bits? b) + (integer->char (arithmetic-shift b (- char-shift)))] + [(box-bits? b) + (box (bits->value (mem-ref (- b type-box))))] + [(cons-bits? b) + (cons (bits->value (mem-ref (+ 0 (- b type-cons)))) + (bits->value (mem-ref (+ 8 (- b type-cons)))))] + + [(vect-bits? b) + (let ((p (- b type-vect))) + (build-vector (bits->value (mem-ref p)) + (lambda (j) + (bits->value (mem-ref (+ p (* 8 (add1 j))))))))] + [(str-bits? b) + (let ((p (- b type-str))) + (build-string (bits->value (mem-ref p)) + (lambda (j) + (integer->char (mem-ref32 (+ p 8 (* 4 j)))))))] + [else (error "invalid bits")])) + +(define (mem-ref i) + (ptr-ref (cast i _int64 _pointer) _int64)) + +(define (mem-ref32 i) + (ptr-ref (cast i _int64 _pointer) _int32)) + +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/iniquity/executor/exec.rkt b/iniquity/executor/exec.rkt new file mode 100644 index 0000000..cd5745e --- /dev/null +++ b/iniquity/executor/exec.rkt @@ -0,0 +1,55 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") +(struct exec-state (program heap) #:transparent) + +(define (exec/state prog) + (define heap (malloc _int64 10000)) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)) + (extern 'raise_error + (λ () (raise 'err)) + (_fun -> _void)))]) + (asm-load prog)) + heap)) + +(define (exec-call st) + (match-define (exec-state program heap) st) + (with-handlers ([(λ (x) (eq? x 'err)) identity]) + (asm-call program 'entry heap))) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/iniquity/executor/run.rkt b/iniquity/executor/run.rkt new file mode 100644 index 0000000..d96fe18 --- /dev/null +++ b/iniquity/executor/run.rkt @@ -0,0 +1,20 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run run/io) +;; Asm -> Answer +(define (run asm) + (call-with-exec + asm + (λ (r) + (match r + ['err 'err] + [b (bits->value b)])))) +;; Asm String -> (cons Answer String) +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) + diff --git a/iniquity/interp-prims.rkt b/iniquity/interp-prims.rkt deleted file mode 100644 index 4cbabc6..0000000 --- a/iniquity/interp-prims.rkt +++ /dev/null @@ -1,69 +0,0 @@ -#lang racket -(require "ast.rkt") -(provide interp-prim1 interp-prim2 interp-prim3) - -;; Op1 Value -> Answer -(define (interp-prim1 p1 v) - (match (list p1 v) - [(list 'add1 (? integer?)) (add1 v)] - [(list 'sub1 (? integer?)) (sub1 v)] - [(list 'zero? (? integer?)) (zero? v)] - [(list 'char? v) (char? v)] - [(list 'char->integer (? char?)) (char->integer v)] - [(list 'integer->char (? codepoint?)) (integer->char v)] - [(list 'eof-object? v) (eof-object? v)] - [(list 'write-byte (? byte?)) (write-byte v)] - [(list 'box v) (box v)] - [(list 'unbox (? box?)) (unbox v)] - [(list 'car (? pair?)) (car v)] - [(list 'cdr (? pair?)) (cdr v)] - [(list 'empty? v) (empty? v)] - [(list 'cons? v) (cons? v)] - [(list 'box? v) (box? v)] - [(list 'vector? v) (vector? v)] - [(list 'vector-length (? vector?)) (vector-length v)] - [(list 'string? v) (string? v)] - [(list 'string-length (? string?)) (string-length v)] - [_ 'err])) - -;; Op2 Value Value -> Answer -(define (interp-prim2 p v1 v2) - (match (list p v1 v2) - [(list '+ (? integer?) (? integer?)) (+ v1 v2)] - [(list '- (? integer?) (? integer?)) (- v1 v2)] - [(list '< (? integer?) (? integer?)) (< v1 v2)] - [(list '= (? integer?) (? integer?)) (= v1 v2)] - [(list 'cons v1 v2) (cons v1 v2)] - [(list 'eq? v1 v2) (eq? v1 v2)] - [(list 'make-vector (? integer?) _) - (if (<= 0 v1) - (make-vector v1 v2) - 'err)] - [(list 'vector-ref (? vector?) (? integer?)) - (if (<= 0 v2 (sub1 (vector-length v1))) - (vector-ref v1 v2) - 'err)] - [(list 'make-string (? integer?) (? char?)) - (if (<= 0 v1) - (make-string v1 v2) - 'err)] - [(list 'string-ref (? string?) (? integer?)) - (if (<= 0 v2 (sub1 (string-length v1))) - (string-ref v1 v2) - 'err)] - [_ 'err])) - -;; Op3 Value Value Value -> Answer -(define (interp-prim3 p v1 v2 v3) - (match (list p v1 v2 v3) - [(list 'vector-set! (? vector?) (? integer?) _) - (if (<= 0 v2 (sub1 (vector-length v1))) - (vector-set! v1 v2 v3) - 'err)] - [_ 'err])) - -;; Any -> Boolean -(define (codepoint? v) - (and (integer? v) - (or (<= 0 v 55295) - (<= 57344 v 1114111)))) diff --git a/iniquity/env.rkt b/iniquity/interpreter/env.rkt similarity index 100% rename from iniquity/env.rkt rename to iniquity/interpreter/env.rkt diff --git a/iniquity/interp-io.rkt b/iniquity/interpreter/interp-io.rkt similarity index 100% rename from iniquity/interp-io.rkt rename to iniquity/interpreter/interp-io.rkt diff --git a/iniquity/interp-prim.rkt b/iniquity/interpreter/interp-prim.rkt similarity index 100% rename from iniquity/interp-prim.rkt rename to iniquity/interpreter/interp-prim.rkt diff --git a/iniquity/interp-stdin.rkt b/iniquity/interpreter/interp-stdin.rkt similarity index 78% rename from iniquity/interp-stdin.rkt rename to iniquity/interpreter/interp-stdin.rkt index df745af..7d85c32 100644 --- a/iniquity/interp-stdin.rkt +++ b/iniquity/interpreter/interp-stdin.rkt @@ -1,8 +1,8 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "interp.rkt") -(require "read-all.rkt") +(require "../syntax/read-all.rkt") ;; -> Void ;; Parse and interpret contents of stdin, diff --git a/jig/interp.rkt b/iniquity/interpreter/interp.rkt similarity index 98% rename from jig/interp.rkt rename to iniquity/interpreter/interp.rkt index 80f12e9..65a23b8 100644 --- a/jig/interp.rkt +++ b/iniquity/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp interp-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") (require "env.rkt") diff --git a/iniquity/io.c b/iniquity/io.c deleted file mode 100644 index 8a417c9..0000000 --- a/iniquity/io.c +++ /dev/null @@ -1,25 +0,0 @@ -#include -#include -#include "types.h" -#include "values.h" -#include "runtime.h" - -val_t read_byte(void) -{ - char c = getc(in); - return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); -} - -val_t peek_byte(void) -{ - char c = getc(in); - ungetc(c, in); - return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); - -} - -val_t write_byte(val_t c) -{ - putc((char) val_unwrap_int(c), out); - return val_wrap_void(); -} diff --git a/iniquity/main.c b/iniquity/main.c deleted file mode 100644 index 4fcd8b6..0000000 --- a/iniquity/main.c +++ /dev/null @@ -1,41 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); -val_t *heap; - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - heap = malloc(8 * heap_size); - - val_t result; - - result = entry(heap); - - print_result(result); - - if (val_typeof(result) != T_VOID) - putchar('\n'); - - free(heap); - return 0; -} diff --git a/iniquity/main.rkt b/iniquity/main.rkt index 50cf56e..f9851a3 100644 --- a/iniquity/main.rkt +++ b/iniquity/main.rkt @@ -1,18 +1,18 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "interp-io.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "interp-io.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "types.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/iniquity/run.rkt b/iniquity/run.rkt deleted file mode 100644 index e707f3b..0000000 --- a/iniquity/run.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require a86/interp) -(require "types.rkt") -(require "build-runtime.rkt") -(provide run run/io) - -;; Run instructions with run-time system linked in - -;; Asm -> Answer -(define (run is) - (match (run/io is "") - [(cons r out) (begin (display out) r)])) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - -;; Asm String -> (cons Answer String) -(define (run/io is in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io is in) - [(cons 'err out) (cons 'err out)] - [(cons b out) - (cons (bits->value b) out)]))) - diff --git a/iniquity/runtime.h b/iniquity/runtime.h deleted file mode 100644 index cf6a73c..0000000 --- a/iniquity/runtime.h +++ /dev/null @@ -1,15 +0,0 @@ -#ifndef RUNTIME_H -#define RUNTIME_H - -#include "values.h" - -val_t entry(val_t*); -extern FILE* in; -extern FILE* out; -extern void (*error_handler)(); - -// in words -#define heap_size 10000 -extern val_t *heap; - -#endif /* RUNTIME_H */ diff --git a/iniquity/runtime/Makefile b/iniquity/runtime/Makefile new file mode 100644 index 0000000..5582813 --- /dev/null +++ b/iniquity/runtime/Makefile @@ -0,0 +1,28 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o \ + values.o \ + io.o \ + error.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/iniquity/runtime/error.c b/iniquity/runtime/error.c new file mode 100644 index 0000000..69a535a --- /dev/null +++ b/iniquity/runtime/error.c @@ -0,0 +1,9 @@ +#include +#include +#include "runtime.h" + +_Noreturn void raise_error(void) +{ + printf("err\n"); + exit(1); +} diff --git a/iniquity/runtime/io.c b/iniquity/runtime/io.c new file mode 100644 index 0000000..139dccb --- /dev/null +++ b/iniquity/runtime/io.c @@ -0,0 +1,25 @@ +#include +#include +#include "types.h" +#include "values.h" +#include "runtime.h" + +val_t read_byte(void) +{ + char c = getc(stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); +} + +val_t peek_byte(void) +{ + char c = getc(stdin); + ungetc(c, stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); + +} + +val_t write_byte(val_t c) +{ + putc((char) val_unwrap_int(c), stdout); + return val_wrap_void(); +} diff --git a/iniquity/runtime/main.c b/iniquity/runtime/main.c new file mode 100644 index 0000000..6fa3ab3 --- /dev/null +++ b/iniquity/runtime/main.c @@ -0,0 +1,26 @@ +#include +#include +#include "values.h" +#include "print.h" +#include "runtime.h" + +/* in words */ +#define heap_size 10000 + +int main(int argc, char **argv) +{ + val_t *heap = malloc(8 * heap_size); + if (!heap) { + fprintf(stderr, "out of memory\n"); + return 1; + } + + val_t result = entry(heap); + + print_result(result); + if (val_typeof(result) != T_VOID) + putchar('\n'); + + free(heap); + return 0; +} diff --git a/iniquity/print.c b/iniquity/runtime/print.c similarity index 100% rename from iniquity/print.c rename to iniquity/runtime/print.c diff --git a/iniquity/print.h b/iniquity/runtime/print.h similarity index 100% rename from iniquity/print.h rename to iniquity/runtime/print.h diff --git a/iniquity/runtime/runtime.h b/iniquity/runtime/runtime.h new file mode 100644 index 0000000..ec422c7 --- /dev/null +++ b/iniquity/runtime/runtime.h @@ -0,0 +1,14 @@ +#ifndef RUNTIME_H +#define RUNTIME_H + +#include "values.h" + +val_t entry(val_t *heap); + +val_t read_byte(void); +val_t peek_byte(void); +val_t write_byte(val_t); + +_Noreturn void raise_error(void); + +#endif /* RUNTIME_H */ diff --git a/iniquity/types.h b/iniquity/runtime/types.h similarity index 100% rename from iniquity/types.h rename to iniquity/runtime/types.h diff --git a/iniquity/types.rkt b/iniquity/runtime/types.rkt similarity index 51% rename from iniquity/types.rkt rename to iniquity/runtime/types.rkt index c0c1d70..b9198f9 100644 --- a/iniquity/types.rkt +++ b/iniquity/runtime/types.rkt @@ -1,6 +1,5 @@ #lang racket (provide (all-defined-out)) -(require ffi/unsafe) (define imm-shift 3) (define imm-mask #b111) @@ -16,35 +15,6 @@ (define type-char #b01000) (define mask-char #b11111) -;; Integer -> Value -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(= b (value->bits eof)) eof] - [(= b (value->bits (void))) (void)] - [(= b (value->bits '())) '()] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [(box-bits? b) - (box (bits->value (mem-ref (- b type-box))))] - [(cons-bits? b) - (cons (bits->value (mem-ref (+ 0 (- b type-cons)))) - (bits->value (mem-ref (+ 8 (- b type-cons)))))] - - [(vect-bits? b) - (let ((p (- b type-vect))) - (build-vector (bits->value (mem-ref p)) - (lambda (j) - (bits->value (mem-ref (+ p (* 8 (add1 j))))))))] - [(str-bits? b) - (let ((p (- b type-str))) - (build-string (bits->value (mem-ref p)) - (lambda (j) - (integer->char (mem-ref32 (+ p 8 (* 4 j)))))))] - [else (error "invalid bits")])) - ;; Value -> Integer ;; v must be an immediate (define (value->bits v) @@ -80,9 +50,3 @@ (define (str-bits? v) (= type-str (bitwise-and v imm-mask))) -(define (mem-ref i) - (ptr-ref (cast i _int64 _pointer) _int64)) - -(define (mem-ref32 i) - (ptr-ref (cast i _int64 _pointer) _int32)) - diff --git a/iniquity/values.c b/iniquity/runtime/values.c similarity index 100% rename from iniquity/values.c rename to iniquity/runtime/values.c diff --git a/iniquity/values.h b/iniquity/runtime/values.h similarity index 100% rename from iniquity/values.h rename to iniquity/runtime/values.h diff --git a/iniquity/ast.rkt b/iniquity/syntax/ast.rkt similarity index 100% rename from iniquity/ast.rkt rename to iniquity/syntax/ast.rkt diff --git a/iniquity/parse.rkt b/iniquity/syntax/parse.rkt similarity index 98% rename from iniquity/parse.rkt rename to iniquity/syntax/parse.rkt index 02df181..b05e65e 100644 --- a/iniquity/parse.rkt +++ b/iniquity/syntax/parse.rkt @@ -35,7 +35,7 @@ (define (rec ss fs) (match ss [(list s) fs] - [(cons (cons 'define sd) sr) + [(cons (cons (? (not-in fs) 'define) sd) sr) (match (parse-defn-name sd) [f (if (memq f fs) (error "duplicate definition" f) @@ -138,7 +138,7 @@ (list ys (cons g gs) (App g es))])])])] [(list-rest (? symbol? g) sr) (match (parse-es/acc sr fs xs ys gs) - [(list ys s es) + [(list ys gs es) (list ys (if (memq g fs) gs (cons g gs)) (App g es))])] [_ (error "parse error" s)])) diff --git a/iniquity/read-all.rkt b/iniquity/syntax/read-all.rkt similarity index 100% rename from iniquity/read-all.rkt rename to iniquity/syntax/read-all.rkt diff --git a/iniquity/test/all.rkt b/iniquity/test/all.rkt deleted file mode 100644 index f880d50..0000000 --- a/iniquity/test/all.rkt +++ /dev/null @@ -1,5 +0,0 @@ -#lang racket - -;; run command line compiler and compare against Racket as refernece implementation -(require rackunit "../../test-programs/get-progs.rkt") -(for-each test-prog (get-progs "iniquity")) diff --git a/iniquity/test/compile.rkt b/iniquity/test/compile.rkt index 2096b58..76fdb1a 100644 --- a/iniquity/test/compile.rkt +++ b/iniquity/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ p (exec (apply parse-closed p)))) -(test/io (λ (in . p) (exec/io (apply parse-closed p) in))) +(test (λ p (run (compile (apply parse-closed p))))) +(test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) diff --git a/iniquity/test/interp.rkt b/iniquity/test/interp.rkt index 523685b..823063f 100644 --- a/iniquity/test/interp.rkt +++ b/iniquity/test/interp.rkt @@ -1,7 +1,7 @@ #lang racket -(require "../interp.rkt") -(require "../interp-io.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ p (interp (apply parse-closed p)))) (test/io (λ (in . p) (interp/io (apply parse-closed p) in))) diff --git a/iniquity/test/parse.rkt b/iniquity/test/parse.rkt index ea9197b..8648a5b 100644 --- a/iniquity/test/parse.rkt +++ b/iniquity/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) @@ -47,7 +47,7 @@ (check-equal? (parse "asdf") (p (Lit "asdf"))) (check-equal? (parse '(make-string 10 #\a)) (p (Prim2 'make-string (Lit 10) (Lit #\a))))) - + (begin ; Iniquity (check-equal? (parse '(define (f x) x) 1) (Prog (list (Defn 'f '(x) (Var 'x))) (Lit 1))) @@ -55,10 +55,20 @@ (Prog (list (Defn 'define '() (Lit 0))) (App 'define '()))) (check-exn exn:fail? (λ () (parse '(define (f y y) y) 1))) + (check-exn exn:fail? (λ () (parse '(define (f y) y) '(define (f x) x) 1))) (check-equal? (parse-closed '(define (f x) (g x)) '(define (g x) (f x)) '(f 0)) (Prog (list (Defn 'f '(x) (App 'g (list (Var 'x)))) (Defn 'g '(x) (App 'f (list (Var 'x))))) - (App 'f (list (Lit 0)))))) + (App 'f (list (Lit 0))))) + (check-equal? (parse '(define (define x) x) + '(define 1)) + (Prog (list (Defn 'define '(x) (Var 'x))) + (App 'define (list (Lit 1))))) + (check-exn exn:fail? (λ () (parse '(define (define x) x) + '(define (g x) x) + '(define (g 1))))) + (check-exn exn:fail? (λ () (parse-closed '(define (f x) 0) + '(f (g)))))) diff --git a/iniquity/test/test-runner.rkt b/iniquity/test/test-runner.rkt index d2e9383..1139468 100644 --- a/iniquity/test/test-runner.rkt +++ b/iniquity/test/test-runner.rkt @@ -201,6 +201,12 @@ '(2 3 4)) (check-equal? (run '(define (f x y) y) '(f 1 (add1 #f))) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1)) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1 2 3)) 'err))) (define (test/io run) diff --git a/jig/build-runtime.rkt b/jig/build-runtime.rkt deleted file mode 100644 index 6699852..0000000 --- a/jig/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(provide runtime-path) - -(require racket/runtime-path) -(define-runtime-path here ".") - -(unless (system (string-append "make -C '" - (path->string (normalize-path here)) - "' --no-print-directory -s runtime.o")) - (error 'build-runtime "could not build runtime")) - -(define runtime-path - (normalize-path (build-path here "runtime.o"))) - diff --git a/jig/assert.rkt b/jig/compiler/assert.rkt similarity index 97% rename from jig/assert.rkt rename to jig/compiler/assert.rkt index cfc110a..380fc8d 100644 --- a/jig/assert.rkt +++ b/jig/compiler/assert.rkt @@ -3,7 +3,7 @@ assert-box assert-cons assert-natural assert-vector assert-string) (require a86/ast) -(require "types.rkt") +(require "../runtime/types.rkt") (define (assert-type mask type) (λ (r) diff --git a/hoax/compile-ops.rkt b/jig/compiler/compile-ops.rkt similarity index 97% rename from hoax/compile-ops.rkt rename to jig/compiler/compile-ops.rkt index 1bb76cb..1a58a86 100644 --- a/hoax/compile-ops.rkt +++ b/jig/compiler/compile-ops.rkt @@ -1,7 +1,7 @@ #lang racket (provide compile-op0 compile-op1 compile-op2 compile-op3 pad-stack) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require "assert.rkt") (require a86/ast a86/registers) @@ -222,8 +222,8 @@ (Mov r9 (Mem r8 (- type-vect))) (Cmp r10 r9) (Jge 'err) - (Sar r10 1) ; convert to byte offset - (Mov (Mem r8 r10 (- 8 type-vect)) rax) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) (Mov rax (value->bits (void))))])) (define (type-pred mask type) diff --git a/jig/compile-stdin.rkt b/jig/compiler/compile-stdin.rkt similarity index 79% rename from jig/compile-stdin.rkt rename to jig/compiler/compile-stdin.rkt index ed18b5e..f25989a 100644 --- a/jig/compile-stdin.rkt +++ b/jig/compiler/compile-stdin.rkt @@ -1,8 +1,8 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "compile.rkt") -(require "read-all.rkt") +(require "../syntax/read-all.rkt") (require a86/printer) ;; -> Void diff --git a/jig/compile.rkt b/jig/compiler/compile.rkt similarity index 95% rename from jig/compile.rkt rename to jig/compiler/compile.rkt index 81d7ac5..d732cf2 100644 --- a/jig/compile.rkt +++ b/jig/compiler/compile.rkt @@ -4,9 +4,9 @@ compile-es compile-define) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; Prog -> Asm @@ -45,6 +45,8 @@ (match d [(Defn f xs e) (seq (Label (symbol->label f)) + (Cmp r8 (length xs)) ; arity check + (Jne 'err) (compile-e e (reverse xs) #t) (Add rsp (* 8 (length xs))) ; pop args (Ret))])) @@ -160,6 +162,7 @@ (seq (compile-es es c) (move-args (length es) (length c)) (Add rsp (* 8 (length c))) + (Mov r8 (length es)) ; pass arity info (Jmp (symbol->label f)))) ;; Integer Integer -> Asm @@ -176,6 +179,7 @@ (seq (Lea rax r) (Push rax) (compile-es es (cons #f c)) + (Mov r8 (length es)) ; pass arity info (Jmp (symbol->label f)) (Label r)))) diff --git a/jig/correct.rkt b/jig/correct.rkt index d286ba1..1a7846d 100644 --- a/jig/correct.rkt +++ b/jig/correct.rkt @@ -1,10 +1,11 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp-io.rkt") -(require "exec.rkt") +(require "interpreter/interp-io.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; ClosedExpr String -> Void (define (check-compiler e i) (check-equal? (interp/io e i) - (exec/io e i))) + (run/io (compile e) i))) diff --git a/jig/exec-io.rkt b/jig/exec-io.rkt deleted file mode 100644 index fb1d306..0000000 --- a/jig/exec-io.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(require a86/interp) -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec/io) -;; Prog String -> (cons Answer String) -(define (exec/io p in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io (compile p) in) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) - diff --git a/jig/exec.rkt b/jig/exec.rkt deleted file mode 100644 index 59f36bf..0000000 --- a/jig/exec.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec exec/io) -;; Prog -> Answer -(define (exec p) - (run (compile p))) -;; Prog String -> (cons Answer String) -(define (exec/io p in) - (run/io (compile p) in)) - diff --git a/jig/executor/decode.rkt b/jig/executor/decode.rkt new file mode 100644 index 0000000..6ee214f --- /dev/null +++ b/jig/executor/decode.rkt @@ -0,0 +1,45 @@ +#lang racket + +(require "../runtime/types.rkt") +(require ffi/unsafe) + +(provide (all-defined-out)) + +;; Integer -> Value +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(= b (value->bits eof)) eof] + [(= b (value->bits (void))) (void)] + [(= b (value->bits '())) '()] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [(char-bits? b) + (integer->char (arithmetic-shift b (- char-shift)))] + [(box-bits? b) + (box (bits->value (mem-ref (- b type-box))))] + [(cons-bits? b) + (cons (bits->value (mem-ref (+ 0 (- b type-cons)))) + (bits->value (mem-ref (+ 8 (- b type-cons)))))] + + [(vect-bits? b) + (let ((p (- b type-vect))) + (build-vector (bits->value (mem-ref p)) + (lambda (j) + (bits->value (mem-ref (+ p (* 8 (add1 j))))))))] + [(str-bits? b) + (let ((p (- b type-str))) + (build-string (bits->value (mem-ref p)) + (lambda (j) + (integer->char (mem-ref32 (+ p 8 (* 4 j)))))))] + [else (error "invalid bits")])) + +(define (mem-ref i) + (ptr-ref (cast i _int64 _pointer) _int64)) + +(define (mem-ref32 i) + (ptr-ref (cast i _int64 _pointer) _int32)) + +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/jig/executor/exec.rkt b/jig/executor/exec.rkt new file mode 100644 index 0000000..cd5745e --- /dev/null +++ b/jig/executor/exec.rkt @@ -0,0 +1,55 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") +(struct exec-state (program heap) #:transparent) + +(define (exec/state prog) + (define heap (malloc _int64 10000)) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)) + (extern 'raise_error + (λ () (raise 'err)) + (_fun -> _void)))]) + (asm-load prog)) + heap)) + +(define (exec-call st) + (match-define (exec-state program heap) st) + (with-handlers ([(λ (x) (eq? x 'err)) identity]) + (asm-call program 'entry heap))) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/jig/executor/run-stdin.rkt b/jig/executor/run-stdin.rkt new file mode 100644 index 0000000..7e7170f --- /dev/null +++ b/jig/executor/run-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") +(require "run.rkt") + +;; -> Void +;; Compile contents of stdin and use asm-interp to run +(define (main) + (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) + diff --git a/jig/executor/run.rkt b/jig/executor/run.rkt new file mode 100644 index 0000000..d96fe18 --- /dev/null +++ b/jig/executor/run.rkt @@ -0,0 +1,20 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run run/io) +;; Asm -> Answer +(define (run asm) + (call-with-exec + asm + (λ (r) + (match r + ['err 'err] + [b (bits->value b)])))) +;; Asm String -> (cons Answer String) +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) + diff --git a/jig/interp-prims.rkt b/jig/interp-prims.rkt deleted file mode 100644 index c7afbb4..0000000 --- a/jig/interp-prims.rkt +++ /dev/null @@ -1,69 +0,0 @@ -#lang racket -(require "ast.rkt") -(provide interp-prim1 interp-prim2 interp-prim3) - -;; Op1 Value -> Answer -(define (interp-prim1 p1 v) - (match (list p1 v) - [(list 'add1 (? integer?)) (add1 v)] - [(list 'sub1 (? integer?)) (sub1 v)] - [(list 'zero? (? integer?)) (zero? v)] - [(list 'char? v) (char? v)] - [(list 'char->integer (? char?)) (char->integer v)] - [(list 'integer->char (? codepoint?)) (integer->char v)] - [(list 'eof-object? v) (eof-object? v)] - [(list 'write-byte (? byte?)) (write-byte v)] - [(list 'box v) (box v)] - [(list 'unbox (? box?)) (unbox v)] - [(list 'car (? pair?)) (car v)] - [(list 'cdr (? pair?)) (cdr v)] - [(list 'empty? v) (empty? v)] - [(list 'cons? v) (cons? v)] - [(list 'box? v) (box? v)] - [(list 'vector? v) (vector? v)] - [(list 'vector-length (? vector?)) (vector-length v)] - [(list 'string? v) (string? v)] - [(list 'string-length (? string?)) (string-length v)] - [_ 'err])) - -;; Op2 Value Value -> Answer -(define (interp-prim2 p v1 v2) - (match (list p v1 v2) - [(list '+ (? integer?) (? integer?)) (+ v1 v2)] - [(list '- (? integer?) (? integer?)) (- v1 v2)] - [(list '< (? integer?) (? integer?)) (< v1 v2)] - [(list '= (? integer?) (? integer?)) (= v1 v2)] - [(list 'cons v1 v2) (cons v1 v2)] - [(list 'eq? v1 v2) (eq? v1 v2)] - [(list 'make-vector (? integer?) _) - (if (<= 0 v1) - (make-vector v1 v2) - 'err)] - [(list 'vector-ref (? vector?) (? integer?)) - (if (<= 0 v2 (sub1 (vector-length v1))) - (vector-ref v1 v2) - 'err)] - [(list 'make-string (? integer?) (? char?)) - (if (<= 0 v1) - (make-string v1 v2) - 'err)] - [(list 'string-ref (? string?) (? integer?)) - (if (<= 0 v2 (sub1 (string-length v1))) - (string-ref v1 v2) - 'err)] - [_ 'err])) - -;; Op3 Value Value Value -> Answer -(define (interp-prim3 p v1 v2 v3) - (match (list p v1 v2 v3) - [(list 'vector-set! (? vector?) (? integer?) _) - (if (<= 0 v2 (sub1 (vector-length v1))) - (vector-set! v1 v2 v3) - 'err)] - [_ 'err])) - -;; Any -> Boolean -(define (codepoint? v) - (and (integer? v) - (or (<= 0 v 55295) - (<= 57344 v 1114111)))) diff --git a/jig/env.rkt b/jig/interpreter/env.rkt similarity index 100% rename from jig/env.rkt rename to jig/interpreter/env.rkt diff --git a/jig/interp-io.rkt b/jig/interpreter/interp-io.rkt similarity index 100% rename from jig/interp-io.rkt rename to jig/interpreter/interp-io.rkt diff --git a/jig/interp-prim.rkt b/jig/interpreter/interp-prim.rkt similarity index 100% rename from jig/interp-prim.rkt rename to jig/interpreter/interp-prim.rkt diff --git a/jig/interp-stdin.rkt b/jig/interpreter/interp-stdin.rkt similarity index 78% rename from jig/interp-stdin.rkt rename to jig/interpreter/interp-stdin.rkt index df745af..7d85c32 100644 --- a/jig/interp-stdin.rkt +++ b/jig/interpreter/interp-stdin.rkt @@ -1,8 +1,8 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "interp.rkt") -(require "read-all.rkt") +(require "../syntax/read-all.rkt") ;; -> Void ;; Parse and interpret contents of stdin, diff --git a/iniquity/interp.rkt b/jig/interpreter/interp.rkt similarity index 98% rename from iniquity/interp.rkt rename to jig/interpreter/interp.rkt index 80f12e9..65a23b8 100644 --- a/iniquity/interp.rkt +++ b/jig/interpreter/interp.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp interp-e) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") (require "env.rkt") diff --git a/jig/io.c b/jig/io.c deleted file mode 100644 index 8a417c9..0000000 --- a/jig/io.c +++ /dev/null @@ -1,25 +0,0 @@ -#include -#include -#include "types.h" -#include "values.h" -#include "runtime.h" - -val_t read_byte(void) -{ - char c = getc(in); - return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); -} - -val_t peek_byte(void) -{ - char c = getc(in); - ungetc(c, in); - return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); - -} - -val_t write_byte(val_t c) -{ - putc((char) val_unwrap_int(c), out); - return val_wrap_void(); -} diff --git a/jig/main.c b/jig/main.c deleted file mode 100644 index 1ca6115..0000000 --- a/jig/main.c +++ /dev/null @@ -1,40 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); -val_t *heap; - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - heap = malloc(8 * heap_size); - - val_t result; - - result = entry(heap); - - print_result(result); - if (val_typeof(result) != T_VOID) - putchar('\n'); - - free(heap); - return 0; -} diff --git a/jig/main.rkt b/jig/main.rkt index 50cf56e..f9851a3 100644 --- a/jig/main.rkt +++ b/jig/main.rkt @@ -1,18 +1,18 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "interp-io.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "interp-io.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "types.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/jig/run-stdin.rkt b/jig/run-stdin.rkt deleted file mode 100644 index 16cf99e..0000000 --- a/jig/run-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require "run.rkt") - -;; -> Void -;; Compile contents of stdin and use asm-interp to run -(define (main) - (read-line) ; ignore #lang racket line - (run (compile (parse (read))))) - diff --git a/jig/run.rkt b/jig/run.rkt deleted file mode 100644 index e707f3b..0000000 --- a/jig/run.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require a86/interp) -(require "types.rkt") -(require "build-runtime.rkt") -(provide run run/io) - -;; Run instructions with run-time system linked in - -;; Asm -> Answer -(define (run is) - (match (run/io is "") - [(cons r out) (begin (display out) r)])) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - -;; Asm String -> (cons Answer String) -(define (run/io is in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io is in) - [(cons 'err out) (cons 'err out)] - [(cons b out) - (cons (bits->value b) out)]))) - diff --git a/jig/runtime.h b/jig/runtime.h deleted file mode 100644 index cf6a73c..0000000 --- a/jig/runtime.h +++ /dev/null @@ -1,15 +0,0 @@ -#ifndef RUNTIME_H -#define RUNTIME_H - -#include "values.h" - -val_t entry(val_t*); -extern FILE* in; -extern FILE* out; -extern void (*error_handler)(); - -// in words -#define heap_size 10000 -extern val_t *heap; - -#endif /* RUNTIME_H */ diff --git a/jig/runtime/Makefile b/jig/runtime/Makefile new file mode 100644 index 0000000..5582813 --- /dev/null +++ b/jig/runtime/Makefile @@ -0,0 +1,28 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o \ + values.o \ + io.o \ + error.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/jig/char.c b/jig/runtime/char.c similarity index 100% rename from jig/char.c rename to jig/runtime/char.c diff --git a/jig/runtime/error.c b/jig/runtime/error.c new file mode 100644 index 0000000..69a535a --- /dev/null +++ b/jig/runtime/error.c @@ -0,0 +1,9 @@ +#include +#include +#include "runtime.h" + +_Noreturn void raise_error(void) +{ + printf("err\n"); + exit(1); +} diff --git a/jig/heap.h b/jig/runtime/heap.h similarity index 100% rename from jig/heap.h rename to jig/runtime/heap.h diff --git a/jig/runtime/io.c b/jig/runtime/io.c new file mode 100644 index 0000000..139dccb --- /dev/null +++ b/jig/runtime/io.c @@ -0,0 +1,25 @@ +#include +#include +#include "types.h" +#include "values.h" +#include "runtime.h" + +val_t read_byte(void) +{ + char c = getc(stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); +} + +val_t peek_byte(void) +{ + char c = getc(stdin); + ungetc(c, stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); + +} + +val_t write_byte(val_t c) +{ + putc((char) val_unwrap_int(c), stdout); + return val_wrap_void(); +} diff --git a/jig/runtime/main.c b/jig/runtime/main.c new file mode 100644 index 0000000..6fa3ab3 --- /dev/null +++ b/jig/runtime/main.c @@ -0,0 +1,26 @@ +#include +#include +#include "values.h" +#include "print.h" +#include "runtime.h" + +/* in words */ +#define heap_size 10000 + +int main(int argc, char **argv) +{ + val_t *heap = malloc(8 * heap_size); + if (!heap) { + fprintf(stderr, "out of memory\n"); + return 1; + } + + val_t result = entry(heap); + + print_result(result); + if (val_typeof(result) != T_VOID) + putchar('\n'); + + free(heap); + return 0; +} diff --git a/jig/print.c b/jig/runtime/print.c similarity index 100% rename from jig/print.c rename to jig/runtime/print.c diff --git a/jig/print.h b/jig/runtime/print.h similarity index 100% rename from jig/print.h rename to jig/runtime/print.h diff --git a/jig/runtime/runtime.h b/jig/runtime/runtime.h new file mode 100644 index 0000000..ec422c7 --- /dev/null +++ b/jig/runtime/runtime.h @@ -0,0 +1,14 @@ +#ifndef RUNTIME_H +#define RUNTIME_H + +#include "values.h" + +val_t entry(val_t *heap); + +val_t read_byte(void); +val_t peek_byte(void); +val_t write_byte(val_t); + +_Noreturn void raise_error(void); + +#endif /* RUNTIME_H */ diff --git a/jig/types.h b/jig/runtime/types.h similarity index 100% rename from jig/types.h rename to jig/runtime/types.h diff --git a/jig/types.rkt b/jig/runtime/types.rkt similarity index 51% rename from jig/types.rkt rename to jig/runtime/types.rkt index c0c1d70..b9198f9 100644 --- a/jig/types.rkt +++ b/jig/runtime/types.rkt @@ -1,6 +1,5 @@ #lang racket (provide (all-defined-out)) -(require ffi/unsafe) (define imm-shift 3) (define imm-mask #b111) @@ -16,35 +15,6 @@ (define type-char #b01000) (define mask-char #b11111) -;; Integer -> Value -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(= b (value->bits eof)) eof] - [(= b (value->bits (void))) (void)] - [(= b (value->bits '())) '()] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [(box-bits? b) - (box (bits->value (mem-ref (- b type-box))))] - [(cons-bits? b) - (cons (bits->value (mem-ref (+ 0 (- b type-cons)))) - (bits->value (mem-ref (+ 8 (- b type-cons)))))] - - [(vect-bits? b) - (let ((p (- b type-vect))) - (build-vector (bits->value (mem-ref p)) - (lambda (j) - (bits->value (mem-ref (+ p (* 8 (add1 j))))))))] - [(str-bits? b) - (let ((p (- b type-str))) - (build-string (bits->value (mem-ref p)) - (lambda (j) - (integer->char (mem-ref32 (+ p 8 (* 4 j)))))))] - [else (error "invalid bits")])) - ;; Value -> Integer ;; v must be an immediate (define (value->bits v) @@ -80,9 +50,3 @@ (define (str-bits? v) (= type-str (bitwise-and v imm-mask))) -(define (mem-ref i) - (ptr-ref (cast i _int64 _pointer) _int64)) - -(define (mem-ref32 i) - (ptr-ref (cast i _int64 _pointer) _int32)) - diff --git a/jig/values.c b/jig/runtime/values.c similarity index 100% rename from jig/values.c rename to jig/runtime/values.c diff --git a/jig/values.h b/jig/runtime/values.h similarity index 100% rename from jig/values.h rename to jig/runtime/values.h diff --git a/jig/ast.rkt b/jig/syntax/ast.rkt similarity index 100% rename from jig/ast.rkt rename to jig/syntax/ast.rkt diff --git a/jig/parse.rkt b/jig/syntax/parse.rkt similarity index 98% rename from jig/parse.rkt rename to jig/syntax/parse.rkt index 511e0bb..b87bfa7 100644 --- a/jig/parse.rkt +++ b/jig/syntax/parse.rkt @@ -35,7 +35,7 @@ (define (rec ss fs) (match ss [(list s) fs] - [(cons (cons 'define sd) sr) + [(cons (cons (? (not-in fs) 'define) sd) sr) (match (parse-defn-name sd) [f (if (memq f fs) (error "duplicate definition" f) @@ -139,7 +139,7 @@ (list ys (cons g gs) (App g es))])])])] [(list-rest (? symbol? g) sr) (match (parse-es/acc sr fs xs ys gs) - [(list ys s es) + [(list ys gs es) (list ys (if (memq g fs) gs (cons g gs)) (App g es))])] [_ (error "parse error" s)])) diff --git a/jig/read-all.rkt b/jig/syntax/read-all.rkt similarity index 100% rename from jig/read-all.rkt rename to jig/syntax/read-all.rkt diff --git a/jig/test/build-runtime.rkt b/jig/test/build-runtime.rkt deleted file mode 100644 index 7023ee0..0000000 --- a/jig/test/build-runtime.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require a86/interp) - -;; link with runtime for IO operations -(unless (file-exists? "../runtime.o") - (system "make -C .. runtime.o")) -(current-objs - (list (path->string (normalize-path "../runtime.o")))) diff --git a/jig/test/compile.rkt b/jig/test/compile.rkt index 2096b58..76fdb1a 100644 --- a/jig/test/compile.rkt +++ b/jig/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ p (exec (apply parse-closed p)))) -(test/io (λ (in . p) (exec/io (apply parse-closed p) in))) +(test (λ p (run (compile (apply parse-closed p))))) +(test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) diff --git a/jig/test/interp.rkt b/jig/test/interp.rkt index 523685b..823063f 100644 --- a/jig/test/interp.rkt +++ b/jig/test/interp.rkt @@ -1,7 +1,7 @@ #lang racket -(require "../interp.rkt") -(require "../interp-io.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ p (interp (apply parse-closed p)))) (test/io (λ (in . p) (interp/io (apply parse-closed p) in))) diff --git a/jig/test/parse.rkt b/jig/test/parse.rkt index fd413ee..80fd2e2 100644 --- a/jig/test/parse.rkt +++ b/jig/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) @@ -47,6 +47,7 @@ (check-equal? (parse "asdf") (p (Lit "asdf"))) (check-equal? (parse '(make-string 10 #\a)) (p (Prim2 'make-string (Lit 10) (Lit #\a))))) + (begin ; Iniquity (check-equal? (parse '(define (f x) x) 1) (Prog (list (Defn 'f '(x) (Var 'x))) (Lit 1))) diff --git a/jig/test/test-progs.rkt b/jig/test/test-progs.rkt deleted file mode 100644 index ec1d725..0000000 --- a/jig/test/test-progs.rkt +++ /dev/null @@ -1,6 +0,0 @@ -#lang racket -;; run command line compiler and compare against Racket as refernece implementation -(require rackunit - "../../test-programs/get-progs.rkt" - "build-runtime.rkt") -(for-each test-prog (get-progs "jig")) diff --git a/jig/test/test-runner.rkt b/jig/test/test-runner.rkt index d2e9383..1139468 100644 --- a/jig/test/test-runner.rkt +++ b/jig/test/test-runner.rkt @@ -201,6 +201,12 @@ '(2 3 4)) (check-equal? (run '(define (f x y) y) '(f 1 (add1 #f))) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1)) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1 2 3)) 'err))) (define (test/io run) diff --git a/knock/build-runtime.rkt b/knock/build-runtime.rkt deleted file mode 100644 index 6699852..0000000 --- a/knock/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(provide runtime-path) - -(require racket/runtime-path) -(define-runtime-path here ".") - -(unless (system (string-append "make -C '" - (path->string (normalize-path here)) - "' --no-print-directory -s runtime.o")) - (error 'build-runtime "could not build runtime")) - -(define runtime-path - (normalize-path (build-path here "runtime.o"))) - diff --git a/knock/assert.rkt b/knock/compiler/assert.rkt similarity index 97% rename from knock/assert.rkt rename to knock/compiler/assert.rkt index cfc110a..380fc8d 100644 --- a/knock/assert.rkt +++ b/knock/compiler/assert.rkt @@ -3,7 +3,7 @@ assert-box assert-cons assert-natural assert-vector assert-string) (require a86/ast) -(require "types.rkt") +(require "../runtime/types.rkt") (define (assert-type mask type) (λ (r) diff --git a/iniquity/compile-ops.rkt b/knock/compiler/compile-ops.rkt similarity index 97% rename from iniquity/compile-ops.rkt rename to knock/compiler/compile-ops.rkt index 1bb76cb..1a58a86 100644 --- a/iniquity/compile-ops.rkt +++ b/knock/compiler/compile-ops.rkt @@ -1,7 +1,7 @@ #lang racket (provide compile-op0 compile-op1 compile-op2 compile-op3 pad-stack) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require "assert.rkt") (require a86/ast a86/registers) @@ -222,8 +222,8 @@ (Mov r9 (Mem r8 (- type-vect))) (Cmp r10 r9) (Jge 'err) - (Sar r10 1) ; convert to byte offset - (Mov (Mem r8 r10 (- 8 type-vect)) rax) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) (Mov rax (value->bits (void))))])) (define (type-pred mask type) diff --git a/knock/compile-stdin.rkt b/knock/compiler/compile-stdin.rkt similarity index 79% rename from knock/compile-stdin.rkt rename to knock/compiler/compile-stdin.rkt index ed18b5e..f25989a 100644 --- a/knock/compile-stdin.rkt +++ b/knock/compiler/compile-stdin.rkt @@ -1,8 +1,8 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "compile.rkt") -(require "read-all.rkt") +(require "../syntax/read-all.rkt") (require a86/printer) ;; -> Void diff --git a/knock/compile.rkt b/knock/compiler/compile.rkt similarity index 97% rename from knock/compile.rkt rename to knock/compiler/compile.rkt index 901a033..74c72f3 100644 --- a/knock/compile.rkt +++ b/knock/compiler/compile.rkt @@ -9,9 +9,9 @@ ; for notes (provide compile-pattern) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") -(require "types.rkt") +(require "../runtime/types.rkt") (require a86/ast a86/registers) ;; Prog -> Asm @@ -50,6 +50,8 @@ (match d [(Defn f xs e) (seq (Label (symbol->label f)) + (Cmp r8 (length xs)) ; arity check + (Jne 'err) (compile-e e (reverse xs) #t) (Add rsp (* 8 (length xs))) ; pop args (Ret))])) @@ -166,6 +168,7 @@ (seq (compile-es es c) (move-args (length es) (length c)) (Add rsp (* 8 (length c))) + (Mov r8 (length es)) ; pass arity info (Jmp (symbol->label f)))) ;; Integer Integer -> Asm @@ -182,6 +185,7 @@ (seq (Lea rax r) (Push rax) (compile-es es (cons #f c)) + (Mov r8 (length es)) ; pass arity info (Jmp (symbol->label f)) (Label r)))) diff --git a/knock/correct.rkt b/knock/correct.rkt index d286ba1..1a7846d 100644 --- a/knock/correct.rkt +++ b/knock/correct.rkt @@ -1,10 +1,11 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp-io.rkt") -(require "exec.rkt") +(require "interpreter/interp-io.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; ClosedExpr String -> Void (define (check-compiler e i) (check-equal? (interp/io e i) - (exec/io e i))) + (run/io (compile e) i))) diff --git a/knock/exec-io.rkt b/knock/exec-io.rkt deleted file mode 100644 index fb1d306..0000000 --- a/knock/exec-io.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(require a86/interp) -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec/io) -;; Prog String -> (cons Answer String) -(define (exec/io p in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io (compile p) in) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) - diff --git a/knock/exec.rkt b/knock/exec.rkt deleted file mode 100644 index 59f36bf..0000000 --- a/knock/exec.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec exec/io) -;; Prog -> Answer -(define (exec p) - (run (compile p))) -;; Prog String -> (cons Answer String) -(define (exec/io p in) - (run/io (compile p) in)) - diff --git a/knock/executor/decode.rkt b/knock/executor/decode.rkt new file mode 100644 index 0000000..6ee214f --- /dev/null +++ b/knock/executor/decode.rkt @@ -0,0 +1,45 @@ +#lang racket + +(require "../runtime/types.rkt") +(require ffi/unsafe) + +(provide (all-defined-out)) + +;; Integer -> Value +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(= b (value->bits eof)) eof] + [(= b (value->bits (void))) (void)] + [(= b (value->bits '())) '()] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [(char-bits? b) + (integer->char (arithmetic-shift b (- char-shift)))] + [(box-bits? b) + (box (bits->value (mem-ref (- b type-box))))] + [(cons-bits? b) + (cons (bits->value (mem-ref (+ 0 (- b type-cons)))) + (bits->value (mem-ref (+ 8 (- b type-cons)))))] + + [(vect-bits? b) + (let ((p (- b type-vect))) + (build-vector (bits->value (mem-ref p)) + (lambda (j) + (bits->value (mem-ref (+ p (* 8 (add1 j))))))))] + [(str-bits? b) + (let ((p (- b type-str))) + (build-string (bits->value (mem-ref p)) + (lambda (j) + (integer->char (mem-ref32 (+ p 8 (* 4 j)))))))] + [else (error "invalid bits")])) + +(define (mem-ref i) + (ptr-ref (cast i _int64 _pointer) _int64)) + +(define (mem-ref32 i) + (ptr-ref (cast i _int64 _pointer) _int32)) + +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/knock/executor/exec.rkt b/knock/executor/exec.rkt new file mode 100644 index 0000000..cd5745e --- /dev/null +++ b/knock/executor/exec.rkt @@ -0,0 +1,55 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") +(struct exec-state (program heap) #:transparent) + +(define (exec/state prog) + (define heap (malloc _int64 10000)) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)) + (extern 'raise_error + (λ () (raise 'err)) + (_fun -> _void)))]) + (asm-load prog)) + heap)) + +(define (exec-call st) + (match-define (exec-state program heap) st) + (with-handlers ([(λ (x) (eq? x 'err)) identity]) + (asm-call program 'entry heap))) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/knock/executor/run-stdin.rkt b/knock/executor/run-stdin.rkt new file mode 100644 index 0000000..7e7170f --- /dev/null +++ b/knock/executor/run-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") +(require "run.rkt") + +;; -> Void +;; Compile contents of stdin and use asm-interp to run +(define (main) + (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) + diff --git a/knock/executor/run.rkt b/knock/executor/run.rkt new file mode 100644 index 0000000..d96fe18 --- /dev/null +++ b/knock/executor/run.rkt @@ -0,0 +1,20 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run run/io) +;; Asm -> Answer +(define (run asm) + (call-with-exec + asm + (λ (r) + (match r + ['err 'err] + [b (bits->value b)])))) +;; Asm String -> (cons Answer String) +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) + diff --git a/knock/interp-prims.rkt b/knock/interp-prims.rkt deleted file mode 100644 index 15039f9..0000000 --- a/knock/interp-prims.rkt +++ /dev/null @@ -1,69 +0,0 @@ -#lang racket -(require "ast.rkt") -(provide interp-prim1 interp-prim2 interp-prim3) - -;; Op1 Value -> Answer -(define (interp-prim1 p1 v) - (match (list p1 v) - [(list 'add1 (? integer?)) (add1 v)] - [(list 'sub1 (? integer?)) (sub1 v)] - [(list 'zero? (? integer?)) (zero? v)] - [(list 'char? v) (char? v)] - [(list 'char->integer (? char?)) (char->integer v)] - [(list 'integer->char (? codepoint?)) (integer->char v)] - [(list 'eof-object? v) (eof-object? v)] - [(list 'write-byte (? byte?)) (write-byte v)] - [(list 'box v) (box v)] - [(list 'unbox (? box?)) (unbox v)] - [(list 'car (? pair?)) (car v)] - [(list 'cdr (? pair?)) (cdr v)] - [(list 'empty? v) (empty? v)] - [(list 'cons? v) (cons? v)] - [(list 'box? v) (box? v)] - [(list 'vector? v) (vector? v)] - [(list 'vector-length (? vector?)) (vector-length v)] - [(list 'string? v) (string? v)] - [(list 'string-length (? string?)) (string-length v)] - [_ 'err])) - -;; Op2 Value Value -> Answer -(define (interp-prim2 p v1 v2) - (match (list p v1 v2) - [(list '+ (? integer?) (? integer?)) (+ v1 v2)] - [(list '- (? integer?) (? integer?)) (- v1 v2)] - [(list '< (? integer?) (? integer?)) (< v1 v2)] - [(list '= (? integer?) (? integer?)) (= v1 v2)] - [(list 'cons v1 v2) (cons v1 v2)] - [(list 'eq? v1 v2) (eq? v1 v2)] - [(list 'make-vector (? integer?) _) - (if (<= 0 v1) - (make-vector v1 v2) - 'err)] - [(list 'vector-ref (? vector?) (? integer?)) - (if (<= 0 v2 (sub1 (vector-length v1))) - (vector-ref v1 v2) - 'err)] - [(list 'make-string (? integer?) (? char?)) - (if (<= 0 v1) - (make-string v1 v2) - 'err)] - [(list 'string-ref (? string?) (? integer?)) - (if (<= 0 v2 (sub1 (string-length v1))) - (string-ref v1 v2) - 'err)] - [_ 'err])) - -;; Op3 Value Value Value -> Answer -(define (interp-prim3 p v1 v2 v3) - (match (list p v1 v2 v3) - [(list 'vector-set! (? vector?) (? integer?) _) - (if (<= 0 v2 (sub1 (vector-length v1))) - (vector-set! v1 v2 v3) - 'err)] - [_ 'err])) - -;; Any -> Boolean -(define (codepoint? v) - (and (integer? v) - (or (<= 0 v 55295) - (<= 57344 v 1114111)))) diff --git a/knock/env.rkt b/knock/interpreter/env.rkt similarity index 100% rename from knock/env.rkt rename to knock/interpreter/env.rkt diff --git a/knock/interp-io.rkt b/knock/interpreter/interp-io.rkt similarity index 100% rename from knock/interp-io.rkt rename to knock/interpreter/interp-io.rkt diff --git a/knock/interp-prim.rkt b/knock/interpreter/interp-prim.rkt similarity index 100% rename from knock/interp-prim.rkt rename to knock/interpreter/interp-prim.rkt diff --git a/knock/interp-stdin.rkt b/knock/interpreter/interp-stdin.rkt similarity index 78% rename from knock/interp-stdin.rkt rename to knock/interpreter/interp-stdin.rkt index df745af..7d85c32 100644 --- a/knock/interp-stdin.rkt +++ b/knock/interpreter/interp-stdin.rkt @@ -1,8 +1,8 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "interp.rkt") -(require "read-all.rkt") +(require "../syntax/read-all.rkt") ;; -> Void ;; Parse and interpret contents of stdin, diff --git a/knock/interp.rkt b/knock/interpreter/interp.rkt similarity index 99% rename from knock/interp.rkt rename to knock/interpreter/interp.rkt index 9b91055..44b91b5 100644 --- a/knock/interp.rkt +++ b/knock/interpreter/interp.rkt @@ -1,7 +1,7 @@ #lang racket (provide interp interp-e) (provide interp-match-pat) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") (require "env.rkt") diff --git a/knock/io.c b/knock/io.c deleted file mode 100644 index 8a417c9..0000000 --- a/knock/io.c +++ /dev/null @@ -1,25 +0,0 @@ -#include -#include -#include "types.h" -#include "values.h" -#include "runtime.h" - -val_t read_byte(void) -{ - char c = getc(in); - return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); -} - -val_t peek_byte(void) -{ - char c = getc(in); - ungetc(c, in); - return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); - -} - -val_t write_byte(val_t c) -{ - putc((char) val_unwrap_int(c), out); - return val_wrap_void(); -} diff --git a/knock/main.c b/knock/main.c deleted file mode 100644 index 1ca6115..0000000 --- a/knock/main.c +++ /dev/null @@ -1,40 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); -val_t *heap; - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - heap = malloc(8 * heap_size); - - val_t result; - - result = entry(heap); - - print_result(result); - if (val_typeof(result) != T_VOID) - putchar('\n'); - - free(heap); - return 0; -} diff --git a/knock/main.rkt b/knock/main.rkt index 50cf56e..f9851a3 100644 --- a/knock/main.rkt +++ b/knock/main.rkt @@ -1,18 +1,18 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "interp-io.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "interp-io.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "types.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/knock/run-stdin.rkt b/knock/run-stdin.rkt deleted file mode 100644 index 16cf99e..0000000 --- a/knock/run-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require "run.rkt") - -;; -> Void -;; Compile contents of stdin and use asm-interp to run -(define (main) - (read-line) ; ignore #lang racket line - (run (compile (parse (read))))) - diff --git a/knock/run.rkt b/knock/run.rkt deleted file mode 100644 index e707f3b..0000000 --- a/knock/run.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require a86/interp) -(require "types.rkt") -(require "build-runtime.rkt") -(provide run run/io) - -;; Run instructions with run-time system linked in - -;; Asm -> Answer -(define (run is) - (match (run/io is "") - [(cons r out) (begin (display out) r)])) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - -;; Asm String -> (cons Answer String) -(define (run/io is in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io is in) - [(cons 'err out) (cons 'err out)] - [(cons b out) - (cons (bits->value b) out)]))) - diff --git a/knock/runtime.h b/knock/runtime.h deleted file mode 100644 index cf6a73c..0000000 --- a/knock/runtime.h +++ /dev/null @@ -1,15 +0,0 @@ -#ifndef RUNTIME_H -#define RUNTIME_H - -#include "values.h" - -val_t entry(val_t*); -extern FILE* in; -extern FILE* out; -extern void (*error_handler)(); - -// in words -#define heap_size 10000 -extern val_t *heap; - -#endif /* RUNTIME_H */ diff --git a/knock/runtime/Makefile b/knock/runtime/Makefile new file mode 100644 index 0000000..5582813 --- /dev/null +++ b/knock/runtime/Makefile @@ -0,0 +1,28 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o \ + values.o \ + io.o \ + error.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/knock/char.c b/knock/runtime/char.c similarity index 100% rename from knock/char.c rename to knock/runtime/char.c diff --git a/knock/runtime/error.c b/knock/runtime/error.c new file mode 100644 index 0000000..69a535a --- /dev/null +++ b/knock/runtime/error.c @@ -0,0 +1,9 @@ +#include +#include +#include "runtime.h" + +_Noreturn void raise_error(void) +{ + printf("err\n"); + exit(1); +} diff --git a/knock/gc.c b/knock/runtime/gc.c similarity index 100% rename from knock/gc.c rename to knock/runtime/gc.c diff --git a/knock/heap.h b/knock/runtime/heap.h similarity index 100% rename from knock/heap.h rename to knock/runtime/heap.h diff --git a/knock/runtime/io.c b/knock/runtime/io.c new file mode 100644 index 0000000..139dccb --- /dev/null +++ b/knock/runtime/io.c @@ -0,0 +1,25 @@ +#include +#include +#include "types.h" +#include "values.h" +#include "runtime.h" + +val_t read_byte(void) +{ + char c = getc(stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); +} + +val_t peek_byte(void) +{ + char c = getc(stdin); + ungetc(c, stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); + +} + +val_t write_byte(val_t c) +{ + putc((char) val_unwrap_int(c), stdout); + return val_wrap_void(); +} diff --git a/knock/runtime/main.c b/knock/runtime/main.c new file mode 100644 index 0000000..6fa3ab3 --- /dev/null +++ b/knock/runtime/main.c @@ -0,0 +1,26 @@ +#include +#include +#include "values.h" +#include "print.h" +#include "runtime.h" + +/* in words */ +#define heap_size 10000 + +int main(int argc, char **argv) +{ + val_t *heap = malloc(8 * heap_size); + if (!heap) { + fprintf(stderr, "out of memory\n"); + return 1; + } + + val_t result = entry(heap); + + print_result(result); + if (val_typeof(result) != T_VOID) + putchar('\n'); + + free(heap); + return 0; +} diff --git a/knock/print.c b/knock/runtime/print.c similarity index 100% rename from knock/print.c rename to knock/runtime/print.c diff --git a/knock/print.h b/knock/runtime/print.h similarity index 100% rename from knock/print.h rename to knock/runtime/print.h diff --git a/hoax/runtime.h b/knock/runtime/runtime.h similarity index 100% rename from hoax/runtime.h rename to knock/runtime/runtime.h diff --git a/knock/types.h b/knock/runtime/types.h similarity index 100% rename from knock/types.h rename to knock/runtime/types.h diff --git a/knock/runtime/types.rkt b/knock/runtime/types.rkt new file mode 100644 index 0000000..b9198f9 --- /dev/null +++ b/knock/runtime/types.rkt @@ -0,0 +1,52 @@ +#lang racket +(provide (all-defined-out)) + +(define imm-shift 3) +(define imm-mask #b111) +(define ptr-mask #b111) +(define type-box #b001) +(define type-cons #b010) +(define type-vect #b011) +(define type-str #b100) +(define int-shift (+ 1 imm-shift)) +(define mask-int #b1111) +(define char-shift (+ 2 imm-shift)) +(define type-int #b0000) +(define type-char #b01000) +(define mask-char #b11111) + +;; Value -> Integer +;; v must be an immediate +(define (value->bits v) + (cond [(eq? v #t) #b00011000] + [(eq? v #f) #b00111000] + [(eq? v eof) #b01011000] + [(eq? v (void)) #b01111000] + [(eq? v '()) #b10011000] + [(integer? v) (arithmetic-shift v int-shift)] + [(char? v) + (bitwise-ior type-char + (arithmetic-shift (char->integer v) char-shift))] + [else (error "not an immediate value" v)])) + +(define (int-bits? v) + (= type-int (bitwise-and v mask-int))) + +(define (char-bits? v) + (= type-char (bitwise-and v mask-char))) + +(define (imm-bits? v) + (zero? (bitwise-and v imm-mask))) + +(define (cons-bits? v) + (= type-cons (bitwise-and v imm-mask))) + +(define (box-bits? v) + (= type-box (bitwise-and v imm-mask))) + +(define (vect-bits? v) + (= type-vect (bitwise-and v imm-mask))) + +(define (str-bits? v) + (= type-str (bitwise-and v imm-mask))) + diff --git a/knock/values.c b/knock/runtime/values.c similarity index 100% rename from knock/values.c rename to knock/runtime/values.c diff --git a/knock/values.h b/knock/runtime/values.h similarity index 100% rename from knock/values.h rename to knock/runtime/values.h diff --git a/knock/ast.rkt b/knock/syntax/ast.rkt similarity index 100% rename from knock/ast.rkt rename to knock/syntax/ast.rkt diff --git a/knock/parse.rkt b/knock/syntax/parse.rkt similarity index 95% rename from knock/parse.rkt rename to knock/syntax/parse.rkt index ecc5fb2..01680e0 100644 --- a/knock/parse.rkt +++ b/knock/syntax/parse.rkt @@ -41,7 +41,7 @@ (define (rec ss fs) (match ss [(list s) fs] - [(cons (cons 'define sd) sr) + [(cons (cons (? (not-in fs) 'define) sd) sr) (match (parse-defn-name sd) [f (if (memq f fs) (error "duplicate definition" f) @@ -126,14 +126,14 @@ (list ys gs (Let x e1 e2))])])] [_ (error "let: bad syntax" s)])] ['match - (match sr - [(cons s sr) - (match (rec s xs ys gs) - [(list ys gs e) - (match (parse-match-clauses/acc sr fs xs ys gs) - [(list ys gs ps es) - (list ys gs (Match e ps es))])])] - [_ (error "match: bad syntax" s)])] + (match sr + [(cons s sr) + (match (rec s xs ys gs) + [(list ys gs e) + (match (parse-match-clauses/acc sr fs xs ys gs) + [(list ys gs ps es) + (list ys gs (Match e ps es))])])] + [_ (error "match: bad syntax" s)])] [_ (match (parse-es/acc sr fs xs ys gs) [(list ys gs es) @@ -154,7 +154,7 @@ (list ys (cons g gs) (App g es))])])])] [(list-rest (? symbol? g) sr) (match (parse-es/acc sr fs xs ys gs) - [(list ys s es) + [(list ys gs es) (list ys (if (memq g fs) gs (cons g gs)) (App g es))])] [_ (error "parse error" s)])) diff --git a/knock/read-all.rkt b/knock/syntax/read-all.rkt similarity index 100% rename from knock/read-all.rkt rename to knock/syntax/read-all.rkt diff --git a/knock/test/build-runtime.rkt b/knock/test/build-runtime.rkt deleted file mode 100644 index 7023ee0..0000000 --- a/knock/test/build-runtime.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require a86/interp) - -;; link with runtime for IO operations -(unless (file-exists? "../runtime.o") - (system "make -C .. runtime.o")) -(current-objs - (list (path->string (normalize-path "../runtime.o")))) diff --git a/knock/test/compile.rkt b/knock/test/compile.rkt index 2096b58..76fdb1a 100644 --- a/knock/test/compile.rkt +++ b/knock/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ p (exec (apply parse-closed p)))) -(test/io (λ (in . p) (exec/io (apply parse-closed p) in))) +(test (λ p (run (compile (apply parse-closed p))))) +(test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) diff --git a/knock/test/interp.rkt b/knock/test/interp.rkt index 523685b..823063f 100644 --- a/knock/test/interp.rkt +++ b/knock/test/interp.rkt @@ -1,7 +1,7 @@ #lang racket -(require "../interp.rkt") -(require "../interp-io.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ p (interp (apply parse-closed p)))) (test/io (λ (in . p) (interp/io (apply parse-closed p) in))) diff --git a/knock/test/parse.rkt b/knock/test/parse.rkt index 8f8494f..ef2d59c 100644 --- a/knock/test/parse.rkt +++ b/knock/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) @@ -47,6 +47,7 @@ (check-equal? (parse "asdf") (p (Lit "asdf"))) (check-equal? (parse '(make-string 10 #\a)) (p (Prim2 'make-string (Lit 10) (Lit #\a))))) + (begin ; Iniquity (check-equal? (parse '(define (f x) x) 1) (Prog (list (Defn 'f '(x) (Var 'x))) (Lit 1))) diff --git a/knock/test/test-runner.rkt b/knock/test/test-runner.rkt index 889ab7c..583af0d 100644 --- a/knock/test/test-runner.rkt +++ b/knock/test/test-runner.rkt @@ -201,6 +201,12 @@ '(2 3 4)) (check-equal? (run '(define (f x y) y) '(f 1 (add1 #f))) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1)) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1 2 3)) 'err)) (begin ;; Knock diff --git a/loot/build-runtime.rkt b/loot/build-runtime.rkt deleted file mode 100644 index 6699852..0000000 --- a/loot/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(provide runtime-path) - -(require racket/runtime-path) -(define-runtime-path here ".") - -(unless (system (string-append "make -C '" - (path->string (normalize-path here)) - "' --no-print-directory -s runtime.o")) - (error 'build-runtime "could not build runtime")) - -(define runtime-path - (normalize-path (build-path here "runtime.o"))) - diff --git a/loot/assert.rkt b/loot/compiler/assert.rkt similarity index 97% rename from loot/assert.rkt rename to loot/compiler/assert.rkt index 250f51c..e6698e9 100644 --- a/loot/assert.rkt +++ b/loot/compiler/assert.rkt @@ -4,7 +4,7 @@ assert-natural assert-vector assert-string assert-proc) (require a86/ast) -(require "types.rkt") +(require "../runtime/types.rkt") (define (assert-type mask type) (λ (r) diff --git a/loot/compile-ops.rkt b/loot/compiler/compile-ops.rkt similarity index 97% rename from loot/compile-ops.rkt rename to loot/compiler/compile-ops.rkt index a648695..295b687 100644 --- a/loot/compile-ops.rkt +++ b/loot/compiler/compile-ops.rkt @@ -1,7 +1,7 @@ #lang racket (provide compile-op0 compile-op1 compile-op2 compile-op3 pad-stack assert-proc) -(require "ast.rkt") -(require "types.rkt") +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") (require "assert.rkt") (require a86/ast a86/registers) @@ -222,8 +222,8 @@ (Mov r9 (Mem r8 (- type-vect))) (Cmp r10 r9) (Jge 'err) - (Sar r10 1) ; convert to byte offset - (Mov (Mem r8 r10 (- 8 type-vect)) rax) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) (Mov rax (value->bits (void))))])) (define (type-pred mask type) diff --git a/loot/compile-stdin.rkt b/loot/compiler/compile-stdin.rkt similarity index 79% rename from loot/compile-stdin.rkt rename to loot/compiler/compile-stdin.rkt index ed18b5e..f25989a 100644 --- a/loot/compile-stdin.rkt +++ b/loot/compiler/compile-stdin.rkt @@ -1,8 +1,8 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "compile.rkt") -(require "read-all.rkt") +(require "../syntax/read-all.rkt") (require a86/printer) ;; -> Void diff --git a/loot/compile.rkt b/loot/compiler/compile.rkt similarity index 97% rename from loot/compile.rkt rename to loot/compiler/compile.rkt index 430d1f5..c32eef1 100644 --- a/loot/compile.rkt +++ b/loot/compiler/compile.rkt @@ -9,11 +9,11 @@ copy-env-to-stack free-vars-to-heap) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "compile-ops.rkt") -(require "types.rkt") -(require "lambdas.rkt") -(require "fv.rkt") +(require "../runtime/types.rkt") +(require "../syntax/lambdas.rkt") +(require "../syntax/fv.rkt") (require a86/ast a86/registers) ;; Prog -> Asm @@ -77,6 +77,8 @@ [(Lam f xs e) (let ((env (append (reverse fvs) (reverse xs) (list #f)))) (seq (Label (symbol->label f)) + (Cmp r8 (length xs)) + (Jne 'err) (Mov rax (Mem rsp (* 8 (length xs)))) (copy-env-to-stack fvs 8) (compile-e e env #t) @@ -210,6 +212,7 @@ (Mov rax (Mem rsp (* 8 (length es)))) (assert-proc rax) (Mov rax (Mem rax (- type-proc))) + (Mov r8 (length es)) ; pass arity info (Jmp rax))) ;; Integer Integer -> Asm @@ -233,6 +236,7 @@ (Mov rax (Mem rsp i)) (assert-proc rax) (Mov rax (Mem rax (- type-proc))) ; fetch the code label + (Mov r8 (length es)) ; pass arity info (Jmp rax) (Label r)))) diff --git a/loot/correct.rkt b/loot/correct.rkt index d286ba1..1a7846d 100644 --- a/loot/correct.rkt +++ b/loot/correct.rkt @@ -1,10 +1,11 @@ #lang racket (provide check-compiler) (require rackunit) -(require "interp-io.rkt") -(require "exec.rkt") +(require "interpreter/interp-io.rkt") +(require "executor/run.rkt") +(require "compiler/compile.rkt") ;; ClosedExpr String -> Void (define (check-compiler e i) (check-equal? (interp/io e i) - (exec/io e i))) + (run/io (compile e) i))) diff --git a/loot/exec-io.rkt b/loot/exec-io.rkt deleted file mode 100644 index fb1d306..0000000 --- a/loot/exec-io.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(require a86/interp) -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec/io) -;; Prog String -> (cons Answer String) -(define (exec/io p in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io (compile p) in) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) - diff --git a/loot/exec.rkt b/loot/exec.rkt deleted file mode 100644 index 59f36bf..0000000 --- a/loot/exec.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require a86/interp) -(require "run.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "build-runtime.rkt") -(provide exec exec/io) -;; Prog -> Answer -(define (exec p) - (run (compile p))) -;; Prog String -> (cons Answer String) -(define (exec/io p in) - (run/io (compile p) in)) - diff --git a/loot/types.rkt b/loot/executor/decode.rkt similarity index 50% rename from loot/types.rkt rename to loot/executor/decode.rkt index 0bb1674..d81ea13 100644 --- a/loot/types.rkt +++ b/loot/executor/decode.rkt @@ -1,21 +1,9 @@ #lang racket -(provide (all-defined-out)) + +(require "../runtime/types.rkt") (require ffi/unsafe) -(define imm-shift 3) -(define imm-mask #b111) -(define ptr-mask #b111) -(define type-box #b001) -(define type-cons #b010) -(define type-vect #b011) -(define type-str #b100) -(define type-proc #b101) -(define int-shift (+ 1 imm-shift)) -(define mask-int #b1111) -(define char-shift (+ 2 imm-shift)) -(define type-int #b0000) -(define type-char #b01000) -(define mask-char #b11111) +(provide (all-defined-out)) ;; Integer -> Value (define (bits->value b) @@ -49,47 +37,12 @@ (error "This function is not callable."))] [else (error "invalid bits")])) -;; Value -> Integer -;; v must be an immediate -(define (value->bits v) - (cond [(eq? v #t) #b00011000] - [(eq? v #f) #b00111000] - [(eq? v eof) #b01011000] - [(eq? v (void)) #b01111000] - [(eq? v '()) #b10011000] - [(integer? v) (arithmetic-shift v int-shift)] - [(char? v) - (bitwise-ior type-char - (arithmetic-shift (char->integer v) char-shift))] - [else (error "not an immediate value" v)])) - -(define (int-bits? v) - (= type-int (bitwise-and v mask-int))) - -(define (char-bits? v) - (= type-char (bitwise-and v mask-char))) - -(define (imm-bits? v) - (zero? (bitwise-and v imm-mask))) - -(define (cons-bits? v) - (= type-cons (bitwise-and v imm-mask))) - -(define (box-bits? v) - (= type-box (bitwise-and v imm-mask))) - -(define (vect-bits? v) - (= type-vect (bitwise-and v imm-mask))) - -(define (str-bits? v) - (= type-str (bitwise-and v imm-mask))) - (define (mem-ref i) (ptr-ref (cast i _int64 _pointer) _int64)) (define (mem-ref32 i) (ptr-ref (cast i _int64 _pointer) _int32)) -(define (proc-bits? v) - (= type-proc (bitwise-and v imm-mask))) +(define _val + (make-ctype _int64 value->bits bits->value)) diff --git a/loot/executor/exec.rkt b/loot/executor/exec.rkt new file mode 100644 index 0000000..cd5745e --- /dev/null +++ b/loot/executor/exec.rkt @@ -0,0 +1,55 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") +(struct exec-state (program heap) #:transparent) + +(define (exec/state prog) + (define heap (malloc _int64 10000)) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)) + (extern 'raise_error + (λ () (raise 'err)) + (_fun -> _void)))]) + (asm-load prog)) + heap)) + +(define (exec-call st) + (match-define (exec-state program heap) st) + (with-handlers ([(λ (x) (eq? x 'err)) identity]) + (asm-call program 'entry heap))) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/loot/executor/run-stdin.rkt b/loot/executor/run-stdin.rkt new file mode 100644 index 0000000..7e7170f --- /dev/null +++ b/loot/executor/run-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") +(require "run.rkt") + +;; -> Void +;; Compile contents of stdin and use asm-interp to run +(define (main) + (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) + diff --git a/loot/executor/run.rkt b/loot/executor/run.rkt new file mode 100644 index 0000000..d96fe18 --- /dev/null +++ b/loot/executor/run.rkt @@ -0,0 +1,20 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run run/io) +;; Asm -> Answer +(define (run asm) + (call-with-exec + asm + (λ (r) + (match r + ['err 'err] + [b (bits->value b)])))) +;; Asm String -> (cons Answer String) +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) + diff --git a/loot/interp-prims.rkt b/loot/interp-prims.rkt deleted file mode 100644 index 15039f9..0000000 --- a/loot/interp-prims.rkt +++ /dev/null @@ -1,69 +0,0 @@ -#lang racket -(require "ast.rkt") -(provide interp-prim1 interp-prim2 interp-prim3) - -;; Op1 Value -> Answer -(define (interp-prim1 p1 v) - (match (list p1 v) - [(list 'add1 (? integer?)) (add1 v)] - [(list 'sub1 (? integer?)) (sub1 v)] - [(list 'zero? (? integer?)) (zero? v)] - [(list 'char? v) (char? v)] - [(list 'char->integer (? char?)) (char->integer v)] - [(list 'integer->char (? codepoint?)) (integer->char v)] - [(list 'eof-object? v) (eof-object? v)] - [(list 'write-byte (? byte?)) (write-byte v)] - [(list 'box v) (box v)] - [(list 'unbox (? box?)) (unbox v)] - [(list 'car (? pair?)) (car v)] - [(list 'cdr (? pair?)) (cdr v)] - [(list 'empty? v) (empty? v)] - [(list 'cons? v) (cons? v)] - [(list 'box? v) (box? v)] - [(list 'vector? v) (vector? v)] - [(list 'vector-length (? vector?)) (vector-length v)] - [(list 'string? v) (string? v)] - [(list 'string-length (? string?)) (string-length v)] - [_ 'err])) - -;; Op2 Value Value -> Answer -(define (interp-prim2 p v1 v2) - (match (list p v1 v2) - [(list '+ (? integer?) (? integer?)) (+ v1 v2)] - [(list '- (? integer?) (? integer?)) (- v1 v2)] - [(list '< (? integer?) (? integer?)) (< v1 v2)] - [(list '= (? integer?) (? integer?)) (= v1 v2)] - [(list 'cons v1 v2) (cons v1 v2)] - [(list 'eq? v1 v2) (eq? v1 v2)] - [(list 'make-vector (? integer?) _) - (if (<= 0 v1) - (make-vector v1 v2) - 'err)] - [(list 'vector-ref (? vector?) (? integer?)) - (if (<= 0 v2 (sub1 (vector-length v1))) - (vector-ref v1 v2) - 'err)] - [(list 'make-string (? integer?) (? char?)) - (if (<= 0 v1) - (make-string v1 v2) - 'err)] - [(list 'string-ref (? string?) (? integer?)) - (if (<= 0 v2 (sub1 (string-length v1))) - (string-ref v1 v2) - 'err)] - [_ 'err])) - -;; Op3 Value Value Value -> Answer -(define (interp-prim3 p v1 v2 v3) - (match (list p v1 v2 v3) - [(list 'vector-set! (? vector?) (? integer?) _) - (if (<= 0 v2 (sub1 (vector-length v1))) - (vector-set! v1 v2 v3) - 'err)] - [_ 'err])) - -;; Any -> Boolean -(define (codepoint? v) - (and (integer? v) - (or (<= 0 v 55295) - (<= 57344 v 1114111)))) diff --git a/loot/env.rkt b/loot/interpreter/env.rkt similarity index 100% rename from loot/env.rkt rename to loot/interpreter/env.rkt diff --git a/loot/interp-defun.rkt b/loot/interpreter/interp-defun.rkt similarity index 99% rename from loot/interp-defun.rkt rename to loot/interpreter/interp-defun.rkt index 54a55a3..0323f5f 100644 --- a/loot/interp-defun.rkt +++ b/loot/interpreter/interp-defun.rkt @@ -1,6 +1,6 @@ #lang racket (provide interp interp-env (struct-out Closure) zip) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") ;; type Answer = Value | 'err diff --git a/loot/interp-io.rkt b/loot/interpreter/interp-io.rkt similarity index 100% rename from loot/interp-io.rkt rename to loot/interpreter/interp-io.rkt diff --git a/loot/interp-prim.rkt b/loot/interpreter/interp-prim.rkt similarity index 100% rename from loot/interp-prim.rkt rename to loot/interpreter/interp-prim.rkt diff --git a/loot/interp-stdin.rkt b/loot/interpreter/interp-stdin.rkt similarity index 78% rename from loot/interp-stdin.rkt rename to loot/interpreter/interp-stdin.rkt index df745af..7d85c32 100644 --- a/loot/interp-stdin.rkt +++ b/loot/interpreter/interp-stdin.rkt @@ -1,8 +1,8 @@ #lang racket (provide main) -(require "parse.rkt") +(require "../syntax/parse.rkt") (require "interp.rkt") -(require "read-all.rkt") +(require "../syntax/read-all.rkt") ;; -> Void ;; Parse and interpret contents of stdin, diff --git a/loot/interp.rkt b/loot/interpreter/interp.rkt similarity index 99% rename from loot/interp.rkt rename to loot/interpreter/interp.rkt index 1964be3..46d5c35 100644 --- a/loot/interp.rkt +++ b/loot/interpreter/interp.rkt @@ -1,7 +1,7 @@ #lang racket (provide interp interp-e) (provide interp-match-pat) -(require "ast.rkt") +(require "../syntax/ast.rkt") (require "interp-prim.rkt") (require "env.rkt") diff --git a/loot/io.c b/loot/io.c deleted file mode 100644 index 8a417c9..0000000 --- a/loot/io.c +++ /dev/null @@ -1,25 +0,0 @@ -#include -#include -#include "types.h" -#include "values.h" -#include "runtime.h" - -val_t read_byte(void) -{ - char c = getc(in); - return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); -} - -val_t peek_byte(void) -{ - char c = getc(in); - ungetc(c, in); - return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); - -} - -val_t write_byte(val_t c) -{ - putc((char) val_unwrap_int(c), out); - return val_wrap_void(); -} diff --git a/loot/main.c b/loot/main.c deleted file mode 100644 index 1ca6115..0000000 --- a/loot/main.c +++ /dev/null @@ -1,40 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); -val_t *heap; - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - heap = malloc(8 * heap_size); - - val_t result; - - result = entry(heap); - - print_result(result); - if (val_typeof(result) != T_VOID) - putchar('\n'); - - free(heap); - return 0; -} diff --git a/loot/main.rkt b/loot/main.rkt index 50cf56e..f9851a3 100644 --- a/loot/main.rkt +++ b/loot/main.rkt @@ -1,18 +1,18 @@ #lang racket -(require "ast.rkt") -(require "parse.rkt") -(require "interp.rkt") -(require "interp-io.rkt") -(require "compile.rkt") -(require "types.rkt") -(require "run.rkt") -(require "exec.rkt") -(provide (all-from-out "ast.rkt")) -(provide (all-from-out "parse.rkt")) -(provide (all-from-out "interp.rkt")) -(provide (all-from-out "interp-io.rkt")) -(provide (all-from-out "compile.rkt")) -(provide (all-from-out "types.rkt")) -(provide (all-from-out "run.rkt")) -(provide (all-from-out "exec.rkt")) +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) diff --git a/loot/parse-file.rkt b/loot/parse-file.rkt deleted file mode 100644 index a502132..0000000 --- a/loot/parse-file.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt" "compile.rkt" "read-all.rkt" a86/printer) - -;; String -> Void -;; Compile contents of given file name, -;; emit asm code on stdout -(define (main fn) - (let ((p (open-input-file fn))) - (begin - (read-line p) ; ignore #lang racket line - (displayln (parse (read-all p))) - (close-input-port p)))) diff --git a/loot/run-stdin.rkt b/loot/run-stdin.rkt deleted file mode 100644 index 16cf99e..0000000 --- a/loot/run-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt") -(require "compile.rkt") -(require "run.rkt") - -;; -> Void -;; Compile contents of stdin and use asm-interp to run -(define (main) - (read-line) ; ignore #lang racket line - (run (compile (parse (read))))) - diff --git a/loot/run.rkt b/loot/run.rkt deleted file mode 100644 index e707f3b..0000000 --- a/loot/run.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require a86/interp) -(require "types.rkt") -(require "build-runtime.rkt") -(provide run run/io) - -;; Run instructions with run-time system linked in - -;; Asm -> Answer -(define (run is) - (match (run/io is "") - [(cons r out) (begin (display out) r)])) - -;; Run instruction and feed input from string, -;; collection output as a string (useful for testing I/O programs) - -;; Asm String -> (cons Answer String) -(define (run/io is in) - (parameterize ((current-objs (list (path->string runtime-path)))) - (match (asm-interp/io is in) - [(cons 'err out) (cons 'err out)] - [(cons b out) - (cons (bits->value b) out)]))) - diff --git a/loot/runtime.h b/loot/runtime.h deleted file mode 100644 index cf6a73c..0000000 --- a/loot/runtime.h +++ /dev/null @@ -1,15 +0,0 @@ -#ifndef RUNTIME_H -#define RUNTIME_H - -#include "values.h" - -val_t entry(val_t*); -extern FILE* in; -extern FILE* out; -extern void (*error_handler)(); - -// in words -#define heap_size 10000 -extern val_t *heap; - -#endif /* RUNTIME_H */ diff --git a/loot/runtime/Makefile b/loot/runtime/Makefile new file mode 100644 index 0000000..5582813 --- /dev/null +++ b/loot/runtime/Makefile @@ -0,0 +1,28 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + print.o \ + values.o \ + io.o \ + error.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/loot/char.c b/loot/runtime/char.c similarity index 100% rename from loot/char.c rename to loot/runtime/char.c diff --git a/loot/runtime/error.c b/loot/runtime/error.c new file mode 100644 index 0000000..69a535a --- /dev/null +++ b/loot/runtime/error.c @@ -0,0 +1,9 @@ +#include +#include +#include "runtime.h" + +_Noreturn void raise_error(void) +{ + printf("err\n"); + exit(1); +} diff --git a/loot/heap.h b/loot/runtime/heap.h similarity index 100% rename from loot/heap.h rename to loot/runtime/heap.h diff --git a/loot/runtime/io.c b/loot/runtime/io.c new file mode 100644 index 0000000..139dccb --- /dev/null +++ b/loot/runtime/io.c @@ -0,0 +1,25 @@ +#include +#include +#include "types.h" +#include "values.h" +#include "runtime.h" + +val_t read_byte(void) +{ + char c = getc(stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); +} + +val_t peek_byte(void) +{ + char c = getc(stdin); + ungetc(c, stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_byte(c); + +} + +val_t write_byte(val_t c) +{ + putc((char) val_unwrap_int(c), stdout); + return val_wrap_void(); +} diff --git a/loot/runtime/main.c b/loot/runtime/main.c new file mode 100644 index 0000000..6fa3ab3 --- /dev/null +++ b/loot/runtime/main.c @@ -0,0 +1,26 @@ +#include +#include +#include "values.h" +#include "print.h" +#include "runtime.h" + +/* in words */ +#define heap_size 10000 + +int main(int argc, char **argv) +{ + val_t *heap = malloc(8 * heap_size); + if (!heap) { + fprintf(stderr, "out of memory\n"); + return 1; + } + + val_t result = entry(heap); + + print_result(result); + if (val_typeof(result) != T_VOID) + putchar('\n'); + + free(heap); + return 0; +} diff --git a/loot/print.c b/loot/runtime/print.c similarity index 100% rename from loot/print.c rename to loot/runtime/print.c diff --git a/loot/print.h b/loot/runtime/print.h similarity index 100% rename from loot/print.h rename to loot/runtime/print.h diff --git a/hustle/runtime.h b/loot/runtime/runtime.h similarity index 100% rename from hustle/runtime.h rename to loot/runtime/runtime.h diff --git a/loot/types.h b/loot/runtime/types.h similarity index 100% rename from loot/types.h rename to loot/runtime/types.h diff --git a/hoax/types.rkt b/loot/runtime/types.rkt similarity index 51% rename from hoax/types.rkt rename to loot/runtime/types.rkt index c0c1d70..4385984 100644 --- a/hoax/types.rkt +++ b/loot/runtime/types.rkt @@ -1,6 +1,5 @@ #lang racket (provide (all-defined-out)) -(require ffi/unsafe) (define imm-shift 3) (define imm-mask #b111) @@ -9,6 +8,7 @@ (define type-cons #b010) (define type-vect #b011) (define type-str #b100) +(define type-proc #b101) (define int-shift (+ 1 imm-shift)) (define mask-int #b1111) (define char-shift (+ 2 imm-shift)) @@ -16,35 +16,6 @@ (define type-char #b01000) (define mask-char #b11111) -;; Integer -> Value -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(= b (value->bits eof)) eof] - [(= b (value->bits (void))) (void)] - [(= b (value->bits '())) '()] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [(box-bits? b) - (box (bits->value (mem-ref (- b type-box))))] - [(cons-bits? b) - (cons (bits->value (mem-ref (+ 0 (- b type-cons)))) - (bits->value (mem-ref (+ 8 (- b type-cons)))))] - - [(vect-bits? b) - (let ((p (- b type-vect))) - (build-vector (bits->value (mem-ref p)) - (lambda (j) - (bits->value (mem-ref (+ p (* 8 (add1 j))))))))] - [(str-bits? b) - (let ((p (- b type-str))) - (build-string (bits->value (mem-ref p)) - (lambda (j) - (integer->char (mem-ref32 (+ p 8 (* 4 j)))))))] - [else (error "invalid bits")])) - ;; Value -> Integer ;; v must be an immediate (define (value->bits v) @@ -80,9 +51,6 @@ (define (str-bits? v) (= type-str (bitwise-and v imm-mask))) -(define (mem-ref i) - (ptr-ref (cast i _int64 _pointer) _int64)) - -(define (mem-ref32 i) - (ptr-ref (cast i _int64 _pointer) _int32)) +(define (proc-bits? v) + (= type-proc (bitwise-and v imm-mask))) diff --git a/loot/values.c b/loot/runtime/values.c similarity index 100% rename from loot/values.c rename to loot/runtime/values.c diff --git a/loot/values.h b/loot/runtime/values.h similarity index 100% rename from loot/values.h rename to loot/runtime/values.h diff --git a/loot/ast.rkt b/loot/syntax/ast.rkt similarity index 100% rename from loot/ast.rkt rename to loot/syntax/ast.rkt diff --git a/loot/fv.rkt b/loot/syntax/fv.rkt similarity index 100% rename from loot/fv.rkt rename to loot/syntax/fv.rkt diff --git a/loot/lambdas.rkt b/loot/syntax/lambdas.rkt similarity index 100% rename from loot/lambdas.rkt rename to loot/syntax/lambdas.rkt diff --git a/loot/parse.rkt b/loot/syntax/parse.rkt similarity index 95% rename from loot/parse.rkt rename to loot/syntax/parse.rkt index a593571..053439c 100644 --- a/loot/parse.rkt +++ b/loot/syntax/parse.rkt @@ -41,7 +41,7 @@ (define (rec ss fs) (match ss [(list s) fs] - [(cons (cons 'define sd) sr) + [(cons (cons (? (not-in fs) 'define) sd) sr) (match (parse-defn-name sd) [f (if (memq f fs) (error "duplicate definition" f) @@ -116,14 +116,14 @@ (list ys (Let x e1 e2))])])] [_ (error "let: bad syntax" s)])] ['match - (match sr - [(cons s sr) - (match (rec s xs ys) - [(list ys e) - (match (parse-match-clauses/acc sr xs ys) - [(list ys ps es) - (list ys (Match e ps es))])])] - [_ (error "match: bad syntax" s)])] + (match sr + [(cons s sr) + (match (rec s xs ys) + [(list ys e) + (match (parse-match-clauses/acc sr xs ys) + [(list ys ps es) + (list ys (Match e ps es))])])] + [_ (error "match: bad syntax" s)])] [(or 'λ 'lambda) (match sr diff --git a/loot/read-all.rkt b/loot/syntax/read-all.rkt similarity index 100% rename from loot/read-all.rkt rename to loot/syntax/read-all.rkt diff --git a/loot/test/build-runtime.rkt b/loot/test/build-runtime.rkt deleted file mode 100644 index 7023ee0..0000000 --- a/loot/test/build-runtime.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require a86/interp) - -;; link with runtime for IO operations -(unless (file-exists? "../runtime.o") - (system "make -C .. runtime.o")) -(current-objs - (list (path->string (normalize-path "../runtime.o")))) diff --git a/loot/test/compile.rkt b/loot/test/compile.rkt index 2096b58..76fdb1a 100644 --- a/loot/test/compile.rkt +++ b/loot/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "../compile.rkt") -(require "../parse.rkt") -(require "../exec.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") (require "test-runner.rkt") -(test (λ p (exec (apply parse-closed p)))) -(test/io (λ (in . p) (exec/io (apply parse-closed p) in))) +(test (λ p (run (compile (apply parse-closed p))))) +(test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) diff --git a/loot/test/interp.rkt b/loot/test/interp.rkt index 523685b..823063f 100644 --- a/loot/test/interp.rkt +++ b/loot/test/interp.rkt @@ -1,7 +1,7 @@ #lang racket -(require "../interp.rkt") -(require "../interp-io.rkt") -(require "../parse.rkt") +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") (require "test-runner.rkt") (test (λ p (interp (apply parse-closed p)))) (test/io (λ (in . p) (interp/io (apply parse-closed p) in))) diff --git a/loot/test/parse.rkt b/loot/test/parse.rkt index 839f472..e5f05ff 100644 --- a/loot/test/parse.rkt +++ b/loot/test/parse.rkt @@ -1,6 +1,6 @@ #lang racket -(require "../parse.rkt") -(require "../ast.rkt") +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") (require rackunit) (define (p e) @@ -47,6 +47,7 @@ (check-equal? (parse "asdf") (p (Lit "asdf"))) (check-equal? (parse '(make-string 10 #\a)) (p (Prim2 'make-string (Lit 10) (Lit #\a))))) + (begin ; Iniquity (check-equal? (parse '(define (f x) x) 1) (Prog (list (Defn 'f '(x) (Var 'x))) (Lit 1))) @@ -74,6 +75,7 @@ (check-equal? (parse '(match x ['() 1])) (p (Match (Var 'x) (list (Lit '())) (list (Lit 1))))) (check-exn exn:fail? (λ () (parse-closed '(match 1 [x y]))))) + (begin ; Loot (check-equal? (parse '(f x)) (p (App (Var 'f) (list (Var 'x)))))) diff --git a/loot/test/test-runner.rkt b/loot/test/test-runner.rkt index 37b2c6f..52b1c9f 100644 --- a/loot/test/test-runner.rkt +++ b/loot/test/test-runner.rkt @@ -201,6 +201,12 @@ '(2 3 4)) (check-equal? (run '(define (f x y) y) '(f 1 (add1 #f))) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1)) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1 2 3)) 'err)) (begin ;; Knock diff --git a/neerdowell/Makefile b/neerdowell/Makefile index 5886d39..74eaae1 100644 --- a/neerdowell/Makefile +++ b/neerdowell/Makefile @@ -1,14 +1,14 @@ ifeq ($(shell uname), Darwin) - LANGS_CC ?= arch -x86_64 clang + LANGS_CC ?= arch -x86_64 clang -### -fuse-ld=lld LANGS_AS ?= arch -x86_64 clang -c else - LANGS_CC ?= clang + LANGS_CC ?= clang -fuse-ld=lld LANGS_AS ?= clang -c endif RACKET ?= racket -RUNTIME_DIR := runtime/standalone +RUNTIME_DIR := runtime RUNTIME := $(RUNTIME_DIR)/runtime.o # Example source extension for this language. From 6a1b92595883df5e0c2cb873d86a1b6ad3a8b57f Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 17 Apr 2026 08:51:40 -0400 Subject: [PATCH 07/47] Bringing Mug up to date. --- iniquity/executor/run-stdin.rkt | 12 + mug/Makefile | 3 +- mug/ast.rkt | 83 -- mug/build-runtime.rkt | 14 - mug/compile-define.rkt | 72 -- mug/compile-ops.rkt | 397 --------- mug/compile-stdin.rkt | 10 - mug/compile.rkt | 58 -- mug/compiler/assert.rkt | 68 ++ mug/compiler/compile-literals.rkt | 48 ++ mug/compiler/compile-ops.rkt | 299 +++++++ mug/compiler/compile-stdin.rkt | 14 + .../compile.rkt} | 353 ++++---- mug/executor/decode.rkt | 54 ++ mug/executor/exec.rkt | 70 ++ mug/executor/run-stdin.rkt | 12 + mug/executor/run.rkt | 20 + mug/interp-defun.rkt | 164 ---- mug/interp-io.rkt | 12 - mug/interp.rkt | 163 ---- mug/{ => interpreter}/env.rkt | 3 +- mug/interpreter/interp-io.rkt | 16 + .../interp-prim.rkt} | 65 +- mug/{ => interpreter}/interp-stdin.rkt | 9 +- mug/interpreter/interp.rkt | 136 ++++ mug/main.c | 40 - mug/main.rkt | 18 + mug/parse-file.rkt | 13 - mug/parse.rkt | 102 --- mug/run.rkt | 18 - mug/runtime.h | 15 - mug/runtime/Makefile | 29 + mug/{ => runtime}/char.c | 0 mug/runtime/error.c | 9 + mug/{ => runtime}/heap.h | 0 mug/{ => runtime}/io.c | 16 +- mug/runtime/main.c | 26 + mug/{ => runtime}/print.c | 10 + mug/{ => runtime}/print.h | 0 mug/runtime/runtime.h | 27 + mug/{ => runtime}/symbol.c | 0 mug/{ => runtime}/types.h | 40 +- mug/runtime/types.rkt | 64 ++ mug/{ => runtime}/values.c | 11 + mug/runtime/values.h | 119 +++ mug/syntax/ast.rkt | 75 ++ mug/{ => syntax}/fv.rkt | 11 +- mug/{ => syntax}/lambdas.rkt | 2 +- .../literals.rkt} | 56 +- mug/syntax/parse.rkt | 270 +++++++ mug/{ => syntax}/read-all.rkt | 1 + mug/test/build-runtime.rkt | 8 - mug/test/compile.rkt | 12 +- mug/test/interp-defun.rkt | 24 - mug/test/interp.rkt | 12 +- mug/test/parse.rkt | 82 ++ mug/test/test-runner.rkt | 761 +++++++++--------- mug/types.rkt | 108 --- mug/utils.rkt | 33 - mug/values.h | 84 -- 60 files changed, 2206 insertions(+), 2045 deletions(-) create mode 100644 iniquity/executor/run-stdin.rkt delete mode 100644 mug/ast.rkt delete mode 100644 mug/build-runtime.rkt delete mode 100644 mug/compile-define.rkt delete mode 100644 mug/compile-ops.rkt delete mode 100644 mug/compile-stdin.rkt delete mode 100644 mug/compile.rkt create mode 100644 mug/compiler/assert.rkt create mode 100644 mug/compiler/compile-literals.rkt create mode 100644 mug/compiler/compile-ops.rkt create mode 100644 mug/compiler/compile-stdin.rkt rename mug/{compile-expr.rkt => compiler/compile.rkt} (55%) create mode 100644 mug/executor/decode.rkt create mode 100644 mug/executor/exec.rkt create mode 100644 mug/executor/run-stdin.rkt create mode 100644 mug/executor/run.rkt delete mode 100644 mug/interp-defun.rkt delete mode 100644 mug/interp-io.rkt delete mode 100644 mug/interp.rkt rename mug/{ => interpreter}/env.rkt (91%) create mode 100644 mug/interpreter/interp-io.rkt rename mug/{interp-prims.rkt => interpreter/interp-prim.rkt} (59%) rename mug/{ => interpreter}/interp-stdin.rkt (53%) create mode 100644 mug/interpreter/interp.rkt delete mode 100644 mug/main.c create mode 100644 mug/main.rkt delete mode 100644 mug/parse-file.rkt delete mode 100644 mug/parse.rkt delete mode 100644 mug/run.rkt delete mode 100644 mug/runtime.h create mode 100644 mug/runtime/Makefile rename mug/{ => runtime}/char.c (100%) create mode 100644 mug/runtime/error.c rename mug/{ => runtime}/heap.h (100%) rename mug/{ => runtime}/io.c (50%) create mode 100644 mug/runtime/main.c rename mug/{ => runtime}/print.c (98%) rename mug/{ => runtime}/print.h (100%) create mode 100644 mug/runtime/runtime.h rename mug/{ => runtime}/symbol.c (100%) rename mug/{ => runtime}/types.h (65%) create mode 100644 mug/runtime/types.rkt rename mug/{ => runtime}/values.c (90%) create mode 100644 mug/runtime/values.h create mode 100644 mug/syntax/ast.rkt rename mug/{ => syntax}/fv.rkt (83%) rename mug/{ => syntax}/lambdas.rkt (100%) rename mug/{compile-literals.rkt => syntax/literals.rkt} (53%) create mode 100644 mug/syntax/parse.rkt rename mug/{ => syntax}/read-all.rkt (99%) delete mode 100644 mug/test/build-runtime.rkt delete mode 100644 mug/test/interp-defun.rkt create mode 100644 mug/test/parse.rkt delete mode 100644 mug/types.rkt delete mode 100644 mug/utils.rkt delete mode 100644 mug/values.h diff --git a/iniquity/executor/run-stdin.rkt b/iniquity/executor/run-stdin.rkt new file mode 100644 index 0000000..7e7170f --- /dev/null +++ b/iniquity/executor/run-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") +(require "run.rkt") + +;; -> Void +;; Compile contents of stdin and use asm-interp to run +(define (main) + (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) + diff --git a/mug/Makefile b/mug/Makefile index 3fc9599..d88e2b9 100644 --- a/mug/Makefile +++ b/mug/Makefile @@ -10,8 +10,7 @@ objs = \ main.o \ print.o \ values.o \ - io.o \ - symbol.o + io.o default: runtime.o diff --git a/mug/ast.rkt b/mug/ast.rkt deleted file mode 100644 index 537deed..0000000 --- a/mug/ast.rkt +++ /dev/null @@ -1,83 +0,0 @@ -#lang racket -(provide (all-defined-out)) - -;; type Prog = (Prog (Listof Defn) Expr) -(struct Prog (ds e) #:prefab) - -;; type Defn = (Defn Id (Listof Id) Expr) -(struct Defn (f xs e) #:prefab) - -;; type Expr = (Eof) -;; | (Empty) -;; | (Int Integer) -;; | (Bool Boolean) -;; | (Char Character) -;; | (Str String) -;; | (Symb Symbol) -;; | (Prim0 Op0) -;; | (Prim1 Op1 Expr) -;; | (Prim2 Op2 Expr Expr) -;; | (Prim3 Op3 Expr Expr Expr) -;; | (If Expr Expr Expr) -;; | (Begin Expr Expr) -;; | (Let Id Expr Expr) -;; | (Var Id) -;; | (Match Expr (Listof Pat) (Listof Expr)) -;; | (App Expr (Listof Expr)) -;; | (Lam Id (Listof Id) Expr) -;; type Id = Symbol -;; type Op0 = 'read-byte -;; type Op1 = 'add1 | 'sub1 | 'zero? -;; | 'char? | 'integer->char | 'char->integer -;; | 'write-byte | 'eof-object? -;; | 'box | 'car | 'cdr | 'unbox -;; | 'empty? | 'cons? | 'box? -;; | 'vector? | 'vector-length -;; | 'string? | 'string-length -;; | 'symbol? | 'symbol->string -;; | 'string->symbol | 'string->uninterned-symbol -;; type Op2 = '+ | '- | '< | '= -;; | 'cons -;; | 'make-vector | 'vector-ref -;; | 'make-string | 'string-ref -;; type Op3 = 'vector-set! -;; type Pat = (PVar Id) -;; | (PWild) -;; | (PLit Lit) -;; | (PBox Pat) -;; | (PCons Pat Pat) -;; | (PAnd Pat Pat) -;; | (PSymb Symbol) -;; | (PStr String) -;; type Lit = Boolean -;; | Character -;; | Integer -;; | '() - -(struct Eof () #:prefab) -(struct Empty () #:prefab) -(struct Int (i) #:prefab) -(struct Bool (b) #:prefab) -(struct Char (c) #:prefab) -(struct Str (s) #:prefab) -(struct Symb (s) #:prefab) -(struct Prim0 (p) #:prefab) -(struct Prim1 (p e) #:prefab) -(struct Prim2 (p e1 e2) #:prefab) -(struct Prim3 (p e1 e2 e3) #:prefab) -(struct If (e1 e2 e3) #:prefab) -(struct Begin (e1 e2) #:prefab) -(struct Let (x e1 e2) #:prefab) -(struct Var (x) #:prefab) -(struct App (e es) #:prefab) -(struct Lam (f xs e) #:prefab) -(struct Match (e ps es) #:prefab) - -(struct PVar (x) #:prefab) -(struct PWild () #:prefab) -(struct PLit (x) #:prefab) -(struct PBox (p) #:prefab) -(struct PCons (p1 p2) #:prefab) -(struct PAnd (p1 p2) #:prefab) -(struct PSymb (s) #:prefab) -(struct PStr (s) #:prefab) diff --git a/mug/build-runtime.rkt b/mug/build-runtime.rkt deleted file mode 100644 index 66aad89..0000000 --- a/mug/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require racket/runtime-path) -(provide runtime-path) - -(define-runtime-path here ".") - -(void - (system (string-append "make -C '" - (path->string (normalize-path here)) - "' runtime.o"))) - -(define runtime-path - (path->string - (normalize-path (build-path here "runtime.o")))) diff --git a/mug/compile-define.rkt b/mug/compile-define.rkt deleted file mode 100644 index a8a6992..0000000 --- a/mug/compile-define.rkt +++ /dev/null @@ -1,72 +0,0 @@ -#lang racket -(provide compile-define compile-defines-values define-ids compile-defines) -(require "ast.rkt" - "types.rkt" - "fv.rkt" - "utils.rkt" - "compile-expr.rkt" - a86/ast) - -(define rax 'rax) -(define rbx 'rbx) - -;; [Listof Defn] -> [Listof Id] -(define (define-ids ds) - (match ds - ['() '()] - [(cons (Defn f xs e) ds) - (cons f (define-ids ds))])) - -;; [Listof Defn] -> Asm -(define (compile-defines ds) - (match ds - ['() (seq)] - [(cons d ds) - (seq (compile-define d) - (compile-defines ds))])) - -;; Defn -> Asm -(define (compile-define d) - (match d - [(Defn f xs e) - (compile-lambda-define (Lam f xs e))])) - -;; Defns -> Asm -;; Compile the closures for ds and push them on the stack -(define (compile-defines-values ds) - (seq (alloc-defines ds 0) - (init-defines ds (reverse (define-ids ds)) 8) - (add-rbx-defines ds 0))) - -;; Defns Int -> Asm -;; Allocate closures for ds at given offset, but don't write environment yet -(define (alloc-defines ds off) - (match ds - ['() (seq)] - [(cons (Defn f xs e) ds) - (let ((fvs (fv (Lam f xs e)))) - (seq (Lea rax (symbol->label f)) - (Mov (Mem rbx off) rax) - (Mov rax rbx) - (Add rax off) - (Or rax type-proc) - (Push rax) - (alloc-defines ds (+ off (* 8 (add1 (length fvs)))))))])) - -;; Defns CEnv Int -> Asm -;; Initialize the environment for each closure for ds at given offset -(define (init-defines ds c off) - (match ds - ['() (seq)] - [(cons (Defn f xs e) ds) - (let ((fvs (fv (Lam f xs e)))) - (seq (free-vars-to-heap fvs c off) - (init-defines ds c (+ off (* 8 (add1 (length fvs)))))))])) - -;; Defns Int -> Asm -;; Compute adjustment to rbx for allocation of all ds -(define (add-rbx-defines ds n) - (match ds - ['() (seq (Add rbx (* n 8)))] - [(cons (Defn f xs e) ds) - (add-rbx-defines ds (+ n (add1 (length (fv (Lam f xs e))))))])) diff --git a/mug/compile-ops.rkt b/mug/compile-ops.rkt deleted file mode 100644 index 79fe367..0000000 --- a/mug/compile-ops.rkt +++ /dev/null @@ -1,397 +0,0 @@ -#lang racket -(provide compile-op0 compile-op1 compile-op2 compile-op3 pad-stack unpad-stack assert-proc) -(require "ast.rkt" "types.rkt" "utils.rkt" a86/ast) - -(define rax 'rax) ; return -(define eax 'eax) ; 32-bit load/store -(define rbx 'rbx) ; heap -(define rdi 'rdi) ; arg1 -(define rsi 'rsi) ; arg2 -(define rdx 'rdx) ; arg3 -(define r8 'r8) ; scratch -(define r9 'r9) ; scratch -(define r10 'r10) ; scratch -(define r12 'r12) ; save across call to memcpy -(define r15 'r15) ; stack pad (non-volatile) -(define rsp 'rsp) ; stack - -;; Op0 -> Asm -(define (compile-op0 p) - (match p - ['void (seq (Mov rax (value->bits (void))))] - ['read-byte (seq pad-stack - (Call 'read_byte) - unpad-stack)] - ['peek-byte (seq pad-stack - (Call 'peek_byte) - unpad-stack)])) - -;; Op1 -> Asm -(define (compile-op1 p) - (match p - ['add1 - (seq (assert-integer rax) - (Add rax (value->bits 1)))] - ['sub1 - (seq (assert-integer rax) - (Sub rax (value->bits 1)))] - ['zero? - (seq (assert-integer rax) - (eq-imm 0))] - ['char? - (type-pred mask-char type-char)] - ['char->integer - (seq (assert-char rax) - (Sar rax char-shift) - (Sal rax int-shift))] - ['integer->char - (seq (assert-codepoint rax) - (Sar rax int-shift) - (Sal rax char-shift) - (Xor rax type-char))] - ['eof-object? (eq-imm eof)] - ['write-byte - (seq (assert-byte rax) - pad-stack - (Mov rdi rax) - (Call 'write_byte) - unpad-stack)] - ['box - (seq (Mov (Mem rbx 0) rax) - (Mov rax rbx) - (Or rax type-box) - (Add rbx 8))] - ['unbox - (seq (assert-box rax) - (Xor rax type-box) - (Mov rax (Mem rax 0)))] - ['car - (seq (assert-cons rax) - (Xor rax type-cons) - (Mov rax (Mem rax 8)))] - ['cdr - (seq (assert-cons rax) - (Xor rax type-cons) - (Mov rax (Mem rax 0)))] - ['empty? (eq-imm '())] - ['box? - (type-pred ptr-mask type-box)] - ['cons? - (type-pred ptr-mask type-cons)] - ['vector? - (type-pred ptr-mask type-vect)] - ['string? - (type-pred ptr-mask type-str)] - ['symbol? - (type-pred ptr-mask type-symb)] - ['vector-length - (let ((zero (gensym)) - (done (gensym))) - (seq (assert-vector rax) - (Xor rax type-vect) - (Cmp rax 0) - (Je zero) - (Mov rax (Mem rax 0)) - (Sal rax int-shift) - (Jmp done) - (Label zero) - (Mov rax 0) - (Label done)))] - ['string-length - (let ((zero (gensym)) - (done (gensym))) - (seq (assert-string rax) - (Xor rax type-str) - (Cmp rax 0) - (Je zero) - (Mov rax (Mem rax 0)) - (Sal rax int-shift) - (Jmp done) - (Label zero) - (Mov rax 0) - (Label done)))] - ['string->symbol - (seq (assert-string rax) - (Xor rax type-str) - (Mov rdi rax) - pad-stack - (Call 'intern_symbol) - unpad-stack - (Or rax type-symb))] - ['symbol->string - (seq (assert-symbol rax) - (Xor rax type-symb) - char-array-copy - (Or rax type-str))] - ['string->uninterned-symbol - (seq (assert-string rax) - (Xor rax type-str) - char-array-copy - (Or rax type-symb))])) - -;; Asm -;; Copy sized array of characters pointed to by rax -(define char-array-copy - (seq (Mov rdi rbx) ; dst - (Mov rsi rax) ; src - (Mov rdx (Mem rax 0)) ; len - (Add rdx 1) ; #words = 1 + (len+1)/2 - (Sar rdx 1) - (Add rdx 1) - (Sal rdx 3) ; #bytes = 8*#words - (Mov r12 rdx) ; save rdx before destroyed - pad-stack - (Call 'memcpy) - unpad-stack - ; rbx should be preserved by memcpy - ;(Mov rbx rax) ; dst is returned, install as heap pointer - (Add rbx r12))) - -;; Op2 -> Asm -(define (compile-op2 p) - (match p - ['+ - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Add rax r8))] - ['- - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Sub r8 rax) - (Mov rax r8))] - ['< - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Cmp r8 rax) - (Mov rax (value->bits #t)) - (let ((true (gensym))) - (seq (Jl true) - (Mov rax (value->bits #f)) - (Label true))))] - ['= - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Cmp r8 rax) - (Mov rax (value->bits #t)) - (let ((true (gensym))) - (seq (Je true) - (Mov rax (value->bits #f)) - (Label true))))] - ['cons - (seq (Mov (Mem rbx 0) rax) - (Pop rax) - (Mov (Mem rbx 8) rax) - (Mov rax rbx) - (Or rax type-cons) - (Add rbx 16))] - ['eq? - (seq (Pop r8) - (eq r8 rax))] - ['make-vector - (let ((loop (gensym)) - (done (gensym)) - (empty (gensym))) - (seq (Pop r8) - (assert-natural r8) - (Cmp r8 0) ; special case empty vector - (Je empty) - - (Mov r9 rbx) - (Or r9 type-vect) - - (Sar r8 int-shift) - (Mov (Mem rbx 0) r8) - (Add rbx 8) - - (Label loop) - (Mov (Mem rbx 0) rax) - (Add rbx 8) - (Sub r8 1) - (Cmp r8 0) - (Jne loop) - - (Mov rax r9) - (Jmp done) - - (Label empty) - (Mov rax type-vect) - (Label done)))] - - ['vector-ref - (seq (Pop r8) - (assert-vector r8) - (assert-integer rax) - (Cmp r8 type-vect) - (Je 'raise_error_align) ; special case for empty vector - (Cmp rax 0) - (Jl 'raise_error_align) - (Xor r8 type-vect) ; r8 = ptr - (Mov r9 (Mem r8 0)) ; r9 = len - (Sar rax int-shift) ; rax = index - (Sub r9 1) - (Cmp r9 rax) - (Jl 'raise_error_align) - (Sal rax 3) - (Add r8 rax) - (Mov rax (Mem r8 8)))] - - ['make-string - (let ((loop (gensym)) - (done (gensym)) - (empty (gensym))) - (seq (Pop r8) - (assert-natural r8) - (assert-char rax) - (Cmp r8 0) ; special case empty string - (Je empty) - - (Mov r9 rbx) - (Or r9 type-str) - - (Sar r8 int-shift) - (Mov (Mem rbx 0) r8) - (Add rbx 8) - - (Sar rax char-shift) - - (Add r8 1) ; adds 1 - (Sar r8 1) ; when - (Sal r8 1) ; len is odd - - (Label loop) - (Mov (Mem rbx 0) eax) - (Add rbx 4) - (Sub r8 1) - (Cmp r8 0) - (Jne loop) - - (Mov rax r9) - (Jmp done) - - (Label empty) - (Mov rax type-str) - (Label done)))] - - ['string-ref - (seq (Pop r8) - (assert-string r8) - (assert-integer rax) - (Cmp r8 type-str) - (Je 'raise_error_align) ; special case for empty string - (Cmp rax 0) - (Jl 'raise_error_align) - (Xor r8 type-str) ; r8 = ptr - (Mov r9 (Mem r8 0)) ; r9 = len - (Sar rax int-shift) ; rax = index - (Sub r9 1) - (Cmp r9 rax) - (Jl 'raise_error_align) - (Sal rax 2) - (Add r8 rax) - (Mov 'eax (Mem r8 8)) - (Sal rax char-shift) - (Or rax type-char))])) - -;; Op3 -> Asm -(define (compile-op3 p) - (match p - ['vector-set! - (seq (Pop r10) - (Pop r8) - (assert-vector r8) - (assert-integer r10) - (Cmp r10 0) - (Jl 'raise_error_align) - (Xor r8 type-vect) ; r8 = ptr - (Mov r9 (Mem r8 0)) ; r9 = len - (Sar r10 int-shift) ; r10 = index - (Sub r9 1) - (Cmp r9 r10) - (Jl 'raise_error_align) - (Sal r10 3) - (Add r8 r10) - (Mov (Mem r8 8) rax) - (Mov rax (value->bits (void))))])) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define (assert-type mask type) - (λ (arg) - (seq (Mov r9 arg) - (And r9 mask) - (Cmp r9 type) - (Jne 'raise_error_align)))) - -(define (type-pred mask type) - (let ((l (gensym))) - (seq (And rax mask) - (Cmp rax type) - (Mov rax (value->bits #t)) - (Je l) - (Mov rax (value->bits #f)) - (Label l)))) - -(define assert-integer - (assert-type mask-int type-int)) -(define assert-char - (assert-type mask-char type-char)) -(define assert-box - (assert-type ptr-mask type-box)) -(define assert-cons - (assert-type ptr-mask type-cons)) -(define assert-vector - (assert-type ptr-mask type-vect)) -(define assert-string - (assert-type ptr-mask type-str)) -(define assert-symbol - (assert-type ptr-mask type-symb)) -(define assert-proc - (assert-type ptr-mask type-proc)) - -(define (assert-codepoint r) - (let ((ok (gensym))) - (seq (assert-integer r) - (Cmp r (value->bits 0)) - (Jl 'raise_error_align) - (Cmp r (value->bits 1114111)) - (Jg 'raise_error_align) - (Cmp r (value->bits 55295)) - (Jl ok) - (Cmp r (value->bits 57344)) - (Jg ok) - (Jmp 'raise_error_align) - (Label ok)))) - -(define (assert-byte r) - (seq (assert-integer r) - (Cmp r (value->bits 0)) - (Jl 'raise_error_align) - (Cmp r (value->bits 255)) - (Jg 'raise_error_align))) - -(define (assert-natural r) - (seq (assert-integer r) - (Cmp r (value->bits 0)) - (Jl 'raise_error_align))) - -;; Value -> Asm -(define (eq-imm imm) - (let ((l1 (gensym))) - (seq (Cmp rax (value->bits imm)) - (Mov rax (value->bits #t)) - (Je l1) - (Mov rax (value->bits #f)) - (Label l1)))) - -(define (eq ir1 ir2) - (let ((l1 (gensym))) - (seq (Cmp ir1 ir2) - (Mov rax (value->bits #t)) - (Je l1) - (Mov rax (value->bits #f)) - (Label l1)))) diff --git a/mug/compile-stdin.rkt b/mug/compile-stdin.rkt deleted file mode 100644 index cfa1510..0000000 --- a/mug/compile-stdin.rkt +++ /dev/null @@ -1,10 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt" "compile.rkt" "read-all.rkt" a86/printer) - -;; -> Void -;; Compile contents of stdin, -;; emit asm code on stdout -(define (main) - (read-line) ; ignore #lang racket line - (asm-display (compile (parse (read-all))))) diff --git a/mug/compile.rkt b/mug/compile.rkt deleted file mode 100644 index ee04163..0000000 --- a/mug/compile.rkt +++ /dev/null @@ -1,58 +0,0 @@ -#lang racket -(provide compile compile-e - ; for notes - compile-string compile-symbol) -(require "ast.rkt" - "types.rkt" - "lambdas.rkt" - "fv.rkt" - "utils.rkt" - "compile-define.rkt" - "compile-expr.rkt" - "compile-literals.rkt" - a86/ast) - -;; Registers used -(define rbx 'rbx) ; heap -(define rsp 'rsp) ; stack -(define rdi 'rdi) ; arg -(define r15 'r15) ; stack pad (non-volatile) -(define r12 'r12) - -;; type CEnv = (Listof [Maybe Id]) - -;; Prog -> Asm -(define (compile p) - (match p - [(Prog ds e) - (prog (externs) - (Global 'entry) - (Label 'entry) - (Push rbx) ; save callee-saved register - (Push r15) - (Push r12) - (Mov rbx rdi) ; recv heap pointer - (init-symbol-table p) - (compile-defines-values ds) - (compile-e e (reverse (define-ids ds)) #f) - (Add rsp (* 8 (length ds))) ;; pop function definitions - (Pop r12) ; restore callee-save register - (Pop r15) - (Pop rbx) - (Ret) - (compile-defines ds) - (compile-lambda-defines (lambdas p)) - (Label 'raise_error_align) - pad-stack - (Call 'raise_error) - (Data) - (compile-literals p))])) - -(define (externs) - (seq (Extern 'peek_byte) - (Extern 'read_byte) - (Extern 'write_byte) - (Extern 'raise_error) - (Extern 'intern_symbol) - (Extern 'symb_cmp) - (Extern 'memcpy))) diff --git a/mug/compiler/assert.rkt b/mug/compiler/assert.rkt new file mode 100644 index 0000000..0d97df1 --- /dev/null +++ b/mug/compiler/assert.rkt @@ -0,0 +1,68 @@ +#lang racket +(provide assert-integer assert-char assert-byte assert-codepoint + assert-box assert-cons + assert-natural assert-vector assert-string + assert-proc assert-symbol) +(require a86/ast) +(require "../runtime/types.rkt") + +(define (assert-type mask type) + (λ (r) + (seq (Push r) + (And r mask) + (Cmp r type) + (Pop r) + (Jne 'err)))) + +;; Register -> Asm + + +(define assert-integer + (assert-type mask-int type-int)) + +;; Register -> Asm + +(define assert-char + (assert-type mask-char type-char)) +(define assert-box + (assert-type ptr-mask type-box)) +(define assert-cons + (assert-type ptr-mask type-cons)) +(define assert-vector + (assert-type ptr-mask type-vect)) +(define assert-string + (assert-type ptr-mask type-str)) +(define assert-proc + (assert-type ptr-mask type-proc)) +(define assert-symbol + (assert-type ptr-mask type-symb)) + +;; Register -> Asm +(define (assert-codepoint r) + (let ((ok (gensym))) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err) + (Cmp r (value->bits 1114111)) + (Jg 'err) + (Cmp r (value->bits 55295)) + (Jl ok) + (Cmp r (value->bits 57344)) + (Jg ok) + (Jmp 'err) + (Label ok)))) + +;; Register -> Asm +(define (assert-byte r) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err) + (Cmp r (value->bits 255)) + (Jg 'err))) + +;; Register -> Asm +(define (assert-natural r) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err))) + diff --git a/mug/compiler/compile-literals.rkt b/mug/compiler/compile-literals.rkt new file mode 100644 index 0000000..c0321d4 --- /dev/null +++ b/mug/compiler/compile-literals.rkt @@ -0,0 +1,48 @@ +#lang racket +(provide compile-literals init-symbol-table compile-string-chars symbol->data-label) +(require "../syntax/ast.rkt") +(require "../syntax/literals.rkt") +(require "../runtime/types.rkt") +(require a86/ast a86/registers) + +;; Prog -> Asm +(define (compile-literals p) + (append-map compile-literal (literals p))) + +;; Symbol -> Asm +(define (compile-literal s) + (let ((str (symbol->string s))) + (seq (Label (symbol->data-label s)) + (Dq (value->bits (string-length str))) + (compile-string-chars (string->list str)) + (if (odd? (string-length str)) + (seq (Dd 0)) + (seq))))) + +;; Prog -> Asm +;; Call intern_symbol on every symbol in the program +(define (init-symbol-table p) + (match (symbols p) + ['() (seq)] + [ss (seq (Sub 'rsp 8) + (append-map init-symbol ss) + (Add 'rsp 8))])) + +;; Symbol -> Asm +(define (init-symbol s) + (seq (Lea rdi (symbol->data-label s)) + (Extern 'intern_symbol) + (Call 'intern_symbol))) + +;; [Listof Char] -> Asm +(define (compile-string-chars cs) + (match cs + ['() (seq)] + [(cons c cs) + (seq (Dd (char->integer c)) + (compile-string-chars cs))])) + +(define (symbol->data-label s) + (symbol->label + (string->symbol (string-append "data_" (symbol->string s))))) + diff --git a/mug/compiler/compile-ops.rkt b/mug/compiler/compile-ops.rkt new file mode 100644 index 0000000..0a9c4b8 --- /dev/null +++ b/mug/compiler/compile-ops.rkt @@ -0,0 +1,299 @@ +#lang racket +(provide compile-op0 compile-op1 compile-op2 compile-op3 pad-stack assert-proc) +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") +(require "assert.rkt") +(require a86/ast a86/registers) + +;; Op0 -> Asm +(define (compile-op0 p) + (match p + ['void (seq (Mov rax (value->bits (void))))] + ['read-byte (seq (Extern 'read_byte) pad-stack (Call 'read_byte) unpad-stack)] + ['peek-byte (seq (Extern 'peek_byte) pad-stack (Call 'peek_byte) unpad-stack)])) + +;; Op1 -> Asm +(define (compile-op1 p) + (match p + ['add1 + (seq (assert-integer rax) + (Add rax (value->bits 1)))] + ['sub1 + (seq (assert-integer rax) + (Sub rax (value->bits 1)))] + ['zero? + (seq (assert-integer rax) + (Cmp rax 0) + if-equal)] + ['char? + (seq (And rax mask-char) + (Cmp rax type-char) + if-equal)] + ['char->integer + (seq (assert-char rax) + (Sar rax char-shift) + (Sal rax int-shift))] + ['integer->char + (seq (assert-codepoint rax) + (Sar rax int-shift) + (Sal rax char-shift) + (Xor rax type-char))] + ['eof-object? + (seq (Cmp rax (value->bits eof)) + if-equal)] + ['write-byte + (seq (Extern 'write_byte) + (assert-byte rax) + pad-stack + (Mov rdi rax) + (Call 'write_byte) + unpad-stack)] + ['box + (seq (Mov (Mem rbx) rax) ; memory write + (Mov rax rbx) ; put box in rax + (Xor rax type-box) ; tag as a box + (Add rbx 8))] + ['unbox + (seq (assert-box rax) + (Mov rax (Mem rax (- type-box))))] + ['car + (seq (assert-cons rax) + (Mov rax (Mem rax (- 0 type-cons))))] + ['cdr + (seq (assert-cons rax) + (Mov rax (Mem rax (- 8 type-cons))))] + + ['empty? (seq (Cmp rax (value->bits '())) if-equal)] + ['cons? (type-pred ptr-mask type-cons)] + ['box? (type-pred ptr-mask type-box)] + ['vector? (type-pred ptr-mask type-vect)] + ['string? (type-pred ptr-mask type-str)] + ['symbol? (type-pred ptr-mask type-symb)] + ['vector-length + (seq (assert-vector rax) + (Mov rax (Mem rax (- type-vect))))] + ['string-length + (seq (assert-string rax) + (Mov rax (Mem rax (- type-str))))] + ['string->symbol + (seq (assert-string rax) + (Xor rax type-str) + (Mov rdi rax) + pad-stack + (Extern 'intern_symbol) + (Call 'intern_symbol) + unpad-stack + (Or rax type-symb))] + ['symbol->string + (seq (assert-symbol rax) + (Xor rax type-symb) + char-array-copy + (Or rax type-str))] + ['string->uninterned-symbol + (seq (assert-string rax) + (Xor rax type-str) + char-array-copy + (Or rax type-symb))])) + +;; Op2 -> Asm +(define (compile-op2 p) + (match p + ['+ + (seq (Pop r8) + (assert-integer r8) + (assert-integer rax) + (Add rax r8))] + ['- + (seq (Pop r8) + (assert-integer r8) + (assert-integer rax) + (Sub r8 rax) + (Mov rax r8))] + ['< + (seq (Pop r8) + (assert-integer r8) + (assert-integer rax) + (Cmp r8 rax) + if-lt)] + ['= + (seq (Pop r8) + (assert-integer r8) + (assert-integer rax) + (Cmp r8 rax) + if-equal)] + ['cons + (seq (Mov (Mem rbx 8) rax) + (Pop rax) + (Mov (Mem rbx 0) rax) + (Mov rax rbx) + (Xor rax type-cons) + (Add rbx 16))] + ['eq? + (seq (Pop r8) + (Cmp rax r8) + if-equal)] + ['make-vector + (let ((nonzero (gensym 'nz)) + (loop (gensym 'loop)) + (theend (gensym 'theend))) + + (seq (Pop r8) + (assert-natural r8) + + ; special case for length = 0 + (Cmp r8 0) + (Jne nonzero) + ; return canonical representation + (Lea rax (Mem 'empty type-vect)) + (Jmp theend) + + ; Code for nonzero case + (Label nonzero) + (Mov (Mem rbx 0) r8) ; write length + (Sar r8 1) ; convert to bytes + (Mov r9 r8) ; save for heap adjustment + + ; start initialization + (Label loop) + (Mov (Mem rbx r8) rax) + (Sub r8 8) + (Cmp r8 0) + (Jne loop) + ; end initialization + + (Mov rax rbx) + (Xor rax type-vect) ; create tagged pointer + (Add rbx r9) ; acct for elements and stored length + (Add rbx 8) + (Label theend)))] + + ['vector-ref + (seq (Pop r8) + (assert-vector r8) + (assert-natural rax) + (Mov r9 (Mem r8 (- type-vect))) + (Cmp rax r9) + (Jge 'err) + (Sar rax 1) + (Mov rax (Mem r8 rax (- 8 type-vect))))] + ['make-string + (let ((nonzero (gensym 'nz)) + (loop (gensym 'loop)) + (theend (gensym 'theend))) + (seq (Pop r8) + (assert-natural r8) + (assert-char rax) + + ; special case for length = 0 + (Cmp r8 0) + (Jne nonzero) + ; return canonical representation + (Lea rax (Mem 'empty type-str)) + (Jmp theend) + + ; Code for nonzero case + (Label nonzero) + + (Mov (Mem rbx 0) r8) ; write length + (Sar r8 2) ; convert to bytes + (Mov r9 r8) ; save for heap adjustment + + (Sar rax char-shift) ; convert to codepoint + + ; start initialization + (Label loop) + (Mov (Mem rbx r8 4) eax) + (Sub r8 4) + (Cmp r8 0) + (Jne loop) + ; end initialization + + (Mov rax rbx) + (Xor rax type-str) ; create tagged pointer + (Add rbx r9) ; acct for elements and stored length + (Add rbx 8) + ; Pad to 8-byte alignment + (Add rbx 4) + (Sar rbx 3) + (Sal rbx 3) + (Label theend)))] + + ['string-ref + (seq (Pop r8) + (assert-natural rax) + (assert-string r8) + (Mov r9 (Mem r8 (- type-str))) + (Cmp rax r9) + (Jge 'err) + (Sar rax 2) + (Mov eax (Mem r8 rax (- 8 type-str))) + (Sal rax char-shift) + (Xor rax type-char))])) + + +;; Op3 -> Asm +(define (compile-op3 p) + (match p + ['vector-set! + (seq (Pop r10) + (Pop r8) + (assert-vector r8) + (assert-natural r10) + (Mov r9 (Mem r8 (- type-vect))) + (Cmp r10 r9) + (Jge 'err) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) + (Mov rax (value->bits (void))))])) + +(define (type-pred mask type) + (seq (And rax mask) + (Cmp rax type) + if-equal)) + +;; Asm +;; set rax to #t or #f if comparison flag is equal +(define if-equal + (seq (Mov rax (value->bits #f)) + (Mov r9 (value->bits #t)) + (Cmove rax r9))) + +;; Asm +;; set rax to #t or #f if comparison flag is less than +(define if-lt + (seq (Mov rax (value->bits #f)) + (Mov r9 (value->bits #t)) + (Cmovl rax r9))) + + +;; Asm +;; Dynamically pad the stack to be aligned for a call +(define pad-stack + (seq (Mov r15 rsp) + (And r15 #b1000) + (Sub rsp r15))) + +;; Asm +;; Undo the stack alignment after a call +(define unpad-stack + (seq (Add rsp r15))) + +;; Asm +;; Copy sized array of characters pointed to by rax +(define char-array-copy + (seq (Mov rdi rbx) ; dst + (Mov rsi rax) ; src + (Mov rdx (Mem rax 0)) ; len + (Add rdx 1) ; #words = 1 + (len+1)/2 + (Sar rdx 1) + (Add rdx 1) + (Sal rdx 3) ; #bytes = 8*#words + (Mov r12 rdx) ; save rdx before destroyed + pad-stack + (Extern 'memcpy) + (Call 'memcpy) + unpad-stack + ; rbx should be preserved by memcpy + ;(Mov rbx rax) ; dst is returned, install as heap pointer + (Add rbx r12))) + diff --git a/mug/compiler/compile-stdin.rkt b/mug/compiler/compile-stdin.rkt new file mode 100644 index 0000000..f25989a --- /dev/null +++ b/mug/compiler/compile-stdin.rkt @@ -0,0 +1,14 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "compile.rkt") +(require "../syntax/read-all.rkt") +(require a86/printer) + +;; -> Void +;; Compile contents of stdin, +;; emit asm code on stdout +(define (main) + (read-line) ; ignore #lang racket line + (asm-display (compile (apply parse-closed (read-all))))) + diff --git a/mug/compile-expr.rkt b/mug/compiler/compile.rkt similarity index 55% rename from mug/compile-expr.rkt rename to mug/compiler/compile.rkt index 1921741..b116407 100644 --- a/mug/compile-expr.rkt +++ b/mug/compiler/compile.rkt @@ -1,69 +1,155 @@ #lang racket -(provide compile-e compile-lambda-defines compile-lambda-define free-vars-to-heap - ; for notes - compile-string compile-symbol) -(require "ast.rkt" - "types.rkt" - "lambdas.rkt" - "fv.rkt" - "utils.rkt" - "compile-ops.rkt" - a86/ast) - -;; Registers used -(define rax 'rax) ; return -(define rbx 'rbx) ; heap -(define rsp 'rsp) ; stack -(define rdi 'rdi) ; arg -(define r8 'r8) -(define r9 'r9) -(define rsi 'rsi) - -;; Expr CEnv Bool -> Asm +(provide compile + compile-e + compile-es + compile-define + compile-match + compile-match-clause + compile-lambda-define + copy-env-to-stack + free-vars-to-heap) + +(require "../syntax/ast.rkt") +(require "compile-ops.rkt") +(require "compile-literals.rkt") +(require "../runtime/types.rkt") +(require "../syntax/lambdas.rkt") +(require "../syntax/fv.rkt") +(require a86/ast a86/registers) + +;; Prog -> Asm +(define (compile p) + (match p + [(Prog ds e) + (prog (Global 'entry) + (Label 'entry) + (Push rbx) ; save callee-saved register + (Push r15) + (Mov rbx rdi) ; recv heap pointer + (init-symbol-table p) + (compile-defines-values ds) + (compile-e e (reverse (define-ids ds)) #f) + (Add rsp (* 8 (length ds))) ;; pop function definitions + (Pop r15) ; restore callee-save register + (Pop rbx) + (Ret) + (compile-defines ds) + (compile-lambda-defines (lambdas p)) + (Label 'err) + pad-stack + (Extern 'raise_error) + (Call 'raise_error) + (Data) + (Label 'empty) + (Dq 0) + (compile-literals p))])) + +;; [Listof Defn] -> [Listof Id] +(define (define-ids ds) + (match ds + ['() '()] + [(cons (Defn f xs e) ds) + (cons f (define-ids ds))])) + +;; [Listof Defn] -> Asm +(define (compile-defines ds) + (match ds + ['() (seq)] + [(cons d ds) + (seq (compile-define d) + (compile-defines ds))])) + +;; Defn -> Asm +(define (compile-define d) + (match d + [(Defn f xs e) + (compile-lambda-define (Lam f xs e))])) + +;; [Listof Lam] -> Asm +(define (compile-lambda-defines ls) + (match ls + ['() (seq)] + [(cons l ls) + (seq (compile-lambda-define l) + (compile-lambda-defines ls))])) + +;; Lam -> Asm +(define (compile-lambda-define l) + (let ((fvs (fv l))) + (match l + [(Lam f xs e) + (let ((env (append (reverse fvs) (reverse xs) (list #f)))) + (seq (Label (symbol->label f)) + (Cmp r8 (length xs)) + (Jne 'err) + (Mov rax (Mem rsp (* 8 (length xs)))) + (copy-env-to-stack fvs 8) + (compile-e e env #t) + (Add rsp (* 8 (length env))) ; pop env + (Ret)))]))) + +;; [Listof Id] Int -> Asm +;; Copy the closure environment at given offset to stack +(define (copy-env-to-stack fvs off) + (match fvs + ['() (seq)] + [(cons _ fvs) + (seq (Mov r9 (Mem rax (- off type-proc))) + (Push r9) + (copy-env-to-stack fvs (+ 8 off)))])) + +;; type CEnv = (Listof [Maybe Id]) +;; Expr CEnv Boolean -> Asm (define (compile-e e c t?) (match e - [(Int i) (compile-value i)] - [(Bool b) (compile-value b)] - [(Char c) (compile-value c)] - [(Eof) (compile-value eof)] - [(Empty) (compile-value '())] - [(Str s) (compile-string s)] - [(Symb s) (compile-symbol s)] - [(Var x) (compile-variable x c)] - [(Prim0 p) (compile-prim0 p c)] - [(Prim1 p e) (compile-prim1 p e c)] - [(Prim2 p e1 e2) (compile-prim2 p e1 e2 c)] + [(Lit d) (compile-datum d)] + [(Eof) (seq (Mov rax (value->bits eof)))] + [(Var x) (compile-variable x c)] + [(Prim0 p) (compile-prim0 p)] + [(Prim1 p e) (compile-prim1 p e c)] + [(Prim2 p e1 e2) (compile-prim2 p e1 e2 c)] [(Prim3 p e1 e2 e3) (compile-prim3 p e1 e2 e3 c)] - [(If e1 e2 e3) (compile-if e1 e2 e3 c t?)] - [(Begin e1 e2) (compile-begin e1 e2 c t?)] - [(Let x e1 e2) (compile-let x e1 e2 c t?)] - [(App e es) (compile-app e es c t?)] - [(Lam f xs e) (compile-lam f xs e c)] - [(Match e ps es) (compile-match e ps es c t?)])) + [(If e1 e2 e3) (compile-if e1 e2 e3 c t?)] + [(Begin e1 e2) (compile-begin e1 e2 c t?)] + [(Let x e1 e2) (compile-let x e1 e2 c t?)] + [(App e es) + (compile-app e es c t?)] + [(Lam f xs e) + (compile-lam f xs e c)] + [(Match e ps es) (compile-match e ps es c t?)])) + +;; Datum -> Asm +(define (compile-datum d) + (cond [(string? d) (compile-string d)] + [(symbol? d) (compile-symbol d)] + [else (seq (Mov rax (value->bits d)))])) ;; Symbol -> Asm -(define (compile-symbol s) +(define (compile-symbol s) (seq (Lea rax (Mem (symbol->data-label s) type-symb)))) ;; String -> Asm (define (compile-string s) (seq (Lea rax (Mem (symbol->data-label (string->symbol s)) type-str)))) -;; Value -> Asm -(define (compile-value v) - (seq (Mov rax (value->bits v)))) +;; [Listof Char] -> Asm +(define (compile-string-chars cs) + (match cs + ['() (seq)] + [(cons c cs) + (seq (Dd (char->integer c)) + (compile-string-chars cs))])) + ;; Id CEnv -> Asm (define (compile-variable x c) - (match (lookup x c) - [#f (error "unbound variable")] ;(seq (Lea rax (symbol->label x)))] - [i (seq (Mov rax (Mem rsp i)))])) + (let ((i (lookup x c))) + (seq (Mov rax (Mem rsp i))))) -;; Op0 CEnv -> Asm -(define (compile-prim0 p c) +;; Op0 -> Asm +(define (compile-prim0 p) (compile-op0 p)) -;; Op1 Expr CEnv -> Asm (define (compile-prim1 p e c) (seq (compile-e e c #f) (compile-op1 p))) @@ -83,8 +169,7 @@ (Push rax) (compile-e e3 (cons #f (cons #f c)) #f) (compile-op3 p))) - -;; Expr Expr Expr CEnv Bool -> Asm +;; Expr Expr Expr CEnv Boolean -> Asm (define (compile-if e1 e2 e3 c t?) (let ((l1 (gensym 'if)) (l2 (gensym 'if))) @@ -96,25 +181,25 @@ (Label l1) (compile-e e3 c t?) (Label l2)))) - -;; Expr Expr CEnv Bool -> Asm +;; Expr Expr CEnv Boolean -> Asm (define (compile-begin e1 e2 c t?) (seq (compile-e e1 c #f) (compile-e e2 c t?))) - -;; Id Expr Expr CEnv Bool -> Asm +;; Id Expr Expr CEnv Boolean -> Asm (define (compile-let x e1 e2 c t?) (seq (compile-e e1 c #f) (Push rax) (compile-e e2 (cons x c) t?) (Add rsp 8))) -;; Id [Listof Expr] CEnv Bool -> Asm -(define (compile-app f es c t?) - ;(compile-app-nontail f es c) +;; Id [Listof Expr] CEnv -> Asm +;; The return address is placed above the arguments, so callee pops +;; arguments and return address is next frame +;; Expr [Listof Expr] CEnv Boolean -> Asm +(define (compile-app e es c t?) (if t? - (compile-app-tail f es c) - (compile-app-nontail f es c))) + (compile-app-tail e es c) + (compile-app-nontail e es c))) ;; Expr [Listof Expr] CEnv -> Asm (define (compile-app-tail e es c) @@ -123,8 +208,8 @@ (Add rsp (* 8 (length c))) (Mov rax (Mem rsp (* 8 (length es)))) (assert-proc rax) - (Xor rax type-proc) - (Mov rax (Mem rax 0)) + (Mov rax (Mem rax (- type-proc))) + (Mov r8 (length es)) ; pass arity info (Jmp rax))) ;; Integer Integer -> Asm @@ -147,19 +232,59 @@ (compile-es (cons e es) (cons #f c)) (Mov rax (Mem rsp i)) (assert-proc rax) - (Xor rax type-proc) - (Mov rax (Mem rax 0)) ; fetch the code label + (Mov rax (Mem rax (- type-proc))) ; fetch the code label + (Mov r8 (length es)) ; pass arity info (Jmp rax) (Label r)))) +;; Defns -> Asm +;; Compile the closures for ds and push them on the stack +(define (compile-defines-values ds) + (seq (alloc-defines ds 0) + (init-defines ds (reverse (define-ids ds)) 8) + (add-rbx-defines ds 0))) + +;; Defns Int -> Asm +;; Allocate closures for ds at given offset, but don't write environment yet +(define (alloc-defines ds off) + (match ds + ['() (seq)] + [(cons (Defn f xs e) ds) + (let ((fvs (fv (Lam f xs e)))) + (seq (Lea rax (symbol->label f)) + (Mov (Mem rbx off) rax) + (Mov rax rbx) + (Add rax off) + (Xor rax type-proc) + (Push rax) + (alloc-defines ds (+ off (* 8 (add1 (length fvs)))))))])) + +;; Defns CEnv Int -> Asm +;; Initialize the environment for each closure for ds at given offset +(define (init-defines ds c off) + (match ds + ['() (seq)] + [(cons (Defn f xs e) ds) + (let ((fvs (fv (Lam f xs e)))) + (seq (free-vars-to-heap fvs c off) + (init-defines ds c (+ off (* 8 (add1 (length fvs)))))))])) + +;; Defns Int -> Asm +;; Compute adjustment to rbx for allocation of all ds +(define (add-rbx-defines ds n) + (match ds + ['() (seq (Add rbx (* n 8)))] + [(cons (Defn f xs e) ds) + (add-rbx-defines ds (+ n (add1 (length (fv (Lam f xs e))))))])) + ;; Id [Listof Id] Expr CEnv -> Asm (define (compile-lam f xs e c) (let ((fvs (fv (Lam f xs e)))) (seq (Lea rax (symbol->label f)) - (Mov (Mem rbx 0) rax) + (Mov (Mem rbx) rax) (free-vars-to-heap fvs c 8) (Mov rax rbx) ; return value - (Or rax type-proc) + (Xor rax type-proc) (Add rbx (* 8 (add1 (length fvs))))))) ;; [Listof Id] CEnv Int -> Asm @@ -172,38 +297,6 @@ (Mov (Mem rbx off) r8) (free-vars-to-heap fvs c (+ off 8)))])) -;; [Listof Lam] -> Asm -(define (compile-lambda-defines ls) - (match ls - ['() (seq)] - [(cons l ls) - (seq (compile-lambda-define l) - (compile-lambda-defines ls))])) - -;; Lam -> Asm -(define (compile-lambda-define l) - (let ((fvs (fv l))) - (match l - [(Lam f xs e) - (let ((env (append (reverse fvs) (reverse xs) (list #f)))) - (seq (Label (symbol->label f)) - (Mov rax (Mem rsp (* 8 (length xs)))) - (Xor rax type-proc) - (copy-env-to-stack fvs 8) - (compile-e e env #t) - (Add rsp (* 8 (length env))) ; pop env - (Ret)))]))) - -;; [Listof Id] Int -> Asm -;; Copy the closure environment at given offset to stack -(define (copy-env-to-stack fvs off) - (match fvs - ['() (seq)] - [(cons _ fvs) - (seq (Mov r9 (Mem rax off)) - (Push r9) - (copy-env-to-stack fvs (+ 8 off)))])) - ;; [Listof Expr] CEnv -> Asm (define (compile-es es c) (match es @@ -219,7 +312,7 @@ (seq (compile-e e c #f) (Push rax) ; save away to be restored by each clause (compile-match-clauses ps es (cons #f c) done t?) - (Jmp 'raise_error_align) + (Jmp 'err) (Label done) (Add rsp 8)))) ; pop the saved value being matched @@ -236,7 +329,7 @@ (let ((next (gensym))) (match (compile-pattern p '() next) [(list i cm) - (seq (Mov rax (Mem rsp 0)) ; restore value being matched + (seq (Mov rax (Mem rsp)) ; restore value being matched i (compile-e e (append cm c) t?) (Add rsp (* 8 (length cm))) @@ -246,48 +339,21 @@ ;; Pat CEnv Symbol -> (list Asm CEnv) (define (compile-pattern p cm next) (match p - [(PWild) + [(Var '_) (list (seq) cm)] - [(PVar x) + [(Var x) (list (seq (Push rax)) (cons x cm))] - [(PStr s) - (let ((ok (gensym)) - (fail (gensym))) - (list (seq (Lea rdi (symbol->data-label (string->symbol s))) - (Mov r8 rax) - (And r8 ptr-mask) - (Cmp r8 type-str) - (Je ok) - (Label fail) - (Add rsp (* 8 (length cm))) - (Jmp next) - (Label ok) - (Xor rax type-str) - (Mov rsi rax) - pad-stack - (Call 'symb_cmp) - unpad-stack - (Cmp rax 0) - (Jne fail)) - cm))] - [(PSymb s) - (let ((ok (gensym))) - (list (seq (Lea r9 (Mem (symbol->data-label s) type-symb)) - (Cmp rax r9) - (Je ok) - (Add rsp (* 8 (length cm))) - (Jmp next) - (Label ok)) - cm))] - [(PLit l) + [(Lit l) (let ((ok (gensym))) - (list (seq (Cmp rax (value->bits l)) + (list (seq (Mov r8 rax) + (compile-datum l) + (Cmp rax r8) (Je ok) (Add rsp (* 8 (length cm))) (Jmp next) (Label ok)) cm))] - [(PAnd p1 p2) + [(Conj p1 p2) (match (compile-pattern p1 (cons #f cm) next) [(list i1 cm1) (match (compile-pattern p2 cm1 next) @@ -298,7 +364,7 @@ (Mov rax (Mem rsp (* 8 (- (sub1 (length cm1)) (length cm))))) i2) cm2)])])] - [(PBox p) + [(Box p) (match (compile-pattern p cm next) [(list i1 cm1) (let ((ok (gensym))) @@ -310,11 +376,10 @@ (Add rsp (* 8 (length cm))) ; haven't pushed anything yet (Jmp next) (Label ok) - (Xor rax type-box) - (Mov rax (Mem rax 0)) + (Mov rax (Mem rax (- type-box))) i1) cm1))])] - [(PCons p1 p2) + [(Cons p1 p2) (match (compile-pattern p1 (cons #f cm) next) [(list i1 cm1) (match (compile-pattern p2 cm1 next) @@ -329,10 +394,20 @@ (Jmp next) (Label ok) (Xor rax type-cons) - (Mov r8 (Mem rax 0)) + (Mov r8 (Mem rax 8)) (Push r8) ; push cdr - (Mov rax (Mem rax 8)) ; mov rax car + (Mov rax (Mem rax 0)) ; mov rax car i1 (Mov rax (Mem rsp (* 8 (- (sub1 (length cm1)) (length cm))))) i2) cm2))])])])) + +;; Id CEnv -> Integer +(define (lookup x cenv) + (match cenv + ['() (error "undefined variable:" x)] + [(cons y rest) + (match (eq? x y) + [#t 0] + [#f (+ 8 (lookup x rest))])])) + diff --git a/mug/executor/decode.rkt b/mug/executor/decode.rkt new file mode 100644 index 0000000..4ba7f96 --- /dev/null +++ b/mug/executor/decode.rkt @@ -0,0 +1,54 @@ +#lang racket + +(require "../runtime/types.rkt") +(require ffi/unsafe) + +(provide (all-defined-out)) + +;; Integer -> Value +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(= b (value->bits eof)) eof] + [(= b (value->bits (void))) (void)] + [(= b (value->bits '())) '()] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [(char-bits? b) + (integer->char (arithmetic-shift b (- char-shift)))] + [(box-bits? b) + (box (bits->value (mem-ref (- b type-box))))] + [(cons-bits? b) + (cons (bits->value (mem-ref (+ 0 (- b type-cons)))) + (bits->value (mem-ref (+ 8 (- b type-cons)))))] + + [(vect-bits? b) + (let ((p (- b type-vect))) + (build-vector (bits->value (mem-ref p)) + (lambda (j) + (bits->value (mem-ref (+ p (* 8 (add1 j))))))))] + [(str-bits? b) + (let ((p (- b type-str))) + (build-string (bits->value (mem-ref p)) + (lambda (j) + (integer->char (mem-ref32 (+ p 8 (* 4 j)))))))] + [(proc-bits? b) + (lambda _ + (error "This function is not callable."))] + [(symb-bits? b) + (let ((p (- b type-symb))) + (string->symbol + (build-string (bits->value (mem-ref p)) + (lambda (j) + (integer->char (mem-ref32 (+ p 8 (* 4 j))))))))] + [else (error "invalid bits")])) + +(define (mem-ref i) + (ptr-ref (cast i _int64 _pointer) _int64)) + +(define (mem-ref32 i) + (ptr-ref (cast i _int64 _pointer) _int32)) + +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/mug/executor/exec.rkt b/mug/executor/exec.rkt new file mode 100644 index 0000000..9217a1d --- /dev/null +++ b/mug/executor/exec.rkt @@ -0,0 +1,70 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") +(struct exec-state (program heap) #:transparent) + +(define (symb-ptr->string p) + (define len (bits->value (ptr-ref p _uint64 0))) + (define cp-base (ptr-add p 8 _byte)) + (build-string + len + (λ (i) + (integer->char (ptr-ref cp-base _uint32 i))))) + +(define (exec/state prog) + (define intern-table (make-hash)) + (define (intern-symbol/cb p) + (define s (symb-ptr->string p)) + (hash-ref! intern-table s (λ () p))) + (define heap (malloc _int64 10000)) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)) + (extern 'raise_error + (λ () (raise 'err)) + (_fun -> _void)) + (extern 'intern_symbol + intern-symbol/cb + (_fun _pointer -> _pointer)))]) + (asm-load prog)) + heap)) + +(define (exec-call st) + (match-define (exec-state program heap) st) + (with-handlers ([(λ (x) (eq? x 'err)) identity]) + (asm-call program 'entry heap))) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/mug/executor/run-stdin.rkt b/mug/executor/run-stdin.rkt new file mode 100644 index 0000000..7e7170f --- /dev/null +++ b/mug/executor/run-stdin.rkt @@ -0,0 +1,12 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "../compiler/compile.rkt") +(require "run.rkt") + +;; -> Void +;; Compile contents of stdin and use asm-interp to run +(define (main) + (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) + diff --git a/mug/executor/run.rkt b/mug/executor/run.rkt new file mode 100644 index 0000000..d96fe18 --- /dev/null +++ b/mug/executor/run.rkt @@ -0,0 +1,20 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run run/io) +;; Asm -> Answer +(define (run asm) + (call-with-exec + asm + (λ (r) + (match r + ['err 'err] + [b (bits->value b)])))) +;; Asm String -> (cons Answer String) +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) + diff --git a/mug/interp-defun.rkt b/mug/interp-defun.rkt deleted file mode 100644 index 7d59532..0000000 --- a/mug/interp-defun.rkt +++ /dev/null @@ -1,164 +0,0 @@ -#lang racket -(provide interp interp-env (struct-out Closure) zip) -(require "ast.rkt" - "env.rkt" - "interp-prims.rkt") - -;; type Answer = Value | 'err - -;; type Value = -;; | Integer -;; | Boolean -;; | Character -;; | Eof -;; | Void -;; | '() -;; | (cons Value Value) -;; | (box Value) -;; | (vector Value ...) -;; | (string Char ...) -;; | (Closure [Listof Id] Expr Env) -(struct Closure (xs e r) #:prefab) - -;; type REnv = (Listof (List Id Value)) -;; type Defns = (Listof Defn) - -;; Prog -> Answer -(define (interp p) - (match p - [(Prog ds e) - (interp-env e '() ds)])) - -;; Expr Env Defns -> Answer -(define (interp-env e r ds) - (match e - [(Int i) i] - [(Bool b) b] - [(Char c) c] - [(Eof) eof] - [(Empty) '()] - [(Var x) (interp-var x r ds)] - [(Str s) s] - [(Symb s) s] - [(Prim0 'void) (void)] - [(Prim0 'read-byte) (read-byte)] - [(Prim0 'peek-byte) (peek-byte)] - [(Prim1 p e) - (match (interp-env e r ds) - ['err 'err] - [v (interp-prim1 p v)])] - [(Prim2 p e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [v1 (match (interp-env e2 r ds) - ['err 'err] - [v2 (interp-prim2 p v1 v2)])])] - [(Prim3 p e1 e2 e3) - (match (interp-env e1 r ds) - ['err 'err] - [v1 (match (interp-env e2 r ds) - ['err 'err] - [v2 (match (interp-env e3 r ds) - ['err 'err] - [v3 (interp-prim3 p v1 v2 v3)])])])] - [(If p e1 e2) - (match (interp-env p r ds) - ['err 'err] - [v - (if v - (interp-env e1 r ds) - (interp-env e2 r ds))])] - [(Begin e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [_ (interp-env e2 r ds)])] - [(Let x e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [v (interp-env e2 (ext r x v) ds)])] - [(Lam _ xs e) - (Closure xs e r)] - [(App e es) - (match (interp-env e r ds) - ['err 'err] - [f - (match (interp-env* es r ds) - ['err 'err] - [vs - (match f - [(Closure xs e r) - ; check arity matches - (if (= (length xs) (length vs)) - (interp-env e (append (zip xs vs) r) ds) - 'err)] - [_ 'err])])])] - [(Match e ps es) - (match (interp-env e r ds) - ['err 'err] - [v - (interp-match v ps es r ds)])])) - -;; Value [Listof Pat] [Listof Expr] Env Defns -> Answer -(define (interp-match v ps es r ds) - (match* (ps es) - [('() '()) 'err] - [((cons p ps) (cons e es)) - (match (interp-match-pat p v r) - [#f (interp-match v ps es r ds)] - [r (interp-env e r ds)])])) - -;; Pat Value Env -> [Maybe Env] -(define (interp-match-pat p v r) - (match p - [(PWild) r] - [(PVar x) (ext r x v)] - [(PSymb s) (and (eq? s v) r)] - [(PStr s) (and (string? v) (string=? s v) r)] - [(PLit l) (and (eqv? l v) r)] - [(PBox p) - (match v - [(box v) - (interp-match-pat p v r)] - [_ #f])] - [(PCons p1 p2) - (match v - [(cons v1 v2) - (match (interp-match-pat p1 v1 r) - [#f #f] - [r1 (interp-match-pat p2 v2 r1)])] - [_ #f])] - [(PAnd p1 p2) - (match (interp-match-pat p1 v r) - [#f #f] - [r1 (interp-match-pat p2 v r1)])])) - -;; Id Env [Listof Defn] -> Answer -(define (interp-var x r ds) - (match (lookup r x) - ['err (match (defns-lookup ds x) - [(Defn f xs e) (interp-env (Lam f xs e) '() ds)] - [#f 'err])] - [v v])) - -;; (Listof Expr) REnv Defns -> (Listof Value) | 'err -(define (interp-env* es r ds) - (match es - ['() '()] - [(cons e es) - (match (interp-env e r ds) - ['err 'err] - [v (match (interp-env* es r ds) - ['err 'err] - [vs (cons v vs)])])])) - -;; Defns Symbol -> [Maybe Defn] -(define (defns-lookup ds f) - (findf (match-lambda [(Defn g _ _) (eq? f g)]) - ds)) - -(define (zip xs ys) - (match* (xs ys) - [('() '()) '()] - [((cons x xs) (cons y ys)) - (cons (list x y) - (zip xs ys))])) diff --git a/mug/interp-io.rkt b/mug/interp-io.rkt deleted file mode 100644 index 93f7d3c..0000000 --- a/mug/interp-io.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide interp/io) -(require "interp.rkt") - -;; (Expr String -> String -;; Interpret e with given string as input, -;; collect output as string (including printed result) -(define (interp/io e in) - (parameterize ((current-output-port (open-output-string)) - (current-input-port (open-input-string in))) - (cons (interp e) - (get-output-string (current-output-port))))) diff --git a/mug/interp.rkt b/mug/interp.rkt deleted file mode 100644 index c295ca6..0000000 --- a/mug/interp.rkt +++ /dev/null @@ -1,163 +0,0 @@ -#lang racket -(provide interp interp-env) -(require "ast.rkt" - "env.rkt" - "interp-prims.rkt") - -;; type Answer = Value | 'err - -;; type Value = -;; | Integer -;; | Boolean -;; | Character -;; | Eof -;; | Void -;; | '() -;; | (cons Value Value) -;; | (box Value) -;; | (vector Value ...) -;; | (string Char ...) -;; | (Value ... -> Answer) - -;; type REnv = (Listof (List Id Value)) -;; type Defns = (Listof Defn) - -;; Prog -> Answer -(define (interp p) - (match p - [(Prog ds e) - (interp-env e '() ds)])) - -;; Expr Env Defns -> Answer -(define (interp-env e r ds) - (match e - [(Int i) i] - [(Bool b) b] - [(Char c) c] - [(Eof) eof] - [(Empty) '()] - [(Var x) (interp-var x r ds)] - [(Str s) s] - [(Symb s) s] - [(Prim0 'void) (void)] - [(Prim0 'read-byte) (read-byte)] - [(Prim0 'peek-byte) (peek-byte)] - [(Prim1 p e) - (match (interp-env e r ds) - ['err 'err] - [v (interp-prim1 p v)])] - [(Prim2 p e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [v1 (match (interp-env e2 r ds) - ['err 'err] - [v2 (interp-prim2 p v1 v2)])])] - [(Prim3 p e1 e2 e3) - (match (interp-env e1 r ds) - ['err 'err] - [v1 (match (interp-env e2 r ds) - ['err 'err] - [v2 (match (interp-env e3 r ds) - ['err 'err] - [v3 (interp-prim3 p v1 v2 v3)])])])] - [(If p e1 e2) - (match (interp-env p r ds) - ['err 'err] - [v - (if v - (interp-env e1 r ds) - (interp-env e2 r ds))])] - [(Begin e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [_ (interp-env e2 r ds)])] - [(Let x e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [v (interp-env e2 (ext r x v) ds)])] - [(Lam _ xs e) - (λ vs - ; check arity matches - (if (= (length xs) (length vs)) - (interp-env e (append (zip xs vs) r) ds) - 'err))] - [(App e es) - (match (interp-env e r ds) - ['err 'err] - [f - (match (interp-env* es r ds) - ['err 'err] - [vs - (if (procedure? f) - (apply f vs) - 'err)])])] - [(Match e ps es) - (match (interp-env e r ds) - ['err 'err] - [v - (interp-match v ps es r ds)])])) - -;; Value [Listof Pat] [Listof Expr] Env Defns -> Answer -(define (interp-match v ps es r ds) - (match* (ps es) - [('() '()) 'err] - [((cons p ps) (cons e es)) - (match (interp-match-pat p v r) - [#f (interp-match v ps es r ds)] - [r (interp-env e r ds)])])) - -;; Pat Value Env -> [Maybe Env] -(define (interp-match-pat p v r) - (match p - [(PWild) r] - [(PVar x) (ext r x v)] - [(PSymb s) (and (eq? s v) r)] - [(PStr s) (and (string? v) (string=? s v) r)] - [(PLit l) (and (eqv? l v) r)] - [(PBox p) - (match v - [(box v) - (interp-match-pat p v r)] - [_ #f])] - [(PCons p1 p2) - (match v - [(cons v1 v2) - (match (interp-match-pat p1 v1 r) - [#f #f] - [r1 (interp-match-pat p2 v2 r1)])] - [_ #f])] - [(PAnd p1 p2) - (match (interp-match-pat p1 v r) - [#f #f] - [r1 (interp-match-pat p2 v r1)])])) - -;; Id Env [Listof Defn] -> Answer -(define (interp-var x r ds) - (match (lookup r x) - ['err (match (defns-lookup ds x) - [(Defn f xs e) (interp-env (Lam f xs e) '() ds)] - [#f 'err])] - [v v])) - -;; (Listof Expr) REnv Defns -> (Listof Value) | 'err -(define (interp-env* es r ds) - (match es - ['() '()] - [(cons e es) - (match (interp-env e r ds) - ['err 'err] - [v (match (interp-env* es r ds) - ['err 'err] - [vs (cons v vs)])])])) - -;; Defns Symbol -> [Maybe Defn] -(define (defns-lookup ds f) - (findf (match-lambda [(Defn g _ _) (eq? f g)]) - ds)) - -(define (zip xs ys) - (match* (xs ys) - [('() '()) '()] - [((cons x xs) (cons y ys)) - (cons (list x y) - (zip xs ys))])) diff --git a/mug/env.rkt b/mug/interpreter/env.rkt similarity index 91% rename from mug/env.rkt rename to mug/interpreter/env.rkt index c43be9c..5c2ab01 100644 --- a/mug/env.rkt +++ b/mug/interpreter/env.rkt @@ -12,4 +12,5 @@ ;; Env Variable Value -> Value (define (ext r x i) - (cons (list x i) r)) \ No newline at end of file + (cons (list x i) r)) + diff --git a/mug/interpreter/interp-io.rkt b/mug/interpreter/interp-io.rkt new file mode 100644 index 0000000..f0bb535 --- /dev/null +++ b/mug/interpreter/interp-io.rkt @@ -0,0 +1,16 @@ +#lang racket +(provide interp/io) +(require "interp.rkt") +;; String Prog -> (Cons Answer String) +;; Interpret p with given string as input, +;; return answer and collected output as string +(define (interp/io p input) + (define result (box #f)) + (define output + (with-input-from-string input + (λ () + (with-output-to-string + (λ () + (set-box! result (interp p))))))) + (cons (unbox result) output)) + diff --git a/mug/interp-prims.rkt b/mug/interpreter/interp-prim.rkt similarity index 59% rename from mug/interp-prims.rkt rename to mug/interpreter/interp-prim.rkt index 7797de6..ea46c7f 100644 --- a/mug/interp-prims.rkt +++ b/mug/interpreter/interp-prim.rkt @@ -1,18 +1,24 @@ #lang racket -(require "ast.rkt") -(provide interp-prim1 interp-prim2 interp-prim3) +(provide interp-prim0 interp-prim1 interp-prim2 interp-prim3) -;; Op1 Value -> Answer -(define (interp-prim1 p1 v) - (match (list p1 v) +;; Op0 -> Value +(define (interp-prim0 op) + (match op + ['read-byte (read-byte)] + ['peek-byte (peek-byte)] + ['void (void)])) + +;; Op1 Value -> Value { raises 'err } +(define (interp-prim1 op v) + (match (list op v) [(list 'add1 (? integer?)) (add1 v)] [(list 'sub1 (? integer?)) (sub1 v)] [(list 'zero? (? integer?)) (zero? v)] [(list 'char? v) (char? v)] - [(list 'char->integer (? char?)) (char->integer v)] [(list 'integer->char (? codepoint?)) (integer->char v)] + [(list 'char->integer (? char?)) (char->integer v)] + [(list 'write-byte (? byte?)) (write-byte v)] [(list 'eof-object? v) (eof-object? v)] - [(list 'write-byte (? byte?)) (write-byte v)] [(list 'box v) (box v)] [(list 'unbox (? box?)) (unbox v)] [(list 'car (? pair?)) (car v)] @@ -24,51 +30,52 @@ [(list 'vector-length (? vector?)) (vector-length v)] [(list 'string? v) (string? v)] [(list 'string-length (? string?)) (string-length v)] - [(list 'symbol? v) (symbol? v)] - [(list 'symbol->string (? symbol?)) (symbol->string v)] - [(list 'string->symbol (? string?)) (string->symbol v)] - [(list 'string->uninterned-symbol (? string?)) - (string->uninterned-symbol v)] - [_ 'err])) + [(list 'symbol? v) (symbol? v)] + [(list 'symbol->string (? symbol? v)) (symbol->string v)] + [(list 'string->symbol (? string? v)) (string->symbol v)] + [(list 'string->uninterned-symbol (? string? v)) + (string->uninterned-symbol v)] + [_ (raise 'err)])) -;; Op2 Value Value -> Answer -(define (interp-prim2 p v1 v2) - (match (list p v1 v2) - [(list '+ (? integer?) (? integer?)) (+ v1 v2)] - [(list '- (? integer?) (? integer?)) (- v1 v2)] - [(list '< (? integer?) (? integer?)) (< v1 v2)] - [(list '= (? integer?) (? integer?)) (= v1 v2)] +;; Op2 Value Value -> Value { raises 'err } +(define (interp-prim2 op v1 v2) + (match (list op v1 v2) + [(list '+ (? integer?) (? integer?)) (+ v1 v2)] + [(list '- (? integer?) (? integer?)) (- v1 v2)] + [(list '< (? integer?) (? integer?)) (< v1 v2)] + [(list '= (? integer?) (? integer?)) (= v1 v2)] + [(list 'eq? v1 v2) (eq? v1 v2)] [(list 'cons v1 v2) (cons v1 v2)] - [(list 'eq? v1 v2) (eq? v1 v2)] [(list 'make-vector (? integer?) _) (if (<= 0 v1) (make-vector v1 v2) - 'err)] + (raise 'err))] [(list 'vector-ref (? vector?) (? integer?)) (if (<= 0 v2 (sub1 (vector-length v1))) (vector-ref v1 v2) - 'err)] + (raise 'err))] [(list 'make-string (? integer?) (? char?)) (if (<= 0 v1) (make-string v1 v2) - 'err)] + (raise 'err))] [(list 'string-ref (? string?) (? integer?)) (if (<= 0 v2 (sub1 (string-length v1))) (string-ref v1 v2) - 'err)] - [_ 'err])) + (raise 'err))] + [_ (raise 'err)])) -;; Op3 Value Value Value -> Answer +;; Op3 Value Value Value -> Value { raises 'err } (define (interp-prim3 p v1 v2 v3) (match (list p v1 v2 v3) [(list 'vector-set! (? vector?) (? integer?) _) (if (<= 0 v2 (sub1 (vector-length v1))) (vector-set! v1 v2 v3) - 'err)] - [_ 'err])) + (raise 'err))] + [_ (raise 'err)])) ;; Any -> Boolean (define (codepoint? v) (and (integer? v) (or (<= 0 v 55295) (<= 57344 v 1114111)))) + diff --git a/mug/interp-stdin.rkt b/mug/interpreter/interp-stdin.rkt similarity index 53% rename from mug/interp-stdin.rkt rename to mug/interpreter/interp-stdin.rkt index 965b9cc..7d85c32 100644 --- a/mug/interp-stdin.rkt +++ b/mug/interpreter/interp-stdin.rkt @@ -1,12 +1,13 @@ #lang racket (provide main) -(require "parse.rkt" "interp.rkt" "read-all.rkt") +(require "../syntax/parse.rkt") +(require "interp.rkt") +(require "../syntax/read-all.rkt") ;; -> Void ;; Parse and interpret contents of stdin, ;; print result on stdout (define (main) (read-line) ; ignore #lang racket line - (let ((r (interp (parse (read-all))))) - (unless (void? r) - (println r)))) + (println (interp (apply parse-closed (read-all))))) + diff --git a/mug/interpreter/interp.rkt b/mug/interpreter/interp.rkt new file mode 100644 index 0000000..46d5c35 --- /dev/null +++ b/mug/interpreter/interp.rkt @@ -0,0 +1,136 @@ +#lang racket +(provide interp interp-e) +(provide interp-match-pat) +(require "../syntax/ast.rkt") +(require "interp-prim.rkt") +(require "env.rkt") + +;; type Value = +;; | Integer +;; | Boolean +;; | Character +;; | Eof +;; | Void +;; | '() +;; | (cons Value Value) +;; | (box Value) +;; | (string Character ...) +;; | (vector Value ...) +;; | (Value ... -> Answer) + +;; type Answer = Value | 'err + +;; type Env = (Listof (List Id Value)) + +(define (err? x) (eq? x 'err)) +;; ClosedExpr -> Answer +;; Prog -> Answer +(define (interp p) + (with-handlers ([err? identity]) + (match p + [(Prog ds e) + (interp-e e '() ds)]))) +;l Expr Env Defns -> Value { raises 'err } +(define (interp-e e r ds) ;; where r closes e + (match e + [(Var x) (interp-var x r ds)] + [(Lit d) d] + [(Eof) eof] + [(Prim0 p) + (interp-prim0 p)] + [(Prim1 p e) + (interp-prim1 p (interp-e e r ds))] + [(Prim2 p e1 e2) + (interp-prim2 p + (interp-e e1 r ds) + (interp-e e2 r ds))] + [(Prim3 p e1 e2 e3) + (interp-prim3 p + (interp-e e1 r ds) + (interp-e e2 r ds) + (interp-e e3 r ds))] + [(If e1 e2 e3) + (if (interp-e e1 r ds) + (interp-e e2 r ds) + (interp-e e3 r ds))] + [(Begin e1 e2) + (begin (interp-e e1 r ds) + (interp-e e2 r ds))] + [(Let x e1 e2) + (let ((v (interp-e e1 r ds))) + (interp-e e2 (ext r x v) ds))] + [(App e es) + (let ((f (interp-e e r ds)) + (vs (interp-e* es r ds))) + (if (procedure? f) + (apply f vs) + (raise 'err)))] + [(Match e ps es) + (let ((v (interp-e e r ds))) + (interp-match v ps es r ds))] + [(Lam f xs e) + (λ vs + ; check arity matches + (if (= (length xs) (length vs)) + (interp-e e (append (zip xs vs) r) ds) + (raise 'err)))])) + +;; (Listof Expr) REnv Defns -> (Listof Value) { raises 'err } +(define (interp-e* es r ds) + (match es + ['() '()] + [(cons e es) + (cons (interp-e e r ds) + (interp-e* es r ds))])) + +;; Id Env [Listof Defn] -> Answer +(define (interp-var x r ds) + (match (lookup r x) + ['err (match (defns-lookup ds x) + [(Defn f xs e) (interp-e (Lam f xs e) '() ds)] + [#f 'err])] + [v v])) + +;; Value [Listof Pat] [Listof Expr] Env Defns -> Answer +(define (interp-match v ps es r ds) + (match* (ps es) + [('() '()) 'err] + [((cons p ps) (cons e es)) + (match (interp-match-pat p v r) + [#f (interp-match v ps es r ds)] + [r (interp-e e r ds)])])) +;; Pat Value Env -> [Maybe Env] +(define (interp-match-pat p v r) + (match p + [(Var '_) r] + [(Var x) (ext r x v)] + [(Lit l) (and (eqv? l v) r)] + [(Box p) + (match v + [(box v) + (interp-match-pat p v r)] + [_ #f])] + [(Cons p1 p2) + (match v + [(cons v1 v2) + (match (interp-match-pat p1 v1 r) + [#f #f] + [r1 (interp-match-pat p2 v2 r1)])] + [_ #f])] + [(Conj p1 p2) + (match (interp-match-pat p1 v r) + [#f #f] + [r1 (interp-match-pat p2 v r1)])])) + +;; Defns Symbol -> Defn +(define (defns-lookup ds f) + (findf (match-lambda [(Defn g _ _) (eq? f g)]) + ds)) + +(define (zip xs ys) + (match* (xs ys) + [('() '()) '()] + [((cons x xs) (cons y ys)) + (cons (list x y) + (zip xs ys))])) + diff --git a/mug/main.c b/mug/main.c deleted file mode 100644 index 1ca6115..0000000 --- a/mug/main.c +++ /dev/null @@ -1,40 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); -val_t *heap; - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - heap = malloc(8 * heap_size); - - val_t result; - - result = entry(heap); - - print_result(result); - if (val_typeof(result) != T_VOID) - putchar('\n'); - - free(heap); - return 0; -} diff --git a/mug/main.rkt b/mug/main.rkt new file mode 100644 index 0000000..f9851a3 --- /dev/null +++ b/mug/main.rkt @@ -0,0 +1,18 @@ +#lang racket +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) + diff --git a/mug/parse-file.rkt b/mug/parse-file.rkt deleted file mode 100644 index a502132..0000000 --- a/mug/parse-file.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt" "compile.rkt" "read-all.rkt" a86/printer) - -;; String -> Void -;; Compile contents of given file name, -;; emit asm code on stdout -(define (main fn) - (let ((p (open-input-file fn))) - (begin - (read-line p) ; ignore #lang racket line - (displayln (parse (read-all p))) - (close-input-port p)))) diff --git a/mug/parse.rkt b/mug/parse.rkt deleted file mode 100644 index 5de4e9b..0000000 --- a/mug/parse.rkt +++ /dev/null @@ -1,102 +0,0 @@ -#lang racket -(provide parse parse-define parse-e) -(require "ast.rkt") - -;; [Listof S-Expr] -> Prog -(define (parse s) - (match s - [(cons (and (cons 'define _) d) s) - (match (parse s) - [(Prog ds e) - (Prog (cons (parse-define d) ds) e)])] - [(cons e '()) (Prog '() (parse-e e))] - [_ (error "program parse error")])) - -;; S-Expr -> Defn -(define (parse-define s) - (match s - [(list 'define (list-rest (? symbol? f) xs) e) - (if (andmap symbol? xs) - (Defn f xs (parse-e e)) - (error "parse definition error"))] - [_ (error "Parse defn error" s)])) - -;; S-Expr -> Expr -(define (parse-e s) - (match s - [(? exact-integer?) (Int s)] - [(? boolean?) (Bool s)] - [(? char?) (Char s)] - [(? string?) (Str s)] - ['eof (Eof)] - [(? symbol?) (Var s)] - [(list 'quote (list)) (Empty)] - [(list 'quote (? symbol? s)) (Symb s)] - [(list (? (op? op0) p0)) (Prim0 p0)] - [(list (? (op? op1) p1) e) (Prim1 p1 (parse-e e))] - [(list (? (op? op2) p2) e1 e2) (Prim2 p2 (parse-e e1) (parse-e e2))] - [(list (? (op? op3) p3) e1 e2 e3) - (Prim3 p3 (parse-e e1) (parse-e e2) (parse-e e3))] - [(list 'begin e1 e2) - (Begin (parse-e e1) (parse-e e2))] - [(list 'if e1 e2 e3) - (If (parse-e e1) (parse-e e2) (parse-e e3))] - [(list 'let (list (list (? symbol? x) e1)) e2) - (Let x (parse-e e1) (parse-e e2))] - [(cons 'match (cons e ms)) - (parse-match (parse-e e) ms)] - [(list (or 'lambda 'λ) xs e) - (if (and (list? xs) - (andmap symbol? xs)) - (Lam (gensym 'lambda) xs (parse-e e)) - (error "parse lambda error"))] - [(cons e es) - (App (parse-e e) (map parse-e es))] - [_ (error "Parse error" s)])) - -(define (parse-match e ms) - (match ms - ['() (Match e '() '())] - [(cons (list p r) ms) - (match (parse-match e ms) - [(Match e ps es) - (Match e - (cons (parse-pat p) ps) - (cons (parse-e r) es))])])) - -(define (parse-pat p) - (match p - [(? boolean?) (PLit p)] - [(? integer?) (PLit p)] - [(? char?) (PLit p)] - ['_ (PWild)] - [(? symbol?) (PVar p)] - [(? string?) (PStr p)] - [(list 'quote (? symbol? s)) - (PSymb s)] - [(list 'quote (list)) - (PLit '())] - [(list 'box p) - (PBox (parse-pat p))] - [(list 'cons p1 p2) - (PCons (parse-pat p1) (parse-pat p2))] - [(list 'and p1 p2) - (PAnd (parse-pat p1) (parse-pat p2))])) - -(define op0 - '(read-byte peek-byte void)) -(define op1 - '(add1 sub1 zero? char? write-byte eof-object? - integer->char char->integer - box unbox empty? cons? box? car cdr - vector? vector-length string? string-length - symbol? symbol->string string->symbol string->uninterned-symbol)) -(define op2 - '(+ - < = cons eq? make-vector vector-ref make-string string-ref)) -(define op3 - '(vector-set!)) - -(define (op? ops) - (λ (x) - (and (symbol? x) - (memq x ops)))) diff --git a/mug/run.rkt b/mug/run.rkt deleted file mode 100644 index eaa53eb..0000000 --- a/mug/run.rkt +++ /dev/null @@ -1,18 +0,0 @@ -#lang racket -(provide run run/io) -(require "types.rkt" "build-runtime.rkt" - a86/interp) - -;; Asm -> Answer -(define (run is) - (parameterize ((current-objs (list runtime-path))) - (match (asm-interp is) - ['err 'err] - [b (bits->value b)]))) - -;; Asm String -> (cons Answer String) -(define (run/io is s) - (parameterize ((current-objs (list runtime-path))) - (match (asm-interp/io is s) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) diff --git a/mug/runtime.h b/mug/runtime.h deleted file mode 100644 index cf6a73c..0000000 --- a/mug/runtime.h +++ /dev/null @@ -1,15 +0,0 @@ -#ifndef RUNTIME_H -#define RUNTIME_H - -#include "values.h" - -val_t entry(val_t*); -extern FILE* in; -extern FILE* out; -extern void (*error_handler)(); - -// in words -#define heap_size 10000 -extern val_t *heap; - -#endif /* RUNTIME_H */ diff --git a/mug/runtime/Makefile b/mug/runtime/Makefile new file mode 100644 index 0000000..ee8ff93 --- /dev/null +++ b/mug/runtime/Makefile @@ -0,0 +1,29 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + values.o \ + print.o \ + io.o \ + symbol.o \ + error.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/mug/char.c b/mug/runtime/char.c similarity index 100% rename from mug/char.c rename to mug/runtime/char.c diff --git a/mug/runtime/error.c b/mug/runtime/error.c new file mode 100644 index 0000000..69a535a --- /dev/null +++ b/mug/runtime/error.c @@ -0,0 +1,9 @@ +#include +#include +#include "runtime.h" + +_Noreturn void raise_error(void) +{ + printf("err\n"); + exit(1); +} diff --git a/mug/heap.h b/mug/runtime/heap.h similarity index 100% rename from mug/heap.h rename to mug/runtime/heap.h diff --git a/mug/io.c b/mug/runtime/io.c similarity index 50% rename from mug/io.c rename to mug/runtime/io.c index 7ef8228..9f1fc45 100644 --- a/mug/io.c +++ b/mug/runtime/io.c @@ -1,25 +1,25 @@ #include -#include -#include "types.h" +#include #include "values.h" #include "runtime.h" val_t read_byte(void) { - char c = getc(in); - return (c == EOF) ? val_wrap_eof() : val_wrap_int(c); + int c = getc(stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_int(c); } val_t peek_byte(void) { - char c = getc(in); - ungetc(c, in); + int c = getc(stdin); + if (c != EOF) + ungetc(c, stdin); return (c == EOF) ? val_wrap_eof() : val_wrap_int(c); - } val_t write_byte(val_t c) { - putc((char) val_unwrap_int(c), out); + int b = val_unwrap_int(c); + putc((unsigned char)b, stdout); return val_wrap_void(); } diff --git a/mug/runtime/main.c b/mug/runtime/main.c new file mode 100644 index 0000000..610b2bf --- /dev/null +++ b/mug/runtime/main.c @@ -0,0 +1,26 @@ +#include +#include +#include "values.h" +#include "print.h" +#include "runtime.h" + +/* in words */ +#define heap_size 10000 + +int main(int argc, char **argv) +{ + val_t *heap = malloc(8 * heap_size); + if (!heap) { + fprintf(stderr, "out of memory\n"); + return 1; + } + + val_t result = entry(heap); + + print_result(result); + if (val_typeof(result) != T_VOID) + putchar('\n'); + + free(heap); + return 0; +} diff --git a/mug/print.c b/mug/runtime/print.c similarity index 98% rename from mug/print.c rename to mug/runtime/print.c index 2bcb21d..1a9f8a7 100644 --- a/mug/print.c +++ b/mug/runtime/print.c @@ -8,6 +8,7 @@ void print_cons(val_cons_t *); void print_vect(val_vect_t*); void print_str(val_str_t*); void print_symb(val_symb_t*); +void print_struct(val_struct_t *); void print_str_char(val_char_t); void print_result_interior(val_t); int utf8_encode_char(val_char_t, char *); @@ -48,11 +49,20 @@ void print_result(val_t x) case T_PROC: printf("#"); break; + case T_STRUCT: + print_struct(val_unwrap_struct(x)); + break; case T_INVALID: printf("internal error"); } } +void print_struct(val_struct_t *s) { + printf("#<"); + print_result_interior(s->name); + printf(">"); +} + void print_symb(val_symb_t *s) { print_str((val_str_t*) s); diff --git a/mug/print.h b/mug/runtime/print.h similarity index 100% rename from mug/print.h rename to mug/runtime/print.h diff --git a/mug/runtime/runtime.h b/mug/runtime/runtime.h new file mode 100644 index 0000000..2ec5ef1 --- /dev/null +++ b/mug/runtime/runtime.h @@ -0,0 +1,27 @@ +#ifndef RUNTIME_H +#define RUNTIME_H + +#include "values.h" + +/* + * Entry point for compiled programs. + * + * The caller supplies the heap pointer. Compiled code may use this as its + * initial allocation pointer / runtime heap base according to the language's + * calling convention. + */ +val_t entry(val_t *heap); + +/* + * Language-facing runtime operations used by compiled code. + * + * These are implemented by the runtime core, typically in terms of lower-level + * host hooks declared in host.h. + */ +val_t read_byte(void); +val_t peek_byte(void); +val_t write_byte(val_t); + +_Noreturn void raise_error(void); + +#endif /* RUNTIME_H */ diff --git a/mug/symbol.c b/mug/runtime/symbol.c similarity index 100% rename from mug/symbol.c rename to mug/runtime/symbol.c diff --git a/mug/types.h b/mug/runtime/types.h similarity index 65% rename from mug/types.h rename to mug/runtime/types.h index 4093c4f..084310e 100644 --- a/mug/types.h +++ b/mug/runtime/types.h @@ -2,41 +2,51 @@ #define TYPES_H /* - Bit layout of values + * Bit layout of runtime values + * + * Values are either: + * - immediates, tagged with low bits ending in #b000 + * - pointers, tagged with one of the pointer tags below + * + * Immediates include: + * - integers + * - characters + * - booleans + * - eof + * - void + * - empty list + */ - Values are either: - - Immediates: end in #b000 - - Pointers - - Immediates are either - - Integers: end in #b0 000 - - Characters: end in #b01 000 - - True: #b11 000 - - False: #b1 11 000 - - Eof: #b10 11 000 - - Void: #b11 11 000 - - Empty: #b100 11 000 -*/ +/* low bits reserved for pointer/immediate discrimination */ #define imm_shift 3 #define ptr_type_mask ((1 << imm_shift) - 1) + +/* pointer tags */ #define box_type_tag 1 #define cons_type_tag 2 #define vect_type_tag 3 #define str_type_tag 4 #define proc_type_tag 5 #define symb_type_tag 6 +#define struct_type_tag 7 + +/* integer immediates */ #define int_shift (1 + imm_shift) #define int_type_mask ((1 << int_shift) - 1) #define int_type_tag (0 << (int_shift - 1)) #define nonint_type_tag (1 << (int_shift - 1)) + +/* character immediates */ #define char_shift (int_shift + 1) #define char_type_mask ((1 << char_shift) - 1) #define char_type_tag ((0 << (char_shift - 1)) | nonint_type_tag) #define nonchar_type_tag ((1 << (char_shift - 1)) | nonint_type_tag) + +/* distinguished immediate constants */ #define val_true ((0 << char_shift) | nonchar_type_tag) #define val_false ((1 << char_shift) | nonchar_type_tag) #define val_eof ((2 << char_shift) | nonchar_type_tag) #define val_void ((3 << char_shift) | nonchar_type_tag) #define val_empty ((4 << char_shift) | nonchar_type_tag) -#endif +#endif /* TYPES_H */ diff --git a/mug/runtime/types.rkt b/mug/runtime/types.rkt new file mode 100644 index 0000000..79c8486 --- /dev/null +++ b/mug/runtime/types.rkt @@ -0,0 +1,64 @@ +#lang racket +(provide (all-defined-out)) + +(define imm-shift 3) +(define imm-mask #b111) +(define ptr-mask #b111) +(define type-box #b001) +(define type-cons #b010) +(define type-vect #b011) +(define type-str #b100) +(define type-proc #b101) +(define type-symb #b110) +(define type-bint #b110) +(define int-shift (+ 1 imm-shift)) +(define mask-int #b1111) +(define char-shift (+ 2 imm-shift)) +(define type-int #b0000) +(define type-char #b01000) +(define mask-char #b11111) + +;; Value -> Integer +;; v must be an immediate +(define (value->bits v) + (cond [(eq? v #t) #b00011000] + [(eq? v #f) #b00111000] + [(eq? v eof) #b01011000] + [(eq? v (void)) #b01111000] + [(eq? v '()) #b10011000] + [(integer? v) (arithmetic-shift v int-shift)] + [(char? v) + (bitwise-ior type-char + (arithmetic-shift (char->integer v) char-shift))] + [else (error "not an immediate value" v)])) + +(define (int-bits? v) + (= type-int (bitwise-and v mask-int))) + +(define (char-bits? v) + (= type-char (bitwise-and v mask-char))) + +(define (imm-bits? v) + (zero? (bitwise-and v imm-mask))) + +(define (cons-bits? v) + (= type-cons (bitwise-and v imm-mask))) + +(define (box-bits? v) + (= type-box (bitwise-and v imm-mask))) + +(define (vect-bits? v) + (= type-vect (bitwise-and v imm-mask))) + +(define (str-bits? v) + (= type-str (bitwise-and v imm-mask))) + +(define (bignum-bits? v) + (= type-bint (bitwise-and v imm-mask))) + +(define (proc-bits? v) + (= type-proc (bitwise-and v imm-mask))) + +(define (symb-bits? v) + (= type-symb (bitwise-and v imm-mask))) + diff --git a/mug/values.c b/mug/runtime/values.c similarity index 90% rename from mug/values.c rename to mug/runtime/values.c index 32e922b..6627fc2 100644 --- a/mug/values.c +++ b/mug/runtime/values.c @@ -16,6 +16,8 @@ type_t val_typeof(val_t x) return T_SYMB; case proc_type_tag: return T_PROC; + case struct_type_tag: + return T_STRUCT; } if ((int_type_mask & x) == int_type_tag) @@ -119,3 +121,12 @@ val_t val_wrap_symb(val_symb_t *v) { return ((val_t)v) | symb_type_tag; } + +val_struct_t* val_unwrap_struct(val_t x) +{ + return (val_struct_t *)(x ^ struct_type_tag); +} +val_t val_wrap_struct(val_struct_t* v) +{ + return ((val_t)v) | struct_type_tag; +} diff --git a/mug/runtime/values.h b/mug/runtime/values.h new file mode 100644 index 0000000..5c41275 --- /dev/null +++ b/mug/runtime/values.h @@ -0,0 +1,119 @@ +#ifndef VALUES_H +#define VALUES_H + +#include + +/* + * Abstract runtime value. + * + * All language values are represented as a tagged 64-bit word. + */ +typedef int64_t val_t; + +/* + * Dynamic type tags used by the runtime and printing code. + */ +typedef enum type_t { + T_INVALID = -1, + + /* immediates */ + T_INT, + T_BOOL, + T_CHAR, + T_EOF, + T_VOID, + T_EMPTY, + + /* heap objects */ + T_BOX, + T_CONS, + T_VECT, + T_STR, + T_SYMB, + T_PROC, + T_STRUCT, +} type_t; + +typedef uint32_t val_char_t; + +/* + * Heap object layouts. + * + * These layouts correspond to the pointer-tagged representations in types.h. + */ +typedef struct val_box_t { + val_t val; +} val_box_t; + +typedef struct val_cons_t { + val_t snd; + val_t fst; +} val_cons_t; + +typedef struct val_vect_t { + uint64_t len; + val_t elems[]; +} val_vect_t; + +typedef struct val_str_t { + uint64_t len; + val_char_t codepoints[]; +} val_str_t; + +typedef struct val_symb_t { + uint64_t len; + val_char_t codepoints[]; +} val_symb_t; + +typedef struct val_struct_t { + val_t name; + val_t *vals; +} val_struct_t; + +/* + * Classify a runtime value. + */ +type_t val_typeof(val_t x); + +/* + * Wrap/unwrap operations. + * + * The behavior of unwrap functions is undefined on type mismatch. + */ + +/* integers */ +int64_t val_unwrap_int(val_t x); +val_t val_wrap_int(int64_t i); + +/* booleans */ +int val_unwrap_bool(val_t x); +val_t val_wrap_bool(int b); + +/* characters */ +val_char_t val_unwrap_char(val_t x); +val_t val_wrap_char(val_char_t c); + +/* special values */ +val_t val_wrap_eof(void); +val_t val_wrap_void(void); + +/* heap objects */ +val_box_t *val_unwrap_box(val_t x); +val_t val_wrap_box(val_box_t *b); + +val_cons_t *val_unwrap_cons(val_t x); +val_t val_wrap_cons(val_cons_t *c); + +val_vect_t *val_unwrap_vect(val_t x); +val_t val_wrap_vect(val_vect_t *v); + +val_str_t *val_unwrap_str(val_t x); +val_t val_wrap_str(val_str_t *v); + +val_symb_t *val_unwrap_symb(val_t x); +val_t val_wrap_symb(val_symb_t *v); + +val_struct_t *val_unwrap_struct(val_t x); +val_t val_wrap_struct(val_struct_t *v); + +#endif /* VALUES_H */ diff --git a/mug/syntax/ast.rkt b/mug/syntax/ast.rkt new file mode 100644 index 0000000..8330791 --- /dev/null +++ b/mug/syntax/ast.rkt @@ -0,0 +1,75 @@ +#lang racket +(provide Lit Prim0 Prim1 Prim2 Prim3 If + Eof Begin + Let Var Prog Defn App + Match Box Cons Conj + Lam) + +;; type Prog = (Prog (Listof Defn) Expr) +(struct Prog (ds e) #:prefab) + +;; type Defn = (Defn Id (Listof Id) Expr) +(struct Defn (f xs e) #:prefab) +;; type Expr = (Lit Datum) +;; | (Eof) +;; | (Prim0 Op0) +;; | (Prim1 Op1 Expr) +;; | (Prim2 Op2 Expr Expr) +;; | (Prim3 Op3 Expr Expr Expr) +;; | (If Expr Expr Expr) +;; | (Begin Expr Expr) +;; | (Let Id Expr Expr) +;; | (Var Id) +;; | (App Expr (Listof Expr)) +;; | (Match Expr (Listof Pat) (Listof Expr)) +;; | (Lam Id (Listof Id) Expr) + +;; type ClosedExpr = { e ∈ Expr | e contains no free variables } + +;; type Id = Symbol +;; type Datum = Integer +;; | Boolean +;; | Character +;; | '() +;; | String +;; | Symbol +;; type Op0 = 'read-byte | 'peek-byte | 'void +;; type Op1 = 'add1 | 'sub1 +;; | 'zero? +;; | 'char? | 'integer->char | 'char->integer +;; | 'write-byte | 'eof-object? +;; | 'car | 'cdr | 'unbox +;; | 'empty? | 'cons? | 'box? +;; | 'box +;; | 'vector? | 'vector-length +;; | 'string? | 'string-length +;; | 'symbol? | 'symbol->string | 'string->symbol | 'string->uninterned-symbol +;; type Op2 = '+ | '- | '< | '= +;; | 'eq? | 'cons +;; | 'make-vector | 'vector-ref +;; | 'make-string | 'string-ref +;; type Op3 = 'vector-set! +;; type Pat = (Var Id) +;; | (Lit Datum) +;; | (Box Pat) +;; | (Cons Pat Pat) +;; | (Conj Pat Pat) + +(struct Eof () #:prefab) +(struct Lit (d) #:prefab) +(struct Prim0 (p) #:prefab) +(struct Prim1 (p e) #:prefab) +(struct Prim2 (p e1 e2) #:prefab) +(struct Prim3 (p e1 e2 e3) #:prefab) +(struct If (e1 e2 e3) #:prefab) +(struct Begin (e1 e2) #:prefab) +(struct Let (x e1 e2) #:prefab) +(struct Var (x) #:prefab) +(struct App (f es) #:prefab) +(struct Lam (f xs e) #:prefab) +(struct Match (e ps es) #:prefab) + +(struct Box (p) #:prefab) +(struct Cons (p1 p2) #:prefab) +(struct Conj (p1 p2) #:prefab) + diff --git a/mug/fv.rkt b/mug/syntax/fv.rkt similarity index 83% rename from mug/fv.rkt rename to mug/syntax/fv.rkt index 2377b7e..1cec0d9 100644 --- a/mug/fv.rkt +++ b/mug/syntax/fv.rkt @@ -28,8 +28,9 @@ ;; Pat -> [Listof Id] (define (bv-pat* p) (match p - [(PVar x) (list x)] - [(PCons p1 p2) (append (bv-pat* p1) (bv-pat* p2))] - [(PAnd p1 p2) (append (bv-pat* p1) (bv-pat* p2))] - [(PBox p) (bv-pat* p)] - [_ '()])) + [(Var x) (list x)] + [(Lit d) '()] + [(Box p) (bv-pat* p)] + [(Cons p1 p2) (append (bv-pat* p1) (bv-pat* p2))] + [(Conj p1 p2) (append (bv-pat* p1) (bv-pat* p2))])) + diff --git a/mug/lambdas.rkt b/mug/syntax/lambdas.rkt similarity index 100% rename from mug/lambdas.rkt rename to mug/syntax/lambdas.rkt index 0a24640..83c5aa8 100644 --- a/mug/lambdas.rkt +++ b/mug/syntax/lambdas.rkt @@ -2,7 +2,6 @@ (require "ast.rkt") (provide lambdas) - ;; Prog -> [Listof Lam] ;; List all of the lambda expressions in p (define (lambdas p) @@ -33,3 +32,4 @@ [(Lam f xs e1) (cons e (lambdas-e e1))] [(Match e ps es) (append (lambdas-e e) (append-map lambdas-e es))] [_ '()])) + diff --git a/mug/compile-literals.rkt b/mug/syntax/literals.rkt similarity index 53% rename from mug/compile-literals.rkt rename to mug/syntax/literals.rkt index 0435961..2ffec7e 100644 --- a/mug/compile-literals.rkt +++ b/mug/syntax/literals.rkt @@ -1,38 +1,8 @@ #lang racket -(provide compile-literals init-symbol-table literals compile-string-chars) -(require "ast.rkt" - "utils.rkt" - a86/ast) +(provide literals symbols) -(define rdi 'rdi) +(require "ast.rkt") -;; Prog -> Asm -(define (compile-literals p) - (append-map compile-literal (literals p))) - -;; Symbol -> Asm -(define (compile-literal s) - (let ((str (symbol->string s))) - (seq (Label (symbol->data-label s)) - (Dq (string-length str)) - (compile-string-chars (string->list str)) - (if (odd? (string-length str)) - (seq (Dd 0)) - (seq))))) - -;; Prog -> Asm -;; Call intern_symbol on every symbol in the program -(define (init-symbol-table p) - (match (symbols p) - ['() (seq)] - [ss (seq (Sub 'rsp 8) - (append-map init-symbol ss) - (Add 'rsp 8))])) - -;; Symbol -> Asm -(define (init-symbol s) - (seq (Lea rdi (symbol->data-label s)) - (Call 'intern_symbol))) ;; Prog -> [Listof Symbol] (define (literals p) @@ -64,8 +34,9 @@ ;; Expr -> [Listof (U Symbol String)] (define (literals-e e) (match e - [(Str s) (list s)] - [(Symb s) (list s)] + [(Lit (? symbol? s)) (list s)] + [(Lit (? string? s)) (list s)] + [(Lit _) '()] [(Prim1 p e) (literals-e e)] [(Prim2 p e1 e2) @@ -93,17 +64,10 @@ ;; Pat -> [Listof (U Symbol String)] (define (literals-pat p) (match p - [(PSymb s) (list s)] - [(PStr s) (list s)] - [(PBox p) (literals-pat p)] - [(PCons p1 p2) (append (literals-pat p1) (literals-pat p2))] - [(PAnd p1 p2) (append (literals-pat p1) (literals-pat p2))] + [(Lit (? symbol? s)) (list s)] + [(Lit (? string? s)) (list s)] + [(Box p) (literals-pat p)] + [(Cons p1 p2) (append (literals-pat p1) (literals-pat p2))] + [(Conj p1 p2) (append (literals-pat p1) (literals-pat p2))] [_ '()])) -;; [Listof Char] -> Asm -(define (compile-string-chars cs) - (match cs - ['() (seq)] - [(cons c cs) - (seq (Dd (char->integer c)) - (compile-string-chars cs))])) diff --git a/mug/syntax/parse.rkt b/mug/syntax/parse.rkt new file mode 100644 index 0000000..c8a8a0f --- /dev/null +++ b/mug/syntax/parse.rkt @@ -0,0 +1,270 @@ +#lang racket +(provide parse parse-closed parse-e parse-define parse-pattern) +(require "ast.rkt") + +;; [Listof S-Expr] -> Prog +(define (parse . ss) + (match (parse-prog ss (parse-defn-names ss) '()) + [(list _ p) p])) + +;; [Listof S-Expr] -> ClosedProg +(define (parse-closed . ss) + (match (parse-prog ss (parse-defn-names ss) '()) + [(list '() p) p] + [(list ys p) (error "undefined identifiers" ys)])) + +;; S-Expr -> Expr +;; Parse a (potentially open) expression +(define (parse-e s) + (match (parse-e/acc s '() '()) + [(list _ e) e])) + +;; S-Expr -> Expr +;; Parse a (potentially open) definition +(define (parse-define s) + (match (parse-define/acc s '() '()) + [(list _ d) d])) + +;; S-Expr -> Pat +;; Parse a (potentially open) pattern +(define (parse-pattern s) + (match (parse-match-pattern/acc s '() '()) + [(list _ _ p) p])) + +;; S-Expr -> r:[Listof Id] +;; where: (distinct? r) +;; Extracts defined function names from given program-like s-expr +;; Does not fully parse definition +;; Example: +;; (parse-defn-names '((define (f x) x) (define (g y) y) 1) -> '(f g) +(define (parse-defn-names ss) + (define (rec ss fs) + (match ss + [(list s) fs] + [(cons (cons (? (not-in fs) 'define) sd) sr) + (match (parse-defn-name sd) + [f (if (memq f fs) + (error "duplicate definition" f) + (rec sr (cons f fs)))])] + [_ (error "parse error")])) + (rec ss '())) + +(define (parse-defn-name s) + (match s + [(cons (cons (? symbol? f) _) _) f] + [_ (error "parse error")])) +;; S-Expr [Listof Id] [Listof Id] -> (list [Listof Id] Prog) +;; s: program shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables and parse of program +(define (parse-prog s xs ys) + (match s + [(list s) + (match (parse-e/acc s xs ys) + [(list ys e) + (list ys (Prog '() e))])] + [(cons s ss) + (match (parse-define/acc s xs ys) + [(list ys (and d (Defn f _ _))) + (match (parse-prog ss xs ys) + [(list ys (Prog ds e)) + (list ys (Prog (cons d ds) e))])])])) +;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] Defn) +;; s: definition shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables and parse of definition +(define (parse-define/acc s xs ys) + (match s + [(cons 'define sr) + (match sr + [(list (cons (? symbol? g) (and (list (? symbol? zs) ...) (? distinct?))) s) + (match (parse-e/acc s (cons g (append zs xs)) ys) + [(list ys e) + (list ys (Defn g zs e))])] + [_ (error "parse error")])] + [_ (error "parse error")])) +;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] Expr) +;; s: expression shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables and parse of expression +(define (parse-e/acc s xs ys) + (define (rec s xs ys) + (define ns xs) + (match s + [(and 'eof (? (not-in ns))) + (list ys (Eof))] + [(? datum?) + (list ys (Lit s))] + [(list (and 'quote (? (not-in ns))) (list)) + (list ys (Lit '()))] + [(list (and 'quote (? (not-in ns))) (? symbol? s)) + (list ys (Lit s))] + [(? symbol? f) + (if (memq s xs) + (list ys (Var s)) + (list (cons s ys) (Var s)))] + [(list-rest (? symbol? (? (not-in ns) k)) sr) + (match k + ['let + (match sr + [(list (list (list (? symbol? x) s1)) s2) + (match (rec s1 xs ys) + [(list ys e1) + (match (rec s2 (cons x xs) ys) + [(list ys e2) + (list ys (Let x e1 e2))])])] + [_ (error "let: bad syntax" s)])] + ['match + (match sr + [(cons s sr) + (match (rec s xs ys) + [(list ys e) + (match (parse-match-clauses/acc sr xs ys) + [(list ys ps es) + (list ys (Match e ps es))])])] + [_ (error "match: bad syntax" s)])] + + [(or 'λ 'lambda) + (match sr + [(list (and (list (? symbol? zs) ...) (? distinct?)) s) + (match (rec s (append zs xs) ys) + [(list ys e) + (list ys (Lam (gensym 'lambda) zs e))])] + [_ (error "lambda: bad syntax" s)])] + [_ + (match (parse-es/acc sr xs ys) + [(list ys es) + (match (cons k es) + [(list (? op0? o)) + (list ys (Prim0 o))] + [(list (? op1? o) e1) + (list ys (Prim1 o e1))] + [(list (? op2? o) e1 e2) + (list ys (Prim2 o e1 e2))] + [(list (? op3? o) e1 e2 e3) + (list ys (Prim3 o e1 e2 e3))] + [(list 'begin e1 e2) + (list ys (Begin e1 e2))] + [(list 'if e1 e2 e3) + (list ys (If e1 e2 e3))] + [(list-rest g es) + (list (cons g ys) (App (Var g) es))])])])] + [(cons s sr) + (match (parse-e/acc s xs ys) + [(list ys e) + (match (parse-es/acc sr xs ys) + [(list ys es) + (list ys (App e es))])])] + [_ + (error "parse error" s)])) + (rec s xs ys)) +;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] [Listof Expr]) +;; s: list of expressions shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables and parse of expressions +(define (parse-es/acc s xs ys) + (match s + ['() (list ys '())] + [(cons s ss) + (match (parse-e/acc s xs ys) + [(list ys e) + (match (parse-es/acc ss xs ys) + [(list ys es) + (list ys (cons e es))])])] + [_ (error "parse error")])) +;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] [Listof Expr]) +;; s: list of match clauses shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables and list of parsed clause patterns and clause expressions +(define (parse-match-clauses/acc sr xs ys) + (match sr + ['() (list ys '() '())] + [(cons (list sp se) sr) + (match (parse-match-pattern/acc sp xs ys) + [(list ys xs p) + (match (parse-e/acc se xs ys) + [(list ys e) + (match (parse-match-clauses/acc sr xs ys) + [(list ys ps es) + (list ys (cons p ps) (cons e es))])])])])) +;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] [Listof Id] Pat) +;; s: list of patterns shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables, bound variables, and parse of pattern +(define (parse-match-pattern/acc s xs ys) + (define (rec p xs ys) + (match p + [(? datum?) (list ys xs (Lit p))] + ['_ (list ys xs (Var '_))] + [(? symbol?) (list ys (cons p xs) (Var p))] + [(list 'quote '()) + (list ys xs (Lit '()))] + [(list 'quote (? symbol? s)) + (list ys xs (Lit s))] + [(list 'box s) + (match (rec s xs ys) + [(list ys xs p) + (list ys xs (Box p))])] + [(list 'cons s1 s2) + (match (rec s1 xs ys) + [(list ys xs p1) + (match (rec s2 xs ys) + [(list ys xs p2) + (list ys xs (Cons p1 p2))])])] + [(list 'and s1 s2) + (match (rec s1 xs ys) + [(list ys xs p1) + (match (rec s2 xs ys) + [(list ys xs p2) + (list ys xs (Conj p1 p2))])])] + [_ (error "parse pattern error")])) + (rec s xs ys)) + +;; [Listof Any] -> Boolean +(define (distinct? xs) + (not (check-duplicates xs))) + +;; xs:[Listof Any] -> p:(x:Any -> Boolean) +;; Produce a predicate p for things not in xs +(define (not-in xs) + (λ (x) (not (memq x xs)))) +(define (in m) + (λ (x) (memq x m))) + +;; Any -> Boolean +(define (self-quoting-datum? x) + (or (exact-integer? x) + (boolean? x) + (char? x) + (string? x))) + +;; Any -> Boolean +(define (datum? x) + (or (self-quoting-datum? x) + (empty? x))) + +;; Any -> Boolean +(define (op0? x) + (memq x '(read-byte peek-byte void))) + +(define (op1? x) + (memq x '(add1 sub1 zero? + char? integer->char char->integer + write-byte eof-object? + box unbox empty? cons? box? car cdr + vector? vector-length string? string-length + symbol? symbol->string string->symbol string->uninterned-symbol))) + +(define (op2? x) + (memq x '(+ - < = eq? cons + make-vector vector-ref make-string string-ref))) + +(define (op3? x) + (memq x '(vector-set!))) + diff --git a/mug/read-all.rkt b/mug/syntax/read-all.rkt similarity index 99% rename from mug/read-all.rkt rename to mug/syntax/read-all.rkt index 8a3289a..a83fe69 100644 --- a/mug/read-all.rkt +++ b/mug/syntax/read-all.rkt @@ -6,3 +6,4 @@ (if (eof-object? r) '() (cons r (read-all))))) + diff --git a/mug/test/build-runtime.rkt b/mug/test/build-runtime.rkt deleted file mode 100644 index 7023ee0..0000000 --- a/mug/test/build-runtime.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require a86/interp) - -;; link with runtime for IO operations -(unless (file-exists? "../runtime.o") - (system "make -C .. runtime.o")) -(current-objs - (list (path->string (normalize-path "../runtime.o")))) diff --git a/mug/test/compile.rkt b/mug/test/compile.rkt index ee289de..76fdb1a 100644 --- a/mug/test/compile.rkt +++ b/mug/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "test-runner.rkt" - "../parse.rkt" - "../compile.rkt" - "../run.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") +(require "test-runner.rkt") +(test (λ p (run (compile (apply parse-closed p))))) +(test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) -(test-runner (λ p (run (compile (parse p))))) -(test-runner-io (λ (s . p) (run/io (compile (parse p)) s))) diff --git a/mug/test/interp-defun.rkt b/mug/test/interp-defun.rkt deleted file mode 100644 index 68ef419..0000000 --- a/mug/test/interp-defun.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require "test-runner.rkt" - "../parse.rkt" - "../interp-defun.rkt" - "../interp-io.rkt") - -(define (closure->proc xs e r) - ;; Could make this better by calling the interpreter, - ;; but it's only used in tests where all we care about - ;; is that you get a procedure. - (lambda _ - (error "This function is not callable."))) - -(test-runner - (λ p - (match (interp (parse p)) - [(Closure xs e r) (closure->proc xs e r)] - [v v]))) -(test-runner-io - (λ (s . p) - (match (interp/io (parse p) s) - [(cons (Closure xs e r) o) - (cons (closure->proc xs e r) o)] - [r r]))) diff --git a/mug/test/interp.rkt b/mug/test/interp.rkt index cd7b654..823063f 100644 --- a/mug/test/interp.rkt +++ b/mug/test/interp.rkt @@ -1,8 +1,8 @@ #lang racket -(require "test-runner.rkt" - "../parse.rkt" - "../interp.rkt" - "../interp-io.rkt") +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") +(require "test-runner.rkt") +(test (λ p (interp (apply parse-closed p)))) +(test/io (λ (in . p) (interp/io (apply parse-closed p) in))) -(test-runner (λ p (interp (parse p)))) -(test-runner-io (λ (s . p) (interp/io (parse p) s))) diff --git a/mug/test/parse.rkt b/mug/test/parse.rkt new file mode 100644 index 0000000..e5f05ff --- /dev/null +++ b/mug/test/parse.rkt @@ -0,0 +1,82 @@ +#lang racket +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") +(require rackunit) + +(define (p e) + (Prog '() e)) + +(begin ; Abscond + (check-equal? (parse 42) (p (Lit 42))) + (check-equal? (parse -1) (p (Lit -1)))) +(begin ; Blackmail + (check-equal? (parse '(add1 42)) (p (Prim1 'add1 (Lit 42))))) +(begin ; Dupe + (check-equal? (parse '(if (zero? 1) 2 3)) + (p (If (Prim1 'zero? (Lit 1)) (Lit 2) (Lit 3)))) + (check-equal? (parse '(if #t 2 3)) + (p (If (Lit #t) (Lit 2) (Lit 3))))) +(begin ; Dodger + (check-equal? (parse #\a) (p (Lit #\a))) + (check-equal? (parse '(char->integer #\a)) + (p (Prim1 'char->integer (Lit #\a))))) +(begin ; Evildoer + (check-equal? (parse 'eof) (p (Eof))) + (check-equal? (parse '(void)) (p (Prim0 'void))) + (check-equal? (parse '(read-byte)) (p (Prim0 'read-byte)))) +(begin ; Fraud + (check-equal? (parse 'x) (p (Var 'x))) + (check-exn exn:fail? (λ () (parse-closed 'x))) + (check-equal? (parse '(+ 1 2)) + (p (Prim2 '+ (Lit 1) (Lit 2)))) + (check-equal? (parse '(let ((x 1)) x)) + (p (Let 'x (Lit 1) (Var 'x)))) + (check-equal? (parse-closed '(let ((x 1)) x)) + (p (Let 'x (Lit 1) (Var 'x)))) + (check-equal? (parse 'add1) (p (Var 'add1))) + (check-exn exn:fail? (λ () (parse-closed 'add1))) + (check-equal? (parse '(let ((let 1)) let)) + (p (Let 'let (Lit 1) (Var 'let)))) + (check-equal? (parse '(let ((if 1)) if)) + (p (Let 'if (Lit 1) (Var 'if))))) +(begin ; Hustle + (check-equal? (parse ''()) (p (Lit '()))) + (check-equal? (parse '(box 1)) (p (Prim1 'box (Lit 1)))) + (check-equal? (parse '(cons 1 2)) (p (Prim2 'cons (Lit 1) (Lit 2))))) +(begin ; Hoax + (check-equal? (parse "asdf") (p (Lit "asdf"))) + (check-equal? (parse '(make-string 10 #\a)) + (p (Prim2 'make-string (Lit 10) (Lit #\a))))) + +(begin ; Iniquity + (check-equal? (parse '(define (f x) x) 1) + (Prog (list (Defn 'f '(x) (Var 'x))) (Lit 1))) + (check-equal? (parse '(define (define) 0) '(define)) + (Prog (list (Defn 'define '() (Lit 0))) + (App (Var 'define) '()))) + (check-exn exn:fail? (λ () (parse '(define (f y y) y) 1))) + (check-equal? (parse-closed '(define (f x) (g x)) + '(define (g x) (f x)) + '(f 0)) + (Prog (list (Defn 'f '(x) (App (Var 'g) (list (Var 'x)))) + (Defn 'g '(x) (App (Var 'f) (list (Var 'x))))) + (App (Var 'f) (list (Lit 0)))))) +(begin ; Knock + (check-equal? (parse '(match 1)) + (p (Match (Lit 1) '() '()))) + (check-equal? (parse '(match 1 [_ #t])) + (p (Match (Lit 1) (list (Var '_)) (list (Lit #t))))) + (check-equal? (parse '(match 1 [x x])) + (p (Match (Lit 1) (list (Var 'x)) (list (Var 'x))))) + (check-equal? (parse-closed '(match 1 [x x])) + (p (Match (Lit 1) (list (Var 'x)) (list (Var 'x))))) + (check-equal? (parse '(match 1 [x y])) + (p (Match (Lit 1) (list (Var 'x)) (list (Var 'y))))) + (check-equal? (parse '(match x ['() 1])) + (p (Match (Var 'x) (list (Lit '())) (list (Lit 1))))) + (check-exn exn:fail? (λ () (parse-closed '(match 1 [x y]))))) + +(begin ; Loot + (check-equal? (parse '(f x)) + (p (App (Var 'f) (list (Var 'x)))))) + diff --git a/mug/test/test-runner.rkt b/mug/test/test-runner.rkt index d4d68ed..451f834 100644 --- a/mug/test/test-runner.rkt +++ b/mug/test/test-runner.rkt @@ -1,389 +1,420 @@ #lang racket -(provide test-runner test-runner-io) +(provide test test/io) (require rackunit) -(define (test-runner run) - ;; Abscond examples - (check-equal? (run 7) 7) - (check-equal? (run -8) -8) +(define (test run) + (begin ;; Abscond + (check-equal? (run 7) 7) + (check-equal? (run -8) -8)) - ;; Blackmail examples - (check-equal? (run '(add1 (add1 7))) 9) - (check-equal? (run '(add1 (sub1 7))) 7) + (begin ;; Blackmail + (check-equal? (run '(add1 (add1 7))) 9) + (check-equal? (run '(add1 (sub1 7))) 7)) - ;; Con examples - (check-equal? (run '(if (zero? 0) 1 2)) 1) - (check-equal? (run '(if (zero? 1) 1 2)) 2) - (check-equal? (run '(if (zero? -7) 1 2)) 2) - (check-equal? (run '(if (zero? 0) - (if (zero? 1) 1 2) - 7)) - 2) - (check-equal? (run '(if (zero? (if (zero? 0) 1 0)) - (if (zero? 1) 1 2) - 7)) - 7) + (begin ;; Con + (check-equal? (run '(if (zero? 0) 1 2)) 1) + (check-equal? (run '(if (zero? 1) 1 2)) 2) + (check-equal? (run '(if (zero? -7) 1 2)) 2) + (check-equal? (run '(if (zero? 0) + (if (zero? 1) 1 2) + 7)) + 2) + (check-equal? (run '(if (zero? (if (zero? 0) 1 0)) + (if (zero? 1) 1 2) + 7)) + 7)) - ;; Dupe examples - (check-equal? (run #t) #t) - (check-equal? (run #f) #f) - (check-equal? (run '(if #t 1 2)) 1) - (check-equal? (run '(if #f 1 2)) 2) - (check-equal? (run '(if 0 1 2)) 1) - (check-equal? (run '(if #t 3 4)) 3) - (check-equal? (run '(if #f 3 4)) 4) - (check-equal? (run '(if 0 3 4)) 3) - (check-equal? (run '(zero? 4)) #f) - (check-equal? (run '(zero? 0)) #t) + (begin ;; Dupe + (check-equal? (run #t) #t) + (check-equal? (run #f) #f) + (check-equal? (run '(if #t 1 2)) 1) + (check-equal? (run '(if #f 1 2)) 2) + (check-equal? (run '(if 0 1 2)) 1) + (check-equal? (run '(if #t 3 4)) 3) + (check-equal? (run '(if #f 3 4)) 4) + (check-equal? (run '(if 0 3 4)) 3) + (check-equal? (run '(zero? 4)) #f) + (check-equal? (run '(zero? 0)) #t)) - ;; Dodger examples - (check-equal? (run #\a) #\a) - (check-equal? (run #\b) #\b) - (check-equal? (run '(char? #\a)) #t) - (check-equal? (run '(char? #t)) #f) - (check-equal? (run '(char? 8)) #f) - (check-equal? (run '(char->integer #\a)) (char->integer #\a)) - (check-equal? (run '(integer->char 955)) #\λ) + (begin ;; Dodger + (check-equal? (run #\a) #\a) + (check-equal? (run #\b) #\b) + (check-equal? (run '(char? #\a)) #t) + (check-equal? (run '(char? #t)) #f) + (check-equal? (run '(char? 8)) #f) + (check-equal? (run '(char->integer #\a)) (char->integer #\a)) + (check-equal? (run '(integer->char 955)) #\λ)) - ;; Extort examples - (check-equal? (run '(add1 #f)) 'err) - (check-equal? (run '(sub1 #f)) 'err) - (check-equal? (run '(zero? #f)) 'err) - (check-equal? (run '(char->integer #f)) 'err) - (check-equal? (run '(integer->char #f)) 'err) - (check-equal? (run '(integer->char -1)) 'err) - (check-equal? (run '(write-byte #f)) 'err) - (check-equal? (run '(write-byte -1)) 'err) - (check-equal? (run '(write-byte 256)) 'err) + (begin ;; Evildoer + (check-equal? (run '(void)) (void)) + (check-equal? (run '(begin 1 2)) 2) + (check-equal? (run '(eof-object? (void))) #f)) - ;; Fraud examples - (check-equal? (run '(let ((x 7)) x)) 7) - (check-equal? (run '(let ((x 7)) 2)) 2) - (check-equal? (run '(let ((x 7)) (add1 x))) 8) - (check-equal? (run '(let ((x (add1 7))) x)) 8) - (check-equal? (run '(let ((x 7)) (let ((y 2)) x))) 7) - (check-equal? (run '(let ((x 7)) (let ((x 2)) x))) 2) - (check-equal? (run '(let ((x 7)) (let ((x (add1 x))) x))) 8) + (begin ;; Extort + (check-equal? (run '(add1 #f)) 'err) + (check-equal? (run '(sub1 #f)) 'err) + (check-equal? (run '(zero? #f)) 'err) + (check-equal? (run '(char->integer #f)) 'err) + (check-equal? (run '(integer->char #f)) 'err) + (check-equal? (run '(integer->char -1)) 'err) + (check-equal? (run '(write-byte #f)) 'err) + (check-equal? (run '(write-byte -1)) 'err) + (check-equal? (run '(write-byte 256)) 'err) + (check-equal? (run '(begin (integer->char 97) + (integer->char 98))) + #\b)) - (check-equal? (run '(let ((x 0)) - (if (zero? x) 7 8))) - 7) - (check-equal? (run '(let ((x 1)) - (add1 (if (zero? x) 7 8)))) - 9) - (check-equal? (run '(+ 3 4)) 7) - (check-equal? (run '(- 3 4)) -1) - (check-equal? (run '(+ (+ 2 1) 4)) 7) - (check-equal? (run '(+ (+ 2 1) (+ 2 2))) 7) - (check-equal? (run '(let ((x (+ 1 2))) - (let ((z (- 4 x))) - (+ (+ x x) z)))) - 7) - (check-equal? (run '(= 5 5)) #t) - (check-equal? (run '(= 4 5)) #f) - (check-equal? (run '(= (add1 4) 5)) #t) - (check-equal? (run '(< 5 5)) #f) - (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f) - - ;; Hustle examples - (check-equal? (run ''()) '()) - (check-equal? (run '(box 1)) (box 1)) - (check-equal? (run '(box -1)) (box -1)) - (check-equal? (run '(cons 1 2)) (cons 1 2)) - (check-equal? (run '(unbox (box 1))) 1) - (check-equal? (run '(car (cons 1 2))) 1) - (check-equal? (run '(cdr (cons 1 2))) 2) - (check-equal? (run '(cons 1 '())) (list 1)) - (check-equal? (run '(let ((x (cons 1 2))) - (begin (cdr x) - (car x)))) - 1) - (check-equal? (run '(let ((x (cons 1 2))) - (let ((y (box 3))) - (unbox y)))) - 3) - (check-equal? (run '(eq? 1 1)) #t) - (check-equal? (run '(eq? 1 2)) #f) - (check-equal? (run '(eq? (cons 1 2) (cons 1 2))) #f) - (check-equal? (run '(let ((x (cons 1 2))) (eq? x x))) #t) + (begin ;; Fraud + (check-equal? (run '(let ((x 7)) x)) 7) + (check-equal? (run '(let ((x 7)) 2)) 2) + (check-equal? (run '(let ((x 7)) (add1 x))) 8) + (check-equal? (run '(let ((x (add1 7))) x)) 8) + (check-equal? (run '(let ((x 7)) (let ((y 2)) x))) 7) + (check-equal? (run '(let ((x 7)) (let ((x 2)) x))) 2) + (check-equal? (run '(let ((x 7)) (let ((x (add1 x))) x))) 8) - ;; Hoax examples - (check-equal? (run '(make-vector 0 0)) #()) - (check-equal? (run '(make-vector 1 0)) #(0)) - (check-equal? (run '(make-vector 3 0)) #(0 0 0)) - (check-equal? (run '(make-vector 3 5)) #(5 5 5)) - (check-equal? (run '(vector? (make-vector 0 0))) #t) - (check-equal? (run '(vector? (cons 0 0))) #f) - (check-equal? (run '(vector-ref (make-vector 0 #f) 0)) 'err) - (check-equal? (run '(vector-ref (make-vector 3 5) -1)) 'err) - (check-equal? (run '(vector-ref (make-vector 3 5) 0)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 1)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 2)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 3)) 'err) - (check-equal? (run '(let ((x (make-vector 3 5))) - (begin (vector-set! x 0 4) - x))) - #(4 5 5)) - (check-equal? (run '(let ((x (make-vector 3 5))) - (begin (vector-set! x 1 4) - x))) - #(5 4 5)) - (check-equal? (run '(vector-length (make-vector 3 #f))) 3) - (check-equal? (run '(vector-length (make-vector 0 #f))) 0) - (check-equal? (run '"") "") - (check-equal? (run '"fred") "fred") - (check-equal? (run '"wilma") "wilma") - (check-equal? (run '(make-string 0 #\f)) "") - (check-equal? (run '(make-string 3 #\f)) "fff") - (check-equal? (run '(make-string 3 #\g)) "ggg") - (check-equal? (run '(string-length "")) 0) - (check-equal? (run '(string-length "fred")) 4) - (check-equal? (run '(string-ref "" 0)) 'err) - (check-equal? (run '(string-ref (make-string 0 #\a) 0)) 'err) - (check-equal? (run '(string-ref "fred" 0)) #\f) - (check-equal? (run '(string-ref "fred" 1)) #\r) - (check-equal? (run '(string-ref "fred" 2)) #\e) - (check-equal? (run '(string-ref "fred" 4)) 'err) - (check-equal? (run '(string? "fred")) #t) - (check-equal? (run '(string? (cons 1 2))) #f) - (check-equal? (run '(begin (make-string 3 #\f) - (make-string 3 #\f))) - "fff") + (check-equal? (run '(let ((x 0)) + (if (zero? x) 7 8))) + 7) + (check-equal? (run '(let ((x 1)) + (add1 (if (zero? x) 7 8)))) + 9) + (check-equal? (run '(+ 3 4)) 7) + (check-equal? (run '(- 3 4)) -1) + (check-equal? (run '(+ (+ 2 1) 4)) 7) + (check-equal? (run '(+ (+ 2 1) (+ 2 2))) 7) + (check-equal? (run '(let ((x (+ 1 2))) + (let ((z (- 4 x))) + (+ (+ x x) z)))) + 7) - ;; Iniquity tests - (check-equal? (run - '(define (f x) x) - '(f 5)) - 5) + (check-equal? (run '(= 5 5)) #t) + (check-equal? (run '(= 4 5)) #f) + (check-equal? (run '(= (add1 4) 5)) #t) + (check-equal? (run '(< 5 5)) #f) + (check-equal? (run '(< 4 5)) #t) + (check-equal? (run '(< (add1 4) 5)) #f)) - (check-equal? (run - '(define (tri x) - (if (zero? x) - 0 - (+ x (tri (sub1 x))))) - '(tri 9)) - 45) + (begin ;; Hustle + (check-equal? (run '(empty? (cons 1 2))) #f) + (check-equal? (run '(box 1)) (box 1)) + (check-equal? (run '(box -1)) (box -1)) + (check-equal? (run '(cons 1 2)) (cons 1 2)) + (check-equal? (run '(unbox (box 1))) 1) + (check-equal? (run '(car (cons 1 2))) 1) + (check-equal? (run '(cdr (cons 1 2))) 2) + (check-equal? (run '(cons 1 '())) (list 1)) + (check-equal? (run '(let ((x (cons 1 2))) + (begin (cdr x) + (car x)))) + 1) + (check-equal? (run '(let ((x (cons 1 2))) + (let ((y (box 3))) + (unbox y)))) + 3) + (check-equal? (run '(eq? 1 1)) #t) + (check-equal? (run '(eq? 1 2)) #f) + (check-equal? (run '(eq? (cons 1 2) (cons 1 2))) #f) + (check-equal? (run '(let ((x (cons 1 2))) (eq? x x))) #t)) - (check-equal? (run - '(define (f x) x) - '(define (g x) (f x)) - '(g 5)) - 5) - (check-equal? (run - '(define (even? x) - (if (zero? x) - #t - (odd? (sub1 x)))) - '(define (odd? x) - (if (zero? x) - #f - (even? (sub1 x)))) - '(even? 101)) - #f) - (check-equal? (run - '(define (map-add1 xs) - (if (empty? xs) - '() - (cons (add1 (car xs)) - (map-add1 (cdr xs))))) - '(map-add1 (cons 1 (cons 2 (cons 3 '()))))) - '(2 3 4)) - (check-equal? (run - '(define (f x) - 10) - '(f 1)) - 10) - (check-equal? (run - '(define (f x) - 10) - '(let ((x 2)) (f 1))) - 10) - (check-equal? (run - '(define (f x y) - 10) - '(f 1 2)) - 10) - (check-equal? (run - '(define (f x y) - 10) - '(let ((z 2)) (f 1 2))) - 10) - (check-equal? (run '(define (f x y) y) - '(f 1 (add1 #f))) - 'err) + (begin ;; Hoax + (check-equal? (run '(make-vector 0 0)) #()) + (check-equal? (run '(make-vector 1 0)) #(0)) + (check-equal? (run '(make-vector 3 0)) #(0 0 0)) + (check-equal? (run '(make-vector 3 5)) #(5 5 5)) + (check-equal? (run '(vector? (make-vector 0 0))) #t) + (check-equal? (run '(vector? (cons 0 0))) #f) + (check-equal? (run '(vector-ref (make-vector 0 #f) 0)) 'err) + (check-equal? (run '(vector-ref (make-vector 3 5) -1)) 'err) + (check-equal? (run '(vector-ref (make-vector 3 5) 0)) 5) + (check-equal? (run '(vector-ref (make-vector 3 5) 1)) 5) + (check-equal? (run '(vector-ref (make-vector 3 5) 2)) 5) + (check-equal? (run '(vector-ref (make-vector 3 5) 3)) 'err) + (check-equal? (run '(let ((x (make-vector 3 5))) + (begin (vector-set! x 0 4) + x))) + #(4 5 5)) + (check-equal? (run '(let ((x (make-vector 3 5))) + (begin (vector-set! x 1 4) + x))) + #(5 4 5)) + (check-equal? (run '(let ((x (make-vector 3 5))) + (begin (vector-set! x 3 4) + x))) + 'err) + (check-equal? (run '(vector-length (make-vector 3 #f))) 3) + (check-equal? (run '(vector-length (make-vector 0 #f))) 0) + (check-equal? (run '"") "") + (check-equal? (run '"fred") "fred") + (check-equal? (run '"wilma") "wilma") + (check-equal? (run '(make-string 0 #t)) 'err) + (check-equal? (run '(make-string 0 #\f)) "") + (check-equal? (run '(make-string 3 #\f)) "fff") + (check-equal? (run '(make-string 3 #\g)) "ggg") + (check-equal? (run '(string-length "")) 0) + (check-equal? (run '(string-length "fred")) 4) + (check-equal? (run '(string-ref "" 0)) 'err) + (check-equal? (run '(string-ref (make-string 0 #\a) 0)) 'err) + (check-equal? (run '(string-ref "fred" 0)) #\f) + (check-equal? (run '(string-ref "fred" 1)) #\r) + (check-equal? (run '(string-ref "fred" 2)) #\e) + (check-equal? (run '(string-ref "fred" 4)) 'err) + (check-equal? (run '(string? "fred")) #t) + (check-equal? (run '(string? (cons 1 2))) #f) + (check-equal? (run '(begin (make-string 3 #\f) + (make-string 3 #\f))) + "fff") + (check-equal? (run '(vector-set! (make-vector 0 #f) 0 #t)) 'err)) - ;; Knock examples - (check-equal? (run '(match 1)) 'err) - (check-equal? (run '(match 1 [1 2])) - 2) - (check-equal? (run '(match 1 [2 1] [1 2])) - 2) - (check-equal? (run '(match 1 [2 1] [1 2] [0 3])) - 2) - (check-equal? (run '(match 1 [2 1] [0 3])) - 'err) - (check-equal? (run '(match 1 [_ 2] [_ 3])) - 2) - (check-equal? (run '(match 1 [x 2] [_ 3])) - 2) - (check-equal? (run '(match 1 [x x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [x x] [_ 3])) - (cons 1 2)) - (check-equal? (run '(match (cons 1 2) [(cons x y) x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [(cons x 2) x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [(cons 3 2) 0] [_ 3])) - 3) - (check-equal? (run '(match 1 [(cons x y) x] [_ 3])) - 3) - (check-equal? (run '(match (cons 1 2) [(cons 1 3) 0] [(cons 1 y) y] [_ 3])) - 2) - (check-equal? (run '(match (box 1) [(box 1) 0] [_ 1])) - 0) - (check-equal? (run '(match (box 1) [(box 2) 0] [_ 1])) - 1) - (check-equal? (run '(match (box 1) [(box x) x] [_ 2])) - 1) + (begin ;; Iniquity + (check-equal? (run + '(define (f x) x) + '(f 5)) + 5) + (check-equal? (run + '(define (tri x) + (if (zero? x) + 0 + (+ x (tri (sub1 x))))) + '(tri 9)) + 45) - ;; Loot examples - (check-true (procedure? (run '(λ (x) x)))) - (check-equal? (run '((λ (x) x) 5)) - 5) - - (check-equal? (run '(let ((f (λ (x) x))) (f 5))) - 5) - (check-equal? (run '(let ((f (λ (x y) x))) (f 5 7))) - 5) - (check-equal? (run '(let ((f (λ (x y) y))) (f 5 7))) - 7) - (check-equal? (run '((let ((x 1)) - (let ((y 2)) - (lambda (z) (cons x (cons y (cons z '())))))) - 3)) - '(1 2 3)) - (check-equal? (run '(define (adder n) - (λ (x) (+ x n))) - '((adder 5) 10)) - 15) - (check-equal? (run '(((λ (t) - ((λ (f) (t (λ (z) ((f f) z)))) - (λ (f) (t (λ (z) ((f f) z)))))) - (λ (tri) - (λ (n) - (if (zero? n) - 0 - (+ n (tri (sub1 n))))))) - 36)) - 666) - (check-equal? (run '(define (tri n) - (if (zero? n) - 0 - (+ n (tri (sub1 n))))) - '(tri 36)) - 666) - (check-equal? (run '(define (tri n) - (match n - [0 0] - [m (+ m (tri (sub1 m)))])) - '(tri 36)) - 666) - (check-equal? (run '((match 8 [8 (lambda (x) x)]) 12)) - 12) + (check-equal? (run + '(define (even? x) + (if (zero? x) + #t + (odd? (sub1 x)))) + '(define (odd? x) + (if (zero? x) + #f + (even? (sub1 x)))) + '(even? 101)) + #f) - ;; Mug examples - (check-equal? (run '(symbol? 'foo)) #t) - (check-equal? (run '(symbol? (string->symbol "foo"))) #t) - (check-equal? (run '(eq? 'foo 'foo)) #t) - (check-equal? (run '(eq? (string->symbol "foo") - (string->symbol "foo"))) - #t) - (check-equal? (run '(eq? 'foo (string->symbol "foo"))) - #t) - (check-equal? (run '(eq? 'fff (string->symbol (make-string 3 #\f)))) - #t) - (check-equal? (run '(symbol? 'g0)) #t) - (check-equal? (run '(symbol? "g0")) #f) - (check-equal? (run '(symbol? (string->symbol "g0"))) #t) - (check-equal? (run '(symbol? (string->uninterned-symbol "g0"))) #t) - (check-equal? (run '(eq? 'g0 (string->symbol "g0"))) #t) - (check-equal? (run '(eq? 'g0 (string->uninterned-symbol "g0"))) #f) - (check-equal? (run '(eq? (string->uninterned-symbol "g0") (string->uninterned-symbol "g0"))) - #f) - (check-equal? (run '(eq? (symbol->string 'foo) (symbol->string 'foo))) #f) - (check-equal? (run '(string? (symbol->string 'foo))) #t) - (check-equal? (run '(eq? (symbol->string 'foo) "foo")) #f) - (check-equal? (run ''foo) 'foo) - (check-equal? (run '(eq? (match #t [_ "foo"]) "bar")) #f) - (check-equal? (run '(eq? (match #t [_ 'foo]) 'bar)) #f) - (check-equal? (run '(match 'foo ['bar #t] [_ #f])) #f) - (check-equal? (run '(match 'foo ['foo #t] [_ #f])) #t) - (check-equal? (run '(match "foo" ["foo" #t] [_ #f])) #t) - (check-equal? (run '(match "foo" ["bar" #t] [_ #f])) #f) - (check-equal? (run '(match (cons '+ (cons 1 (cons 2 '()))) - [(cons '+ (cons x (cons y '()))) - (+ x y)])) - 3)) + (check-equal? (run + '(define (map-add1 xs) + (if (empty? xs) + '() + (cons (add1 (car xs)) + (map-add1 (cdr xs))))) + '(map-add1 (cons 1 (cons 2 (cons 3 '()))))) + '(2 3 4)) + (check-equal? (run '(define (f x y) y) + '(f 1 (add1 #f))) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1)) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1 2 3)) + 'err)) -(define (test-runner-io run) - ;; Evildoer examples - (check-equal? (run "" 7) (cons 7 "")) - (check-equal? (run "" '(write-byte 97)) (cons (void) "a")) - (check-equal? (run "a" '(read-byte)) (cons 97 "")) - (check-equal? (run "b" '(begin (write-byte 97) (read-byte))) - (cons 98 "a")) - (check-equal? (run "" '(read-byte)) (cons eof "")) - (check-equal? (run "" '(eof-object? (read-byte))) (cons #t "")) - (check-equal? (run "a" '(eof-object? (read-byte))) (cons #f "")) - (check-equal? (run "" '(begin (write-byte 97) (write-byte 98))) - (cons (void) "ab")) + (begin ;; Knock + (check-equal? (run '(match 1)) 'err) + (check-equal? (run '(match 1 [1 2])) + 2) + (check-equal? (run '(match 1 [2 1] [1 2])) + 2) + (check-equal? (run '(match 1 [2 1] [1 2] [0 3])) + 2) + (check-equal? (run '(match 1 [2 1] [0 3])) + 'err) + (check-equal? (run '(match 1 [_ 2] [_ 3])) + 2) + (check-equal? (run '(match 1 [x 2] [_ 3])) + 2) + (check-equal? (run '(match 1 [x x] [_ 3])) + 1) + (check-equal? (run '(match (cons 1 2) [x x] [_ 3])) + (cons 1 2)) + (check-equal? (run '(match (cons 1 2) [(cons x y) x] [_ 3])) + 1) + (check-equal? (run '(match (cons 1 2) [(cons x 2) x] [_ 3])) + 1) + (check-equal? (run '(match (cons 1 2) [(cons 3 2) 0] [_ 3])) + 3) + (check-equal? (run '(match 1 [(cons x y) x] [_ 3])) + 3) + (check-equal? (run '(match (cons 1 2) [(cons 1 3) 0] [(cons 1 y) y] [_ 3])) + 2) + (check-equal? (run '(match (box 1) [(box 1) 0] [_ 1])) + 0) + (check-equal? (run '(match (box 1) [(box 2) 0] [_ 1])) + 1) + (check-equal? (run '(match (box 1) [(box x) x] [_ 2])) + 1) + (check-equal? (run '(match 1 [8589934592 1] [_ 2])) 2) + (check-equal? (run '(match 8589934592 [8589934592 1] [_ 2])) 1)) - (check-equal? (run "ab" '(peek-byte)) (cons 97 "")) - (check-equal? (run "ab" '(begin (peek-byte) (read-byte))) (cons 97 "")) - ;; Extort examples - (check-equal? (run "" '(write-byte #t)) (cons 'err "")) + (begin ;; Loot + (check-true (procedure? (run '(λ (x) x)))) + (check-equal? (run '((λ (x) x) 5)) + 5) - ;; Fraud examples - (check-equal? (run "" '(let ((x 97)) (write-byte x))) (cons (void) "a")) - (check-equal? (run "" - '(let ((x 97)) - (begin (write-byte x) - x))) - (cons 97 "a")) - (check-equal? (run "b" '(let ((x 97)) (begin (read-byte) x))) - (cons 97 "")) - (check-equal? (run "b" '(let ((x 97)) (begin (peek-byte) x))) - (cons 97 "")) + (check-equal? (run '(let ((f (λ (x) x))) (f 5))) + 5) + (check-equal? (run '(let ((f (λ (x y) x))) (f 5 7))) + 5) + (check-equal? (run '(let ((f (λ (x y) y))) (f 5 7))) + 7) + (check-equal? (run '((let ((x 1)) + (let ((y 2)) + (lambda (z) (cons x (cons y (cons z '())))))) + 3)) + '(1 2 3)) + (check-equal? (run '(define (adder n) + (λ (x) (+ x n))) + '((adder 5) 10)) + 15) + (check-equal? (run '(((λ (t) + ((λ (f) (t (λ (z) ((f f) z)))) + (λ (f) (t (λ (z) ((f f) z)))))) + (λ (tri) + (λ (n) + (if (zero? n) + 0 + (+ n (tri (sub1 n))))))) + 36)) + 666) + (check-equal? (run '(define (tri n) + (if (zero? n) + 0 + (+ n (tri (sub1 n))))) + '(tri 36)) + 666) + (check-equal? (run '(define (tri n) + (match n + [0 0] + [m (+ m (tri (sub1 m)))])) + '(tri 36)) + 666) + (check-equal? (run '((match 8 [8 (lambda (x) x)]) 12)) + 12)) - ;; Hustle examples - (check-equal? (run "" - '(let ((x 1)) - (begin (write-byte 97) - 1))) - (cons 1 "a")) + (begin ;; Mug + (check-equal? (run '(symbol? 'foo)) #t) + (check-equal? (run '(symbol? (string->symbol "foo"))) #t) + (check-equal? (run '(eq? 'foo 'foo)) #t) + (check-equal? (run '(eq? (string->symbol "foo") + (string->symbol "foo"))) + #t) + (check-equal? (run '(eq? 'foo (string->symbol "foo"))) + #t) + (check-equal? (run '(eq? 'fff (string->symbol (make-string 3 #\f)))) + #t) + (check-equal? (run '(symbol? 'g0)) #t) + (check-equal? (run '(symbol? "g0")) #f) + (check-equal? (run '(symbol? (string->symbol "g0"))) #t) + (check-equal? (run '(symbol? (string->uninterned-symbol "g0"))) #t) + (check-equal? (run '(eq? 'g0 (string->symbol "g0"))) #t) + (check-equal? (run '(eq? 'g0 (string->uninterned-symbol "g0"))) #f) + (check-equal? (run '(eq? (string->uninterned-symbol "g0") (string->uninterned-symbol "g0"))) + #f) + (check-equal? (run '(eq? (symbol->string 'foo) (symbol->string 'foo))) #f) + (check-equal? (run '(string? (symbol->string 'foo))) #t) + (check-equal? (run '(eq? (symbol->string 'foo) "foo")) #f) + (check-equal? (run ''foo) 'foo) + (check-equal? (run '(eq? (match #t [_ "foo"]) "bar")) #f) + (check-equal? (run '(eq? (match #t [_ 'foo]) 'bar)) #f) + (check-equal? (run '(match 'foo ['bar #t] [_ #f])) #f) + (check-equal? (run '(match 'foo ['foo #t] [_ #f])) #t) + (check-equal? (run '(match "foo" ["foo" #t] [_ #f])) #t) + (check-equal? (run '(match "foo" ["bar" #t] [_ #f])) #f) + (check-equal? (run '(match (cons '+ (cons 1 (cons 2 '()))) + [(cons '+ (cons x (cons y '()))) + (+ x y)])) + 3))) - (check-equal? (run "" - '(let ((x 1)) - (let ((y 2)) - (begin (write-byte 97) - 1)))) - (cons 1 "a")) +(define (test/io run) + (begin ;; Evildoer + (check-equal? (run "" 7) (cons 7 "")) + (check-equal? (run "" '(write-byte 97)) (cons (void) "a")) + (check-equal? (run "a" '(read-byte)) (cons 97 "")) + (check-equal? (run "b" '(begin (write-byte 97) (read-byte))) + (cons 98 "a")) + (check-equal? (run "" '(read-byte)) (cons eof "")) + (check-equal? (run "" '(eof-object? (read-byte))) (cons #t "")) + (check-equal? (run "a" '(eof-object? (read-byte))) (cons #f "")) + (check-equal? (run "" '(begin (write-byte 97) (write-byte 98))) + (cons (void) "ab")) - (check-equal? (run "" - '(let ((x (cons 1 2))) - (begin (write-byte 97) - (car x)))) - (cons 1 "a")) - ;; Iniquity examples - #| - (check-equal? (run "" - '(define (print-alphabet i) - (if (zero? i) - (void) - (begin (write-byte (- 123 i)) + (check-equal? (run "ab" '(peek-byte)) (cons 97 "")) + (check-equal? (run "ab" '(begin (peek-byte) (read-byte))) (cons 97 "")) + (check-equal? (run "†" '(read-byte)) (cons 226 "")) + (check-equal? (run "†" '(peek-byte)) (cons 226 ""))) + + (begin ;; Extort + (check-equal? (run "" '(write-byte #t)) (cons 'err ""))) + + (begin ;; Fraud + (check-equal? (run "" '(let ((x 97)) (write-byte x))) (cons (void) "a")) + (check-equal? (run "" + '(let ((x 97)) + (begin (write-byte x) + x))) + (cons 97 "a")) + (check-equal? (run "b" '(let ((x 97)) (begin (read-byte) x))) + (cons 97 "")) + (check-equal? (run "b" '(let ((x 97)) (begin (peek-byte) x))) + (cons 97 ""))) + + (begin ;; Iniquity + (check-equal? (run "" + '(define (print-alphabet i) + (if (zero? i) + (void) + (begin (write-byte (- 123 i)) (print-alphabet (sub1 i))))) - '(print-alphabet 26)) - (cons (void) "abcdefghijklmnopqrstuvwxyz")) -|#) + '(print-alphabet 26)) + (cons (void) "abcdefghijklmnopqrstuvwxyz")) + + (check-equal? (run "" + '(define (f x) + (write-byte x)) + '(f 97)) + (cons (void) "a")) + (check-equal? (run "" + '(define (f x y) + (write-byte x)) + '(f 97 98)) + (cons (void) "a")) + (check-equal? (run "" + '(define (f x) + (let ((y x)) + (write-byte y))) + '(f 97)) + (cons (void) "a")) + (check-equal? (run "" + '(define (f x y) + (let ((y x)) + (write-byte y))) + '(f 97 98)) + (cons (void) "a")) + (check-equal? (run "" + '(define (f x) + (write-byte x)) + '(let ((z 97)) + (f z))) + (cons (void) "a")) + (check-equal? (run "" + '(define (f x y) + (write-byte x)) + '(let ((z 97)) + (f z 98))) + (cons (void) "a"))) + + (begin ;; Knock + (check-equal? (run "" + '(match (write-byte 97) + [_ 1])) + (cons 1 "a"))) + + (begin ;; Loot + (check-equal? (run "" + '((begin (write-byte 97) + (λ (x) + (begin (write-byte x) + (write-byte 99)))) + 98)) + (cons (void) "abc")))) + diff --git a/mug/types.rkt b/mug/types.rkt deleted file mode 100644 index 1bb4f59..0000000 --- a/mug/types.rkt +++ /dev/null @@ -1,108 +0,0 @@ -#lang racket -(provide (all-defined-out)) -(require ffi/unsafe) - -(define imm-shift 3) -(define imm-mask #b111) -(define ptr-mask #b111) -(define type-box #b001) -(define type-cons #b010) -(define type-vect #b011) -(define type-str #b100) -(define type-proc #b101) -(define type-symb #b110) -(define int-shift (+ 1 imm-shift)) -(define char-shift (+ 2 imm-shift)) -(define type-int #b0000) -(define mask-int #b1111) -(define type-char #b01000) -(define mask-char #b11111) - -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(= b (value->bits eof)) eof] - [(= b (value->bits (void))) (void)] - [(= b (value->bits '())) '()] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [(box-bits? b) - (box (bits->value (heap-ref b)))] - [(cons-bits? b) - (cons (bits->value (heap-ref (+ b 8))) - (bits->value (heap-ref b)))] - [(vect-bits? b) - (if (zero? (untag b)) - (vector) - (build-vector (heap-ref b) - (lambda (j) - (bits->value (heap-ref (+ b (* 8 (add1 j))))))))] - [(str-bits? b) - (if (zero? (untag b)) - (string) - (build-string (heap-ref b) - (lambda (j) - (char-ref (+ b 8) j))))] - [(symb-bits? b) - (string->symbol - (if (zero? (untag b)) - (string) - (build-string (heap-ref b) - (lambda (j) - (char-ref (+ b 8) j)))))] - [(proc-bits? b) - (lambda _ - (error "This function is not callable."))] - [else (error "invalid bits")])) - -(define (value->bits v) - (cond [(eq? v #t) #b00011000] - [(eq? v #f) #b00111000] - [(eof-object? v) #b01011000] - [(void? v) #b01111000] - [(empty? v) #b10011000] - [(integer? v) - (arithmetic-shift v int-shift)] - [(char? v) - (bitwise-ior type-char - (arithmetic-shift (char->integer v) char-shift))] - [else (error "not an immediate value")])) - -(define (imm-bits? v) - (zero? (bitwise-and v imm-mask))) - -(define (int-bits? v) - (= type-int (bitwise-and v mask-int))) - -(define (char-bits? v) - (= type-char (bitwise-and v mask-char))) - -(define (cons-bits? v) - (= type-cons (bitwise-and v imm-mask))) - -(define (box-bits? v) - (= type-box (bitwise-and v imm-mask))) - -(define (vect-bits? v) - (= type-vect (bitwise-and v imm-mask))) - -(define (str-bits? v) - (= type-str (bitwise-and v imm-mask))) - -(define (proc-bits? v) - (= type-proc (bitwise-and v imm-mask))) - -(define (symb-bits? v) - (= type-symb (bitwise-and v imm-mask))) - -(define (untag i) - (arithmetic-shift (arithmetic-shift i (- (integer-length ptr-mask))) - (integer-length ptr-mask))) - -(define (heap-ref i) - (ptr-ref (cast (untag i) _int64 _pointer) _int64)) - -(define (char-ref i j) - (integer->char (ptr-ref (cast (untag i) _int64 _pointer) _uint32 j))) diff --git a/mug/utils.rkt b/mug/utils.rkt deleted file mode 100644 index 612b738..0000000 --- a/mug/utils.rkt +++ /dev/null @@ -1,33 +0,0 @@ -#lang racket -(provide symbol->data-label lookup pad-stack unpad-stack) -(require a86/ast) - -(define rsp 'rsp) -(define r15 'r15) - -(define (symbol->data-label s) - (symbol->label - (string->symbol (string-append "data_" (symbol->string s))))) - -;; Id CEnv -> [Maybe Integer] -(define (lookup x cenv) - (match cenv - ['() #f] - [(cons y rest) - (match (eq? x y) - [#t 0] - [#f (match (lookup x rest) - [#f #f] - [i (+ 8 i)])])])) - -;; Asm -;; Dynamically pad the stack to be aligned for a call -(define pad-stack - (seq (Mov r15 rsp) - (And r15 #b1000) - (Sub rsp r15))) - -;; Asm -;; Undo the stack alignment after a call -(define unpad-stack - (seq (Add rsp r15))) diff --git a/mug/values.h b/mug/values.h deleted file mode 100644 index c1de09d..0000000 --- a/mug/values.h +++ /dev/null @@ -1,84 +0,0 @@ -#ifndef VALUES_H -#define VALUES_H - -#include - -/* any abstract value */ -typedef int64_t val_t; - -typedef enum type_t { - T_INVALID = -1, - /* immediates */ - T_INT, - T_BOOL, - T_CHAR, - T_EOF, - T_VOID, - T_EMPTY, - /* pointers */ - T_BOX, - T_CONS, - T_VECT, - T_STR, - T_SYMB, - T_PROC, -} type_t; - -typedef uint32_t val_char_t; -typedef struct val_box_t { - val_t val; -} val_box_t; -typedef struct val_cons_t { - val_t snd; - val_t fst; -} val_cons_t; -typedef struct val_vect_t { - uint64_t len; - val_t elems[]; -} val_vect_t; -typedef struct val_str_t { - uint64_t len; - val_char_t codepoints[]; -} val_str_t; -typedef struct val_symb_t { - uint64_t len; - val_char_t codepoints[]; -} val_symb_t; - -/* return the type of x */ -type_t val_typeof(val_t x); - -/** - * Wrap/unwrap values - * - * The behavior of unwrap functions are undefined on type mismatch. - */ -int64_t val_unwrap_int(val_t x); -val_t val_wrap_int(int64_t i); - -int val_unwrap_bool(val_t x); -val_t val_wrap_bool(int b); - -val_char_t val_unwrap_char(val_t x); -val_t val_wrap_char(val_char_t b); - -val_t val_wrap_eof(); - -val_t val_wrap_void(); - -val_box_t* val_unwrap_box(val_t x); -val_t val_wrap_box(val_box_t* b); - -val_cons_t* val_unwrap_cons(val_t x); -val_t val_wrap_cons(val_cons_t* c); - -val_vect_t* val_unwrap_vect(val_t x); -val_t val_wrap_vect(val_vect_t* c); - -val_str_t* val_unwrap_str(val_t x); -val_t val_wrap_str(val_str_t* c); - -val_symb_t* val_unwrap_symb(val_t x); -val_t val_wrap_symb(val_symb_t* c); - -#endif From fa402228ecaad038b59eceea3e27ca2a608b5c71 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 17 Apr 2026 09:42:20 -0400 Subject: [PATCH 08/47] Slight refactor to literals. --- mug/syntax/literals.rkt | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/mug/syntax/literals.rkt b/mug/syntax/literals.rkt index 2ffec7e..09ff2de 100644 --- a/mug/syntax/literals.rkt +++ b/mug/syntax/literals.rkt @@ -34,9 +34,7 @@ ;; Expr -> [Listof (U Symbol String)] (define (literals-e e) (match e - [(Lit (? symbol? s)) (list s)] - [(Lit (? string? s)) (list s)] - [(Lit _) '()] + [(Lit d) (literals-datum d)] [(Prim1 p e) (literals-e e)] [(Prim2 p e1 e2) @@ -57,6 +55,13 @@ (append (literals-e e) (append-map literals-match-clause ps es))] [_ '()])) +;; Datum -> [Listof (U Symbol String)] +(define (literals-datum d) + (cond + [(string? d) (list d)] + [(symbol? d) (list d)] + [else '()])) + ;; Pat Expr -> [Listof (U Symbol String)] (define (literals-match-clause p e) (append (literals-pat p) (literals-e e))) @@ -64,8 +69,7 @@ ;; Pat -> [Listof (U Symbol String)] (define (literals-pat p) (match p - [(Lit (? symbol? s)) (list s)] - [(Lit (? string? s)) (list s)] + [(Lit d) (literals-datum d)] [(Box p) (literals-pat p)] [(Cons p1 p2) (append (literals-pat p1) (literals-pat p2))] [(Conj p1 p2) (append (literals-pat p1) (literals-pat p2))] From 40a16f35f5825f4be8d0df2d232b1b2121de8b55 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 16:44:38 -0400 Subject: [PATCH 09/47] Bringing Mountebank up to date. --- mountebank/Makefile | 3 +- mountebank/ast.rkt | 81 -- mountebank/build-runtime.rkt | 14 - mountebank/compile-define.rkt | 72 -- mountebank/compile-ops.rkt | 397 -------- mountebank/compile-stdin.rkt | 10 - mountebank/compile.rkt | 56 -- mountebank/compiler/assert.rkt | 68 ++ mountebank/{ => compiler}/compile-datum.rkt | 17 +- mountebank/compiler/compile-literals.rkt | 48 + mountebank/compiler/compile-ops.rkt | 299 ++++++ mountebank/compiler/compile-stdin.rkt | 14 + .../compile.rkt} | 330 ++++--- mountebank/executor/decode.rkt | 54 ++ mountebank/executor/exec.rkt | 70 ++ mountebank/executor/run.rkt | 20 + mountebank/interp-defun.rkt | 156 ---- mountebank/interp-io.rkt | 12 - mountebank/interp.rkt | 155 --- mountebank/{ => interpreter}/env.rkt | 3 +- mountebank/interpreter/interp-io.rkt | 16 + .../interp-prim.rkt} | 65 +- mountebank/{ => interpreter}/interp-stdin.rkt | 9 +- mountebank/interpreter/interp.rkt | 136 +++ mountebank/main.c | 40 - mountebank/main.rkt | 18 + mountebank/parse-file.rkt | 13 - mountebank/parse.rkt | 112 --- mountebank/run.rkt | 18 - mountebank/runtime.h | 15 - mountebank/runtime/Makefile | 29 + mountebank/{ => runtime}/char.c | 0 mountebank/runtime/error.c | 9 + mountebank/{ => runtime}/heap.h | 0 mountebank/{ => runtime}/io.c | 16 +- mountebank/runtime/main.c | 26 + mountebank/{ => runtime}/print.c | 10 + mountebank/{ => runtime}/print.h | 0 mountebank/runtime/runtime.h | 27 + mountebank/{ => runtime}/symbol.c | 0 mountebank/{ => runtime}/types.h | 40 +- mountebank/runtime/types.rkt | 64 ++ mountebank/{ => runtime}/values.c | 11 + mountebank/runtime/values.h | 119 +++ mountebank/simple-interp.rkt | 59 -- mountebank/syntax/ast.rkt | 75 ++ mountebank/{ => syntax}/fv.rkt | 11 +- mountebank/{ => syntax}/lambdas.rkt | 2 +- .../literals.rkt} | 70 +- mountebank/syntax/parse.rkt | 276 ++++++ mountebank/{ => syntax}/read-all.rkt | 1 + mountebank/test/build-runtime.rkt | 8 - mountebank/test/compile.rkt | 12 +- mountebank/test/interp-defun.rkt | 24 - mountebank/test/interp.rkt | 12 +- mountebank/test/parse.rkt | 89 ++ mountebank/test/test-runner.rkt | 883 +++++++++--------- mountebank/types.rkt | 109 --- mountebank/utils.rkt | 33 - mountebank/values.h | 84 -- 60 files changed, 2257 insertions(+), 2163 deletions(-) delete mode 100644 mountebank/ast.rkt delete mode 100644 mountebank/build-runtime.rkt delete mode 100644 mountebank/compile-define.rkt delete mode 100644 mountebank/compile-ops.rkt delete mode 100644 mountebank/compile-stdin.rkt delete mode 100644 mountebank/compile.rkt create mode 100644 mountebank/compiler/assert.rkt rename mountebank/{ => compiler}/compile-datum.rkt (91%) create mode 100644 mountebank/compiler/compile-literals.rkt create mode 100644 mountebank/compiler/compile-ops.rkt create mode 100644 mountebank/compiler/compile-stdin.rkt rename mountebank/{compile-expr.rkt => compiler/compile.rkt} (56%) create mode 100644 mountebank/executor/decode.rkt create mode 100644 mountebank/executor/exec.rkt create mode 100644 mountebank/executor/run.rkt delete mode 100644 mountebank/interp-defun.rkt delete mode 100644 mountebank/interp-io.rkt delete mode 100644 mountebank/interp.rkt rename mountebank/{ => interpreter}/env.rkt (91%) create mode 100644 mountebank/interpreter/interp-io.rkt rename mountebank/{interp-prims.rkt => interpreter/interp-prim.rkt} (59%) rename mountebank/{ => interpreter}/interp-stdin.rkt (53%) create mode 100644 mountebank/interpreter/interp.rkt delete mode 100644 mountebank/main.c create mode 100644 mountebank/main.rkt delete mode 100644 mountebank/parse-file.rkt delete mode 100644 mountebank/parse.rkt delete mode 100644 mountebank/run.rkt delete mode 100644 mountebank/runtime.h create mode 100644 mountebank/runtime/Makefile rename mountebank/{ => runtime}/char.c (100%) create mode 100644 mountebank/runtime/error.c rename mountebank/{ => runtime}/heap.h (100%) rename mountebank/{ => runtime}/io.c (50%) create mode 100644 mountebank/runtime/main.c rename mountebank/{ => runtime}/print.c (98%) rename mountebank/{ => runtime}/print.h (100%) create mode 100644 mountebank/runtime/runtime.h rename mountebank/{ => runtime}/symbol.c (100%) rename mountebank/{ => runtime}/types.h (65%) create mode 100644 mountebank/runtime/types.rkt rename mountebank/{ => runtime}/values.c (90%) create mode 100644 mountebank/runtime/values.h delete mode 100644 mountebank/simple-interp.rkt create mode 100644 mountebank/syntax/ast.rkt rename mountebank/{ => syntax}/fv.rkt (83%) rename mountebank/{ => syntax}/lambdas.rkt (100%) rename mountebank/{compile-literals.rkt => syntax/literals.rkt} (58%) create mode 100644 mountebank/syntax/parse.rkt rename mountebank/{ => syntax}/read-all.rkt (99%) delete mode 100644 mountebank/test/build-runtime.rkt delete mode 100644 mountebank/test/interp-defun.rkt create mode 100644 mountebank/test/parse.rkt delete mode 100644 mountebank/types.rkt delete mode 100644 mountebank/utils.rkt delete mode 100644 mountebank/values.h diff --git a/mountebank/Makefile b/mountebank/Makefile index 3fc9599..d88e2b9 100644 --- a/mountebank/Makefile +++ b/mountebank/Makefile @@ -10,8 +10,7 @@ objs = \ main.o \ print.o \ values.o \ - io.o \ - symbol.o + io.o default: runtime.o diff --git a/mountebank/ast.rkt b/mountebank/ast.rkt deleted file mode 100644 index a946759..0000000 --- a/mountebank/ast.rkt +++ /dev/null @@ -1,81 +0,0 @@ -#lang racket -(provide (all-defined-out)) - -;; type Prog = (Prog (Listof Defn) Expr) -(struct Prog (ds e) #:prefab) - -;; type Defn = (Defn Id (Listof Id) Expr) -(struct Defn (f xs e) #:prefab) - -;; type Expr = (Eof) -;; | (Quote Datum) -;; | (Prim0 Op0) -;; | (Prim1 Op1 Expr) -;; | (Prim2 Op2 Expr Expr) -;; | (Prim3 Op3 Expr Expr Expr) -;; | (If Expr Expr Expr) -;; | (Begin Expr Expr) -;; | (Let Id Expr Expr) -;; | (Var Id) -;; | (Match Expr (Listof Pat) (Listof Expr)) -;; | (App Expr (Listof Expr)) -;; | (Lam Id (Listof Id) Expr) -;; type Datum = Integer -;; | Char -;; | Boolean -;; | String -;; | Symbol -;; | (Boxof Datum) -;; | (Listof Datum) -;; | (Vectorof Datum) -;; type Id = Symbol -;; type Op0 = 'read-byte -;; type Op1 = 'add1 | 'sub1 | 'zero? -;; | 'char? | 'integer->char | 'char->integer -;; | 'write-byte | 'eof-object? -;; | 'box | 'car | 'cdr | 'unbox -;; | 'empty? | 'cons? | 'box? -;; | 'vector? | 'vector-length -;; | 'string? | 'string-length -;; | 'symbol? | 'string->symbol -;; | 'string->symbol | 'string->uninterned-symbol -;; type Op2 = '+ | '- | '< | '= -;; | 'cons | 'eq? -;; | 'make-vector | 'vector-ref -;; | 'make-string | 'string-ref -;; type Op3 = 'vector-set! -;; type Pat = (PVar Id) -;; | (PWild) -;; | (PLit Lit) -;; | (PBox Pat) -;; | (PCons Pat Pat) -;; | (PAnd Pat Pat) -;; | (PSymb Symbol) -;; | (PStr String) -;; type Lit = Boolean -;; | Character -;; | Integer -;; | '() - -(struct Eof () #:prefab) -(struct Prim0 (p) #:prefab) -(struct Prim1 (p e) #:prefab) -(struct Prim2 (p e1 e2) #:prefab) -(struct Prim3 (p e1 e2 e3) #:prefab) -(struct If (e1 e2 e3) #:prefab) -(struct Begin (e1 e2) #:prefab) -(struct Let (x e1 e2) #:prefab) -(struct Var (x) #:prefab) -(struct App (e es) #:prefab) -(struct Lam (f xs e) #:prefab) -(struct Quote (d) #:prefab) -(struct Match (e ps es) #:prefab) - -(struct PVar (x) #:prefab) -(struct PWild () #:prefab) -(struct PLit (x) #:prefab) -(struct PBox (p) #:prefab) -(struct PCons (p1 p2) #:prefab) -(struct PAnd (p1 p2) #:prefab) -(struct PSymb (s) #:prefab) -(struct PStr (s) #:prefab) diff --git a/mountebank/build-runtime.rkt b/mountebank/build-runtime.rkt deleted file mode 100644 index 66aad89..0000000 --- a/mountebank/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require racket/runtime-path) -(provide runtime-path) - -(define-runtime-path here ".") - -(void - (system (string-append "make -C '" - (path->string (normalize-path here)) - "' runtime.o"))) - -(define runtime-path - (path->string - (normalize-path (build-path here "runtime.o")))) diff --git a/mountebank/compile-define.rkt b/mountebank/compile-define.rkt deleted file mode 100644 index a8a6992..0000000 --- a/mountebank/compile-define.rkt +++ /dev/null @@ -1,72 +0,0 @@ -#lang racket -(provide compile-define compile-defines-values define-ids compile-defines) -(require "ast.rkt" - "types.rkt" - "fv.rkt" - "utils.rkt" - "compile-expr.rkt" - a86/ast) - -(define rax 'rax) -(define rbx 'rbx) - -;; [Listof Defn] -> [Listof Id] -(define (define-ids ds) - (match ds - ['() '()] - [(cons (Defn f xs e) ds) - (cons f (define-ids ds))])) - -;; [Listof Defn] -> Asm -(define (compile-defines ds) - (match ds - ['() (seq)] - [(cons d ds) - (seq (compile-define d) - (compile-defines ds))])) - -;; Defn -> Asm -(define (compile-define d) - (match d - [(Defn f xs e) - (compile-lambda-define (Lam f xs e))])) - -;; Defns -> Asm -;; Compile the closures for ds and push them on the stack -(define (compile-defines-values ds) - (seq (alloc-defines ds 0) - (init-defines ds (reverse (define-ids ds)) 8) - (add-rbx-defines ds 0))) - -;; Defns Int -> Asm -;; Allocate closures for ds at given offset, but don't write environment yet -(define (alloc-defines ds off) - (match ds - ['() (seq)] - [(cons (Defn f xs e) ds) - (let ((fvs (fv (Lam f xs e)))) - (seq (Lea rax (symbol->label f)) - (Mov (Mem rbx off) rax) - (Mov rax rbx) - (Add rax off) - (Or rax type-proc) - (Push rax) - (alloc-defines ds (+ off (* 8 (add1 (length fvs)))))))])) - -;; Defns CEnv Int -> Asm -;; Initialize the environment for each closure for ds at given offset -(define (init-defines ds c off) - (match ds - ['() (seq)] - [(cons (Defn f xs e) ds) - (let ((fvs (fv (Lam f xs e)))) - (seq (free-vars-to-heap fvs c off) - (init-defines ds c (+ off (* 8 (add1 (length fvs)))))))])) - -;; Defns Int -> Asm -;; Compute adjustment to rbx for allocation of all ds -(define (add-rbx-defines ds n) - (match ds - ['() (seq (Add rbx (* n 8)))] - [(cons (Defn f xs e) ds) - (add-rbx-defines ds (+ n (add1 (length (fv (Lam f xs e))))))])) diff --git a/mountebank/compile-ops.rkt b/mountebank/compile-ops.rkt deleted file mode 100644 index 79fe367..0000000 --- a/mountebank/compile-ops.rkt +++ /dev/null @@ -1,397 +0,0 @@ -#lang racket -(provide compile-op0 compile-op1 compile-op2 compile-op3 pad-stack unpad-stack assert-proc) -(require "ast.rkt" "types.rkt" "utils.rkt" a86/ast) - -(define rax 'rax) ; return -(define eax 'eax) ; 32-bit load/store -(define rbx 'rbx) ; heap -(define rdi 'rdi) ; arg1 -(define rsi 'rsi) ; arg2 -(define rdx 'rdx) ; arg3 -(define r8 'r8) ; scratch -(define r9 'r9) ; scratch -(define r10 'r10) ; scratch -(define r12 'r12) ; save across call to memcpy -(define r15 'r15) ; stack pad (non-volatile) -(define rsp 'rsp) ; stack - -;; Op0 -> Asm -(define (compile-op0 p) - (match p - ['void (seq (Mov rax (value->bits (void))))] - ['read-byte (seq pad-stack - (Call 'read_byte) - unpad-stack)] - ['peek-byte (seq pad-stack - (Call 'peek_byte) - unpad-stack)])) - -;; Op1 -> Asm -(define (compile-op1 p) - (match p - ['add1 - (seq (assert-integer rax) - (Add rax (value->bits 1)))] - ['sub1 - (seq (assert-integer rax) - (Sub rax (value->bits 1)))] - ['zero? - (seq (assert-integer rax) - (eq-imm 0))] - ['char? - (type-pred mask-char type-char)] - ['char->integer - (seq (assert-char rax) - (Sar rax char-shift) - (Sal rax int-shift))] - ['integer->char - (seq (assert-codepoint rax) - (Sar rax int-shift) - (Sal rax char-shift) - (Xor rax type-char))] - ['eof-object? (eq-imm eof)] - ['write-byte - (seq (assert-byte rax) - pad-stack - (Mov rdi rax) - (Call 'write_byte) - unpad-stack)] - ['box - (seq (Mov (Mem rbx 0) rax) - (Mov rax rbx) - (Or rax type-box) - (Add rbx 8))] - ['unbox - (seq (assert-box rax) - (Xor rax type-box) - (Mov rax (Mem rax 0)))] - ['car - (seq (assert-cons rax) - (Xor rax type-cons) - (Mov rax (Mem rax 8)))] - ['cdr - (seq (assert-cons rax) - (Xor rax type-cons) - (Mov rax (Mem rax 0)))] - ['empty? (eq-imm '())] - ['box? - (type-pred ptr-mask type-box)] - ['cons? - (type-pred ptr-mask type-cons)] - ['vector? - (type-pred ptr-mask type-vect)] - ['string? - (type-pred ptr-mask type-str)] - ['symbol? - (type-pred ptr-mask type-symb)] - ['vector-length - (let ((zero (gensym)) - (done (gensym))) - (seq (assert-vector rax) - (Xor rax type-vect) - (Cmp rax 0) - (Je zero) - (Mov rax (Mem rax 0)) - (Sal rax int-shift) - (Jmp done) - (Label zero) - (Mov rax 0) - (Label done)))] - ['string-length - (let ((zero (gensym)) - (done (gensym))) - (seq (assert-string rax) - (Xor rax type-str) - (Cmp rax 0) - (Je zero) - (Mov rax (Mem rax 0)) - (Sal rax int-shift) - (Jmp done) - (Label zero) - (Mov rax 0) - (Label done)))] - ['string->symbol - (seq (assert-string rax) - (Xor rax type-str) - (Mov rdi rax) - pad-stack - (Call 'intern_symbol) - unpad-stack - (Or rax type-symb))] - ['symbol->string - (seq (assert-symbol rax) - (Xor rax type-symb) - char-array-copy - (Or rax type-str))] - ['string->uninterned-symbol - (seq (assert-string rax) - (Xor rax type-str) - char-array-copy - (Or rax type-symb))])) - -;; Asm -;; Copy sized array of characters pointed to by rax -(define char-array-copy - (seq (Mov rdi rbx) ; dst - (Mov rsi rax) ; src - (Mov rdx (Mem rax 0)) ; len - (Add rdx 1) ; #words = 1 + (len+1)/2 - (Sar rdx 1) - (Add rdx 1) - (Sal rdx 3) ; #bytes = 8*#words - (Mov r12 rdx) ; save rdx before destroyed - pad-stack - (Call 'memcpy) - unpad-stack - ; rbx should be preserved by memcpy - ;(Mov rbx rax) ; dst is returned, install as heap pointer - (Add rbx r12))) - -;; Op2 -> Asm -(define (compile-op2 p) - (match p - ['+ - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Add rax r8))] - ['- - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Sub r8 rax) - (Mov rax r8))] - ['< - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Cmp r8 rax) - (Mov rax (value->bits #t)) - (let ((true (gensym))) - (seq (Jl true) - (Mov rax (value->bits #f)) - (Label true))))] - ['= - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Cmp r8 rax) - (Mov rax (value->bits #t)) - (let ((true (gensym))) - (seq (Je true) - (Mov rax (value->bits #f)) - (Label true))))] - ['cons - (seq (Mov (Mem rbx 0) rax) - (Pop rax) - (Mov (Mem rbx 8) rax) - (Mov rax rbx) - (Or rax type-cons) - (Add rbx 16))] - ['eq? - (seq (Pop r8) - (eq r8 rax))] - ['make-vector - (let ((loop (gensym)) - (done (gensym)) - (empty (gensym))) - (seq (Pop r8) - (assert-natural r8) - (Cmp r8 0) ; special case empty vector - (Je empty) - - (Mov r9 rbx) - (Or r9 type-vect) - - (Sar r8 int-shift) - (Mov (Mem rbx 0) r8) - (Add rbx 8) - - (Label loop) - (Mov (Mem rbx 0) rax) - (Add rbx 8) - (Sub r8 1) - (Cmp r8 0) - (Jne loop) - - (Mov rax r9) - (Jmp done) - - (Label empty) - (Mov rax type-vect) - (Label done)))] - - ['vector-ref - (seq (Pop r8) - (assert-vector r8) - (assert-integer rax) - (Cmp r8 type-vect) - (Je 'raise_error_align) ; special case for empty vector - (Cmp rax 0) - (Jl 'raise_error_align) - (Xor r8 type-vect) ; r8 = ptr - (Mov r9 (Mem r8 0)) ; r9 = len - (Sar rax int-shift) ; rax = index - (Sub r9 1) - (Cmp r9 rax) - (Jl 'raise_error_align) - (Sal rax 3) - (Add r8 rax) - (Mov rax (Mem r8 8)))] - - ['make-string - (let ((loop (gensym)) - (done (gensym)) - (empty (gensym))) - (seq (Pop r8) - (assert-natural r8) - (assert-char rax) - (Cmp r8 0) ; special case empty string - (Je empty) - - (Mov r9 rbx) - (Or r9 type-str) - - (Sar r8 int-shift) - (Mov (Mem rbx 0) r8) - (Add rbx 8) - - (Sar rax char-shift) - - (Add r8 1) ; adds 1 - (Sar r8 1) ; when - (Sal r8 1) ; len is odd - - (Label loop) - (Mov (Mem rbx 0) eax) - (Add rbx 4) - (Sub r8 1) - (Cmp r8 0) - (Jne loop) - - (Mov rax r9) - (Jmp done) - - (Label empty) - (Mov rax type-str) - (Label done)))] - - ['string-ref - (seq (Pop r8) - (assert-string r8) - (assert-integer rax) - (Cmp r8 type-str) - (Je 'raise_error_align) ; special case for empty string - (Cmp rax 0) - (Jl 'raise_error_align) - (Xor r8 type-str) ; r8 = ptr - (Mov r9 (Mem r8 0)) ; r9 = len - (Sar rax int-shift) ; rax = index - (Sub r9 1) - (Cmp r9 rax) - (Jl 'raise_error_align) - (Sal rax 2) - (Add r8 rax) - (Mov 'eax (Mem r8 8)) - (Sal rax char-shift) - (Or rax type-char))])) - -;; Op3 -> Asm -(define (compile-op3 p) - (match p - ['vector-set! - (seq (Pop r10) - (Pop r8) - (assert-vector r8) - (assert-integer r10) - (Cmp r10 0) - (Jl 'raise_error_align) - (Xor r8 type-vect) ; r8 = ptr - (Mov r9 (Mem r8 0)) ; r9 = len - (Sar r10 int-shift) ; r10 = index - (Sub r9 1) - (Cmp r9 r10) - (Jl 'raise_error_align) - (Sal r10 3) - (Add r8 r10) - (Mov (Mem r8 8) rax) - (Mov rax (value->bits (void))))])) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define (assert-type mask type) - (λ (arg) - (seq (Mov r9 arg) - (And r9 mask) - (Cmp r9 type) - (Jne 'raise_error_align)))) - -(define (type-pred mask type) - (let ((l (gensym))) - (seq (And rax mask) - (Cmp rax type) - (Mov rax (value->bits #t)) - (Je l) - (Mov rax (value->bits #f)) - (Label l)))) - -(define assert-integer - (assert-type mask-int type-int)) -(define assert-char - (assert-type mask-char type-char)) -(define assert-box - (assert-type ptr-mask type-box)) -(define assert-cons - (assert-type ptr-mask type-cons)) -(define assert-vector - (assert-type ptr-mask type-vect)) -(define assert-string - (assert-type ptr-mask type-str)) -(define assert-symbol - (assert-type ptr-mask type-symb)) -(define assert-proc - (assert-type ptr-mask type-proc)) - -(define (assert-codepoint r) - (let ((ok (gensym))) - (seq (assert-integer r) - (Cmp r (value->bits 0)) - (Jl 'raise_error_align) - (Cmp r (value->bits 1114111)) - (Jg 'raise_error_align) - (Cmp r (value->bits 55295)) - (Jl ok) - (Cmp r (value->bits 57344)) - (Jg ok) - (Jmp 'raise_error_align) - (Label ok)))) - -(define (assert-byte r) - (seq (assert-integer r) - (Cmp r (value->bits 0)) - (Jl 'raise_error_align) - (Cmp r (value->bits 255)) - (Jg 'raise_error_align))) - -(define (assert-natural r) - (seq (assert-integer r) - (Cmp r (value->bits 0)) - (Jl 'raise_error_align))) - -;; Value -> Asm -(define (eq-imm imm) - (let ((l1 (gensym))) - (seq (Cmp rax (value->bits imm)) - (Mov rax (value->bits #t)) - (Je l1) - (Mov rax (value->bits #f)) - (Label l1)))) - -(define (eq ir1 ir2) - (let ((l1 (gensym))) - (seq (Cmp ir1 ir2) - (Mov rax (value->bits #t)) - (Je l1) - (Mov rax (value->bits #f)) - (Label l1)))) diff --git a/mountebank/compile-stdin.rkt b/mountebank/compile-stdin.rkt deleted file mode 100644 index cfa1510..0000000 --- a/mountebank/compile-stdin.rkt +++ /dev/null @@ -1,10 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt" "compile.rkt" "read-all.rkt" a86/printer) - -;; -> Void -;; Compile contents of stdin, -;; emit asm code on stdout -(define (main) - (read-line) ; ignore #lang racket line - (asm-display (compile (parse (read-all))))) diff --git a/mountebank/compile.rkt b/mountebank/compile.rkt deleted file mode 100644 index 9c8c62a..0000000 --- a/mountebank/compile.rkt +++ /dev/null @@ -1,56 +0,0 @@ -#lang racket -(provide compile compile-e) -(require "ast.rkt" - "types.rkt" - "lambdas.rkt" - "fv.rkt" - "utils.rkt" - "compile-define.rkt" - "compile-expr.rkt" - "compile-literals.rkt" - a86/ast) - -;; Registers used -(define rbx 'rbx) ; heap -(define rsp 'rsp) ; stack -(define rdi 'rdi) ; arg -(define r15 'r15) ; stack pad (non-volatile) -(define r12 'r12) - -;; type CEnv = (Listof [Maybe Id]) - -;; Prog -> Asm -(define (compile p) - (match p - [(Prog ds e) - (prog (externs) - (Global 'entry) - (Label 'entry) - (Push rbx) ; save callee-saved register - (Push r15) - (Push r12) - (Mov rbx rdi) ; recv heap pointer - (init-symbol-table p) - (compile-defines-values ds) - (compile-e e (reverse (define-ids ds)) #f) - (Add rsp (* 8 (length ds))) ;; pop function definitions - (Pop r12) ; restore callee-save register - (Pop r15) - (Pop rbx) - (Ret) - (compile-defines ds) - (compile-lambda-defines (lambdas p)) - (Label 'raise_error_align) - pad-stack - (Call 'raise_error) - (Data) - (compile-literals p))])) - -(define (externs) - (seq (Extern 'peek_byte) - (Extern 'read_byte) - (Extern 'write_byte) - (Extern 'raise_error) - (Extern 'intern_symbol) - (Extern 'symb_cmp) - (Extern 'memcpy))) diff --git a/mountebank/compiler/assert.rkt b/mountebank/compiler/assert.rkt new file mode 100644 index 0000000..0d97df1 --- /dev/null +++ b/mountebank/compiler/assert.rkt @@ -0,0 +1,68 @@ +#lang racket +(provide assert-integer assert-char assert-byte assert-codepoint + assert-box assert-cons + assert-natural assert-vector assert-string + assert-proc assert-symbol) +(require a86/ast) +(require "../runtime/types.rkt") + +(define (assert-type mask type) + (λ (r) + (seq (Push r) + (And r mask) + (Cmp r type) + (Pop r) + (Jne 'err)))) + +;; Register -> Asm + + +(define assert-integer + (assert-type mask-int type-int)) + +;; Register -> Asm + +(define assert-char + (assert-type mask-char type-char)) +(define assert-box + (assert-type ptr-mask type-box)) +(define assert-cons + (assert-type ptr-mask type-cons)) +(define assert-vector + (assert-type ptr-mask type-vect)) +(define assert-string + (assert-type ptr-mask type-str)) +(define assert-proc + (assert-type ptr-mask type-proc)) +(define assert-symbol + (assert-type ptr-mask type-symb)) + +;; Register -> Asm +(define (assert-codepoint r) + (let ((ok (gensym))) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err) + (Cmp r (value->bits 1114111)) + (Jg 'err) + (Cmp r (value->bits 55295)) + (Jl ok) + (Cmp r (value->bits 57344)) + (Jg ok) + (Jmp 'err) + (Label ok)))) + +;; Register -> Asm +(define (assert-byte r) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err) + (Cmp r (value->bits 255)) + (Jg 'err))) + +;; Register -> Asm +(define (assert-natural r) + (seq (assert-integer r) + (Cmp r (value->bits 0)) + (Jl 'err))) + diff --git a/mountebank/compile-datum.rkt b/mountebank/compiler/compile-datum.rkt similarity index 91% rename from mountebank/compile-datum.rkt rename to mountebank/compiler/compile-datum.rkt index 9fe2720..1fe497f 100644 --- a/mountebank/compile-datum.rkt +++ b/mountebank/compiler/compile-datum.rkt @@ -1,11 +1,9 @@ #lang racket (provide compile-datum) -(require "types.rkt" - "utils.rkt" - a86/ast) - -;; Registers used -(define rax 'rax) ; return +(require "../runtime/types.rkt") +(require "compile-literals.rkt") +(require a86/ast + a86/registers) ;; Datum -> Asm (define (compile-datum d) @@ -69,20 +67,21 @@ (let ((l (gensym 'cons))) (cons (Mem l type-cons) (seq (Label l) - (Dq l2) (Dq l1) + (Dq l2) is1 is2)))])])) ;; [Listof Datum] -> (cons AsmExpr Asm) (define (compile-datum-vector ds) (match ds - ['() (cons type-vect '())] + ['() (cons (Mem 'empty type-vect) '())] [_ (let ((l (gensym 'vector)) (cds (map compile-quoted ds))) (cons (Mem l type-vect) (seq (Label l) - (Dq (length ds)) + (Dq (value->bits (length ds))) (map (λ (cd) (Dq (car cd))) cds) (append-map cdr cds))))])) + diff --git a/mountebank/compiler/compile-literals.rkt b/mountebank/compiler/compile-literals.rkt new file mode 100644 index 0000000..c0321d4 --- /dev/null +++ b/mountebank/compiler/compile-literals.rkt @@ -0,0 +1,48 @@ +#lang racket +(provide compile-literals init-symbol-table compile-string-chars symbol->data-label) +(require "../syntax/ast.rkt") +(require "../syntax/literals.rkt") +(require "../runtime/types.rkt") +(require a86/ast a86/registers) + +;; Prog -> Asm +(define (compile-literals p) + (append-map compile-literal (literals p))) + +;; Symbol -> Asm +(define (compile-literal s) + (let ((str (symbol->string s))) + (seq (Label (symbol->data-label s)) + (Dq (value->bits (string-length str))) + (compile-string-chars (string->list str)) + (if (odd? (string-length str)) + (seq (Dd 0)) + (seq))))) + +;; Prog -> Asm +;; Call intern_symbol on every symbol in the program +(define (init-symbol-table p) + (match (symbols p) + ['() (seq)] + [ss (seq (Sub 'rsp 8) + (append-map init-symbol ss) + (Add 'rsp 8))])) + +;; Symbol -> Asm +(define (init-symbol s) + (seq (Lea rdi (symbol->data-label s)) + (Extern 'intern_symbol) + (Call 'intern_symbol))) + +;; [Listof Char] -> Asm +(define (compile-string-chars cs) + (match cs + ['() (seq)] + [(cons c cs) + (seq (Dd (char->integer c)) + (compile-string-chars cs))])) + +(define (symbol->data-label s) + (symbol->label + (string->symbol (string-append "data_" (symbol->string s))))) + diff --git a/mountebank/compiler/compile-ops.rkt b/mountebank/compiler/compile-ops.rkt new file mode 100644 index 0000000..0a9c4b8 --- /dev/null +++ b/mountebank/compiler/compile-ops.rkt @@ -0,0 +1,299 @@ +#lang racket +(provide compile-op0 compile-op1 compile-op2 compile-op3 pad-stack assert-proc) +(require "../syntax/ast.rkt") +(require "../runtime/types.rkt") +(require "assert.rkt") +(require a86/ast a86/registers) + +;; Op0 -> Asm +(define (compile-op0 p) + (match p + ['void (seq (Mov rax (value->bits (void))))] + ['read-byte (seq (Extern 'read_byte) pad-stack (Call 'read_byte) unpad-stack)] + ['peek-byte (seq (Extern 'peek_byte) pad-stack (Call 'peek_byte) unpad-stack)])) + +;; Op1 -> Asm +(define (compile-op1 p) + (match p + ['add1 + (seq (assert-integer rax) + (Add rax (value->bits 1)))] + ['sub1 + (seq (assert-integer rax) + (Sub rax (value->bits 1)))] + ['zero? + (seq (assert-integer rax) + (Cmp rax 0) + if-equal)] + ['char? + (seq (And rax mask-char) + (Cmp rax type-char) + if-equal)] + ['char->integer + (seq (assert-char rax) + (Sar rax char-shift) + (Sal rax int-shift))] + ['integer->char + (seq (assert-codepoint rax) + (Sar rax int-shift) + (Sal rax char-shift) + (Xor rax type-char))] + ['eof-object? + (seq (Cmp rax (value->bits eof)) + if-equal)] + ['write-byte + (seq (Extern 'write_byte) + (assert-byte rax) + pad-stack + (Mov rdi rax) + (Call 'write_byte) + unpad-stack)] + ['box + (seq (Mov (Mem rbx) rax) ; memory write + (Mov rax rbx) ; put box in rax + (Xor rax type-box) ; tag as a box + (Add rbx 8))] + ['unbox + (seq (assert-box rax) + (Mov rax (Mem rax (- type-box))))] + ['car + (seq (assert-cons rax) + (Mov rax (Mem rax (- 0 type-cons))))] + ['cdr + (seq (assert-cons rax) + (Mov rax (Mem rax (- 8 type-cons))))] + + ['empty? (seq (Cmp rax (value->bits '())) if-equal)] + ['cons? (type-pred ptr-mask type-cons)] + ['box? (type-pred ptr-mask type-box)] + ['vector? (type-pred ptr-mask type-vect)] + ['string? (type-pred ptr-mask type-str)] + ['symbol? (type-pred ptr-mask type-symb)] + ['vector-length + (seq (assert-vector rax) + (Mov rax (Mem rax (- type-vect))))] + ['string-length + (seq (assert-string rax) + (Mov rax (Mem rax (- type-str))))] + ['string->symbol + (seq (assert-string rax) + (Xor rax type-str) + (Mov rdi rax) + pad-stack + (Extern 'intern_symbol) + (Call 'intern_symbol) + unpad-stack + (Or rax type-symb))] + ['symbol->string + (seq (assert-symbol rax) + (Xor rax type-symb) + char-array-copy + (Or rax type-str))] + ['string->uninterned-symbol + (seq (assert-string rax) + (Xor rax type-str) + char-array-copy + (Or rax type-symb))])) + +;; Op2 -> Asm +(define (compile-op2 p) + (match p + ['+ + (seq (Pop r8) + (assert-integer r8) + (assert-integer rax) + (Add rax r8))] + ['- + (seq (Pop r8) + (assert-integer r8) + (assert-integer rax) + (Sub r8 rax) + (Mov rax r8))] + ['< + (seq (Pop r8) + (assert-integer r8) + (assert-integer rax) + (Cmp r8 rax) + if-lt)] + ['= + (seq (Pop r8) + (assert-integer r8) + (assert-integer rax) + (Cmp r8 rax) + if-equal)] + ['cons + (seq (Mov (Mem rbx 8) rax) + (Pop rax) + (Mov (Mem rbx 0) rax) + (Mov rax rbx) + (Xor rax type-cons) + (Add rbx 16))] + ['eq? + (seq (Pop r8) + (Cmp rax r8) + if-equal)] + ['make-vector + (let ((nonzero (gensym 'nz)) + (loop (gensym 'loop)) + (theend (gensym 'theend))) + + (seq (Pop r8) + (assert-natural r8) + + ; special case for length = 0 + (Cmp r8 0) + (Jne nonzero) + ; return canonical representation + (Lea rax (Mem 'empty type-vect)) + (Jmp theend) + + ; Code for nonzero case + (Label nonzero) + (Mov (Mem rbx 0) r8) ; write length + (Sar r8 1) ; convert to bytes + (Mov r9 r8) ; save for heap adjustment + + ; start initialization + (Label loop) + (Mov (Mem rbx r8) rax) + (Sub r8 8) + (Cmp r8 0) + (Jne loop) + ; end initialization + + (Mov rax rbx) + (Xor rax type-vect) ; create tagged pointer + (Add rbx r9) ; acct for elements and stored length + (Add rbx 8) + (Label theend)))] + + ['vector-ref + (seq (Pop r8) + (assert-vector r8) + (assert-natural rax) + (Mov r9 (Mem r8 (- type-vect))) + (Cmp rax r9) + (Jge 'err) + (Sar rax 1) + (Mov rax (Mem r8 rax (- 8 type-vect))))] + ['make-string + (let ((nonzero (gensym 'nz)) + (loop (gensym 'loop)) + (theend (gensym 'theend))) + (seq (Pop r8) + (assert-natural r8) + (assert-char rax) + + ; special case for length = 0 + (Cmp r8 0) + (Jne nonzero) + ; return canonical representation + (Lea rax (Mem 'empty type-str)) + (Jmp theend) + + ; Code for nonzero case + (Label nonzero) + + (Mov (Mem rbx 0) r8) ; write length + (Sar r8 2) ; convert to bytes + (Mov r9 r8) ; save for heap adjustment + + (Sar rax char-shift) ; convert to codepoint + + ; start initialization + (Label loop) + (Mov (Mem rbx r8 4) eax) + (Sub r8 4) + (Cmp r8 0) + (Jne loop) + ; end initialization + + (Mov rax rbx) + (Xor rax type-str) ; create tagged pointer + (Add rbx r9) ; acct for elements and stored length + (Add rbx 8) + ; Pad to 8-byte alignment + (Add rbx 4) + (Sar rbx 3) + (Sal rbx 3) + (Label theend)))] + + ['string-ref + (seq (Pop r8) + (assert-natural rax) + (assert-string r8) + (Mov r9 (Mem r8 (- type-str))) + (Cmp rax r9) + (Jge 'err) + (Sar rax 2) + (Mov eax (Mem r8 rax (- 8 type-str))) + (Sal rax char-shift) + (Xor rax type-char))])) + + +;; Op3 -> Asm +(define (compile-op3 p) + (match p + ['vector-set! + (seq (Pop r10) + (Pop r8) + (assert-vector r8) + (assert-natural r10) + (Mov r9 (Mem r8 (- type-vect))) + (Cmp r10 r9) + (Jge 'err) + (Sar r10 1) ; convert to byte offset + (Mov (Mem r8 r10 (- 8 type-vect)) rax) + (Mov rax (value->bits (void))))])) + +(define (type-pred mask type) + (seq (And rax mask) + (Cmp rax type) + if-equal)) + +;; Asm +;; set rax to #t or #f if comparison flag is equal +(define if-equal + (seq (Mov rax (value->bits #f)) + (Mov r9 (value->bits #t)) + (Cmove rax r9))) + +;; Asm +;; set rax to #t or #f if comparison flag is less than +(define if-lt + (seq (Mov rax (value->bits #f)) + (Mov r9 (value->bits #t)) + (Cmovl rax r9))) + + +;; Asm +;; Dynamically pad the stack to be aligned for a call +(define pad-stack + (seq (Mov r15 rsp) + (And r15 #b1000) + (Sub rsp r15))) + +;; Asm +;; Undo the stack alignment after a call +(define unpad-stack + (seq (Add rsp r15))) + +;; Asm +;; Copy sized array of characters pointed to by rax +(define char-array-copy + (seq (Mov rdi rbx) ; dst + (Mov rsi rax) ; src + (Mov rdx (Mem rax 0)) ; len + (Add rdx 1) ; #words = 1 + (len+1)/2 + (Sar rdx 1) + (Add rdx 1) + (Sal rdx 3) ; #bytes = 8*#words + (Mov r12 rdx) ; save rdx before destroyed + pad-stack + (Extern 'memcpy) + (Call 'memcpy) + unpad-stack + ; rbx should be preserved by memcpy + ;(Mov rbx rax) ; dst is returned, install as heap pointer + (Add rbx r12))) + diff --git a/mountebank/compiler/compile-stdin.rkt b/mountebank/compiler/compile-stdin.rkt new file mode 100644 index 0000000..f25989a --- /dev/null +++ b/mountebank/compiler/compile-stdin.rkt @@ -0,0 +1,14 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "compile.rkt") +(require "../syntax/read-all.rkt") +(require a86/printer) + +;; -> Void +;; Compile contents of stdin, +;; emit asm code on stdout +(define (main) + (read-line) ; ignore #lang racket line + (asm-display (compile (apply parse-closed (read-all))))) + diff --git a/mountebank/compile-expr.rkt b/mountebank/compiler/compile.rkt similarity index 56% rename from mountebank/compile-expr.rkt rename to mountebank/compiler/compile.rkt index e2b9627..4724ac7 100644 --- a/mountebank/compile-expr.rkt +++ b/mountebank/compiler/compile.rkt @@ -1,51 +1,134 @@ #lang racket -(provide compile-e compile-lambda-defines compile-lambda-define free-vars-to-heap) -(require "ast.rkt" - "types.rkt" - "lambdas.rkt" - "fv.rkt" - "utils.rkt" - "compile-ops.rkt" - "compile-datum.rkt" - a86/ast) - -;; Registers used -(define rax 'rax) ; return -(define rbx 'rbx) ; heap -(define rsp 'rsp) ; stack -(define rdi 'rdi) ; arg -(define r8 'r8) -(define r9 'r9) -(define rsi 'rsi) - -;; Expr CEnv Bool -> Asm +(provide compile + compile-e + compile-es + compile-define + compile-match + compile-match-clause + compile-lambda-define + copy-env-to-stack + free-vars-to-heap) + +(require "../syntax/ast.rkt") +(require "compile-ops.rkt") +(require "compile-literals.rkt") +(require "compile-datum.rkt") +(require "../runtime/types.rkt") +(require "../syntax/lambdas.rkt") +(require "../syntax/fv.rkt") +(require a86/ast a86/registers) + +;; Prog -> Asm +(define (compile p) + (match p + [(Prog ds e) + (prog (Global 'entry) + (Label 'entry) + (Push rbx) ; save callee-saved register + (Push r15) + (Mov rbx rdi) ; recv heap pointer + (init-symbol-table p) + (compile-defines-values ds) + (compile-e e (reverse (define-ids ds)) #f) + (Add rsp (* 8 (length ds))) ;; pop function definitions + (Pop r15) ; restore callee-save register + (Pop rbx) + (Ret) + (compile-defines ds) + (compile-lambda-defines (lambdas p)) + (Label 'err) + pad-stack + (Extern 'raise_error) + (Call 'raise_error) + (Data) + (Label 'empty) + (Dq 0) + (compile-literals p))])) + +;; [Listof Defn] -> [Listof Id] +(define (define-ids ds) + (match ds + ['() '()] + [(cons (Defn f xs e) ds) + (cons f (define-ids ds))])) + +;; [Listof Defn] -> Asm +(define (compile-defines ds) + (match ds + ['() (seq)] + [(cons d ds) + (seq (compile-define d) + (compile-defines ds))])) + +;; Defn -> Asm +(define (compile-define d) + (match d + [(Defn f xs e) + (compile-lambda-define (Lam f xs e))])) + +;; [Listof Lam] -> Asm +(define (compile-lambda-defines ls) + (match ls + ['() (seq)] + [(cons l ls) + (seq (compile-lambda-define l) + (compile-lambda-defines ls))])) + +;; Lam -> Asm +(define (compile-lambda-define l) + (let ((fvs (fv l))) + (match l + [(Lam f xs e) + (let ((env (append (reverse fvs) (reverse xs) (list #f)))) + (seq (Label (symbol->label f)) + (Cmp r8 (length xs)) + (Jne 'err) + (Mov rax (Mem rsp (* 8 (length xs)))) + (copy-env-to-stack fvs 8) + (compile-e e env #t) + (Add rsp (* 8 (length env))) ; pop env + (Ret)))]))) + +;; [Listof Id] Int -> Asm +;; Copy the closure environment at given offset to stack +(define (copy-env-to-stack fvs off) + (match fvs + ['() (seq)] + [(cons _ fvs) + (seq (Mov r9 (Mem rax (- off type-proc))) + (Push r9) + (copy-env-to-stack fvs (+ 8 off)))])) + +;; type CEnv = (Listof [Maybe Id]) +;; Expr CEnv Boolean -> Asm (define (compile-e e c t?) (match e - [(Quote d) (compile-datum d)] - [(Eof) (seq (Mov rax (value->bits eof)))] - [(Var x) (compile-variable x c)] - [(Prim0 p) (compile-prim0 p c)] - [(Prim1 p e) (compile-prim1 p e c)] - [(Prim2 p e1 e2) (compile-prim2 p e1 e2 c)] + [(Lit d) (compile-datum d)] + [(Eof) (seq (Mov rax (value->bits eof)))] + [(Var x) (compile-variable x c)] + [(Prim0 p) (compile-prim0 p)] + [(Prim1 p e) (compile-prim1 p e c)] + [(Prim2 p e1 e2) (compile-prim2 p e1 e2 c)] [(Prim3 p e1 e2 e3) (compile-prim3 p e1 e2 e3 c)] - [(If e1 e2 e3) (compile-if e1 e2 e3 c t?)] - [(Begin e1 e2) (compile-begin e1 e2 c t?)] - [(Let x e1 e2) (compile-let x e1 e2 c t?)] - [(App e es) (compile-app e es c t?)] - [(Lam f xs e) (compile-lam f xs e c)] - [(Match e ps es) (compile-match e ps es c t?)])) + [(If e1 e2 e3) (compile-if e1 e2 e3 c t?)] + [(Begin e1 e2) (compile-begin e1 e2 c t?)] + [(Let x e1 e2) (compile-let x e1 e2 c t?)] + [(App e es) + (compile-app e es c t?)] + [(Lam f xs e) + (compile-lam f xs e c)] + [(Match e ps es) (compile-match e ps es c t?)])) + ;; Id CEnv -> Asm (define (compile-variable x c) - (match (lookup x c) - [#f (error "unbound variable")] ;(seq (Lea rax (symbol->label x)))] - [i (seq (Mov rax (Mem rsp i)))])) + (let ((i (lookup x c))) + (seq (Mov rax (Mem rsp i))))) -;; Op0 CEnv -> Asm -(define (compile-prim0 p c) +;; Op0 -> Asm +(define (compile-prim0 p) (compile-op0 p)) -;; Op1 Expr CEnv -> Asm (define (compile-prim1 p e c) (seq (compile-e e c #f) (compile-op1 p))) @@ -65,8 +148,7 @@ (Push rax) (compile-e e3 (cons #f (cons #f c)) #f) (compile-op3 p))) - -;; Expr Expr Expr CEnv Bool -> Asm +;; Expr Expr Expr CEnv Boolean -> Asm (define (compile-if e1 e2 e3 c t?) (let ((l1 (gensym 'if)) (l2 (gensym 'if))) @@ -78,25 +160,25 @@ (Label l1) (compile-e e3 c t?) (Label l2)))) - -;; Expr Expr CEnv Bool -> Asm +;; Expr Expr CEnv Boolean -> Asm (define (compile-begin e1 e2 c t?) (seq (compile-e e1 c #f) (compile-e e2 c t?))) - -;; Id Expr Expr CEnv Bool -> Asm +;; Id Expr Expr CEnv Boolean -> Asm (define (compile-let x e1 e2 c t?) (seq (compile-e e1 c #f) (Push rax) (compile-e e2 (cons x c) t?) (Add rsp 8))) -;; Id [Listof Expr] CEnv Bool -> Asm -(define (compile-app f es c t?) - ;(compile-app-nontail f es c) +;; Id [Listof Expr] CEnv -> Asm +;; The return address is placed above the arguments, so callee pops +;; arguments and return address is next frame +;; Expr [Listof Expr] CEnv Boolean -> Asm +(define (compile-app e es c t?) (if t? - (compile-app-tail f es c) - (compile-app-nontail f es c))) + (compile-app-tail e es c) + (compile-app-nontail e es c))) ;; Expr [Listof Expr] CEnv -> Asm (define (compile-app-tail e es c) @@ -105,8 +187,8 @@ (Add rsp (* 8 (length c))) (Mov rax (Mem rsp (* 8 (length es)))) (assert-proc rax) - (Xor rax type-proc) - (Mov rax (Mem rax 0)) + (Mov rax (Mem rax (- type-proc))) + (Mov r8 (length es)) ; pass arity info (Jmp rax))) ;; Integer Integer -> Asm @@ -129,19 +211,59 @@ (compile-es (cons e es) (cons #f c)) (Mov rax (Mem rsp i)) (assert-proc rax) - (Xor rax type-proc) - (Mov rax (Mem rax 0)) ; fetch the code label + (Mov rax (Mem rax (- type-proc))) ; fetch the code label + (Mov r8 (length es)) ; pass arity info (Jmp rax) (Label r)))) +;; Defns -> Asm +;; Compile the closures for ds and push them on the stack +(define (compile-defines-values ds) + (seq (alloc-defines ds 0) + (init-defines ds (reverse (define-ids ds)) 8) + (add-rbx-defines ds 0))) + +;; Defns Int -> Asm +;; Allocate closures for ds at given offset, but don't write environment yet +(define (alloc-defines ds off) + (match ds + ['() (seq)] + [(cons (Defn f xs e) ds) + (let ((fvs (fv (Lam f xs e)))) + (seq (Lea rax (symbol->label f)) + (Mov (Mem rbx off) rax) + (Mov rax rbx) + (Add rax off) + (Xor rax type-proc) + (Push rax) + (alloc-defines ds (+ off (* 8 (add1 (length fvs)))))))])) + +;; Defns CEnv Int -> Asm +;; Initialize the environment for each closure for ds at given offset +(define (init-defines ds c off) + (match ds + ['() (seq)] + [(cons (Defn f xs e) ds) + (let ((fvs (fv (Lam f xs e)))) + (seq (free-vars-to-heap fvs c off) + (init-defines ds c (+ off (* 8 (add1 (length fvs)))))))])) + +;; Defns Int -> Asm +;; Compute adjustment to rbx for allocation of all ds +(define (add-rbx-defines ds n) + (match ds + ['() (seq (Add rbx (* n 8)))] + [(cons (Defn f xs e) ds) + (add-rbx-defines ds (+ n (add1 (length (fv (Lam f xs e))))))])) + ;; Id [Listof Id] Expr CEnv -> Asm (define (compile-lam f xs e c) (let ((fvs (fv (Lam f xs e)))) (seq (Lea rax (symbol->label f)) - (Mov (Mem rbx 0) rax) + (Mov (Mem rbx) rax) (free-vars-to-heap fvs c 8) (Mov rax rbx) ; return value - (Or rax type-proc) + (Xor rax type-proc) (Add rbx (* 8 (add1 (length fvs))))))) ;; [Listof Id] CEnv Int -> Asm @@ -154,38 +276,6 @@ (Mov (Mem rbx off) r8) (free-vars-to-heap fvs c (+ off 8)))])) -;; [Listof Lam] -> Asm -(define (compile-lambda-defines ls) - (match ls - ['() (seq)] - [(cons l ls) - (seq (compile-lambda-define l) - (compile-lambda-defines ls))])) - -;; Lam -> Asm -(define (compile-lambda-define l) - (let ((fvs (fv l))) - (match l - [(Lam f xs e) - (let ((env (append (reverse fvs) (reverse xs) (list #f)))) - (seq (Label (symbol->label f)) - (Mov rax (Mem rsp (* 8 (length xs)))) - (Xor rax type-proc) - (copy-env-to-stack fvs 8) - (compile-e e env #t) - (Add rsp (* 8 (length env))) ; pop env - (Ret)))]))) - -;; [Listof Id] Int -> Asm -;; Copy the closure environment at given offset to stack -(define (copy-env-to-stack fvs off) - (match fvs - ['() (seq)] - [(cons _ fvs) - (seq (Mov r9 (Mem rax off)) - (Push r9) - (copy-env-to-stack fvs (+ 8 off)))])) - ;; [Listof Expr] CEnv -> Asm (define (compile-es es c) (match es @@ -201,7 +291,7 @@ (seq (compile-e e c #f) (Push rax) ; save away to be restored by each clause (compile-match-clauses ps es (cons #f c) done t?) - (Jmp 'raise_error_align) + (Jmp 'err) (Label done) (Add rsp 8)))) ; pop the saved value being matched @@ -218,7 +308,7 @@ (let ((next (gensym))) (match (compile-pattern p '() next) [(list i cm) - (seq (Mov rax (Mem rsp 0)) ; restore value being matched + (seq (Mov rax (Mem rsp)) ; restore value being matched i (compile-e e (append cm c) t?) (Add rsp (* 8 (length cm))) @@ -228,48 +318,21 @@ ;; Pat CEnv Symbol -> (list Asm CEnv) (define (compile-pattern p cm next) (match p - [(PWild) + [(Var '_) (list (seq) cm)] - [(PVar x) + [(Var x) (list (seq (Push rax)) (cons x cm))] - [(PStr s) - (let ((ok (gensym)) - (fail (gensym))) - (list (seq (Lea rdi (symbol->data-label (string->symbol s))) - (Mov r8 rax) - (And r8 ptr-mask) - (Cmp r8 type-str) - (Je ok) - (Label fail) - (Add rsp (* 8 (length cm))) - (Jmp next) - (Label ok) - (Xor rax type-str) - (Mov rsi rax) - pad-stack - (Call 'symb_cmp) - unpad-stack - (Cmp rax 0) - (Jne fail)) - cm))] - [(PSymb s) + [(Lit l) (let ((ok (gensym))) - (list (seq (Lea r9 (Mem (symbol->data-label s) type-symb)) - (Cmp rax r9) + (list (seq (Mov r8 rax) + (compile-datum l) + (Cmp rax r8) (Je ok) (Add rsp (* 8 (length cm))) (Jmp next) (Label ok)) cm))] - [(PLit l) - (let ((ok (gensym))) - (list (seq (Cmp rax (value->bits l)) - (Je ok) - (Add rsp (* 8 (length cm))) - (Jmp next) - (Label ok)) - cm))] - [(PAnd p1 p2) + [(Conj p1 p2) (match (compile-pattern p1 (cons #f cm) next) [(list i1 cm1) (match (compile-pattern p2 cm1 next) @@ -280,7 +343,7 @@ (Mov rax (Mem rsp (* 8 (- (sub1 (length cm1)) (length cm))))) i2) cm2)])])] - [(PBox p) + [(Box p) (match (compile-pattern p cm next) [(list i1 cm1) (let ((ok (gensym))) @@ -292,11 +355,10 @@ (Add rsp (* 8 (length cm))) ; haven't pushed anything yet (Jmp next) (Label ok) - (Xor rax type-box) - (Mov rax (Mem rax 0)) + (Mov rax (Mem rax (- type-box))) i1) cm1))])] - [(PCons p1 p2) + [(Cons p1 p2) (match (compile-pattern p1 (cons #f cm) next) [(list i1 cm1) (match (compile-pattern p2 cm1 next) @@ -311,10 +373,20 @@ (Jmp next) (Label ok) (Xor rax type-cons) - (Mov r8 (Mem rax 0)) + (Mov r8 (Mem rax 8)) (Push r8) ; push cdr - (Mov rax (Mem rax 8)) ; mov rax car + (Mov rax (Mem rax 0)) ; mov rax car i1 (Mov rax (Mem rsp (* 8 (- (sub1 (length cm1)) (length cm))))) i2) cm2))])])])) + +;; Id CEnv -> Integer +(define (lookup x cenv) + (match cenv + ['() (error "undefined variable:" x)] + [(cons y rest) + (match (eq? x y) + [#t 0] + [#f (+ 8 (lookup x rest))])])) + diff --git a/mountebank/executor/decode.rkt b/mountebank/executor/decode.rkt new file mode 100644 index 0000000..4ba7f96 --- /dev/null +++ b/mountebank/executor/decode.rkt @@ -0,0 +1,54 @@ +#lang racket + +(require "../runtime/types.rkt") +(require ffi/unsafe) + +(provide (all-defined-out)) + +;; Integer -> Value +(define (bits->value b) + (cond [(= b (value->bits #t)) #t] + [(= b (value->bits #f)) #f] + [(= b (value->bits eof)) eof] + [(= b (value->bits (void))) (void)] + [(= b (value->bits '())) '()] + [(int-bits? b) + (arithmetic-shift b (- int-shift))] + [(char-bits? b) + (integer->char (arithmetic-shift b (- char-shift)))] + [(box-bits? b) + (box (bits->value (mem-ref (- b type-box))))] + [(cons-bits? b) + (cons (bits->value (mem-ref (+ 0 (- b type-cons)))) + (bits->value (mem-ref (+ 8 (- b type-cons)))))] + + [(vect-bits? b) + (let ((p (- b type-vect))) + (build-vector (bits->value (mem-ref p)) + (lambda (j) + (bits->value (mem-ref (+ p (* 8 (add1 j))))))))] + [(str-bits? b) + (let ((p (- b type-str))) + (build-string (bits->value (mem-ref p)) + (lambda (j) + (integer->char (mem-ref32 (+ p 8 (* 4 j)))))))] + [(proc-bits? b) + (lambda _ + (error "This function is not callable."))] + [(symb-bits? b) + (let ((p (- b type-symb))) + (string->symbol + (build-string (bits->value (mem-ref p)) + (lambda (j) + (integer->char (mem-ref32 (+ p 8 (* 4 j))))))))] + [else (error "invalid bits")])) + +(define (mem-ref i) + (ptr-ref (cast i _int64 _pointer) _int64)) + +(define (mem-ref32 i) + (ptr-ref (cast i _int64 _pointer) _int32)) + +(define _val + (make-ctype _int64 value->bits bits->value)) + diff --git a/mountebank/executor/exec.rkt b/mountebank/executor/exec.rkt new file mode 100644 index 0000000..9217a1d --- /dev/null +++ b/mountebank/executor/exec.rkt @@ -0,0 +1,70 @@ +#lang racket +(require a86/interp) + +(provide exec + (struct-out exec-state) + exec-unload + call-with-exec) + +(require a86/interp + ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") +(struct exec-state (program heap) #:transparent) + +(define (symb-ptr->string p) + (define len (bits->value (ptr-ref p _uint64 0))) + (define cp-base (ptr-add p 8 _byte)) + (build-string + len + (λ (i) + (integer->char (ptr-ref cp-base _uint32 i))))) + +(define (exec/state prog) + (define intern-table (make-hash)) + (define (intern-symbol/cb p) + (define s (symb-ptr->string p)) + (hash-ref! intern-table s (λ () p))) + (define heap (malloc _int64 10000)) + (exec-state + (parameterize + ([current-externs + (list + (extern 'read_byte read-byte (_fun -> _val)) + (extern 'peek_byte peek-byte (_fun -> _val)) + (extern 'write_byte write-byte (_fun _val -> _val)) + (extern 'raise_error + (λ () (raise 'err)) + (_fun -> _void)) + (extern 'intern_symbol + intern-symbol/cb + (_fun _pointer -> _pointer)))]) + (asm-load prog)) + heap)) + +(define (exec-call st) + (match-define (exec-state program heap) st) + (with-handlers ([(λ (x) (eq? x 'err)) identity]) + (asm-call program 'entry heap))) + +(define (exec-unload st) + (asm-unload (exec-state-program st))) + +;; ------------------------------------------------------------ +;; public API + +;; execute with runtime system and Racket host +;; return raw bits plus the live state needed to interpret them safely + +;; CAUTION: this does not unload +(define (exec asm) + (exec-call (exec/state asm))) + +;; version of above that ensures unloading +(define (call-with-exec e f) + (define st (exec/state e)) + (dynamic-wind + void + (λ () (f (exec-call st))) + (λ () (exec-unload st)))) + diff --git a/mountebank/executor/run.rkt b/mountebank/executor/run.rkt new file mode 100644 index 0000000..d96fe18 --- /dev/null +++ b/mountebank/executor/run.rkt @@ -0,0 +1,20 @@ +#lang racket +(require a86/interp) +(require "decode.rkt") +(require "exec.rkt") +(provide run run/io) +;; Asm -> Answer +(define (run asm) + (call-with-exec + asm + (λ (r) + (match r + ['err 'err] + [b (bits->value b)])))) +;; Asm String -> (cons Answer String) +(define (run/io asm in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (run asm) + (get-output-string (current-output-port))))) + diff --git a/mountebank/interp-defun.rkt b/mountebank/interp-defun.rkt deleted file mode 100644 index c4bcc05..0000000 --- a/mountebank/interp-defun.rkt +++ /dev/null @@ -1,156 +0,0 @@ -#lang racket -(provide interp interp-env (struct-out Closure) zip) -(require "ast.rkt" - "env.rkt" - "interp-prims.rkt") - -;; type Answer = Value | 'err - -;; type Value = -;; | Datum -;; | Eof -;; | Void -;; | (cons Value Value) -;; | (box Value) -;; | (vector Value ...) -;; | (string Char ...) -;; | (Closure [Listof Id] Expr Env) -(struct Closure (xs e r) #:prefab) - -;; type REnv = (Listof (List Id Value)) -;; type Defns = (Listof Defn) - -;; Prog -> Answer -(define (interp p) - (match p - [(Prog ds e) - (interp-env e '() ds)])) - -;; Expr Env Defns -> Answer -(define (interp-env e r ds) - (match e - [(Quote d) d] - [(Eof) eof] - [(Var x) (interp-var x r ds)] - [(Prim0 'void) (void)] - [(Prim0 'read-byte) (read-byte)] - [(Prim0 'peek-byte) (peek-byte)] - [(Prim1 p e) - (match (interp-env e r ds) - ['err 'err] - [v (interp-prim1 p v)])] - [(Prim2 p e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [v1 (match (interp-env e2 r ds) - ['err 'err] - [v2 (interp-prim2 p v1 v2)])])] - [(Prim3 p e1 e2 e3) - (match (interp-env e1 r ds) - ['err 'err] - [v1 (match (interp-env e2 r ds) - ['err 'err] - [v2 (match (interp-env e3 r ds) - ['err 'err] - [v3 (interp-prim3 p v1 v2 v3)])])])] - [(If p e1 e2) - (match (interp-env p r ds) - ['err 'err] - [v - (if v - (interp-env e1 r ds) - (interp-env e2 r ds))])] - [(Begin e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [_ (interp-env e2 r ds)])] - [(Let x e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [v (interp-env e2 (ext r x v) ds)])] - [(Lam _ xs e) - (Closure xs e r)] - [(App e es) - (match (interp-env e r ds) - ['err 'err] - [f - (match (interp-env* es r ds) - ['err 'err] - [vs - (match f - [(Closure xs e r) - ; check arity matches - (if (= (length xs) (length vs)) - (interp-env e (append (zip xs vs) r) ds) - 'err)] - [_ 'err])])])] - [(Match e ps es) - (match (interp-env e r ds) - ['err 'err] - [v - (interp-match v ps es r ds)])])) - -;; Value [Listof Pat] [Listof Expr] Env Defns -> Answer -(define (interp-match v ps es r ds) - (match* (ps es) - [('() '()) 'err] - [((cons p ps) (cons e es)) - (match (interp-match-pat p v r) - [#f (interp-match v ps es r ds)] - [r (interp-env e r ds)])])) - -;; Pat Value Env -> [Maybe Env] -(define (interp-match-pat p v r) - (match p - [(PWild) r] - [(PVar x) (ext r x v)] - [(PSymb s) (and (eq? s v) r)] - [(PStr s) (and (string? v) (string=? s v) r)] - [(PLit l) (and (eqv? l v) r)] - [(PBox p) - (match v - [(box v) - (interp-match-pat p v r)] - [_ #f])] - [(PCons p1 p2) - (match v - [(cons v1 v2) - (match (interp-match-pat p1 v1 r) - [#f #f] - [r1 (interp-match-pat p2 v2 r1)])] - [_ #f])] - [(PAnd p1 p2) - (match (interp-match-pat p1 v r) - [#f #f] - [r1 (interp-match-pat p2 v r1)])])) - -;; Id Env [Listof Defn] -> Answer -(define (interp-var x r ds) - (match (lookup r x) - ['err (match (defns-lookup ds x) - [(Defn f xs e) (interp-env (Lam f xs e) '() ds)] - [#f 'err])] - [v v])) - -;; (Listof Expr) REnv Defns -> (Listof Value) | 'err -(define (interp-env* es r ds) - (match es - ['() '()] - [(cons e es) - (match (interp-env e r ds) - ['err 'err] - [v (match (interp-env* es r ds) - ['err 'err] - [vs (cons v vs)])])])) - -;; Defns Symbol -> [Maybe Defn] -(define (defns-lookup ds f) - (findf (match-lambda [(Defn g _ _) (eq? f g)]) - ds)) - -(define (zip xs ys) - (match* (xs ys) - [('() '()) '()] - [((cons x xs) (cons y ys)) - (cons (list x y) - (zip xs ys))])) diff --git a/mountebank/interp-io.rkt b/mountebank/interp-io.rkt deleted file mode 100644 index 93f7d3c..0000000 --- a/mountebank/interp-io.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide interp/io) -(require "interp.rkt") - -;; (Expr String -> String -;; Interpret e with given string as input, -;; collect output as string (including printed result) -(define (interp/io e in) - (parameterize ((current-output-port (open-output-string)) - (current-input-port (open-input-string in))) - (cons (interp e) - (get-output-string (current-output-port))))) diff --git a/mountebank/interp.rkt b/mountebank/interp.rkt deleted file mode 100644 index 3accf29..0000000 --- a/mountebank/interp.rkt +++ /dev/null @@ -1,155 +0,0 @@ -#lang racket -(provide interp interp-env) -(require "ast.rkt" - "env.rkt" - "interp-prims.rkt") - -;; type Answer = Value | 'err - -;; type Value = -;; | Datum -;; | Eof -;; | Void -;; | (cons Value Value) -;; | (box Value) -;; | (vector Value ...) -;; | (string Char ...) -;; | (Value ... -> Answer) - -;; type REnv = (Listof (List Id Value)) -;; type Defns = (Listof Defn) - -;; Prog -> Answer -(define (interp p) - (match p - [(Prog ds e) - (interp-env e '() ds)])) - -;; Expr Env Defns -> Answer -(define (interp-env e r ds) - (match e - [(Quote d) d] - [(Eof) eof] - [(Var x) (interp-var x r ds)] - [(Prim0 'void) (void)] - [(Prim0 'read-byte) (read-byte)] - [(Prim0 'peek-byte) (peek-byte)] - [(Prim1 p e) - (match (interp-env e r ds) - ['err 'err] - [v (interp-prim1 p v)])] - [(Prim2 p e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [v1 (match (interp-env e2 r ds) - ['err 'err] - [v2 (interp-prim2 p v1 v2)])])] - [(Prim3 p e1 e2 e3) - (match (interp-env e1 r ds) - ['err 'err] - [v1 (match (interp-env e2 r ds) - ['err 'err] - [v2 (match (interp-env e3 r ds) - ['err 'err] - [v3 (interp-prim3 p v1 v2 v3)])])])] - [(If p e1 e2) - (match (interp-env p r ds) - ['err 'err] - [v - (if v - (interp-env e1 r ds) - (interp-env e2 r ds))])] - [(Begin e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [_ (interp-env e2 r ds)])] - [(Let x e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [v (interp-env e2 (ext r x v) ds)])] - [(Lam _ xs e) - (λ vs - ; check arity matches - (if (= (length xs) (length vs)) - (interp-env e (append (zip xs vs) r) ds) - 'err))] - [(App e es) - (match (interp-env e r ds) - ['err 'err] - [f - (match (interp-env* es r ds) - ['err 'err] - [vs - (if (procedure? f) - (apply f vs) - 'err)])])] - [(Match e ps es) - (match (interp-env e r ds) - ['err 'err] - [v - (interp-match v ps es r ds)])])) - -;; Value [Listof Pat] [Listof Expr] Env Defns -> Answer -(define (interp-match v ps es r ds) - (match* (ps es) - [('() '()) 'err] - [((cons p ps) (cons e es)) - (match (interp-match-pat p v r) - [#f (interp-match v ps es r ds)] - [r (interp-env e r ds)])])) - -;; Pat Value Env -> [Maybe Env] -(define (interp-match-pat p v r) - (match p - [(PWild) r] - [(PVar x) (ext r x v)] - [(PSymb s) (and (eq? s v) r)] - [(PStr s) (and (string? v) (string=? s v) r)] - [(PLit l) (and (eqv? l v) r)] - [(PBox p) - (match v - [(box v) - (interp-match-pat p v r)] - [_ #f])] - [(PCons p1 p2) - (match v - [(cons v1 v2) - (match (interp-match-pat p1 v1 r) - [#f #f] - [r1 (interp-match-pat p2 v2 r1)])] - [_ #f])] - [(PAnd p1 p2) - (match (interp-match-pat p1 v r) - [#f #f] - [r1 (interp-match-pat p2 v r1)])])) - -;; Id Env [Listof Defn] -> Answer -(define (interp-var x r ds) - (match (lookup r x) - ['err (match (defns-lookup ds x) - [(Defn f xs e) (interp-env (Lam f xs e) '() ds)] - [#f 'err])] - [v v])) - -;; (Listof Expr) REnv Defns -> (Listof Value) | 'err -(define (interp-env* es r ds) - (match es - ['() '()] - [(cons e es) - (match (interp-env e r ds) - ['err 'err] - [v (match (interp-env* es r ds) - ['err 'err] - [vs (cons v vs)])])])) - -;; Defns Symbol -> [Maybe Defn] -(define (defns-lookup ds f) - (findf (match-lambda [(Defn g _ _) (eq? f g)]) - ds)) - -(define (zip xs ys) - (match* (xs ys) - [('() '()) '()] - [((cons x xs) (cons y ys)) - (cons (list x y) - (zip xs ys))])) diff --git a/mountebank/env.rkt b/mountebank/interpreter/env.rkt similarity index 91% rename from mountebank/env.rkt rename to mountebank/interpreter/env.rkt index c43be9c..5c2ab01 100644 --- a/mountebank/env.rkt +++ b/mountebank/interpreter/env.rkt @@ -12,4 +12,5 @@ ;; Env Variable Value -> Value (define (ext r x i) - (cons (list x i) r)) \ No newline at end of file + (cons (list x i) r)) + diff --git a/mountebank/interpreter/interp-io.rkt b/mountebank/interpreter/interp-io.rkt new file mode 100644 index 0000000..f0bb535 --- /dev/null +++ b/mountebank/interpreter/interp-io.rkt @@ -0,0 +1,16 @@ +#lang racket +(provide interp/io) +(require "interp.rkt") +;; String Prog -> (Cons Answer String) +;; Interpret p with given string as input, +;; return answer and collected output as string +(define (interp/io p input) + (define result (box #f)) + (define output + (with-input-from-string input + (λ () + (with-output-to-string + (λ () + (set-box! result (interp p))))))) + (cons (unbox result) output)) + diff --git a/mountebank/interp-prims.rkt b/mountebank/interpreter/interp-prim.rkt similarity index 59% rename from mountebank/interp-prims.rkt rename to mountebank/interpreter/interp-prim.rkt index 7797de6..ea46c7f 100644 --- a/mountebank/interp-prims.rkt +++ b/mountebank/interpreter/interp-prim.rkt @@ -1,18 +1,24 @@ #lang racket -(require "ast.rkt") -(provide interp-prim1 interp-prim2 interp-prim3) +(provide interp-prim0 interp-prim1 interp-prim2 interp-prim3) -;; Op1 Value -> Answer -(define (interp-prim1 p1 v) - (match (list p1 v) +;; Op0 -> Value +(define (interp-prim0 op) + (match op + ['read-byte (read-byte)] + ['peek-byte (peek-byte)] + ['void (void)])) + +;; Op1 Value -> Value { raises 'err } +(define (interp-prim1 op v) + (match (list op v) [(list 'add1 (? integer?)) (add1 v)] [(list 'sub1 (? integer?)) (sub1 v)] [(list 'zero? (? integer?)) (zero? v)] [(list 'char? v) (char? v)] - [(list 'char->integer (? char?)) (char->integer v)] [(list 'integer->char (? codepoint?)) (integer->char v)] + [(list 'char->integer (? char?)) (char->integer v)] + [(list 'write-byte (? byte?)) (write-byte v)] [(list 'eof-object? v) (eof-object? v)] - [(list 'write-byte (? byte?)) (write-byte v)] [(list 'box v) (box v)] [(list 'unbox (? box?)) (unbox v)] [(list 'car (? pair?)) (car v)] @@ -24,51 +30,52 @@ [(list 'vector-length (? vector?)) (vector-length v)] [(list 'string? v) (string? v)] [(list 'string-length (? string?)) (string-length v)] - [(list 'symbol? v) (symbol? v)] - [(list 'symbol->string (? symbol?)) (symbol->string v)] - [(list 'string->symbol (? string?)) (string->symbol v)] - [(list 'string->uninterned-symbol (? string?)) - (string->uninterned-symbol v)] - [_ 'err])) + [(list 'symbol? v) (symbol? v)] + [(list 'symbol->string (? symbol? v)) (symbol->string v)] + [(list 'string->symbol (? string? v)) (string->symbol v)] + [(list 'string->uninterned-symbol (? string? v)) + (string->uninterned-symbol v)] + [_ (raise 'err)])) -;; Op2 Value Value -> Answer -(define (interp-prim2 p v1 v2) - (match (list p v1 v2) - [(list '+ (? integer?) (? integer?)) (+ v1 v2)] - [(list '- (? integer?) (? integer?)) (- v1 v2)] - [(list '< (? integer?) (? integer?)) (< v1 v2)] - [(list '= (? integer?) (? integer?)) (= v1 v2)] +;; Op2 Value Value -> Value { raises 'err } +(define (interp-prim2 op v1 v2) + (match (list op v1 v2) + [(list '+ (? integer?) (? integer?)) (+ v1 v2)] + [(list '- (? integer?) (? integer?)) (- v1 v2)] + [(list '< (? integer?) (? integer?)) (< v1 v2)] + [(list '= (? integer?) (? integer?)) (= v1 v2)] + [(list 'eq? v1 v2) (eq? v1 v2)] [(list 'cons v1 v2) (cons v1 v2)] - [(list 'eq? v1 v2) (eq? v1 v2)] [(list 'make-vector (? integer?) _) (if (<= 0 v1) (make-vector v1 v2) - 'err)] + (raise 'err))] [(list 'vector-ref (? vector?) (? integer?)) (if (<= 0 v2 (sub1 (vector-length v1))) (vector-ref v1 v2) - 'err)] + (raise 'err))] [(list 'make-string (? integer?) (? char?)) (if (<= 0 v1) (make-string v1 v2) - 'err)] + (raise 'err))] [(list 'string-ref (? string?) (? integer?)) (if (<= 0 v2 (sub1 (string-length v1))) (string-ref v1 v2) - 'err)] - [_ 'err])) + (raise 'err))] + [_ (raise 'err)])) -;; Op3 Value Value Value -> Answer +;; Op3 Value Value Value -> Value { raises 'err } (define (interp-prim3 p v1 v2 v3) (match (list p v1 v2 v3) [(list 'vector-set! (? vector?) (? integer?) _) (if (<= 0 v2 (sub1 (vector-length v1))) (vector-set! v1 v2 v3) - 'err)] - [_ 'err])) + (raise 'err))] + [_ (raise 'err)])) ;; Any -> Boolean (define (codepoint? v) (and (integer? v) (or (<= 0 v 55295) (<= 57344 v 1114111)))) + diff --git a/mountebank/interp-stdin.rkt b/mountebank/interpreter/interp-stdin.rkt similarity index 53% rename from mountebank/interp-stdin.rkt rename to mountebank/interpreter/interp-stdin.rkt index 965b9cc..7d85c32 100644 --- a/mountebank/interp-stdin.rkt +++ b/mountebank/interpreter/interp-stdin.rkt @@ -1,12 +1,13 @@ #lang racket (provide main) -(require "parse.rkt" "interp.rkt" "read-all.rkt") +(require "../syntax/parse.rkt") +(require "interp.rkt") +(require "../syntax/read-all.rkt") ;; -> Void ;; Parse and interpret contents of stdin, ;; print result on stdout (define (main) (read-line) ; ignore #lang racket line - (let ((r (interp (parse (read-all))))) - (unless (void? r) - (println r)))) + (println (interp (apply parse-closed (read-all))))) + diff --git a/mountebank/interpreter/interp.rkt b/mountebank/interpreter/interp.rkt new file mode 100644 index 0000000..46d5c35 --- /dev/null +++ b/mountebank/interpreter/interp.rkt @@ -0,0 +1,136 @@ +#lang racket +(provide interp interp-e) +(provide interp-match-pat) +(require "../syntax/ast.rkt") +(require "interp-prim.rkt") +(require "env.rkt") + +;; type Value = +;; | Integer +;; | Boolean +;; | Character +;; | Eof +;; | Void +;; | '() +;; | (cons Value Value) +;; | (box Value) +;; | (string Character ...) +;; | (vector Value ...) +;; | (Value ... -> Answer) + +;; type Answer = Value | 'err + +;; type Env = (Listof (List Id Value)) + +(define (err? x) (eq? x 'err)) +;; ClosedExpr -> Answer +;; Prog -> Answer +(define (interp p) + (with-handlers ([err? identity]) + (match p + [(Prog ds e) + (interp-e e '() ds)]))) +;l Expr Env Defns -> Value { raises 'err } +(define (interp-e e r ds) ;; where r closes e + (match e + [(Var x) (interp-var x r ds)] + [(Lit d) d] + [(Eof) eof] + [(Prim0 p) + (interp-prim0 p)] + [(Prim1 p e) + (interp-prim1 p (interp-e e r ds))] + [(Prim2 p e1 e2) + (interp-prim2 p + (interp-e e1 r ds) + (interp-e e2 r ds))] + [(Prim3 p e1 e2 e3) + (interp-prim3 p + (interp-e e1 r ds) + (interp-e e2 r ds) + (interp-e e3 r ds))] + [(If e1 e2 e3) + (if (interp-e e1 r ds) + (interp-e e2 r ds) + (interp-e e3 r ds))] + [(Begin e1 e2) + (begin (interp-e e1 r ds) + (interp-e e2 r ds))] + [(Let x e1 e2) + (let ((v (interp-e e1 r ds))) + (interp-e e2 (ext r x v) ds))] + [(App e es) + (let ((f (interp-e e r ds)) + (vs (interp-e* es r ds))) + (if (procedure? f) + (apply f vs) + (raise 'err)))] + [(Match e ps es) + (let ((v (interp-e e r ds))) + (interp-match v ps es r ds))] + [(Lam f xs e) + (λ vs + ; check arity matches + (if (= (length xs) (length vs)) + (interp-e e (append (zip xs vs) r) ds) + (raise 'err)))])) + +;; (Listof Expr) REnv Defns -> (Listof Value) { raises 'err } +(define (interp-e* es r ds) + (match es + ['() '()] + [(cons e es) + (cons (interp-e e r ds) + (interp-e* es r ds))])) + +;; Id Env [Listof Defn] -> Answer +(define (interp-var x r ds) + (match (lookup r x) + ['err (match (defns-lookup ds x) + [(Defn f xs e) (interp-e (Lam f xs e) '() ds)] + [#f 'err])] + [v v])) + +;; Value [Listof Pat] [Listof Expr] Env Defns -> Answer +(define (interp-match v ps es r ds) + (match* (ps es) + [('() '()) 'err] + [((cons p ps) (cons e es)) + (match (interp-match-pat p v r) + [#f (interp-match v ps es r ds)] + [r (interp-e e r ds)])])) +;; Pat Value Env -> [Maybe Env] +(define (interp-match-pat p v r) + (match p + [(Var '_) r] + [(Var x) (ext r x v)] + [(Lit l) (and (eqv? l v) r)] + [(Box p) + (match v + [(box v) + (interp-match-pat p v r)] + [_ #f])] + [(Cons p1 p2) + (match v + [(cons v1 v2) + (match (interp-match-pat p1 v1 r) + [#f #f] + [r1 (interp-match-pat p2 v2 r1)])] + [_ #f])] + [(Conj p1 p2) + (match (interp-match-pat p1 v r) + [#f #f] + [r1 (interp-match-pat p2 v r1)])])) + +;; Defns Symbol -> Defn +(define (defns-lookup ds f) + (findf (match-lambda [(Defn g _ _) (eq? f g)]) + ds)) + +(define (zip xs ys) + (match* (xs ys) + [('() '()) '()] + [((cons x xs) (cons y ys)) + (cons (list x y) + (zip xs ys))])) + diff --git a/mountebank/main.c b/mountebank/main.c deleted file mode 100644 index 1ca6115..0000000 --- a/mountebank/main.c +++ /dev/null @@ -1,40 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); -val_t *heap; - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - heap = malloc(8 * heap_size); - - val_t result; - - result = entry(heap); - - print_result(result); - if (val_typeof(result) != T_VOID) - putchar('\n'); - - free(heap); - return 0; -} diff --git a/mountebank/main.rkt b/mountebank/main.rkt new file mode 100644 index 0000000..f9851a3 --- /dev/null +++ b/mountebank/main.rkt @@ -0,0 +1,18 @@ +#lang racket +(require "syntax/ast.rkt") +(require "syntax/parse.rkt") +(require "interpreter/interp.rkt") +(require "interpreter/interp-io.rkt") +(require "compiler/compile.rkt") +(require "runtime/types.rkt") +(require "executor/run.rkt") +(require "executor/exec.rkt") +(provide (all-from-out "syntax/ast.rkt")) +(provide (all-from-out "syntax/parse.rkt")) +(provide (all-from-out "interpreter/interp.rkt")) +(provide (all-from-out "interpreter/interp-io.rkt")) +(provide (all-from-out "compiler/compile.rkt")) +(provide (all-from-out "runtime/types.rkt")) +(provide (all-from-out "executor/run.rkt")) +(provide (all-from-out "executor/exec.rkt")) + diff --git a/mountebank/parse-file.rkt b/mountebank/parse-file.rkt deleted file mode 100644 index a502132..0000000 --- a/mountebank/parse-file.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt" "compile.rkt" "read-all.rkt" a86/printer) - -;; String -> Void -;; Compile contents of given file name, -;; emit asm code on stdout -(define (main fn) - (let ((p (open-input-file fn))) - (begin - (read-line p) ; ignore #lang racket line - (displayln (parse (read-all p))) - (close-input-port p)))) diff --git a/mountebank/parse.rkt b/mountebank/parse.rkt deleted file mode 100644 index 29d4db4..0000000 --- a/mountebank/parse.rkt +++ /dev/null @@ -1,112 +0,0 @@ -#lang racket -(provide parse parse-define parse-e) -(require "ast.rkt") - -;; [Listof S-Expr] -> Prog -(define (parse s) - (match s - [(cons (and (cons 'define _) d) s) - (match (parse s) - [(Prog ds e) - (Prog (cons (parse-define d) ds) e)])] - [(cons e '()) (Prog '() (parse-e e))] - [_ (error "program parse error")])) - -;; S-Expr -> Defn -(define (parse-define s) - (match s - [(list 'define (list-rest (? symbol? f) xs) e) - (if (andmap symbol? xs) - (Defn f xs (parse-e e)) - (error "parse definition error"))] - [_ (error "Parse defn error" s)])) - -;; S-Expr -> Expr -(define (parse-e s) - (match s - [(? self-quoting?) (Quote s)] - [(list 'quote d) (Quote d)] - ['eof (Eof)] - [(? symbol?) (Var s)] - [(list (? (op? op0) p0)) (Prim0 p0)] - [(list (? (op? op1) p1) e) (Prim1 p1 (parse-e e))] - [(list (? (op? op2) p2) e1 e2) (Prim2 p2 (parse-e e1) (parse-e e2))] - [(list (? (op? op3) p3) e1 e2 e3) - (Prim3 p3 (parse-e e1) (parse-e e2) (parse-e e3))] - [(list 'begin e1 e2) - (Begin (parse-e e1) (parse-e e2))] - [(list 'if e1 e2 e3) - (If (parse-e e1) (parse-e e2) (parse-e e3))] - [(list 'let (list (list (? symbol? x) e1)) e2) - (Let x (parse-e e1) (parse-e e2))] - [(cons 'match (cons e ms)) - (parse-match (parse-e e) ms)] - [(list (or 'lambda 'λ) xs e) - (if (and (list? xs) - (andmap symbol? xs)) - (Lam (gensym 'lambda) xs (parse-e e)) - (error "parse lambda error"))] - [(cons e es) - (App (parse-e e) (map parse-e es))] - [_ (error "Parse error" s)])) - -(define (parse-match e ms) - (match ms - ['() (Match e '() '())] - [(cons (list p r) ms) - (match (parse-match e ms) - [(Match e ps es) - (Match e - (cons (parse-pat p) ps) - (cons (parse-e r) es))])])) - -(define (parse-pat p) - (match p - [(? boolean?) (PLit p)] - [(? exact-integer?) (PLit p)] - [(? char?) (PLit p)] - ['_ (PWild)] - [(? symbol?) (PVar p)] - [(? string?) (PStr p)] - [(list 'quote (? symbol? s)) - (PSymb s)] - [(list 'quote (list)) - (PLit '())] - [(list 'box p) - (PBox (parse-pat p))] - [(list 'cons p1 p2) - (PCons (parse-pat p1) (parse-pat p2))] - [(list 'and p1 p2) - (PAnd (parse-pat p1) (parse-pat p2))] - [(cons 'list '()) - (PLit '())] - [(cons 'list (cons p1 ps)) - (PCons (parse-pat p1) - (parse-pat (cons 'list ps)))])) - -(define (self-quoting? x) - (or (integer? x) - (boolean? x) - (char? x) - (string? x) - (box? x) - (vector? x))) - -(define op0 - '(read-byte peek-byte void)) - -(define op1 - '(add1 sub1 zero? char? write-byte eof-object? - integer->char char->integer - box unbox empty? cons? box? car cdr - vector? vector-length string? string-length - symbol? symbol->string string->symbol string->uninterned-symbol)) -(define op2 - '(+ - < = cons eq? make-vector vector-ref make-string string-ref)) -(define op3 - '(vector-set!)) - -(define (op? ops) - (λ (x) - (and (symbol? x) - (memq x ops)))) diff --git a/mountebank/run.rkt b/mountebank/run.rkt deleted file mode 100644 index eaa53eb..0000000 --- a/mountebank/run.rkt +++ /dev/null @@ -1,18 +0,0 @@ -#lang racket -(provide run run/io) -(require "types.rkt" "build-runtime.rkt" - a86/interp) - -;; Asm -> Answer -(define (run is) - (parameterize ((current-objs (list runtime-path))) - (match (asm-interp is) - ['err 'err] - [b (bits->value b)]))) - -;; Asm String -> (cons Answer String) -(define (run/io is s) - (parameterize ((current-objs (list runtime-path))) - (match (asm-interp/io is s) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) diff --git a/mountebank/runtime.h b/mountebank/runtime.h deleted file mode 100644 index cf6a73c..0000000 --- a/mountebank/runtime.h +++ /dev/null @@ -1,15 +0,0 @@ -#ifndef RUNTIME_H -#define RUNTIME_H - -#include "values.h" - -val_t entry(val_t*); -extern FILE* in; -extern FILE* out; -extern void (*error_handler)(); - -// in words -#define heap_size 10000 -extern val_t *heap; - -#endif /* RUNTIME_H */ diff --git a/mountebank/runtime/Makefile b/mountebank/runtime/Makefile new file mode 100644 index 0000000..ee8ff93 --- /dev/null +++ b/mountebank/runtime/Makefile @@ -0,0 +1,29 @@ +ifeq ($(shell uname), Darwin) + LANGS_CC ?= arch -x86_64 clang + LANGS_AS ?= arch -x86_64 clang -c +else + LANGS_CC ?= clang + LANGS_AS ?= clang -c +endif + +CFLAGS += -fPIC -g + +OBJS = \ + main.o \ + values.o \ + print.o \ + io.o \ + symbol.o \ + error.o + +default: runtime.o + +runtime.o: $(OBJS) + ld -r $(OBJS) -o $@ + +%.o: %.c + $(LANGS_CC) $(CFLAGS) -c -o $@ $< + +clean: + @$(RM) *.o runtime.o ||: + @echo "$(shell basename $(shell pwd)): cleaned!" diff --git a/mountebank/char.c b/mountebank/runtime/char.c similarity index 100% rename from mountebank/char.c rename to mountebank/runtime/char.c diff --git a/mountebank/runtime/error.c b/mountebank/runtime/error.c new file mode 100644 index 0000000..69a535a --- /dev/null +++ b/mountebank/runtime/error.c @@ -0,0 +1,9 @@ +#include +#include +#include "runtime.h" + +_Noreturn void raise_error(void) +{ + printf("err\n"); + exit(1); +} diff --git a/mountebank/heap.h b/mountebank/runtime/heap.h similarity index 100% rename from mountebank/heap.h rename to mountebank/runtime/heap.h diff --git a/mountebank/io.c b/mountebank/runtime/io.c similarity index 50% rename from mountebank/io.c rename to mountebank/runtime/io.c index 7ef8228..9f1fc45 100644 --- a/mountebank/io.c +++ b/mountebank/runtime/io.c @@ -1,25 +1,25 @@ #include -#include -#include "types.h" +#include #include "values.h" #include "runtime.h" val_t read_byte(void) { - char c = getc(in); - return (c == EOF) ? val_wrap_eof() : val_wrap_int(c); + int c = getc(stdin); + return (c == EOF) ? val_wrap_eof() : val_wrap_int(c); } val_t peek_byte(void) { - char c = getc(in); - ungetc(c, in); + int c = getc(stdin); + if (c != EOF) + ungetc(c, stdin); return (c == EOF) ? val_wrap_eof() : val_wrap_int(c); - } val_t write_byte(val_t c) { - putc((char) val_unwrap_int(c), out); + int b = val_unwrap_int(c); + putc((unsigned char)b, stdout); return val_wrap_void(); } diff --git a/mountebank/runtime/main.c b/mountebank/runtime/main.c new file mode 100644 index 0000000..610b2bf --- /dev/null +++ b/mountebank/runtime/main.c @@ -0,0 +1,26 @@ +#include +#include +#include "values.h" +#include "print.h" +#include "runtime.h" + +/* in words */ +#define heap_size 10000 + +int main(int argc, char **argv) +{ + val_t *heap = malloc(8 * heap_size); + if (!heap) { + fprintf(stderr, "out of memory\n"); + return 1; + } + + val_t result = entry(heap); + + print_result(result); + if (val_typeof(result) != T_VOID) + putchar('\n'); + + free(heap); + return 0; +} diff --git a/mountebank/print.c b/mountebank/runtime/print.c similarity index 98% rename from mountebank/print.c rename to mountebank/runtime/print.c index 2bcb21d..1a9f8a7 100644 --- a/mountebank/print.c +++ b/mountebank/runtime/print.c @@ -8,6 +8,7 @@ void print_cons(val_cons_t *); void print_vect(val_vect_t*); void print_str(val_str_t*); void print_symb(val_symb_t*); +void print_struct(val_struct_t *); void print_str_char(val_char_t); void print_result_interior(val_t); int utf8_encode_char(val_char_t, char *); @@ -48,11 +49,20 @@ void print_result(val_t x) case T_PROC: printf("#"); break; + case T_STRUCT: + print_struct(val_unwrap_struct(x)); + break; case T_INVALID: printf("internal error"); } } +void print_struct(val_struct_t *s) { + printf("#<"); + print_result_interior(s->name); + printf(">"); +} + void print_symb(val_symb_t *s) { print_str((val_str_t*) s); diff --git a/mountebank/print.h b/mountebank/runtime/print.h similarity index 100% rename from mountebank/print.h rename to mountebank/runtime/print.h diff --git a/mountebank/runtime/runtime.h b/mountebank/runtime/runtime.h new file mode 100644 index 0000000..2ec5ef1 --- /dev/null +++ b/mountebank/runtime/runtime.h @@ -0,0 +1,27 @@ +#ifndef RUNTIME_H +#define RUNTIME_H + +#include "values.h" + +/* + * Entry point for compiled programs. + * + * The caller supplies the heap pointer. Compiled code may use this as its + * initial allocation pointer / runtime heap base according to the language's + * calling convention. + */ +val_t entry(val_t *heap); + +/* + * Language-facing runtime operations used by compiled code. + * + * These are implemented by the runtime core, typically in terms of lower-level + * host hooks declared in host.h. + */ +val_t read_byte(void); +val_t peek_byte(void); +val_t write_byte(val_t); + +_Noreturn void raise_error(void); + +#endif /* RUNTIME_H */ diff --git a/mountebank/symbol.c b/mountebank/runtime/symbol.c similarity index 100% rename from mountebank/symbol.c rename to mountebank/runtime/symbol.c diff --git a/mountebank/types.h b/mountebank/runtime/types.h similarity index 65% rename from mountebank/types.h rename to mountebank/runtime/types.h index 4093c4f..084310e 100644 --- a/mountebank/types.h +++ b/mountebank/runtime/types.h @@ -2,41 +2,51 @@ #define TYPES_H /* - Bit layout of values + * Bit layout of runtime values + * + * Values are either: + * - immediates, tagged with low bits ending in #b000 + * - pointers, tagged with one of the pointer tags below + * + * Immediates include: + * - integers + * - characters + * - booleans + * - eof + * - void + * - empty list + */ - Values are either: - - Immediates: end in #b000 - - Pointers - - Immediates are either - - Integers: end in #b0 000 - - Characters: end in #b01 000 - - True: #b11 000 - - False: #b1 11 000 - - Eof: #b10 11 000 - - Void: #b11 11 000 - - Empty: #b100 11 000 -*/ +/* low bits reserved for pointer/immediate discrimination */ #define imm_shift 3 #define ptr_type_mask ((1 << imm_shift) - 1) + +/* pointer tags */ #define box_type_tag 1 #define cons_type_tag 2 #define vect_type_tag 3 #define str_type_tag 4 #define proc_type_tag 5 #define symb_type_tag 6 +#define struct_type_tag 7 + +/* integer immediates */ #define int_shift (1 + imm_shift) #define int_type_mask ((1 << int_shift) - 1) #define int_type_tag (0 << (int_shift - 1)) #define nonint_type_tag (1 << (int_shift - 1)) + +/* character immediates */ #define char_shift (int_shift + 1) #define char_type_mask ((1 << char_shift) - 1) #define char_type_tag ((0 << (char_shift - 1)) | nonint_type_tag) #define nonchar_type_tag ((1 << (char_shift - 1)) | nonint_type_tag) + +/* distinguished immediate constants */ #define val_true ((0 << char_shift) | nonchar_type_tag) #define val_false ((1 << char_shift) | nonchar_type_tag) #define val_eof ((2 << char_shift) | nonchar_type_tag) #define val_void ((3 << char_shift) | nonchar_type_tag) #define val_empty ((4 << char_shift) | nonchar_type_tag) -#endif +#endif /* TYPES_H */ diff --git a/mountebank/runtime/types.rkt b/mountebank/runtime/types.rkt new file mode 100644 index 0000000..79c8486 --- /dev/null +++ b/mountebank/runtime/types.rkt @@ -0,0 +1,64 @@ +#lang racket +(provide (all-defined-out)) + +(define imm-shift 3) +(define imm-mask #b111) +(define ptr-mask #b111) +(define type-box #b001) +(define type-cons #b010) +(define type-vect #b011) +(define type-str #b100) +(define type-proc #b101) +(define type-symb #b110) +(define type-bint #b110) +(define int-shift (+ 1 imm-shift)) +(define mask-int #b1111) +(define char-shift (+ 2 imm-shift)) +(define type-int #b0000) +(define type-char #b01000) +(define mask-char #b11111) + +;; Value -> Integer +;; v must be an immediate +(define (value->bits v) + (cond [(eq? v #t) #b00011000] + [(eq? v #f) #b00111000] + [(eq? v eof) #b01011000] + [(eq? v (void)) #b01111000] + [(eq? v '()) #b10011000] + [(integer? v) (arithmetic-shift v int-shift)] + [(char? v) + (bitwise-ior type-char + (arithmetic-shift (char->integer v) char-shift))] + [else (error "not an immediate value" v)])) + +(define (int-bits? v) + (= type-int (bitwise-and v mask-int))) + +(define (char-bits? v) + (= type-char (bitwise-and v mask-char))) + +(define (imm-bits? v) + (zero? (bitwise-and v imm-mask))) + +(define (cons-bits? v) + (= type-cons (bitwise-and v imm-mask))) + +(define (box-bits? v) + (= type-box (bitwise-and v imm-mask))) + +(define (vect-bits? v) + (= type-vect (bitwise-and v imm-mask))) + +(define (str-bits? v) + (= type-str (bitwise-and v imm-mask))) + +(define (bignum-bits? v) + (= type-bint (bitwise-and v imm-mask))) + +(define (proc-bits? v) + (= type-proc (bitwise-and v imm-mask))) + +(define (symb-bits? v) + (= type-symb (bitwise-and v imm-mask))) + diff --git a/mountebank/values.c b/mountebank/runtime/values.c similarity index 90% rename from mountebank/values.c rename to mountebank/runtime/values.c index 32e922b..6627fc2 100644 --- a/mountebank/values.c +++ b/mountebank/runtime/values.c @@ -16,6 +16,8 @@ type_t val_typeof(val_t x) return T_SYMB; case proc_type_tag: return T_PROC; + case struct_type_tag: + return T_STRUCT; } if ((int_type_mask & x) == int_type_tag) @@ -119,3 +121,12 @@ val_t val_wrap_symb(val_symb_t *v) { return ((val_t)v) | symb_type_tag; } + +val_struct_t* val_unwrap_struct(val_t x) +{ + return (val_struct_t *)(x ^ struct_type_tag); +} +val_t val_wrap_struct(val_struct_t* v) +{ + return ((val_t)v) | struct_type_tag; +} diff --git a/mountebank/runtime/values.h b/mountebank/runtime/values.h new file mode 100644 index 0000000..5c41275 --- /dev/null +++ b/mountebank/runtime/values.h @@ -0,0 +1,119 @@ +#ifndef VALUES_H +#define VALUES_H + +#include + +/* + * Abstract runtime value. + * + * All language values are represented as a tagged 64-bit word. + */ +typedef int64_t val_t; + +/* + * Dynamic type tags used by the runtime and printing code. + */ +typedef enum type_t { + T_INVALID = -1, + + /* immediates */ + T_INT, + T_BOOL, + T_CHAR, + T_EOF, + T_VOID, + T_EMPTY, + + /* heap objects */ + T_BOX, + T_CONS, + T_VECT, + T_STR, + T_SYMB, + T_PROC, + T_STRUCT, +} type_t; + +typedef uint32_t val_char_t; + +/* + * Heap object layouts. + * + * These layouts correspond to the pointer-tagged representations in types.h. + */ +typedef struct val_box_t { + val_t val; +} val_box_t; + +typedef struct val_cons_t { + val_t snd; + val_t fst; +} val_cons_t; + +typedef struct val_vect_t { + uint64_t len; + val_t elems[]; +} val_vect_t; + +typedef struct val_str_t { + uint64_t len; + val_char_t codepoints[]; +} val_str_t; + +typedef struct val_symb_t { + uint64_t len; + val_char_t codepoints[]; +} val_symb_t; + +typedef struct val_struct_t { + val_t name; + val_t *vals; +} val_struct_t; + +/* + * Classify a runtime value. + */ +type_t val_typeof(val_t x); + +/* + * Wrap/unwrap operations. + * + * The behavior of unwrap functions is undefined on type mismatch. + */ + +/* integers */ +int64_t val_unwrap_int(val_t x); +val_t val_wrap_int(int64_t i); + +/* booleans */ +int val_unwrap_bool(val_t x); +val_t val_wrap_bool(int b); + +/* characters */ +val_char_t val_unwrap_char(val_t x); +val_t val_wrap_char(val_char_t c); + +/* special values */ +val_t val_wrap_eof(void); +val_t val_wrap_void(void); + +/* heap objects */ +val_box_t *val_unwrap_box(val_t x); +val_t val_wrap_box(val_box_t *b); + +val_cons_t *val_unwrap_cons(val_t x); +val_t val_wrap_cons(val_cons_t *c); + +val_vect_t *val_unwrap_vect(val_t x); +val_t val_wrap_vect(val_vect_t *v); + +val_str_t *val_unwrap_str(val_t x); +val_t val_wrap_str(val_str_t *v); + +val_symb_t *val_unwrap_symb(val_t x); +val_t val_wrap_symb(val_symb_t *v); + +val_struct_t *val_unwrap_struct(val_t x); +val_t val_wrap_struct(val_struct_t *v); + +#endif /* VALUES_H */ diff --git a/mountebank/simple-interp.rkt b/mountebank/simple-interp.rkt deleted file mode 100644 index e2eb2b6..0000000 --- a/mountebank/simple-interp.rkt +++ /dev/null @@ -1,59 +0,0 @@ -#lang racket - -;; type Expr = Number -;; | Boolean -;; | (list Op1 Expr) -;; | (list Op2 Expr) -;; | (list 'if Expr Expr Expr) -;; | (list Expr Expr) -;; | (list 'λ (list Id) Expr) -;; | Id - -;; type Id = Symbol -;; type Op1 = 'sub1 | 'zero? -;; type Op2 = '+ - -;; type Value = Number -;; | Boolean -;; | (Value -> Value) - -;; Expr Env -> Value -(define (interp e r) - (match e - [(list '+ e1 e2) - (+ (interp e1 r) (interp e2 r))] - [(list 'sub1 e1) - (sub1 (interp e1 r))] - [(list 'zero? e1) - (zero? (interp e1 r))] - [(list 'if e1 e2 e3) - (if (interp e1 r) - (interp e2 r) - (interp e3 r))] - [(list 'λ (list x) e1) - (λ (v) (interp e1 (cons (cons x v) r)))] - [(list e1 e2) - ((interp e1 r) (interp e2 r))] - [_ - (if (symbol? e) - (lookup e r) - e)])) - -;; Id Env -> Value -(define (lookup x r) - (match r - [(cons (cons y v) r) - (if (eq? x y) - v - (lookup x r))])) - -(interp '(((λ (t) - ((λ (f) (t (λ (z) ((f f) z)))) - (λ (f) (t (λ (z) ((f f) z)))))) - (λ (tri) - (λ (n) - (if (zero? n) - 0 - (+ n (tri (sub1 n))))))) - 36) - '()) diff --git a/mountebank/syntax/ast.rkt b/mountebank/syntax/ast.rkt new file mode 100644 index 0000000..8330791 --- /dev/null +++ b/mountebank/syntax/ast.rkt @@ -0,0 +1,75 @@ +#lang racket +(provide Lit Prim0 Prim1 Prim2 Prim3 If + Eof Begin + Let Var Prog Defn App + Match Box Cons Conj + Lam) + +;; type Prog = (Prog (Listof Defn) Expr) +(struct Prog (ds e) #:prefab) + +;; type Defn = (Defn Id (Listof Id) Expr) +(struct Defn (f xs e) #:prefab) +;; type Expr = (Lit Datum) +;; | (Eof) +;; | (Prim0 Op0) +;; | (Prim1 Op1 Expr) +;; | (Prim2 Op2 Expr Expr) +;; | (Prim3 Op3 Expr Expr Expr) +;; | (If Expr Expr Expr) +;; | (Begin Expr Expr) +;; | (Let Id Expr Expr) +;; | (Var Id) +;; | (App Expr (Listof Expr)) +;; | (Match Expr (Listof Pat) (Listof Expr)) +;; | (Lam Id (Listof Id) Expr) + +;; type ClosedExpr = { e ∈ Expr | e contains no free variables } + +;; type Id = Symbol +;; type Datum = Integer +;; | Boolean +;; | Character +;; | '() +;; | String +;; | Symbol +;; type Op0 = 'read-byte | 'peek-byte | 'void +;; type Op1 = 'add1 | 'sub1 +;; | 'zero? +;; | 'char? | 'integer->char | 'char->integer +;; | 'write-byte | 'eof-object? +;; | 'car | 'cdr | 'unbox +;; | 'empty? | 'cons? | 'box? +;; | 'box +;; | 'vector? | 'vector-length +;; | 'string? | 'string-length +;; | 'symbol? | 'symbol->string | 'string->symbol | 'string->uninterned-symbol +;; type Op2 = '+ | '- | '< | '= +;; | 'eq? | 'cons +;; | 'make-vector | 'vector-ref +;; | 'make-string | 'string-ref +;; type Op3 = 'vector-set! +;; type Pat = (Var Id) +;; | (Lit Datum) +;; | (Box Pat) +;; | (Cons Pat Pat) +;; | (Conj Pat Pat) + +(struct Eof () #:prefab) +(struct Lit (d) #:prefab) +(struct Prim0 (p) #:prefab) +(struct Prim1 (p e) #:prefab) +(struct Prim2 (p e1 e2) #:prefab) +(struct Prim3 (p e1 e2 e3) #:prefab) +(struct If (e1 e2 e3) #:prefab) +(struct Begin (e1 e2) #:prefab) +(struct Let (x e1 e2) #:prefab) +(struct Var (x) #:prefab) +(struct App (f es) #:prefab) +(struct Lam (f xs e) #:prefab) +(struct Match (e ps es) #:prefab) + +(struct Box (p) #:prefab) +(struct Cons (p1 p2) #:prefab) +(struct Conj (p1 p2) #:prefab) + diff --git a/mountebank/fv.rkt b/mountebank/syntax/fv.rkt similarity index 83% rename from mountebank/fv.rkt rename to mountebank/syntax/fv.rkt index 2377b7e..1cec0d9 100644 --- a/mountebank/fv.rkt +++ b/mountebank/syntax/fv.rkt @@ -28,8 +28,9 @@ ;; Pat -> [Listof Id] (define (bv-pat* p) (match p - [(PVar x) (list x)] - [(PCons p1 p2) (append (bv-pat* p1) (bv-pat* p2))] - [(PAnd p1 p2) (append (bv-pat* p1) (bv-pat* p2))] - [(PBox p) (bv-pat* p)] - [_ '()])) + [(Var x) (list x)] + [(Lit d) '()] + [(Box p) (bv-pat* p)] + [(Cons p1 p2) (append (bv-pat* p1) (bv-pat* p2))] + [(Conj p1 p2) (append (bv-pat* p1) (bv-pat* p2))])) + diff --git a/mountebank/lambdas.rkt b/mountebank/syntax/lambdas.rkt similarity index 100% rename from mountebank/lambdas.rkt rename to mountebank/syntax/lambdas.rkt index 0a24640..83c5aa8 100644 --- a/mountebank/lambdas.rkt +++ b/mountebank/syntax/lambdas.rkt @@ -2,7 +2,6 @@ (require "ast.rkt") (provide lambdas) - ;; Prog -> [Listof Lam] ;; List all of the lambda expressions in p (define (lambdas p) @@ -33,3 +32,4 @@ [(Lam f xs e1) (cons e (lambdas-e e1))] [(Match e ps es) (append (lambdas-e e) (append-map lambdas-e es))] [_ '()])) + diff --git a/mountebank/compile-literals.rkt b/mountebank/syntax/literals.rkt similarity index 58% rename from mountebank/compile-literals.rkt rename to mountebank/syntax/literals.rkt index e2484e1..f3f4fc7 100644 --- a/mountebank/compile-literals.rkt +++ b/mountebank/syntax/literals.rkt @@ -1,38 +1,8 @@ #lang racket -(provide compile-literals init-symbol-table literals) -(require "ast.rkt" - "utils.rkt" - a86/ast) +(provide literals symbols) -(define rdi 'rdi) +(require "ast.rkt") -;; Prog -> Asm -(define (compile-literals p) - (append-map compile-literal (literals p))) - -;; Symbol -> Asm -(define (compile-literal s) - (let ((str (symbol->string s))) - (seq (Label (symbol->data-label s)) - (Dq (string-length str)) - (compile-string-chars (string->list str)) - (if (odd? (string-length str)) - (seq (Dd 0)) - (seq))))) - -;; Prog -> Asm -;; Call intern_symbol on every symbol in the program -(define (init-symbol-table p) - (match (symbols p) - ['() (seq)] - [ss (seq (Sub 'rsp 8) - (append-map init-symbol ss) - (Add 'rsp 8))])) - -;; Symbol -> Asm -(define (init-symbol s) - (seq (Lea rdi (symbol->data-label s)) - (Call 'intern_symbol))) ;; Prog -> [Listof Symbol] (define (literals p) @@ -64,7 +34,7 @@ ;; Expr -> [Listof (U Symbol String)] (define (literals-e e) (match e - [(Quote d) (literals-datum d)] + [(Lit d) (literals-datum d)] [(Prim1 p e) (literals-e e)] [(Prim2 p e1 e2) @@ -85,20 +55,6 @@ (append (literals-e e) (append-map literals-match-clause ps es))] [_ '()])) -;; Pat Expr -> [Listof Symbol] -(define (literals-match-clause p e) - (append (literals-pat p) (literals-e e))) - -;; Pat -> [Listof (U Symbol String)] -(define (literals-pat p) - (match p - [(PSymb s) (list s)] - [(PStr s) (list s)] - [(PBox p) (literals-pat p)] - [(PCons p1 p2) (append (literals-pat p1) (literals-pat p2))] - [(PAnd p1 p2) (append (literals-pat p1) (literals-pat p2))] - [_ '()])) - ;; Datum -> [Listof (U Symbol String)] (define (literals-datum d) (cond @@ -113,10 +69,16 @@ (append-map literals-datum (vector->list d))] [else '()])) -;; [Listof Char] -> Asm -(define (compile-string-chars cs) - (match cs - ['() (seq)] - [(cons c cs) - (seq (Dd (char->integer c)) - (compile-string-chars cs))])) +;; Pat Expr -> [Listof (U Symbol String)] +(define (literals-match-clause p e) + (append (literals-pat p) (literals-e e))) + +;; Pat -> [Listof (U Symbol String)] +(define (literals-pat p) + (match p + [(Lit d) (literals-datum d)] + [(Box p) (literals-pat p)] + [(Cons p1 p2) (append (literals-pat p1) (literals-pat p2))] + [(Conj p1 p2) (append (literals-pat p1) (literals-pat p2))] + [_ '()])) + diff --git a/mountebank/syntax/parse.rkt b/mountebank/syntax/parse.rkt new file mode 100644 index 0000000..067e7c9 --- /dev/null +++ b/mountebank/syntax/parse.rkt @@ -0,0 +1,276 @@ +#lang racket +(provide parse parse-closed parse-e parse-define parse-pattern) +(require "ast.rkt") + +;; [Listof S-Expr] -> Prog +(define (parse . ss) + (match (parse-prog ss (parse-defn-names ss) '()) + [(list _ p) p])) + +;; [Listof S-Expr] -> ClosedProg +(define (parse-closed . ss) + (match (parse-prog ss (parse-defn-names ss) '()) + [(list '() p) p] + [(list ys p) (error "undefined identifiers" ys)])) + +;; S-Expr -> Expr +;; Parse a (potentially open) expression +(define (parse-e s) + (match (parse-e/acc s '() '()) + [(list _ e) e])) + +;; S-Expr -> Expr +;; Parse a (potentially open) definition +(define (parse-define s) + (match (parse-define/acc s '() '()) + [(list _ d) d])) + +;; S-Expr -> Pat +;; Parse a (potentially open) pattern +(define (parse-pattern s) + (match (parse-match-pattern/acc s '() '()) + [(list _ _ p) p])) + +;; S-Expr -> r:[Listof Id] +;; where: (distinct? r) +;; Extracts defined function names from given program-like s-expr +;; Does not fully parse definition +;; Example: +;; (parse-defn-names '((define (f x) x) (define (g y) y) 1) -> '(f g) +(define (parse-defn-names ss) + (define (rec ss fs) + (match ss + [(list s) fs] + [(cons (cons (? (not-in fs) 'define) sd) sr) + (match (parse-defn-name sd) + [f (if (memq f fs) + (error "duplicate definition" f) + (rec sr (cons f fs)))])] + [_ (error "parse error")])) + (rec ss '())) + +(define (parse-defn-name s) + (match s + [(cons (cons (? symbol? f) _) _) f] + [_ (error "parse error")])) +;; S-Expr [Listof Id] [Listof Id] -> (list [Listof Id] Prog) +;; s: program shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables and parse of program +(define (parse-prog s xs ys) + (match s + [(list s) + (match (parse-e/acc s xs ys) + [(list ys e) + (list ys (Prog '() e))])] + [(cons s ss) + (match (parse-define/acc s xs ys) + [(list ys (and d (Defn f _ _))) + (match (parse-prog ss xs ys) + [(list ys (Prog ds e)) + (list ys (Prog (cons d ds) e))])])])) +;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] Defn) +;; s: definition shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables and parse of definition +(define (parse-define/acc s xs ys) + (match s + [(cons 'define sr) + (match sr + [(list (cons (? symbol? g) (and (list (? symbol? zs) ...) (? distinct?))) s) + (match (parse-e/acc s (cons g (append zs xs)) ys) + [(list ys e) + (list ys (Defn g zs e))])] + [_ (error "parse error")])] + [_ (error "parse error")])) +;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] Expr) +;; s: expression shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables and parse of expression +(define (parse-e/acc s xs ys) + (define (rec s xs ys) + (define ns xs) + (match s + [(and 'eof (? (not-in ns))) + (list ys (Eof))] + [(? self-quoting-datum?) + (list ys (Lit s))] + [(list (and 'quote (? (not-in ns))) (list)) + (list ys (Lit '()))] + [(list (and 'quote (? (not-in ns))) (? datum? d)) + (list ys (Lit d))] + [(? symbol? f) + (if (memq s xs) + (list ys (Var s)) + (list (cons s ys) (Var s)))] + [(list-rest (? symbol? (? (not-in ns) k)) sr) + (match k + ['let + (match sr + [(list (list (list (? symbol? x) s1)) s2) + (match (rec s1 xs ys) + [(list ys e1) + (match (rec s2 (cons x xs) ys) + [(list ys e2) + (list ys (Let x e1 e2))])])] + [_ (error "let: bad syntax" s)])] + ['match + (match sr + [(cons s sr) + (match (rec s xs ys) + [(list ys e) + (match (parse-match-clauses/acc sr xs ys) + [(list ys ps es) + (list ys (Match e ps es))])])] + [_ (error "match: bad syntax" s)])] + + [(or 'λ 'lambda) + (match sr + [(list (and (list (? symbol? zs) ...) (? distinct?)) s) + (match (rec s (append zs xs) ys) + [(list ys e) + (list ys (Lam (gensym 'lambda) zs e))])] + [_ (error "lambda: bad syntax" s)])] + [_ + (match (parse-es/acc sr xs ys) + [(list ys es) + (match (cons k es) + [(list (? op0? o)) + (list ys (Prim0 o))] + [(list (? op1? o) e1) + (list ys (Prim1 o e1))] + [(list (? op2? o) e1 e2) + (list ys (Prim2 o e1 e2))] + [(list (? op3? o) e1 e2 e3) + (list ys (Prim3 o e1 e2 e3))] + [(list 'begin e1 e2) + (list ys (Begin e1 e2))] + [(list 'if e1 e2 e3) + (list ys (If e1 e2 e3))] + [(list-rest g es) + (list (cons g ys) (App (Var g) es))])])])] + [(cons s sr) + (match (parse-e/acc s xs ys) + [(list ys e) + (match (parse-es/acc sr xs ys) + [(list ys es) + (list ys (App e es))])])] + [_ + (error "parse error" s)])) + (rec s xs ys)) +;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] [Listof Expr]) +;; s: list of expressions shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables and parse of expressions +(define (parse-es/acc s xs ys) + (match s + ['() (list ys '())] + [(cons s ss) + (match (parse-e/acc s xs ys) + [(list ys e) + (match (parse-es/acc ss xs ys) + [(list ys es) + (list ys (cons e es))])])] + [_ (error "parse error")])) +;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] [Listof Expr]) +;; s: list of match clauses shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables and list of parsed clause patterns and clause expressions +(define (parse-match-clauses/acc sr xs ys) + (match sr + ['() (list ys '() '())] + [(cons (list sp se) sr) + (match (parse-match-pattern/acc sp xs ys) + [(list ys xs p) + (match (parse-e/acc se xs ys) + [(list ys e) + (match (parse-match-clauses/acc sr xs ys) + [(list ys ps es) + (list ys (cons p ps) (cons e es))])])])])) +;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] [Listof Id] Pat) +;; s: list of patterns shaped s-expr to be parsed +;; xs: bound variables +;; ys: free variables +;; returns list of free variables, bound variables, and parse of pattern +(define (parse-match-pattern/acc s xs ys) + (define (rec p xs ys) + (match p + [(? self-quoting-datum?) (list ys xs (Lit p))] + ['_ (list ys xs (Var '_))] + [(? symbol?) (list ys (cons p xs) (Var p))] + [(list 'quote (? datum? d)) + (list ys xs (Lit d))] + [(list 'box s) + (match (rec s xs ys) + [(list ys xs p) + (list ys xs (Box p))])] + [(list 'cons s1 s2) + (match (rec s1 xs ys) + [(list ys xs p1) + (match (rec s2 xs ys) + [(list ys xs p2) + (list ys xs (Cons p1 p2))])])] + [(list 'and s1 s2) + (match (rec s1 xs ys) + [(list ys xs p1) + (match (rec s2 xs ys) + [(list ys xs p2) + (list ys xs (Conj p1 p2))])])] + [_ (error "parse pattern error")])) + (rec s xs ys)) + +;; [Listof Any] -> Boolean +(define (distinct? xs) + (not (check-duplicates xs))) + +;; xs:[Listof Any] -> p:(x:Any -> Boolean) +;; Produce a predicate p for things not in xs +(define (not-in xs) + (λ (x) (not (memq x xs)))) +(define (in m) + (λ (x) (memq x m))) + +;; Any -> Boolean +(define (self-quoting-datum? x) + (or (exact-integer? x) + (boolean? x) + (char? x) + (string? x) + (and (box? x) + (datum? (unbox x))) + (and (vector? x) + (andmap datum? (vector->list x))))) + +;; Any -> Boolean +(define (datum? x) + (or (self-quoting-datum? x) + (empty? x) + (symbol? x) + (and (pair? x) + (datum? (car x)) + (datum? (cdr x))))) + +;; Any -> Boolean +(define (op0? x) + (memq x '(read-byte peek-byte void))) + +(define (op1? x) + (memq x '(add1 sub1 zero? + char? integer->char char->integer + write-byte eof-object? + box unbox empty? cons? box? car cdr + vector? vector-length string? string-length + symbol? symbol->string string->symbol string->uninterned-symbol))) + +(define (op2? x) + (memq x '(+ - < = eq? cons + make-vector vector-ref make-string string-ref))) + +(define (op3? x) + (memq x '(vector-set!))) + diff --git a/mountebank/read-all.rkt b/mountebank/syntax/read-all.rkt similarity index 99% rename from mountebank/read-all.rkt rename to mountebank/syntax/read-all.rkt index 8a3289a..a83fe69 100644 --- a/mountebank/read-all.rkt +++ b/mountebank/syntax/read-all.rkt @@ -6,3 +6,4 @@ (if (eof-object? r) '() (cons r (read-all))))) + diff --git a/mountebank/test/build-runtime.rkt b/mountebank/test/build-runtime.rkt deleted file mode 100644 index 7023ee0..0000000 --- a/mountebank/test/build-runtime.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require a86/interp) - -;; link with runtime for IO operations -(unless (file-exists? "../runtime.o") - (system "make -C .. runtime.o")) -(current-objs - (list (path->string (normalize-path "../runtime.o")))) diff --git a/mountebank/test/compile.rkt b/mountebank/test/compile.rkt index ee289de..76fdb1a 100644 --- a/mountebank/test/compile.rkt +++ b/mountebank/test/compile.rkt @@ -1,8 +1,8 @@ #lang racket -(require "test-runner.rkt" - "../parse.rkt" - "../compile.rkt" - "../run.rkt") +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") +(require "test-runner.rkt") +(test (λ p (run (compile (apply parse-closed p))))) +(test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) -(test-runner (λ p (run (compile (parse p))))) -(test-runner-io (λ (s . p) (run/io (compile (parse p)) s))) diff --git a/mountebank/test/interp-defun.rkt b/mountebank/test/interp-defun.rkt deleted file mode 100644 index 68ef419..0000000 --- a/mountebank/test/interp-defun.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require "test-runner.rkt" - "../parse.rkt" - "../interp-defun.rkt" - "../interp-io.rkt") - -(define (closure->proc xs e r) - ;; Could make this better by calling the interpreter, - ;; but it's only used in tests where all we care about - ;; is that you get a procedure. - (lambda _ - (error "This function is not callable."))) - -(test-runner - (λ p - (match (interp (parse p)) - [(Closure xs e r) (closure->proc xs e r)] - [v v]))) -(test-runner-io - (λ (s . p) - (match (interp/io (parse p) s) - [(cons (Closure xs e r) o) - (cons (closure->proc xs e r) o)] - [r r]))) diff --git a/mountebank/test/interp.rkt b/mountebank/test/interp.rkt index cd7b654..823063f 100644 --- a/mountebank/test/interp.rkt +++ b/mountebank/test/interp.rkt @@ -1,8 +1,8 @@ #lang racket -(require "test-runner.rkt" - "../parse.rkt" - "../interp.rkt" - "../interp-io.rkt") +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") +(require "test-runner.rkt") +(test (λ p (interp (apply parse-closed p)))) +(test/io (λ (in . p) (interp/io (apply parse-closed p) in))) -(test-runner (λ p (interp (parse p)))) -(test-runner-io (λ (s . p) (interp/io (parse p) s))) diff --git a/mountebank/test/parse.rkt b/mountebank/test/parse.rkt new file mode 100644 index 0000000..e03cb56 --- /dev/null +++ b/mountebank/test/parse.rkt @@ -0,0 +1,89 @@ +#lang racket +(require "../syntax/parse.rkt") +(require "../syntax/ast.rkt") +(require rackunit) + +(define (p e) + (Prog '() e)) + +(begin ; Abscond + (check-equal? (parse 42) (p (Lit 42))) + (check-equal? (parse -1) (p (Lit -1)))) +(begin ; Blackmail + (check-equal? (parse '(add1 42)) (p (Prim1 'add1 (Lit 42))))) +(begin ; Dupe + (check-equal? (parse '(if (zero? 1) 2 3)) + (p (If (Prim1 'zero? (Lit 1)) (Lit 2) (Lit 3)))) + (check-equal? (parse '(if #t 2 3)) + (p (If (Lit #t) (Lit 2) (Lit 3))))) +(begin ; Dodger + (check-equal? (parse #\a) (p (Lit #\a))) + (check-equal? (parse '(char->integer #\a)) + (p (Prim1 'char->integer (Lit #\a))))) +(begin ; Evildoer + (check-equal? (parse 'eof) (p (Eof))) + (check-equal? (parse '(void)) (p (Prim0 'void))) + (check-equal? (parse '(read-byte)) (p (Prim0 'read-byte)))) +(begin ; Fraud + (check-equal? (parse 'x) (p (Var 'x))) + (check-exn exn:fail? (λ () (parse-closed 'x))) + (check-equal? (parse '(+ 1 2)) + (p (Prim2 '+ (Lit 1) (Lit 2)))) + (check-equal? (parse '(let ((x 1)) x)) + (p (Let 'x (Lit 1) (Var 'x)))) + (check-equal? (parse-closed '(let ((x 1)) x)) + (p (Let 'x (Lit 1) (Var 'x)))) + (check-equal? (parse 'add1) (p (Var 'add1))) + (check-exn exn:fail? (λ () (parse-closed 'add1))) + (check-equal? (parse '(let ((let 1)) let)) + (p (Let 'let (Lit 1) (Var 'let)))) + (check-equal? (parse '(let ((if 1)) if)) + (p (Let 'if (Lit 1) (Var 'if))))) +(begin ; Hustle + (check-equal? (parse ''()) (p (Lit '()))) + (check-equal? (parse '(box 1)) (p (Prim1 'box (Lit 1)))) + (check-equal? (parse '(cons 1 2)) (p (Prim2 'cons (Lit 1) (Lit 2))))) +(begin ; Hoax + (check-equal? (parse "asdf") (p (Lit "asdf"))) + (check-equal? (parse '(make-string 10 #\a)) + (p (Prim2 'make-string (Lit 10) (Lit #\a))))) + +(begin ; Iniquity + (check-equal? (parse '(define (f x) x) 1) + (Prog (list (Defn 'f '(x) (Var 'x))) (Lit 1))) + (check-equal? (parse '(define (define) 0) '(define)) + (Prog (list (Defn 'define '() (Lit 0))) + (App (Var 'define) '()))) + (check-exn exn:fail? (λ () (parse '(define (f y y) y) 1))) + (check-equal? (parse-closed '(define (f x) (g x)) + '(define (g x) (f x)) + '(f 0)) + (Prog (list (Defn 'f '(x) (App (Var 'g) (list (Var 'x)))) + (Defn 'g '(x) (App (Var 'f) (list (Var 'x))))) + (App (Var 'f) (list (Lit 0)))))) +(begin ; Knock + (check-equal? (parse '(match 1)) + (p (Match (Lit 1) '() '()))) + (check-equal? (parse '(match 1 [_ #t])) + (p (Match (Lit 1) (list (Var '_)) (list (Lit #t))))) + (check-equal? (parse '(match 1 [x x])) + (p (Match (Lit 1) (list (Var 'x)) (list (Var 'x))))) + (check-equal? (parse-closed '(match 1 [x x])) + (p (Match (Lit 1) (list (Var 'x)) (list (Var 'x))))) + (check-equal? (parse '(match 1 [x y])) + (p (Match (Lit 1) (list (Var 'x)) (list (Var 'y))))) + (check-equal? (parse '(match x ['() 1])) + (p (Match (Var 'x) (list (Lit '())) (list (Lit 1))))) + (check-exn exn:fail? (λ () (parse-closed '(match 1 [x y]))))) + +(begin ; Loot + (check-equal? (parse '(f x)) + (p (App (Var 'f) (list (Var 'x)))))) + +(begin ; Mug + (check-equal? (parse ''x) + (p (Lit 'x))) + (check-equal? (parse '(let ((quote 1)) + 'x)) + (p (Let 'quote (Lit 1) (App (Var 'quote) (list (Var 'x))))))) + diff --git a/mountebank/test/test-runner.rkt b/mountebank/test/test-runner.rkt index d4cb5b2..393cef0 100644 --- a/mountebank/test/test-runner.rkt +++ b/mountebank/test/test-runner.rkt @@ -1,452 +1,483 @@ #lang racket -(provide test-runner test-runner-io) +(provide test test/io) (require rackunit) -(define (test-runner run) - ;; Abscond examples - (check-equal? (run 7) 7) - (check-equal? (run -8) -8) +(define (test run) + (begin ;; Abscond + (check-equal? (run 7) 7) + (check-equal? (run -8) -8)) - ;; Blackmail examples - (check-equal? (run '(add1 (add1 7))) 9) - (check-equal? (run '(add1 (sub1 7))) 7) + (begin ;; Blackmail + (check-equal? (run '(add1 (add1 7))) 9) + (check-equal? (run '(add1 (sub1 7))) 7)) - ;; Con examples - (check-equal? (run '(if (zero? 0) 1 2)) 1) - (check-equal? (run '(if (zero? 1) 1 2)) 2) - (check-equal? (run '(if (zero? -7) 1 2)) 2) - (check-equal? (run '(if (zero? 0) - (if (zero? 1) 1 2) - 7)) - 2) - (check-equal? (run '(if (zero? (if (zero? 0) 1 0)) - (if (zero? 1) 1 2) - 7)) - 7) + (begin ;; Con + (check-equal? (run '(if (zero? 0) 1 2)) 1) + (check-equal? (run '(if (zero? 1) 1 2)) 2) + (check-equal? (run '(if (zero? -7) 1 2)) 2) + (check-equal? (run '(if (zero? 0) + (if (zero? 1) 1 2) + 7)) + 2) + (check-equal? (run '(if (zero? (if (zero? 0) 1 0)) + (if (zero? 1) 1 2) + 7)) + 7)) - ;; Dupe examples - (check-equal? (run #t) #t) - (check-equal? (run #f) #f) - (check-equal? (run '(if #t 1 2)) 1) - (check-equal? (run '(if #f 1 2)) 2) - (check-equal? (run '(if 0 1 2)) 1) - (check-equal? (run '(if #t 3 4)) 3) - (check-equal? (run '(if #f 3 4)) 4) - (check-equal? (run '(if 0 3 4)) 3) - (check-equal? (run '(zero? 4)) #f) - (check-equal? (run '(zero? 0)) #t) + (begin ;; Dupe + (check-equal? (run #t) #t) + (check-equal? (run #f) #f) + (check-equal? (run '(if #t 1 2)) 1) + (check-equal? (run '(if #f 1 2)) 2) + (check-equal? (run '(if 0 1 2)) 1) + (check-equal? (run '(if #t 3 4)) 3) + (check-equal? (run '(if #f 3 4)) 4) + (check-equal? (run '(if 0 3 4)) 3) + (check-equal? (run '(zero? 4)) #f) + (check-equal? (run '(zero? 0)) #t)) - ;; Dodger examples - (check-equal? (run #\a) #\a) - (check-equal? (run #\b) #\b) - (check-equal? (run '(char? #\a)) #t) - (check-equal? (run '(char? #t)) #f) - (check-equal? (run '(char? 8)) #f) - (check-equal? (run '(char->integer #\a)) (char->integer #\a)) - (check-equal? (run '(integer->char 955)) #\λ) + (begin ;; Dodger + (check-equal? (run #\a) #\a) + (check-equal? (run #\b) #\b) + (check-equal? (run '(char? #\a)) #t) + (check-equal? (run '(char? #t)) #f) + (check-equal? (run '(char? 8)) #f) + (check-equal? (run '(char->integer #\a)) (char->integer #\a)) + (check-equal? (run '(integer->char 955)) #\λ)) - ;; Extort examples - (check-equal? (run '(add1 #f)) 'err) - (check-equal? (run '(sub1 #f)) 'err) - (check-equal? (run '(zero? #f)) 'err) - (check-equal? (run '(char->integer #f)) 'err) - (check-equal? (run '(integer->char #f)) 'err) - (check-equal? (run '(integer->char -1)) 'err) - (check-equal? (run '(write-byte #f)) 'err) - (check-equal? (run '(write-byte -1)) 'err) - (check-equal? (run '(write-byte 256)) 'err) + (begin ;; Evildoer + (check-equal? (run '(void)) (void)) + (check-equal? (run '(begin 1 2)) 2) + (check-equal? (run '(eof-object? (void))) #f)) - ;; Fraud examples - (check-equal? (run '(let ((x 7)) x)) 7) - (check-equal? (run '(let ((x 7)) 2)) 2) - (check-equal? (run '(let ((x 7)) (add1 x))) 8) - (check-equal? (run '(let ((x (add1 7))) x)) 8) - (check-equal? (run '(let ((x 7)) (let ((y 2)) x))) 7) - (check-equal? (run '(let ((x 7)) (let ((x 2)) x))) 2) - (check-equal? (run '(let ((x 7)) (let ((x (add1 x))) x))) 8) + (begin ;; Extort + (check-equal? (run '(add1 #f)) 'err) + (check-equal? (run '(sub1 #f)) 'err) + (check-equal? (run '(zero? #f)) 'err) + (check-equal? (run '(char->integer #f)) 'err) + (check-equal? (run '(integer->char #f)) 'err) + (check-equal? (run '(integer->char -1)) 'err) + (check-equal? (run '(write-byte #f)) 'err) + (check-equal? (run '(write-byte -1)) 'err) + (check-equal? (run '(write-byte 256)) 'err) + (check-equal? (run '(begin (integer->char 97) + (integer->char 98))) + #\b)) - (check-equal? (run '(let ((x 0)) - (if (zero? x) 7 8))) - 7) - (check-equal? (run '(let ((x 1)) - (add1 (if (zero? x) 7 8)))) - 9) - (check-equal? (run '(+ 3 4)) 7) - (check-equal? (run '(- 3 4)) -1) - (check-equal? (run '(+ (+ 2 1) 4)) 7) - (check-equal? (run '(+ (+ 2 1) (+ 2 2))) 7) - (check-equal? (run '(let ((x (+ 1 2))) - (let ((z (- 4 x))) - (+ (+ x x) z)))) - 7) - (check-equal? (run '(= 5 5)) #t) - (check-equal? (run '(= 4 5)) #f) - (check-equal? (run '(= (add1 4) 5)) #t) - (check-equal? (run '(< 5 5)) #f) - (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f) - - ;; Hustle examples - (check-equal? (run ''()) '()) - (check-equal? (run '(box 1)) (box 1)) - (check-equal? (run '(box -1)) (box -1)) - (check-equal? (run '(cons 1 2)) (cons 1 2)) - (check-equal? (run '(unbox (box 1))) 1) - (check-equal? (run '(car (cons 1 2))) 1) - (check-equal? (run '(cdr (cons 1 2))) 2) - (check-equal? (run '(cons 1 '())) (list 1)) - (check-equal? (run '(let ((x (cons 1 2))) - (begin (cdr x) - (car x)))) - 1) - (check-equal? (run '(let ((x (cons 1 2))) - (let ((y (box 3))) - (unbox y)))) - 3) - (check-equal? (run '(eq? 1 1)) #t) - (check-equal? (run '(eq? 1 2)) #f) - (check-equal? (run '(eq? (cons 1 2) (cons 1 2))) #f) - (check-equal? (run '(let ((x (cons 1 2))) (eq? x x))) #t) + (begin ;; Fraud + (check-equal? (run '(let ((x 7)) x)) 7) + (check-equal? (run '(let ((x 7)) 2)) 2) + (check-equal? (run '(let ((x 7)) (add1 x))) 8) + (check-equal? (run '(let ((x (add1 7))) x)) 8) + (check-equal? (run '(let ((x 7)) (let ((y 2)) x))) 7) + (check-equal? (run '(let ((x 7)) (let ((x 2)) x))) 2) + (check-equal? (run '(let ((x 7)) (let ((x (add1 x))) x))) 8) - ;; Hoax examples - (check-equal? (run '(make-vector 0 0)) #()) - (check-equal? (run '(make-vector 1 0)) #(0)) - (check-equal? (run '(make-vector 3 0)) #(0 0 0)) - (check-equal? (run '(make-vector 3 5)) #(5 5 5)) - (check-equal? (run '(vector? (make-vector 0 0))) #t) - (check-equal? (run '(vector? (cons 0 0))) #f) - (check-equal? (run '(vector-ref (make-vector 0 #f) 0)) 'err) - (check-equal? (run '(vector-ref (make-vector 3 5) -1)) 'err) - (check-equal? (run '(vector-ref (make-vector 3 5) 0)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 1)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 2)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 3)) 'err) - (check-equal? (run '(let ((x (make-vector 3 5))) - (begin (vector-set! x 0 4) - x))) - #(4 5 5)) - (check-equal? (run '(let ((x (make-vector 3 5))) - (begin (vector-set! x 1 4) - x))) - #(5 4 5)) - (check-equal? (run '(vector-length (make-vector 3 #f))) 3) - (check-equal? (run '(vector-length (make-vector 0 #f))) 0) - (check-equal? (run '"") "") - (check-equal? (run '"fred") "fred") - (check-equal? (run '"wilma") "wilma") - (check-equal? (run '(make-string 0 #\f)) "") - (check-equal? (run '(make-string 3 #\f)) "fff") - (check-equal? (run '(make-string 3 #\g)) "ggg") - (check-equal? (run '(string-length "")) 0) - (check-equal? (run '(string-length "fred")) 4) - (check-equal? (run '(string-ref "" 0)) 'err) - (check-equal? (run '(string-ref (make-string 0 #\a) 0)) 'err) - (check-equal? (run '(string-ref "fred" 0)) #\f) - (check-equal? (run '(string-ref "fred" 1)) #\r) - (check-equal? (run '(string-ref "fred" 2)) #\e) - (check-equal? (run '(string-ref "fred" 4)) 'err) - (check-equal? (run '(string? "fred")) #t) - (check-equal? (run '(string? (cons 1 2))) #f) - (check-equal? (run '(begin (make-string 3 #\f) - (make-string 3 #\f))) - "fff") + (check-equal? (run '(let ((x 0)) + (if (zero? x) 7 8))) + 7) + (check-equal? (run '(let ((x 1)) + (add1 (if (zero? x) 7 8)))) + 9) + (check-equal? (run '(+ 3 4)) 7) + (check-equal? (run '(- 3 4)) -1) + (check-equal? (run '(+ (+ 2 1) 4)) 7) + (check-equal? (run '(+ (+ 2 1) (+ 2 2))) 7) + (check-equal? (run '(let ((x (+ 1 2))) + (let ((z (- 4 x))) + (+ (+ x x) z)))) + 7) - ;; Iniquity tests - (check-equal? (run - '(define (f x) x) - '(f 5)) - 5) + (check-equal? (run '(= 5 5)) #t) + (check-equal? (run '(= 4 5)) #f) + (check-equal? (run '(= (add1 4) 5)) #t) + (check-equal? (run '(< 5 5)) #f) + (check-equal? (run '(< 4 5)) #t) + (check-equal? (run '(< (add1 4) 5)) #f)) - (check-equal? (run - '(define (tri x) - (if (zero? x) - 0 - (+ x (tri (sub1 x))))) - '(tri 9)) - 45) + (begin ;; Hustle + (check-equal? (run '(empty? (cons 1 2))) #f) + (check-equal? (run '(box 1)) (box 1)) + (check-equal? (run '(box -1)) (box -1)) + (check-equal? (run '(cons 1 2)) (cons 1 2)) + (check-equal? (run '(unbox (box 1))) 1) + (check-equal? (run '(car (cons 1 2))) 1) + (check-equal? (run '(cdr (cons 1 2))) 2) + (check-equal? (run '(cons 1 '())) (list 1)) + (check-equal? (run '(let ((x (cons 1 2))) + (begin (cdr x) + (car x)))) + 1) + (check-equal? (run '(let ((x (cons 1 2))) + (let ((y (box 3))) + (unbox y)))) + 3) + (check-equal? (run '(eq? 1 1)) #t) + (check-equal? (run '(eq? 1 2)) #f) + (check-equal? (run '(eq? (cons 1 2) (cons 1 2))) #f) + (check-equal? (run '(let ((x (cons 1 2))) (eq? x x))) #t)) - (check-equal? (run - '(define (f x) x) - '(define (g x) (f x)) - '(g 5)) - 5) - (check-equal? (run - '(define (even? x) - (if (zero? x) - #t - (odd? (sub1 x)))) - '(define (odd? x) - (if (zero? x) - #f - (even? (sub1 x)))) - '(even? 101)) - #f) - (check-equal? (run - '(define (map-add1 xs) - (if (empty? xs) - '() - (cons (add1 (car xs)) - (map-add1 (cdr xs))))) - '(map-add1 (cons 1 (cons 2 (cons 3 '()))))) - '(2 3 4)) - (check-equal? (run - '(define (f x) - 10) - '(f 1)) - 10) - (check-equal? (run - '(define (f x) - 10) - '(let ((x 2)) (f 1))) - 10) - (check-equal? (run - '(define (f x y) - 10) - '(f 1 2)) - 10) - (check-equal? (run - '(define (f x y) - 10) - '(let ((z 2)) (f 1 2))) - 10) - (check-equal? (run '(define (f x y) y) - '(f 1 (add1 #f))) - 'err) + (begin ;; Hoax + (check-equal? (run '(make-vector 0 0)) #()) + (check-equal? (run '(make-vector 1 0)) #(0)) + (check-equal? (run '(make-vector 3 0)) #(0 0 0)) + (check-equal? (run '(make-vector 3 5)) #(5 5 5)) + (check-equal? (run '(vector? (make-vector 0 0))) #t) + (check-equal? (run '(vector? (cons 0 0))) #f) + (check-equal? (run '(vector-ref (make-vector 0 #f) 0)) 'err) + (check-equal? (run '(vector-ref (make-vector 3 5) -1)) 'err) + (check-equal? (run '(vector-ref (make-vector 3 5) 0)) 5) + (check-equal? (run '(vector-ref (make-vector 3 5) 1)) 5) + (check-equal? (run '(vector-ref (make-vector 3 5) 2)) 5) + (check-equal? (run '(vector-ref (make-vector 3 5) 3)) 'err) + (check-equal? (run '(let ((x (make-vector 3 5))) + (begin (vector-set! x 0 4) + x))) + #(4 5 5)) + (check-equal? (run '(let ((x (make-vector 3 5))) + (begin (vector-set! x 1 4) + x))) + #(5 4 5)) + (check-equal? (run '(let ((x (make-vector 3 5))) + (begin (vector-set! x 3 4) + x))) + 'err) + (check-equal? (run '(vector-length (make-vector 3 #f))) 3) + (check-equal? (run '(vector-length (make-vector 0 #f))) 0) + (check-equal? (run '"") "") + (check-equal? (run '"fred") "fred") + (check-equal? (run '"wilma") "wilma") + (check-equal? (run '(make-string 0 #t)) 'err) + (check-equal? (run '(make-string 0 #\f)) "") + (check-equal? (run '(make-string 3 #\f)) "fff") + (check-equal? (run '(make-string 3 #\g)) "ggg") + (check-equal? (run '(string-length "")) 0) + (check-equal? (run '(string-length "fred")) 4) + (check-equal? (run '(string-ref "" 0)) 'err) + (check-equal? (run '(string-ref (make-string 0 #\a) 0)) 'err) + (check-equal? (run '(string-ref "fred" 0)) #\f) + (check-equal? (run '(string-ref "fred" 1)) #\r) + (check-equal? (run '(string-ref "fred" 2)) #\e) + (check-equal? (run '(string-ref "fred" 4)) 'err) + (check-equal? (run '(string? "fred")) #t) + (check-equal? (run '(string? (cons 1 2))) #f) + (check-equal? (run '(begin (make-string 3 #\f) + (make-string 3 #\f))) + "fff") + (check-equal? (run '(vector-set! (make-vector 0 #f) 0 #t)) 'err)) - ;; Knock examples - (check-equal? (run '(match 1)) 'err) - (check-equal? (run '(match 1 [1 2])) - 2) - (check-equal? (run '(match 1 [2 1] [1 2])) - 2) - (check-equal? (run '(match 1 [2 1] [1 2] [0 3])) - 2) - (check-equal? (run '(match 1 [2 1] [0 3])) - 'err) - (check-equal? (run '(match 1 [_ 2] [_ 3])) - 2) - (check-equal? (run '(match 1 [x 2] [_ 3])) - 2) - (check-equal? (run '(match 1 [x x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [x x] [_ 3])) - (cons 1 2)) - (check-equal? (run '(match (cons 1 2) [(cons x y) x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [(cons x 2) x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [(cons 3 2) 0] [_ 3])) - 3) - (check-equal? (run '(match 1 [(cons x y) x] [_ 3])) - 3) - (check-equal? (run '(match (cons 1 2) [(cons 1 3) 0] [(cons 1 y) y] [_ 3])) - 2) - (check-equal? (run '(match (box 1) [(box 1) 0] [_ 1])) - 0) - (check-equal? (run '(match (box 1) [(box 2) 0] [_ 1])) - 1) - (check-equal? (run '(match (box 1) [(box x) x] [_ 2])) - 1) + (begin ;; Iniquity + (check-equal? (run + '(define (f x) x) + '(f 5)) + 5) + (check-equal? (run + '(define (tri x) + (if (zero? x) + 0 + (+ x (tri (sub1 x))))) + '(tri 9)) + 45) + + (check-equal? (run + '(define (even? x) + (if (zero? x) + #t + (odd? (sub1 x)))) + '(define (odd? x) + (if (zero? x) + #f + (even? (sub1 x)))) + '(even? 101)) + #f) + + (check-equal? (run + '(define (map-add1 xs) + (if (empty? xs) + '() + (cons (add1 (car xs)) + (map-add1 (cdr xs))))) + '(map-add1 (cons 1 (cons 2 (cons 3 '()))))) + '(2 3 4)) + (check-equal? (run '(define (f x y) y) + '(f 1 (add1 #f))) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1)) + 'err) + (check-equal? (run '(define (f x y) y) + '(f 1 2 3)) + 'err)) + + (begin ;; Knock + (check-equal? (run '(match 1)) 'err) + (check-equal? (run '(match 1 [1 2])) + 2) + (check-equal? (run '(match 1 [2 1] [1 2])) + 2) + (check-equal? (run '(match 1 [2 1] [1 2] [0 3])) + 2) + (check-equal? (run '(match 1 [2 1] [0 3])) + 'err) + (check-equal? (run '(match 1 [_ 2] [_ 3])) + 2) + (check-equal? (run '(match 1 [x 2] [_ 3])) + 2) + (check-equal? (run '(match 1 [x x] [_ 3])) + 1) + (check-equal? (run '(match (cons 1 2) [x x] [_ 3])) + (cons 1 2)) + (check-equal? (run '(match (cons 1 2) [(cons x y) x] [_ 3])) + 1) + (check-equal? (run '(match (cons 1 2) [(cons x 2) x] [_ 3])) + 1) + (check-equal? (run '(match (cons 1 2) [(cons 3 2) 0] [_ 3])) + 3) + (check-equal? (run '(match 1 [(cons x y) x] [_ 3])) + 3) + (check-equal? (run '(match (cons 1 2) [(cons 1 3) 0] [(cons 1 y) y] [_ 3])) + 2) + (check-equal? (run '(match (box 1) [(box 1) 0] [_ 1])) + 0) + (check-equal? (run '(match (box 1) [(box 2) 0] [_ 1])) + 1) + (check-equal? (run '(match (box 1) [(box x) x] [_ 2])) + 1) + (check-equal? (run '(match 1 [8589934592 1] [_ 2])) 2) + (check-equal? (run '(match 8589934592 [8589934592 1] [_ 2])) 1)) + + (begin ;; Loot + (check-true (procedure? (run '(λ (x) x)))) + (check-equal? (run '((λ (x) x) 5)) + 5) + + (check-equal? (run '(let ((f (λ (x) x))) (f 5))) + 5) + (check-equal? (run '(let ((f (λ (x y) x))) (f 5 7))) + 5) + (check-equal? (run '(let ((f (λ (x y) y))) (f 5 7))) + 7) + (check-equal? (run '((let ((x 1)) + (let ((y 2)) + (lambda (z) (cons x (cons y (cons z '())))))) + 3)) + '(1 2 3)) + (check-equal? (run '(define (adder n) + (λ (x) (+ x n))) + '((adder 5) 10)) + 15) + (check-equal? (run '(((λ (t) + ((λ (f) (t (λ (z) ((f f) z)))) + (λ (f) (t (λ (z) ((f f) z)))))) + (λ (tri) + (λ (n) + (if (zero? n) + 0 + (+ n (tri (sub1 n))))))) + 36)) + 666) + (check-equal? (run '(define (tri n) + (if (zero? n) + 0 + (+ n (tri (sub1 n))))) + '(tri 36)) + 666) + (check-equal? (run '(define (tri n) + (match n + [0 0] + [m (+ m (tri (sub1 m)))])) + '(tri 36)) + 666) + (check-equal? (run '((match 8 [8 (lambda (x) x)]) 12)) + 12)) + + (begin ;; Mug + (check-equal? (run '(symbol? 'foo)) #t) + (check-equal? (run '(symbol? (string->symbol "foo"))) #t) + (check-equal? (run '(eq? 'foo 'foo)) #t) + (check-equal? (run '(eq? (string->symbol "foo") + (string->symbol "foo"))) + #t) + (check-equal? (run '(eq? 'foo (string->symbol "foo"))) + #t) + (check-equal? (run '(eq? 'fff (string->symbol (make-string 3 #\f)))) + #t) + (check-equal? (run '(symbol? 'g0)) #t) + (check-equal? (run '(symbol? "g0")) #f) + (check-equal? (run '(symbol? (string->symbol "g0"))) #t) + (check-equal? (run '(symbol? (string->uninterned-symbol "g0"))) #t) + (check-equal? (run '(eq? 'g0 (string->symbol "g0"))) #t) + (check-equal? (run '(eq? 'g0 (string->uninterned-symbol "g0"))) #f) + (check-equal? (run '(eq? (string->uninterned-symbol "g0") (string->uninterned-symbol "g0"))) + #f) + (check-equal? (run '(eq? (symbol->string 'foo) (symbol->string 'foo))) #f) + (check-equal? (run '(string? (symbol->string 'foo))) #t) + (check-equal? (run '(eq? (symbol->string 'foo) "foo")) #f) + (check-equal? (run ''foo) 'foo) + (check-equal? (run '(eq? (match #t [_ "foo"]) "bar")) #f) + (check-equal? (run '(eq? (match #t [_ 'foo]) 'bar)) #f) + (check-equal? (run '(match 'foo ['bar #t] [_ #f])) #f) + (check-equal? (run '(match 'foo ['foo #t] [_ #f])) #t) + (check-equal? (run '(match "foo" ["foo" #t] [_ #f])) #t) + (check-equal? (run '(match "foo" ["bar" #t] [_ #f])) #f) + (check-equal? (run '(match (cons '+ (cons 1 (cons 2 '()))) + [(cons '+ (cons x (cons y '()))) + (+ x y)])) + 3)) - ;; Loot examples - (check-true (procedure? (run '(λ (x) x)))) - (check-equal? (run '((λ (x) x) 5)) - 5) - - (check-equal? (run '(let ((f (λ (x) x))) (f 5))) - 5) - (check-equal? (run '(let ((f (λ (x y) x))) (f 5 7))) - 5) - (check-equal? (run '(let ((f (λ (x y) y))) (f 5 7))) - 7) - (check-equal? (run '((let ((x 1)) - (let ((y 2)) - (lambda (z) (cons x (cons y (cons z '())))))) - 3)) - '(1 2 3)) - (check-equal? (run '(define (adder n) - (λ (x) (+ x n))) - '((adder 5) 10)) - 15) - (check-equal? (run '(((λ (t) - ((λ (f) (t (λ (z) ((f f) z)))) - (λ (f) (t (λ (z) ((f f) z)))))) - (λ (tri) - (λ (n) - (if (zero? n) - 0 - (+ n (tri (sub1 n))))))) - 36)) - 666) - (check-equal? (run '(define (tri n) + (begin ;; Mountebank + (check-equal? (run '#()) + #()) + (check-equal? (run ''#()) + #()) + (check-equal? (run ''#t) + #t) + (check-equal? (run ''7) + 7) + (check-equal? (run ''(1 2 3)) + '(1 2 3)) + (check-equal? (run ''(1 . 2)) + '(1 . 2)) + (check-equal? (run ''(("1") (#() #(1 #(2))) (#&(1)) (#f) (4) (5))) + '(("1") (#() #(1 #(2))) (#&(1)) (#f) (4) (5))) + (check-equal? (run '(define (f) (cons 1 2)) + '(eq? (f) (f))) + #f) + (check-equal? (run '(define (f) '(1 . 2)) + '(eq? (f) (f))) + #t) + (check-equal? (run '(let ((x '(foo . foo))) + (eq? (car x) (cdr x)))) + #t) + (check-equal? + (run '(define (eval e r) + (match e + [(cons 'zero? (cons e '())) + (zero? (eval e r))] + [(cons 'sub1 (cons e '())) + (sub1 (eval e r))] + [(cons '+ (cons e1 (cons e2 '()))) + (+ (eval e1 r) (eval e2 r))] + [(cons 'if (cons e1 (cons e2 (cons e3 '())))) + (if (eval e1 r) + (eval e2 r) + (eval e3 r))] + [(cons 'λ (cons (cons x '()) (cons e '()))) + (lambda (v) (eval e (cons (cons x v) r)))] + [(cons e1 (cons e2 '())) + ((eval e1 r) (eval e2 r))] + [_ + (if (symbol? e) + (lookup r e) + e)])) + '(define (lookup r x) + (match r + [(cons (cons y v) r) + (if (eq? x y) + v + (lookup r x))])) + '(eval '(((λ (t) + ((λ (f) (t (λ (z) ((f f) z)))) + (λ (f) (t (λ (z) ((f f) z)))))) + (λ (tri) + (λ (n) (if (zero? n) 0 - (+ n (tri (sub1 n))))) - '(tri 36)) - 666) - (check-equal? (run '(define (tri n) - (match n - [0 0] - [m (+ m (tri (sub1 m)))])) - '(tri 36)) - 666) - (check-equal? (run '((match 8 [8 (lambda (x) x)]) 12)) - 12) + (+ n (tri (sub1 n))))))) + 36) + '())) + 666))) - ;; Mug examples - (check-equal? (run '(symbol? 'foo)) #t) - (check-equal? (run '(symbol? (string->symbol "foo"))) #t) - (check-equal? (run '(eq? 'foo 'foo)) #t) - (check-equal? (run '(eq? (string->symbol "foo") - (string->symbol "foo"))) - #t) - (check-equal? (run '(eq? 'foo (string->symbol "foo"))) - #t) - (check-equal? (run '(eq? 'fff (string->symbol (make-string 3 #\f)))) - #t) - (check-equal? (run '(symbol? 'g0)) #t) - (check-equal? (run '(symbol? "g0")) #f) - (check-equal? (run '(symbol? (string->symbol "g0"))) #t) - (check-equal? (run '(symbol? (string->uninterned-symbol "g0"))) #t) - (check-equal? (run '(eq? 'g0 (string->symbol "g0"))) #t) - (check-equal? (run '(eq? 'g0 (string->uninterned-symbol "g0"))) #f) - (check-equal? (run '(eq? (string->uninterned-symbol "g0") (string->uninterned-symbol "g0"))) - #f) - (check-equal? (run '(eq? (symbol->string 'foo) (symbol->string 'foo))) #f) - (check-equal? (run '(string? (symbol->string 'foo))) #t) - (check-equal? (run '(eq? (symbol->string 'foo) "foo")) #f) - (check-equal? (run ''foo) 'foo) - (check-equal? (run '(eq? (match #t [_ "foo"]) "bar")) #f) - (check-equal? (run '(eq? (match #t [_ 'foo]) 'bar)) #f) - (check-equal? (run '(match 'foo ['bar #t] [_ #f])) #f) - (check-equal? (run '(match 'foo ['foo #t] [_ #f])) #t) - (check-equal? (run '(match "foo" ["foo" #t] [_ #f])) #t) - (check-equal? (run '(match "foo" ["bar" #t] [_ #f])) #f) - (check-equal? (run '(match (cons '+ (cons 1 (cons 2 '()))) - [(cons '+ (cons x (cons y '()))) - (+ x y)])) - 3) +(define (test/io run) + (begin ;; Evildoer + (check-equal? (run "" 7) (cons 7 "")) + (check-equal? (run "" '(write-byte 97)) (cons (void) "a")) + (check-equal? (run "a" '(read-byte)) (cons 97 "")) + (check-equal? (run "b" '(begin (write-byte 97) (read-byte))) + (cons 98 "a")) + (check-equal? (run "" '(read-byte)) (cons eof "")) + (check-equal? (run "" '(eof-object? (read-byte))) (cons #t "")) + (check-equal? (run "a" '(eof-object? (read-byte))) (cons #f "")) + (check-equal? (run "" '(begin (write-byte 97) (write-byte 98))) + (cons (void) "ab")) - ;; Mountebank examples - (check-equal? (run '#()) - #()) - (check-equal? (run ''#()) - #()) - (check-equal? (run ''#t) - #t) - (check-equal? (run ''7) - 7) - (check-equal? (run ''(1 2 3)) - '(1 2 3)) - (check-equal? (run ''(1 . 2)) - '(1 . 2)) - (check-equal? (run ''(("1") (#() #(1 #(2))) (#&(1)) (#f) (4) (5))) - '(("1") (#() #(1 #(2))) (#&(1)) (#f) (4) (5))) - (check-equal? (run '(define (f) (cons 1 2)) - '(eq? (f) (f))) - #f) - (check-equal? (run '(define (f) '(1 . 2)) - '(eq? (f) (f))) - #t) - (check-equal? (run '(let ((x '(foo . foo))) - (eq? (car x) (cdr x)))) - #t) - (check-equal? - (run '(define (eval e r) - (match e - [(list 'zero? e) - (zero? (eval e r))] - [(list 'sub1 e) - (sub1 (eval e r))] - [(list '+ e1 e2) - (+ (eval e1 r) (eval e2 r))] - [(list 'if e1 e2 e3) - (if (eval e1 r) - (eval e2 r) - (eval e3 r))] - [(list 'λ (list x) e) - (lambda (v) (eval e (cons (cons x v) r)))] - [(list e1 e2) - ((eval e1 r) (eval e2 r))] - [_ - (if (symbol? e) - (lookup r e) - e)])) - '(define (lookup r x) - (match r - [(cons (cons y v) r) - (if (eq? x y) - v - (lookup r x))])) - '(eval '(((λ (t) - ((λ (f) (t (λ (z) ((f f) z)))) - (λ (f) (t (λ (z) ((f f) z)))))) - (λ (tri) - (λ (n) - (if (zero? n) - 0 - (+ n (tri (sub1 n))))))) - 36) - '())) - 666)) + (check-equal? (run "ab" '(peek-byte)) (cons 97 "")) + (check-equal? (run "ab" '(begin (peek-byte) (read-byte))) (cons 97 "")) + (check-equal? (run "†" '(read-byte)) (cons 226 "")) + (check-equal? (run "†" '(peek-byte)) (cons 226 ""))) -(define (test-runner-io run) - ;; Evildoer examples - (check-equal? (run "" 7) (cons 7 "")) - (check-equal? (run "" '(write-byte 97)) (cons (void) "a")) - (check-equal? (run "a" '(read-byte)) (cons 97 "")) - (check-equal? (run "b" '(begin (write-byte 97) (read-byte))) - (cons 98 "a")) - (check-equal? (run "" '(read-byte)) (cons eof "")) - (check-equal? (run "" '(eof-object? (read-byte))) (cons #t "")) - (check-equal? (run "a" '(eof-object? (read-byte))) (cons #f "")) - (check-equal? (run "" '(begin (write-byte 97) (write-byte 98))) - (cons (void) "ab")) + (begin ;; Extort + (check-equal? (run "" '(write-byte #t)) (cons 'err ""))) - (check-equal? (run "ab" '(peek-byte)) (cons 97 "")) - (check-equal? (run "ab" '(begin (peek-byte) (read-byte))) (cons 97 "")) - ;; Extort examples - (check-equal? (run "" '(write-byte #t)) (cons 'err "")) + (begin ;; Fraud + (check-equal? (run "" '(let ((x 97)) (write-byte x))) (cons (void) "a")) + (check-equal? (run "" + '(let ((x 97)) + (begin (write-byte x) + x))) + (cons 97 "a")) + (check-equal? (run "b" '(let ((x 97)) (begin (read-byte) x))) + (cons 97 "")) + (check-equal? (run "b" '(let ((x 97)) (begin (peek-byte) x))) + (cons 97 ""))) - ;; Fraud examples - (check-equal? (run "" '(let ((x 97)) (write-byte x))) (cons (void) "a")) - (check-equal? (run "" - '(let ((x 97)) - (begin (write-byte x) - x))) - (cons 97 "a")) - (check-equal? (run "b" '(let ((x 97)) (begin (read-byte) x))) - (cons 97 "")) - (check-equal? (run "b" '(let ((x 97)) (begin (peek-byte) x))) - (cons 97 "")) + (begin ;; Iniquity + (check-equal? (run "" + '(define (print-alphabet i) + (if (zero? i) + (void) + (begin (write-byte (- 123 i)) + (print-alphabet (sub1 i))))) + '(print-alphabet 26)) + (cons (void) "abcdefghijklmnopqrstuvwxyz")) - ;; Hustle examples - (check-equal? (run "" - '(let ((x 1)) - (begin (write-byte 97) - 1))) - (cons 1 "a")) + (check-equal? (run "" + '(define (f x) + (write-byte x)) + '(f 97)) + (cons (void) "a")) + (check-equal? (run "" + '(define (f x y) + (write-byte x)) + '(f 97 98)) + (cons (void) "a")) + (check-equal? (run "" + '(define (f x) + (let ((y x)) + (write-byte y))) + '(f 97)) + (cons (void) "a")) + (check-equal? (run "" + '(define (f x y) + (let ((y x)) + (write-byte y))) + '(f 97 98)) + (cons (void) "a")) + (check-equal? (run "" + '(define (f x) + (write-byte x)) + '(let ((z 97)) + (f z))) + (cons (void) "a")) + (check-equal? (run "" + '(define (f x y) + (write-byte x)) + '(let ((z 97)) + (f z 98))) + (cons (void) "a"))) - (check-equal? (run "" - '(let ((x 1)) - (let ((y 2)) - (begin (write-byte 97) - 1)))) - (cons 1 "a")) + (begin ;; Knock + (check-equal? (run "" + '(match (write-byte 97) + [_ 1])) + (cons 1 "a"))) + + (begin ;; Loot + (check-equal? (run "" + '((begin (write-byte 97) + (λ (x) + (begin (write-byte x) + (write-byte 99)))) + 98)) + (cons (void) "abc")))) - (check-equal? (run "" - '(let ((x (cons 1 2))) - (begin (write-byte 97) - (car x)))) - (cons 1 "a")) - ;; Iniquity examples - #| - (check-equal? (run "" - '(define (print-alphabet i) - (if (zero? i) - (void) - (begin (write-byte (- 123 i)) - (print-alphabet (sub1 i))))) - '(print-alphabet 26)) - (cons (void) "abcdefghijklmnopqrstuvwxyz")) -|#) diff --git a/mountebank/types.rkt b/mountebank/types.rkt deleted file mode 100644 index f4cbf7d..0000000 --- a/mountebank/types.rkt +++ /dev/null @@ -1,109 +0,0 @@ -#lang racket -(provide (all-defined-out)) -(require ffi/unsafe) - -(define imm-shift 3) -(define imm-mask #b111) -(define ptr-mask #b111) -(define type-box #b001) -(define type-cons #b010) -(define type-vect #b011) -(define type-str #b100) -(define type-proc #b101) -(define type-symb #b110) -(define int-shift (+ 1 imm-shift)) -(define char-shift (+ 2 imm-shift)) -(define type-int #b0000) -(define mask-int #b1111) -(define type-char #b01000) -(define mask-char #b11111) - -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(= b (value->bits eof)) eof] - [(= b (value->bits (void))) (void)] - [(= b (value->bits '())) '()] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [(box-bits? b) - (box (bits->value (heap-ref b)))] - [(cons-bits? b) - (cons (bits->value (heap-ref (+ b 8))) - (bits->value (heap-ref b)))] - [(vect-bits? b) - (if (zero? (untag b)) - (vector) - (build-vector (heap-ref b) - (lambda (j) - (bits->value (heap-ref (+ b (* 8 (add1 j))))))))] - [(str-bits? b) - (if (zero? (untag b)) - (string) - (build-string (heap-ref b) - (lambda (j) - (char-ref (+ b 8) j))))] - [(symb-bits? b) - (string->symbol - (if (zero? (untag b)) - (string) - (build-string (heap-ref b) - (lambda (j) - (char-ref (+ b 8) j)))))] - [(proc-bits? b) - (lambda _ - (error "This function is not callable."))] - [else (error "invalid bits")])) - -(define (value->bits v) - (cond [(eq? v #t) #b00011000] - [(eq? v #f) #b00111000] - [(eof-object? v) #b01011000] - [(void? v) #b01111000] - [(empty? v) #b10011000] - [(integer? v) - (arithmetic-shift v int-shift)] - [(char? v) - (bitwise-ior type-char - (arithmetic-shift (char->integer v) char-shift))] - [else (error "not an immediate value")])) - - -(define (imm-bits? v) - (zero? (bitwise-and v imm-mask))) - -(define (int-bits? v) - (= type-int (bitwise-and v mask-int))) - -(define (char-bits? v) - (= type-char (bitwise-and v mask-char))) - -(define (cons-bits? v) - (= type-cons (bitwise-and v imm-mask))) - -(define (box-bits? v) - (= type-box (bitwise-and v imm-mask))) - -(define (vect-bits? v) - (= type-vect (bitwise-and v imm-mask))) - -(define (str-bits? v) - (= type-str (bitwise-and v imm-mask))) - -(define (proc-bits? v) - (= type-proc (bitwise-and v imm-mask))) - -(define (symb-bits? v) - (= type-symb (bitwise-and v imm-mask))) - -(define (untag i) - (arithmetic-shift (arithmetic-shift i (- (integer-length ptr-mask))) - (integer-length ptr-mask))) - -(define (heap-ref i) - (ptr-ref (cast (untag i) _int64 _pointer) _int64)) - -(define (char-ref i j) - (integer->char (ptr-ref (cast (untag i) _int64 _pointer) _uint32 j))) diff --git a/mountebank/utils.rkt b/mountebank/utils.rkt deleted file mode 100644 index 612b738..0000000 --- a/mountebank/utils.rkt +++ /dev/null @@ -1,33 +0,0 @@ -#lang racket -(provide symbol->data-label lookup pad-stack unpad-stack) -(require a86/ast) - -(define rsp 'rsp) -(define r15 'r15) - -(define (symbol->data-label s) - (symbol->label - (string->symbol (string-append "data_" (symbol->string s))))) - -;; Id CEnv -> [Maybe Integer] -(define (lookup x cenv) - (match cenv - ['() #f] - [(cons y rest) - (match (eq? x y) - [#t 0] - [#f (match (lookup x rest) - [#f #f] - [i (+ 8 i)])])])) - -;; Asm -;; Dynamically pad the stack to be aligned for a call -(define pad-stack - (seq (Mov r15 rsp) - (And r15 #b1000) - (Sub rsp r15))) - -;; Asm -;; Undo the stack alignment after a call -(define unpad-stack - (seq (Add rsp r15))) diff --git a/mountebank/values.h b/mountebank/values.h deleted file mode 100644 index c1de09d..0000000 --- a/mountebank/values.h +++ /dev/null @@ -1,84 +0,0 @@ -#ifndef VALUES_H -#define VALUES_H - -#include - -/* any abstract value */ -typedef int64_t val_t; - -typedef enum type_t { - T_INVALID = -1, - /* immediates */ - T_INT, - T_BOOL, - T_CHAR, - T_EOF, - T_VOID, - T_EMPTY, - /* pointers */ - T_BOX, - T_CONS, - T_VECT, - T_STR, - T_SYMB, - T_PROC, -} type_t; - -typedef uint32_t val_char_t; -typedef struct val_box_t { - val_t val; -} val_box_t; -typedef struct val_cons_t { - val_t snd; - val_t fst; -} val_cons_t; -typedef struct val_vect_t { - uint64_t len; - val_t elems[]; -} val_vect_t; -typedef struct val_str_t { - uint64_t len; - val_char_t codepoints[]; -} val_str_t; -typedef struct val_symb_t { - uint64_t len; - val_char_t codepoints[]; -} val_symb_t; - -/* return the type of x */ -type_t val_typeof(val_t x); - -/** - * Wrap/unwrap values - * - * The behavior of unwrap functions are undefined on type mismatch. - */ -int64_t val_unwrap_int(val_t x); -val_t val_wrap_int(int64_t i); - -int val_unwrap_bool(val_t x); -val_t val_wrap_bool(int b); - -val_char_t val_unwrap_char(val_t x); -val_t val_wrap_char(val_char_t b); - -val_t val_wrap_eof(); - -val_t val_wrap_void(); - -val_box_t* val_unwrap_box(val_t x); -val_t val_wrap_box(val_box_t* b); - -val_cons_t* val_unwrap_cons(val_t x); -val_t val_wrap_cons(val_cons_t* c); - -val_vect_t* val_unwrap_vect(val_t x); -val_t val_wrap_vect(val_vect_t* c); - -val_str_t* val_unwrap_str(val_t x); -val_t val_wrap_str(val_str_t* c); - -val_symb_t* val_unwrap_symb(val_t x); -val_t val_wrap_symb(val_symb_t* c); - -#endif From 3a5fab471c73723fd6c46b7bd76d6f0d26480c02 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 17:08:51 -0400 Subject: [PATCH 10/47] Fix up path. --- con/syntax/random.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/con/syntax/random.rkt b/con/syntax/random.rkt index 5318a89..9119d23 100644 --- a/con/syntax/random.rkt +++ b/con/syntax/random.rkt @@ -1,6 +1,6 @@ #lang racket (provide (all-defined-out)) -(require "../parse.rkt") +(require "parse.rkt") ;; Randomly generate an expression (define (random-expr) From 6fc41b02e64a86b2e3f112b3c83d3edc50298dc6 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 17:11:12 -0400 Subject: [PATCH 11/47] Check for quote binding in parser. --- iniquity/syntax/parse.rkt | 2 +- jig/syntax/parse.rkt | 2 +- knock/syntax/parse.rkt | 6 ++++-- loot/syntax/parse.rkt | 6 ++++-- mug/syntax/parse.rkt | 4 +++- mug/test/parse.rkt | 7 +++++++ 6 files changed, 20 insertions(+), 7 deletions(-) diff --git a/iniquity/syntax/parse.rkt b/iniquity/syntax/parse.rkt index b05e65e..da4f4a0 100644 --- a/iniquity/syntax/parse.rkt +++ b/iniquity/syntax/parse.rkt @@ -101,7 +101,7 @@ (list ys gs (Eof))] [(? datum?) (list ys gs (Lit s))] - [(list 'quote (list)) + [(list (and 'quote (? (not-in ns))) (list)) (list ys gs (Lit '()))] [(? symbol? (? (not-in fs))) (if (memq s xs) diff --git a/jig/syntax/parse.rkt b/jig/syntax/parse.rkt index b87bfa7..3930d04 100644 --- a/jig/syntax/parse.rkt +++ b/jig/syntax/parse.rkt @@ -102,7 +102,7 @@ (list ys gs (Eof))] [(? datum?) (list ys gs (Lit s))] - [(list 'quote (list)) + [(list (and 'quote (? (not-in ns))) (list)) (list ys gs (Lit '()))] [(? symbol? (? (not-in fs))) (if (memq s xs) diff --git a/knock/syntax/parse.rkt b/knock/syntax/parse.rkt index 01680e0..b36f651 100644 --- a/knock/syntax/parse.rkt +++ b/knock/syntax/parse.rkt @@ -108,7 +108,7 @@ (list ys gs (Eof))] [(? datum?) (list ys gs (Lit s))] - [(list 'quote (list)) + [(list (and 'quote (? (not-in ns))) (list)) (list ys gs (Lit '()))] [(? symbol? (? (not-in fs))) (if (memq s xs) @@ -207,11 +207,13 @@ (define (parse-match-pattern/acc s fs xs ys gs) (define (rec p xs ys gs) (match p - [(? datum?) (list ys xs gs (Lit p))] + [(? self-quoting-datum?) (list ys xs gs (Lit p))] ['_ (list ys xs gs (Var '_))] [(? symbol?) (list ys (cons p xs) gs (Var p))] [(list 'quote '()) (list ys xs gs (Lit '()))] + [(list 'quote (? datum? d)) + (list ys xs (Lit d))] [(list 'box s) (match (rec s xs ys gs) [(list ys xs gs p) diff --git a/loot/syntax/parse.rkt b/loot/syntax/parse.rkt index 053439c..30207c5 100644 --- a/loot/syntax/parse.rkt +++ b/loot/syntax/parse.rkt @@ -98,7 +98,7 @@ (list ys (Eof))] [(? datum?) (list ys (Lit s))] - [(list 'quote (list)) + [(list (and 'quote (? (not-in ns))) (list)) (list ys (Lit '()))] [(? symbol? f) (if (memq s xs) @@ -198,11 +198,13 @@ (define (parse-match-pattern/acc s xs ys) (define (rec p xs ys) (match p - [(? datum?) (list ys xs (Lit p))] + [(? self-quoting-datum?) (list ys xs (Lit p))] ['_ (list ys xs (Var '_))] [(? symbol?) (list ys (cons p xs) (Var p))] [(list 'quote '()) (list ys xs (Lit '()))] + [(list 'quote (? datum? d)) + (list ys xs (Lit d))] [(list 'box s) (match (rec s xs ys) [(list ys xs p) diff --git a/mug/syntax/parse.rkt b/mug/syntax/parse.rkt index c8a8a0f..4025e4a 100644 --- a/mug/syntax/parse.rkt +++ b/mug/syntax/parse.rkt @@ -200,13 +200,15 @@ (define (parse-match-pattern/acc s xs ys) (define (rec p xs ys) (match p - [(? datum?) (list ys xs (Lit p))] + [(? self-quoting-datum?) (list ys xs (Lit p))] ['_ (list ys xs (Var '_))] [(? symbol?) (list ys (cons p xs) (Var p))] [(list 'quote '()) (list ys xs (Lit '()))] [(list 'quote (? symbol? s)) (list ys xs (Lit s))] + [(list 'quote (? datum? d)) + (list ys xs (Lit d))] [(list 'box s) (match (rec s xs ys) [(list ys xs p) diff --git a/mug/test/parse.rkt b/mug/test/parse.rkt index e5f05ff..e03cb56 100644 --- a/mug/test/parse.rkt +++ b/mug/test/parse.rkt @@ -80,3 +80,10 @@ (check-equal? (parse '(f x)) (p (App (Var 'f) (list (Var 'x)))))) +(begin ; Mug + (check-equal? (parse ''x) + (p (Lit 'x))) + (check-equal? (parse '(let ((quote 1)) + 'x)) + (p (Let 'quote (Lit 1) (App (Var 'quote) (list (Var 'x))))))) + From dd434d3ca9958cee88a9de6efd71b674c37adcfc Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 17:11:45 -0400 Subject: [PATCH 12/47] ws. --- loot/compiler/compile.rkt | 1 + 1 file changed, 1 insertion(+) diff --git a/loot/compiler/compile.rkt b/loot/compiler/compile.rkt index c32eef1..f87daad 100644 --- a/loot/compiler/compile.rkt +++ b/loot/compiler/compile.rkt @@ -25,6 +25,7 @@ (Push rbx) ; save callee-saved register (Push r15) (Mov rbx rdi) ; recv heap pointer + (compile-defines-values ds) (compile-e e (reverse (define-ids ds)) #f) (Add rsp (* 8 (length ds))) ;; pop function definitions From 4b54a28834136baa1b0a7de47bb4dbdc95b3174c Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 17:14:29 -0400 Subject: [PATCH 13/47] Remove iniquity-gc. --- iniquity-gc/Makefile | 43 -- iniquity-gc/ast.rkt | 53 -- iniquity-gc/build-runtime.rkt | 14 - iniquity-gc/compile-ops.rkt | 427 ---------------- iniquity-gc/compile-stdin.rkt | 10 - iniquity-gc/compile.rkt | 205 -------- iniquity-gc/env.rkt | 15 - iniquity-gc/gc.c | 150 ------ iniquity-gc/interp-io.rkt | 12 - iniquity-gc/interp-prims.rkt | 69 --- iniquity-gc/interp-stdin.rkt | 12 - iniquity-gc/interp.rkt | 110 ---- iniquity-gc/io.c | 25 - iniquity-gc/main.c | 46 -- iniquity-gc/parse.rkt | 65 --- iniquity-gc/print.c | 839 ------------------------------- iniquity-gc/print.h | 8 - iniquity-gc/read-all.rkt | 8 - iniquity-gc/run.rkt | 18 - iniquity-gc/runtime.h | 15 - iniquity-gc/test/all.rkt | 5 - iniquity-gc/test/compile.rkt | 8 - iniquity-gc/test/interp.rkt | 8 - iniquity-gc/test/test-runner.rkt | 312 ------------ iniquity-gc/types.h | 40 -- iniquity-gc/types.rkt | 90 ---- iniquity-gc/values.c | 143 ------ iniquity-gc/values.h | 80 --- 28 files changed, 2830 deletions(-) delete mode 100644 iniquity-gc/Makefile delete mode 100644 iniquity-gc/ast.rkt delete mode 100644 iniquity-gc/build-runtime.rkt delete mode 100644 iniquity-gc/compile-ops.rkt delete mode 100644 iniquity-gc/compile-stdin.rkt delete mode 100644 iniquity-gc/compile.rkt delete mode 100644 iniquity-gc/env.rkt delete mode 100644 iniquity-gc/gc.c delete mode 100644 iniquity-gc/interp-io.rkt delete mode 100644 iniquity-gc/interp-prims.rkt delete mode 100644 iniquity-gc/interp-stdin.rkt delete mode 100644 iniquity-gc/interp.rkt delete mode 100644 iniquity-gc/io.c delete mode 100644 iniquity-gc/main.c delete mode 100644 iniquity-gc/parse.rkt delete mode 100644 iniquity-gc/print.c delete mode 100644 iniquity-gc/print.h delete mode 100644 iniquity-gc/read-all.rkt delete mode 100644 iniquity-gc/run.rkt delete mode 100644 iniquity-gc/runtime.h delete mode 100644 iniquity-gc/test/all.rkt delete mode 100644 iniquity-gc/test/compile.rkt delete mode 100644 iniquity-gc/test/interp.rkt delete mode 100644 iniquity-gc/test/test-runner.rkt delete mode 100644 iniquity-gc/types.h delete mode 100644 iniquity-gc/types.rkt delete mode 100644 iniquity-gc/values.c delete mode 100644 iniquity-gc/values.h diff --git a/iniquity-gc/Makefile b/iniquity-gc/Makefile deleted file mode 100644 index 690ca95..0000000 --- a/iniquity-gc/Makefile +++ /dev/null @@ -1,43 +0,0 @@ -ifeq ($(shell uname), Darwin) - LANGS_CC ?= arch -x86_64 clang - LANGS_AS ?= arch -x86_64 clang -c -else - LANGS_CC ?= clang - LANGS_AS ?= clang -c -endif - -objs = \ - main.o \ - print.o \ - values.o \ - io.o \ - gc.o - -default: submit.zip - -submit.zip: - zip submit.zip -r * \ - -x \*.[os] -x \*~ -x \*zip \ - -x \*Zone.Identifier -x \*\*compiled\*\* - -runtime.o: $(objs) - ld -r $(objs) -o runtime.o - -%.run: %.o runtime.o - $(LANGS_CC) runtime.o $< -o $@ - -.c.o: - $(LANGS_CC) -fPIC -c -g -o $@ $< - -.s.o: - $(LANGS_AS) -o $@ $< - -%.s: %.rkt - cat $< | racket -t compile-stdin.rkt -m > $@ - -clean: - @$(RM) *.o *.s *.run ||: - @echo "$(shell basename $(shell pwd)): cleaned!" - -%.test: %.run %.rkt - @test "$(shell ./$(<))" = "$(shell racket $(word 2,$^))" diff --git a/iniquity-gc/ast.rkt b/iniquity-gc/ast.rkt deleted file mode 100644 index 29e4e06..0000000 --- a/iniquity-gc/ast.rkt +++ /dev/null @@ -1,53 +0,0 @@ -#lang racket -(provide (all-defined-out)) - -;; type Prog = (Prog (Listof Defn) Expr) -(struct Prog (ds e) #:prefab) - -;; type Defn = (Defn Id (Listof Id) Expr) -(struct Defn (f xs e) #:prefab) - -;; type Expr = (Eof) -;; | (Empty) -;; | (Int Integer) -;; | (Bool Boolean) -;; | (Char Character) -;; | (Str String) -;; | (Prim0 Op0) -;; | (Prim1 Op1 Expr) -;; | (Prim2 Op2 Expr Expr) -;; | (Prim3 Op3 Expr Expr Expr) -;; | (If Expr Expr Expr) -;; | (Begin Expr Expr) -;; | (Let Id Expr Expr) -;; | (Var Id) -;; | (App Id (Listof Expr)) -;; type Id = Symbol -;; type Op0 = 'read-byte -;; type Op1 = 'add1 | 'sub1 | 'zero? -;; | 'char? | 'integer->char | 'char->integer -;; | 'write-byte | 'eof-object? -;; | 'box | 'car | 'cdr | 'unbox -;; | 'empty? | 'cons? | 'box? -;; | 'vector? | vector-length -;; | 'string? | string-length -;; type Op2 = '+ | '- | '< | '= -;; | 'cons -;; | 'make-vector | 'vector-ref -;; | 'make-string | 'string-ref -;; type Op3 = 'vector-set! -(struct Eof () #:prefab) -(struct Empty () #:prefab) -(struct Int (i) #:prefab) -(struct Bool (b) #:prefab) -(struct Char (c) #:prefab) -(struct Str (s) #:prefab) -(struct Prim0 (p) #:prefab) -(struct Prim1 (p e) #:prefab) -(struct Prim2 (p e1 e2) #:prefab) -(struct Prim3 (p e1 e2 e3) #:prefab) -(struct If (e1 e2 e3) #:prefab) -(struct Begin (e1 e2) #:prefab) -(struct Let (x e1 e2) #:prefab) -(struct Var (x) #:prefab) -(struct App (f es) #:prefab) diff --git a/iniquity-gc/build-runtime.rkt b/iniquity-gc/build-runtime.rkt deleted file mode 100644 index 66aad89..0000000 --- a/iniquity-gc/build-runtime.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket -(require racket/runtime-path) -(provide runtime-path) - -(define-runtime-path here ".") - -(void - (system (string-append "make -C '" - (path->string (normalize-path here)) - "' runtime.o"))) - -(define runtime-path - (path->string - (normalize-path (build-path here "runtime.o")))) diff --git a/iniquity-gc/compile-ops.rkt b/iniquity-gc/compile-ops.rkt deleted file mode 100644 index 4ce8d09..0000000 --- a/iniquity-gc/compile-ops.rkt +++ /dev/null @@ -1,427 +0,0 @@ -#lang racket -(provide compile-op0 compile-op1 compile-op2 compile-op3 pad-stack unpad-stack allocate) -(require "ast.rkt" "types.rkt" a86/ast) - -(define rax 'rax) ; return -(define eax 'eax) ; 32-bit load/store -(define rbx 'rbx) ; heap -(define rdi 'rdi) ; arg -(define rsi 'rsi) ; arg -(define rdx 'rdx) ; arg -(define rcx 'rcx) ; arg -(define r8 'r8) ; scratch -(define r9 'r9) ; scratch -(define r10 'r10) ; scratch -(define r14 'r14) ; stack pad (non-volatile) -(define r15 'r15) ; stack pad (non-volatile) -(define rsp 'rsp) ; stack -(define rbp 'rbp) ; base stack - -;; Op0 -> Asm -(define (compile-op0 p) - (match p - ['void (seq (Mov rax (value->bits (void))))] - ['read-byte (seq pad-stack - (Call 'read_byte) - unpad-stack)] - ['peek-byte (seq pad-stack - (Call 'peek_byte) - unpad-stack)] - ['dump-memory-stats - (seq (Mov rdi rsp) - (Mov rsi rbp) - (Mov rdx rbx) - pad-stack - (Call 'print_memory) - unpad-stack - (Mov rax (value->bits (void))))] - ['collect-garbage - (seq (Mov rdi rsp) - (Mov rsi rbp) - (Mov rdx rbx) - pad-stack - (Call 'collect_garbage) - unpad-stack - (Mov rbx rax) - (Mov rax (value->bits (void))))])) - -;; Op1 -> Asm -(define (compile-op1 p) - (match p - ['add1 - (seq (assert-integer rax) - (Add rax (value->bits 1)))] - ['sub1 - (seq (assert-integer rax) - (Sub rax (value->bits 1)))] - ['zero? - (seq (assert-integer rax) - (eq-imm 0))] - ['char? - (type-pred mask-char type-char)] - ['char->integer - (seq (assert-char rax) - (Sar rax char-shift) - (Sal rax int-shift))] - ['integer->char - (seq (assert-codepoint rax) - (Sar rax int-shift) - (Sal rax char-shift) - (Xor rax type-char))] - ['eof-object? (eq-imm eof)] - ['write-byte - (seq (assert-byte rax) - pad-stack - (Mov rdi rax) - (Call 'write_byte) - unpad-stack)] - ['box - (seq (Push rax) - (allocate 1) - (Pop rax) - (Mov (Mem rbx 0) rax) - (Mov rax rbx) - (Or rax type-box) - (Add rbx 8))] - ['unbox - (seq (assert-box rax) - (Xor rax type-box) - (Mov rax (Mem rax 0)))] - ['car - (seq (assert-cons rax) - (Xor rax type-cons) - (Mov rax (Mem rax 8)))] - ['cdr - (seq (assert-cons rax) - (Xor rax type-cons) - (Mov rax (Mem rax 0)))] - ['empty? (eq-imm '())] - ['box? - (type-pred ptr-mask type-box)] - ['cons? - (type-pred ptr-mask type-cons)] - ['vector? - (type-pred ptr-mask type-vect)] - ['string? - (type-pred ptr-mask type-str)] - ['vector-length - (let ((zero (gensym)) - (done (gensym))) - (seq (assert-vector rax) - (Xor rax type-vect) - (Cmp rax 0) - (Je zero) - (Mov rax (Mem rax 0)) - (Sal rax int-shift) - (Jmp done) - (Label zero) - (Mov rax 0) - (Label done)))] - ['string-length - (let ((zero (gensym)) - (done (gensym))) - (seq (assert-string rax) - (Xor rax type-str) - (Cmp rax 0) - (Je zero) - (Mov rax (Mem rax 0)) - (Sal rax int-shift) - (Jmp done) - (Label zero) - (Mov rax 0) - (Label done)))])) - -(define (allocate n) - (seq (Mov rdi rsp) - (Mov rsi rbp) - (Mov rdx rbx) - (Mov rcx n) - pad-stack - (Call 'alloc_val) - unpad-stack - (Mov rbx rax))) - -;; Op2 -> Asm -(define (compile-op2 p) - (match p - ['+ - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Add rax r8))] - ['- - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Sub r8 rax) - (Mov rax r8))] - ['< - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Cmp r8 rax) - (Mov rax (value->bits #t)) - (let ((true (gensym))) - (seq (Jl true) - (Mov rax (value->bits #f)) - (Label true))))] - ['= - (seq (Pop r8) - (assert-integer r8) - (assert-integer rax) - (Cmp r8 rax) - (Mov rax (value->bits #t)) - (let ((true (gensym))) - (seq (Je true) - (Mov rax (value->bits #f)) - (Label true))))] - ;; tricky: if you have a pointer in a register, GC might collect - ;; what it points to and create a dangling reference - ['cons - (seq (Push rax) - (allocate 2) - (Pop rax) - (Mov (Mem rbx 0) rax) - (Pop rax) - (Mov (Mem rbx 8) rax) - (Mov rax rbx) - (Or rax type-cons) - (Add rbx 16))] - ['eq? - (seq (Pop r8) - (eq r8 rax))] - ['make-vector - (let ((loop (gensym)) - (done (gensym)) - (empty (gensym))) - (seq (Pop r8) - (assert-natural r8) - (Cmp r8 0) ; special case empty vector - (Je empty) - - - (Push rax) - (Mov rax r8) - (Sar rax int-shift) - (Add rax 1) - (allocate rax) - (Pop rax) - - - (Mov r9 rbx) - (Or r9 type-vect) - - (Sar r8 int-shift) - (Mov (Mem rbx 0) r8) - (Add rbx 8) - - (Label loop) - (Mov (Mem rbx 0) rax) - (Add rbx 8) - (Sub r8 1) - (Cmp r8 0) - (Jne loop) - - (Mov rax r9) - (Jmp done) - - (Label empty) - (Mov rax type-vect) - (Label done)))] - ['vector-ref - (seq (Pop r8) - (assert-vector r8) - (assert-integer rax) - (Cmp rax 0) - (Jl 'raise_error_align) - (Xor r8 type-vect) ; r8 = ptr - (Mov r9 (Mem r8 0)) ; r9 = len - (Sar rax int-shift) ; rax = index - (Sub r9 1) - (Cmp r9 rax) - (Jl 'raise_error_align) - (Sal rax 3) - (Add r8 rax) - (Mov rax (Mem r8 8)))] - - ['make-string - (let ((loop (gensym)) - (done (gensym)) - (empty (gensym))) - (seq (Pop r8) - (assert-natural r8) - (assert-char rax) - (Cmp r8 0) ; special case empty string - (Je empty) - - (Push rax) - (Mov rax r8) - (Sar rax int-shift) - (Add rax 1) ; adds 1 - (Sar rax 1) ; when - (Sal rax 1) ; len is odd - (Add rax 1) - (allocate rax) - (Pop rax) - - - (Mov r9 rbx) - (Or r9 type-str) - - (Sar r8 int-shift) - (Mov (Mem rbx 0) r8) - (Add rbx 8) - - (Sar rax char-shift) - - (Add r8 1) ; adds 1 - (Sar r8 1) ; when - (Sal r8 1) ; len is odd - - (Label loop) - (Mov (Mem rbx 0) eax) - (Add rbx 4) - (Sub r8 1) - (Cmp r8 0) - (Jne loop) - - (Mov rax r9) - (Jmp done) - - (Label empty) - (Mov rax type-str) - (Label done)))] - - - ['string-ref - (seq (Pop r8) - (assert-string r8) - (assert-integer rax) - (Cmp rax 0) - (Jl 'raise_error_align) - (Xor r8 type-str) ; r8 = ptr - (Mov r9 (Mem r8 0)) ; r9 = len - (Sar rax int-shift) ; rax = index - (Sub r9 1) - (Cmp r9 rax) - (Jl 'raise_error_align) - (Sal rax 2) - (Add r8 rax) - (Mov 'eax (Mem r8 8)) - (Sal rax char-shift) - (Or rax type-char))] - - ['set-box! - (seq (Pop r8) - (assert-box r8) - (Xor r8 type-box) - (Mov (Mem r8 0) rax) - (Mov rax (value->bits (void))))])) - -;; Op3 -> Asm -(define (compile-op3 p) - (match p - ['vector-set! - (seq (Pop r10) - (Pop r8) - (assert-vector r8) - (assert-integer r10) - (Cmp r10 0) - (Jl 'raise_error_align) - (Xor r8 type-vect) ; r8 = ptr - (Mov r9 (Mem r8 0)) ; r9 = len - (Sar r10 int-shift) ; r10 = index - (Sub r9 1) - (Cmp r9 r10) - (Jl 'raise_error_align) - (Sal r10 3) - (Add r8 r10) - (Mov (Mem r8 8) rax) - (Mov rax (value->bits (void))))])) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define (assert-type mask type) - (λ (arg) - (seq (Mov r9 arg) - (And r9 mask) - (Cmp r9 type) - (Jne 'raise_error_align)))) - -(define (type-pred mask type) - (let ((l (gensym))) - (seq (And rax mask) - (Cmp rax type) - (Mov rax (value->bits #t)) - (Je l) - (Mov rax (value->bits #f)) - (Label l)))) - -(define assert-integer - (assert-type mask-int type-int)) -(define assert-char - (assert-type mask-char type-char)) -(define assert-box - (assert-type ptr-mask type-box)) -(define assert-cons - (assert-type ptr-mask type-cons)) -(define assert-vector - (assert-type ptr-mask type-vect)) -(define assert-string - (assert-type ptr-mask type-str)) - -(define (assert-codepoint r) - (let ((ok (gensym))) - (seq (assert-integer r) - (Cmp r (value->bits 0)) - (Jl 'raise_error_align) - (Cmp r (value->bits 1114111)) - (Jg 'raise_error_align) - (Cmp r (value->bits 55295)) - (Jl ok) - (Cmp r (value->bits 57344)) - (Jg ok) - (Jmp 'raise_error_align) - (Label ok)))) - -(define (assert-byte r) - (seq (assert-integer r) - (Cmp r (value->bits 0)) - (Jl 'raise_error_align) - (Cmp r (value->bits 255)) - (Jg 'raise_error_align))) - -(define (assert-natural r) - (seq (assert-integer r) - (Cmp r (value->bits 0)) - (Jl 'raise_error_align))) - -;; Value -> Asm -(define (eq-imm imm) - (let ((l1 (gensym))) - (seq (Cmp rax (value->bits imm)) - (Mov rax (value->bits #t)) - (Je l1) - (Mov rax (value->bits #f)) - (Label l1)))) - -(define (eq ir1 ir2) - (let ((l1 (gensym))) - (seq (Cmp ir1 ir2) - (Mov rax (value->bits #t)) - (Je l1) - (Mov rax (value->bits #f)) - (Label l1)))) - -;; Asm -;; Dynamically pad the stack to be aligned for a call -(define pad-stack - (seq (Mov r15 rsp) - (And r15 #b1000) - (Sub rsp r15))) - -;; Asm -;; Undo the stack alignment after a call -(define unpad-stack - (seq (Add rsp r15))) diff --git a/iniquity-gc/compile-stdin.rkt b/iniquity-gc/compile-stdin.rkt deleted file mode 100644 index cfa1510..0000000 --- a/iniquity-gc/compile-stdin.rkt +++ /dev/null @@ -1,10 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt" "compile.rkt" "read-all.rkt" a86/printer) - -;; -> Void -;; Compile contents of stdin, -;; emit asm code on stdout -(define (main) - (read-line) ; ignore #lang racket line - (asm-display (compile (parse (read-all))))) diff --git a/iniquity-gc/compile.rkt b/iniquity-gc/compile.rkt deleted file mode 100644 index fb9b813..0000000 --- a/iniquity-gc/compile.rkt +++ /dev/null @@ -1,205 +0,0 @@ -#lang racket -(provide compile compile-e) -(require "ast.rkt" "types.rkt" "compile-ops.rkt" a86/ast) - -;; Registers used -(define rax 'rax) ; return -(define rbx 'rbx) ; heap -(define rsp 'rsp) ; stack -(define rdi 'rdi) ; arg - -;; type CEnv = [Listof Variable] - -;; Prog -> Asm -(define (compile p) - (match p - [(Prog ds e) - (prog (externs) - (Global 'entry) - (Label 'entry) - (Push 'rbx) - (Push 'rbp) - (Mov 'rbp 'rsp) ; save stack base pointer - (Mov rbx rdi) ; recv heap pointer - (compile-e e '()) - (Pop 'rbp) - (Pop 'rbx) - (Ret) - (compile-defines ds) - (Label 'raise_error_align) - pad-stack - (Call 'raise_error))])) - -(define (externs) - (seq (Extern 'peek_byte) - (Extern 'read_byte) - (Extern 'write_byte) - (Extern 'raise_error) - (Extern 'print_memory) - (Extern 'collect_garbage) - (Extern 'alloc_val))) - -;; [Listof Defn] -> Asm -(define (compile-defines ds) - (match ds - ['() (seq)] - [(cons d ds) - (seq (compile-define d) - (compile-defines ds))])) - -;; Defn -> Asm -(define (compile-define d) - (match d - [(Defn f xs e) - (seq (Label (symbol->label f)) - (compile-e e (reverse xs)) - (Add rsp (* 8 (length xs))) ; pop args - (Ret))])) - -;; Expr CEnv -> Asm -(define (compile-e e c) - (match e - [(Int i) (compile-value i)] - [(Bool b) (compile-value b)] - [(Char c) (compile-value c)] - [(Eof) (compile-value eof)] - [(Empty) (compile-value '())] - [(Var x) (compile-variable x c)] - [(Str s) (compile-string s)] - [(Prim0 p) (compile-prim0 p c)] - [(Prim1 p e) (compile-prim1 p e c)] - [(Prim2 p e1 e2) (compile-prim2 p e1 e2 c)] - [(Prim3 p e1 e2 e3) (compile-prim3 p e1 e2 e3 c)] - [(If e1 e2 e3) (compile-if e1 e2 e3 c)] - [(Begin e1 e2) (compile-begin e1 e2 c)] - [(Let x e1 e2) (compile-let x e1 e2 c)] - [(App f es) (compile-app f es c)])) - -;; Value -> Asm -(define (compile-value v) - (seq (Mov rax (value->bits v)))) - -;; Id CEnv -> Asm -(define (compile-variable x c) - (let ((i (lookup x c))) - (seq (Mov rax (Mem rsp i))))) - -;; String -> Asm -(define (compile-string s) - (let ((len (string-length s))) - (if (zero? len) - (seq (Mov rax type-str)) - (seq (allocate (add1 (quotient (add1 len) 2))) - (Mov rax len) - (Mov (Mem rbx 0) rax) - (compile-string-chars (string->list s) 8) - (Mov rax rbx) - (Or rax type-str) - (Add rbx - (+ 8 (* 4 (if (odd? len) (add1 len) len)))))))) - -;; [Listof Char] Integer -> Asm -(define (compile-string-chars cs i) - (match cs - ['() (seq)] - [(cons c cs) - (seq (Mov rax (char->integer c)) - (Mov (Mem rbx i) 'eax) - (compile-string-chars cs (+ 4 i)))])) - -;; Op0 CEnv -> Asm -(define (compile-prim0 p c) - (compile-op0 p)) - -;; Op1 Expr CEnv -> Asm -(define (compile-prim1 p e c) - (seq (compile-e e c) - (compile-op1 p))) - -;; Op2 Expr Expr CEnv -> Asm -(define (compile-prim2 p e1 e2 c) - (seq (compile-e e1 c) - (Push rax) - (compile-e e2 (cons #f c)) - (compile-op2 p))) - -;; Op3 Expr Expr Expr CEnv -> Asm -(define (compile-prim3 p e1 e2 e3 c) - (seq (compile-e e1 c) - (Push rax) - (compile-e e2 (cons #f c)) - (Push rax) - (compile-e e3 (cons #f (cons #f c))) - (compile-op3 p))) - -;; Expr Expr Expr CEnv -> Asm -(define (compile-if e1 e2 e3 c) - (let ((l1 (gensym 'if)) - (l2 (gensym 'if))) - (seq (compile-e e1 c) - (Cmp rax (value->bits #f)) - (Je l1) - (compile-e e2 c) - (Jmp l2) - (Label l1) - (compile-e e3 c) - (Label l2)))) - -;; Expr Expr CEnv -> Asm -(define (compile-begin e1 e2 c) - (seq (compile-e e1 c) - (compile-e e2 c))) - -;; Id Expr Expr CEnv -> Asm -(define (compile-let x e1 e2 c) - (seq (compile-e e1 c) - (Push rax) - (compile-e e2 (cons x c)) - (Add rsp 8))) - -;; Id [Listof Expr] CEnv -> Asm -;; The return address is placed above the arguments, so callee pops -;; arguments and return address is next frame -(define (compile-app f es c) - (let ((r (gensym 'ret))) - (seq (Lea rax r) - (Push rax) - (compile-es es (cons #f c)) - (Jmp (symbol->label f)) - (Label r)))) - -;; [Listof Expr] CEnv -> Asm -(define (compile-es es c) - (match es - ['() '()] - [(cons e es) - (seq (compile-e e c) - (Push rax) - (compile-es es (cons #f c)))])) - -;; Id CEnv -> Integer -(define (lookup x cenv) - (match cenv - ['() (error "undefined variable:" x)] - [(cons y rest) - (match (eq? x y) - [#t 0] - [#f (+ 8 (lookup x rest))])])) - -;; Symbol -> Label -;; Produce a symbol that is a valid Nasm label -(define (symbol->label s) - (string->symbol - (string-append - "label_" - (list->string - (map (λ (c) - (if (or (char<=? #\a c #\z) - (char<=? #\A c #\Z) - (char<=? #\0 c #\9) - (memq c '(#\_ #\$ #\# #\@ #\~ #\. #\?))) - c - #\_)) - (string->list (symbol->string s)))) - "_" - (number->string (eq-hash-code s) 16)))) diff --git a/iniquity-gc/env.rkt b/iniquity-gc/env.rkt deleted file mode 100644 index c43be9c..0000000 --- a/iniquity-gc/env.rkt +++ /dev/null @@ -1,15 +0,0 @@ -#lang racket -(provide lookup ext) - -;; Env Variable -> Answer -(define (lookup env x) - (match env - ['() 'err] - [(cons (list y i) env) - (match (symbol=? x y) - [#t i] - [#f (lookup env x)])])) - -;; Env Variable Value -> Value -(define (ext r x i) - (cons (list x i) r)) \ No newline at end of file diff --git a/iniquity-gc/gc.c b/iniquity-gc/gc.c deleted file mode 100644 index a5f5e48..0000000 --- a/iniquity-gc/gc.c +++ /dev/null @@ -1,150 +0,0 @@ -#include -#include -#include -#include -#include "values.h" -#include "runtime.h" - -const char* val_typeof_string(int64_t t) { - switch (val_typeof(t)) { - case T_INT: return "INT"; - case T_BOOL: return "BOOL"; - case T_CHAR: return "CHAR"; - case T_EOF: return "EOF"; - case T_VOID: return "VOID"; - case T_EMPTY: return "EMPTY"; - case T_BOX: return "BOX"; - case T_CONS: return "CONS"; - case T_VECT: return "VECT"; - case T_STR: return "STR"; - default: return "UNKNOWN"; - } -} - -void step(val_t** to_curr, val_t** to_next, int count, int* t_back) { - type_t t; - int i; - int size; - val_t v; - val_t *ptr_v; - for (i = 0; i < count; i++) { - v = **to_curr; - t = val_typeof(v); - switch (t) { - case T_BOX: - case T_CONS: - case T_VECT: - case T_STR: - ptr_v = val_unwrap(v); - if (ptr_v >= from && ptr_v < from + heap_size) { - // this is a pointer to from space so we need to deal with it - if (val_unwrap(*ptr_v) >= to && - val_unwrap(*ptr_v) < to + heap_size) { - // it points to a fwd pointer (points in to to-space), so just set - // curr to what it points to. - **to_curr = *ptr_v; - *to_curr = *to_curr + 1; - } else { - // copy, fwd, update - size = val_size(ptr_v, t); - types[*t_back] = t; // enqueue type - *t_back = *t_back + 1; - memcpy(*to_next, ptr_v, 8 * size); // copy - *ptr_v = val_wrap(*to_next, t); // fwd - **to_curr = val_wrap(*to_next, t); // update - *to_next = *to_next + size; - *to_curr = *to_curr + 1; - } - } else { - // looks like a pointer, but doesn't point to from-space - // leave it alone - *to_curr = *to_curr + 1; - } - break; - default: - // not a pointer - *to_curr = *to_curr + 1; - } - } -} - - -int64_t* collect_garbage(int64_t* rsp, int64_t *rbp, int64_t* rbx) { - - printf("Collect garbage: rsp = %" PRIx64 ", rbp = %" PRIx64 ", rbx = %" PRIx64 "\n", - (int64_t)rsp, (int64_t)rbp, (int64_t)rbx); - - int stack_count = rbp - rsp; - - val_t *tmp; - val_t *to_next = to; - val_t *to_curr = to; - - int t_back = 0; - int t_front = 0; - - // Step through everything on the stack - val_t *rsp_curr = rsp; - step(&rsp_curr, &to_next, stack_count, &t_back); - int vi; - // now play catch up between to_curr and to_next - while (to_curr != to_next) { - switch (types[t_front++]) { - case T_VECT: - vi = to_curr[0]; - to_curr++; - step(&to_curr, &to_next, vi, &t_back); - break; - case T_BOX: - step(&to_curr, &to_next, 1, &t_back); - break; - case T_CONS: - step(&to_curr, &to_next, 2, &t_back); - break; - case T_STR: - to_curr = to_curr + 1 + ((*to_curr + 1) / 2); - break; - default: - to_curr++; - break; - } - } - - tmp = from; - from = to; - to = tmp; - return to_next; -} - - -void print_memory(int64_t* rsp, int64_t* rbp, int64_t* rbx) { - - int stack_count = rbp - rsp; - int heap_count = rbx - from; - - printf("----------------------------------------------------------------\n"); - int i; - - printf("STACK:\n"); - for (i = 0; i < stack_count; i++) { - printf("[%" PRIx64 "] = %016" PRIx64 ", %s\n", - (int64_t)rsp + 8*i, rsp[i], val_typeof_string(rsp[i])); - } - printf("HEAP:\n"); - for (i = 0; i < heap_count; i++) { - printf("[%" PRIx64 "] = %016" PRIx64 ", %s\n", - (int64_t)from + 8*i, from[i], val_typeof_string(from[i])); - } -} - -int64_t* alloc_val(int64_t* rsp, int64_t* rbp, int64_t* rbx, int words) { - if (rbx + words >= from + heap_size) { - rbx = collect_garbage(rsp, rbp, rbx); - if (rbx + words >= from + heap_size) { - printf("OUT OF MEMORY!!\n"); - error_handler(); - } - } - // printf("returning %" PRIx64 "\n", (int64_t)rbx); - return rbx; -} diff --git a/iniquity-gc/interp-io.rkt b/iniquity-gc/interp-io.rkt deleted file mode 100644 index 93f7d3c..0000000 --- a/iniquity-gc/interp-io.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide interp/io) -(require "interp.rkt") - -;; (Expr String -> String -;; Interpret e with given string as input, -;; collect output as string (including printed result) -(define (interp/io e in) - (parameterize ((current-output-port (open-output-string)) - (current-input-port (open-input-string in))) - (cons (interp e) - (get-output-string (current-output-port))))) diff --git a/iniquity-gc/interp-prims.rkt b/iniquity-gc/interp-prims.rkt deleted file mode 100644 index 4cbabc6..0000000 --- a/iniquity-gc/interp-prims.rkt +++ /dev/null @@ -1,69 +0,0 @@ -#lang racket -(require "ast.rkt") -(provide interp-prim1 interp-prim2 interp-prim3) - -;; Op1 Value -> Answer -(define (interp-prim1 p1 v) - (match (list p1 v) - [(list 'add1 (? integer?)) (add1 v)] - [(list 'sub1 (? integer?)) (sub1 v)] - [(list 'zero? (? integer?)) (zero? v)] - [(list 'char? v) (char? v)] - [(list 'char->integer (? char?)) (char->integer v)] - [(list 'integer->char (? codepoint?)) (integer->char v)] - [(list 'eof-object? v) (eof-object? v)] - [(list 'write-byte (? byte?)) (write-byte v)] - [(list 'box v) (box v)] - [(list 'unbox (? box?)) (unbox v)] - [(list 'car (? pair?)) (car v)] - [(list 'cdr (? pair?)) (cdr v)] - [(list 'empty? v) (empty? v)] - [(list 'cons? v) (cons? v)] - [(list 'box? v) (box? v)] - [(list 'vector? v) (vector? v)] - [(list 'vector-length (? vector?)) (vector-length v)] - [(list 'string? v) (string? v)] - [(list 'string-length (? string?)) (string-length v)] - [_ 'err])) - -;; Op2 Value Value -> Answer -(define (interp-prim2 p v1 v2) - (match (list p v1 v2) - [(list '+ (? integer?) (? integer?)) (+ v1 v2)] - [(list '- (? integer?) (? integer?)) (- v1 v2)] - [(list '< (? integer?) (? integer?)) (< v1 v2)] - [(list '= (? integer?) (? integer?)) (= v1 v2)] - [(list 'cons v1 v2) (cons v1 v2)] - [(list 'eq? v1 v2) (eq? v1 v2)] - [(list 'make-vector (? integer?) _) - (if (<= 0 v1) - (make-vector v1 v2) - 'err)] - [(list 'vector-ref (? vector?) (? integer?)) - (if (<= 0 v2 (sub1 (vector-length v1))) - (vector-ref v1 v2) - 'err)] - [(list 'make-string (? integer?) (? char?)) - (if (<= 0 v1) - (make-string v1 v2) - 'err)] - [(list 'string-ref (? string?) (? integer?)) - (if (<= 0 v2 (sub1 (string-length v1))) - (string-ref v1 v2) - 'err)] - [_ 'err])) - -;; Op3 Value Value Value -> Answer -(define (interp-prim3 p v1 v2 v3) - (match (list p v1 v2 v3) - [(list 'vector-set! (? vector?) (? integer?) _) - (if (<= 0 v2 (sub1 (vector-length v1))) - (vector-set! v1 v2 v3) - 'err)] - [_ 'err])) - -;; Any -> Boolean -(define (codepoint? v) - (and (integer? v) - (or (<= 0 v 55295) - (<= 57344 v 1114111)))) diff --git a/iniquity-gc/interp-stdin.rkt b/iniquity-gc/interp-stdin.rkt deleted file mode 100644 index 965b9cc..0000000 --- a/iniquity-gc/interp-stdin.rkt +++ /dev/null @@ -1,12 +0,0 @@ -#lang racket -(provide main) -(require "parse.rkt" "interp.rkt" "read-all.rkt") - -;; -> Void -;; Parse and interpret contents of stdin, -;; print result on stdout -(define (main) - (read-line) ; ignore #lang racket line - (let ((r (interp (parse (read-all))))) - (unless (void? r) - (println r)))) diff --git a/iniquity-gc/interp.rkt b/iniquity-gc/interp.rkt deleted file mode 100644 index 3576d43..0000000 --- a/iniquity-gc/interp.rkt +++ /dev/null @@ -1,110 +0,0 @@ -#lang racket -(provide interp interp-env) -(require "ast.rkt" - "env.rkt" - "interp-prims.rkt") - -;; type Answer = Value | 'err - -;; type Value = -;; | Integer -;; | Boolean -;; | Character -;; | Eof -;; | Void -;; | '() -;; | (cons Value Value) -;; | (box Value) -;; | (vector Value ...) -;; | (string Char ...) - -;; type REnv = (Listof (List Id Value)) -;; type Defns = (Listof Defn) - -;; Prog -> Answer -(define (interp p) - (match p - [(Prog ds e) - (interp-env e '() ds)])) - -;; Expr Env Defns -> Answer -(define (interp-env e r ds) - (match e - [(Int i) i] - [(Bool b) b] - [(Char c) c] - [(Eof) eof] - [(Empty) '()] - [(Var x) (lookup r x)] - [(Str s) s] - [(Prim0 'void) (void)] - [(Prim0 'read-byte) (read-byte)] - [(Prim0 'peek-byte) (peek-byte)] - [(Prim0 'dump-memory-stats) (dump-memory-stats)] - [(Prim0 'collect-garbage) (collect-garbage)] - [(Prim1 p e) - (match (interp-env e r ds) - ['err 'err] - [v (interp-prim1 p v)])] - [(Prim2 p e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [v1 (match (interp-env e2 r ds) - ['err 'err] - [v2 (interp-prim2 p v1 v2)])])] - [(Prim3 p e1 e2 e3) - (match (interp-env e1 r ds) - ['err 'err] - [v1 (match (interp-env e2 r ds) - ['err 'err] - [v2 (match (interp-env e3 r ds) - ['err 'err] - [v3 (interp-prim3 p v1 v2 v3)])])])] - [(If p e1 e2) - (match (interp-env p r ds) - ['err 'err] - [v - (if v - (interp-env e1 r ds) - (interp-env e2 r ds))])] - [(Begin e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [_ (interp-env e2 r ds)])] - [(Let x e1 e2) - (match (interp-env e1 r ds) - ['err 'err] - [v (interp-env e2 (ext r x v) ds)])] - [(App f es) - (match (interp-env* es r ds) - ['err 'err] - [vs - (match (defns-lookup ds f) - [(Defn f xs e) - ; check arity matches - (if (= (length xs) (length vs)) - (interp-env e (zip xs vs) ds) - 'err)])])])) - -;; (Listof Expr) REnv Defns -> (Listof Value) | 'err -(define (interp-env* es r ds) - (match es - ['() '()] - [(cons e es) - (match (interp-env e r ds) - ['err 'err] - [v (match (interp-env* es r ds) - ['err 'err] - [vs (cons v vs)])])])) - -;; Defns Symbol -> Defn -(define (defns-lookup ds f) - (findf (match-lambda [(Defn g _ _) (eq? f g)]) - ds)) - -(define (zip xs ys) - (match* (xs ys) - [('() '()) '()] - [((cons x xs) (cons y ys)) - (cons (list x y) - (zip xs ys))])) diff --git a/iniquity-gc/io.c b/iniquity-gc/io.c deleted file mode 100644 index 7ef8228..0000000 --- a/iniquity-gc/io.c +++ /dev/null @@ -1,25 +0,0 @@ -#include -#include -#include "types.h" -#include "values.h" -#include "runtime.h" - -val_t read_byte(void) -{ - char c = getc(in); - return (c == EOF) ? val_wrap_eof() : val_wrap_int(c); -} - -val_t peek_byte(void) -{ - char c = getc(in); - ungetc(c, in); - return (c == EOF) ? val_wrap_eof() : val_wrap_int(c); - -} - -val_t write_byte(val_t c) -{ - putc((char) val_unwrap_int(c), out); - return val_wrap_void(); -} diff --git a/iniquity-gc/main.c b/iniquity-gc/main.c deleted file mode 100644 index 1157f0b..0000000 --- a/iniquity-gc/main.c +++ /dev/null @@ -1,46 +0,0 @@ -#include -#include -#include "values.h" -#include "print.h" -#include "runtime.h" - -FILE* in; -FILE* out; -void (*error_handler)(); -val_t *heap; -val_t *to; -val_t *from; -type_t *types; - -void error_exit() -{ - printf("err\n"); - exit(1); -} - -void raise_error() -{ - return error_handler(); -} - -int main(int argc, char** argv) -{ - in = stdin; - out = stdout; - error_handler = &error_exit; - heap = malloc(2 * 8 * heap_size); - from = heap; - to = heap + heap_size; - types = malloc(sizeof(type_t) * heap_size); - - val_t result; - - result = entry(heap); - - print_result(result); - if (val_typeof(result) != T_VOID) - putchar('\n'); - - free(heap); - return 0; -} diff --git a/iniquity-gc/parse.rkt b/iniquity-gc/parse.rkt deleted file mode 100644 index b5d9565..0000000 --- a/iniquity-gc/parse.rkt +++ /dev/null @@ -1,65 +0,0 @@ -#lang racket -(provide parse parse-define parse-e) -(require "ast.rkt") - -;; [Listof S-Expr] -> Prog -(define (parse s) - (match s - [(cons (and (cons 'define _) d) s) - (match (parse s) - [(Prog ds e) - (Prog (cons (parse-define d) ds) e)])] - [(cons e '()) (Prog '() (parse-e e))] - [_ (error "program parse error")])) - -;; S-Expr -> Defn -(define (parse-define s) - (match s - [(list 'define (list-rest (? symbol? f) xs) e) - (if (andmap symbol? xs) - (Defn f xs (parse-e e)) - (error "parse definition error"))] - [_ (error "Parse defn error" s)])) - -;; S-Expr -> Expr -(define (parse-e s) - (match s - [(? integer?) (Int s)] - [(? boolean?) (Bool s)] - [(? char?) (Char s)] - [(? string?) (Str s)] - ['eof (Eof)] - [(? symbol?) (Var s)] - [(list 'quote (list)) (Empty)] - [(list (? (op? op0) p0)) (Prim0 p0)] - [(list (? (op? op1) p1) e) (Prim1 p1 (parse-e e))] - [(list (? (op? op2) p2) e1 e2) (Prim2 p2 (parse-e e1) (parse-e e2))] - [(list (? (op? op3) p3) e1 e2 e3) - (Prim3 p3 (parse-e e1) (parse-e e2) (parse-e e3))] - [(list 'begin e1 e2) - (Begin (parse-e e1) (parse-e e2))] - [(list 'if e1 e2 e3) - (If (parse-e e1) (parse-e e2) (parse-e e3))] - [(list 'let (list (list (? symbol? x) e1)) e2) - (Let x (parse-e e1) (parse-e e2))] - [(cons (? symbol? f) es) - (App f (map parse-e es))] - [_ (error "Parse error" s)])) - -(define op0 - '(read-byte peek-byte void dump-memory-stats collect-garbage)) - -(define op1 - '(add1 sub1 zero? char? write-byte eof-object? - integer->char char->integer - box unbox empty? cons? box? car cdr - vector? vector-length string? string-length)) -(define op2 - '(+ - < = cons eq? make-vector vector-ref make-string string-ref set-box!)) -(define op3 - '(vector-set!)) - -(define (op? ops) - (λ (x) - (and (symbol? x) - (memq x ops)))) diff --git a/iniquity-gc/print.c b/iniquity-gc/print.c deleted file mode 100644 index acb1413..0000000 --- a/iniquity-gc/print.c +++ /dev/null @@ -1,839 +0,0 @@ -#include -#include -#include "values.h" - -void print_char(val_char_t); -void print_codepoint(val_char_t); -void print_cons(val_cons_t *); -void print_vect(val_vect_t*); -void print_str(val_str_t*); -void print_str_char(val_char_t); -void print_result_interior(val_t); -int utf8_encode_char(val_char_t, char *); - -void print_result(val_t x) -{ - switch (val_typeof(x)) { - case T_INT: - printf("%" PRId64, val_unwrap_int(x)); - break; - case T_BOOL: - printf(val_unwrap_bool(x) ? "#t" : "#f"); - break; - case T_CHAR: - print_char(val_unwrap_char(x)); - break; - case T_EOF: - printf("#"); - break; - case T_VOID: - break; - case T_EMPTY: - case T_BOX: - case T_CONS: - case T_VECT: - printf("'"); - print_result_interior(x); - break; - case T_STR: - putchar('"'); - print_str(val_unwrap_str(x)); - putchar('"'); - break; - case T_INVALID: - printf("internal error"); - } -} - -void print_result_interior(val_t x) -{ - switch (val_typeof(x)) { - case T_EMPTY: - printf("()"); - break; - case T_BOX: - printf("#&"); - print_result_interior(val_unwrap_box(x)->val); - break; - case T_CONS: - printf("("); - print_cons(val_unwrap_cons(x)); - printf(")"); - break; - case T_VECT: - print_vect(val_unwrap_vect(x)); - break; - default: - print_result(x); - } -} - -void print_vect(val_vect_t *v) -{ - uint64_t i; - - if (!v) { printf("#()"); return; } - - printf("#("); - for (i = 0; i < v->len; ++i) { - print_result_interior(v->elems[i]); - - if (i < v->len - 1) - putchar(' '); - } - printf(")"); -} - -void print_cons(val_cons_t *cons) -{ - print_result_interior(cons->fst); - - switch (val_typeof(cons->snd)) { - case T_EMPTY: - // nothing - break; - case T_CONS: - printf(" "); - print_cons(val_unwrap_cons(cons->snd)); - break; - default: - printf(" . "); - print_result_interior(cons->snd); - break; - } -} - -void print_str(val_str_t* s) -{ - if (!s) return; - uint64_t i; - for (i = 0; i < s->len; ++i) - print_str_char(s->codepoints[i]); -} - -void print_str_char_u(val_char_t c) -{ - printf("\\u%04X", c); -} - -void print_str_char_U(val_char_t c) -{ - printf("\\U%08X", c); -} - -void print_str_char(val_char_t c) -{ - switch (c) { - case 0 ... 6: - print_str_char_u(c); - break; - case 7: - printf("\\a"); - break; - case 8: - printf("\\b"); - break; - case 9: - printf("\\t"); - break; - case 10: - printf("\\n"); - break; - case 11: - printf("\\v"); - break; - case 12: - printf("\\f"); - break; - case 13: - printf("\\r"); - break; - case 14 ... 26: - print_str_char_u(c); - break; - case 27: - printf("\\e"); - break; - case 28 ... 31: - print_str_char_u(c); - break; - case 34: - printf("\\\""); - break; - case 39: - printf("'"); - break; - case 92: - printf("\\\\"); - break; - case 127 ... 159: - case 173 ... 173: - case 888 ... 889: - case 896 ... 899: - case 907 ... 907: - case 909 ... 909: - case 930 ... 930: - case 1328 ... 1328: - case 1367 ... 1368: - case 1376 ... 1376: - case 1416 ... 1416: - case 1419 ... 1420: - case 1424 ... 1424: - case 1480 ... 1487: - case 1515 ... 1519: - case 1525 ... 1541: - case 1564 ... 1565: - case 1757 ... 1757: - case 1806 ... 1807: - case 1867 ... 1868: - case 1970 ... 1983: - case 2043 ... 2047: - case 2094 ... 2095: - case 2111 ... 2111: - case 2140 ... 2141: - case 2143 ... 2207: - case 2227 ... 2275: - case 2436 ... 2436: - case 2445 ... 2446: - case 2449 ... 2450: - case 2473 ... 2473: - case 2481 ... 2481: - case 2483 ... 2485: - case 2490 ... 2491: - case 2501 ... 2502: - case 2505 ... 2506: - case 2511 ... 2518: - case 2520 ... 2523: - case 2526 ... 2526: - case 2532 ... 2533: - case 2556 ... 2560: - case 2564 ... 2564: - case 2571 ... 2574: - case 2577 ... 2578: - case 2601 ... 2601: - case 2609 ... 2609: - case 2612 ... 2612: - case 2615 ... 2615: - case 2618 ... 2619: - case 2621 ... 2621: - case 2627 ... 2630: - case 2633 ... 2634: - case 2638 ... 2640: - case 2642 ... 2648: - case 2653 ... 2653: - case 2655 ... 2661: - case 2678 ... 2688: - case 2692 ... 2692: - case 2702 ... 2702: - case 2706 ... 2706: - case 2729 ... 2729: - case 2737 ... 2737: - case 2740 ... 2740: - case 2746 ... 2747: - case 2758 ... 2758: - case 2762 ... 2762: - case 2766 ... 2767: - case 2769 ... 2783: - case 2788 ... 2789: - case 2802 ... 2816: - case 2820 ... 2820: - case 2829 ... 2830: - case 2833 ... 2834: - case 2857 ... 2857: - case 2865 ... 2865: - case 2868 ... 2868: - case 2874 ... 2875: - case 2885 ... 2886: - case 2889 ... 2890: - case 2894 ... 2901: - case 2904 ... 2907: - case 2910 ... 2910: - case 2916 ... 2917: - case 2936 ... 2945: - case 2948 ... 2948: - case 2955 ... 2957: - case 2961 ... 2961: - case 2966 ... 2968: - case 2971 ... 2971: - case 2973 ... 2973: - case 2976 ... 2978: - case 2981 ... 2983: - case 2987 ... 2989: - case 3002 ... 3005: - case 3011 ... 3013: - case 3017 ... 3017: - case 3022 ... 3023: - case 3025 ... 3030: - case 3032 ... 3045: - case 3067 ... 3071: - case 3076 ... 3076: - case 3085 ... 3085: - case 3089 ... 3089: - case 3113 ... 3113: - case 3130 ... 3132: - case 3141 ... 3141: - case 3145 ... 3145: - case 3150 ... 3156: - case 3159 ... 3159: - case 3162 ... 3167: - case 3172 ... 3173: - case 3184 ... 3191: - case 3200 ... 3200: - case 3204 ... 3204: - case 3213 ... 3213: - case 3217 ... 3217: - case 3241 ... 3241: - case 3252 ... 3252: - case 3258 ... 3259: - case 3269 ... 3269: - case 3273 ... 3273: - case 3278 ... 3284: - case 3287 ... 3293: - case 3295 ... 3295: - case 3300 ... 3301: - case 3312 ... 3312: - case 3315 ... 3328: - case 3332 ... 3332: - case 3341 ... 3341: - case 3345 ... 3345: - case 3387 ... 3388: - case 3397 ... 3397: - case 3401 ... 3401: - case 3407 ... 3414: - case 3416 ... 3423: - case 3428 ... 3429: - case 3446 ... 3448: - case 3456 ... 3457: - case 3460 ... 3460: - case 3479 ... 3481: - case 3506 ... 3506: - case 3516 ... 3516: - case 3518 ... 3519: - case 3527 ... 3529: - case 3531 ... 3534: - case 3541 ... 3541: - case 3543 ... 3543: - case 3552 ... 3557: - case 3568 ... 3569: - case 3573 ... 3584: - case 3643 ... 3646: - case 3676 ... 3712: - case 3715 ... 3715: - case 3717 ... 3718: - case 3721 ... 3721: - case 3723 ... 3724: - case 3726 ... 3731: - case 3736 ... 3736: - case 3744 ... 3744: - case 3748 ... 3748: - case 3750 ... 3750: - case 3752 ... 3753: - case 3756 ... 3756: - case 3770 ... 3770: - case 3774 ... 3775: - case 3781 ... 3781: - case 3783 ... 3783: - case 3790 ... 3791: - case 3802 ... 3803: - case 3808 ... 3839: - case 3912 ... 3912: - case 3949 ... 3952: - case 3992 ... 3992: - case 4029 ... 4029: - case 4045 ... 4045: - case 4059 ... 4095: - case 4294 ... 4294: - case 4296 ... 4300: - case 4302 ... 4303: - case 4681 ... 4681: - case 4686 ... 4687: - case 4695 ... 4695: - case 4697 ... 4697: - case 4702 ... 4703: - case 4745 ... 4745: - case 4750 ... 4751: - case 4785 ... 4785: - case 4790 ... 4791: - case 4799 ... 4799: - case 4801 ... 4801: - case 4806 ... 4807: - case 4823 ... 4823: - case 4881 ... 4881: - case 4886 ... 4887: - case 4955 ... 4956: - case 4989 ... 4991: - case 5018 ... 5023: - case 5109 ... 5119: - case 5789 ... 5791: - case 5881 ... 5887: - case 5901 ... 5901: - case 5909 ... 5919: - case 5943 ... 5951: - case 5972 ... 5983: - case 5997 ... 5997: - case 6001 ... 6001: - case 6004 ... 6015: - case 6110 ... 6111: - case 6122 ... 6127: - case 6138 ... 6143: - case 6158 ... 6159: - case 6170 ... 6175: - case 6264 ... 6271: - case 6315 ... 6319: - case 6390 ... 6399: - case 6431 ... 6431: - case 6444 ... 6447: - case 6460 ... 6463: - case 6465 ... 6467: - case 6510 ... 6511: - case 6517 ... 6527: - case 6572 ... 6575: - case 6602 ... 6607: - case 6619 ... 6621: - case 6684 ... 6685: - case 6751 ... 6751: - case 6781 ... 6782: - case 6794 ... 6799: - case 6810 ... 6815: - case 6830 ... 6831: - case 6847 ... 6911: - case 6988 ... 6991: - case 7037 ... 7039: - case 7156 ... 7163: - case 7224 ... 7226: - case 7242 ... 7244: - case 7296 ... 7359: - case 7368 ... 7375: - case 7415 ... 7415: - case 7418 ... 7423: - case 7670 ... 7675: - case 7958 ... 7959: - case 7966 ... 7967: - case 8006 ... 8007: - case 8014 ... 8015: - case 8024 ... 8024: - case 8026 ... 8026: - case 8028 ... 8028: - case 8030 ... 8030: - case 8062 ... 8063: - case 8117 ... 8117: - case 8133 ... 8133: - case 8148 ... 8149: - case 8156 ... 8156: - case 8176 ... 8177: - case 8181 ... 8181: - case 8191 ... 8191: - case 8203 ... 8207: - case 8232 ... 8238: - case 8288 ... 8303: - case 8306 ... 8307: - case 8335 ... 8335: - case 8349 ... 8351: - case 8382 ... 8399: - case 8433 ... 8447: - case 8586 ... 8591: - case 9211 ... 9215: - case 9255 ... 9279: - case 9291 ... 9311: - case 11124 ... 11125: - case 11158 ... 11159: - case 11194 ... 11196: - case 11209 ... 11209: - case 11218 ... 11263: - case 11311 ... 11311: - case 11359 ... 11359: - case 11508 ... 11512: - case 11558 ... 11558: - case 11560 ... 11564: - case 11566 ... 11567: - case 11624 ... 11630: - case 11633 ... 11646: - case 11671 ... 11679: - case 11687 ... 11687: - case 11695 ... 11695: - case 11703 ... 11703: - case 11711 ... 11711: - case 11719 ... 11719: - case 11727 ... 11727: - case 11735 ... 11735: - case 11743 ... 11743: - case 11843 ... 11903: - case 11930 ... 11930: - case 12020 ... 12031: - case 12246 ... 12271: - case 12284 ... 12287: - case 12352 ... 12352: - case 12439 ... 12440: - case 12544 ... 12548: - case 12590 ... 12592: - case 12687 ... 12687: - case 12731 ... 12735: - case 12772 ... 12783: - case 12831 ... 12831: - case 13055 ... 13055: - case 19894 ... 19903: - case 40909 ... 40959: - case 42125 ... 42127: - case 42183 ... 42191: - case 42540 ... 42559: - case 42654 ... 42654: - case 42744 ... 42751: - case 42895 ... 42895: - case 42926 ... 42927: - case 42930 ... 42998: - case 43052 ... 43055: - case 43066 ... 43071: - case 43128 ... 43135: - case 43205 ... 43213: - case 43226 ... 43231: - case 43260 ... 43263: - case 43348 ... 43358: - case 43389 ... 43391: - case 43470 ... 43470: - case 43482 ... 43485: - case 43519 ... 43519: - case 43575 ... 43583: - case 43598 ... 43599: - case 43610 ... 43611: - case 43715 ... 43738: - case 43767 ... 43776: - case 43783 ... 43784: - case 43791 ... 43792: - case 43799 ... 43807: - case 43815 ... 43815: - case 43823 ... 43823: - case 43872 ... 43875: - case 43878 ... 43967: - case 44014 ... 44015: - case 44026 ... 44031: - case 55204 ... 55215: - case 55239 ... 55242: - case 55292 ... 55295: - case 57344 ... 63743: - case 64110 ... 64111: - case 64218 ... 64255: - case 64263 ... 64274: - case 64280 ... 64284: - case 64311 ... 64311: - case 64317 ... 64317: - case 64319 ... 64319: - case 64322 ... 64322: - case 64325 ... 64325: - case 64450 ... 64466: - case 64832 ... 64847: - case 64912 ... 64913: - case 64968 ... 65007: - case 65022 ... 65023: - case 65050 ... 65055: - case 65070 ... 65071: - case 65107 ... 65107: - case 65127 ... 65127: - case 65132 ... 65135: - case 65141 ... 65141: - case 65277 ... 65280: - case 65471 ... 65473: - case 65480 ... 65481: - case 65488 ... 65489: - case 65496 ... 65497: - case 65501 ... 65503: - case 65511 ... 65511: - case 65519 ... 65531: - case 65534 ... 65535: - print_str_char_u(c); - break; - case 65548 ... 65548: - case 65575 ... 65575: - case 65595 ... 65595: - case 65598 ... 65598: - case 65614 ... 65615: - case 65630 ... 65663: - case 65787 ... 65791: - case 65795 ... 65798: - case 65844 ... 65846: - case 65933 ... 65935: - case 65948 ... 65951: - case 65953 ... 65999: - case 66046 ... 66175: - case 66205 ... 66207: - case 66257 ... 66271: - case 66300 ... 66303: - case 66340 ... 66351: - case 66379 ... 66383: - case 66427 ... 66431: - case 66462 ... 66462: - case 66500 ... 66503: - case 66518 ... 66559: - case 66718 ... 66719: - case 66730 ... 66815: - case 66856 ... 66863: - case 66916 ... 66926: - case 66928 ... 67071: - case 67383 ... 67391: - case 67414 ... 67423: - case 67432 ... 67583: - case 67590 ... 67591: - case 67593 ... 67593: - case 67638 ... 67638: - case 67641 ... 67643: - case 67645 ... 67646: - case 67670 ... 67670: - case 67743 ... 67750: - case 67760 ... 67839: - case 67868 ... 67870: - case 67898 ... 67902: - case 67904 ... 67967: - case 68024 ... 68029: - case 68032 ... 68095: - case 68100 ... 68100: - case 68103 ... 68107: - case 68116 ... 68116: - case 68120 ... 68120: - case 68148 ... 68151: - case 68155 ... 68158: - case 68168 ... 68175: - case 68185 ... 68191: - case 68256 ... 68287: - case 68327 ... 68330: - case 68343 ... 68351: - case 68406 ... 68408: - case 68438 ... 68439: - case 68467 ... 68471: - case 68498 ... 68504: - case 68509 ... 68520: - case 68528 ... 68607: - case 68681 ... 69215: - case 69247 ... 69631: - case 69710 ... 69713: - case 69744 ... 69758: - case 69821 ... 69821: - case 69826 ... 69839: - case 69865 ... 69871: - case 69882 ... 69887: - case 69941 ... 69941: - case 69956 ... 69967: - case 70007 ... 70015: - case 70089 ... 70092: - case 70094 ... 70095: - case 70107 ... 70112: - case 70133 ... 70143: - case 70162 ... 70162: - case 70206 ... 70319: - case 70379 ... 70383: - case 70394 ... 70400: - case 70404 ... 70404: - case 70413 ... 70414: - case 70417 ... 70418: - case 70441 ... 70441: - case 70449 ... 70449: - case 70452 ... 70452: - case 70458 ... 70459: - case 70469 ... 70470: - case 70473 ... 70474: - case 70478 ... 70486: - case 70488 ... 70492: - case 70500 ... 70501: - case 70509 ... 70511: - case 70517 ... 70783: - case 70856 ... 70863: - case 70874 ... 71039: - case 71094 ... 71095: - case 71114 ... 71167: - case 71237 ... 71247: - case 71258 ... 71295: - case 71352 ... 71359: - case 71370 ... 71839: - case 71923 ... 71934: - case 71936 ... 72383: - case 72441 ... 73727: - case 74649 ... 74751: - case 74863 ... 74863: - case 74869 ... 77823: - case 78895 ... 92159: - case 92729 ... 92735: - case 92767 ... 92767: - case 92778 ... 92781: - case 92784 ... 92879: - case 92910 ... 92911: - case 92918 ... 92927: - case 92998 ... 93007: - case 93018 ... 93018: - case 93026 ... 93026: - case 93048 ... 93052: - case 93072 ... 93951: - case 94021 ... 94031: - case 94079 ... 94094: - case 94112 ... 110591: - case 110594 ... 113663: - case 113771 ... 113775: - case 113789 ... 113791: - case 113801 ... 113807: - case 113818 ... 113819: - case 113824 ... 118783: - case 119030 ... 119039: - case 119079 ... 119080: - case 119155 ... 119162: - case 119262 ... 119295: - case 119366 ... 119551: - case 119639 ... 119647: - case 119666 ... 119807: - case 119893 ... 119893: - case 119965 ... 119965: - case 119968 ... 119969: - case 119971 ... 119972: - case 119975 ... 119976: - case 119981 ... 119981: - case 119994 ... 119994: - case 119996 ... 119996: - case 120004 ... 120004: - case 120070 ... 120070: - case 120075 ... 120076: - case 120085 ... 120085: - case 120093 ... 120093: - case 120122 ... 120122: - case 120127 ... 120127: - case 120133 ... 120133: - case 120135 ... 120137: - case 120145 ... 120145: - case 120486 ... 120487: - case 120780 ... 120781: - case 120832 ... 124927: - case 125125 ... 125126: - case 125143 ... 126463: - case 126468 ... 126468: - case 126496 ... 126496: - case 126499 ... 126499: - case 126501 ... 126502: - case 126504 ... 126504: - case 126515 ... 126515: - case 126520 ... 126520: - case 126522 ... 126522: - case 126524 ... 126529: - case 126531 ... 126534: - case 126536 ... 126536: - case 126538 ... 126538: - case 126540 ... 126540: - case 126544 ... 126544: - case 126547 ... 126547: - case 126549 ... 126550: - case 126552 ... 126552: - case 126554 ... 126554: - case 126556 ... 126556: - case 126558 ... 126558: - case 126560 ... 126560: - case 126563 ... 126563: - case 126565 ... 126566: - case 126571 ... 126571: - case 126579 ... 126579: - case 126584 ... 126584: - case 126589 ... 126589: - case 126591 ... 126591: - case 126602 ... 126602: - case 126620 ... 126624: - case 126628 ... 126628: - case 126634 ... 126634: - case 126652 ... 126703: - case 126706 ... 126975: - case 127020 ... 127023: - case 127124 ... 127135: - case 127151 ... 127152: - case 127168 ... 127168: - case 127184 ... 127184: - case 127222 ... 127231: - case 127245 ... 127247: - case 127279 ... 127279: - case 127340 ... 127343: - case 127387 ... 127461: - case 127491 ... 127503: - case 127547 ... 127551: - case 127561 ... 127567: - case 127570 ... 127743: - case 127789 ... 127791: - case 127870 ... 127871: - case 127951 ... 127955: - case 127992 ... 127999: - case 128255 ... 128255: - case 128331 ... 128335: - case 128378 ... 128378: - case 128420 ... 128420: - case 128579 ... 128580: - case 128720 ... 128735: - case 128749 ... 128751: - case 128756 ... 128767: - case 128884 ... 128895: - case 128981 ... 129023: - case 129036 ... 129039: - case 129096 ... 129103: - case 129114 ... 129119: - case 129160 ... 129167: - case 129198 ... 131071: - case 173783 ... 173823: - case 177973 ... 177983: - case 178206 ... 194559: - case 195102 ... 917759: - case 918000 ... 1114110: - print_str_char_U(c); - break; - default: - print_codepoint(c); - break; - } -} - -void print_char(val_char_t c) -{ - printf("#\\"); - switch (c) { - case 0: - printf("nul"); break; - case 8: - printf("backspace"); break; - case 9: - printf("tab"); break; - case 10: - printf("newline"); break; - case 11: - printf("vtab"); break; - case 12: - printf("page"); break; - case 13: - printf("return"); break; - case 32: - printf("space"); break; - case 127: - printf("rubout"); break; - default: - print_codepoint(c); - } -} - -void print_codepoint(val_char_t c) -{ - char buffer[5] = {0}; - utf8_encode_char(c, buffer); - printf("%s", buffer); -} - -int utf8_encode_char(val_char_t c, char *buffer) -{ - // Output to buffer using UTF-8 encoding of codepoint - // https://en.wikipedia.org/wiki/UTF-8 - if (c < 128) { - buffer[0] = (char) c; - return 1; - } else if (c < 2048) { - buffer[0] = (char)(c >> 6) | 192; - buffer[1] = ((char) c & 63) | 128; - return 2; - } else if (c < 65536) { - buffer[0] = (char)(c >> 12) | 224; - buffer[1] = ((char)(c >> 6) & 63) | 128; - buffer[2] = ((char) c & 63) | 128; - return 3; - } else { - buffer[0] = (char)(c >> 18) | 240; - buffer[1] = ((char)(c >> 12) & 63) | 128; - buffer[2] = ((char)(c >> 6) & 63) | 128; - buffer[3] = ((char) c & 63) | 128; - return 4; - } -} diff --git a/iniquity-gc/print.h b/iniquity-gc/print.h deleted file mode 100644 index c22081a..0000000 --- a/iniquity-gc/print.h +++ /dev/null @@ -1,8 +0,0 @@ -#ifndef PRINT_H -#define PRINT_H - -#include "values.h" - -void print_result(val_t); - -#endif diff --git a/iniquity-gc/read-all.rkt b/iniquity-gc/read-all.rkt deleted file mode 100644 index 8a3289a..0000000 --- a/iniquity-gc/read-all.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(provide read-all) -;; read all s-expression until eof -(define (read-all) - (let ((r (read))) - (if (eof-object? r) - '() - (cons r (read-all))))) diff --git a/iniquity-gc/run.rkt b/iniquity-gc/run.rkt deleted file mode 100644 index eaa53eb..0000000 --- a/iniquity-gc/run.rkt +++ /dev/null @@ -1,18 +0,0 @@ -#lang racket -(provide run run/io) -(require "types.rkt" "build-runtime.rkt" - a86/interp) - -;; Asm -> Answer -(define (run is) - (parameterize ((current-objs (list runtime-path))) - (match (asm-interp is) - ['err 'err] - [b (bits->value b)]))) - -;; Asm String -> (cons Answer String) -(define (run/io is s) - (parameterize ((current-objs (list runtime-path))) - (match (asm-interp/io is s) - [(cons 'err o) (cons 'err o)] - [(cons b o) (cons (bits->value b) o)]))) diff --git a/iniquity-gc/runtime.h b/iniquity-gc/runtime.h deleted file mode 100644 index 6588ad1..0000000 --- a/iniquity-gc/runtime.h +++ /dev/null @@ -1,15 +0,0 @@ -#ifndef RUNTIME_H -#define RUNTIME_H -int64_t entry(); -extern FILE* in; -extern FILE* out; -extern void (*error_handler)(); - -// in words -#define heap_size 10000 -extern int64_t *heap; -extern val_t *from; -extern val_t *to; - -extern type_t *types; -#endif /* RUNTIME_H */ diff --git a/iniquity-gc/test/all.rkt b/iniquity-gc/test/all.rkt deleted file mode 100644 index f880d50..0000000 --- a/iniquity-gc/test/all.rkt +++ /dev/null @@ -1,5 +0,0 @@ -#lang racket - -;; run command line compiler and compare against Racket as refernece implementation -(require rackunit "../../test-programs/get-progs.rkt") -(for-each test-prog (get-progs "iniquity")) diff --git a/iniquity-gc/test/compile.rkt b/iniquity-gc/test/compile.rkt deleted file mode 100644 index 9a9d707..0000000 --- a/iniquity-gc/test/compile.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require "test-runner.rkt" - "../parse.rkt" - "../compile.rkt" - "../run.rkt") - -(test-runner (λ p (run (compile (parse p))))) -;(test-runner-io (λ (s . p) (run/io (compile (parse p)) s))) diff --git a/iniquity-gc/test/interp.rkt b/iniquity-gc/test/interp.rkt deleted file mode 100644 index cd7b654..0000000 --- a/iniquity-gc/test/interp.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require "test-runner.rkt" - "../parse.rkt" - "../interp.rkt" - "../interp-io.rkt") - -(test-runner (λ p (interp (parse p)))) -(test-runner-io (λ (s . p) (interp/io (parse p) s))) diff --git a/iniquity-gc/test/test-runner.rkt b/iniquity-gc/test/test-runner.rkt deleted file mode 100644 index 7c044cd..0000000 --- a/iniquity-gc/test/test-runner.rkt +++ /dev/null @@ -1,312 +0,0 @@ -#lang racket -(provide test-runner test-runner-io) -(require rackunit) - -(define (test-runner run) - ;; Abscond examples - (check-equal? (run 7) 7) - (check-equal? (run -8) -8) - - ;; Blackmail examples - (check-equal? (run '(add1 (add1 7))) 9) - (check-equal? (run '(add1 (sub1 7))) 7) - - ;; Con examples - (check-equal? (run '(if (zero? 0) 1 2)) 1) - (check-equal? (run '(if (zero? 1) 1 2)) 2) - (check-equal? (run '(if (zero? -7) 1 2)) 2) - (check-equal? (run '(if (zero? 0) - (if (zero? 1) 1 2) - 7)) - 2) - (check-equal? (run '(if (zero? (if (zero? 0) 1 0)) - (if (zero? 1) 1 2) - 7)) - 7) - - ;; Dupe examples - (check-equal? (run #t) #t) - (check-equal? (run #f) #f) - (check-equal? (run '(if #t 1 2)) 1) - (check-equal? (run '(if #f 1 2)) 2) - (check-equal? (run '(if 0 1 2)) 1) - (check-equal? (run '(if #t 3 4)) 3) - (check-equal? (run '(if #f 3 4)) 4) - (check-equal? (run '(if 0 3 4)) 3) - (check-equal? (run '(zero? 4)) #f) - (check-equal? (run '(zero? 0)) #t) - - ;; Dodger examples - (check-equal? (run #\a) #\a) - (check-equal? (run #\b) #\b) - (check-equal? (run '(char? #\a)) #t) - (check-equal? (run '(char? #t)) #f) - (check-equal? (run '(char? 8)) #f) - (check-equal? (run '(char->integer #\a)) (char->integer #\a)) - (check-equal? (run '(integer->char 955)) #\λ) - - ;; Extort examples - (check-equal? (run '(add1 #f)) 'err) - (check-equal? (run '(sub1 #f)) 'err) - (check-equal? (run '(zero? #f)) 'err) - (check-equal? (run '(char->integer #f)) 'err) - (check-equal? (run '(integer->char #f)) 'err) - (check-equal? (run '(integer->char -1)) 'err) - (check-equal? (run '(write-byte #f)) 'err) - (check-equal? (run '(write-byte -1)) 'err) - (check-equal? (run '(write-byte 256)) 'err) - - ;; Fraud examples - (check-equal? (run '(let ((x 7)) x)) 7) - (check-equal? (run '(let ((x 7)) 2)) 2) - (check-equal? (run '(let ((x 7)) (add1 x))) 8) - (check-equal? (run '(let ((x (add1 7))) x)) 8) - (check-equal? (run '(let ((x 7)) (let ((y 2)) x))) 7) - (check-equal? (run '(let ((x 7)) (let ((x 2)) x))) 2) - (check-equal? (run '(let ((x 7)) (let ((x (add1 x))) x))) 8) - - (check-equal? (run '(let ((x 0)) - (if (zero? x) 7 8))) - 7) - (check-equal? (run '(let ((x 1)) - (add1 (if (zero? x) 7 8)))) - 9) - (check-equal? (run '(+ 3 4)) 7) - (check-equal? (run '(- 3 4)) -1) - (check-equal? (run '(+ (+ 2 1) 4)) 7) - (check-equal? (run '(+ (+ 2 1) (+ 2 2))) 7) - (check-equal? (run '(let ((x (+ 1 2))) - (let ((z (- 4 x))) - (+ (+ x x) z)))) - 7) - (check-equal? (run '(= 5 5)) #t) - (check-equal? (run '(= 4 5)) #f) - (check-equal? (run '(= (add1 4) 5)) #t) - (check-equal? (run '(< 5 5)) #f) - (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f) - - ;; Hustle examples - (check-equal? (run ''()) '()) - (check-equal? (run '(box 1)) (box 1)) - (check-equal? (run '(cons 1 2)) (cons 1 2)) - (check-equal? (run '(unbox (box 1))) 1) - (check-equal? (run '(car (cons 1 2))) 1) - (check-equal? (run '(cdr (cons 1 2))) 2) - (check-equal? (run '(cons 1 '())) (list 1)) - (check-equal? (run '(let ((x (cons 1 2))) - (begin (cdr x) - (car x)))) - 1) - (check-equal? (run '(let ((x (cons 1 2))) - (let ((y (box 3))) - (unbox y)))) - 3) - (check-equal? (run '(eq? 1 1)) #t) - (check-equal? (run '(eq? 1 2)) #f) - (check-equal? (run '(eq? (cons 1 2) (cons 1 2))) #f) - (check-equal? (run '(let ((x (cons 1 2))) (eq? x x))) #t) - - ;; Hoax examples - (check-equal? (run '(make-vector 0 0)) #()) - (check-equal? (run '(make-vector 1 0)) #(0)) - (check-equal? (run '(make-vector 3 0)) #(0 0 0)) - (check-equal? (run '(make-vector 3 5)) #(5 5 5)) - (check-equal? (run '(vector? (make-vector 0 0))) #t) - (check-equal? (run '(vector? (cons 0 0))) #f) - (check-equal? (run '(vector-ref (make-vector 3 5) -1)) 'err) - (check-equal? (run '(vector-ref (make-vector 3 5) 0)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 1)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 2)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 3)) 'err) - (check-equal? (run '(let ((x (make-vector 3 5))) - (begin (vector-set! x 0 4) - x))) - #(4 5 5)) - (check-equal? (run '(let ((x (make-vector 3 5))) - (begin (vector-set! x 1 4) - x))) - #(5 4 5)) - (check-equal? (run '(vector-length (make-vector 3 #f))) 3) - (check-equal? (run '(vector-length (make-vector 0 #f))) 0) - (check-equal? (run '"") "") - (check-equal? (run '"fred") "fred") - (check-equal? (run '"wilma") "wilma") - (check-equal? (run '(make-string 0 #\f)) "") - (check-equal? (run '(make-string 3 #\f)) "fff") - (check-equal? (run '(make-string 3 #\g)) "ggg") - (check-equal? (run '(string-length "")) 0) - (check-equal? (run '(string-length "fred")) 4) - (check-equal? (run '(string-ref "fred" 0)) #\f) - (check-equal? (run '(string-ref "fred" 1)) #\r) - (check-equal? (run '(string-ref "fred" 2)) #\e) - (check-equal? (run '(string-ref "fred" 4)) 'err) - (check-equal? (run '(string? "fred")) #t) - (check-equal? (run '(string? (cons 1 2))) #f) - (check-equal? (run '(begin (make-string 3 #\f) - (make-string 3 #\f))) - "fff") - - ;; Iniquity tests - (check-equal? (run - '(define (f x) x) - '(f 5)) - 5) - (check-equal? (run - '(define (tri x) - (if (zero? x) - 0 - (+ x (tri (sub1 x))))) - '(tri 9)) - 45) - - (check-equal? (run - '(define (even? x) - (if (zero? x) - #t - (odd? (sub1 x)))) - '(define (odd? x) - (if (zero? x) - #f - (even? (sub1 x)))) - '(even? 101)) - #f) - - (check-equal? (run - '(define (map-add1 xs) - (if (empty? xs) - '() - (cons (add1 (car xs)) - (map-add1 (cdr xs))))) - '(map-add1 (cons 1 (cons 2 (cons 3 '()))))) - '(2 3 4)) - (check-equal? (run '(define (f x y) y) - '(f 1 (add1 #f))) - 'err) - - (check-equal? (run '(collect-garbage)) (void)) - (check-equal? (run '(begin (box 0) (collect-garbage))) (void)) - (check-equal? (run '(begin (collect-garbage) (box 0))) (box 0)) - (check-equal? (run '(let ((x (box 0))) (collect-garbage))) (void)) - (check-equal? (run '(let ((x (box 0))) - (begin (collect-garbage) - x))) - (box 0)) - ;; GC tests - (check-equal? (run - '(define (n-boxes n) - (if (zero? n) - (void) - (begin (box 0) - (n-boxes (sub1 n))))) - '(n-boxes 10001)) - (void)) - - ;; can't test this in the interpreter, because it doesn't exhaust the heap there. - #; - (check-equal? (run - '(define (nested-boxes n) - (if (zero? n) - (void) - (box (nested-boxes (sub1 n))))) - '(begin (nested-boxes 10001) (void))) - 'err) - ) - - - -(define (test-runner-io run) - ;; Evildoer examples - (check-equal? (run "" 7) (cons 7 "")) - (check-equal? (run "" '(write-byte 97)) (cons (void) "a")) - (check-equal? (run "a" '(read-byte)) (cons 97 "")) - (check-equal? (run "b" '(begin (write-byte 97) (read-byte))) - (cons 98 "a")) - (check-equal? (run "" '(read-byte)) (cons eof "")) - (check-equal? (run "" '(eof-object? (read-byte))) (cons #t "")) - (check-equal? (run "a" '(eof-object? (read-byte))) (cons #f "")) - (check-equal? (run "" '(begin (write-byte 97) (write-byte 98))) - (cons (void) "ab")) - - (check-equal? (run "ab" '(peek-byte)) (cons 97 "")) - (check-equal? (run "ab" '(begin (peek-byte) (read-byte))) (cons 97 "")) - ;; Extort examples - (check-equal? (run "" '(write-byte #t)) (cons 'err "")) - - ;; Fraud examples - (check-equal? (run "" '(let ((x 97)) (write-byte x))) (cons (void) "a")) - (check-equal? (run "" - '(let ((x 97)) - (begin (write-byte x) - x))) - (cons 97 "a")) - (check-equal? (run "b" '(let ((x 97)) (begin (read-byte) x))) - (cons 97 "")) - (check-equal? (run "b" '(let ((x 97)) (begin (peek-byte) x))) - (cons 97 "")) - - ;; Hustle examples - (check-equal? (run "" - '(let ((x 1)) - (begin (write-byte 97) - 1))) - (cons 1 "a")) - - (check-equal? (run "" - '(let ((x 1)) - (let ((y 2)) - (begin (write-byte 97) - 1)))) - (cons 1 "a")) - - (check-equal? (run "" - '(let ((x (cons 1 2))) - (begin (write-byte 97) - (car x)))) - (cons 1 "a")) - ;; Iniquity examples - (check-equal? (run "" - '(define (print-alphabet i) - (if (zero? i) - (void) - (begin (write-byte (- 123 i)) - (print-alphabet (sub1 i))))) - '(print-alphabet 26)) - (cons (void) "abcdefghijklmnopqrstuvwxyz")) - - (check-equal? (run "" - '(define (f x) - (write-byte x)) - '(f 97)) - (cons (void) "a")) - (check-equal? (run "" - '(define (f x y) - (write-byte x)) - '(f 97 98)) - (cons (void) "a")) - (check-equal? (run "" - '(define (f x) - (let ((y x)) - (write-byte y))) - '(f 97)) - (cons (void) "a")) - (check-equal? (run "" - '(define (f x y) - (let ((y x)) - (write-byte y))) - '(f 97 98)) - (cons (void) "a")) - (check-equal? (run "" - '(define (f x) - (write-byte x)) - '(let ((z 97)) - (f z))) - (cons (void) "a")) - (check-equal? (run "" - '(define (f x y) - (write-byte x)) - '(let ((z 97)) - (f z 98))) - (cons (void) "a"))) - - diff --git a/iniquity-gc/types.h b/iniquity-gc/types.h deleted file mode 100644 index b79f45b..0000000 --- a/iniquity-gc/types.h +++ /dev/null @@ -1,40 +0,0 @@ -#ifndef TYPES_H -#define TYPES_H - -/* - Bit layout of values - - Values are either: - - Immediates: end in #b000 - - Pointers - - Immediates are either - - Integers: end in #b0 000 - - Characters: end in #b01 000 - - True: #b11 000 - - False: #b1 11 000 - - Eof: #b10 11 000 - - Void: #b11 11 000 - - Empty: #b100 11 000 -*/ -#define imm_shift 3 -#define ptr_type_mask ((1 << imm_shift) - 1) -#define box_type_tag 1 -#define cons_type_tag 2 -#define vect_type_tag 3 -#define str_type_tag 4 -#define int_shift (1 + imm_shift) -#define int_type_mask ((1 << int_shift) - 1) -#define int_type_tag (0 << (int_shift - 1)) -#define nonint_type_tag (1 << (int_shift - 1)) -#define char_shift (int_shift + 1) -#define char_type_mask ((1 << char_shift) - 1) -#define char_type_tag ((0 << (char_shift - 1)) | nonint_type_tag) -#define nonchar_type_tag ((1 << (char_shift - 1)) | nonint_type_tag) -#define val_true ((0 << char_shift) | nonchar_type_tag) -#define val_false ((1 << char_shift) | nonchar_type_tag) -#define val_eof ((2 << char_shift) | nonchar_type_tag) -#define val_void ((3 << char_shift) | nonchar_type_tag) -#define val_empty ((4 << char_shift) | nonchar_type_tag) - -#endif diff --git a/iniquity-gc/types.rkt b/iniquity-gc/types.rkt deleted file mode 100644 index 9dbc9d5..0000000 --- a/iniquity-gc/types.rkt +++ /dev/null @@ -1,90 +0,0 @@ -#lang racket -(provide (all-defined-out)) -(require ffi/unsafe) - -(define imm-shift 3) -(define imm-mask #b111) -(define ptr-mask #b111) -(define type-box #b001) -(define type-cons #b010) -(define type-vect #b011) -(define type-str #b100) -(define int-shift (+ 1 imm-shift)) -(define char-shift (+ 2 imm-shift)) -(define type-int #b0000) -(define mask-int #b1111) -(define type-char #b01000) -(define mask-char #b11111) - -(define (bits->value b) - (cond [(= b (value->bits #t)) #t] - [(= b (value->bits #f)) #f] - [(= b (value->bits eof)) eof] - [(= b (value->bits (void))) (void)] - [(= b (value->bits '())) '()] - [(int-bits? b) - (arithmetic-shift b (- int-shift))] - [(char-bits? b) - (integer->char (arithmetic-shift b (- char-shift)))] - [(box-bits? b) - (box (bits->value (heap-ref b)))] - [(cons-bits? b) - (cons (bits->value (heap-ref (+ b 8))) - (bits->value (heap-ref b)))] - [(vect-bits? b) - (if (zero? (untag b)) - (vector) - (build-vector (heap-ref b) - (lambda (j) - (bits->value (heap-ref (+ b (* 8 (add1 j))))))))] - [(str-bits? b) - (if (zero? (untag b)) - (string) - (build-string (heap-ref b) - (lambda (j) - (char-ref (+ b 8) j))))] - [else (error "invalid bits")])) - -(define (value->bits v) - (cond [(eq? v #t) #b00011000] - [(eq? v #f) #b00111000] - [(eof-object? v) #b01011000] - [(void? v) #b01111000] - [(empty? v) #b10011000] - [(integer? v) - (arithmetic-shift v int-shift)] - [(char? v) - (bitwise-ior type-char - (arithmetic-shift (char->integer v) char-shift))] - [else (error "not an immediate value")])) - -(define (imm-bits? v) - (zero? (bitwise-and v imm-mask))) - -(define (int-bits? v) - (= type-int (bitwise-and v mask-int))) - -(define (char-bits? v) - (= type-char (bitwise-and v mask-char))) - -(define (cons-bits? v) - (= type-cons (bitwise-and v imm-mask))) - -(define (box-bits? v) - (= type-box (bitwise-and v imm-mask))) - -(define (vect-bits? v) - (= type-vect (bitwise-and v imm-mask))) - -(define (str-bits? v) - (= type-str (bitwise-and v imm-mask))) - -(define (untag i) - (arithmetic-shift (arithmetic-shift i (- (integer-length ptr-mask))) - (integer-length ptr-mask))) - -(define (heap-ref i) - (ptr-ref (cast (untag i) _int64 _pointer) _int64)) - -(define (char-ref i j) - (integer->char (ptr-ref (cast (untag i) _int64 _pointer) _uint32 j))) diff --git a/iniquity-gc/values.c b/iniquity-gc/values.c deleted file mode 100644 index df54ade..0000000 --- a/iniquity-gc/values.c +++ /dev/null @@ -1,143 +0,0 @@ -#include -#include -#include "types.h" -#include "values.h" - -type_t val_typeof(val_t x) -{ - switch (x & ptr_type_mask) { - case box_type_tag: - return T_BOX; - case cons_type_tag: - return T_CONS; - case vect_type_tag: - return T_VECT; - case str_type_tag: - return T_STR; - } - - if ((int_type_mask & x) == int_type_tag) - return T_INT; - if ((char_type_mask & x) == char_type_tag) - return T_CHAR; - - switch (x) { - case val_true: - case val_false: - return T_BOOL; - case val_eof: - return T_EOF; - case val_void: - return T_VOID; - case val_empty: - return T_EMPTY; - } - - return T_INVALID; -} - -val_t* val_unwrap(val_t v) { - return (val_t*)((v >> imm_shift) << imm_shift); -} - -int64_t type_tag(type_t t) { - switch (t) { - case T_BOX: - return box_type_tag; - case T_CONS: - return cons_type_tag; - case T_STR: - return str_type_tag; - case T_VECT: - return vect_type_tag; - default: - printf("type_tag called on non-pointer type"); - exit(1); - } -} - -int val_size(val_t *v, type_t t) { - switch (t) { - case T_CONS: return 2; - case T_VECT: return 1 + v[0]; - case T_STR: return 1 + ((v[0] + 1) / 2); - default: return 1; - } -}; - -val_t val_wrap(val_t* v, type_t t) { - return (val_t)((int64_t)v ^ type_tag(t)); -} - -int64_t val_unwrap_int(val_t x) -{ - return x >> int_shift; -} -val_t val_wrap_int(int64_t i) -{ - return (i << int_shift) | int_type_tag; -} - -int val_unwrap_bool(val_t x) -{ - return x == val_true; -} -val_t val_wrap_bool(int b) -{ - return b ? val_true : val_false; -} - -val_char_t val_unwrap_char(val_t x) -{ - return (val_char_t)(x >> char_shift); -} -val_t val_wrap_char(val_char_t c) -{ - return (((val_t)c) << char_shift) | char_type_tag; -} - -val_t val_wrap_eof(void) -{ - return val_eof; -} - -val_t val_wrap_void(void) -{ - return val_void; -} - -val_box_t* val_unwrap_box(val_t x) -{ - return (val_box_t *)(x ^ box_type_tag); -} -val_t val_wrap_box(val_box_t* b) -{ - return ((val_t)b) | box_type_tag; -} - -val_cons_t* val_unwrap_cons(val_t x) -{ - return (val_cons_t *)(x ^ cons_type_tag); -} -val_t val_wrap_cons(val_cons_t *c) -{ - return ((val_t)c) | cons_type_tag; -} - -val_vect_t* val_unwrap_vect(val_t x) -{ - return (val_vect_t *)(x ^ vect_type_tag); -} -val_t val_wrap_vect(val_vect_t *v) -{ - return ((val_t)v) | vect_type_tag; -} - -val_str_t* val_unwrap_str(val_t x) -{ - return (val_str_t *)(x ^ str_type_tag); -} -val_t val_wrap_str(val_str_t *v) -{ - return ((val_t)v) | str_type_tag; -} diff --git a/iniquity-gc/values.h b/iniquity-gc/values.h deleted file mode 100644 index 00f7070..0000000 --- a/iniquity-gc/values.h +++ /dev/null @@ -1,80 +0,0 @@ -#ifndef VALUES_H -#define VALUES_H - -#include - -/* any abstract value */ -typedef int64_t val_t; - -typedef enum type_t { - T_INVALID = -1, - /* immediates */ - T_INT, - T_BOOL, - T_CHAR, - T_EOF, - T_VOID, - T_EMPTY, - /* pointers */ - T_BOX, - T_CONS, - T_VECT, - T_STR, -} type_t; - -typedef uint32_t val_char_t; -typedef struct val_box_t { - val_t val; -} val_box_t; -typedef struct val_cons_t { - val_t snd; - val_t fst; -} val_cons_t; -typedef struct val_vect_t { - uint64_t len; - val_t elems[]; -} val_vect_t; -typedef struct val_str_t { - uint64_t len; - val_char_t codepoints[]; -} val_str_t; - -/* return the type of x */ -type_t val_typeof(val_t x); - -/** - * Wrap/unwrap values - * - * The behavior of unwrap functions are undefined on type mismatch. - */ -val_t* val_unwrap(val_t v); // v is a pointer type value -val_t val_wrap(val_t* v, type_t t); - -int val_size(val_t *v, type_t t); - -int64_t val_unwrap_int(val_t x); -val_t val_wrap_int(int64_t i); - -int val_unwrap_bool(val_t x); -val_t val_wrap_bool(int b); - -val_char_t val_unwrap_char(val_t x); -val_t val_wrap_char(val_char_t b); - -val_t val_wrap_eof(); - -val_t val_wrap_void(); - -val_box_t* val_unwrap_box(val_t x); -val_t val_wrap_box(val_box_t* b); - -val_cons_t* val_unwrap_cons(val_t x); -val_t val_wrap_cons(val_cons_t* c); - -val_vect_t* val_unwrap_vect(val_t x); -val_t val_wrap_vect(val_vect_t* c); - -val_str_t* val_unwrap_str(val_t x); -val_t val_wrap_str(val_str_t* c); - -#endif From d3ab4604e6ec845deaf171d8a1a8852c4c1795bc Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 17:38:58 -0400 Subject: [PATCH 14/47] Trying out fresh jit on each exec in Hoax. --- hoax/executor/exec.rkt | 1 + 1 file changed, 1 insertion(+) diff --git a/hoax/executor/exec.rkt b/hoax/executor/exec.rkt index cd5745e..8c179eb 100644 --- a/hoax/executor/exec.rkt +++ b/hoax/executor/exec.rkt @@ -24,6 +24,7 @@ (extern 'raise_error (λ () (raise 'err)) (_fun -> _void)))]) + (reset-jit!) ; diagnostic (asm-load prog)) heap)) From 31c190f3babf6a23183d1a8d50c8b41c253a30e2 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 17:44:51 -0400 Subject: [PATCH 15/47] Remove fail-fast in CI. --- .github/workflows/ubuntu.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 9cd49fb..5b3207b 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -8,7 +8,7 @@ concurrency: jobs: build-and-test: strategy: - fail-fast: true + # fail-fast: true matrix: os: [ubuntu-22.04, ubuntu-24.04] racket-variant: ['CS'] From b79b54791970ed507b0b887731ab2ebf9f374316 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 17:51:19 -0400 Subject: [PATCH 16/47] Update ubuntu.yml --- .github/workflows/ubuntu.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 5b3207b..fea7dab 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -3,7 +3,7 @@ on: [push, workflow_dispatch] concurrency: group: ubuntu-ci-${{ github.ref }} - cancel-in-progress: true + cancel-in-progress: false jobs: build-and-test: From 562bbe63aae8bbb8f4248d68a23cfc65977a58b1 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 18:21:52 -0400 Subject: [PATCH 17/47] Set fail-fast to false. --- .github/workflows/ubuntu.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index fea7dab..e090cd3 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -8,7 +8,7 @@ concurrency: jobs: build-and-test: strategy: - # fail-fast: true + fail-fast: false matrix: os: [ubuntu-22.04, ubuntu-24.04] racket-variant: ['CS'] From 8d8f014cdf4f34fe2c8cb7807c3c7b36ca4526ed Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 18:50:25 -0400 Subject: [PATCH 18/47] Try more jit-resetting to get to bottom of CI failures. --- loot/executor/exec.rkt | 1 + neerdowell/executor/exec.rkt | 1 + 2 files changed, 2 insertions(+) diff --git a/loot/executor/exec.rkt b/loot/executor/exec.rkt index cd5745e..8c179eb 100644 --- a/loot/executor/exec.rkt +++ b/loot/executor/exec.rkt @@ -24,6 +24,7 @@ (extern 'raise_error (λ () (raise 'err)) (_fun -> _void)))]) + (reset-jit!) ; diagnostic (asm-load prog)) heap)) diff --git a/neerdowell/executor/exec.rkt b/neerdowell/executor/exec.rkt index 5e2f7fd..94ffe6e 100644 --- a/neerdowell/executor/exec.rkt +++ b/neerdowell/executor/exec.rkt @@ -63,6 +63,7 @@ (extern 'symb_cmp symb-cmp/cb (_fun _pointer _pointer -> _int)))]) + (reset-jit!) ; diagnostic (asm-load prog)) heap)) From e92b362aeb2ec4534fea09924581b4d1f2829d5c Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 19:02:52 -0400 Subject: [PATCH 19/47] Update mac workflow. --- .github/workflows/macos.yml | 14 ++------------ 1 file changed, 2 insertions(+), 12 deletions(-) diff --git a/.github/workflows/macos.yml b/.github/workflows/macos.yml index 558a602..6de629c 100644 --- a/.github/workflows/macos.yml +++ b/.github/workflows/macos.yml @@ -19,10 +19,10 @@ jobs: steps: - name: Checkout - uses: actions/checkout@v4 + uses: actions/checkout@main - name: Install Racket - uses: Bogdanp/setup-racket@v1.14 + uses: Bogdanp/setup-racket@v1.15 with: architecture: 'x64' distribution: 'full' @@ -36,16 +36,6 @@ jobs: clang --version gcc --version - - name: Cache Racket packages - uses: actions/cache@v4 - with: - path: | - ~/.racket - ~/.cache/racket - ~/.local/share/racket - ~/Library/Caches/Racket - key: racket-${{ matrix.racket-variant }}-${{ matrix.racket-version }}-${{ matrix.os }} - - name: Install langs package run: | raco pkg install --auto ../langs/ From 4cad9b13c59054b7323871d052ff4e0cac74632d Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 19:04:58 -0400 Subject: [PATCH 20/47] Bump setup-racket version to try and fix node.js warning on GH. --- .github/workflows/ubuntu.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index e090cd3..9444b1b 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -22,7 +22,7 @@ jobs: uses: actions/checkout@main - name: Install Racket - uses: Bogdanp/setup-racket@v1.14 + uses: Bogdanp/setup-racket@v1.15 with: architecture: 'x64' distribution: 'full' From 103f96eda6912c50d5bd2e861335209a55a50dac Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 19:11:58 -0400 Subject: [PATCH 21/47] Use next branch of a86 in mac action. --- .github/workflows/macos.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.github/workflows/macos.yml b/.github/workflows/macos.yml index 6de629c..d2f678f 100644 --- a/.github/workflows/macos.yml +++ b/.github/workflows/macos.yml @@ -36,6 +36,12 @@ jobs: clang --version gcc --version + # Temporary: install the next branch of a86 while this is in development + # Once merged in main, remove this and let it grab main branch by default + - name: Install a86 next branch + run: | + raco pkg install --auto 'https://github.com/cmsc430/a86.git?#next' + - name: Install langs package run: | raco pkg install --auto ../langs/ From 19ffb87a394711d52d8ab674318c1fdc7453fa37 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 20:23:50 -0400 Subject: [PATCH 22/47] Remove diagnostic jit-reset. --- hoax/executor/exec.rkt | 1 - loot/executor/exec.rkt | 1 - neerdowell/executor/exec.rkt | 1 - 3 files changed, 3 deletions(-) diff --git a/hoax/executor/exec.rkt b/hoax/executor/exec.rkt index 8c179eb..cd5745e 100644 --- a/hoax/executor/exec.rkt +++ b/hoax/executor/exec.rkt @@ -24,7 +24,6 @@ (extern 'raise_error (λ () (raise 'err)) (_fun -> _void)))]) - (reset-jit!) ; diagnostic (asm-load prog)) heap)) diff --git a/loot/executor/exec.rkt b/loot/executor/exec.rkt index 8c179eb..cd5745e 100644 --- a/loot/executor/exec.rkt +++ b/loot/executor/exec.rkt @@ -24,7 +24,6 @@ (extern 'raise_error (λ () (raise 'err)) (_fun -> _void)))]) - (reset-jit!) ; diagnostic (asm-load prog)) heap)) diff --git a/neerdowell/executor/exec.rkt b/neerdowell/executor/exec.rkt index 94ffe6e..5e2f7fd 100644 --- a/neerdowell/executor/exec.rkt +++ b/neerdowell/executor/exec.rkt @@ -63,7 +63,6 @@ (extern 'symb_cmp symb-cmp/cb (_fun _pointer _pointer -> _int)))]) - (reset-jit!) ; diagnostic (asm-load prog)) heap)) From d332561bc47e3b4ecee54d34e85bdd17e55c6cfc Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 20 Apr 2026 20:30:24 -0400 Subject: [PATCH 23/47] Install newer LLVM on mac action. --- .github/workflows/macos.yml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.github/workflows/macos.yml b/.github/workflows/macos.yml index d2f678f..85a3cfc 100644 --- a/.github/workflows/macos.yml +++ b/.github/workflows/macos.yml @@ -29,6 +29,11 @@ jobs: variant: ${{ matrix.racket-variant }} version: ${{ matrix.racket-version }} + - name: Install LLVM + uses: ZhongRuoyu/setup-llvm@v0 + with: + llvm-version: 22 + - name: Version info run: | uname -a From 76032bbaf8994963bef5ceda4dc4e2347b606d58 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Thu, 7 May 2026 16:50:32 -0400 Subject: [PATCH 24/47] Preserve r12 in generated entry points --- iniquity/compiler/compile.rkt | 3 ++- knock/compiler/compile.rkt | 3 ++- mountebank/compiler/compile.rkt | 3 ++- 3 files changed, 6 insertions(+), 3 deletions(-) diff --git a/iniquity/compiler/compile.rkt b/iniquity/compiler/compile.rkt index d79d077..c58dfae 100644 --- a/iniquity/compiler/compile.rkt +++ b/iniquity/compiler/compile.rkt @@ -20,9 +20,11 @@ (Label 'entry) (Push rbx) ; save callee-saved register (Push r15) + (Push r12) (Mov rbx rdi) ; recv heap pointer (compile-e e '()) + (Pop r12) ; restore callee-save register (Pop r15) ; restore callee-save register (Pop rbx) (Ret) @@ -181,4 +183,3 @@ (match (eq? x y) [#t 0] [#f (+ 8 (lookup x rest))])])) - diff --git a/knock/compiler/compile.rkt b/knock/compiler/compile.rkt index 74c72f3..70358e1 100644 --- a/knock/compiler/compile.rkt +++ b/knock/compiler/compile.rkt @@ -22,9 +22,11 @@ (Label 'entry) (Push rbx) ; save callee-saved register (Push r15) + (Push r12) (Mov rbx rdi) ; recv heap pointer (compile-e e '() #f) + (Pop r12) ; restore callee-save register (Pop r15) ; restore callee-save register (Pop rbx) (Ret) @@ -302,4 +304,3 @@ (match (eq? x y) [#t 0] [#f (+ 8 (lookup x rest))])])) - diff --git a/mountebank/compiler/compile.rkt b/mountebank/compiler/compile.rkt index 4724ac7..b1969df 100644 --- a/mountebank/compiler/compile.rkt +++ b/mountebank/compiler/compile.rkt @@ -26,11 +26,13 @@ (Label 'entry) (Push rbx) ; save callee-saved register (Push r15) + (Push r12) (Mov rbx rdi) ; recv heap pointer (init-symbol-table p) (compile-defines-values ds) (compile-e e (reverse (define-ids ds)) #f) (Add rsp (* 8 (length ds))) ;; pop function definitions + (Pop r12) ; restore callee-save register (Pop r15) ; restore callee-save register (Pop rbx) (Ret) @@ -389,4 +391,3 @@ (match (eq? x y) [#t 0] [#f (+ 8 (lookup x rest))])])) - From e943f5b0be489a6ba639692c3f3c3c19d56e1375 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 13:20:35 -0400 Subject: [PATCH 25/47] Use a86 with branch matching this branch. --- .github/workflows/ubuntu.yml | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 9444b1b..efad544 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -43,15 +43,14 @@ jobs: clang --version gcc --version - # Temporary: install the next branch of a86 while this is in development - # Once merged in main, remove this and let it grab main branch by default - - name: Install a86 next branch + - name: Install a86 branch run: | - raco pkg install --auto 'https://github.com/cmsc430/a86.git?#next' + git clone --branch "${{ github.ref_name }}" --single-branch https://github.com/cmsc430/a86.git + raco pkg install --auto --no-docs a86/ - name: Install langs package run: | - raco pkg install --auto ../langs/ + raco pkg install --auto --no-docs ../langs/ - name: Run tests run: | From 042c2338f9d84e3a0341a788d3aa9aa6d82467a1 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 13:49:42 -0400 Subject: [PATCH 26/47] Whitespace. --- hoax/test/test-runner.rkt | 2 +- hustle/test/test-runner.rkt | 2 +- iniquity/compiler/compile.rkt | 3 +-- iniquity/test/test-runner.rkt | 2 +- jig/test/test-runner.rkt | 2 +- knock/compiler/compile.rkt | 3 +-- knock/test/test-runner.rkt | 2 +- loot/test/test-runner.rkt | 2 +- mountebank/compiler/compile-ops.rkt | 1 - mountebank/compiler/compile.rkt | 3 +-- mountebank/test/test-runner.rkt | 4 ++-- mug/compiler/compile-ops.rkt | 1 - mug/test/test-runner.rkt | 2 +- 13 files changed, 12 insertions(+), 17 deletions(-) diff --git a/hoax/test/test-runner.rkt b/hoax/test/test-runner.rkt index 3b3f151..39a1402 100644 --- a/hoax/test/test-runner.rkt +++ b/hoax/test/test-runner.rkt @@ -93,7 +93,7 @@ (check-equal? (run '(= (add1 4) 5)) #t) (check-equal? (run '(< 5 5)) #f) (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f)) + (check-equal? (run '(< (add1 4) 5)) #f)) (begin ;; Hustle (check-equal? (run '(empty? (cons 1 2))) #f) diff --git a/hustle/test/test-runner.rkt b/hustle/test/test-runner.rkt index 8079325..8557916 100644 --- a/hustle/test/test-runner.rkt +++ b/hustle/test/test-runner.rkt @@ -93,7 +93,7 @@ (check-equal? (run '(= (add1 4) 5)) #t) (check-equal? (run '(< 5 5)) #f) (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f)) + (check-equal? (run '(< (add1 4) 5)) #f)) (begin ;; Hustle (check-equal? (run '(empty? (cons 1 2))) #f) diff --git a/iniquity/compiler/compile.rkt b/iniquity/compiler/compile.rkt index c58dfae..d79d077 100644 --- a/iniquity/compiler/compile.rkt +++ b/iniquity/compiler/compile.rkt @@ -20,11 +20,9 @@ (Label 'entry) (Push rbx) ; save callee-saved register (Push r15) - (Push r12) (Mov rbx rdi) ; recv heap pointer (compile-e e '()) - (Pop r12) ; restore callee-save register (Pop r15) ; restore callee-save register (Pop rbx) (Ret) @@ -183,3 +181,4 @@ (match (eq? x y) [#t 0] [#f (+ 8 (lookup x rest))])])) + diff --git a/iniquity/test/test-runner.rkt b/iniquity/test/test-runner.rkt index 1139468..9dd225d 100644 --- a/iniquity/test/test-runner.rkt +++ b/iniquity/test/test-runner.rkt @@ -93,7 +93,7 @@ (check-equal? (run '(= (add1 4) 5)) #t) (check-equal? (run '(< 5 5)) #f) (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f)) + (check-equal? (run '(< (add1 4) 5)) #f)) (begin ;; Hustle (check-equal? (run '(empty? (cons 1 2))) #f) diff --git a/jig/test/test-runner.rkt b/jig/test/test-runner.rkt index 1139468..9dd225d 100644 --- a/jig/test/test-runner.rkt +++ b/jig/test/test-runner.rkt @@ -93,7 +93,7 @@ (check-equal? (run '(= (add1 4) 5)) #t) (check-equal? (run '(< 5 5)) #f) (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f)) + (check-equal? (run '(< (add1 4) 5)) #f)) (begin ;; Hustle (check-equal? (run '(empty? (cons 1 2))) #f) diff --git a/knock/compiler/compile.rkt b/knock/compiler/compile.rkt index 70358e1..74c72f3 100644 --- a/knock/compiler/compile.rkt +++ b/knock/compiler/compile.rkt @@ -22,11 +22,9 @@ (Label 'entry) (Push rbx) ; save callee-saved register (Push r15) - (Push r12) (Mov rbx rdi) ; recv heap pointer (compile-e e '() #f) - (Pop r12) ; restore callee-save register (Pop r15) ; restore callee-save register (Pop rbx) (Ret) @@ -304,3 +302,4 @@ (match (eq? x y) [#t 0] [#f (+ 8 (lookup x rest))])])) + diff --git a/knock/test/test-runner.rkt b/knock/test/test-runner.rkt index 583af0d..493ad77 100644 --- a/knock/test/test-runner.rkt +++ b/knock/test/test-runner.rkt @@ -93,7 +93,7 @@ (check-equal? (run '(= (add1 4) 5)) #t) (check-equal? (run '(< 5 5)) #f) (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f)) + (check-equal? (run '(< (add1 4) 5)) #f)) (begin ;; Hustle (check-equal? (run '(empty? (cons 1 2))) #f) diff --git a/loot/test/test-runner.rkt b/loot/test/test-runner.rkt index 52b1c9f..a9833ad 100644 --- a/loot/test/test-runner.rkt +++ b/loot/test/test-runner.rkt @@ -93,7 +93,7 @@ (check-equal? (run '(= (add1 4) 5)) #t) (check-equal? (run '(< 5 5)) #f) (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f)) + (check-equal? (run '(< (add1 4) 5)) #f)) (begin ;; Hustle (check-equal? (run '(empty? (cons 1 2))) #f) diff --git a/mountebank/compiler/compile-ops.rkt b/mountebank/compiler/compile-ops.rkt index 0a9c4b8..bf35a6a 100644 --- a/mountebank/compiler/compile-ops.rkt +++ b/mountebank/compiler/compile-ops.rkt @@ -294,6 +294,5 @@ (Call 'memcpy) unpad-stack ; rbx should be preserved by memcpy - ;(Mov rbx rax) ; dst is returned, install as heap pointer (Add rbx r12))) diff --git a/mountebank/compiler/compile.rkt b/mountebank/compiler/compile.rkt index b1969df..4724ac7 100644 --- a/mountebank/compiler/compile.rkt +++ b/mountebank/compiler/compile.rkt @@ -26,13 +26,11 @@ (Label 'entry) (Push rbx) ; save callee-saved register (Push r15) - (Push r12) (Mov rbx rdi) ; recv heap pointer (init-symbol-table p) (compile-defines-values ds) (compile-e e (reverse (define-ids ds)) #f) (Add rsp (* 8 (length ds))) ;; pop function definitions - (Pop r12) ; restore callee-save register (Pop r15) ; restore callee-save register (Pop rbx) (Ret) @@ -391,3 +389,4 @@ (match (eq? x y) [#t 0] [#f (+ 8 (lookup x rest))])])) + diff --git a/mountebank/test/test-runner.rkt b/mountebank/test/test-runner.rkt index 393cef0..880309b 100644 --- a/mountebank/test/test-runner.rkt +++ b/mountebank/test/test-runner.rkt @@ -93,7 +93,7 @@ (check-equal? (run '(= (add1 4) 5)) #t) (check-equal? (run '(< 5 5)) #f) (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f)) + (check-equal? (run '(< (add1 4) 5)) #f)) (begin ;; Hustle (check-equal? (run '(empty? (cons 1 2))) #f) @@ -339,7 +339,7 @@ (check-equal? (run ''(1 . 2)) '(1 . 2)) (check-equal? (run ''(("1") (#() #(1 #(2))) (#&(1)) (#f) (4) (5))) - '(("1") (#() #(1 #(2))) (#&(1)) (#f) (4) (5))) + '(("1") (#() #(1 #(2))) (#&(1)) (#f) (4) (5))) (check-equal? (run '(define (f) (cons 1 2)) '(eq? (f) (f))) #f) diff --git a/mug/compiler/compile-ops.rkt b/mug/compiler/compile-ops.rkt index 0a9c4b8..bf35a6a 100644 --- a/mug/compiler/compile-ops.rkt +++ b/mug/compiler/compile-ops.rkt @@ -294,6 +294,5 @@ (Call 'memcpy) unpad-stack ; rbx should be preserved by memcpy - ;(Mov rbx rax) ; dst is returned, install as heap pointer (Add rbx r12))) diff --git a/mug/test/test-runner.rkt b/mug/test/test-runner.rkt index 451f834..edfbc7b 100644 --- a/mug/test/test-runner.rkt +++ b/mug/test/test-runner.rkt @@ -93,7 +93,7 @@ (check-equal? (run '(= (add1 4) 5)) #t) (check-equal? (run '(< 5 5)) #f) (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f)) + (check-equal? (run '(< (add1 4) 5)) #f)) (begin ;; Hustle (check-equal? (run '(empty? (cons 1 2))) #f) From f37bf1e0f30af8a9e654d970f8396603abc1b1a6 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 15:13:35 -0400 Subject: [PATCH 27/47] Rename test files. Closes #5. --- .../{test-runner.rkt => define-tests.rkt} | 0 .../{compile.rkt => run-compile-tests.rkt} | 2 +- .../test/run-interp-tests.rkt | 2 +- .../test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../test/run-compile-tests.rkt | 2 +- .../test/run-interp-tests.rkt | 2 +- .../test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../test/run-compile-tests.rkt | 2 +- .../test/run-interp-tests.rkt | 2 +- con/test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../{compile.rkt => run-compile-tests.rkt} | 2 +- .../test/run-interp-tests.rkt | 2 +- .../test/{parse.rkt => run-parse-tests.rkt} | 0 dupe/test/compile.rkt | 8 - .../{test-runner.rkt => define-tests.rkt} | 0 dupe/test/interp.rkt | 7 - dupe/test/run-compile-tests.rkt | 8 + dupe/test/run-interp-tests.rkt | 7 + dupe/test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../{compile.rkt => run-compile-tests.rkt} | 2 +- .../test/{interp.rkt => run-interp-tests.rkt} | 2 +- .../test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../{compile.rkt => run-compile-tests.rkt} | 2 +- .../test/{interp.rkt => run-interp-tests.rkt} | 2 +- .../test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../{compile.rkt => run-compile-tests.rkt} | 2 +- .../test/run-interp-tests.rkt | 2 +- fraud/test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../{compile.rkt => run-compile-tests.rkt} | 2 +- .../test/run-interp-heap-bits-tests.rkt | 2 +- ...erp-heap.rkt => run-interp-heap-tests.rkt} | 2 +- .../test/run-interp-tests.rkt | 2 +- hoax/test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../{compile.rkt => run-compile-tests.rkt} | 2 +- .../test/run-interp-heap-bits-tests.rkt | 2 +- ...erp-heap.rkt => run-interp-heap-tests.rkt} | 2 +- .../test/run-interp-tests.rkt | 2 +- .../test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../{compile.rkt => run-compile-tests.rkt} | 2 +- .../test/{interp.rkt => run-interp-tests.rkt} | 2 +- .../test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../{compile.rkt => run-compile-tests.rkt} | 2 +- jig/test/{interp.rkt => run-interp-tests.rkt} | 2 +- jig/test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../{compile.rkt => run-compile-tests.rkt} | 2 +- .../test/{interp.rkt => run-interp-tests.rkt} | 2 +- knock/test/{parse.rkt => run-parse-tests.rkt} | 0 .../{test-runner.rkt => define-tests.rkt} | 0 .../{compile.rkt => run-compile-tests.rkt} | 2 +- .../test/{interp.rkt => run-interp-tests.rkt} | 2 +- loot/test/{parse.rkt => run-parse-tests.rkt} | 0 mountebank/test/compile.rkt | 8 - .../{test-runner.rkt => define-tests.rkt} | 0 mountebank/test/interp.rkt | 8 - mountebank/test/run-compile-tests.rkt | 8 + mountebank/test/run-interp-tests.rkt | 8 + .../test/{parse.rkt => run-parse-tests.rkt} | 0 mug/test/compile.rkt | 8 - .../{test-runner.rkt => define-tests.rkt} | 0 mug/test/interp.rkt | 8 - mug/test/run-compile-tests.rkt | 8 + mug/test/run-interp-tests.rkt | 8 + mug/test/{parse.rkt => run-parse-tests.rkt} | 0 neerdowell/test/compile.rkt | 8 - neerdowell/test/interp-defun.rkt | 24 - neerdowell/test/interp.rkt | 8 - neerdowell/test/test-runner.rkt | 550 ------------ outlaw/test/compile.rkt | 18 - outlaw/test/test-runner.rkt | 781 ------------------ 80 files changed, 77 insertions(+), 1466 deletions(-) rename abscond/test/{test-runner.rkt => define-tests.rkt} (100%) rename abscond/test/{compile.rkt => run-compile-tests.rkt} (84%) rename con/test/interp.rkt => abscond/test/run-interp-tests.rkt (80%) rename abscond/test/{parse.rkt => run-parse-tests.rkt} (100%) rename blackmail/test/{test-runner.rkt => define-tests.rkt} (100%) rename con/test/compile.rkt => blackmail/test/run-compile-tests.rkt (84%) rename abscond/test/interp.rkt => blackmail/test/run-interp-tests.rkt (80%) rename blackmail/test/{parse.rkt => run-parse-tests.rkt} (100%) rename con/test/{test-runner.rkt => define-tests.rkt} (100%) rename blackmail/test/compile.rkt => con/test/run-compile-tests.rkt (84%) rename dodger/test/interp.rkt => con/test/run-interp-tests.rkt (80%) rename con/test/{parse.rkt => run-parse-tests.rkt} (100%) rename dodger/test/{test-runner.rkt => define-tests.rkt} (100%) rename dodger/test/{compile.rkt => run-compile-tests.rkt} (84%) rename blackmail/test/interp.rkt => dodger/test/run-interp-tests.rkt (80%) rename dodger/test/{parse.rkt => run-parse-tests.rkt} (100%) delete mode 100644 dupe/test/compile.rkt rename dupe/test/{test-runner.rkt => define-tests.rkt} (100%) delete mode 100644 dupe/test/interp.rkt create mode 100644 dupe/test/run-compile-tests.rkt create mode 100644 dupe/test/run-interp-tests.rkt rename dupe/test/{parse.rkt => run-parse-tests.rkt} (100%) rename evildoer/test/{test-runner.rkt => define-tests.rkt} (100%) rename evildoer/test/{compile.rkt => run-compile-tests.rkt} (87%) rename evildoer/test/{interp.rkt => run-interp-tests.rkt} (87%) rename evildoer/test/{parse.rkt => run-parse-tests.rkt} (100%) rename extort/test/{test-runner.rkt => define-tests.rkt} (100%) rename extort/test/{compile.rkt => run-compile-tests.rkt} (87%) rename extort/test/{interp.rkt => run-interp-tests.rkt} (87%) rename extort/test/{parse.rkt => run-parse-tests.rkt} (100%) rename fraud/test/{test-runner.rkt => define-tests.rkt} (100%) rename fraud/test/{compile.rkt => run-compile-tests.rkt} (88%) rename hustle/test/interp.rkt => fraud/test/run-interp-tests.rkt (88%) rename fraud/test/{parse.rkt => run-parse-tests.rkt} (100%) rename hoax/test/{test-runner.rkt => define-tests.rkt} (100%) rename hoax/test/{compile.rkt => run-compile-tests.rkt} (88%) rename hustle/test/interp-heap-bits.rkt => hoax/test/run-interp-heap-bits-tests.rkt (90%) rename hoax/test/{interp-heap.rkt => run-interp-heap-tests.rkt} (90%) rename fraud/test/interp.rkt => hoax/test/run-interp-tests.rkt (88%) rename hoax/test/{parse.rkt => run-parse-tests.rkt} (100%) rename hustle/test/{test-runner.rkt => define-tests.rkt} (100%) rename hustle/test/{compile.rkt => run-compile-tests.rkt} (88%) rename hoax/test/interp-heap-bits.rkt => hustle/test/run-interp-heap-bits-tests.rkt (90%) rename hustle/test/{interp-heap.rkt => run-interp-heap-tests.rkt} (90%) rename hoax/test/interp.rkt => hustle/test/run-interp-tests.rkt (88%) rename hustle/test/{parse.rkt => run-parse-tests.rkt} (100%) rename iniquity/test/{test-runner.rkt => define-tests.rkt} (100%) rename iniquity/test/{compile.rkt => run-compile-tests.rkt} (89%) rename iniquity/test/{interp.rkt => run-interp-tests.rkt} (88%) rename iniquity/test/{parse.rkt => run-parse-tests.rkt} (100%) rename jig/test/{test-runner.rkt => define-tests.rkt} (100%) rename jig/test/{compile.rkt => run-compile-tests.rkt} (89%) rename jig/test/{interp.rkt => run-interp-tests.rkt} (88%) rename jig/test/{parse.rkt => run-parse-tests.rkt} (100%) rename knock/test/{test-runner.rkt => define-tests.rkt} (100%) rename knock/test/{compile.rkt => run-compile-tests.rkt} (89%) rename knock/test/{interp.rkt => run-interp-tests.rkt} (88%) rename knock/test/{parse.rkt => run-parse-tests.rkt} (100%) rename loot/test/{test-runner.rkt => define-tests.rkt} (100%) rename loot/test/{compile.rkt => run-compile-tests.rkt} (89%) rename loot/test/{interp.rkt => run-interp-tests.rkt} (88%) rename loot/test/{parse.rkt => run-parse-tests.rkt} (100%) delete mode 100644 mountebank/test/compile.rkt rename mountebank/test/{test-runner.rkt => define-tests.rkt} (100%) delete mode 100644 mountebank/test/interp.rkt create mode 100644 mountebank/test/run-compile-tests.rkt create mode 100644 mountebank/test/run-interp-tests.rkt rename mountebank/test/{parse.rkt => run-parse-tests.rkt} (100%) delete mode 100644 mug/test/compile.rkt rename mug/test/{test-runner.rkt => define-tests.rkt} (100%) delete mode 100644 mug/test/interp.rkt create mode 100644 mug/test/run-compile-tests.rkt create mode 100644 mug/test/run-interp-tests.rkt rename mug/test/{parse.rkt => run-parse-tests.rkt} (100%) delete mode 100644 neerdowell/test/compile.rkt delete mode 100644 neerdowell/test/interp-defun.rkt delete mode 100644 neerdowell/test/interp.rkt delete mode 100644 neerdowell/test/test-runner.rkt delete mode 100644 outlaw/test/compile.rkt delete mode 100644 outlaw/test/test-runner.rkt diff --git a/abscond/test/test-runner.rkt b/abscond/test/define-tests.rkt similarity index 100% rename from abscond/test/test-runner.rkt rename to abscond/test/define-tests.rkt diff --git a/abscond/test/compile.rkt b/abscond/test/run-compile-tests.rkt similarity index 84% rename from abscond/test/compile.rkt rename to abscond/test/run-compile-tests.rkt index db295e3..638f5e8 100644 --- a/abscond/test/compile.rkt +++ b/abscond/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (run (compile (parse e))))) diff --git a/con/test/interp.rkt b/abscond/test/run-interp-tests.rkt similarity index 80% rename from con/test/interp.rkt rename to abscond/test/run-interp-tests.rkt index 4ed7882..7a4ebb9 100644 --- a/con/test/interp.rkt +++ b/abscond/test/run-interp-tests.rkt @@ -1,7 +1,7 @@ #lang racket (require "../interpreter/interp.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (interp (parse e)))) diff --git a/abscond/test/parse.rkt b/abscond/test/run-parse-tests.rkt similarity index 100% rename from abscond/test/parse.rkt rename to abscond/test/run-parse-tests.rkt diff --git a/blackmail/test/test-runner.rkt b/blackmail/test/define-tests.rkt similarity index 100% rename from blackmail/test/test-runner.rkt rename to blackmail/test/define-tests.rkt diff --git a/con/test/compile.rkt b/blackmail/test/run-compile-tests.rkt similarity index 84% rename from con/test/compile.rkt rename to blackmail/test/run-compile-tests.rkt index db295e3..638f5e8 100644 --- a/con/test/compile.rkt +++ b/blackmail/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (run (compile (parse e))))) diff --git a/abscond/test/interp.rkt b/blackmail/test/run-interp-tests.rkt similarity index 80% rename from abscond/test/interp.rkt rename to blackmail/test/run-interp-tests.rkt index 4ed7882..7a4ebb9 100644 --- a/abscond/test/interp.rkt +++ b/blackmail/test/run-interp-tests.rkt @@ -1,7 +1,7 @@ #lang racket (require "../interpreter/interp.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (interp (parse e)))) diff --git a/blackmail/test/parse.rkt b/blackmail/test/run-parse-tests.rkt similarity index 100% rename from blackmail/test/parse.rkt rename to blackmail/test/run-parse-tests.rkt diff --git a/con/test/test-runner.rkt b/con/test/define-tests.rkt similarity index 100% rename from con/test/test-runner.rkt rename to con/test/define-tests.rkt diff --git a/blackmail/test/compile.rkt b/con/test/run-compile-tests.rkt similarity index 84% rename from blackmail/test/compile.rkt rename to con/test/run-compile-tests.rkt index db295e3..638f5e8 100644 --- a/blackmail/test/compile.rkt +++ b/con/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (run (compile (parse e))))) diff --git a/dodger/test/interp.rkt b/con/test/run-interp-tests.rkt similarity index 80% rename from dodger/test/interp.rkt rename to con/test/run-interp-tests.rkt index 4ed7882..7a4ebb9 100644 --- a/dodger/test/interp.rkt +++ b/con/test/run-interp-tests.rkt @@ -1,7 +1,7 @@ #lang racket (require "../interpreter/interp.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (interp (parse e)))) diff --git a/con/test/parse.rkt b/con/test/run-parse-tests.rkt similarity index 100% rename from con/test/parse.rkt rename to con/test/run-parse-tests.rkt diff --git a/dodger/test/test-runner.rkt b/dodger/test/define-tests.rkt similarity index 100% rename from dodger/test/test-runner.rkt rename to dodger/test/define-tests.rkt diff --git a/dodger/test/compile.rkt b/dodger/test/run-compile-tests.rkt similarity index 84% rename from dodger/test/compile.rkt rename to dodger/test/run-compile-tests.rkt index db295e3..638f5e8 100644 --- a/dodger/test/compile.rkt +++ b/dodger/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (run (compile (parse e))))) diff --git a/blackmail/test/interp.rkt b/dodger/test/run-interp-tests.rkt similarity index 80% rename from blackmail/test/interp.rkt rename to dodger/test/run-interp-tests.rkt index 4ed7882..7a4ebb9 100644 --- a/blackmail/test/interp.rkt +++ b/dodger/test/run-interp-tests.rkt @@ -1,7 +1,7 @@ #lang racket (require "../interpreter/interp.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (interp (parse e)))) diff --git a/dodger/test/parse.rkt b/dodger/test/run-parse-tests.rkt similarity index 100% rename from dodger/test/parse.rkt rename to dodger/test/run-parse-tests.rkt diff --git a/dupe/test/compile.rkt b/dupe/test/compile.rkt deleted file mode 100644 index db295e3..0000000 --- a/dupe/test/compile.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require "../compiler/compile.rkt") -(require "../syntax/parse.rkt") -(require "../executor/run.rkt") -(require "test-runner.rkt") - -(test (λ (e) (run (compile (parse e))))) - diff --git a/dupe/test/test-runner.rkt b/dupe/test/define-tests.rkt similarity index 100% rename from dupe/test/test-runner.rkt rename to dupe/test/define-tests.rkt diff --git a/dupe/test/interp.rkt b/dupe/test/interp.rkt deleted file mode 100644 index 4ed7882..0000000 --- a/dupe/test/interp.rkt +++ /dev/null @@ -1,7 +0,0 @@ -#lang racket -(require "../interpreter/interp.rkt") -(require "../syntax/parse.rkt") -(require "test-runner.rkt") - -(test (λ (e) (interp (parse e)))) - diff --git a/dupe/test/run-compile-tests.rkt b/dupe/test/run-compile-tests.rkt new file mode 100644 index 0000000..638f5e8 --- /dev/null +++ b/dupe/test/run-compile-tests.rkt @@ -0,0 +1,8 @@ +#lang racket +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") +(require "define-tests.rkt") + +(test (λ (e) (run (compile (parse e))))) + diff --git a/dupe/test/run-interp-tests.rkt b/dupe/test/run-interp-tests.rkt new file mode 100644 index 0000000..7a4ebb9 --- /dev/null +++ b/dupe/test/run-interp-tests.rkt @@ -0,0 +1,7 @@ +#lang racket +(require "../interpreter/interp.rkt") +(require "../syntax/parse.rkt") +(require "define-tests.rkt") + +(test (λ (e) (interp (parse e)))) + diff --git a/dupe/test/parse.rkt b/dupe/test/run-parse-tests.rkt similarity index 100% rename from dupe/test/parse.rkt rename to dupe/test/run-parse-tests.rkt diff --git a/evildoer/test/test-runner.rkt b/evildoer/test/define-tests.rkt similarity index 100% rename from evildoer/test/test-runner.rkt rename to evildoer/test/define-tests.rkt diff --git a/evildoer/test/compile.rkt b/evildoer/test/run-compile-tests.rkt similarity index 87% rename from evildoer/test/compile.rkt rename to evildoer/test/run-compile-tests.rkt index aaeb50f..253889d 100644 --- a/evildoer/test/compile.rkt +++ b/evildoer/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (run (compile (parse e))))) diff --git a/evildoer/test/interp.rkt b/evildoer/test/run-interp-tests.rkt similarity index 87% rename from evildoer/test/interp.rkt rename to evildoer/test/run-interp-tests.rkt index a987b86..4fdfde2 100644 --- a/evildoer/test/interp.rkt +++ b/evildoer/test/run-interp-tests.rkt @@ -2,7 +2,7 @@ (require "../interpreter/interp.rkt") (require "../interpreter/interp-io.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (interp (parse e)))) diff --git a/evildoer/test/parse.rkt b/evildoer/test/run-parse-tests.rkt similarity index 100% rename from evildoer/test/parse.rkt rename to evildoer/test/run-parse-tests.rkt diff --git a/extort/test/test-runner.rkt b/extort/test/define-tests.rkt similarity index 100% rename from extort/test/test-runner.rkt rename to extort/test/define-tests.rkt diff --git a/extort/test/compile.rkt b/extort/test/run-compile-tests.rkt similarity index 87% rename from extort/test/compile.rkt rename to extort/test/run-compile-tests.rkt index aaeb50f..253889d 100644 --- a/extort/test/compile.rkt +++ b/extort/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (run (compile (parse e))))) diff --git a/extort/test/interp.rkt b/extort/test/run-interp-tests.rkt similarity index 87% rename from extort/test/interp.rkt rename to extort/test/run-interp-tests.rkt index a987b86..4fdfde2 100644 --- a/extort/test/interp.rkt +++ b/extort/test/run-interp-tests.rkt @@ -2,7 +2,7 @@ (require "../interpreter/interp.rkt") (require "../interpreter/interp-io.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (interp (parse e)))) diff --git a/extort/test/parse.rkt b/extort/test/run-parse-tests.rkt similarity index 100% rename from extort/test/parse.rkt rename to extort/test/run-parse-tests.rkt diff --git a/fraud/test/test-runner.rkt b/fraud/test/define-tests.rkt similarity index 100% rename from fraud/test/test-runner.rkt rename to fraud/test/define-tests.rkt diff --git a/fraud/test/compile.rkt b/fraud/test/run-compile-tests.rkt similarity index 88% rename from fraud/test/compile.rkt rename to fraud/test/run-compile-tests.rkt index fabb24f..9cc5971 100644 --- a/fraud/test/compile.rkt +++ b/fraud/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (run (compile (parse-closed e))))) (test/io (λ (i e) (run/io (compile (parse-closed e)) i))) diff --git a/hustle/test/interp.rkt b/fraud/test/run-interp-tests.rkt similarity index 88% rename from hustle/test/interp.rkt rename to fraud/test/run-interp-tests.rkt index acb6a86..32de7cc 100644 --- a/hustle/test/interp.rkt +++ b/fraud/test/run-interp-tests.rkt @@ -2,7 +2,7 @@ (require "../interpreter/interp.rkt") (require "../interpreter/interp-io.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (interp (parse-closed e)))) (test/io (λ (in e) (interp/io (parse-closed e) in))) diff --git a/fraud/test/parse.rkt b/fraud/test/run-parse-tests.rkt similarity index 100% rename from fraud/test/parse.rkt rename to fraud/test/run-parse-tests.rkt diff --git a/hoax/test/test-runner.rkt b/hoax/test/define-tests.rkt similarity index 100% rename from hoax/test/test-runner.rkt rename to hoax/test/define-tests.rkt diff --git a/hoax/test/compile.rkt b/hoax/test/run-compile-tests.rkt similarity index 88% rename from hoax/test/compile.rkt rename to hoax/test/run-compile-tests.rkt index fabb24f..9cc5971 100644 --- a/hoax/test/compile.rkt +++ b/hoax/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (run (compile (parse-closed e))))) (test/io (λ (i e) (run/io (compile (parse-closed e)) i))) diff --git a/hustle/test/interp-heap-bits.rkt b/hoax/test/run-interp-heap-bits-tests.rkt similarity index 90% rename from hustle/test/interp-heap-bits.rkt rename to hoax/test/run-interp-heap-bits-tests.rkt index a6525cf..115f689 100644 --- a/hustle/test/interp-heap-bits.rkt +++ b/hoax/test/run-interp-heap-bits-tests.rkt @@ -1,5 +1,5 @@ #lang racket -(require "test-runner.rkt") +(require "define-tests.rkt") (require "../syntax/parse.rkt") (require "../interpreter/interp-heap-bits.rkt") (require "../interpreter/interp-io.rkt") diff --git a/hoax/test/interp-heap.rkt b/hoax/test/run-interp-heap-tests.rkt similarity index 90% rename from hoax/test/interp-heap.rkt rename to hoax/test/run-interp-heap-tests.rkt index 14d7068..252f89e 100644 --- a/hoax/test/interp-heap.rkt +++ b/hoax/test/run-interp-heap-tests.rkt @@ -1,5 +1,5 @@ #lang racket -(require "test-runner.rkt") +(require "define-tests.rkt") (require "../syntax/parse.rkt") (require "../interpreter/interp-heap.rkt") (require "../interpreter/interp-io.rkt") diff --git a/fraud/test/interp.rkt b/hoax/test/run-interp-tests.rkt similarity index 88% rename from fraud/test/interp.rkt rename to hoax/test/run-interp-tests.rkt index acb6a86..32de7cc 100644 --- a/fraud/test/interp.rkt +++ b/hoax/test/run-interp-tests.rkt @@ -2,7 +2,7 @@ (require "../interpreter/interp.rkt") (require "../interpreter/interp-io.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (interp (parse-closed e)))) (test/io (λ (in e) (interp/io (parse-closed e) in))) diff --git a/hoax/test/parse.rkt b/hoax/test/run-parse-tests.rkt similarity index 100% rename from hoax/test/parse.rkt rename to hoax/test/run-parse-tests.rkt diff --git a/hustle/test/test-runner.rkt b/hustle/test/define-tests.rkt similarity index 100% rename from hustle/test/test-runner.rkt rename to hustle/test/define-tests.rkt diff --git a/hustle/test/compile.rkt b/hustle/test/run-compile-tests.rkt similarity index 88% rename from hustle/test/compile.rkt rename to hustle/test/run-compile-tests.rkt index fabb24f..9cc5971 100644 --- a/hustle/test/compile.rkt +++ b/hustle/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (run (compile (parse-closed e))))) (test/io (λ (i e) (run/io (compile (parse-closed e)) i))) diff --git a/hoax/test/interp-heap-bits.rkt b/hustle/test/run-interp-heap-bits-tests.rkt similarity index 90% rename from hoax/test/interp-heap-bits.rkt rename to hustle/test/run-interp-heap-bits-tests.rkt index a6525cf..115f689 100644 --- a/hoax/test/interp-heap-bits.rkt +++ b/hustle/test/run-interp-heap-bits-tests.rkt @@ -1,5 +1,5 @@ #lang racket -(require "test-runner.rkt") +(require "define-tests.rkt") (require "../syntax/parse.rkt") (require "../interpreter/interp-heap-bits.rkt") (require "../interpreter/interp-io.rkt") diff --git a/hustle/test/interp-heap.rkt b/hustle/test/run-interp-heap-tests.rkt similarity index 90% rename from hustle/test/interp-heap.rkt rename to hustle/test/run-interp-heap-tests.rkt index 14d7068..252f89e 100644 --- a/hustle/test/interp-heap.rkt +++ b/hustle/test/run-interp-heap-tests.rkt @@ -1,5 +1,5 @@ #lang racket -(require "test-runner.rkt") +(require "define-tests.rkt") (require "../syntax/parse.rkt") (require "../interpreter/interp-heap.rkt") (require "../interpreter/interp-io.rkt") diff --git a/hoax/test/interp.rkt b/hustle/test/run-interp-tests.rkt similarity index 88% rename from hoax/test/interp.rkt rename to hustle/test/run-interp-tests.rkt index acb6a86..32de7cc 100644 --- a/hoax/test/interp.rkt +++ b/hustle/test/run-interp-tests.rkt @@ -2,7 +2,7 @@ (require "../interpreter/interp.rkt") (require "../interpreter/interp-io.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ (e) (interp (parse-closed e)))) (test/io (λ (in e) (interp/io (parse-closed e) in))) diff --git a/hustle/test/parse.rkt b/hustle/test/run-parse-tests.rkt similarity index 100% rename from hustle/test/parse.rkt rename to hustle/test/run-parse-tests.rkt diff --git a/iniquity/test/test-runner.rkt b/iniquity/test/define-tests.rkt similarity index 100% rename from iniquity/test/test-runner.rkt rename to iniquity/test/define-tests.rkt diff --git a/iniquity/test/compile.rkt b/iniquity/test/run-compile-tests.rkt similarity index 89% rename from iniquity/test/compile.rkt rename to iniquity/test/run-compile-tests.rkt index 76fdb1a..2cf66fd 100644 --- a/iniquity/test/compile.rkt +++ b/iniquity/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ p (run (compile (apply parse-closed p))))) (test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) diff --git a/iniquity/test/interp.rkt b/iniquity/test/run-interp-tests.rkt similarity index 88% rename from iniquity/test/interp.rkt rename to iniquity/test/run-interp-tests.rkt index 823063f..96137ef 100644 --- a/iniquity/test/interp.rkt +++ b/iniquity/test/run-interp-tests.rkt @@ -2,7 +2,7 @@ (require "../interpreter/interp.rkt") (require "../interpreter/interp-io.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ p (interp (apply parse-closed p)))) (test/io (λ (in . p) (interp/io (apply parse-closed p) in))) diff --git a/iniquity/test/parse.rkt b/iniquity/test/run-parse-tests.rkt similarity index 100% rename from iniquity/test/parse.rkt rename to iniquity/test/run-parse-tests.rkt diff --git a/jig/test/test-runner.rkt b/jig/test/define-tests.rkt similarity index 100% rename from jig/test/test-runner.rkt rename to jig/test/define-tests.rkt diff --git a/jig/test/compile.rkt b/jig/test/run-compile-tests.rkt similarity index 89% rename from jig/test/compile.rkt rename to jig/test/run-compile-tests.rkt index 76fdb1a..2cf66fd 100644 --- a/jig/test/compile.rkt +++ b/jig/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ p (run (compile (apply parse-closed p))))) (test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) diff --git a/jig/test/interp.rkt b/jig/test/run-interp-tests.rkt similarity index 88% rename from jig/test/interp.rkt rename to jig/test/run-interp-tests.rkt index 823063f..96137ef 100644 --- a/jig/test/interp.rkt +++ b/jig/test/run-interp-tests.rkt @@ -2,7 +2,7 @@ (require "../interpreter/interp.rkt") (require "../interpreter/interp-io.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ p (interp (apply parse-closed p)))) (test/io (λ (in . p) (interp/io (apply parse-closed p) in))) diff --git a/jig/test/parse.rkt b/jig/test/run-parse-tests.rkt similarity index 100% rename from jig/test/parse.rkt rename to jig/test/run-parse-tests.rkt diff --git a/knock/test/test-runner.rkt b/knock/test/define-tests.rkt similarity index 100% rename from knock/test/test-runner.rkt rename to knock/test/define-tests.rkt diff --git a/knock/test/compile.rkt b/knock/test/run-compile-tests.rkt similarity index 89% rename from knock/test/compile.rkt rename to knock/test/run-compile-tests.rkt index 76fdb1a..2cf66fd 100644 --- a/knock/test/compile.rkt +++ b/knock/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ p (run (compile (apply parse-closed p))))) (test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) diff --git a/knock/test/interp.rkt b/knock/test/run-interp-tests.rkt similarity index 88% rename from knock/test/interp.rkt rename to knock/test/run-interp-tests.rkt index 823063f..96137ef 100644 --- a/knock/test/interp.rkt +++ b/knock/test/run-interp-tests.rkt @@ -2,7 +2,7 @@ (require "../interpreter/interp.rkt") (require "../interpreter/interp-io.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ p (interp (apply parse-closed p)))) (test/io (λ (in . p) (interp/io (apply parse-closed p) in))) diff --git a/knock/test/parse.rkt b/knock/test/run-parse-tests.rkt similarity index 100% rename from knock/test/parse.rkt rename to knock/test/run-parse-tests.rkt diff --git a/loot/test/test-runner.rkt b/loot/test/define-tests.rkt similarity index 100% rename from loot/test/test-runner.rkt rename to loot/test/define-tests.rkt diff --git a/loot/test/compile.rkt b/loot/test/run-compile-tests.rkt similarity index 89% rename from loot/test/compile.rkt rename to loot/test/run-compile-tests.rkt index 76fdb1a..2cf66fd 100644 --- a/loot/test/compile.rkt +++ b/loot/test/run-compile-tests.rkt @@ -2,7 +2,7 @@ (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") (require "../executor/run.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ p (run (compile (apply parse-closed p))))) (test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) diff --git a/loot/test/interp.rkt b/loot/test/run-interp-tests.rkt similarity index 88% rename from loot/test/interp.rkt rename to loot/test/run-interp-tests.rkt index 823063f..96137ef 100644 --- a/loot/test/interp.rkt +++ b/loot/test/run-interp-tests.rkt @@ -2,7 +2,7 @@ (require "../interpreter/interp.rkt") (require "../interpreter/interp-io.rkt") (require "../syntax/parse.rkt") -(require "test-runner.rkt") +(require "define-tests.rkt") (test (λ p (interp (apply parse-closed p)))) (test/io (λ (in . p) (interp/io (apply parse-closed p) in))) diff --git a/loot/test/parse.rkt b/loot/test/run-parse-tests.rkt similarity index 100% rename from loot/test/parse.rkt rename to loot/test/run-parse-tests.rkt diff --git a/mountebank/test/compile.rkt b/mountebank/test/compile.rkt deleted file mode 100644 index 76fdb1a..0000000 --- a/mountebank/test/compile.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require "../compiler/compile.rkt") -(require "../syntax/parse.rkt") -(require "../executor/run.rkt") -(require "test-runner.rkt") -(test (λ p (run (compile (apply parse-closed p))))) -(test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) - diff --git a/mountebank/test/test-runner.rkt b/mountebank/test/define-tests.rkt similarity index 100% rename from mountebank/test/test-runner.rkt rename to mountebank/test/define-tests.rkt diff --git a/mountebank/test/interp.rkt b/mountebank/test/interp.rkt deleted file mode 100644 index 823063f..0000000 --- a/mountebank/test/interp.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require "../interpreter/interp.rkt") -(require "../interpreter/interp-io.rkt") -(require "../syntax/parse.rkt") -(require "test-runner.rkt") -(test (λ p (interp (apply parse-closed p)))) -(test/io (λ (in . p) (interp/io (apply parse-closed p) in))) - diff --git a/mountebank/test/run-compile-tests.rkt b/mountebank/test/run-compile-tests.rkt new file mode 100644 index 0000000..2cf66fd --- /dev/null +++ b/mountebank/test/run-compile-tests.rkt @@ -0,0 +1,8 @@ +#lang racket +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") +(require "define-tests.rkt") +(test (λ p (run (compile (apply parse-closed p))))) +(test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) + diff --git a/mountebank/test/run-interp-tests.rkt b/mountebank/test/run-interp-tests.rkt new file mode 100644 index 0000000..96137ef --- /dev/null +++ b/mountebank/test/run-interp-tests.rkt @@ -0,0 +1,8 @@ +#lang racket +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") +(require "define-tests.rkt") +(test (λ p (interp (apply parse-closed p)))) +(test/io (λ (in . p) (interp/io (apply parse-closed p) in))) + diff --git a/mountebank/test/parse.rkt b/mountebank/test/run-parse-tests.rkt similarity index 100% rename from mountebank/test/parse.rkt rename to mountebank/test/run-parse-tests.rkt diff --git a/mug/test/compile.rkt b/mug/test/compile.rkt deleted file mode 100644 index 76fdb1a..0000000 --- a/mug/test/compile.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require "../compiler/compile.rkt") -(require "../syntax/parse.rkt") -(require "../executor/run.rkt") -(require "test-runner.rkt") -(test (λ p (run (compile (apply parse-closed p))))) -(test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) - diff --git a/mug/test/test-runner.rkt b/mug/test/define-tests.rkt similarity index 100% rename from mug/test/test-runner.rkt rename to mug/test/define-tests.rkt diff --git a/mug/test/interp.rkt b/mug/test/interp.rkt deleted file mode 100644 index 823063f..0000000 --- a/mug/test/interp.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require "../interpreter/interp.rkt") -(require "../interpreter/interp-io.rkt") -(require "../syntax/parse.rkt") -(require "test-runner.rkt") -(test (λ p (interp (apply parse-closed p)))) -(test/io (λ (in . p) (interp/io (apply parse-closed p) in))) - diff --git a/mug/test/run-compile-tests.rkt b/mug/test/run-compile-tests.rkt new file mode 100644 index 0000000..2cf66fd --- /dev/null +++ b/mug/test/run-compile-tests.rkt @@ -0,0 +1,8 @@ +#lang racket +(require "../compiler/compile.rkt") +(require "../syntax/parse.rkt") +(require "../executor/run.rkt") +(require "define-tests.rkt") +(test (λ p (run (compile (apply parse-closed p))))) +(test/io (λ (in . p) (run/io (compile (apply parse-closed p)) in))) + diff --git a/mug/test/run-interp-tests.rkt b/mug/test/run-interp-tests.rkt new file mode 100644 index 0000000..96137ef --- /dev/null +++ b/mug/test/run-interp-tests.rkt @@ -0,0 +1,8 @@ +#lang racket +(require "../interpreter/interp.rkt") +(require "../interpreter/interp-io.rkt") +(require "../syntax/parse.rkt") +(require "define-tests.rkt") +(test (λ p (interp (apply parse-closed p)))) +(test/io (λ (in . p) (interp/io (apply parse-closed p) in))) + diff --git a/mug/test/parse.rkt b/mug/test/run-parse-tests.rkt similarity index 100% rename from mug/test/parse.rkt rename to mug/test/run-parse-tests.rkt diff --git a/neerdowell/test/compile.rkt b/neerdowell/test/compile.rkt deleted file mode 100644 index a94773c..0000000 --- a/neerdowell/test/compile.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require "test-runner.rkt" - "../syntax/parse.rkt" - "../compiler/compile.rkt" - "../executor/run.rkt") - -(test-runner (λ p (run (compile (parse p))))) -(test-runner-io (λ (s . p) (run/io (compile (parse p)) s))) diff --git a/neerdowell/test/interp-defun.rkt b/neerdowell/test/interp-defun.rkt deleted file mode 100644 index 82da55d..0000000 --- a/neerdowell/test/interp-defun.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket -(require "test-runner.rkt" - "../syntax/parse.rkt" - "../interpreter/interp-defun.rkt" - "../interpreter/interp-io.rkt") - -(define (closure->proc xs e r) - ;; Could make this better by calling the interpreter, - ;; but it's only used in tests where all we care about - ;; is that you get a procedure. - (lambda _ - (error "This function is not callable."))) - -(test-runner - (λ p - (match (interp (parse p)) - [(Closure xs e r) (closure->proc xs e r)] - [v v]))) -(test-runner-io - (λ (s . p) - (match (interp/io (parse p) s) - [(cons (Closure xs e r) o) - (cons (closure->proc xs e r) o)] - [r r]))) diff --git a/neerdowell/test/interp.rkt b/neerdowell/test/interp.rkt deleted file mode 100644 index 5338128..0000000 --- a/neerdowell/test/interp.rkt +++ /dev/null @@ -1,8 +0,0 @@ -#lang racket -(require "test-runner.rkt" - "../syntax/parse.rkt" - "../interpreter/interp.rkt" - "../interpreter/interp-io.rkt") - -(test-runner (λ p (interp (parse p)))) -(test-runner-io (λ (s . p) (interp/io (parse p) s))) diff --git a/neerdowell/test/test-runner.rkt b/neerdowell/test/test-runner.rkt deleted file mode 100644 index a0fc443..0000000 --- a/neerdowell/test/test-runner.rkt +++ /dev/null @@ -1,550 +0,0 @@ -#lang racket -(provide test-runner test-runner-io) -(require rackunit) - -(define (test-runner run) - ;; Abscond examples - (check-equal? (run 7) 7) - (check-equal? (run -8) -8) - - ;; Blackmail examples - (check-equal? (run '(add1 (add1 7))) 9) - (check-equal? (run '(add1 (sub1 7))) 7) - - ;; Con examples - (check-equal? (run '(if (zero? 0) 1 2)) 1) - (check-equal? (run '(if (zero? 1) 1 2)) 2) - (check-equal? (run '(if (zero? -7) 1 2)) 2) - (check-equal? (run '(if (zero? 0) - (if (zero? 1) 1 2) - 7)) - 2) - (check-equal? (run '(if (zero? (if (zero? 0) 1 0)) - (if (zero? 1) 1 2) - 7)) - 7) - - ;; Dupe examples - (check-equal? (run #t) #t) - (check-equal? (run #f) #f) - (check-equal? (run '(if #t 1 2)) 1) - (check-equal? (run '(if #f 1 2)) 2) - (check-equal? (run '(if 0 1 2)) 1) - (check-equal? (run '(if #t 3 4)) 3) - (check-equal? (run '(if #f 3 4)) 4) - (check-equal? (run '(if 0 3 4)) 3) - (check-equal? (run '(zero? 4)) #f) - (check-equal? (run '(zero? 0)) #t) - - ;; Dodger examples - (check-equal? (run #\a) #\a) - (check-equal? (run #\b) #\b) - (check-equal? (run '(char? #\a)) #t) - (check-equal? (run '(char? #t)) #f) - (check-equal? (run '(char? 8)) #f) - (check-equal? (run '(char->integer #\a)) (char->integer #\a)) - (check-equal? (run '(integer->char 955)) #\λ) - - ;; Extort examples - (check-equal? (run '(add1 #f)) 'err) - (check-equal? (run '(sub1 #f)) 'err) - (check-equal? (run '(zero? #f)) 'err) - (check-equal? (run '(char->integer #f)) 'err) - (check-equal? (run '(integer->char #f)) 'err) - (check-equal? (run '(integer->char -1)) 'err) - (check-equal? (run '(write-byte #f)) 'err) - (check-equal? (run '(write-byte -1)) 'err) - (check-equal? (run '(write-byte 256)) 'err) - - ;; Fraud examples - (check-equal? (run '(let ((x 7)) x)) 7) - (check-equal? (run '(let ((x 7)) 2)) 2) - (check-equal? (run '(let ((x 7)) (add1 x))) 8) - (check-equal? (run '(let ((x (add1 7))) x)) 8) - (check-equal? (run '(let ((x 7)) (let ((y 2)) x))) 7) - (check-equal? (run '(let ((x 7)) (let ((x 2)) x))) 2) - (check-equal? (run '(let ((x 7)) (let ((x (add1 x))) x))) 8) - - (check-equal? (run '(let ((x 0)) - (if (zero? x) 7 8))) - 7) - (check-equal? (run '(let ((x 1)) - (add1 (if (zero? x) 7 8)))) - 9) - (check-equal? (run '(+ 3 4)) 7) - (check-equal? (run '(- 3 4)) -1) - (check-equal? (run '(+ (+ 2 1) 4)) 7) - (check-equal? (run '(+ (+ 2 1) (+ 2 2))) 7) - (check-equal? (run '(let ((x (+ 1 2))) - (let ((z (- 4 x))) - (+ (+ x x) z)))) - 7) - (check-equal? (run '(= 5 5)) #t) - (check-equal? (run '(= 4 5)) #f) - (check-equal? (run '(= (add1 4) 5)) #t) - (check-equal? (run '(< 5 5)) #f) - (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f) - - ;; Hustle examples - (check-equal? (run ''()) '()) - (check-equal? (run '(box 1)) (box 1)) - (check-equal? (run '(box -1)) (box -1)) - (check-equal? (run '(cons 1 2)) (cons 1 2)) - (check-equal? (run '(unbox (box 1))) 1) - (check-equal? (run '(car (cons 1 2))) 1) - (check-equal? (run '(cdr (cons 1 2))) 2) - (check-equal? (run '(cons 1 '())) (list 1)) - (check-equal? (run '(let ((x (cons 1 2))) - (begin (cdr x) - (car x)))) - 1) - (check-equal? (run '(let ((x (cons 1 2))) - (let ((y (box 3))) - (unbox y)))) - 3) - (check-equal? (run '(eq? 1 1)) #t) - (check-equal? (run '(eq? 1 2)) #f) - (check-equal? (run '(eq? (cons 1 2) (cons 1 2))) #f) - (check-equal? (run '(let ((x (cons 1 2))) (eq? x x))) #t) - - ;; Hoax examples - (check-equal? (run '(make-vector 0 0)) #()) - (check-equal? (run '(make-vector 1 0)) #(0)) - (check-equal? (run '(make-vector 3 0)) #(0 0 0)) - (check-equal? (run '(make-vector 3 5)) #(5 5 5)) - (check-equal? (run '(vector? (make-vector 0 0))) #t) - (check-equal? (run '(vector? (cons 0 0))) #f) - (check-equal? (run '(vector-ref (make-vector 0 #f) 0)) 'err) - (check-equal? (run '(vector-ref (make-vector 3 5) -1)) 'err) - (check-equal? (run '(vector-ref (make-vector 3 5) 0)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 1)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 2)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 3)) 'err) - (check-equal? (run '(let ((x (make-vector 3 5))) - (begin (vector-set! x 0 4) - x))) - #(4 5 5)) - (check-equal? (run '(let ((x (make-vector 3 5))) - (begin (vector-set! x 1 4) - x))) - #(5 4 5)) - (check-equal? (run '(vector-length (make-vector 3 #f))) 3) - (check-equal? (run '(vector-length (make-vector 0 #f))) 0) - (check-equal? (run '"") "") - (check-equal? (run '"fred") "fred") - (check-equal? (run '"wilma") "wilma") - (check-equal? (run '(make-string 0 #\f)) "") - (check-equal? (run '(make-string 3 #\f)) "fff") - (check-equal? (run '(make-string 3 #\g)) "ggg") - (check-equal? (run '(string-length "")) 0) - (check-equal? (run '(string-length "fred")) 4) - (check-equal? (run '(string-ref "" 0)) 'err) - (check-equal? (run '(string-ref (make-string 0 #\a) 0)) 'err) - (check-equal? (run '(string-ref "fred" 0)) #\f) - (check-equal? (run '(string-ref "fred" 1)) #\r) - (check-equal? (run '(string-ref "fred" 2)) #\e) - (check-equal? (run '(string-ref "fred" 4)) 'err) - (check-equal? (run '(string? "fred")) #t) - (check-equal? (run '(string? (cons 1 2))) #f) - (check-equal? (run '(begin (make-string 3 #\f) - (make-string 3 #\f))) - "fff") - - ;; Iniquity tests - (check-equal? (run - '(define (f x) x) - '(f 5)) - 5) - - (check-equal? (run - '(define (tri x) - (if (zero? x) - 0 - (+ x (tri (sub1 x))))) - '(tri 9)) - 45) - - (check-equal? (run - '(define (f x) x) - '(define (g x) (f x)) - '(g 5)) - 5) - (check-equal? (run - '(define (even? x) - (if (zero? x) - #t - (odd? (sub1 x)))) - '(define (odd? x) - (if (zero? x) - #f - (even? (sub1 x)))) - '(even? 101)) - #f) - (check-equal? (run - '(define (map-add1 xs) - (if (empty? xs) - '() - (cons (add1 (car xs)) - (map-add1 (cdr xs))))) - '(map-add1 (cons 1 (cons 2 (cons 3 '()))))) - '(2 3 4)) - (check-equal? (run - '(define (f x) - 10) - '(f 1)) - 10) - (check-equal? (run - '(define (f x) - 10) - '(let ((x 2)) (f 1))) - 10) - (check-equal? (run - '(define (f x y) - 10) - '(f 1 2)) - 10) - (check-equal? (run - '(define (f x y) - 10) - '(let ((z 2)) (f 1 2))) - 10) - (check-equal? (run '(define (f x y) y) - '(f 1 (add1 #f))) - 'err) - - ;; Knock examples - (check-equal? (run '(match 1)) 'err) - (check-equal? (run '(match 1 [1 2])) - 2) - (check-equal? (run '(match 1 [2 1] [1 2])) - 2) - (check-equal? (run '(match 1 [2 1] [1 2] [0 3])) - 2) - (check-equal? (run '(match 1 [2 1] [0 3])) - 'err) - (check-equal? (run '(match 1 [_ 2] [_ 3])) - 2) - (check-equal? (run '(match 1 [x 2] [_ 3])) - 2) - (check-equal? (run '(match 1 [x x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [x x] [_ 3])) - (cons 1 2)) - (check-equal? (run '(match (cons 1 2) [(cons x y) x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [(cons x 2) x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [(cons 3 2) 0] [_ 3])) - 3) - (check-equal? (run '(match 1 [(cons x y) x] [_ 3])) - 3) - (check-equal? (run '(match (cons 1 2) [(cons 1 3) 0] [(cons 1 y) y] [_ 3])) - 2) - (check-equal? (run '(match (box 1) [(box 1) 0] [_ 1])) - 0) - (check-equal? (run '(match (box 1) [(box 2) 0] [_ 1])) - 1) - (check-equal? (run '(match (box 1) [(box x) x] [_ 2])) - 1) - - ;; Loot examples - (check-true (procedure? (run '(λ (x) x)))) - (check-equal? (run '((λ (x) x) 5)) - 5) - - (check-equal? (run '(let ((f (λ (x) x))) (f 5))) - 5) - (check-equal? (run '(let ((f (λ (x y) x))) (f 5 7))) - 5) - (check-equal? (run '(let ((f (λ (x y) y))) (f 5 7))) - 7) - (check-equal? (run '((let ((x 1)) - (let ((y 2)) - (lambda (z) (cons x (cons y (cons z '())))))) - 3)) - '(1 2 3)) - (check-equal? (run '(define (adder n) - (λ (x) (+ x n))) - '((adder 5) 10)) - 15) - (check-equal? (run '(((λ (t) - ((λ (f) (t (λ (z) ((f f) z)))) - (λ (f) (t (λ (z) ((f f) z)))))) - (λ (tri) - (λ (n) - (if (zero? n) - 0 - (+ n (tri (sub1 n))))))) - 36)) - 666) - (check-equal? (run '(define (tri n) - (if (zero? n) - 0 - (+ n (tri (sub1 n))))) - '(tri 36)) - 666) - (check-equal? (run '(define (tri n) - (match n - [0 0] - [m (+ m (tri (sub1 m)))])) - '(tri 36)) - 666) - (check-equal? (run '((match 8 [8 (lambda (x) x)]) 12)) - 12) - - ;; Mug examples - (check-equal? (run '(symbol? 'foo)) #t) - (check-equal? (run '(symbol? (string->symbol "foo"))) #t) - (check-equal? (run '(eq? 'foo 'foo)) #t) - (check-equal? (run '(eq? (string->symbol "foo") - (string->symbol "foo"))) - #t) - (check-equal? (run '(eq? 'foo (string->symbol "foo"))) - #t) - (check-equal? (run '(eq? 'fff (string->symbol (make-string 3 #\f)))) - #t) - (check-equal? (run '(symbol? 'g0)) #t) - (check-equal? (run '(symbol? "g0")) #f) - (check-equal? (run '(symbol? (string->symbol "g0"))) #t) - (check-equal? (run '(symbol? (string->uninterned-symbol "g0"))) #t) - (check-equal? (run '(eq? 'g0 (string->symbol "g0"))) #t) - (check-equal? (run '(eq? 'g0 (string->uninterned-symbol "g0"))) #f) - (check-equal? (run '(eq? (string->uninterned-symbol "g0") (string->uninterned-symbol "g0"))) - #f) - (check-equal? (run '(eq? (symbol->string 'foo) (symbol->string 'foo))) #f) - (check-equal? (run '(string? (symbol->string 'foo))) #t) - (check-equal? (run '(eq? (symbol->string 'foo) "foo")) #f) - (check-equal? (run ''foo) 'foo) - (check-equal? (run '(eq? (match #t [_ "foo"]) "bar")) #f) - (check-equal? (run '(eq? (match #t [_ 'foo]) 'bar)) #f) - (check-equal? (run '(match 'foo ['bar #t] [_ #f])) #f) - (check-equal? (run '(match 'foo ['foo #t] [_ #f])) #t) - (check-equal? (run '(match "foo" ["foo" #t] [_ #f])) #t) - (check-equal? (run '(match "foo" ["bar" #t] [_ #f])) #f) - (check-equal? (run '(match (cons '+ (cons 1 (cons 2 '()))) - [(cons '+ (cons x (cons y '()))) - (+ x y)])) - 3) - - ;; Mountebank examples - (check-equal? (run '#()) - #()) - (check-equal? (run ''#()) - #()) - (check-equal? (run ''#t) - #t) - (check-equal? (run ''7) - 7) - (check-equal? (run ''(1 2 3)) - '(1 2 3)) - (check-equal? (run ''(1 . 2)) - '(1 . 2)) - (check-equal? (run ''(("1") (#() #(1 #(2))) (#&(1)) (#f) (4) (5))) - '(("1") (#() #(1 #(2))) (#&(1)) (#f) (4) (5))) - (check-equal? (run '(define (f) (cons 1 2)) - '(eq? (f) (f))) - #f) - (check-equal? (run '(define (f) '(1 . 2)) - '(eq? (f) (f))) - #t) - (check-equal? (run '(let ((x '(foo . foo))) - (eq? (car x) (cdr x)))) - #t) - (check-equal? - (run '(define (eval e r) - (match e - [(list 'zero? e) - (zero? (eval e r))] - [(list 'sub1 e) - (sub1 (eval e r))] - [(list '+ e1 e2) - (+ (eval e1 r) (eval e2 r))] - [(list 'if e1 e2 e3) - (if (eval e1 r) - (eval e2 r) - (eval e3 r))] - [(list 'λ (list x) e) - (lambda (v) (eval e (cons (cons x v) r)))] - [(list e1 e2) - ((eval e1 r) (eval e2 r))] - [_ - (if (symbol? e) - (lookup r e) - e)])) - '(define (lookup r x) - (match r - [(cons (cons y v) r) - (if (eq? x y) - v - (lookup r x))])) - '(eval '(((λ (t) - ((λ (f) (t (λ (z) ((f f) z)))) - (λ (f) (t (λ (z) ((f f) z)))))) - (λ (tri) - (λ (n) - (if (zero? n) - 0 - (+ n (tri (sub1 n))))))) - 36) - '())) - 666) - - ;; Neerdowell examples - (check-equal? (run '(struct foo ()) - '(foo? (foo))) - #t) - (check-equal? (run '(struct foo (x)) - '(foo? (foo 1))) - #t) - (check-equal? (run '(struct foo ()) - '(struct bar ()) - '(foo? (bar))) - #f) - (check-equal? (run '(struct foo ()) - '(struct bar ()) - '(bar? (bar))) - #t) - (check-equal? (run '(struct foo ()) - '(struct bar ()) - '(bar? #())) - #f) - (check-equal? (run '(struct foo (x)) - '(foo-x (foo 3))) - 3) - (check-equal? (run '(struct foo (x)) - '(let ((x (foo 3))) - (foo-x x))) - 3) - (check-equal? (run '(struct foo (x)) - '(let ((x (foo 3))) - (foo-x x))) - 3) - (check-equal? (run '(struct foo (x)) - '(let ((x (foo (foo 3)))) - (foo? (foo-x x)))) - #t) - (check-equal? (run '(struct foo (x y z)) - '(let ((x (foo 1 2 3))) - (cons (foo-x x) - (cons (foo-y x) - (cons (foo-z x) - '()))))) - '(1 2 3)) - (check-equal? (run '(struct foo ()) - '(eq? (foo) (foo))) - #f) - (check-equal? (run '(struct foo (x)) - '(foo-x #t)) - 'err) - (check-equal? (run '(struct foo (x)) - '(struct bar (y)) - '(match (bar 5) - [(foo x) #f] - [(bar x) x])) - 5) - (check-equal? (run '(struct nil ()) - '(struct pair (x y)) - '(define (len x) - (match x - [(nil) 0] - [(pair _ x) (add1 (len x))])) - '(len (pair 1 (pair 2 (pair 3 (nil)))))) - 3) - (check-equal? (run '(match (cons (cons 1 2) '()) - [(cons (cons x y) '()) y])) - 2) - (check-equal? (run '(struct foo (p q)) - '(match (cons (foo 1 2) '()) - [(cons (foo x y) _) y])) - 2) - (check-equal? (run '(struct foo (p q)) - '(match (cons (foo 1 2) '()) - [(cons (foo x 3) _) x] - [_ 9])) - 9) - (check-equal? (run '(struct foo (x q)) - '(define (get z) - (match z - ['() #f] - [(cons (foo x q) y) x])) - '(get (cons (foo 7 2) '()))) - 7) - (check-equal? (run '(struct posn (x y)) - '(define (posn-xs ps) - (match ps - ['() '()] - [(cons (posn x y) ps) - (cons x (posn-xs ps))])) - '(posn-xs (cons (posn 3 4) (cons (posn 5 6) (cons (posn 7 8) '()))))) - '(3 5 7)) - (check-equal? (run '(struct Foo (x y z)) - '(match (Foo 1 2 3) - [(Foo x y z) z])) - 3) - (check-equal? (run '(struct Boo (x)) - '(match 8 - [(Boo 'y) 0] - [_ 1])) - 1)) - -(define (test-runner-io run) - ;; Evildoer examples - (check-equal? (run "" 7) (cons 7 "")) - (check-equal? (run "" '(write-byte 97)) (cons (void) "a")) - (check-equal? (run "a" '(read-byte)) (cons 97 "")) - (check-equal? (run "b" '(begin (write-byte 97) (read-byte))) - (cons 98 "a")) - (check-equal? (run "" '(read-byte)) (cons eof "")) - (check-equal? (run "" '(eof-object? (read-byte))) (cons #t "")) - (check-equal? (run "a" '(eof-object? (read-byte))) (cons #f "")) - (check-equal? (run "" '(begin (write-byte 97) (write-byte 98))) - (cons (void) "ab")) - - (check-equal? (run "ab" '(peek-byte)) (cons 97 "")) - (check-equal? (run "ab" '(begin (peek-byte) (read-byte))) (cons 97 "")) - ;; Extort examples - (check-equal? (run "" '(write-byte #t)) (cons 'err "")) - - ;; Fraud examples - (check-equal? (run "" '(let ((x 97)) (write-byte x))) (cons (void) "a")) - (check-equal? (run "" - '(let ((x 97)) - (begin (write-byte x) - x))) - (cons 97 "a")) - (check-equal? (run "b" '(let ((x 97)) (begin (read-byte) x))) - (cons 97 "")) - (check-equal? (run "b" '(let ((x 97)) (begin (peek-byte) x))) - (cons 97 "")) - - ;; Hustle examples - (check-equal? (run "" - '(let ((x 1)) - (begin (write-byte 97) - 1))) - (cons 1 "a")) - - (check-equal? (run "" - '(let ((x 1)) - (let ((y 2)) - (begin (write-byte 97) - 1)))) - (cons 1 "a")) - - (check-equal? (run "" - '(let ((x (cons 1 2))) - (begin (write-byte 97) - (car x)))) - (cons 1 "a")) - ;; Iniquity examples - #| - (check-equal? (run "" - '(define (print-alphabet i) - (if (zero? i) - (void) - (begin (write-byte (- 123 i)) - (print-alphabet (sub1 i))))) - '(print-alphabet 26)) - (cons (void) "abcdefghijklmnopqrstuvwxyz")) -|#) diff --git a/outlaw/test/compile.rkt b/outlaw/test/compile.rkt deleted file mode 100644 index 0d8f86a..0000000 --- a/outlaw/test/compile.rkt +++ /dev/null @@ -1,18 +0,0 @@ -#lang racket -(require "test-runner.rkt" - "../parse.rkt" - "../compile.rkt" - "../unload-bits-asm.rkt" - "../a86/interp.rkt") - -;; link with runtime for IO operations -(unless (file-exists? "../runtime.o") - (system "make -C .. runtime.o")) -(current-objs - (list (path->string (normalize-path "../runtime.o")))) - -(test-runner (λ p (unload/free (asm-interp (compile (parse p)))))) -(test-runner-io (λ (s . p) - (match (asm-interp/io (compile (parse p)) s) - ['err 'err] - [(cons r o) (cons (unload/free r) o)]))) diff --git a/outlaw/test/test-runner.rkt b/outlaw/test/test-runner.rkt deleted file mode 100644 index 64f0d41..0000000 --- a/outlaw/test/test-runner.rkt +++ /dev/null @@ -1,781 +0,0 @@ -#lang racket -(provide test-runner test-runner-io) -(require rackunit) - -(define (test-runner run) - ;; Abscond examples - (check-equal? (run 7) 7) - (check-equal? (run -8) -8) - - ;; Blackmail examples - (check-equal? (run '(add1 (add1 7))) 9) - (check-equal? (run '(add1 (sub1 7))) 7) - - ;; Con examples - (check-equal? (run '(if (zero? 0) 1 2)) 1) - (check-equal? (run '(if (zero? 1) 1 2)) 2) - (check-equal? (run '(if (zero? -7) 1 2)) 2) - (check-equal? (run '(if (zero? 0) - (if (zero? 1) 1 2) - 7)) - 2) - (check-equal? (run '(if (zero? (if (zero? 0) 1 0)) - (if (zero? 1) 1 2) - 7)) - 7) - - ;; Dupe examples - (check-equal? (run #t) #t) - (check-equal? (run #f) #f) - (check-equal? (run '(if #t 1 2)) 1) - (check-equal? (run '(if #f 1 2)) 2) - (check-equal? (run '(if 0 1 2)) 1) - (check-equal? (run '(if #t 3 4)) 3) - (check-equal? (run '(if #f 3 4)) 4) - (check-equal? (run '(if 0 3 4)) 3) - (check-equal? (run '(zero? 4)) #f) - (check-equal? (run '(zero? 0)) #t) - - ;; Dodger examples - (check-equal? (run #\a) #\a) - (check-equal? (run #\b) #\b) - (check-equal? (run '(char? #\a)) #t) - (check-equal? (run '(char? #t)) #f) - (check-equal? (run '(char? 8)) #f) - (check-equal? (run '(char->integer #\a)) (char->integer #\a)) - (check-equal? (run '(integer->char 955)) #\λ) - - ;; Extort examples - (check-equal? (run '(add1 #f)) 'err) - (check-equal? (run '(sub1 #f)) 'err) - (check-equal? (run '(zero? #f)) 'err) - (check-equal? (run '(char->integer #f)) 'err) - (check-equal? (run '(integer->char #f)) 'err) - (check-equal? (run '(integer->char -1)) 'err) - (check-equal? (run '(write-byte #f)) 'err) - (check-equal? (run '(write-byte -1)) 'err) - (check-equal? (run '(write-byte 256)) 'err) - - ;; Fraud examples - (check-equal? (run '(let ((x 7)) x)) 7) - (check-equal? (run '(let ((x 7)) 2)) 2) - (check-equal? (run '(let ((x 7)) (add1 x))) 8) - (check-equal? (run '(let ((x (add1 7))) x)) 8) - (check-equal? (run '(let ((x 7)) (let ((y 2)) x))) 7) - (check-equal? (run '(let ((x 7)) (let ((x 2)) x))) 2) - (check-equal? (run '(let ((x 7)) (let ((x (add1 x))) x))) 8) - - (check-equal? (run '(let ((x 0)) - (if (zero? x) 7 8))) - 7) - (check-equal? (run '(let ((x 1)) - (add1 (if (zero? x) 7 8)))) - 9) - (check-equal? (run '(+ 3 4)) 7) - (check-equal? (run '(- 3 4)) -1) - (check-equal? (run '(+ (+ 2 1) 4)) 7) - (check-equal? (run '(+ (+ 2 1) (+ 2 2))) 7) - (check-equal? (run '(let ((x (+ 1 2))) - (let ((z (- 4 x))) - (+ (+ x x) z)))) - 7) - (check-equal? (run '(= 5 5)) #t) - (check-equal? (run '(= 4 5)) #f) - (check-equal? (run '(= (add1 4) 5)) #t) - (check-equal? (run '(< 5 5)) #f) - (check-equal? (run '(< 4 5)) #t) - (check-equal? (run '(< (add1 4) 5)) #f) - - ;; Hustle examples - (check-equal? (run ''()) '()) - (check-equal? (run '(box 1)) (box 1)) - (check-equal? (run '(box -1)) (box -1)) - (check-equal? (run '(cons 1 2)) (cons 1 2)) - (check-equal? (run '(unbox (box 1))) 1) - (check-equal? (run '(car (cons 1 2))) 1) - (check-equal? (run '(cdr (cons 1 2))) 2) - (check-equal? (run '(cons 1 '())) (list 1)) - (check-equal? (run '(let ((x (cons 1 2))) - (begin (cdr x) - (car x)))) - 1) - (check-equal? (run '(let ((x (cons 1 2))) - (let ((y (box 3))) - (unbox y)))) - 3) - (check-equal? (run '(eq? 1 1)) #t) - (check-equal? (run '(eq? 1 2)) #f) - (check-equal? (run '(eq? (cons 1 2) (cons 1 2))) #f) - (check-equal? (run '(let ((x (cons 1 2))) (eq? x x))) #t) - - ;; Hoax examples - (check-equal? (run '(make-vector 0 0)) #()) - (check-equal? (run '(make-vector 1 0)) #(0)) - (check-equal? (run '(make-vector 3 0)) #(0 0 0)) - (check-equal? (run '(make-vector 3 5)) #(5 5 5)) - (check-equal? (run '(vector? (make-vector 0 0))) #t) - (check-equal? (run '(vector? (cons 0 0))) #f) - (check-equal? (run '(vector-ref (make-vector 0 #f) 0)) 'err) - (check-equal? (run '(vector-ref (make-vector 3 5) -1)) 'err) - (check-equal? (run '(vector-ref (make-vector 3 5) 0)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 1)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 2)) 5) - (check-equal? (run '(vector-ref (make-vector 3 5) 3)) 'err) - (check-equal? (run '(let ((x (make-vector 3 5))) - (begin (vector-set! x 0 4) - x))) - #(4 5 5)) - (check-equal? (run '(let ((x (make-vector 3 5))) - (begin (vector-set! x 1 4) - x))) - #(5 4 5)) - (check-equal? (run '(vector-length (make-vector 3 #f))) 3) - (check-equal? (run '(vector-length (make-vector 0 #f))) 0) - (check-equal? (run '"") "") - (check-equal? (run '"fred") "fred") - (check-equal? (run '"wilma") "wilma") - (check-equal? (run '(make-string 0 #\f)) "") - (check-equal? (run '(make-string 3 #\f)) "fff") - (check-equal? (run '(make-string 3 #\g)) "ggg") - (check-equal? (run '(string-length "")) 0) - (check-equal? (run '(string-length "fred")) 4) - (check-equal? (run '(string-ref "" 0)) 'err) - (check-equal? (run '(string-ref (make-string 0 #\a) 0)) 'err) - (check-equal? (run '(string-ref "fred" 0)) #\f) - (check-equal? (run '(string-ref "fred" 1)) #\r) - (check-equal? (run '(string-ref "fred" 2)) #\e) - (check-equal? (run '(string-ref "fred" 4)) 'err) - (check-equal? (run '(string? "fred")) #t) - (check-equal? (run '(string? (cons 1 2))) #f) - (check-equal? (run '(begin (make-string 3 #\f) - (make-string 3 #\f))) - "fff") - - ;; Iniquity tests - (check-equal? (run - '(define (f x) x) - '(f 5)) - 5) - (check-equal? (run - '(define (tri x) - (if (zero? x) - 0 - (+ x (tri (sub1 x))))) - '(tri 9)) - 45) - - (check-equal? (run - '(define (f x) x) - '(define (g x) (f x)) - '(g 5)) - 5) - (check-equal? (run - '(define (my-even? x) - (if (zero? x) - #t - (my-odd? (sub1 x)))) - '(define (my-odd? x) - (if (zero? x) - #f - (my-even? (sub1 x)))) - '(my-even? 101)) - #f) - (check-equal? (run - '(define (map-add1 xs) - (if (empty? xs) - '() - (cons (add1 (car xs)) - (map-add1 (cdr xs))))) - '(map-add1 (cons 1 (cons 2 (cons 3 '()))))) - '(2 3 4)) - (check-equal? (run - '(define (f x) - 10) - '(f 1)) - 10) - (check-equal? (run - '(define (f x) - 10) - '(let ((x 2)) (f 1))) - 10) - (check-equal? (run - '(define (f x y) - 10) - '(f 1 2)) - 10) - (check-equal? (run - '(define (f x y) - 10) - '(let ((z 2)) (f 1 2))) - 10) - - ;; Knock examples - (check-equal? (run '(match 1)) 'err) - (check-equal? (run '(match 1 [1 2])) - 2) - (check-equal? (run '(match 1 [2 1] [1 2])) - 2) - (check-equal? (run '(match 1 [2 1] [1 2] [0 3])) - 2) - (check-equal? (run '(match 1 [2 1] [0 3])) - 'err) - (check-equal? (run '(match 1 [_ 2] [_ 3])) - 2) - (check-equal? (run '(match 1 [x 2] [_ 3])) - 2) - (check-equal? (run '(match 1 [x x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [x x] [_ 3])) - (cons 1 2)) - (check-equal? (run '(match (cons 1 2) [(cons x y) x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [(cons x 2) x] [_ 3])) - 1) - (check-equal? (run '(match (cons 1 2) [(cons 3 2) 0] [_ 3])) - 3) - (check-equal? (run '(match 1 [(cons x y) x] [_ 3])) - 3) - (check-equal? (run '(match (cons 1 2) [(cons 1 3) 0] [(cons 1 y) y] [_ 3])) - 2) - (check-equal? (run '(match (box 1) [(box 1) 0] [_ 1])) - 0) - (check-equal? (run '(match (box 1) [(box 2) 0] [_ 1])) - 1) - (check-equal? (run '(match (box 1) [(box x) x] [_ 2])) - 1) - - ;; Loot examples - (check-true (procedure? (run '(λ (x) x)))) - (check-equal? (run '((λ (x) x) 5)) - 5) - - (check-equal? (run '(let ((f (λ (x) x))) (f 5))) - 5) - (check-equal? (run '(let ((f (λ (x y) x))) (f 5 7))) - 5) - (check-equal? (run '(let ((f (λ (x y) y))) (f 5 7))) - 7) - (check-equal? (run '((let ((x 1)) - (let ((y 2)) - (lambda (z) (cons x (cons y (cons z '())))))) - 3)) - '(1 2 3)) - (check-equal? (run '(define (adder n) - (λ (x) (+ x n))) - '((adder 5) 10)) - 15) - (check-equal? (run '(((λ (t) - ((λ (f) (t (λ (z) ((f f) z)))) - (λ (f) (t (λ (z) ((f f) z)))))) - (λ (tri) - (λ (n) - (if (zero? n) - 0 - (+ n (tri (sub1 n))))))) - 36)) - 666) - (check-equal? (run '(define (tri n) - (if (zero? n) - 0 - (+ n (tri (sub1 n))))) - '(tri 36)) - 666) - (check-equal? (run '(define (tri n) - (match n - [0 0] - [m (+ m (tri (sub1 m)))])) - '(tri 36)) - 666) - (check-equal? (run '((match 8 [8 (lambda (x) x)]) 12)) - 12) - - ;; Mug examples - (check-equal? (run '(symbol? 'foo)) #t) - (check-equal? (run '(symbol? (string->symbol "foo"))) #t) - (check-equal? (run '(eq? 'foo 'foo)) #t) - (check-equal? (run '(eq? (string->symbol "foo") - (string->symbol "foo"))) - #t) - (check-equal? (run '(eq? 'foo (string->symbol "foo"))) - #t) - (check-equal? (run '(eq? 'fff (string->symbol (make-string 3 #\f)))) - #t) - (check-equal? (run '(symbol? 'g0)) #t) - (check-equal? (run '(symbol? "g0")) #f) - (check-equal? (run '(symbol? (string->symbol "g0"))) #t) - (check-equal? (run '(symbol? (string->uninterned-symbol "g0"))) #t) - (check-equal? (run '(eq? 'g0 (string->symbol "g0"))) #t) - (check-equal? (run '(eq? 'g0 (string->uninterned-symbol "g0"))) #f) - (check-equal? (run '(eq? (string->uninterned-symbol "g0") (string->uninterned-symbol "g0"))) - #f) - (check-equal? (run '(eq? (symbol->string 'foo) (symbol->string 'foo))) #f) - (check-equal? (run '(string? (symbol->string 'foo))) #t) - (check-equal? (run '(eq? (symbol->string 'foo) "foo")) #f) - (check-equal? (run ''foo) 'foo) - (check-equal? (run '(eq? (match #t [_ "foo"]) "bar")) #f) - (check-equal? (run '(eq? (match #t [_ 'foo]) 'bar)) #f) - (check-equal? (run '(match 'foo ['bar #t] [_ #f])) #f) - (check-equal? (run '(match 'foo ['foo #t] [_ #f])) #t) - (check-equal? (run '(match "foo" ["foo" #t] [_ #f])) #t) - (check-equal? (run '(match "foo" ["bar" #t] [_ #f])) #f) - (check-equal? (run '(match (cons '+ (cons 1 (cons 2 '()))) - [(cons '+ (cons x (cons y '()))) - (+ x y)])) - 3) - - ;; Mountebank examples - (check-equal? (run '#()) - #()) - (check-equal? (run ''#()) - #()) - (check-equal? (run ''#t) - #t) - (check-equal? (run ''7) - 7) - (check-equal? (run ''(1 2 3)) - '(1 2 3)) - (check-equal? (run ''(1 . 2)) - '(1 . 2)) - (check-equal? (run ''(("1") (#() #(1 #(2))) (#&(1)) (#f) (4) (5))) - '(("1") (#() #(1 #(2))) (#&(1)) (#f) (4) (5))) - (check-equal? (run '(define (f) (cons 1 2)) - '(eq? (f) (f))) - #f) - (check-equal? (run '(define (f) '(1 . 2)) - '(eq? (f) (f))) - #t) - (check-equal? (run '(let ((x '(foo . foo))) - (eq? (car x) (cdr x)))) - #t) - (check-equal? - (run '(define (eval e r) - (match e - [(list 'zero? e) - (zero? (eval e r))] - [(list 'sub1 e) - (sub1 (eval e r))] - [(list '+ e1 e2) - (+ (eval e1 r) (eval e2 r))] - [(list 'if e1 e2 e3) - (if (eval e1 r) - (eval e2 r) - (eval e3 r))] - [(list 'λ (list x) e) - (lambda (v) (eval e (cons (cons x v) r)))] - [(list e1 e2) - ((eval e1 r) (eval e2 r))] - [_ - (if (symbol? e) - (lookup r e) - e)])) - '(define (lookup r x) - (match r - [(cons (cons y v) r) - (if (eq? x y) - v - (lookup r x))])) - '(eval '(((λ (t) - ((λ (f) (t (λ (z) ((f f) z)))) - (λ (f) (t (λ (z) ((f f) z)))))) - (λ (tri) - (λ (n) - (if (zero? n) - 0 - (+ n (tri (sub1 n))))))) - 36) - '())) - 666) - - ;; Neerdowell examples - (check-equal? (run '(struct foo ()) - '(foo? (foo))) - #t) - (check-equal? (run '(struct foo (x)) - '(foo? (foo 1))) - #t) - (check-equal? (run '(struct foo ()) - '(struct bar ()) - '(foo? (bar))) - #f) - (check-equal? (run '(struct foo ()) - '(struct bar ()) - '(bar? (bar))) - #t) - (check-equal? (run '(struct foo ()) - '(struct bar ()) - '(bar? #())) - #f) - (check-equal? (run '(struct foo (x)) - '(foo-x (foo 3))) - 3) - (check-equal? (run '(struct foo (x)) - '(let ((x (foo 3))) - (foo-x x))) - 3) - (check-equal? (run '(struct foo (x)) - '(let ((x (foo 3))) - (foo-x x))) - 3) - (check-equal? (run '(struct foo (x)) - '(let ((x (foo (foo 3)))) - (foo? (foo-x x)))) - #t) - (check-equal? (run '(struct foo (x y z)) - '(let ((x (foo 1 2 3))) - (cons (foo-x x) - (cons (foo-y x) - (cons (foo-z x) - '()))))) - '(1 2 3)) - (check-equal? (run '(struct foo ()) - '(eq? (foo) (foo))) - #f) - (check-equal? (run '(struct foo (x)) - '(foo-x #t)) - 'err) - (check-equal? (run '(struct foo (x)) - '(struct bar (y)) - '(match (bar 5) - [(foo x) #f] - [(bar x) x])) - 5) - (check-equal? (run '(struct nil ()) - '(struct pair (x y)) - '(define (len x) - (match x - [(nil) 0] - [(pair _ x) (add1 (len x))])) - '(len (pair 1 (pair 2 (pair 3 (nil)))))) - 3) - (check-equal? (run '(match (cons (cons 1 2) '()) - [(cons (cons x y) '()) y])) - 2) - (check-equal? (run '(struct foo (p q)) - '(match (cons (foo 1 2) '()) - [(cons (foo x y) _) y])) - 2) - (check-equal? (run '(struct foo (p q)) - '(match (cons (foo 1 2) '()) - [(cons (foo x 3) _) x] - [_ 9])) - 9) - (check-equal? (run '(struct foo (x q)) - '(define (get z) - (match z - ['() #f] - [(cons (foo x q) y) x])) - '(get (cons (foo 7 2) '()))) - 7) - (check-equal? (run '(struct posn (x y)) - '(define (posn-xs ps) - (match ps - ['() '()] - [(cons (posn x y) ps) - (cons x (posn-xs ps))])) - '(posn-xs (cons (posn 3 4) (cons (posn 5 6) (cons (posn 7 8) '()))))) - '(3 5 7)) - (check-equal? (run '(struct Foo (x y z)) - '(match (Foo 1 2 3) - [(Foo x y z) z])) - 3) - (check-equal? (run '(struct Boo (x)) - '(match 8 - [(Boo 'y) 0] - [_ 1])) - 1) - - ;; Outlaw examples - (check-equal? (run '(+)) 0) - (check-equal? (run '(+ 1 2 3)) 6) - (check-equal? (run '(< 1)) #t) - (check-equal? (run '(< 1 2 3)) #t) - (check-equal? (run '(< 1 3 3)) #f) - (check-equal? (run '(> 1)) #t) - (check-equal? (run '(> 3 2 1)) #t) - (check-equal? (run '(> 3 3 1)) #f) - (check-equal? (run '(<= 1)) #t) - (check-equal? (run '(<= 1 2 3)) #t) - (check-equal? (run '(<= 1 3 3)) #t) - (check-equal? (run '(<= 1 4 3)) #f) - (check-equal? (run '(>= 1)) #t) - (check-equal? (run '(>= 3 2 1)) #t) - (check-equal? (run '(>= 3 3 1)) #t) - (check-equal? (run '(>= 3 4 1)) #f) - (check-equal? (run '(list)) '()) - (check-equal? (run '(list 1 2 3)) '(1 2 3)) - (check-equal? (run '(map add1 (list 1 2 3))) '(2 3 4)) - (check-equal? (run '(map + (list 1 2 3) (list 4 5 6))) '(5 7 9)) - (check-equal? (run '(append)) '()) - (check-equal? (run '(append '(1 2 3))) '(1 2 3)) - (check-equal? (run '(append '(1 2 3) '())) '(1 2 3)) - (check-equal? (run '(append '() '(1 2 3))) '(1 2 3)) - (check-equal? (run '(append '(1 2 3) '(4 5 6))) '(1 2 3 4 5 6)) - (check-equal? (run '(memq 'x '())) #f) - (check-equal? (run '(memq 'x '(p x y))) '(x y)) - (check-equal? (run '(member 'x '() eq?)) #f) - (check-equal? (run '(member 'x '(p x y) eq?)) '(x y)) - (check-equal? (run '(append-map list '(1 2 3))) '(1 2 3)) - (check-equal? (run '(vector->list #())) '()) - (check-equal? (run '(vector->list #(1 2 3))) '(1 2 3)) - (check-equal? (run '(number->string 0)) "0") - (check-equal? (run '(number->string 10)) "10") - (check-equal? (run '(number->string 123)) "123") - (check-equal? (run '(number->string 0 10)) "0") - (check-equal? (run '(number->string 10 10)) "10") - (check-equal? (run '(number->string 123 10)) "123") - (check-equal? (run '(number->string 0 2)) "0") - (check-equal? (run '(number->string 1 2)) "1") - (check-equal? (run '(number->string 3 2)) "11") - (check-equal? (run '(number->string 8 2)) "1000") - (check-equal? (run '(number->string 0 8)) "0") - (check-equal? (run '(number->string 1 8)) "1") - (check-equal? (run '(number->string 3 8)) "3") - (check-equal? (run '(number->string 8 8)) "10") - (check-equal? (run '(number->string 0 16)) "0") - (check-equal? (run '(number->string 1 16)) "1") - (check-equal? (run '(number->string 3 16)) "3") - (check-equal? (run '(number->string 8 16)) "8") - (check-equal? (run '(number->string 10 16)) "a") - (check-equal? (run '(number->string 15 16)) "f") - (check-equal? (run '(number->string 16 16)) "10") - (check-pred symbol? (run '(gensym))) - (check-equal? (run '(eq? (gensym) (gensym))) #f) - (check-equal? (run '(let ((x (gensym))) (eq? x x))) #t) - (check-pred symbol? (run '(gensym 'fred))) - (check-equal? (run '(eq? (gensym 'fred) (gensym 'fred))) #f) - (check-equal? (run '(let ((x (gensym 'fred))) (eq? x x))) #t) - (check-pred symbol? (run '(gensym "fred"))) - (check-equal? (run '(eq? (gensym "fred") (gensym "fred"))) #f) - (check-equal? (run '(let ((x (gensym "fred"))) (eq? x x))) #t) - (check-equal? (run '(void? (void))) #t) - (check-equal? (run '(void? void)) #f) - (check-equal? (run '(eq? (void) (void))) #t) - (check-equal? (run '(bitwise-and #b111 #b000)) #b000) - (check-equal? (run '(bitwise-and #b111 #b111)) #b111) - (check-equal? (run '(bitwise-and #b101 #b100)) #b100) - (check-equal? (run '(bitwise-and #b001 #b100)) #b000) - (check-equal? (run '(bitwise-ior #b111 #b000)) #b111) - (check-equal? (run '(bitwise-ior #b111 #b111)) #b111) - (check-equal? (run '(bitwise-ior #b101 #b100)) #b101) - (check-equal? (run '(bitwise-ior #b001 #b100)) #b101) - (check-equal? (run '(bitwise-xor #b111 #b000)) #b111) - (check-equal? (run '(bitwise-xor #b111 #b111)) #b000) - (check-equal? (run '(bitwise-xor #b101 #b100)) #b001) - (check-equal? (run '(bitwise-xor #b001 #b100)) #b101) - (check-equal? (run '(arithmetic-shift 1 0)) 1) - (check-equal? (run '(arithmetic-shift 1 1)) 2) - (check-equal? (run '(arithmetic-shift 1 2)) 4) - (check-equal? (run '(arithmetic-shift 1 3)) 8) - (check-equal? (run '(arithmetic-shift 3 2)) 12) - (check-equal? (run '(or)) #f) - (check-equal? (run '(or #t)) #t) - (check-equal? (run '(or 7)) 7) - (check-equal? (run '(or 7 #t)) 7) - (check-equal? (run '(or #f #f #f)) #f) - (check-equal? (run '(or #f 7 9)) 7) - (check-equal? (run '(list->string '())) "") - (check-equal? (run '(list->string '(#\a #\b #\c))) "abc") - (check-equal? (run '(char<=? #\a)) #t) - (check-equal? (run '(char<=? #\a #\b)) #t) - (check-equal? (run '(char<=? #\a #\b #\c)) #t) - (check-equal? (run '(char<=? #\a #\b #\b)) #t) - (check-equal? (run '(char<=? #\a #\b #\a)) #f) - (check-equal? (run '(= (eq-hash-code 'x) (eq-hash-code 'x))) #t) - (check-equal? (run '(= (eq-hash-code 'x) (eq-hash-code 'y))) #f) - (check-equal? (run '(foldr + #f '())) #f) - (check-equal? (run '(foldr + 0 '(1 2 3))) 6) - (check-equal? (run '(list? '())) #t) - (check-equal? (run '(list? '(1 2 3))) #t) - (check-equal? (run '(list? (cons 1 2))) #f) - (check-equal? (run '(list? #t)) #f) - (check-equal? (run '(reverse '())) '()) - (check-equal? (run '(reverse '(1 2 3))) '(3 2 1)) - (check-equal? (run '(remove-duplicates '() eq?)) '()) - (check-equal? (run '(remove-duplicates '(1 2 3) eq?)) '(1 2 3)) - (check-equal? (run '(remove-duplicates '(1 2 3 2 1 3) eq?)) '(1 2 3)) - (check-equal? (run '(remove 'x '() eq?)) '()) - (check-equal? (run '(remove 'x '(x y z) eq?)) '(y z)) - (check-equal? (run '(remove 'x '(p q x r) eq?)) '(p q r)) - (check-equal? (run '(remove 'x '(p q x r x) eq?)) '(p q r x)) - (check-equal? (run '(remove* 'x '() eq?)) '()) - (check-equal? (run '(remove* 'x '(x y z) eq?)) '(y z)) - (check-equal? (run '(remove* 'x '(p q x r) eq?)) '(p q r)) - (check-equal? (run '(remove* 'x '(p q x r x) eq?)) '(p q r)) - (check-equal? (run '(remq* '(x y) '())) '()) - (check-equal? (run '(remq* '(x y) '(x y z))) '(z)) - (check-equal? (run '(remq* '(x y) '(p q x r x))) '(p q r)) - (check-equal? (run '(make-list 0 #\a)) '()) - (check-equal? (run '(make-list 3 #\a)) '(#\a #\a #\a)) - (check-equal? (run '(match 8 - [(? integer?) 1] - [_ 2])) - 1) - (check-equal? (run '(match 8 - [(? string?) 1] - [_ 2])) - 2) - (check-equal? (run '(match (cons 8 "8") - [(cons (? integer?) (? string?)) 1] - [_ 2])) - 1) - (check-equal? (run '(match 8 - [(? (lambda (x) (eq? x 8))) 1] - [_ 2])) - 1) - (check-equal? (run '(match 8 - [(? integer? x) x] - [_ 2])) - 8) - (check-equal? (run '(match (box #\a) - [(box (and x (? integer?))) 1] - [(box (and x (? char?))) x])) - #\a) - - (check-equal? (run '(vector)) #()) - (check-equal? (run '(vector 1 2 3)) #(1 2 3)) - (check-equal? (run '(list->vector '())) #()) - (check-equal? (run '(list->vector '(1 2 3))) #(1 2 3)) - (check-equal? (run '(boolean? #t)) #t) - (check-equal? (run '(boolean? #f)) #t) - (check-equal? (run '(boolean? 8)) #f) - (check-equal? (run '(substring "hello" 0)) "hello") - (check-equal? (run '(substring "hello" 1)) "ello") - (check-equal? (run '(substring "hello" 1 4)) "ell") - (check-equal? (run '(odd? 7)) #t) - (check-equal? (run '(odd? 8)) #f) - (check-equal? (run '(filter odd? '())) '()) - (check-equal? (run '(filter odd? '(1 2 3 4))) '(1 3)) - (check-equal? (run '(findf odd? '())) #f) - (check-equal? (run '(findf odd? '(2 4 3 7))) 3) - (check-equal? (run '(char-alphabetic? #\a)) #t) - (check-equal? (run '(char-alphabetic? #\space)) #f) - (check-equal? (run '(char-whitespace? #\a)) #f) - (check-equal? (run '(char-whitespace? #\space)) #t) - (check-equal? (run '(begin 1)) 1) - (check-equal? (run '(begin 1 2)) 2) - (check-equal? (run '(begin 1 2 3)) 3) - (check-equal? (run '(let () 1 2)) 2) - (check-equal? (run '(let ((x 1)) x x)) 1) - (check-equal? (run '(let ((x 1)) x x x)) 1) - (check-equal? (run '(match 1 [1 2 3])) 3) - (check-equal? (run '(system-type)) (system-type)) - (check-equal? (run '(struct Foo (x)) - '(struct Bar (y)) - '(match (Bar 1) - [(Foo x) #f] - [(Bar x) x])) - 1) - (check-equal? (run '(procedure? add1)) #t) - (check-equal? (run '(procedure? (lambda (x) x))) #t) - (check-equal? (run '(procedure? 8)) #f) - (check-equal? (run '(struct posn (x y)) - '(procedure? (posn 3 4))) - #f) - (check-equal? (run '(apply string-append (list "x"))) - "x") - - (check-equal? (run '(* 0 8)) 0) - (check-equal? (run '(* 1 8)) 8) - (check-equal? (run '(* 2 9)) 18) - (check-equal? (run '(* 2 -3)) -6) - (check-equal? (run '(* 4 3)) 12) - (check-equal? (run '(* 8 3)) 24) - (check-equal? (run '(* 16 2)) 32) - (check-equal? (run '(* 10 5)) 50) - (check-equal? (run '(* 64 2)) 128) - (check-equal? (run '(let ((pred (lambda (x) #t))) - (match 0 - [(and (? pred) _) #t] - [_ #f]))) - #t)) - - -(define (test-runner-io run) - ;; Evildoer examples - (check-equal? (run "" 7) (cons 7 "")) - (check-equal? (run "" '(write-byte 97)) (cons (void) "a")) - (check-equal? (run "a" '(read-byte)) (cons 97 "")) - (check-equal? (run "b" '(begin (write-byte 97) (read-byte))) - (cons 98 "a")) - (check-equal? (run "" '(read-byte)) (cons eof "")) - (check-equal? (run "" '(eof-object? (read-byte))) (cons #t "")) - (check-equal? (run "a" '(eof-object? (read-byte))) (cons #f "")) - (check-equal? (run "" '(begin (write-byte 97) (write-byte 98))) - (cons (void) "ab")) - (check-equal? (run "ab" '(peek-byte)) (cons 97 "")) - (check-equal? (run "ab" '(begin (peek-byte) (read-byte))) (cons 97 "")) - ;; Extort examples - (check-equal? (run "" '(write-byte #t)) (cons 'err "")) - - ;; Fraud examples - (check-equal? (run "" '(let ((x 97)) (write-byte x))) (cons (void) "a")) - (check-equal? (run "" - '(let ((x 97)) - (begin (write-byte x) - x))) - (cons 97 "a")) - (check-equal? (run "b" '(let ((x 97)) (begin (read-byte) x))) - (cons 97 "")) - (check-equal? (run "b" '(let ((x 97)) (begin (peek-byte) x))) - (cons 97 "")) - - ;; Hustle examples - (check-equal? (run "" - '(let ((x 1)) - (begin (write-byte 97) - 1))) - (cons 1 "a")) - - (check-equal? (run "" - '(let ((x 1)) - (let ((y 2)) - (begin (write-byte 97) - 1)))) - (cons 1 "a")) - - (check-equal? (run "" - '(let ((x (cons 1 2))) - (begin (write-byte 97) - (car x)))) - (cons 1 "a")) - ;; Iniquity examples - (check-equal? (run "" - '(define (print-alphabet i) - (if (zero? i) - (void) - (begin (write-byte (- 123 i)) - (print-alphabet (sub1 i))))) - '(print-alphabet 26)) - (cons (void) "abcdefghijklmnopqrstuvwxyz")) - - ;; Outlaw examples - (check-equal? (run "" '(read-char)) - (cons eof "")) - (check-equal? (run "a" '(read-char)) - (cons #\a "")) - (check-equal? (run "ab" '(read-char)) - (cons #\a "")) - (check-equal? (run "ab" '(cons (read-char) (read-char))) - (cons '(#\a . #\b) "")) - (check-equal? (run "a" '(peek-byte (%current-input-port) 0)) - (cons 97 "")) - (check-equal? (run "ab" '(cons (peek-byte (%current-input-port) 1) (read-byte))) - (cons (cons 98 97) "")) - (check-equal? (run "abc" '(cons (peek-byte (%current-input-port) 2) - (cons (read-byte) (read-byte)))) - (cons (cons 99 (cons 97 98)) "")) - (check-equal? (run "a" '(peek-char)) - (cons #\a "")) - (check-equal? (run "ab" '(cons (peek-char) (peek-char))) - (cons '(#\a . #\a) "")) - (check-equal? (run "λ" '(peek-char)) - (cons #\λ "")) - (check-equal? (run "" '(write-char #\a)) - (cons (void) "a")) - (check-equal? (run "" '(write-char #\newline)) - (cons (void) "\n")) - (check-equal? (run "" '(write-string "hello world")) - (cons 11 "hello world")) - (check-equal? (run "" '(displayln "hello world")) - (cons (void) "hello world\n")) - ) From 695064abfec118fd48a82756ead2b23014a14235 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 15:17:37 -0400 Subject: [PATCH 28/47] Fix up paths in workflow file. --- .github/workflows/ubuntu.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index efad544..44cb2f0 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -45,8 +45,8 @@ jobs: - name: Install a86 branch run: | - git clone --branch "${{ github.ref_name }}" --single-branch https://github.com/cmsc430/a86.git - raco pkg install --auto --no-docs a86/ + git clone --branch "${{ github.ref_name }}" --single-branch https://github.com/cmsc430/a86.git ../a86 + raco pkg install --auto --no-docs ../a86/ - name: Install langs package run: | From 7a1c19dd66cd7198bae30929acbb844b1f2b2915 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 15:36:39 -0400 Subject: [PATCH 29/47] Narrow langs CI reruns for flaky failures --- .github/workflows/ubuntu.yml | 43 ++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 44cb2f0..f0b14aa 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -53,5 +53,48 @@ jobs: raco pkg install --auto --no-docs ../langs/ - name: Run tests + id: langs-tests + continue-on-error: true run: | xvfb-run raco test -p langs + + - name: Rerun focused failing tests without trace + id: focused-rerun + if: steps.langs-tests.outcome == 'failure' + continue-on-error: true + run: | + case "${{ matrix.racket-version }}" in + stable) + xvfb-run raco test mug/test/run-compile-tests.rkt + ;; + 8.6) + xvfb-run raco test jig/test/run-compile-tests.rkt + ;; + *) + exit 0 + ;; + esac + + - name: Rerun focused failing tests with JIT trace + id: focused-rerun-trace + if: steps.langs-tests.outcome == 'failure' && steps.focused-rerun.outcome == 'failure' + continue-on-error: true + env: + A86_JIT_TRACE: "1" + run: | + case "${{ matrix.racket-version }}" in + stable) + xvfb-run raco test mug/test/run-compile-tests.rkt + ;; + 8.6) + xvfb-run raco test jig/test/run-compile-tests.rkt + ;; + *) + exit 0 + ;; + esac + + - name: Fail job if focused rerun also failed + if: steps.langs-tests.outcome == 'failure' && steps.focused-rerun.outcome == 'failure' && steps.focused-rerun-trace.outcome == 'failure' + run: | + exit 1 From 7e10f36afe104171dbebfa25c264ff2b02f793b9 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 15:47:08 -0400 Subject: [PATCH 30/47] Add prefix debug jobs for flaky CI failures --- .github/workflows/ubuntu.yml | 129 +++++++++++++++++++++++++++++++++++ 1 file changed, 129 insertions(+) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index f0b14aa..341827f 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -98,3 +98,132 @@ jobs: if: steps.langs-tests.outcome == 'failure' && steps.focused-rerun.outcome == 'failure' && steps.focused-rerun-trace.outcome == 'failure' run: | exit 1 + + debug-mug-prefix: + runs-on: ubuntu-22.04 + name: Debug prefix / Racket stable / mug + + steps: + + - name: Checkout + uses: actions/checkout@main + + - name: Install Racket + uses: Bogdanp/setup-racket@v1.15 + with: + architecture: 'x64' + distribution: 'full' + variant: 'CS' + version: 'stable' + + - name: Install LLVM + uses: ZhongRuoyu/setup-llvm@v0 + with: + llvm-version: 22 + + - name: Install libssl + run: | + sudo apt install -y libssl-dev + + - name: Install a86 branch + run: | + git clone --branch "${{ github.ref_name }}" --single-branch https://github.com/cmsc430/a86.git ../a86 + raco pkg install --auto --no-docs ../a86/ + + - name: Install langs package + run: | + raco pkg install --auto --no-docs ../langs/ + + - name: Run prefix before mug + run: | + xvfb-run raco test \ + abscond \ + blackmail \ + con \ + dodger \ + dupe \ + evildoer \ + extort \ + fraud \ + hoax \ + hustle \ + iniquity \ + jig \ + knock \ + loot + + - name: Run mug define tests + id: mug-define + continue-on-error: true + run: | + xvfb-run raco test mug/test/define-tests.rkt + + - name: Rerun mug define tests with JIT trace + if: steps.mug-define.outcome == 'failure' + env: + A86_JIT_TRACE: "1" + run: | + xvfb-run raco test mug/test/define-tests.rkt + + debug-jig-prefix: + runs-on: ubuntu-22.04 + name: Debug prefix / Racket 8.6 / jig + + steps: + + - name: Checkout + uses: actions/checkout@main + + - name: Install Racket + uses: Bogdanp/setup-racket@v1.15 + with: + architecture: 'x64' + distribution: 'full' + variant: 'CS' + version: '8.6' + + - name: Install LLVM + uses: ZhongRuoyu/setup-llvm@v0 + with: + llvm-version: 22 + + - name: Install libssl + run: | + sudo apt install -y libssl-dev + + - name: Install a86 branch + run: | + git clone --branch "${{ github.ref_name }}" --single-branch https://github.com/cmsc430/a86.git ../a86 + raco pkg install --auto --no-docs ../a86/ + + - name: Install langs package + run: | + raco pkg install --auto --no-docs ../langs/ + + - name: Run prefix before jig + run: | + xvfb-run raco test \ + abscond \ + blackmail \ + con \ + dodger \ + dupe \ + evildoer \ + extort \ + fraud \ + hoax \ + hustle \ + iniquity + + - name: Run jig define tests + id: jig-define + continue-on-error: true + run: | + xvfb-run raco test jig/test/define-tests.rkt + + - name: Rerun jig define tests with JIT trace + if: steps.jig-define.outcome == 'failure' + env: + A86_JIT_TRACE: "1" + run: | + xvfb-run raco test jig/test/define-tests.rkt From 218f0809707eff4fe02e9f15600a334327e03533 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 16:15:38 -0400 Subject: [PATCH 31/47] Refine flaky CI prefix debug jobs --- .github/workflows/ubuntu.yml | 37 +++++++++++++++++++++++++++++++----- 1 file changed, 32 insertions(+), 5 deletions(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 341827f..6b96313 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -150,7 +150,8 @@ jobs: iniquity \ jig \ knock \ - loot + loot \ + mountebank - name: Run mug define tests id: mug-define @@ -200,7 +201,7 @@ jobs: run: | raco pkg install --auto --no-docs ../langs/ - - name: Run prefix before jig + - name: Run prefix through hoax run: | xvfb-run raco test \ abscond \ @@ -211,12 +212,38 @@ jobs: evildoer \ extort \ fraud \ - hoax \ - hustle \ - iniquity + hoax + + - name: Run hustle tests + id: hustle-prefix + continue-on-error: true + run: | + xvfb-run raco test hustle + + - name: Rerun hustle tests with JIT trace + if: steps.hustle-prefix.outcome == 'failure' + env: + A86_JIT_TRACE: "1" + run: | + xvfb-run raco test hustle + + - name: Run iniquity tests + id: iniquity-prefix + if: steps.hustle-prefix.outcome != 'failure' + continue-on-error: true + run: | + xvfb-run raco test iniquity + + - name: Rerun iniquity tests with JIT trace + if: steps.iniquity-prefix.outcome == 'failure' + env: + A86_JIT_TRACE: "1" + run: | + xvfb-run raco test iniquity - name: Run jig define tests id: jig-define + if: steps.hustle-prefix.outcome != 'failure' && steps.iniquity-prefix.outcome != 'failure' continue-on-error: true run: | xvfb-run raco test jig/test/define-tests.rkt From 0dc1bd1e1c0c4c1042e6b14c61d44f28ce8bfee4 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 16:41:45 -0400 Subject: [PATCH 32/47] Retarget stable debug job to mountebank --- .github/workflows/ubuntu.yml | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 6b96313..658cd4a 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -99,9 +99,9 @@ jobs: run: | exit 1 - debug-mug-prefix: + debug-mountebank-prefix: runs-on: ubuntu-22.04 - name: Debug prefix / Racket stable / mug + name: Debug prefix / Racket stable / mountebank steps: @@ -134,7 +134,7 @@ jobs: run: | raco pkg install --auto --no-docs ../langs/ - - name: Run prefix before mug + - name: Run prefix before mountebank run: | xvfb-run raco test \ abscond \ @@ -150,21 +150,20 @@ jobs: iniquity \ jig \ knock \ - loot \ - mountebank + loot - - name: Run mug define tests - id: mug-define + - name: Run mountebank compile tests + id: mountebank-compile continue-on-error: true run: | - xvfb-run raco test mug/test/define-tests.rkt + xvfb-run raco test mountebank/test/run-compile-tests.rkt - - name: Rerun mug define tests with JIT trace - if: steps.mug-define.outcome == 'failure' + - name: Rerun mountebank compile tests with JIT trace + if: steps.mountebank-compile.outcome == 'failure' env: A86_JIT_TRACE: "1" run: | - xvfb-run raco test mug/test/define-tests.rkt + xvfb-run raco test mountebank/test/run-compile-tests.rkt debug-jig-prefix: runs-on: ubuntu-22.04 From fb4202154bce3cd62c2a2898b0b137e9d3288b3d Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 17:00:00 -0400 Subject: [PATCH 33/47] Replay exact stable test prefix in CI debug job --- .github/stable-prefix-files.txt | 381 ++++++++++++++++++++++++++++++++ .github/workflows/ubuntu.yml | 36 +-- 2 files changed, 391 insertions(+), 26 deletions(-) create mode 100644 .github/stable-prefix-files.txt diff --git a/.github/stable-prefix-files.txt b/.github/stable-prefix-files.txt new file mode 100644 index 0000000..7ff2ac4 --- /dev/null +++ b/.github/stable-prefix-files.txt @@ -0,0 +1,381 @@ +abscond/42.rkt +abscond/compiler/compile-stdin.rkt +abscond/compiler/compile.rkt +abscond/correct.rkt +abscond/executor/exec.rkt +abscond/executor/run-stdin.rkt +abscond/executor/run.rkt +abscond/interpreter/interp-stdin.rkt +abscond/interpreter/interp.rkt +abscond/main.rkt +abscond/syntax/ast.rkt +abscond/syntax/parse.rkt +abscond/test/define-tests.rkt +abscond/test/run-compile-tests.rkt +abscond/test/run-interp-tests.rkt +abscond/test/run-parse-tests.rkt +blackmail/add1-add1-40.rkt +blackmail/compiler/compile-ops.rkt +blackmail/compiler/compile-stdin.rkt +blackmail/compiler/compile.rkt +blackmail/correct.rkt +blackmail/executor/exec.rkt +blackmail/executor/run-stdin.rkt +blackmail/executor/run.rkt +blackmail/interpreter/interp-prim.rkt +blackmail/interpreter/interp-stdin.rkt +blackmail/interpreter/interp.rkt +blackmail/main.rkt +blackmail/syntax/ast.rkt +blackmail/syntax/parse.rkt +blackmail/syntax/random.rkt +blackmail/test/define-tests.rkt +blackmail/test/run-compile-tests.rkt +blackmail/test/run-interp-tests.rkt +blackmail/test/run-parse-tests.rkt +con/compiler/compile-ops.rkt +con/compiler/compile-stdin.rkt +con/compiler/compile.rkt +con/correct.rkt +con/example.rkt +con/executor/exec.rkt +con/executor/run-stdin.rkt +con/executor/run.rkt +con/interpreter/interp-prim.rkt +con/interpreter/interp-stdin.rkt +con/interpreter/interp.rkt +con/main.rkt +con/syntax/ast.rkt +con/syntax/parse.rkt +con/syntax/random.rkt +con/test/define-tests.rkt +con/test/run-compile-tests.rkt +con/test/run-interp-tests.rkt +con/test/run-parse-tests.rkt +dodger/compiler/compile-ops.rkt +dodger/compiler/compile-stdin.rkt +dodger/compiler/compile.rkt +dodger/correct.rkt +dodger/executor/decode.rkt +dodger/executor/exec.rkt +dodger/executor/run-stdin.rkt +dodger/executor/run.rkt +dodger/interpreter/interp-prim.rkt +dodger/interpreter/interp-stdin.rkt +dodger/interpreter/interp.rkt +dodger/main.rkt +dodger/runtime/types.rkt +dodger/syntax/ast.rkt +dodger/syntax/parse.rkt +dodger/syntax/random.rkt +dodger/test/define-tests.rkt +dodger/test/run-compile-tests.rkt +dodger/test/run-interp-tests.rkt +dodger/test/run-parse-tests.rkt +dupe/compiler/compile-ops.rkt +dupe/compiler/compile-stdin.rkt +dupe/compiler/compile.rkt +dupe/correct.rkt +dupe/example.rkt +dupe/executor/decode.rkt +dupe/executor/exec.rkt +dupe/executor/run-stdin.rkt +dupe/executor/run.rkt +dupe/interpreter/interp-prim.rkt +dupe/interpreter/interp-stdin.rkt +dupe/interpreter/interp.rkt +dupe/main.rkt +dupe/runtime/types.rkt +dupe/syntax/ast.rkt +dupe/syntax/parse.rkt +dupe/syntax/random.rkt +dupe/test/define-tests.rkt +dupe/test/run-compile-tests.rkt +dupe/test/run-interp-tests.rkt +dupe/test/run-parse-tests.rkt +evildoer/compiler/compile-ops.rkt +evildoer/compiler/compile-stdin.rkt +evildoer/compiler/compile.rkt +evildoer/correct.rkt +evildoer/executor/decode.rkt +evildoer/executor/exec.rkt +evildoer/executor/run-stdin.rkt +evildoer/executor/run.rkt +evildoer/interpreter/interp-io.rkt +evildoer/interpreter/interp-prim.rkt +evildoer/interpreter/interp-stdin.rkt +evildoer/interpreter/interp.rkt +evildoer/main.rkt +evildoer/runtime/types.rkt +evildoer/syntax/ast.rkt +evildoer/syntax/parse.rkt +evildoer/syntax/random.rkt +evildoer/test/define-tests.rkt +evildoer/test/run-compile-tests.rkt +evildoer/test/run-interp-tests.rkt +evildoer/test/run-parse-tests.rkt +extort/compiler/assert.rkt +extort/compiler/compile-ops.rkt +extort/compiler/compile-stdin.rkt +extort/compiler/compile.rkt +extort/correct.rkt +extort/executor/decode.rkt +extort/executor/exec.rkt +extort/executor/run-stdin.rkt +extort/executor/run.rkt +extort/interpreter/interp-io.rkt +extort/interpreter/interp-prim.rkt +extort/interpreter/interp-stdin.rkt +extort/interpreter/interp.rkt +extort/main.rkt +extort/runtime/types.rkt +extort/syntax/ast.rkt +extort/syntax/parse.rkt +extort/syntax/random.rkt +extort/test/define-tests.rkt +extort/test/run-compile-tests.rkt +extort/test/run-interp-tests.rkt +extort/test/run-parse-tests.rkt +fraud/compiler/assert.rkt +fraud/compiler/compile-ops.rkt +fraud/compiler/compile-stdin.rkt +fraud/compiler/compile.rkt +fraud/correct.rkt +fraud/executor/decode.rkt +fraud/executor/exec.rkt +fraud/executor/run-stdin.rkt +fraud/executor/run.rkt +fraud/interpreter/env.rkt +fraud/interpreter/interp-io.rkt +fraud/interpreter/interp-prim.rkt +fraud/interpreter/interp-stdin.rkt +fraud/interpreter/interp.rkt +fraud/main.rkt +fraud/runtime/types.rkt +fraud/syntax/ast.rkt +fraud/syntax/parse.rkt +fraud/syntax/random.rkt +fraud/syntax/translate.rkt +fraud/test/define-tests.rkt +fraud/test/run-compile-tests.rkt +fraud/test/run-interp-tests.rkt +fraud/test/run-parse-tests.rkt +fraud/test/translate.rkt +hoax/compiler/assert.rkt +hoax/compiler/compile-ops.rkt +hoax/compiler/compile-stdin.rkt +hoax/compiler/compile.rkt +hoax/correct.rkt +hoax/executor/decode.rkt +hoax/executor/exec.rkt +hoax/executor/run-stdin.rkt +hoax/executor/run.rkt +hoax/interpreter/env.rkt +hoax/interpreter/heap-bits.rkt +hoax/interpreter/heap.rkt +hoax/interpreter/interp-heap-bits.rkt +hoax/interpreter/interp-heap.rkt +hoax/interpreter/interp-io.rkt +hoax/interpreter/interp-prim.rkt +hoax/interpreter/interp-prims-heap-bits.rkt +hoax/interpreter/interp-prims-heap.rkt +hoax/interpreter/interp-stdin.rkt +hoax/interpreter/interp.rkt +hoax/interpreter/unload-bits.rkt +hoax/interpreter/unload.rkt +hoax/main.rkt +hoax/runtime/types.rkt +hoax/syntax/ast.rkt +hoax/syntax/parse.rkt +hoax/test/define-tests.rkt +hoax/test/run-compile-tests.rkt +hoax/test/run-interp-heap-bits-tests.rkt +hoax/test/run-interp-heap-tests.rkt +hoax/test/run-interp-tests.rkt +hoax/test/run-parse-tests.rkt +hustle/compiler/assert.rkt +hustle/compiler/compile-ops.rkt +hustle/compiler/compile-stdin.rkt +hustle/compiler/compile.rkt +hustle/correct.rkt +hustle/executor/decode.rkt +hustle/executor/exec.rkt +hustle/executor/run-stdin.rkt +hustle/executor/run.rkt +hustle/interpreter/env.rkt +hustle/interpreter/heap-bits.rkt +hustle/interpreter/heap.rkt +hustle/interpreter/interp-heap-bits.rkt +hustle/interpreter/interp-heap.rkt +hustle/interpreter/interp-io.rkt +hustle/interpreter/interp-prim.rkt +hustle/interpreter/interp-prims-heap-bits.rkt +hustle/interpreter/interp-prims-heap.rkt +hustle/interpreter/interp-stdin.rkt +hustle/interpreter/interp.rkt +hustle/interpreter/unload-bits.rkt +hustle/interpreter/unload.rkt +hustle/main.rkt +hustle/runtime/types.rkt +hustle/syntax/ast.rkt +hustle/syntax/parse.rkt +hustle/syntax/random.rkt +hustle/test/define-tests.rkt +hustle/test/run-compile-tests.rkt +hustle/test/run-interp-heap-bits-tests.rkt +hustle/test/run-interp-heap-tests.rkt +hustle/test/run-interp-tests.rkt +hustle/test/run-parse-tests.rkt +info.rkt +iniquity/compiler/assert.rkt +iniquity/compiler/compile-ops.rkt +iniquity/compiler/compile-stdin.rkt +iniquity/compiler/compile.rkt +iniquity/correct.rkt +iniquity/example/len.rkt +iniquity/executor/decode.rkt +iniquity/executor/exec.rkt +iniquity/executor/run-stdin.rkt +iniquity/executor/run.rkt +iniquity/gc-racket.rkt +iniquity/interpreter/env.rkt +iniquity/interpreter/interp-io.rkt +iniquity/interpreter/interp-prim.rkt +iniquity/interpreter/interp-stdin.rkt +iniquity/interpreter/interp.rkt +iniquity/main.rkt +iniquity/runtime/types.rkt +iniquity/syntax/ast.rkt +iniquity/syntax/parse.rkt +iniquity/syntax/read-all.rkt +iniquity/test/define-tests.rkt +iniquity/test/run-compile-tests.rkt +iniquity/test/run-interp-tests.rkt +iniquity/test/run-parse-tests.rkt +jig/compiler/assert.rkt +jig/compiler/compile-ops.rkt +jig/compiler/compile-stdin.rkt +jig/compiler/compile.rkt +jig/correct.rkt +jig/example.rkt +jig/executor/decode.rkt +jig/executor/exec.rkt +jig/executor/run-stdin.rkt +jig/executor/run.rkt +jig/interpreter/env.rkt +jig/interpreter/interp-io.rkt +jig/interpreter/interp-prim.rkt +jig/interpreter/interp-stdin.rkt +jig/interpreter/interp.rkt +jig/main.rkt +jig/runtime/types.rkt +jig/syntax/ast.rkt +jig/syntax/parse.rkt +jig/syntax/read-all.rkt +jig/test/define-tests.rkt +jig/test/run-compile-tests.rkt +jig/test/run-interp-tests.rkt +jig/test/run-parse-tests.rkt +knock/compiler/assert.rkt +knock/compiler/compile-ops.rkt +knock/compiler/compile-stdin.rkt +knock/compiler/compile.rkt +knock/correct.rkt +knock/executor/decode.rkt +knock/executor/exec.rkt +knock/executor/run-stdin.rkt +knock/executor/run.rkt +knock/interpreter/env.rkt +knock/interpreter/interp-io.rkt +knock/interpreter/interp-prim.rkt +knock/interpreter/interp-stdin.rkt +knock/interpreter/interp.rkt +knock/main.rkt +knock/runtime/types.rkt +knock/syntax/ast.rkt +knock/syntax/parse.rkt +knock/syntax/read-all.rkt +knock/test/define-tests.rkt +knock/test/run-compile-tests.rkt +knock/test/run-interp-tests.rkt +knock/test/run-parse-tests.rkt +loot/build-list-cons-rec.rkt +loot/compiler/assert.rkt +loot/compiler/compile-ops.rkt +loot/compiler/compile-stdin.rkt +loot/compiler/compile.rkt +loot/correct.rkt +loot/example.rkt +loot/executor/decode.rkt +loot/executor/exec.rkt +loot/executor/run-stdin.rkt +loot/executor/run.rkt +loot/interpreter/env.rkt +loot/interpreter/interp-defun.rkt +loot/interpreter/interp-io.rkt +loot/interpreter/interp-prim.rkt +loot/interpreter/interp-stdin.rkt +loot/interpreter/interp.rkt +loot/main.rkt +loot/regexp-defun.rkt +loot/regexp.rkt +loot/runtime/types.rkt +loot/syntax/ast.rkt +loot/syntax/fv.rkt +loot/syntax/lambdas.rkt +loot/syntax/parse.rkt +loot/syntax/read-all.rkt +loot/test/define-tests.rkt +loot/test/run-compile-tests.rkt +loot/test/run-interp-tests.rkt +loot/test/run-parse-tests.rkt +loot/tri.rkt +mountebank/compiler/assert.rkt +mountebank/compiler/compile-datum.rkt +mountebank/compiler/compile-literals.rkt +mountebank/compiler/compile-ops.rkt +mountebank/compiler/compile-stdin.rkt +mountebank/compiler/compile.rkt +mountebank/executor/decode.rkt +mountebank/executor/exec.rkt +mountebank/executor/run.rkt +mountebank/interpreter/env.rkt +mountebank/interpreter/interp-io.rkt +mountebank/interpreter/interp-prim.rkt +mountebank/interpreter/interp-stdin.rkt +mountebank/interpreter/interp.rkt +mountebank/main.rkt +mountebank/runtime/types.rkt +mountebank/syntax/ast.rkt +mountebank/syntax/fv.rkt +mountebank/syntax/lambdas.rkt +mountebank/syntax/literals.rkt +mountebank/syntax/parse.rkt +mountebank/syntax/read-all.rkt +mountebank/test/define-tests.rkt +mountebank/test/run-compile-tests.rkt +mountebank/test/run-interp-tests.rkt +mountebank/test/run-parse-tests.rkt +mug/compiler/assert.rkt +mug/compiler/compile-literals.rkt +mug/compiler/compile-ops.rkt +mug/compiler/compile-stdin.rkt +mug/compiler/compile.rkt +mug/executor/decode.rkt +mug/executor/exec.rkt +mug/executor/run-stdin.rkt +mug/executor/run.rkt +mug/interpreter/env.rkt +mug/interpreter/interp-io.rkt +mug/interpreter/interp-prim.rkt +mug/interpreter/interp-stdin.rkt +mug/interpreter/interp.rkt +mug/main.rkt +mug/runtime/types.rkt +mug/syntax/ast.rkt +mug/syntax/fv.rkt +mug/syntax/lambdas.rkt +mug/syntax/literals.rkt +mug/syntax/parse.rkt +mug/syntax/read-all.rkt +mug/test/define-tests.rkt diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 658cd4a..150d50c 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -99,9 +99,9 @@ jobs: run: | exit 1 - debug-mountebank-prefix: + debug-stable-file-prefix: runs-on: ubuntu-22.04 - name: Debug prefix / Racket stable / mountebank + name: Debug exact file prefix / Racket stable steps: @@ -134,36 +134,20 @@ jobs: run: | raco pkg install --auto --no-docs ../langs/ - - name: Run prefix before mountebank - run: | - xvfb-run raco test \ - abscond \ - blackmail \ - con \ - dodger \ - dupe \ - evildoer \ - extort \ - fraud \ - hoax \ - hustle \ - iniquity \ - jig \ - knock \ - loot - - - name: Run mountebank compile tests - id: mountebank-compile + - name: Run exact stable file prefix + id: stable-prefix continue-on-error: true run: | - xvfb-run raco test mountebank/test/run-compile-tests.rkt + mapfile -t files < .github/stable-prefix-files.txt + xvfb-run raco test "${files[@]}" - - name: Rerun mountebank compile tests with JIT trace - if: steps.mountebank-compile.outcome == 'failure' + - name: Rerun exact stable file prefix with JIT trace + if: steps.stable-prefix.outcome == 'failure' env: A86_JIT_TRACE: "1" run: | - xvfb-run raco test mountebank/test/run-compile-tests.rkt + mapfile -t files < .github/stable-prefix-files.txt + xvfb-run raco test "${files[@]}" debug-jig-prefix: runs-on: ubuntu-22.04 From f9687978b934d567e820675927fe380a489c06e5 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 17:18:53 -0400 Subject: [PATCH 34/47] Separate stable rerun and trace effects --- .github/workflows/ubuntu.yml | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 150d50c..7563298 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -141,8 +141,18 @@ jobs: mapfile -t files < .github/stable-prefix-files.txt xvfb-run raco test "${files[@]}" - - name: Rerun exact stable file prefix with JIT trace + - name: Rerun exact stable file prefix without trace + id: stable-prefix-rerun if: steps.stable-prefix.outcome == 'failure' + continue-on-error: true + run: | + mapfile -t files < .github/stable-prefix-files.txt + xvfb-run raco test "${files[@]}" + + - name: Rerun exact stable file prefix with JIT trace + id: stable-prefix-rerun-trace + if: steps.stable-prefix.outcome == 'failure' && steps.stable-prefix-rerun.outcome == 'failure' + continue-on-error: true env: A86_JIT_TRACE: "1" run: | From 9826237185ecb0de9edfcb7569c3262a6e179c20 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 17:30:29 -0400 Subject: [PATCH 35/47] Try no-unload rerun before JIT trace --- .github/workflows/ubuntu.yml | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 7563298..99f8666 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -149,9 +149,19 @@ jobs: mapfile -t files < .github/stable-prefix-files.txt xvfb-run raco test "${files[@]}" + - name: Rerun exact stable file prefix with unload disabled + id: stable-prefix-rerun-no-unload + if: steps.stable-prefix.outcome == 'failure' && steps.stable-prefix-rerun.outcome == 'failure' + continue-on-error: true + env: + A86_JIT_NO_UNLOAD: "1" + run: | + mapfile -t files < .github/stable-prefix-files.txt + xvfb-run raco test "${files[@]}" + - name: Rerun exact stable file prefix with JIT trace id: stable-prefix-rerun-trace - if: steps.stable-prefix.outcome == 'failure' && steps.stable-prefix-rerun.outcome == 'failure' + if: steps.stable-prefix.outcome == 'failure' && steps.stable-prefix-rerun.outcome == 'failure' && steps.stable-prefix-rerun-no-unload.outcome == 'failure' continue-on-error: true env: A86_JIT_TRACE: "1" From 1d0f521eca58302cff8416c011707b29b1aaea12 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 17:37:02 -0400 Subject: [PATCH 36/47] Try no-unload on broad stable reruns --- .github/workflows/ubuntu.yml | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 99f8666..9c0fd66 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -75,9 +75,25 @@ jobs: ;; esac + - name: Rerun focused failing tests with unload disabled + id: focused-rerun-no-unload + if: steps.langs-tests.outcome == 'failure' && steps.focused-rerun.outcome == 'failure' + continue-on-error: true + env: + A86_JIT_NO_UNLOAD: "1" + run: | + case "${{ matrix.racket-version }}" in + stable) + xvfb-run raco test mug/test/run-compile-tests.rkt + ;; + *) + exit 0 + ;; + esac + - name: Rerun focused failing tests with JIT trace id: focused-rerun-trace - if: steps.langs-tests.outcome == 'failure' && steps.focused-rerun.outcome == 'failure' + if: steps.langs-tests.outcome == 'failure' && steps.focused-rerun.outcome == 'failure' && steps.focused-rerun-no-unload.outcome == 'failure' continue-on-error: true env: A86_JIT_TRACE: "1" @@ -95,7 +111,7 @@ jobs: esac - name: Fail job if focused rerun also failed - if: steps.langs-tests.outcome == 'failure' && steps.focused-rerun.outcome == 'failure' && steps.focused-rerun-trace.outcome == 'failure' + if: steps.langs-tests.outcome == 'failure' && steps.focused-rerun.outcome == 'failure' && steps.focused-rerun-no-unload.outcome == 'failure' && steps.focused-rerun-trace.outcome == 'failure' run: | exit 1 From 76fc68cb06e8c1aa39942702b7c1a8f5a42f9ace Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 8 May 2026 22:24:28 -0400 Subject: [PATCH 37/47] r12, for real. --- iniquity/compiler/compile.rkt | 2 ++ jig/compiler/compile.rkt | 2 ++ knock/compiler/compile.rkt | 2 ++ loot/compiler/compile.rkt | 2 ++ mountebank/compiler/compile.rkt | 2 ++ mug/compiler/compile.rkt | 2 ++ 6 files changed, 12 insertions(+) diff --git a/iniquity/compiler/compile.rkt b/iniquity/compiler/compile.rkt index d79d077..b585409 100644 --- a/iniquity/compiler/compile.rkt +++ b/iniquity/compiler/compile.rkt @@ -19,11 +19,13 @@ (prog (Global 'entry) (Label 'entry) (Push rbx) ; save callee-saved register + (Push r15) (Mov rbx rdi) ; recv heap pointer (compile-e e '()) (Pop r15) ; restore callee-save register + (Pop rbx) (Ret) (compile-defines ds) diff --git a/jig/compiler/compile.rkt b/jig/compiler/compile.rkt index d732cf2..680a0ec 100644 --- a/jig/compiler/compile.rkt +++ b/jig/compiler/compile.rkt @@ -16,11 +16,13 @@ (prog (Global 'entry) (Label 'entry) (Push rbx) ; save callee-saved register + (Push r15) (Mov rbx rdi) ; recv heap pointer (compile-e e '() #f) (Pop r15) ; restore callee-save register + (Pop rbx) (Ret) (compile-defines ds) diff --git a/knock/compiler/compile.rkt b/knock/compiler/compile.rkt index 74c72f3..966e739 100644 --- a/knock/compiler/compile.rkt +++ b/knock/compiler/compile.rkt @@ -21,11 +21,13 @@ (prog (Global 'entry) (Label 'entry) (Push rbx) ; save callee-saved register + (Push r15) (Mov rbx rdi) ; recv heap pointer (compile-e e '() #f) (Pop r15) ; restore callee-save register + (Pop rbx) (Ret) (compile-defines ds) diff --git a/loot/compiler/compile.rkt b/loot/compiler/compile.rkt index f87daad..26ab093 100644 --- a/loot/compiler/compile.rkt +++ b/loot/compiler/compile.rkt @@ -23,6 +23,7 @@ (prog (Global 'entry) (Label 'entry) (Push rbx) ; save callee-saved register + (Push r15) (Mov rbx rdi) ; recv heap pointer @@ -30,6 +31,7 @@ (compile-e e (reverse (define-ids ds)) #f) (Add rsp (* 8 (length ds))) ;; pop function definitions (Pop r15) ; restore callee-save register + (Pop rbx) (Ret) (compile-defines ds) diff --git a/mountebank/compiler/compile.rkt b/mountebank/compiler/compile.rkt index 4724ac7..1dc6d01 100644 --- a/mountebank/compiler/compile.rkt +++ b/mountebank/compiler/compile.rkt @@ -25,6 +25,7 @@ (prog (Global 'entry) (Label 'entry) (Push rbx) ; save callee-saved register + (Push r12) (Push r15) (Mov rbx rdi) ; recv heap pointer (init-symbol-table p) @@ -32,6 +33,7 @@ (compile-e e (reverse (define-ids ds)) #f) (Add rsp (* 8 (length ds))) ;; pop function definitions (Pop r15) ; restore callee-save register + (Pop r12) (Pop rbx) (Ret) (compile-defines ds) diff --git a/mug/compiler/compile.rkt b/mug/compiler/compile.rkt index b116407..88b176b 100644 --- a/mug/compiler/compile.rkt +++ b/mug/compiler/compile.rkt @@ -24,6 +24,7 @@ (prog (Global 'entry) (Label 'entry) (Push rbx) ; save callee-saved register + (Push r12) (Push r15) (Mov rbx rdi) ; recv heap pointer (init-symbol-table p) @@ -31,6 +32,7 @@ (compile-e e (reverse (define-ids ds)) #f) (Add rsp (* 8 (length ds))) ;; pop function definitions (Pop r15) ; restore callee-save register + (Pop r12) (Pop rbx) (Ret) (compile-defines ds) From 4b8d9d7491035fa8e16b2144758c64e51f070466 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Sat, 9 May 2026 07:55:02 -0400 Subject: [PATCH 38/47] Back out debug workflow stuff. --- .github/workflows/ubuntu.yml | 216 ----------------------------------- 1 file changed, 216 deletions(-) diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 9c0fd66..1deec54 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -57,219 +57,3 @@ jobs: continue-on-error: true run: | xvfb-run raco test -p langs - - - name: Rerun focused failing tests without trace - id: focused-rerun - if: steps.langs-tests.outcome == 'failure' - continue-on-error: true - run: | - case "${{ matrix.racket-version }}" in - stable) - xvfb-run raco test mug/test/run-compile-tests.rkt - ;; - 8.6) - xvfb-run raco test jig/test/run-compile-tests.rkt - ;; - *) - exit 0 - ;; - esac - - - name: Rerun focused failing tests with unload disabled - id: focused-rerun-no-unload - if: steps.langs-tests.outcome == 'failure' && steps.focused-rerun.outcome == 'failure' - continue-on-error: true - env: - A86_JIT_NO_UNLOAD: "1" - run: | - case "${{ matrix.racket-version }}" in - stable) - xvfb-run raco test mug/test/run-compile-tests.rkt - ;; - *) - exit 0 - ;; - esac - - - name: Rerun focused failing tests with JIT trace - id: focused-rerun-trace - if: steps.langs-tests.outcome == 'failure' && steps.focused-rerun.outcome == 'failure' && steps.focused-rerun-no-unload.outcome == 'failure' - continue-on-error: true - env: - A86_JIT_TRACE: "1" - run: | - case "${{ matrix.racket-version }}" in - stable) - xvfb-run raco test mug/test/run-compile-tests.rkt - ;; - 8.6) - xvfb-run raco test jig/test/run-compile-tests.rkt - ;; - *) - exit 0 - ;; - esac - - - name: Fail job if focused rerun also failed - if: steps.langs-tests.outcome == 'failure' && steps.focused-rerun.outcome == 'failure' && steps.focused-rerun-no-unload.outcome == 'failure' && steps.focused-rerun-trace.outcome == 'failure' - run: | - exit 1 - - debug-stable-file-prefix: - runs-on: ubuntu-22.04 - name: Debug exact file prefix / Racket stable - - steps: - - - name: Checkout - uses: actions/checkout@main - - - name: Install Racket - uses: Bogdanp/setup-racket@v1.15 - with: - architecture: 'x64' - distribution: 'full' - variant: 'CS' - version: 'stable' - - - name: Install LLVM - uses: ZhongRuoyu/setup-llvm@v0 - with: - llvm-version: 22 - - - name: Install libssl - run: | - sudo apt install -y libssl-dev - - - name: Install a86 branch - run: | - git clone --branch "${{ github.ref_name }}" --single-branch https://github.com/cmsc430/a86.git ../a86 - raco pkg install --auto --no-docs ../a86/ - - - name: Install langs package - run: | - raco pkg install --auto --no-docs ../langs/ - - - name: Run exact stable file prefix - id: stable-prefix - continue-on-error: true - run: | - mapfile -t files < .github/stable-prefix-files.txt - xvfb-run raco test "${files[@]}" - - - name: Rerun exact stable file prefix without trace - id: stable-prefix-rerun - if: steps.stable-prefix.outcome == 'failure' - continue-on-error: true - run: | - mapfile -t files < .github/stable-prefix-files.txt - xvfb-run raco test "${files[@]}" - - - name: Rerun exact stable file prefix with unload disabled - id: stable-prefix-rerun-no-unload - if: steps.stable-prefix.outcome == 'failure' && steps.stable-prefix-rerun.outcome == 'failure' - continue-on-error: true - env: - A86_JIT_NO_UNLOAD: "1" - run: | - mapfile -t files < .github/stable-prefix-files.txt - xvfb-run raco test "${files[@]}" - - - name: Rerun exact stable file prefix with JIT trace - id: stable-prefix-rerun-trace - if: steps.stable-prefix.outcome == 'failure' && steps.stable-prefix-rerun.outcome == 'failure' && steps.stable-prefix-rerun-no-unload.outcome == 'failure' - continue-on-error: true - env: - A86_JIT_TRACE: "1" - run: | - mapfile -t files < .github/stable-prefix-files.txt - xvfb-run raco test "${files[@]}" - - debug-jig-prefix: - runs-on: ubuntu-22.04 - name: Debug prefix / Racket 8.6 / jig - - steps: - - - name: Checkout - uses: actions/checkout@main - - - name: Install Racket - uses: Bogdanp/setup-racket@v1.15 - with: - architecture: 'x64' - distribution: 'full' - variant: 'CS' - version: '8.6' - - - name: Install LLVM - uses: ZhongRuoyu/setup-llvm@v0 - with: - llvm-version: 22 - - - name: Install libssl - run: | - sudo apt install -y libssl-dev - - - name: Install a86 branch - run: | - git clone --branch "${{ github.ref_name }}" --single-branch https://github.com/cmsc430/a86.git ../a86 - raco pkg install --auto --no-docs ../a86/ - - - name: Install langs package - run: | - raco pkg install --auto --no-docs ../langs/ - - - name: Run prefix through hoax - run: | - xvfb-run raco test \ - abscond \ - blackmail \ - con \ - dodger \ - dupe \ - evildoer \ - extort \ - fraud \ - hoax - - - name: Run hustle tests - id: hustle-prefix - continue-on-error: true - run: | - xvfb-run raco test hustle - - - name: Rerun hustle tests with JIT trace - if: steps.hustle-prefix.outcome == 'failure' - env: - A86_JIT_TRACE: "1" - run: | - xvfb-run raco test hustle - - - name: Run iniquity tests - id: iniquity-prefix - if: steps.hustle-prefix.outcome != 'failure' - continue-on-error: true - run: | - xvfb-run raco test iniquity - - - name: Rerun iniquity tests with JIT trace - if: steps.iniquity-prefix.outcome == 'failure' - env: - A86_JIT_TRACE: "1" - run: | - xvfb-run raco test iniquity - - - name: Run jig define tests - id: jig-define - if: steps.hustle-prefix.outcome != 'failure' && steps.iniquity-prefix.outcome != 'failure' - continue-on-error: true - run: | - xvfb-run raco test jig/test/define-tests.rkt - - - name: Rerun jig define tests with JIT trace - if: steps.jig-define.outcome == 'failure' - env: - A86_JIT_TRACE: "1" - run: | - xvfb-run raco test jig/test/define-tests.rkt From 93f97bc187001053e82a1f78f2a41561d82ea829 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 29 May 2026 15:03:21 -0400 Subject: [PATCH 39/47] Simplify executor for Abscond. --- abscond/compiler/compile.rkt | 6 ++-- abscond/correct.rkt | 4 +-- abscond/executor/exec.rkt | 44 ---------------------------- abscond/executor/run-stdin.rkt | 4 +-- abscond/executor/run.rkt | 11 ------- abscond/main.rkt | 4 --- abscond/test/run-compile-tests.rkt | 4 +-- blackmail/executor/run-stdin.rkt | 1 + blackmail/test/run-compile-tests.rkt | 1 - con/executor/run-stdin.rkt | 1 + con/test/run-compile-tests.rkt | 1 - dodger/executor/run-stdin.rkt | 1 + dodger/test/run-compile-tests.rkt | 1 - dupe/executor/run-stdin.rkt | 1 + dupe/test/run-compile-tests.rkt | 1 - evildoer/executor/run-stdin.rkt | 1 + evildoer/test/run-compile-tests.rkt | 1 - extort/executor/run-stdin.rkt | 1 + extort/test/run-compile-tests.rkt | 1 - fraud/executor/run-stdin.rkt | 1 + hoax/executor/run-stdin.rkt | 1 + hustle/executor/run-stdin.rkt | 1 + iniquity/executor/run-stdin.rkt | 1 + jig/executor/run-stdin.rkt | 1 + knock/executor/run-stdin.rkt | 1 + loot/executor/run-stdin.rkt | 1 + mug/executor/run-stdin.rkt | 1 + 27 files changed, 23 insertions(+), 74 deletions(-) delete mode 100644 abscond/executor/exec.rkt delete mode 100644 abscond/executor/run.rkt diff --git a/abscond/compiler/compile.rkt b/abscond/compiler/compile.rkt index e67640c..b87c5da 100644 --- a/abscond/compiler/compile.rkt +++ b/abscond/compiler/compile.rkt @@ -1,6 +1,5 @@ #lang racket -(provide compile - compile-e) +(provide compile) (require "../syntax/ast.rkt") (require a86/ast a86/registers) @@ -9,7 +8,8 @@ (define (compile e) (prog (Global 'entry) (Label 'entry) - (compile-e e) + (match e + [(Lit i) (Mov rax i)]) (Ret))) ;; Expr -> Asm diff --git a/abscond/correct.rkt b/abscond/correct.rkt index 9ee319c..69f6400 100644 --- a/abscond/correct.rkt +++ b/abscond/correct.rkt @@ -2,11 +2,11 @@ (provide check-compiler) (require rackunit) (require "interpreter/interp.rkt") -(require "executor/run.rkt") (require "compiler/compile.rkt") +(require a86/interp) ;; Expr -> Void (define (check-compiler e) (check-equal? (interp e) - (run (compile e)))) + (asm-interp (compile e)))) diff --git a/abscond/executor/exec.rkt b/abscond/executor/exec.rkt deleted file mode 100644 index 7800ef5..0000000 --- a/abscond/executor/exec.rkt +++ /dev/null @@ -1,44 +0,0 @@ -#lang racket -(require a86/interp) - -(provide exec - (struct-out exec-state) - exec-unload - call-with-exec) - -(require a86/interp - ffi/unsafe) - -(struct exec-state (program) #:transparent) - -(define _val _int64) - -(define (exec/state prog) - (exec-state - (asm-load prog))) - -(define (exec-call st) - (match-define (exec-state program) st) - (asm-call program 'entry)) - -(define (exec-unload st) - (asm-unload (exec-state-program st))) - -;; ------------------------------------------------------------ -;; public API - -;; execute with runtime system and Racket host -;; return raw bits plus the live state needed to interpret them safely - -;; CAUTION: this does not unload -(define (exec asm) - (exec-call (exec/state asm))) - -;; version of above that ensures unloading -(define (call-with-exec e f) - (define st (exec/state e)) - (dynamic-wind - void - (λ () (f (exec-call st))) - (λ () (exec-unload st)))) - diff --git a/abscond/executor/run-stdin.rkt b/abscond/executor/run-stdin.rkt index 7e7170f..8f50771 100644 --- a/abscond/executor/run-stdin.rkt +++ b/abscond/executor/run-stdin.rkt @@ -2,11 +2,11 @@ (provide main) (require "../syntax/parse.rkt") (require "../compiler/compile.rkt") -(require "run.rkt") +(require a86/interp) ;; -> Void ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line - (run (compile (parse (read))))) + (asm-interp (compile (parse (read))))) diff --git a/abscond/executor/run.rkt b/abscond/executor/run.rkt deleted file mode 100644 index 39c354a..0000000 --- a/abscond/executor/run.rkt +++ /dev/null @@ -1,11 +0,0 @@ -#lang racket -(require a86/interp) -(require "exec.rkt") -(provide run) - -;; Asm -> Integer -(define (run asm) - (call-with-exec - asm - identity)) - diff --git a/abscond/main.rkt b/abscond/main.rkt index 16c671d..a334722 100644 --- a/abscond/main.rkt +++ b/abscond/main.rkt @@ -3,12 +3,8 @@ (require "syntax/parse.rkt") (require "interpreter/interp.rkt") (require "compiler/compile.rkt") -(require "executor/run.rkt") -(require "executor/exec.rkt") (provide (all-from-out "syntax/ast.rkt")) (provide (all-from-out "syntax/parse.rkt")) (provide (all-from-out "interpreter/interp.rkt")) (provide (all-from-out "compiler/compile.rkt")) -(provide (all-from-out "executor/run.rkt")) -(provide (all-from-out "executor/exec.rkt")) diff --git a/abscond/test/run-compile-tests.rkt b/abscond/test/run-compile-tests.rkt index 638f5e8..9fc6cc6 100644 --- a/abscond/test/run-compile-tests.rkt +++ b/abscond/test/run-compile-tests.rkt @@ -1,8 +1,8 @@ #lang racket (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") -(require "../executor/run.rkt") (require "define-tests.rkt") +(require a86/interp) -(test (λ (e) (run (compile (parse e))))) +(test (λ (e) (asm-interp (compile (parse e))))) diff --git a/blackmail/executor/run-stdin.rkt b/blackmail/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/blackmail/executor/run-stdin.rkt +++ b/blackmail/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/blackmail/test/run-compile-tests.rkt b/blackmail/test/run-compile-tests.rkt index 638f5e8..1360550 100644 --- a/blackmail/test/run-compile-tests.rkt +++ b/blackmail/test/run-compile-tests.rkt @@ -3,6 +3,5 @@ (require "../syntax/parse.rkt") (require "../executor/run.rkt") (require "define-tests.rkt") - (test (λ (e) (run (compile (parse e))))) diff --git a/con/executor/run-stdin.rkt b/con/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/con/executor/run-stdin.rkt +++ b/con/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/con/test/run-compile-tests.rkt b/con/test/run-compile-tests.rkt index 638f5e8..1360550 100644 --- a/con/test/run-compile-tests.rkt +++ b/con/test/run-compile-tests.rkt @@ -3,6 +3,5 @@ (require "../syntax/parse.rkt") (require "../executor/run.rkt") (require "define-tests.rkt") - (test (λ (e) (run (compile (parse e))))) diff --git a/dodger/executor/run-stdin.rkt b/dodger/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/dodger/executor/run-stdin.rkt +++ b/dodger/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/dodger/test/run-compile-tests.rkt b/dodger/test/run-compile-tests.rkt index 638f5e8..1360550 100644 --- a/dodger/test/run-compile-tests.rkt +++ b/dodger/test/run-compile-tests.rkt @@ -3,6 +3,5 @@ (require "../syntax/parse.rkt") (require "../executor/run.rkt") (require "define-tests.rkt") - (test (λ (e) (run (compile (parse e))))) diff --git a/dupe/executor/run-stdin.rkt b/dupe/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/dupe/executor/run-stdin.rkt +++ b/dupe/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/dupe/test/run-compile-tests.rkt b/dupe/test/run-compile-tests.rkt index 638f5e8..1360550 100644 --- a/dupe/test/run-compile-tests.rkt +++ b/dupe/test/run-compile-tests.rkt @@ -3,6 +3,5 @@ (require "../syntax/parse.rkt") (require "../executor/run.rkt") (require "define-tests.rkt") - (test (λ (e) (run (compile (parse e))))) diff --git a/evildoer/executor/run-stdin.rkt b/evildoer/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/evildoer/executor/run-stdin.rkt +++ b/evildoer/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/evildoer/test/run-compile-tests.rkt b/evildoer/test/run-compile-tests.rkt index 253889d..95e541e 100644 --- a/evildoer/test/run-compile-tests.rkt +++ b/evildoer/test/run-compile-tests.rkt @@ -3,7 +3,6 @@ (require "../syntax/parse.rkt") (require "../executor/run.rkt") (require "define-tests.rkt") - (test (λ (e) (run (compile (parse e))))) (test/io (λ (i e) (run/io (compile (parse e)) i))) diff --git a/extort/executor/run-stdin.rkt b/extort/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/extort/executor/run-stdin.rkt +++ b/extort/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/extort/test/run-compile-tests.rkt b/extort/test/run-compile-tests.rkt index 253889d..95e541e 100644 --- a/extort/test/run-compile-tests.rkt +++ b/extort/test/run-compile-tests.rkt @@ -3,7 +3,6 @@ (require "../syntax/parse.rkt") (require "../executor/run.rkt") (require "define-tests.rkt") - (test (λ (e) (run (compile (parse e))))) (test/io (λ (i e) (run/io (compile (parse e)) i))) diff --git a/fraud/executor/run-stdin.rkt b/fraud/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/fraud/executor/run-stdin.rkt +++ b/fraud/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/hoax/executor/run-stdin.rkt b/hoax/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/hoax/executor/run-stdin.rkt +++ b/hoax/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/hustle/executor/run-stdin.rkt b/hustle/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/hustle/executor/run-stdin.rkt +++ b/hustle/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/iniquity/executor/run-stdin.rkt b/iniquity/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/iniquity/executor/run-stdin.rkt +++ b/iniquity/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/jig/executor/run-stdin.rkt b/jig/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/jig/executor/run-stdin.rkt +++ b/jig/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/knock/executor/run-stdin.rkt b/knock/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/knock/executor/run-stdin.rkt +++ b/knock/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/loot/executor/run-stdin.rkt b/loot/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/loot/executor/run-stdin.rkt +++ b/loot/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) diff --git a/mug/executor/run-stdin.rkt b/mug/executor/run-stdin.rkt index 7e7170f..ac60d60 100644 --- a/mug/executor/run-stdin.rkt +++ b/mug/executor/run-stdin.rkt @@ -8,5 +8,6 @@ ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line + (run (compile (parse (read))))) From 69d4a2942a18c952ef9833c7812f90d418809ee9 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 29 May 2026 15:22:10 -0400 Subject: [PATCH 40/47] Simplify compile.rkt for Abscond. --- abscond/compiler/compile.rkt | 5 ----- 1 file changed, 5 deletions(-) diff --git a/abscond/compiler/compile.rkt b/abscond/compiler/compile.rkt index b87c5da..ee7eddd 100644 --- a/abscond/compiler/compile.rkt +++ b/abscond/compiler/compile.rkt @@ -12,8 +12,3 @@ [(Lit i) (Mov rax i)]) (Ret))) -;; Expr -> Asm -(define (compile-e e) - (match e - [(Lit i) (seq (Mov rax i))])) - From 60e3644622698573951ac162c7060bb87d3ad519 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 29 May 2026 17:59:40 -0400 Subject: [PATCH 41/47] Simplify standalone runtime for Blackmail. --- abscond/runtime/print.c | 7 ------- abscond/runtime/print.h | 6 ------ blackmail/runtime/Makefile | 4 +--- blackmail/runtime/main.c | 3 +-- blackmail/runtime/print.c | 7 ------- blackmail/runtime/print.h | 6 ------ 6 files changed, 2 insertions(+), 31 deletions(-) delete mode 100644 abscond/runtime/print.c delete mode 100644 abscond/runtime/print.h delete mode 100644 blackmail/runtime/print.c delete mode 100644 blackmail/runtime/print.h diff --git a/abscond/runtime/print.c b/abscond/runtime/print.c deleted file mode 100644 index cf19daf..0000000 --- a/abscond/runtime/print.c +++ /dev/null @@ -1,7 +0,0 @@ -#include -#include - -void print_result(int64_t x) -{ - printf("%" PRId64, x); -} diff --git a/abscond/runtime/print.h b/abscond/runtime/print.h deleted file mode 100644 index 08ae346..0000000 --- a/abscond/runtime/print.h +++ /dev/null @@ -1,6 +0,0 @@ -#ifndef PRINT_H -#define PRINT_H - -void print_result(int64_t); - -#endif diff --git a/blackmail/runtime/Makefile b/blackmail/runtime/Makefile index 8b22999..27e3c78 100644 --- a/blackmail/runtime/Makefile +++ b/blackmail/runtime/Makefile @@ -8,9 +8,7 @@ endif CFLAGS += -fPIC -g -OBJS = \ - main.o \ - print.o +OBJS = main.o default: runtime.o diff --git a/blackmail/runtime/main.c b/blackmail/runtime/main.c index 4c8ad77..163618e 100644 --- a/blackmail/runtime/main.c +++ b/blackmail/runtime/main.c @@ -1,13 +1,12 @@ #include #include -#include "print.h" int64_t entry(); int main(int argc, char** argv) { int64_t result = entry(); - print_result(result); + printf("%" PRId64, result); putchar('\n'); return 0; } diff --git a/blackmail/runtime/print.c b/blackmail/runtime/print.c deleted file mode 100644 index cf19daf..0000000 --- a/blackmail/runtime/print.c +++ /dev/null @@ -1,7 +0,0 @@ -#include -#include - -void print_result(int64_t x) -{ - printf("%" PRId64, x); -} diff --git a/blackmail/runtime/print.h b/blackmail/runtime/print.h deleted file mode 100644 index 08ae346..0000000 --- a/blackmail/runtime/print.h +++ /dev/null @@ -1,6 +0,0 @@ -#ifndef PRINT_H -#define PRINT_H - -void print_result(int64_t); - -#endif From dd394d3257241baf5f925b4b3e82448a82931ded Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 29 May 2026 18:26:51 -0400 Subject: [PATCH 42/47] Simplify executor in Blackmail. --- abscond/runtime/Makefile | 4 +-- abscond/runtime/main.c | 3 +- blackmail/correct.rkt | 4 +-- blackmail/executor/exec.rkt | 44 ---------------------------- blackmail/executor/run-stdin.rkt | 5 ++-- blackmail/executor/run.rkt | 11 ------- blackmail/main.rkt | 4 --- blackmail/test/run-compile-tests.rkt | 5 ++-- con/correct.rkt | 4 +-- con/executor/run-stdin.rkt | 5 ++-- con/main.rkt | 4 --- con/test/run-compile-tests.rkt | 5 ++-- 12 files changed, 16 insertions(+), 82 deletions(-) delete mode 100644 blackmail/executor/exec.rkt delete mode 100644 blackmail/executor/run.rkt diff --git a/abscond/runtime/Makefile b/abscond/runtime/Makefile index 8b22999..27e3c78 100644 --- a/abscond/runtime/Makefile +++ b/abscond/runtime/Makefile @@ -8,9 +8,7 @@ endif CFLAGS += -fPIC -g -OBJS = \ - main.o \ - print.o +OBJS = main.o default: runtime.o diff --git a/abscond/runtime/main.c b/abscond/runtime/main.c index 4c8ad77..163618e 100644 --- a/abscond/runtime/main.c +++ b/abscond/runtime/main.c @@ -1,13 +1,12 @@ #include #include -#include "print.h" int64_t entry(); int main(int argc, char** argv) { int64_t result = entry(); - print_result(result); + printf("%" PRId64, result); putchar('\n'); return 0; } diff --git a/blackmail/correct.rkt b/blackmail/correct.rkt index 9ee319c..69f6400 100644 --- a/blackmail/correct.rkt +++ b/blackmail/correct.rkt @@ -2,11 +2,11 @@ (provide check-compiler) (require rackunit) (require "interpreter/interp.rkt") -(require "executor/run.rkt") (require "compiler/compile.rkt") +(require a86/interp) ;; Expr -> Void (define (check-compiler e) (check-equal? (interp e) - (run (compile e)))) + (asm-interp (compile e)))) diff --git a/blackmail/executor/exec.rkt b/blackmail/executor/exec.rkt deleted file mode 100644 index 7800ef5..0000000 --- a/blackmail/executor/exec.rkt +++ /dev/null @@ -1,44 +0,0 @@ -#lang racket -(require a86/interp) - -(provide exec - (struct-out exec-state) - exec-unload - call-with-exec) - -(require a86/interp - ffi/unsafe) - -(struct exec-state (program) #:transparent) - -(define _val _int64) - -(define (exec/state prog) - (exec-state - (asm-load prog))) - -(define (exec-call st) - (match-define (exec-state program) st) - (asm-call program 'entry)) - -(define (exec-unload st) - (asm-unload (exec-state-program st))) - -;; ------------------------------------------------------------ -;; public API - -;; execute with runtime system and Racket host -;; return raw bits plus the live state needed to interpret them safely - -;; CAUTION: this does not unload -(define (exec asm) - (exec-call (exec/state asm))) - -;; version of above that ensures unloading -(define (call-with-exec e f) - (define st (exec/state e)) - (dynamic-wind - void - (λ () (f (exec-call st))) - (λ () (exec-unload st)))) - diff --git a/blackmail/executor/run-stdin.rkt b/blackmail/executor/run-stdin.rkt index ac60d60..8f50771 100644 --- a/blackmail/executor/run-stdin.rkt +++ b/blackmail/executor/run-stdin.rkt @@ -2,12 +2,11 @@ (provide main) (require "../syntax/parse.rkt") (require "../compiler/compile.rkt") -(require "run.rkt") +(require a86/interp) ;; -> Void ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line - - (run (compile (parse (read))))) + (asm-interp (compile (parse (read))))) diff --git a/blackmail/executor/run.rkt b/blackmail/executor/run.rkt deleted file mode 100644 index 39c354a..0000000 --- a/blackmail/executor/run.rkt +++ /dev/null @@ -1,11 +0,0 @@ -#lang racket -(require a86/interp) -(require "exec.rkt") -(provide run) - -;; Asm -> Integer -(define (run asm) - (call-with-exec - asm - identity)) - diff --git a/blackmail/main.rkt b/blackmail/main.rkt index 16c671d..a334722 100644 --- a/blackmail/main.rkt +++ b/blackmail/main.rkt @@ -3,12 +3,8 @@ (require "syntax/parse.rkt") (require "interpreter/interp.rkt") (require "compiler/compile.rkt") -(require "executor/run.rkt") -(require "executor/exec.rkt") (provide (all-from-out "syntax/ast.rkt")) (provide (all-from-out "syntax/parse.rkt")) (provide (all-from-out "interpreter/interp.rkt")) (provide (all-from-out "compiler/compile.rkt")) -(provide (all-from-out "executor/run.rkt")) -(provide (all-from-out "executor/exec.rkt")) diff --git a/blackmail/test/run-compile-tests.rkt b/blackmail/test/run-compile-tests.rkt index 1360550..9fc6cc6 100644 --- a/blackmail/test/run-compile-tests.rkt +++ b/blackmail/test/run-compile-tests.rkt @@ -1,7 +1,8 @@ #lang racket (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") -(require "../executor/run.rkt") (require "define-tests.rkt") -(test (λ (e) (run (compile (parse e))))) +(require a86/interp) + +(test (λ (e) (asm-interp (compile (parse e))))) diff --git a/con/correct.rkt b/con/correct.rkt index 9ee319c..69f6400 100644 --- a/con/correct.rkt +++ b/con/correct.rkt @@ -2,11 +2,11 @@ (provide check-compiler) (require rackunit) (require "interpreter/interp.rkt") -(require "executor/run.rkt") (require "compiler/compile.rkt") +(require a86/interp) ;; Expr -> Void (define (check-compiler e) (check-equal? (interp e) - (run (compile e)))) + (asm-interp (compile e)))) diff --git a/con/executor/run-stdin.rkt b/con/executor/run-stdin.rkt index ac60d60..8f50771 100644 --- a/con/executor/run-stdin.rkt +++ b/con/executor/run-stdin.rkt @@ -2,12 +2,11 @@ (provide main) (require "../syntax/parse.rkt") (require "../compiler/compile.rkt") -(require "run.rkt") +(require a86/interp) ;; -> Void ;; Compile contents of stdin and use asm-interp to run (define (main) (read-line) ; ignore #lang racket line - - (run (compile (parse (read))))) + (asm-interp (compile (parse (read))))) diff --git a/con/main.rkt b/con/main.rkt index 16c671d..a334722 100644 --- a/con/main.rkt +++ b/con/main.rkt @@ -3,12 +3,8 @@ (require "syntax/parse.rkt") (require "interpreter/interp.rkt") (require "compiler/compile.rkt") -(require "executor/run.rkt") -(require "executor/exec.rkt") (provide (all-from-out "syntax/ast.rkt")) (provide (all-from-out "syntax/parse.rkt")) (provide (all-from-out "interpreter/interp.rkt")) (provide (all-from-out "compiler/compile.rkt")) -(provide (all-from-out "executor/run.rkt")) -(provide (all-from-out "executor/exec.rkt")) diff --git a/con/test/run-compile-tests.rkt b/con/test/run-compile-tests.rkt index 1360550..9fc6cc6 100644 --- a/con/test/run-compile-tests.rkt +++ b/con/test/run-compile-tests.rkt @@ -1,7 +1,8 @@ #lang racket (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") -(require "../executor/run.rkt") (require "define-tests.rkt") -(test (λ (e) (run (compile (parse e))))) +(require a86/interp) + +(test (λ (e) (asm-interp (compile (parse e))))) From 9d6068f32d88d83da6b8a508a2fe3832728d427d Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Fri, 29 May 2026 21:05:41 -0400 Subject: [PATCH 43/47] Simplify standalone and executor for Con. --- con/executor/exec.rkt | 44 ------------------------------------------- con/executor/run.rkt | 11 ----------- con/runtime/Makefile | 4 +--- con/runtime/main.c | 5 ++--- con/runtime/print.c | 7 ------- con/runtime/print.h | 6 ------ 6 files changed, 3 insertions(+), 74 deletions(-) delete mode 100644 con/executor/exec.rkt delete mode 100644 con/executor/run.rkt delete mode 100644 con/runtime/print.c delete mode 100644 con/runtime/print.h diff --git a/con/executor/exec.rkt b/con/executor/exec.rkt deleted file mode 100644 index 7800ef5..0000000 --- a/con/executor/exec.rkt +++ /dev/null @@ -1,44 +0,0 @@ -#lang racket -(require a86/interp) - -(provide exec - (struct-out exec-state) - exec-unload - call-with-exec) - -(require a86/interp - ffi/unsafe) - -(struct exec-state (program) #:transparent) - -(define _val _int64) - -(define (exec/state prog) - (exec-state - (asm-load prog))) - -(define (exec-call st) - (match-define (exec-state program) st) - (asm-call program 'entry)) - -(define (exec-unload st) - (asm-unload (exec-state-program st))) - -;; ------------------------------------------------------------ -;; public API - -;; execute with runtime system and Racket host -;; return raw bits plus the live state needed to interpret them safely - -;; CAUTION: this does not unload -(define (exec asm) - (exec-call (exec/state asm))) - -;; version of above that ensures unloading -(define (call-with-exec e f) - (define st (exec/state e)) - (dynamic-wind - void - (λ () (f (exec-call st))) - (λ () (exec-unload st)))) - diff --git a/con/executor/run.rkt b/con/executor/run.rkt deleted file mode 100644 index 39c354a..0000000 --- a/con/executor/run.rkt +++ /dev/null @@ -1,11 +0,0 @@ -#lang racket -(require a86/interp) -(require "exec.rkt") -(provide run) - -;; Asm -> Integer -(define (run asm) - (call-with-exec - asm - identity)) - diff --git a/con/runtime/Makefile b/con/runtime/Makefile index 8b22999..27e3c78 100644 --- a/con/runtime/Makefile +++ b/con/runtime/Makefile @@ -8,9 +8,7 @@ endif CFLAGS += -fPIC -g -OBJS = \ - main.o \ - print.o +OBJS = main.o default: runtime.o diff --git a/con/runtime/main.c b/con/runtime/main.c index c608bf9..163618e 100644 --- a/con/runtime/main.c +++ b/con/runtime/main.c @@ -1,13 +1,12 @@ #include #include -#include "print.h" int64_t entry(); int main(int argc, char** argv) { - int64_t result = entry(); - print_result(result); + int64_t result = entry(); + printf("%" PRId64, result); putchar('\n'); return 0; } diff --git a/con/runtime/print.c b/con/runtime/print.c deleted file mode 100644 index cf19daf..0000000 --- a/con/runtime/print.c +++ /dev/null @@ -1,7 +0,0 @@ -#include -#include - -void print_result(int64_t x) -{ - printf("%" PRId64, x); -} diff --git a/con/runtime/print.h b/con/runtime/print.h deleted file mode 100644 index 08ae346..0000000 --- a/con/runtime/print.h +++ /dev/null @@ -1,6 +0,0 @@ -#ifndef PRINT_H -#define PRINT_H - -void print_result(int64_t); - -#endif From e7df06ccc3afa16d7c205c165d8722c9a3e4cd3f Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Sat, 30 May 2026 14:53:32 -0400 Subject: [PATCH 44/47] Remove PIC from runtime Makefile, not needed anymore. --- abscond/runtime/Makefile | 2 +- blackmail/runtime/Makefile | 2 +- con/runtime/Makefile | 2 +- dupe/runtime/Makefile | 5 ++--- evildoer/Makefile | 37 ++++++++++++++++++++----------------- 5 files changed, 25 insertions(+), 23 deletions(-) diff --git a/abscond/runtime/Makefile b/abscond/runtime/Makefile index 27e3c78..34d7577 100644 --- a/abscond/runtime/Makefile +++ b/abscond/runtime/Makefile @@ -6,7 +6,7 @@ else LANGS_AS ?= clang -c endif -CFLAGS += -fPIC -g +CFLAGS += -g OBJS = main.o diff --git a/blackmail/runtime/Makefile b/blackmail/runtime/Makefile index 27e3c78..34d7577 100644 --- a/blackmail/runtime/Makefile +++ b/blackmail/runtime/Makefile @@ -6,7 +6,7 @@ else LANGS_AS ?= clang -c endif -CFLAGS += -fPIC -g +CFLAGS += -g OBJS = main.o diff --git a/con/runtime/Makefile b/con/runtime/Makefile index 27e3c78..34d7577 100644 --- a/con/runtime/Makefile +++ b/con/runtime/Makefile @@ -6,7 +6,7 @@ else LANGS_AS ?= clang -c endif -CFLAGS += -fPIC -g +CFLAGS += -g OBJS = main.o diff --git a/dupe/runtime/Makefile b/dupe/runtime/Makefile index cf0e413..32de08f 100644 --- a/dupe/runtime/Makefile +++ b/dupe/runtime/Makefile @@ -6,10 +6,9 @@ else LANGS_AS ?= clang -c endif -CFLAGS += -fPIC -g +CFLAGS += -g -OBJS = \ - main.o \ +OBJS = main.o \ print.o \ values.o diff --git a/evildoer/Makefile b/evildoer/Makefile index 5205a2f..2d442f8 100644 --- a/evildoer/Makefile +++ b/evildoer/Makefile @@ -6,30 +6,33 @@ else LANGS_AS ?= clang -c endif -objs = \ - main.o \ - print.o +RACKET ?= racket -default: runtime.o +RUNTIME_DIR := runtime +RUNTIME := $(RUNTIME_DIR)/runtime.o -runtime.o: $(objs) - ld -r $(objs) -o runtime.o +# Example source extension for this language. +SRC_EXT := rkt -%.run: %.o runtime.o - $(LANGS_CC) runtime.o $< -o $@ +default: + @echo "example: make foo.run" -.c.o: - $(LANGS_CC) -fPIC -c -g -o $@ $< +# Build the runtime bundles if needed. +$(RUNTIME): + $(MAKE) -C $(RUNTIME_DIR) -.s.o: +# Compile source program to assembly. +%.s: %.$(SRC_EXT) + cat $< | $(RACKET) -t compiler/compile-stdin.rkt -m > $@ + +# Assemble to object. +%.o: %.s $(LANGS_AS) -o $@ $< -%.s: %.rkt - cat $< | racket -t compile-stdin.rkt -m > $@ +# Link standalone executable. +%.run: %.o $(RUNTIME) + $(LANGS_CC) -o $@ $^ clean: @$(RM) *.o *.s *.run ||: - @echo "$(shell basename $(shell pwd)): cleaned!" - -%.test: %.run %.rkt - @test "$(shell ./$(<))" = "$(shell racket $(word 2,$^))" + @$(MAKE) -C $(RUNTIME_DIR) clean From cfe2f560636836c2e11c22d9aa830d7a0d94b59f Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Sun, 31 May 2026 21:31:28 -0400 Subject: [PATCH 45/47] Reorg things slightly in Evildoer. --- evildoer/correct.rkt | 4 +- evildoer/executor/exec-stdin.rkt | 11 +++++ evildoer/executor/exec.rkt | 63 +++++++---------------------- evildoer/executor/host.rkt | 22 ++++++++++ evildoer/executor/run-stdin.rkt | 13 ------ evildoer/executor/run.rkt | 19 --------- evildoer/main.rkt | 2 - evildoer/test/run-compile-tests.rkt | 6 +-- 8 files changed, 53 insertions(+), 87 deletions(-) create mode 100644 evildoer/executor/exec-stdin.rkt create mode 100644 evildoer/executor/host.rkt delete mode 100644 evildoer/executor/run-stdin.rkt delete mode 100644 evildoer/executor/run.rkt diff --git a/evildoer/correct.rkt b/evildoer/correct.rkt index 01914a1..cf21df8 100644 --- a/evildoer/correct.rkt +++ b/evildoer/correct.rkt @@ -2,12 +2,12 @@ (provide check-compiler) (require rackunit) (require "interpreter/interp-io.rkt") -(require "executor/run.rkt") +(require "executor/exec.rkt") (require "compiler/compile.rkt") ;; Expr String -> Void (define (check-compiler e i) (let ((r (with-handlers ([exn:fail? identity]) (interp/io e i)))) (unless (exn? r) - (check-equal? r (run/io (compile e) i))))) + (check-equal? r (exec/io e i))))) diff --git a/evildoer/executor/exec-stdin.rkt b/evildoer/executor/exec-stdin.rkt new file mode 100644 index 0000000..9669e7a --- /dev/null +++ b/evildoer/executor/exec-stdin.rkt @@ -0,0 +1,11 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "exec.rkt") + +;; -> Value +;; Parse, compile, and execute contents of stdin +(define (main) + (read-line) ; ignore #lang racket line + (exec (parse (read)))) + diff --git a/evildoer/executor/exec.rkt b/evildoer/executor/exec.rkt index 34d9d42..ae90943 100644 --- a/evildoer/executor/exec.rkt +++ b/evildoer/executor/exec.rkt @@ -1,50 +1,17 @@ #lang racket -(require a86/interp) - -(provide exec - (struct-out exec-state) - exec-unload - call-with-exec) - -(require a86/interp - ffi/unsafe) +(provide exec exec/io) +(require "../compiler/compile.rkt") (require "decode.rkt") -(require "../runtime/types.rkt") - -(struct exec-state (program) #:transparent) - -(define (exec/state prog) - (exec-state - (parameterize - ([current-externs - (list - (extern 'read_byte read-byte (_fun -> _val)) - (extern 'peek_byte peek-byte (_fun -> _val)) - (extern 'write_byte write-byte (_fun _val -> _val)))]) - (asm-load prog)))) - -(define (exec-call st) - (match-define (exec-state program) st) - (asm-call program 'entry)) - -(define (exec-unload st) - (asm-unload (exec-state-program st))) - -;; ------------------------------------------------------------ -;; public API - -;; execute with runtime system and Racket host -;; return raw bits plus the live state needed to interpret them safely - -;; CAUTION: this does not unload -(define (exec asm) - (exec-call (exec/state asm))) - -;; version of above that ensures unloading -(define (call-with-exec e f) - (define st (exec/state e)) - (dynamic-wind - void - (λ () (f (exec-call st))) - (λ () (exec-unload st)))) - +(require "host.rkt") + +;; Expr -> Value +(define (exec e) + (bits->value (asm-interp/host (compile e)))) + +;; Asm String -> (cons Value String) +(define (exec/io e in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (exec e) + (get-output-string (current-output-port))))) + diff --git a/evildoer/executor/host.rkt b/evildoer/executor/host.rkt new file mode 100644 index 0000000..26a64e8 --- /dev/null +++ b/evildoer/executor/host.rkt @@ -0,0 +1,22 @@ +#lang racket +(require a86/interp) +(require ffi/unsafe) +(require "decode.rkt") +(require "../runtime/types.rkt") +(provide (all-defined-out)) + +(define (prim-read-byte) + (value->bits (read-byte))) +(define (prim-peek-byte) + (value->bits (peek-byte))) +(define (prim-write-byte bs) + (value->bits (write-byte (bits->value bs)))) + +(define (asm-interp/host asm) + (parameterize + ([current-externs + (list (extern 'read_byte prim-read-byte (_fun -> _int64)) + (extern 'peek_byte prim-peek-byte (_fun -> _int64)) + (extern 'write_byte prim-write-byte (_fun _int64 -> _int64)))]) + (asm-interp asm))) + diff --git a/evildoer/executor/run-stdin.rkt b/evildoer/executor/run-stdin.rkt deleted file mode 100644 index ac60d60..0000000 --- a/evildoer/executor/run-stdin.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(provide main) -(require "../syntax/parse.rkt") -(require "../compiler/compile.rkt") -(require "run.rkt") - -;; -> Void -;; Compile contents of stdin and use asm-interp to run -(define (main) - (read-line) ; ignore #lang racket line - - (run (compile (parse (read))))) - diff --git a/evildoer/executor/run.rkt b/evildoer/executor/run.rkt deleted file mode 100644 index e568605..0000000 --- a/evildoer/executor/run.rkt +++ /dev/null @@ -1,19 +0,0 @@ -#lang racket -(require a86/interp) -(require "decode.rkt") -(require "exec.rkt") -(provide run run/io) -;; Asm -> Value -(define (run asm) - (call-with-exec - asm - (λ (r) - (bits->value r)))) - -;; Asm String -> (cons Value String) -(define (run/io asm in) - (parameterize ((current-output-port (open-output-string)) - (current-input-port (open-input-string in))) - (cons (run asm) - (get-output-string (current-output-port))))) - diff --git a/evildoer/main.rkt b/evildoer/main.rkt index f9851a3..ae83f33 100644 --- a/evildoer/main.rkt +++ b/evildoer/main.rkt @@ -5,7 +5,6 @@ (require "interpreter/interp-io.rkt") (require "compiler/compile.rkt") (require "runtime/types.rkt") -(require "executor/run.rkt") (require "executor/exec.rkt") (provide (all-from-out "syntax/ast.rkt")) (provide (all-from-out "syntax/parse.rkt")) @@ -13,6 +12,5 @@ (provide (all-from-out "interpreter/interp-io.rkt")) (provide (all-from-out "compiler/compile.rkt")) (provide (all-from-out "runtime/types.rkt")) -(provide (all-from-out "executor/run.rkt")) (provide (all-from-out "executor/exec.rkt")) diff --git a/evildoer/test/run-compile-tests.rkt b/evildoer/test/run-compile-tests.rkt index 95e541e..2a0cabf 100644 --- a/evildoer/test/run-compile-tests.rkt +++ b/evildoer/test/run-compile-tests.rkt @@ -1,9 +1,9 @@ #lang racket (require "../compiler/compile.rkt") (require "../syntax/parse.rkt") -(require "../executor/run.rkt") +(require "../executor/exec.rkt") (require "define-tests.rkt") -(test (λ (e) (run (compile (parse e))))) +(test (λ (e) (exec (parse e)))) -(test/io (λ (i e) (run/io (compile (parse e)) i))) +(test/io (λ (i e) (exec/io (parse e) i))) From 5ed644a8ba428ad8f19b10a2ae6b2750c99ef794 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Sun, 31 May 2026 23:03:45 -0400 Subject: [PATCH 46/47] Make interp/io a little nicer in Evildoer. --- evildoer/interpreter/interp-io.rkt | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/evildoer/interpreter/interp-io.rkt b/evildoer/interpreter/interp-io.rkt index 0550189..ccc2dfe 100644 --- a/evildoer/interpreter/interp-io.rkt +++ b/evildoer/interpreter/interp-io.rkt @@ -5,13 +5,8 @@ ;; String Expr -> (Cons Value String) ;; Interpret e with given string as input, ;; return value and collected output as string -(define (interp/io e input) - (define result (box #f)) - (define output - (with-input-from-string input - (λ () - (with-output-to-string - (λ () - (set-box! result (interp e))))))) - (cons (unbox result) output)) - +(define (interp/io e in) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string in))) + (cons (interp e) + (get-output-string (current-output-port))))) From ab000a044b58f0ca7a653ff1aea44162e3bc6794 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 1 Jun 2026 08:18:34 -0400 Subject: [PATCH 47/47] Slight reworking of the exec stuff in the early langs. --- .../{run-stdin.rkt => exec-stdin.rkt} | 0 .../{run-stdin.rkt => exec-stdin.rkt} | 0 .../{run-stdin.rkt => exec-stdin.rkt} | 0 dupe/correct.rkt | 5 +-- dupe/executor/exec-stdin.rkt | 11 +++++ dupe/executor/exec.rkt | 45 +++---------------- dupe/executor/run-stdin.rkt | 13 ------ dupe/executor/run.rkt | 11 ----- dupe/main.rkt | 2 - dupe/test/run-compile-tests.rkt | 5 +-- 10 files changed, 20 insertions(+), 72 deletions(-) rename abscond/executor/{run-stdin.rkt => exec-stdin.rkt} (100%) rename blackmail/executor/{run-stdin.rkt => exec-stdin.rkt} (100%) rename con/executor/{run-stdin.rkt => exec-stdin.rkt} (100%) create mode 100644 dupe/executor/exec-stdin.rkt delete mode 100644 dupe/executor/run-stdin.rkt delete mode 100644 dupe/executor/run.rkt diff --git a/abscond/executor/run-stdin.rkt b/abscond/executor/exec-stdin.rkt similarity index 100% rename from abscond/executor/run-stdin.rkt rename to abscond/executor/exec-stdin.rkt diff --git a/blackmail/executor/run-stdin.rkt b/blackmail/executor/exec-stdin.rkt similarity index 100% rename from blackmail/executor/run-stdin.rkt rename to blackmail/executor/exec-stdin.rkt diff --git a/con/executor/run-stdin.rkt b/con/executor/exec-stdin.rkt similarity index 100% rename from con/executor/run-stdin.rkt rename to con/executor/exec-stdin.rkt diff --git a/dupe/correct.rkt b/dupe/correct.rkt index 2129ca0..16ae264 100644 --- a/dupe/correct.rkt +++ b/dupe/correct.rkt @@ -2,13 +2,12 @@ (provide check-compiler) (require rackunit) (require "interpreter/interp.rkt") -(require "executor/run.rkt") -(require "compiler/compile.rkt") +(require "executor/exec.rkt") ;; Expr -> Void (define (check-compiler e) (let ((r (with-handlers ([exn:fail? identity]) (interp e)))) (unless (exn? r) - (check-equal? r (run (compile e)))))) + (check-equal? r (exec e))))) diff --git a/dupe/executor/exec-stdin.rkt b/dupe/executor/exec-stdin.rkt new file mode 100644 index 0000000..9669e7a --- /dev/null +++ b/dupe/executor/exec-stdin.rkt @@ -0,0 +1,11 @@ +#lang racket +(provide main) +(require "../syntax/parse.rkt") +(require "exec.rkt") + +;; -> Value +;; Parse, compile, and execute contents of stdin +(define (main) + (read-line) ; ignore #lang racket line + (exec (parse (read)))) + diff --git a/dupe/executor/exec.rkt b/dupe/executor/exec.rkt index 8b8c3be..71f3c17 100644 --- a/dupe/executor/exec.rkt +++ b/dupe/executor/exec.rkt @@ -1,44 +1,9 @@ #lang racket +(provide exec) (require a86/interp) - -(provide exec - (struct-out exec-state) - exec-unload - call-with-exec) - -(require a86/interp - ffi/unsafe) +(require "../compiler/compile.rkt") (require "decode.rkt") -(require "../runtime/types.rkt") - -(struct exec-state (program) #:transparent) - -(define (exec/state prog) - (exec-state - (asm-load prog))) - -(define (exec-call st) - (match-define (exec-state program) st) - (asm-call program 'entry)) - -(define (exec-unload st) - (asm-unload (exec-state-program st))) - -;; ------------------------------------------------------------ -;; public API - -;; execute with runtime system and Racket host -;; return raw bits plus the live state needed to interpret them safely - -;; CAUTION: this does not unload -(define (exec asm) - (exec-call (exec/state asm))) - -;; version of above that ensures unloading -(define (call-with-exec e f) - (define st (exec/state e)) - (dynamic-wind - void - (λ () (f (exec-call st))) - (λ () (exec-unload st)))) +;; Expr -> Value +(define (exec e) + (bits->value (asm-interp (compile e)))) diff --git a/dupe/executor/run-stdin.rkt b/dupe/executor/run-stdin.rkt deleted file mode 100644 index ac60d60..0000000 --- a/dupe/executor/run-stdin.rkt +++ /dev/null @@ -1,13 +0,0 @@ -#lang racket -(provide main) -(require "../syntax/parse.rkt") -(require "../compiler/compile.rkt") -(require "run.rkt") - -;; -> Void -;; Compile contents of stdin and use asm-interp to run -(define (main) - (read-line) ; ignore #lang racket line - - (run (compile (parse (read))))) - diff --git a/dupe/executor/run.rkt b/dupe/executor/run.rkt deleted file mode 100644 index 5b4c9cd..0000000 --- a/dupe/executor/run.rkt +++ /dev/null @@ -1,11 +0,0 @@ -#lang racket -(require a86/interp) -(require "decode.rkt") -(require "exec.rkt") -(provide run) -(define (run asm) - (call-with-exec - asm - (λ (r) - (bits->value r)))) - diff --git a/dupe/main.rkt b/dupe/main.rkt index d6a5d90..dc085fd 100644 --- a/dupe/main.rkt +++ b/dupe/main.rkt @@ -4,13 +4,11 @@ (require "interpreter/interp.rkt") (require "compiler/compile.rkt") (require "runtime/types.rkt") -(require "executor/run.rkt") (require "executor/exec.rkt") (provide (all-from-out "syntax/ast.rkt")) (provide (all-from-out "syntax/parse.rkt")) (provide (all-from-out "interpreter/interp.rkt")) (provide (all-from-out "compiler/compile.rkt")) (provide (all-from-out "runtime/types.rkt")) -(provide (all-from-out "executor/run.rkt")) (provide (all-from-out "executor/exec.rkt")) diff --git a/dupe/test/run-compile-tests.rkt b/dupe/test/run-compile-tests.rkt index 1360550..a13ebef 100644 --- a/dupe/test/run-compile-tests.rkt +++ b/dupe/test/run-compile-tests.rkt @@ -1,7 +1,6 @@ #lang racket -(require "../compiler/compile.rkt") (require "../syntax/parse.rkt") -(require "../executor/run.rkt") +(require "../executor/exec.rkt") (require "define-tests.rkt") -(test (λ (e) (run (compile (parse e))))) +(test (λ (e) (exec (parse e))))