From 386a91bb5626c49217625b9c918738eed9243a5e Mon Sep 17 00:00:00 2001 From: dvanhorn Date: Sat, 1 Nov 2025 16:46:33 +0000 Subject: [PATCH 1/4] crook --- iniquity/compile.rkt | 3 +++ iniquity/test/test-runner.rkt | 6 ++++++ jig/compile.rkt | 4 ++++ jig/test/test-runner.rkt | 6 ++++++ knock/compile.rkt | 4 ++++ knock/test/test-runner.rkt | 6 ++++++ loot/compile.rkt | 4 ++++ loot/test/test-runner.rkt | 6 ++++++ 8 files changed, 39 insertions(+) diff --git a/iniquity/compile.rkt b/iniquity/compile.rkt index 55f8fa9..ca92845 100644 --- a/iniquity/compile.rkt +++ b/iniquity/compile.rkt @@ -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/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/compile.rkt b/jig/compile.rkt index 81d7ac5..f2f763f 100644 --- a/jig/compile.rkt +++ b/jig/compile.rkt @@ -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/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/compile.rkt b/knock/compile.rkt index 901a033..9de76de 100644 --- a/knock/compile.rkt +++ b/knock/compile.rkt @@ -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/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/compile.rkt b/loot/compile.rkt index 430d1f5..89e192d 100644 --- a/loot/compile.rkt +++ b/loot/compile.rkt @@ -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/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 From 0eb11a908ab1892aa6ca61ef9f7791677290898a Mon Sep 17 00:00:00 2001 From: dvanhorn Date: Tue, 4 Nov 2025 05:52:14 +0000 Subject: [PATCH 2/4] crook --- iniquity/parse.rkt | 2 +- iniquity/test/parse.rkt | 10 +++++++++- jig/parse.rkt | 2 +- jig/test/parse.rkt | 1 + knock/parse.rkt | 18 +++++++++--------- knock/test/parse.rkt | 1 + loot/parse.rkt | 18 +++++++++--------- loot/test/parse.rkt | 1 + 8 files changed, 32 insertions(+), 21 deletions(-) diff --git a/iniquity/parse.rkt b/iniquity/parse.rkt index 02df181..e1d8680 100644 --- a/iniquity/parse.rkt +++ b/iniquity/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) diff --git a/iniquity/test/parse.rkt b/iniquity/test/parse.rkt index ea9197b..8e6ac4c 100644 --- a/iniquity/test/parse.rkt +++ b/iniquity/test/parse.rkt @@ -55,10 +55,18 @@ (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)))))) diff --git a/jig/parse.rkt b/jig/parse.rkt index 511e0bb..f522fc0 100644 --- a/jig/parse.rkt +++ b/jig/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) diff --git a/jig/test/parse.rkt b/jig/test/parse.rkt index fd413ee..71e0b52 100644 --- a/jig/test/parse.rkt +++ b/jig/test/parse.rkt @@ -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/parse.rkt b/knock/parse.rkt index ecc5fb2..1990913 100644 --- a/knock/parse.rkt +++ b/knock/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) diff --git a/knock/test/parse.rkt b/knock/test/parse.rkt index 8f8494f..f9ef8d0 100644 --- a/knock/test/parse.rkt +++ b/knock/test/parse.rkt @@ -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/loot/parse.rkt b/loot/parse.rkt index a593571..053439c 100644 --- a/loot/parse.rkt +++ b/loot/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/test/parse.rkt b/loot/test/parse.rkt index 839f472..58a2bbb 100644 --- a/loot/test/parse.rkt +++ b/loot/test/parse.rkt @@ -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))) From d989a90b2683748cb2e2eb421343190938a373d2 Mon Sep 17 00:00:00 2001 From: dvanhorn Date: Thu, 6 Nov 2025 15:59:03 +0000 Subject: [PATCH 3/4] crook --- iniquity/parse.rkt | 2 +- iniquity/test/parse.rkt | 4 +++- jig/parse.rkt | 2 +- knock/parse.rkt | 2 +- 4 files changed, 6 insertions(+), 4 deletions(-) diff --git a/iniquity/parse.rkt b/iniquity/parse.rkt index e1d8680..b05e65e 100644 --- a/iniquity/parse.rkt +++ b/iniquity/parse.rkt @@ -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/test/parse.rkt b/iniquity/test/parse.rkt index 8e6ac4c..becea55 100644 --- a/iniquity/test/parse.rkt +++ b/iniquity/test/parse.rkt @@ -68,5 +68,7 @@ (App 'define (list (Lit 1))))) (check-exn exn:fail? (λ () (parse '(define (define x) x) '(define (g x) x) - '(define (g 1)))))) + '(define (g 1))))) + (check-exn exn:fail? (λ () (parse-closed '(define (f x) 0) + '(f (g)))))) diff --git a/jig/parse.rkt b/jig/parse.rkt index f522fc0..b87bfa7 100644 --- a/jig/parse.rkt +++ b/jig/parse.rkt @@ -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/knock/parse.rkt b/knock/parse.rkt index 1990913..01680e0 100644 --- a/knock/parse.rkt +++ b/knock/parse.rkt @@ -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)])) From b08949347dda04a8a8a760d8ce756c8fd3ce4688 Mon Sep 17 00:00:00 2001 From: dvanhorn Date: Tue, 25 Nov 2025 20:58:28 +0000 Subject: [PATCH 4/4] crook --- hoax/compile-ops.rkt | 4 ++-- iniquity/compile-ops.rkt | 4 ++-- jig/compile-ops.rkt | 4 ++-- knock/compile-ops.rkt | 4 ++-- loot/compile-ops.rkt | 4 ++-- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/hoax/compile-ops.rkt b/hoax/compile-ops.rkt index 1bb76cb..bac7704 100644 --- a/hoax/compile-ops.rkt +++ b/hoax/compile-ops.rkt @@ -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-ops.rkt b/iniquity/compile-ops.rkt index 1bb76cb..bac7704 100644 --- a/iniquity/compile-ops.rkt +++ b/iniquity/compile-ops.rkt @@ -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-ops.rkt b/jig/compile-ops.rkt index 1bb76cb..bac7704 100644 --- a/jig/compile-ops.rkt +++ b/jig/compile-ops.rkt @@ -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-ops.rkt b/knock/compile-ops.rkt index 1bb76cb..bac7704 100644 --- a/knock/compile-ops.rkt +++ b/knock/compile-ops.rkt @@ -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-ops.rkt b/loot/compile-ops.rkt index a648695..d931acf 100644 --- a/loot/compile-ops.rkt +++ b/loot/compile-ops.rkt @@ -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)