From 18e5275a7648c7792696a4808909dc0cb6e6002a Mon Sep 17 00:00:00 2001
From: Jacob Signorovitch <jacob.signorovitch@gmail.com>
Date: Sat, 30 May 2026 09:12:17 -0400
Subject: [PATCH] ah

---
 15-compilation-part-2/main.rkt | 32 +++++++++++++++++++-------------
 1 file changed, 19 insertions(+), 13 deletions(-)

diff --git a/15-compilation-part-2/main.rkt b/15-compilation-part-2/main.rkt
index e5c183d..e6387e8 100644
--- a/15-compilation-part-2/main.rkt
+++ b/15-compilation-part-2/main.rkt
@@ -72,7 +72,7 @@
      (match sexpr
        [(list 'set! (symbol: name) new) (Set name (parse-sexpr new))]
        [else (error 'parse-sexpr "bad `set!' syntax in ~s" sexpr)])]
-    [(cons (and binder (or 'bind 'bindrec)) more)
+    [(cons (and binder (or 'bind 'bindrec)) _)
      (match sexpr
        [(list _ (list (list (symbol: names) (sexpr: nameds)) ...)
               body0 body ...)
@@ -84,7 +84,7 @@
             (error 'parse-sexpr "duplicate `~s' names: ~s" binder names))]
        [else (error 'parse-sexpr "bad `~s' syntax in ~s"
                     binder sexpr)])]
-    [(cons (and funner (or 'fun 'rfun)) more)
+    [(cons (and funner (or 'fun 'rfun)) _)
      (match sexpr
        [(list _ (list (symbol: names) ...)
               body0 body ...)
@@ -95,7 +95,7 @@
             (error 'parse-sexpr "duplicate `~s' names: ~s" funner names))]
        [else (error 'parse-sexpr "bad `~s' syntax in ~s"
                     funner sexpr)])]
-    [(cons 'if more)
+    [(cons 'if _)
      (match sexpr
        [(list 'if cond then else)
         (If (parse-sexpr cond) (parse-sexpr then) (parse-sexpr else))]
@@ -118,7 +118,7 @@
 (define-type VAL
              [BogusV]
              [RktV Any]
-             [FunV (Listof Symbol) (ENV -> VAL) ENV Boolean] ; `byref?' flag
+             [FunV Natural (ENV -> VAL) ENV Boolean] ; `byref?' flag
              [PrimV ((Listof VAL) -> VAL)])
 
 ;; a single bogus value to use wherever needed
@@ -126,7 +126,7 @@
 
 (: extend : (Listof VAL) ENV -> ENV)
 ;; extends an environment with a new frame (given plain values).
-(define (extend names values env)
+(define (extend values env)
   (cons (map (inst box VAL) values) env))
 
 (: extend-rec : (Listof (ENV -> VAL)) ENV -> ENV)
@@ -221,8 +221,8 @@
         compiled-1st
         (let ([compiled-rest (compile-body rest bin)])
           (lambda (env)
-            (define ignored (compiled-1st env))
-            (compiled-rest env))))))
+            (let [(_ (compiled-1st env))]
+              (compiled-rest env)))))))
 
 (: compile-get-boxes : (Listof TOY) BINDINGS -> (ENV -> (Listof (Boxof VAL))))
 ;; utility for applying rfun
@@ -292,12 +292,17 @@
             (compiled-body (extend-rec compiled-exprs env)))]
          [(Fun names bound-body)
           (define compiled-body (compile-body bound-body (cons names bin)))
-          (lambda ([env : ENV]) (FunV names compiled-body env #f))]
+          (: arity : Natural)
+          (define arity (length names))
+          (lambda ([env : ENV]) (FunV arity compiled-body env #f))]
          [(RFun names bound-body)
           (define compiled-body (compile-body bound-body (cons names bin)))
-          (lambda ([env : ENV]) (FunV names compiled-body env #t))]
+          (define arity (length names))
+          (lambda ([env : ENV]) (FunV arity compiled-body env #t))]
          [(Call fun-expr arg-exprs)
           (define compiled-fun (compile fun-expr bin))
+          (: nargs : Natural)
+          (define nargs (length arg-exprs))
           (define compiled-args (map compile* arg-exprs))
           (define compiled-boxes-getter (compile-get-boxes arg-exprs bin))
           (lambda ([env : ENV])
@@ -306,10 +311,11 @@
             (define arg-vals (lambda () (map (caller env) compiled-args)))
             (cases fval
                    [(PrimV proc) (proc (arg-vals))]
-                   [(FunV names compiled-body fun-env byref?)
-                    (compiled-body (if byref?
-                                       (cons (compiled-boxes-getter env) fun-env)
-                                       (extend (arg-vals) fun-env)))]
+                   [(FunV arity compiled-body fun-env byref?) (if (= arity nargs)
+                                                                  (compiled-body (if byref?
+                                                                                     (cons (compiled-boxes-getter env) fun-env)
+                                                                                     (extend (arg-vals) fun-env)))
+                                                                  (error 'compile "arity mismatch"))]
                    [else (error 'call "function call with a non-function: ~s"
                                 fval)]))]
          [(If cond-expr then-expr else-expr)