crook

Author: dvanhorn

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))))
 

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)

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))))
 

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)

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))))
 

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

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))))
 

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