add postulate, #[compile-scheme], #[main]

exe/Main.idr

@@ -58,16 +58,19 @@ newState = pure $ MkState {
 }
 
 private
-data Error
-  = ParseError String Parser.Error
-  | FromParserError FromParser.Error
-  | EraseError Erase.Error
-  | WriteError FilePath FileError
+data Error =
+  ParseError String Parser.Error
+| FromParserError FromParser.Error
+| EraseError Erase.Error
+| WriteError FilePath FileError
+| NoMain
+| MultipleMains (List Id)
 %hide FromParser.Error
 %hide Erase.Error
 %hide Lexer.Error
 %hide Parser.Error
 
+
 private
 loadError : Loc -> FilePath -> FileError -> Error
 loadError loc file err = FromParserError $ LoadError loc file err
@@ -77,6 +80,10 @@ prettyError : {opts : LayoutOpts} -> Error -> Eff Pretty (Doc opts)
 prettyError (ParseError file e) = prettyParseError file e
 prettyError (FromParserError e) = FromParser.prettyError True e
 prettyError (EraseError      e) = Erase.prettyError True e
+prettyError NoMain              = pure "no #[main] function given"
+prettyError (MultipleMains xs)  =
+  pure $ sep ["multiple #[main] functions given:",
+              separateLoose "," !(traverse prettyId xs)]
 prettyError (WriteError file e) = pure $
   hangSingle 2 (text "couldn't write file \{file}:") (pshow e)
 
@@ -133,9 +140,10 @@ outputStr str =
       rethrow $ mapFst (WriteError f) res
 
 private
-outputDocs : {opts : LayoutOpts} -> List (Doc opts) -> Eff Compile ()
-outputDocs {opts = Opts _} doc =
-  outputStr $ concat $ map (render _) doc
+outputDocs : (opts : Options) ->
+             ({opts : LayoutOpts} -> List (Doc opts)) -> Eff Compile ()
+outputDocs opts doc =
+  outputStr $ concat $ map (render (Opts opts.width)) doc
 
 private
 outputDocStopIf : Phase ->
@@ -144,7 +152,7 @@ outputDocStopIf : Phase ->
 outputDocStopIf p docs = do
   opts <- askAt OPTS
   when (opts.until == Just p) $ Prelude.do
-    lift $ outputDocs (runPretty opts docs) {opts = Opts opts.width}
+    lift $ outputDocs !(askAt OPTS) (runPretty opts docs)
     stopHere
 
 private
@@ -166,10 +174,19 @@ liftErase defs act =
      handleStateIORef !(asksAt STATE suf)]
 
 private
-liftScheme : Eff Scheme a -> Eff CompileStop a
-liftScheme act = runEff act [handleStateIORef !(newIORef empty)]
+liftScheme : Eff Scheme a -> Eff CompileStop (a, List Id)
+liftScheme act = do
+  runEff [|MkPair act (getAt MAIN)|]
+    [handleStateIORef !(newIORef empty),
+     handleStateIORef !(newIORef [])]
 
 
+private
+oneMain : Has (Except Error) fs => List Id -> Eff fs Id
+oneMain []    = throw NoMain
+oneMain [x]   = pure x
+oneMain mains = throw $ MultipleMains mains
+
 private
 processFile : String -> Eff Compile ()
 processFile file = withEarlyStop $ do
@@ -187,11 +204,16 @@ processFile file = withEarlyStop $ do
     traverse (\(x, d) => (x,) <$> eraseDef x d) defList
   outputDocStopIf Erase $
     traverse (uncurry U.prettyDef) erased
-  scheme <- liftScheme $ map catMaybes $
+  (scheme, mains) <- liftScheme $ map catMaybes $
     traverse (uncurry defToScheme) erased
   outputDocStopIf Scheme $
-    (text Scheme.prelude ::) <$> traverse prettySexp scheme
-  die "that's all folks"
+    intersperse empty <$> traverse prettySexp scheme
+  opts <- askAt OPTS
+  main <- oneMain mains
+  lift $ outputDocs opts $ intersperse empty $ runPretty opts $ do
+    res    <- traverse prettySexp scheme
+    runner <- makeRunMain main
+    pure $ text Scheme.prelude :: res ++ [runner]
 
 export
 main : IO ()