lude

commit e2aebea409d0682ea935e85df897fe7e79de926f
parent 498b7dd4b09f2491997df1e0e7f3ef85e6d0a00f
Author: Robert Russell <robert@rr3.xyz>
Date:   Wed, 14 Oct 2026 16:20:06 -0700

Haskell.Functional: add Box type to Functional# class, and use CPP for Functional# instances

Diffstat:
M
src/Lude/Haskell/Functional.hs
 | 
46
++++++++++++++++++++++++++++++----------------

1 file changed, 30 insertions(+), 16 deletions(-)
diff --git a/src/Lude/Haskell/Functional.hs b/src/Lude/Haskell/Functional.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module Lude.Haskell.Functional (
     Lev,
     Functional# (..),
@@ -13,6 +15,9 @@ import Lude.Haskell.Core
 import Lude.Haskell.Repr qualified as Repr
 import Lude.Haskell.Type
 
+-- TODO: Replace Lev with Box in lam# and app#?
+-- It's less convenient but more efficient for boxed types.
+
 --------------------------------------------------------------------------------
 
 -- | Transparently box a type of any representation
@@ -28,6 +33,9 @@ type Lev a = (GHC.CTuple0) => a
 
 type Functional# :: Repr -> Constraint
 class Functional# r where
+    data Box :: Type# r -> Type
+    mkBox# :: forall (a :: Type# r). a -> Box a
+    unBox# :: forall (a :: Type# r). Box a -> a
     lam# :: forall (a :: Type# r) {s :: Repr} (b :: Type# s). (Lev a -> b) -> (a -> b)
     app# :: forall (a :: Type# r) {s :: Repr} (b :: Type# s). (a -> b) -> (Lev a -> b)
 
@@ -47,20 +55,26 @@ app2# f x y = f `app#` x `app#` y
 
 --------------------------------------------------------------------------------
 
-instance Functional# Repr.BoxL where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.BoxE where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Addr where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Int where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Int8 where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Int16 where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Int32 where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Int64 where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Nat where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Nat8 where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Nat16 where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Nat32 where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Nat64 where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Flt32 where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
-instance Functional# Repr.Flt64 where lam# f = \x -> f x; {-# INLINE lam# #-}; app# f = \x -> f x; {-# INLINE app# #-}
+#define FUNCTIONAL(R, DECLARE, C)\
+instance Functional# Repr.R where\
+    DECLARE Box @Repr.R a = C a;\
+    mkBox# = C; {-# INLINE mkBox# #-};\
+    unBox# (C x) = x; {-# INLINE unBox# #-};\
+    lam# f = \x -> f x; {-# INLINE lam# #-};\
+    app# f = \x -> f x; {-# INLINE app# #-}
 
--- TODO: Tuple and Sum instances? There're infinitely many :(
+FUNCTIONAL(BoxL, newtype, MkBoxLBox)
+FUNCTIONAL(BoxE, data, MkBoxEBox)
+FUNCTIONAL(Addr, data, MkAddrBox)
+FUNCTIONAL(Int, data, MkIntBox)
+FUNCTIONAL(Int8, data, MkInt8Box)
+FUNCTIONAL(Int16, data, MkInt16Box)
+FUNCTIONAL(Int32, data, MkInt32Box)
+FUNCTIONAL(Int64, data, MkInt64Box)
+FUNCTIONAL(Nat, data, MkNatBox)
+FUNCTIONAL(Nat8, data, MkNat8Box)
+FUNCTIONAL(Nat16, data, MkNat16Box)
+FUNCTIONAL(Nat32, data, MkNat32Box)
+FUNCTIONAL(Nat64, data, MkNat64Box)
+FUNCTIONAL(Flt32, data, MkFlt32Box)
+FUNCTIONAL(Flt64, data, MkFlt64Box)