From 948e595523dbccdce1cfd65b6d2eb2c0d039d324 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 26 Feb 2024 14:07:00 -0500 Subject: [PATCH 1/3] Generated Dodger. --- langs/dodger/ast.rkt | 15 ++++++++++ langs/dodger/compile-ops.rkt | 40 ++++++++++++++++++++++++++ langs/dodger/compile-stdin.rkt | 13 +++++++++ langs/dodger/compile.rkt | 46 ++++++++++++++++++++++++++++++ langs/dodger/interp-prim.rkt | 13 +++++++++ langs/dodger/interp-stdin.rkt | 12 ++++++++ langs/dodger/interp.rkt | 20 +++++++++++++ langs/dodger/main.rkt | 13 +++++++++ langs/dodger/parse.rkt | 23 +++++++++++++++ langs/dodger/run-stdin.rkt | 12 ++++++++ langs/dodger/run.rkt | 8 ++++++ langs/dodger/test/compile.rkt | 8 ++++++ langs/dodger/test/interp.rkt | 7 +++++ langs/dodger/test/test-runner.rkt | 47 +++++++++++++++++++++++++++++++ langs/dodger/types.rkt | 32 +++++++++++++++++++++ 15 files changed, 309 insertions(+) create mode 100644 langs/dodger/ast.rkt create mode 100644 langs/dodger/compile-ops.rkt create mode 100644 langs/dodger/compile-stdin.rkt create mode 100644 langs/dodger/compile.rkt create mode 100644 langs/dodger/interp-prim.rkt create mode 100644 langs/dodger/interp-stdin.rkt create mode 100644 langs/dodger/interp.rkt create mode 100644 langs/dodger/main.rkt create mode 100644 langs/dodger/parse.rkt create mode 100644 langs/dodger/run-stdin.rkt create mode 100644 langs/dodger/run.rkt create mode 100644 langs/dodger/test/compile.rkt create mode 100644 langs/dodger/test/interp.rkt create mode 100644 langs/dodger/test/test-runner.rkt create mode 100644 langs/dodger/types.rkt diff --git a/langs/dodger/ast.rkt b/langs/dodger/ast.rkt new file mode 100644 index 00000000..f2ebd7df --- /dev/null +++ b/langs/dodger/ast.rkt @@ -0,0 +1,15 @@ +#lang racket +(provide Lit Prim1 If) +;; type Expr = (Lit Datum) +;; | (Prim1 Op1 Expr) +;; | (If Expr Expr Expr) +;; type Datum = Integer +;; | Boolean +;; | Character +;; type Op1 = 'add1 | 'sub1 +;; | 'zero? +;; | 'char? | 'integer->char | 'char->integer +(struct Lit (d) #:prefab) +(struct Prim1 (p e) #:prefab) +(struct If (e1 e2 e3) #:prefab) + diff --git a/langs/dodger/compile-ops.rkt b/langs/dodger/compile-ops.rkt new file mode 100644 index 00000000..8b6a512b --- /dev/null +++ b/langs/dodger/compile-ops.rkt @@ -0,0 +1,40 @@ +#lang racket +(provide compile-op1) +(require "ast.rkt") +(require "types.rkt") +(require a86/ast) + +(define rax 'rax) +(define r9 'r9) + +;; Op1 -> Asm +(define (compile-op1 p) + (match p + ['add1 (Add rax (value->bits 1))] + ['sub1 (Sub rax (value->bits 1))] + ['zero? + (seq + (Cmp rax 0) + if-equal)] + ['char? + (seq (And rax mask-char) + (Cmp rax type-char) + if-equal)] + ['char->integer + (seq + (Sar rax char-shift) + (Sal rax int-shift))] + ['integer->char + (seq + (Sar rax int-shift) + (Sal rax char-shift) + (Xor rax type-char))])) + + +;; -> 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))) + diff --git a/langs/dodger/compile-stdin.rkt b/langs/dodger/compile-stdin.rkt new file mode 100644 index 00000000..532ee0eb --- /dev/null +++ b/langs/dodger/compile-stdin.rkt @@ -0,0 +1,13 @@ +#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/langs/dodger/compile.rkt b/langs/dodger/compile.rkt new file mode 100644 index 00000000..3a39225c --- /dev/null +++ b/langs/dodger/compile.rkt @@ -0,0 +1,46 @@ +#lang racket +(provide (all-defined-out)) +(require "ast.rkt") +(require "compile-ops.rkt") +(require "types.rkt") +(require a86/ast) + +(define rax 'rax) + +;; Expr -> Asm +(define (compile e) + (prog (Global 'entry) + (Label 'entry) + (compile-e e) + (Ret))) + +;; Expr -> Asm +(define (compile-e e) + (match e + [(Lit d) (compile-value d)] + [(Prim1 p e) (compile-prim1 p e)] + [(If e1 e2 e3) + (compile-if e1 e2 e3)])) + +;; Value -> Asm +(define (compile-value v) + (seq (Mov rax (value->bits v)))) + +;; Op1 Expr -> Asm +(define (compile-prim1 p e) + (seq (compile-e e) + (compile-op1 p))) + +;; Expr Expr Expr -> Asm +(define (compile-if e1 e2 e3) + (let ((l1 (gensym 'if)) + (l2 (gensym 'if))) + (seq (compile-e e1) + (Cmp rax (value->bits #f)) + (Je l1) + (compile-e e2) + (Jmp l2) + (Label l1) + (compile-e e3) + (Label l2)))) + diff --git a/langs/dodger/interp-prim.rkt b/langs/dodger/interp-prim.rkt new file mode 100644 index 00000000..89237e72 --- /dev/null +++ b/langs/dodger/interp-prim.rkt @@ -0,0 +1,13 @@ +#lang racket +(provide interp-prim1) + +;; Op1 Value -> Value +(define (interp-prim1 op v) + (match op + ['add1 (add1 v)] + ['sub1 (sub1 v)] + ['zero? (zero? v)] + ['char? (char? v)] + ['integer->char (integer->char v)] + ['char->integer (char->integer v)])) + diff --git a/langs/dodger/interp-stdin.rkt b/langs/dodger/interp-stdin.rkt new file mode 100644 index 00000000..ce4885f7 --- /dev/null +++ b/langs/dodger/interp-stdin.rkt @@ -0,0 +1,12 @@ +#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/langs/dodger/interp.rkt b/langs/dodger/interp.rkt new file mode 100644 index 00000000..e8a0bff8 --- /dev/null +++ b/langs/dodger/interp.rkt @@ -0,0 +1,20 @@ +#lang racket +(provide interp) +(require "ast.rkt") +(require "interp-prim.rkt") + +;; type Value = +;; | Integer +;; | Boolean +;; | Character +;; Expr -> Value +(define (interp e) + (match e + [(Lit d) d] + [(Prim1 p e) + (interp-prim1 p (interp e))] + [(If e1 e2 e3) + (if (interp e1) + (interp e2) + (interp e3))])) + diff --git a/langs/dodger/main.rkt b/langs/dodger/main.rkt new file mode 100644 index 00000000..e0e38924 --- /dev/null +++ b/langs/dodger/main.rkt @@ -0,0 +1,13 @@ +#lang racket +(require "ast.rkt") +(require "parse.rkt") +(require "interp.rkt") +(require "compile.rkt") +(require "run.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")) + + diff --git a/langs/dodger/parse.rkt b/langs/dodger/parse.rkt new file mode 100644 index 00000000..e89ba0a7 --- /dev/null +++ b/langs/dodger/parse.rkt @@ -0,0 +1,23 @@ +#lang racket +(provide parse) +(require "ast.rkt") + +;; S-Expr -> Expr +(define (parse s) + (match s + [(? datum?) (Lit s)] + [(list (? op1? o) e) (Prim1 o (parse e))] + [(list 'if e1 e2 e3) + (If (parse e1) (parse e2) (parse e3))] + [_ (error "Parse error")])) + + +;; Any -> Boolean +(define (datum? x) + (or (exact-integer? x) + (boolean? x) + (char? x))) + +(define (op1? x) + (memq x '(add1 sub1 zero? char? integer->char char->integer))) + diff --git a/langs/dodger/run-stdin.rkt b/langs/dodger/run-stdin.rkt new file mode 100644 index 00000000..16cf99e0 --- /dev/null +++ b/langs/dodger/run-stdin.rkt @@ -0,0 +1,12 @@ +#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/langs/dodger/run.rkt b/langs/dodger/run.rkt new file mode 100644 index 00000000..37cba759 --- /dev/null +++ b/langs/dodger/run.rkt @@ -0,0 +1,8 @@ +#lang racket +(require a86/interp) +(require "types.rkt") +(provide run) +;; Asm -> Value +(define (run is) + (bits->value (asm-interp is))) + diff --git a/langs/dodger/test/compile.rkt b/langs/dodger/test/compile.rkt new file mode 100644 index 00000000..560e6f59 --- /dev/null +++ b/langs/dodger/test/compile.rkt @@ -0,0 +1,8 @@ +#lang racket +(require "../compile.rkt") +(require "../parse.rkt") +(require "../run.rkt") +(require "test-runner.rkt") + +(test (λ (e) (run (compile (parse e))))) + diff --git a/langs/dodger/test/interp.rkt b/langs/dodger/test/interp.rkt new file mode 100644 index 00000000..dc33c12a --- /dev/null +++ b/langs/dodger/test/interp.rkt @@ -0,0 +1,7 @@ +#lang racket +(require "../interp.rkt") +(require "../parse.rkt") +(require "test-runner.rkt") + +(test (λ (e) (interp (parse e)))) + diff --git a/langs/dodger/test/test-runner.rkt b/langs/dodger/test/test-runner.rkt new file mode 100644 index 00000000..91bc4d30 --- /dev/null +++ b/langs/dodger/test/test-runner.rkt @@ -0,0 +1,47 @@ +#lang racket +(provide test) +(require rackunit) + +(define (test run) + (begin ;; Abscond + (check-equal? (run 7) 7) + (check-equal? (run -8) -8)) + + (begin ;; Blackmail + (check-equal? (run '(add1 (add1 7))) 9) + (check-equal? (run '(add1 (sub1 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)) + + (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)) + + (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)) #\λ))) + diff --git a/langs/dodger/types.rkt b/langs/dodger/types.rkt new file mode 100644 index 00000000..d282feaf --- /dev/null +++ b/langs/dodger/types.rkt @@ -0,0 +1,32 @@ +#lang racket +(provide (all-defined-out)) +(define int-shift 1) +(define mask-int #b1) +(define char-shift 2) +(define type-int #b0) +(define type-char #b01) +(define mask-char #b11) + +(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 (value->bits v) + (cond [(eq? v #t) #b011] + [(eq? v #f) #b111] + [(integer? v) (arithmetic-shift v int-shift)] + [(char? v) + (bitwise-ior type-char + (arithmetic-shift (char->integer v) char-shift))])) + +(define (int-bits? v) + (= type-int (bitwise-and v mask-int))) + +(define (char-bits? v) + (= type-char (bitwise-and v mask-char))) + From 5fd551a8a8e9e5886724d435b587d688301a2753 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 26 Feb 2024 14:07:43 -0500 Subject: [PATCH 2/3] Generated Evildoer. --- langs/evildoer/ast.rkt | 23 ++++++++++ langs/evildoer/compile-ops.rkt | 55 +++++++++++++++++++++++ langs/evildoer/compile-stdin.rkt | 13 ++++++ langs/evildoer/compile.rkt | 65 +++++++++++++++++++++++++++ langs/evildoer/interp-io.rkt | 13 ++++++ langs/evildoer/interp-prim.rkt | 22 +++++++++ langs/evildoer/interp-stdin.rkt | 12 +++++ langs/evildoer/interp.rkt | 28 ++++++++++++ langs/evildoer/main.rkt | 13 ++++++ langs/evildoer/parse.rkt | 31 +++++++++++++ langs/evildoer/run-stdin.rkt | 12 +++++ langs/evildoer/run.rkt | 17 +++++++ langs/evildoer/test/compile.rkt | 10 +++++ langs/evildoer/test/interp.rkt | 10 +++++ langs/evildoer/test/test-runner.rkt | 70 +++++++++++++++++++++++++++++ langs/evildoer/types.rkt | 36 +++++++++++++++ 16 files changed, 430 insertions(+) create mode 100644 langs/evildoer/ast.rkt create mode 100644 langs/evildoer/compile-ops.rkt create mode 100644 langs/evildoer/compile-stdin.rkt create mode 100644 langs/evildoer/compile.rkt create mode 100644 langs/evildoer/interp-io.rkt create mode 100644 langs/evildoer/interp-prim.rkt create mode 100644 langs/evildoer/interp-stdin.rkt create mode 100644 langs/evildoer/interp.rkt create mode 100644 langs/evildoer/main.rkt create mode 100644 langs/evildoer/parse.rkt create mode 100644 langs/evildoer/run-stdin.rkt create mode 100644 langs/evildoer/run.rkt create mode 100644 langs/evildoer/test/compile.rkt create mode 100644 langs/evildoer/test/interp.rkt create mode 100644 langs/evildoer/test/test-runner.rkt create mode 100644 langs/evildoer/types.rkt diff --git a/langs/evildoer/ast.rkt b/langs/evildoer/ast.rkt new file mode 100644 index 00000000..c7c5c530 --- /dev/null +++ b/langs/evildoer/ast.rkt @@ -0,0 +1,23 @@ +#lang racket +(provide Lit Prim0 Prim1 If Eof Begin) +;; type Expr = (Lit Datum) +;; | (Eof) +;; | (Prim0 Op0) +;; | (Prim1 Op1 Expr) +;; | (If Expr Expr Expr) +;; type Datum = Integer +;; | Boolean +;; | Character +;; type Op0 = 'read-byte | 'peek-byte | 'void +;; type Op1 = 'add1 | 'sub1 +;; | 'zero? +;; | 'char? | 'integer->char | 'char->integer +;; | 'write-byte | 'eof-object? + +(struct Eof () #:prefab) +(struct Lit (d) #:prefab) +(struct Prim0 (p) #:prefab) +(struct Prim1 (p e) #:prefab) +(struct If (e1 e2 e3) #:prefab) +(struct Begin (e1 e2) #:prefab) + diff --git a/langs/evildoer/compile-ops.rkt b/langs/evildoer/compile-ops.rkt new file mode 100644 index 00000000..6bee2560 --- /dev/null +++ b/langs/evildoer/compile-ops.rkt @@ -0,0 +1,55 @@ +#lang racket +(provide compile-op0 compile-op1) +(require "ast.rkt") +(require "types.rkt") +(require a86/ast) + +(define rax 'rax) +(define rdi 'rdi) ; arg +(define r9 'r9) ; scratch + +;; Op0 -> Asm +(define (compile-op0 p) + (match p + ['void (seq (Mov rax (value->bits (void))))] + ['read-byte (seq (Call 'read_byte))] + ['peek-byte (seq (Call 'peek_byte))])) + +;; Op1 -> Asm +(define (compile-op1 p) + (match p + ['add1 (Add rax (value->bits 1))] + ['sub1 (Sub rax (value->bits 1))] + ['zero? + (seq + (Cmp rax 0) + if-equal)] + ['char? + (seq (And rax mask-char) + (Cmp rax type-char) + if-equal)] + ['char->integer + (seq + (Sar rax char-shift) + (Sal rax int-shift))] + ['integer->char + (seq + (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 + (Mov rdi rax) + (Call 'write_byte))])) + + +;; -> 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))) + diff --git a/langs/evildoer/compile-stdin.rkt b/langs/evildoer/compile-stdin.rkt new file mode 100644 index 00000000..532ee0eb --- /dev/null +++ b/langs/evildoer/compile-stdin.rkt @@ -0,0 +1,13 @@ +#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/langs/evildoer/compile.rkt b/langs/evildoer/compile.rkt new file mode 100644 index 00000000..80a654b7 --- /dev/null +++ b/langs/evildoer/compile.rkt @@ -0,0 +1,65 @@ +#lang racket +(provide (all-defined-out)) +(require "ast.rkt") +(require "compile-ops.rkt") +(require "types.rkt") +(require a86/ast) + +(define rax 'rax) +(define rsp 'rsp) ; stack + +;; Expr -> Asm +(define (compile e) + (prog (Global 'entry) + (Extern 'peek_byte) + (Extern 'read_byte) + (Extern 'write_byte) + (Label 'entry) + (Sub rsp 8) + (compile-e e) + (Add rsp 8) + (Ret))) + +;; Expr -> Asm +(define (compile-e e) + (match e + [(Lit d) (compile-value d)] + [(Eof) (compile-value eof)] + [(Prim0 p) (compile-prim0 p)] + [(Prim1 p e) (compile-prim1 p e)] + [(If e1 e2 e3) + (compile-if e1 e2 e3)] + [(Begin e1 e2) + (compile-begin e1 e2)])) + +;; Value -> Asm +(define (compile-value v) + (seq (Mov rax (value->bits v)))) + +;; Op0 -> Asm +(define (compile-prim0 p) + (compile-op0 p)) + +;; Op1 Expr -> Asm +(define (compile-prim1 p e) + (seq (compile-e e) + (compile-op1 p))) + +;; Expr Expr Expr -> Asm +(define (compile-if e1 e2 e3) + (let ((l1 (gensym 'if)) + (l2 (gensym 'if))) + (seq (compile-e e1) + (Cmp rax (value->bits #f)) + (Je l1) + (compile-e e2) + (Jmp l2) + (Label l1) + (compile-e e3) + (Label l2)))) + +;; Expr Expr -> Asm +(define (compile-begin e1 e2) + (seq (compile-e e1) + (compile-e e2))) + diff --git a/langs/evildoer/interp-io.rkt b/langs/evildoer/interp-io.rkt new file mode 100644 index 00000000..29a82d0b --- /dev/null +++ b/langs/evildoer/interp-io.rkt @@ -0,0 +1,13 @@ +#lang racket +(provide interp/io) +(require "interp.rkt") + +;; String Expr -> (Cons Value String) +;; Interpret e with given string as input, +;; return value and collected output as string +(define (interp/io e input) + (parameterize ((current-output-port (open-output-string)) + (current-input-port (open-input-string input))) + (cons (interp e) + (get-output-string (current-output-port))))) + diff --git a/langs/evildoer/interp-prim.rkt b/langs/evildoer/interp-prim.rkt new file mode 100644 index 00000000..72a671ec --- /dev/null +++ b/langs/evildoer/interp-prim.rkt @@ -0,0 +1,22 @@ +#lang racket +(provide interp-prim0 interp-prim1) + +;; Op0 -> Value +(define (interp-prim0 op) + (match op + ['read-byte (read-byte)] + ['peek-byte (peek-byte)] + ['void (void)])) + +;; Op1 Value -> Value +(define (interp-prim1 op v) + (match op + ['add1 (add1 v)] + ['sub1 (sub1 v)] + ['zero? (zero? v)] + ['char? (char? v)] + ['integer->char (integer->char v)] + ['char->integer (char->integer v)] + ['write-byte (write-byte v)] + ['eof-object? (eof-object? v)])) + diff --git a/langs/evildoer/interp-stdin.rkt b/langs/evildoer/interp-stdin.rkt new file mode 100644 index 00000000..ce4885f7 --- /dev/null +++ b/langs/evildoer/interp-stdin.rkt @@ -0,0 +1,12 @@ +#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/langs/evildoer/interp.rkt b/langs/evildoer/interp.rkt new file mode 100644 index 00000000..4c6e520a --- /dev/null +++ b/langs/evildoer/interp.rkt @@ -0,0 +1,28 @@ +#lang racket +(provide interp) +(require "ast.rkt") +(require "interp-prim.rkt") + +;; type Value = +;; | Integer +;; | Boolean +;; | Character +;; | Eof +;; | Void +;; Expr -> Value +(define (interp e) + (match e + [(Lit d) d] + [(Eof) eof] + [(Prim0 p) + (interp-prim0 p)] + [(Prim1 p e) + (interp-prim1 p (interp e))] + [(If e1 e2 e3) + (if (interp e1) + (interp e2) + (interp e3))] + [(Begin e1 e2) + (begin (interp e1) + (interp e2))])) + diff --git a/langs/evildoer/main.rkt b/langs/evildoer/main.rkt new file mode 100644 index 00000000..e0e38924 --- /dev/null +++ b/langs/evildoer/main.rkt @@ -0,0 +1,13 @@ +#lang racket +(require "ast.rkt") +(require "parse.rkt") +(require "interp.rkt") +(require "compile.rkt") +(require "run.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")) + + diff --git a/langs/evildoer/parse.rkt b/langs/evildoer/parse.rkt new file mode 100644 index 00000000..013ff045 --- /dev/null +++ b/langs/evildoer/parse.rkt @@ -0,0 +1,31 @@ +#lang racket +(provide parse) +(require "ast.rkt") + +;; S-Expr -> Expr +(define (parse s) + (match s + ['eof (Eof)] + [(? datum?) (Lit s)] + [(list (? op0? o)) (Prim0 o)] + [(list (? op1? o) e) (Prim1 o (parse e))] + [(list 'begin e1 e2) (Begin (parse e1) (parse e2))] + [(list 'if e1 e2 e3) + (If (parse e1) (parse e2) (parse e3))] + [_ (error "Parse error")])) + + +;; Any -> Boolean +(define (datum? x) + (or (exact-integer? x) + (boolean? x) + (char? 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?))) + diff --git a/langs/evildoer/run-stdin.rkt b/langs/evildoer/run-stdin.rkt new file mode 100644 index 00000000..16cf99e0 --- /dev/null +++ b/langs/evildoer/run-stdin.rkt @@ -0,0 +1,12 @@ +#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/langs/evildoer/run.rkt b/langs/evildoer/run.rkt new file mode 100644 index 00000000..233ecb8b --- /dev/null +++ b/langs/evildoer/run.rkt @@ -0,0 +1,17 @@ +#lang racket +(require a86/interp) +(require "types.rkt") +(require "build-runtime.rkt") +(provide run run/io) +;; Asm -> Value +(define (run is) + (parameterize ((current-objs (list (path->string runtime-path)))) + (bits->value (asm-interp is)))) + +;; 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 b out) + (cons (bits->value b) out)]))) + diff --git a/langs/evildoer/test/compile.rkt b/langs/evildoer/test/compile.rkt new file mode 100644 index 00000000..d52b46dd --- /dev/null +++ b/langs/evildoer/test/compile.rkt @@ -0,0 +1,10 @@ +#lang racket +(require "../compile.rkt") +(require "../parse.rkt") +(require "../run.rkt") +(require "test-runner.rkt") + +(test (λ (e) (run (compile (parse e))))) + +(test/io (λ (in e) (run/io (compile (parse e)) in))) + diff --git a/langs/evildoer/test/interp.rkt b/langs/evildoer/test/interp.rkt new file mode 100644 index 00000000..74d4a050 --- /dev/null +++ b/langs/evildoer/test/interp.rkt @@ -0,0 +1,10 @@ +#lang racket +(require "../interp.rkt") +(require "../interp-io.rkt") +(require "../parse.rkt") +(require "test-runner.rkt") + +(test (λ (e) (interp (parse e)))) + +(test/io (λ (in e) (interp/io (parse e) in))) + diff --git a/langs/evildoer/test/test-runner.rkt b/langs/evildoer/test/test-runner.rkt new file mode 100644 index 00000000..d149076d --- /dev/null +++ b/langs/evildoer/test/test-runner.rkt @@ -0,0 +1,70 @@ +#lang racket +(provide test test/io) +(require rackunit) + +(define (test run) + (begin ;; Abscond + (check-equal? (run 7) 7) + (check-equal? (run -8) -8)) + + (begin ;; Blackmail + (check-equal? (run '(add1 (add1 7))) 9) + (check-equal? (run '(add1 (sub1 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)) + + (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)) + + (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)) #\λ)) + + (begin ;; Evildoer + (check-equal? (run '(void)) (void)) + (check-equal? (run '(begin 1 2)) 2) + (check-equal? (run '(eof-object? (void))) #f))) + +(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 "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 "")))) + diff --git a/langs/evildoer/types.rkt b/langs/evildoer/types.rkt new file mode 100644 index 00000000..928a05fe --- /dev/null +++ b/langs/evildoer/types.rkt @@ -0,0 +1,36 @@ +#lang racket +(provide (all-defined-out)) +(define int-shift 1) +(define mask-int #b1) +(define char-shift 2) +(define type-int #b0) +(define type-char #b01) +(define mask-char #b11) + +(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 (value->bits v) + (cond [(eq? v #t) #b011] + [(eq? v #f) #b111] + [(integer? v) (arithmetic-shift v int-shift)] + [(eof-object? v) #b1011] + [(void? v) #b1111] + [(char? v) + (bitwise-ior type-char + (arithmetic-shift (char->integer v) char-shift))])) + +(define (int-bits? v) + (= type-int (bitwise-and v mask-int))) + +(define (char-bits? v) + (= type-char (bitwise-and v mask-char))) + From af307d6d6e7d190333a6f67931ab9af46e048ef5 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Mon, 26 Feb 2024 14:16:03 -0500 Subject: [PATCH 3/3] Update Assign 3 use of Lit in place of Int, Bool. --- www/assignments/3.scrbl | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/www/assignments/3.scrbl b/www/assignments/3.scrbl index 1368efdf..f5e19714 100644 --- a/www/assignments/3.scrbl +++ b/www/assignments/3.scrbl @@ -247,30 +247,30 @@ Now, we won't go so far as to @emph{give} you the code for @itemlist[ -@item{@racket[(abs 1)] parses as @racket[(Prim1 'abs (Int 1))],} +@item{@racket[(abs 1)] parses as @racket[(Prim1 'abs (Lit 1))],} -@item{@racket[(not #t)] parses as @racket[(Prim1 'not (Bool #t))],} +@item{@racket[(not #t)] parses as @racket[(Prim1 'not (Lit #t))],} -@item{@racket[(cond [else 5])] parses as @racket[(Cond '() (Int 5))],} +@item{@racket[(cond [else 5])] parses as @racket[(Cond '() (Lit 5))],} @item{@racket[(cond [(not #t) 3] [else 5])] parses as @racket[(Cond -(list (Clause (Prim1 'not (Bool #t)) (Int 3))) (Int 5))],} +(list (Clause (Prim1 'not (Lit #t)) (Lit 3))) (Lit 5))],} @item{@racket[(cond [(not #t) 3] [7 4] [else 5])] parses as -@racket[(Cond (list (Clause (Prim1 'not (Bool #t)) (Int 3)) (Clause -(Int 7) (Int 4))) (Int 5))],} +@racket[(Cond (list (Clause (Prim1 'not (Lit #t)) (Lit 3)) (Clause +(Lit 7) (Lit 4))) (Lit 5))],} @item{@racket[(case (add1 3) [else 2])] parses as @racket[(Case (Prim1 -'add1 (Int 3)) '() (Int 2))].} +'add1 (Lit 3)) '() (Lit 2))].} -@item{@racket[(case 4 [(4) 1] [else 2])] parses as @racket[(Case (Int -4) (list (Clause (list 4) (Int 1))) (Int 2))],} +@item{@racket[(case 4 [(4) 1] [else 2])] parses as @racket[(Case (Lit +4) (list (Clause (list 4) (Lit 1))) (Lit 2))],} -@item{@racket[(case 4 [(4 5 6) 1] [else 2])] parses as @racket[(Case (Int -4) (list (Clause (list 4 5 6) (Int 1))) (Int 2))], and} +@item{@racket[(case 4 [(4 5 6) 1] [else 2])] parses as @racket[(Case (Lit +4) (list (Clause (list 4 5 6) (Lit 1))) (Lit 2))], and} -@item{@racket[(case 4 [(4 5 6) 1] [(#t #f) 7] [else 2])] parses as @racket[(Case (Int -4) (list (Clause (list 4 5 6) (Int 1)) (Clause (list #t #f) (Int 7))) (Int 2))].} +@item{@racket[(case 4 [(4 5 6) 1] [(#t #f) 7] [else 2])] parses as @racket[(Case (Lit +4) (list (Clause (list 4 5 6) (Lit 1)) (Clause (list #t #f) (Lit 7))) (Lit 2))].} ]