speedup primes example

2 files changed, 11 insertions, 8 deletions

diff --git a/src/LambdaCube/Compiler/Core.hs b/src/LambdaCube/Compiler/Core.hs
index 76d16a66..45ebda38 100644
--- a/src/LambdaCube/Compiler/Core.hs
+++ b/src/LambdaCube/Compiler/Core.hs
@@ -240,6 +240,7 @@ conTypeName :: ConName -> TyConName
 conTypeName (ConName _ _ t) = case snd $ getParams t of TyCon n _ -> n
 
 mkFun_ md (FunName _ _ (DeltaDef ar f) _) as _ | length as == ar = f md as
+mkFun_ md f@(FunName _ _ (ExpDef e) _) xs _ = Neut $ Fun_ md f xs $ hnf $ foldlrev app_ e xs
 mkFun_ md f xs y = Neut $ Fun_ md f xs $ hnf y
 
 mkFun :: FunName -> [Exp] -> Exp -> Exp
@@ -412,14 +413,6 @@ instance MkDoc Exp where
         Let a b         -> shLet_ (pShow a) (pShow b)
         RHS x           -> text "_rhs" `DApp` mkDoc pr x
 
-showNth n = show n ++ f (n `div` 10 `mod` 10) (n `mod` 10)
-  where
-    f 1 _ = "th"
-    f _ 1 = "st"
-    f _ 2 = "nd"
-    f _ 3 = "rd"
-    f _ _ = "th"
-
 pattern FFix f <- Fun (FunName (FTag FprimFix) _ _ _) [f, _] _
 
 getFixLam (Lam (Neut (Fun s@(FunName _ loc _ _) xs _)))
diff --git a/src/LambdaCube/Compiler/Pretty.hs b/src/LambdaCube/Compiler/Pretty.hs
index 0dd09107..a357a9eb 100644
--- a/src/LambdaCube/Compiler/Pretty.hs
+++ b/src/LambdaCube/Compiler/Pretty.hs
@@ -410,3 +410,13 @@ instance PShow a => PShow (Set.Set a) where
 --instance (PShow s, PShow a) => PShow (Map s a) where
 --    pShow = braces . vcat . map (\(k, t) -> pShow k <> P.colon <+> pShow t) . Map.toList
 
+--------------------------------------------------------
+
+showNth n = show n ++ f (n `div` 10 `mod` 10) (n `mod` 10)
+  where
+    f 1 _ = "th"
+    f _ 1 = "st"
+    f _ 2 = "nd"
+    f _ 3 = "rd"
+    f _ _ = "th"
+