git.iko.soy/Idris-dev
on master help sign in
Don't inline for compilation (because the evaluator makes bad choices)
dad12e6Edwin Brady
src/Core/CaseTree.hs+1−1
compare with master
unifiedsplit
@@ -80,7 +80,7 @@ instance TermSize CaseAlt where
80small :: Name -> [Name] -> SC -> Bool
80small :: Name -> [Name] -> SC -> Bool
81small n args t = let as = findAllUsedArgs t args in
81small n args t = let as = findAllUsedArgs t args in
82 length as == length (nub as) &&
82 length as == length (nub as) &&
83− termsize n t < 5
83+ termsize n t < 10
84
84
85namesUsed :: SC -> [Name]
85namesUsed :: SC -> [Name]
86namesUsed sc = nub $ nu' [] sc where
86namesUsed sc = nub $ nu' [] sc where
src/Core/Evaluate.hs+1−1
@@ -178,7 +178,7 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where
178 = do v' <- ev ntimes stk top env v --(finalise v)
178 = do v' <- ev ntimes stk top env v --(finalise v)
179 sc' <- ev ntimes stk top (v' : env) sc
179 sc' <- ev ntimes stk top (v' : env) sc
180 wknV (-1) sc'
180 wknV (-1) sc'
181− | otherwise -- put this back when the Bind works properly
181+ | otherwise
182 = do t' <- ev ntimes stk top env t
182 = do t' <- ev ntimes stk top env t
183 v' <- ev ntimes stk top env v --(finalise v)
183 v' <- ev ntimes stk top env v --(finalise v)
184 -- use Tmp as a placeholder, then make it a variable reference
184 -- use Tmp as a placeholder, then make it a variable reference
src/IRTS/Compiler.hs+8−1
@@ -291,13 +291,20 @@ mkIty' (App (App (P _ (UN "FFunction") _) _) (App (P _ (UN "FAny") _) (App (P _
291mkIty' (App (App (P _ (UN "FFunction") _) _) _) = FFunction
291mkIty' (App (App (P _ (UN "FFunction") _) _) _) = FFunction
292mkIty' _ = FAny
292mkIty' _ = FAny
293
293
294+-- would be better if these FInt types were evaluated at compile time
295+-- TODO: add %eval directive for such things
296+
294mkIty "FFloat" = FDouble
297mkIty "FFloat" = FDouble
295−mkIty "FChar" = FChar
298+mkIty "FInt" = mkIntIty "ITNative"
299+mkIty "FChar" = mkIntIty "IT8"
300+mkIty "FShort" = mkIntIty "IT16"
301+mkIty "FLong" = mkIntIty "IT64"
296mkIty "FString" = FString
302mkIty "FString" = FString
297mkIty "FPtr" = FPtr
303mkIty "FPtr" = FPtr
298mkIty "FUnit" = FUnit
304mkIty "FUnit" = FUnit
299mkIty "FFunction" = FFunction
305mkIty "FFunction" = FFunction
300mkIty "FFunctionIO" = FFunctionIO
306mkIty "FFunctionIO" = FFunctionIO
307+mkIty x = error $ "Unknown type " ++ x
301
308
302mkIntIty "ITNative" = FInt ITNative
309mkIntIty "ITNative" = FInt ITNative
303mkIntIty "IT8" = FInt IT8
310mkIntIty "IT8" = FInt IT8
src/Idris/ElabDecls.hs+3−3
@@ -600,9 +600,9 @@ elabClauses info fc opts n_in cs = let n = liftname info n_in in
600
600
601 getLHS (_, l, _) = l
601 getLHS (_, l, _) = l
602
602
603+-- simpl rt ctxt (Right (x, y)) = Right (normalise ctxt [] x,
604+-- simplify ctxt rt [] y)
603− simpl rt ctxt (Right (x, y)) = Right (normalise ctxt [] x,
605+ simpl rt ctxt (Right (x, y)) = Right (normalise ctxt [] x, y)
604− simplify ctxt rt [] y)
605−-- simpl rt ctxt (Right (x, y)) = Right (x, y)
606 simpl rt ctxt t = t
606 simpl rt ctxt t = t
607
607
608 sameLength ((_, x, _) : xs)
608 sameLength ((_, x, _) : xs)