@@ -62,7 +62,7 @@ compile codegen f tm
62 -- iputStrLn $ showSep "\n" (map show defs)
62 -- iputStrLn $ showSep "\n" (map show defs)
63 -- Inlined top level LDecl made here
63 -- Inlined top level LDecl made here
64 let defsInlined = inlineAll defs
64 let defsInlined = inlineAll defs
65− let defsUniq = map (allocUnique (addAlist defsInlined emptyContext))
65+ let defsUniq = map (allocUnique (addAlist defsInlined emptyContext))
66 defsInlined
66 defsInlined
68 let (nexttag, tagged) = addTags 65536 (liftAll defsUniq)
68 let (nexttag, tagged) = addTags 65536 (liftAll defsUniq)
@@ -91,13 +91,13 @@ compile codegen f tm
91 iLOG "Building output"
91 iLOG "Building output"
93 case checked of
93 case checked of
94− OK c -> do return $ CodegenInfo f outty triple cpu
94+ OK c -> do return $ CodegenInfo f outty triple cpu
95 hdrs impdirs objs libs flags
95 hdrs impdirs objs libs flags
96 NONE c (toAlist defuns)
96 NONE c (toAlist defuns)
98-- runIO $ case codegen of
98-- runIO $ case codegen of
99-- ViaC -> codegenC cginfo
99-- ViaC -> codegenC cginfo
100−-- ViaJava -> codegenJava cginfo
100+-- ViaJava -> codegenJava cginfo
101-- ViaJavaScript -> codegenJavaScript cginfo
101-- ViaJavaScript -> codegenJavaScript cginfo
102-- ViaNode -> codegenNode cginfo
102-- ViaNode -> codegenNode cginfo
103-- ViaLLVM -> codegenLLVM cginfo
103-- ViaLLVM -> codegenLLVM cginfo
@@ -116,10 +116,10 @@ compile codegen f tm
116 if ex then return f else return h
116 if ex then return f else return h
118generate :: Codegen -> FilePath -> CodegenInfo -> IO ()
118generate :: Codegen -> FilePath -> CodegenInfo -> IO ()
119−generate codegen mainmod ir
119+generate codegen mainmod ir
120 = case codegen of
120 = case codegen of
121 -- Built-in code generators (FIXME: lift these out!)
121 -- Built-in code generators (FIXME: lift these out!)
122− Via "c" -> codegenC ir
122+ Via "c" -> codegenC ir
123 -- Any external code generator
123 -- Any external code generator
124 Via cg -> do let cmd = "idris-" ++ cg ++ " " ++ mainmod ++
124 Via cg -> do let cmd = "idris-" ++ cg ++ " " ++ mainmod ++
125 " -o " ++ outputFile ir
125 " -o " ++ outputFile ir
@@ -195,7 +195,7 @@ mkLDecl n (CaseOp ci _ _ _ pats cd)
196 (args, sc) = cases_runtime cd
196 (args, sc) = cases_runtime cd
198− -- Always attempt to inline functions arising from 'case' expressions
198+ -- Always attempt to inline functions arising from 'case' expressions
199 caseName (SN (CaseN _)) = True
199 caseName (SN (CaseN _)) = True
200 caseName (SN (WithN _ _)) = True
200 caseName (SN (WithN _ _)) = True
201 caseName (NS n _) = caseName n
201 caseName (NS n _) = caseName n
@@ -284,7 +284,7 @@ irTerm vs env tm@(App f a) = case unApply tm of
284 x' <- irTerm vs env x
284 x' <- irTerm vs env x
285 t' <- irTerm vs env t
285 t' <- irTerm vs env t
286 e' <- irTerm vs env e
286 e' <- irTerm vs env e
287− return (LCase Shared x'
287+ return (LCase Shared x'
288 [LConCase 0 (sNS (sUN "False") ["Bool","Prelude"]) [] e'
288 [LConCase 0 (sNS (sUN "False") ["Bool","Prelude"]) [] e'
289 ,LConCase 1 (sNS (sUN "True" ) ["Bool","Prelude"]) [] t'
289 ,LConCase 1 (sNS (sUN "True" ) ["Bool","Prelude"]) [] t'
@@ -425,7 +425,7 @@ irTerm vs env (Bind _ _ _) = return $ LNothing
426irTerm vs env (Proj t (-1)) = do
426irTerm vs env (Proj t (-1)) = do
427 t' <- irTerm vs env t
427 t' <- irTerm vs env t
428− return $ LOp (LMinus (ATInt ITBig))
428+ return $ LOp (LMinus (ATInt ITBig))
429 [t', LConst (BI 1)]
429 [t', LConst (BI 1)]
431irTerm vs env (Proj t i) = LProj <$> irTerm vs env t <*> pure i
431irTerm vs env (Proj t i) = LProj <$> irTerm vs env t <*> pure i
@@ -458,13 +458,13 @@ doForeign vs env (_ : fgn : args)
458 | fi == txt "FIntT"
458 | fi == txt "FIntT"
459 = mkIntIty (str intTy)
459 = mkIntIty (str intTy)
461− mkIty' (App (App (P _ (UN ff) _) _) (App (P _ (UN fa) _) (App (P _ (UN io) _) _)))
461+ mkIty' (App (App (P _ (UN ff) _) _) (App (P _ (UN fa) _) (App (P _ (UN io) _) _)))
462 | ff == txt "FFunction"
462 | ff == txt "FFunction"
463 , fa == txt "FAny"
463 , fa == txt "FAny"
464− , io == txt "IO"
464+ , io == txt "IO"
465 = FFunctionIO
465 = FFunctionIO
467− mkIty' (App (App (P _ (UN ff) _) _) _)
467+ mkIty' (App (App (P _ (UN ff) _) _) _)
468 | ff == txt "FFunction"
468 | ff == txt "FFunction"
469 = FFunction
469 = FFunction
@@ -472,7 +472,8 @@ doForeign vs env (_ : fgn : args)
473 -- would be better if these FInt types were evaluated at compile time
473 -- would be better if these FInt types were evaluated at compile time
474 -- TODO: add %eval directive for such things
474 -- TODO: add %eval directive for such things
475−
475+ -- Issue #1742 on the issue tracker.
476+ -- https://github.com/idris-lang/Idris-dev/issues/1742
476 mkIty "FFloat" = FArith ATFloat
477 mkIty "FFloat" = FArith ATFloat
477 mkIty "FInt" = mkIntIty "ITNative"
478 mkIty "FInt" = mkIntIty "ITNative"
478 mkIty "FChar" = mkIntIty "ITChar"
479 mkIty "FChar" = mkIntIty "ITChar"
@@ -521,7 +522,7 @@ irSC vs (Case up n [ConCase (UN delay) i [_, _, n'] sc])
521 | delay == txt "Delay"
522 | delay == txt "Delay"
522 = do sc' <- irSC vs $ mkForce n' n sc
523 = do sc' <- irSC vs $ mkForce n' n sc
523 return $ LLet n' (LForce (LV (Glob n))) sc'
524 return $ LLet n' (LForce (LV (Glob n))) sc'
525-- There are two transformations in this case:
526-- There are two transformations in this case:
527-- 1. Newtype-case elimination:
528-- 1. Newtype-case elimination: