simplify

Author: Thomas Mahler

src/CCC/Compiler.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 
 {-- | Compilation from lambda calculus expressions (Expr) and environments
@@ -11,7 +10,14 @@
     - Function applications
 --}
 
-module CCC.Compiler where
+module CCC.Compiler
+  ( Value,
+    evalExpr,
+    compileNumExpr,
+    compileEnvironment,
+    tryCompileVar,
+    compileNumericBindings
+  ) where
 
 import           CCC.CatExpr (CatExpr (..))
 import           CCC.Rewrite (simplify)
@@ -150,7 +156,7 @@ tryCompileVar env name = case lookup name env of
 -- Collects successful numeric compilations and reports failures.
 compileNumericBindings :: Environment -> ([(String, String)], [String])
 compileNumericBindings env = 
-  let results = map (\(name, expr) -> (name, tryCompileVar env name)) env
+  let results = map (\(name, _expr) -> (name, tryCompileVar env name)) env
       successes = [(n, show m) | (n, Right m) <- results]
       failures = [e | (_, Left e) <- results]
   in (successes, failures)

src/CCC/Hask.hs

@@ -1,16 +1,14 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-{-- | Type class instances for (->) enabling interpretation of CatExpr as functions.
-    Allows categorical expressions to be evaluated as standard Haskell functions.
---}
+{-- | Instance-only module for interpreting categorical terms in the (->) category. --}
 
-module CCC.Hask where
+module CCC.Hask () where
 
 import           CCC.Cat
 import qualified CCC.Cat as Cat
 
 instance Monoidal (->) where
-  parC f g (x, y) = (f x, g y) -- this could also be implemented as `bimap f g` (imported from Data.Bifunctor)
+  parC f g (x, y) = (f x, g y)
 
 instance Cartesian (->) where
   fstC (x, _y) = x
@@ -28,11 +26,10 @@ instance NumCat (->) where
   addC = uncurry (+)
   subC = uncurry (-)
   absC = abs
-  -- Need explicit type annotations since BoolLike is polymorphic
-  leqC (x, y) = if x <= y then true else false
-  geqC (x, y) = if x >= y then true else false
-  lesC (x, y) = if x < y then true else false
-  greC (x, y) = if x > y then true else false
+  leqC = ordPred (<=)
+  geqC = ordPred (>=)
+  lesC = ordPred (<)
+  greC = ordPred (>)
 
 instance BoolCat (->) where
   andC = uncurry (Cat.&&)
@@ -47,6 +44,8 @@ instance IfValCat (->) where
   ifValC (test, (t, e)) = if test then t else e
 
 instance FixCat (->) where
-  -- The step function takes (rec, input) and produces output
-  -- We tie the knot by making rec = fixC step
-  fixC step = let f a = step (f, a) in f
+  fixC step = let f a = step (f, a) in f
+
+-- BoolLike result type prevents using plain uncurry comparison directly.
+ordPred :: (Ord a, BoolLike b) => (a -> a -> Bool) -> (a, a) -> b
+ordPred op (x, y) = if op x y then true else false