Check Typed Jerboa equality

ober

aade672ae4bb5413c774c8c5aebb79864cae210f

diff --git a/docs/jerboa-to-rust.md b/docs/jerboa-to-rust.md
index 1c47816..198ec62 100644
--- a/docs/jerboa-to-rust.md
+++ b/docs/jerboa-to-rust.md
@@ -627,7 +627,8 @@ Second module: typed `rope`.
 - Support function calls.
 - Support `if`, `let`, arithmetic, comparisons. Initial `string-length` and
   `bytevector-length` support landed as checked `(String -> Nat)` and
-  `(Bytes -> Nat)` builtins.
+  `(Bytes -> Nat)` builtins. Same-type `equal?` now checks as `Bool` and
+  lowers to Rust `==`, including for generated records and variants.
 - Generate wrappers. Initial scalar `.ss` wrappers plus `String` and `Bytes`
   argument wrappers landed. Same-module record and variant values now cross the
   wrapper boundary as opaque handles. `String` and `Bytes` returns now cross
@@ -650,7 +651,8 @@ Second module: typed `rope`.
   boundaries as opaque handles.
 - Box self-recursive variant fields in generated Rust and rebind recursive
   match children as owned typed values for branch bodies.
-- Support equality and debug output.
+- Support equality and debug output. Same-type `equal?` has landed; richer
+  debug/string rendering remains future work.
 
 ### Milestone 4: First Real Module
 
diff --git a/docs/typed-jerboa.md b/docs/typed-jerboa.md
index e76ca4e..136fc53 100644
--- a/docs/typed-jerboa.md
+++ b/docs/typed-jerboa.md
@@ -201,9 +201,9 @@ Current landing:
   annotations.
 - This is still a front-end milestone. Function-body checking currently covers
   literals, variables, `begin`, simple `let`, `if`, arithmetic primitives,
-  numeric comparisons, boolean primitives, calls to typed functions defined in
-  the same module, generated record/variant operations, and exhaustive
-  `match` over same-module variants. The first builtin string primitive,
+  numeric comparisons, same-type `equal?`, boolean primitives, calls to typed
+  functions defined in the same module, generated record/variant operations,
+  and exhaustive `match` over same-module variants. The first builtin string primitive,
   `string-length`, is checked as `(String -> Nat)` and lowers to Rust
   `.len()`; `string-append` is checked as a two-argument `(String String ->
   String)` builtin and lowers to Rust `format!`; `bytevector-length` is checked
@@ -867,7 +867,9 @@ Minimum excluded features:
 - Generate Rust structs and enums. Initial safe Rust text emission landed.
 - Generate Rust functions. Initial primitive expression function emission
   landed, along with lowering for same-module record/variant operations and
-  exhaustive variant `match`.
+  exhaustive variant `match`. Same-type `equal?` now checks as `Bool` and
+  lowers to Rust `==`, including for generated records and variants that derive
+  `PartialEq`.
 - Generate a Cargo crate. Initial `make typed-rust` / `make typed-build`
   targets landed for a primitive typed fixture.
 - Compile generated Rust as a static or dynamic library. Initial disposable
diff --git a/lib/jerboa/typed/checker.ss b/lib/jerboa/typed/checker.ss
index 55a096c..da38f22 100644
--- a/lib/jerboa/typed/checker.ss
+++ b/lib/jerboa/typed/checker.ss
@@ -853,6 +853,27 @@
             (if (and (null? errors) (null? operand-errors)) 'Bool #f)
             (append errors operand-errors))))))
 
+  (def (infer-equality args env type-names expr)
+    (if (not (= (length args) 2))
+      (values #f
+        (list (make-check-error 'bad-primitive-arity
+                "equal? needs exactly two operands"
+                expr)))
+      (let-values ([(types errors) (infer-args args env type-names)])
+        (let ([same-type?
+               (and (car types)
+                    (cadr types)
+                    (equal? (car types) (cadr types)))])
+          (values
+            (if (and (null? errors) same-type?) 'Bool #f)
+            (append
+              errors
+              (if (or (not (null? errors)) same-type?)
+                '()
+                (list (make-check-error 'operand-type-mismatch
+                        "equal? operands must have the same type"
+                        expr)))))))))
+
   (def (infer-boolean op args env type-names expr)
     (cond
       [(and (eq? op 'not) (not (= (length args) 1)))
@@ -1130,7 +1151,9 @@
          [(+ - * /)
           (infer-arithmetic (car expr) (cdr expr) env type-names expr)]
          [(= < <= > >=)
-          (infer-comparison (car expr) (cdr expr) env type-names expr)]
+         (infer-comparison (car expr) (cdr expr) env type-names expr)]
+         [(equal?)
+          (infer-equality (cdr expr) env type-names expr)]
          [(not and or)
           (infer-boolean (car expr) (cdr expr) env type-names expr)]
          [(option-some)
diff --git a/lib/jerboa/typed/rust.ss b/lib/jerboa/typed/rust.ss
index 3b45520..6b38de3 100644
--- a/lib/jerboa/typed/rust.ss
+++ b/lib/jerboa/typed/rust.ss
@@ -920,6 +920,16 @@
       (emit-expression (car args))
       ").len() as u64"))
 
+  (def (emit-equality args)
+    (unless (= (length args) 2)
+      (error 'typed-rust "equal? expects two operands" args))
+    (string-append
+      "("
+      (emit-expression (car args))
+      " == "
+      (emit-expression (cadr args))
+      ")"))
+
   (def (emit-option-some args)
     (unless (= (length args) 1)
       (error 'typed-rust "option-some expects one operand" args))
@@ -961,6 +971,8 @@
          (emit-string-append args)]
         [(eq? name 'bytevector-length)
          (emit-bytevector-length args)]
+        [(eq? name 'equal?)
+         (emit-equality args)]
         [(eq? name 'option-some)
          (emit-option-some args)]
         [(eq? name 'option-none)
diff --git a/tests/test-typed-checker.ss b/tests/test-typed-checker.ss
index 55264ce..022e24f 100644
--- a/tests/test-typed-checker.ss
+++ b/tests/test-typed-checker.ss
@@ -849,6 +849,24 @@
          (> x 0))))
   '(operand-type-mismatch))
 
+(test "equality primitive accepts same type"
+  (error-kinds
+    '(typed-library (body equal)
+       (export f)
+       (record Box
+         ((value : Nat)))
+       (def (f (x : Nat)) : Bool
+         (equal? (make-Box x) (make-Box x)))))
+  '())
+
+(test "equality primitive rejects mismatched types"
+  (error-kinds
+    '(typed-library (body equal-bad)
+       (export f)
+       (def (f (x : Nat) (text : String)) : Bool
+         (equal? x text))))
+  '(operand-type-mismatch))
+
 (test "boolean primitive returns Bool"
   (error-kinds
     '(typed-library (body bool)
diff --git a/tests/test-typed-rust.ss b/tests/test-typed-rust.ss
index 2bf16f2..461ea74 100644
--- a/tests/test-typed-rust.ss
+++ b/tests/test-typed-rust.ss
@@ -188,6 +188,20 @@
 (define option-result-rust
   (typed-library-form->rust-string option-result-form))
 
+(define equality-form
+  '(typed-library (sample typed equality)
+     (export same-text? same-token?)
+     (variant Token
+       (Some (value : Nat))
+       (Empty))
+     (def (same-text? (a : String) (b : String)) : Bool
+       (equal? a b))
+     (def (same-token? (a : Token) (b : Token)) : Bool
+       (equal? a b))))
+
+(define equality-rust
+  (typed-library-form->rust-string equality-form))
+
 (printf "--- Typed Jerboa Rust emitter tests ---~%")
 
 (test "rust symbol sanitizes"
@@ -306,6 +320,14 @@
        (substring? option-result-rust "jt_store_handle(echo_result(r))"))
   #t)
 
+(test "rust lowers equal? primitive"
+  (and (substring? equality-rust "pub fn same_text_p(a: String, b: String) -> bool")
+       (substring? equality-rust "(a == b)")
+       (substring? equality-rust "pub fn same_token_p(a: Token, b: Token) -> bool")
+       (substring? equality-rust "#[derive(Clone, Debug, PartialEq)]")
+       (substring? equality-rust "(a == b)"))
+  #t)
+
 (printf "~%Typed Rust emitter: ~a passed, ~a failed~%" pass fail)
 (when (> fail 0)
   (exit 1))