Skip to content

crook #62

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
dvanhorn wants to merge 4 commits into
base: main
Choose a base branch
from
Open

crook #62

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
386a91b
crook
dvanhorn Nov 1, 2025
0eb11a9
crook
dvanhorn Nov 4, 2025
d989a90
crook
dvanhorn Nov 6, 2025
b089493
crook
dvanhorn Nov 25, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions hoax/compile-ops.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
4 changes: 2 additions & 2 deletions iniquity/compile-ops.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
3 changes: 3 additions & 0 deletions iniquity/compile.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))]))
Expand Down Expand Up @@ -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))))

Expand Down
4 changes: 2 additions & 2 deletions iniquity/parse.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)]))
Expand Down
12 changes: 11 additions & 1 deletion iniquity/test/parse.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))))))

6 changes: 6 additions & 0 deletions iniquity/test/test-runner.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
4 changes: 2 additions & 2 deletions jig/compile-ops.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
4 changes: 4 additions & 0 deletions jig/compile.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))]))
Expand Down Expand Up @@ -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
Expand All @@ -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))))

Expand Down
4 changes: 2 additions & 2 deletions jig/parse.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)]))
Expand Down
1 change: 1 addition & 0 deletions jig/test/parse.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand Down
6 changes: 6 additions & 0 deletions jig/test/test-runner.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
4 changes: 2 additions & 2 deletions knock/compile-ops.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
4 changes: 4 additions & 0 deletions knock/compile.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))]))
Expand Down Expand Up @@ -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
Expand All @@ -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))))

Expand Down
20 changes: 10 additions & 10 deletions knock/parse.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand All @@ -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)]))
Expand Down
1 change: 1 addition & 0 deletions knock/test/parse.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand Down
6 changes: 6 additions & 0 deletions knock/test/test-runner.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions loot/compile-ops.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
4 changes: 4 additions & 0 deletions loot/compile.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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))))

Expand Down
18 changes: 9 additions & 9 deletions loot/parse.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions loot/test/parse.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand Down
6 changes: 6 additions & 0 deletions loot/test/test-runner.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading