(defsuite "algebraic-data-types" (deftest "constructor creates dict with adt marker" (do (define-type Maybe (Just value) (Nothing)) (assert= true (get (Just 42) :_adt)))) (deftest "constructor stores type name" (do (define-type Shape (Circle radius) (Square side)) (assert= "Shape" (get (Circle 5) :_type)) (assert= "Shape" (get (Square 3) :_type)))) (deftest "constructor stores constructor name" (do (define-type Opt (Some val) (None)) (assert= "Some" (get (Some 1) :_ctor)) (assert= "None" (get (None) :_ctor)))) (deftest "constructor stores fields as list" (do (define-type Pair (Pair-of fst snd)) (assert-equal (list 1 2) (get (Pair-of 1 2) :_fields)))) (deftest "zero-arg constructor has empty fields" (do (define-type Flag (Set) (Unset)) (assert-equal (list) (get (Set) :_fields)) (assert-equal (list) (get (Unset) :_fields)))) (deftest "type predicate true for all constructors" (do (define-type Expr (Num n) (Add left right) (Neg e)) (assert= true (Expr? (Num 5))) (assert= true (Expr? (Add (Num 1) (Num 2)))) (assert= true (Expr? (Neg (Num 3)))))) (deftest "type predicate false for non-adt values" (do (define-type Box (Box-of x)) (assert= false (Box? 42)) (assert= false (Box? "hello")) (assert= false (Box? nil)) (assert= false (Box? (list 1 2))) (assert= false (Box? {})))) (deftest "type predicate false for wrong adt type" (do (define-type AT (AV x)) (define-type BT (BV x)) (assert= false (AT? (BV 1))) (assert= false (BT? (AV 1))))) (deftest "constructor predicate true for matching constructor" (do (define-type Result (Ok value) (Err msg)) (assert= true (Ok? (Ok 42))) (assert= true (Err? (Err "bad"))))) (deftest "constructor predicate false for wrong constructor" (do (define-type Coin (Heads) (Tails)) (assert= false (Heads? (Tails))) (assert= false (Tails? (Heads))))) (deftest "constructor predicate false for non-adt" (do (define-type Wrap (Wrapped x)) (assert= false (Wrapped? 42)) (assert= false (Wrapped? nil)) (assert= false (Wrapped? "str")))) (deftest "single-field accessor returns field value" (do (define-type Holder (Held content)) (assert= 99 (Held-content (Held 99))) (assert= "hello" (Held-content (Held "hello"))))) (deftest "multi-field accessors return correct fields" (do (define-type Triple (Triple-of a b c)) (let ((t (Triple-of 10 20 30))) (assert= 10 (Triple-of-a t)) (assert= 20 (Triple-of-b t)) (assert= 30 (Triple-of-c t))))) (deftest "tree constructors and accessors" (do (define-type Tree (Leaf) (Node left val right)) (let ((t (Node (Leaf) 5 (Node (Leaf) 3 (Leaf))))) (assert= true (Node? t)) (assert= 5 (Node-val t)) (assert= true (Leaf? (Node-left t))) (assert= true (Node? (Node-right t))) (assert= 3 (Node-val (Node-right t)))))) (deftest "arity error on too few args" (do (define-type Pair2 (Pair2-of a b)) (let ((ok false)) (guard (exn (else (set! ok true))) (Pair2-of 1)) (assert ok)))) (deftest "arity error on too many args" (do (define-type Single (Single-of x)) (let ((ok false)) (guard (exn (else (set! ok true))) (Single-of 1 2)) (assert ok)))) (deftest "multiple types are independent" (do (define-type Color2 (Red2) (Green2) (Blue2)) (define-type Suit (Hearts) (Diamonds) (Clubs) (Spades)) (assert= false (Color2? (Hearts))) (assert= false (Suit? (Red2))) (assert= true (Color2? (Blue2))) (assert= true (Suit? (Spades))))) (deftest "adt fields can hold any value" (do (define-type Container (Hold x)) (assert-equal (list 1 2 3) (Hold-x (Hold (list 1 2 3)))) (assert-equal {:a 1} (Hold-x (Hold {:a 1}))))) (deftest "adt-registry tracks type constructor names" (do (define-type Days (Mon) (Tue) (Wed) (Thu) (Fri)) (assert-equal (list "Mon" "Tue" "Wed" "Thu" "Fri") (get *adt-registry* "Days")))) (deftest "constructors with same field name in different types are independent" (do (define-type P1 (P1-ctor value)) (define-type P2 (P2-ctor value)) (assert= 10 (P1-ctor-value (P1-ctor 10))) (assert= 20 (P2-ctor-value (P2-ctor 20))))))