Some comments and signatures.

3 files changed, 65 insertions, 7 deletions

diff --git a/src/LambdaCube/Compiler.hs b/src/LambdaCube/Compiler.hs
index 6a65c811..f87f3a3d 100644
--- a/src/LambdaCube/Compiler.hs
+++ b/src/LambdaCube/Compiler.hs
@@ -13,6 +13,9 @@ module LambdaCube.Compiler
     , IR.Pipeline
     , module Exported
 
+    , MName
+    , SourceCode
+    , ModuleFetcher
     , MMT, runMMT, mapMMT
     , MM, runMM
     , ioFetch, decideFilePath
@@ -58,6 +61,7 @@ import LambdaCube.Compiler.CoreToIR
 import LambdaCube.Compiler.Utils
 import LambdaCube.Compiler.DesugaredSource as Exported (FileInfo(..), Range(..), SPos(..), pattern SPos, SIName(..), pattern SIName, sName, SI(..))
 import LambdaCube.Compiler.Core as Exported (mkDoc, Exp, ExpType(..), pattern ET, outputType, boolType, trueExp, hnf, closeExp, closeExpType)
+import qualified LambdaCube.Compiler.Core as Core
 import LambdaCube.Compiler.InferMonad as Exported (errorRange, listAllInfos, listAllInfos', listTypeInfos, listErrors, listWarnings, listTraceInfos, Infos, Info(..))
 --import LambdaCube.Compiler.Infer as Exported ()
 
@@ -66,8 +70,13 @@ import Paths_lambdacube_compiler (getDataDir)
 
 --------------------------------------------------------------------------------
 
+-- | The name of module.
 type MName = String
+
+-- | The name of a symbol defined in a module.
 type SName = String
+
+-- | The source code of a module.
 type SourceCode = String
 
 -- file name or module name?
@@ -77,14 +86,21 @@ decideFilePath n
 
 dropExtension' e f
     | takeExtension f == e = dropExtension f
-    | otherwise = error $ "dropExtension: expcted extension: " ++ e ++ " ; filename: " ++ f
+    | otherwise = error $ "dropExtension: expected extension: " ++ e ++ " ; filename: " ++ f
 
+-- | Removes the .lc filename extension and replaces path seperators with dots.
+--
+-- It is a run-time error to pass a string that does not end with the ".lc"
+-- suffix.
+fileNameToModuleName :: String -> String
 fileNameToModuleName n
     = intercalate "." $ remDot $ (\(a, b) -> map takeDirectory (splitPath a) ++ [b]) $ splitFileName $ dropExtension' ".lc" $ normalise n
   where
     remDot (".": xs) = xs
     remDot xs = xs
 
+-- | Converts dots into path separators and appends a .lc filename extension.
+moduleNameToFileName :: String -> String
 moduleNameToFileName n = hn n ++ ".lc"
   where
     hn = h []
@@ -92,10 +108,18 @@ moduleNameToFileName n = hn n ++ ".lc"
     h acc ('.':cs) = reverse acc </> hn cs
     h acc (c: cs) = h (c: acc) cs
 
-type ModuleFetcher m = Maybe FilePath -> Either FilePath MName -> m (Either Doc (FilePath, MName, m SourceCode))
+-- | This function can be used with 'runMM' to customize how the compiler
+-- resolves module names.
+type ModuleFetcher m = Maybe FilePath           -- ^ The file that is importing this module.
+                       -> Either FilePath MName -- ^ Module or file name to load.
+                       -> m (Either Doc (FilePath, MName, m SourceCode))
 
+-- | Provides a ModuleFetcher that ignores its first argument and searches a
+-- fixed list of paths to find a module file to parse.
+--
+-- This is the default module fetcher that is used by 'compileMain'.
 ioFetch :: MonadIO m => [FilePath] -> ModuleFetcher (MMT m x)
-ioFetch paths' imp n = do
+ioFetch paths' _ n = do
     preludePath <- (</> "lc") <$> liftIO getDataDir
     let paths = map (id &&& id) paths' ++ [(preludePath, "<<installed-prelude-path>>")]
         find ((x, (x', mn)): xs) = liftIO (readFileIfExists x) >>= maybe (find xs) (\src -> return $ Right (x, mn, liftIO src))
@@ -103,14 +127,22 @@ ioFetch paths' imp n = do
                                   <+> "in path" <+> hsep (text . snd <$> paths)
     find $ nubBy ((==) `on` fst) $ map (first normalise . lcModuleFile) paths
   where
+    -- Given (path,symbolicPath) where modules might be stored,
+    -- returns candidate (fullFilePath,(symbolicFilePath,moduleName)) for module of interest.
     lcModuleFile (path, path') = case n of
         Left n  -> (path </> n, (path' </> n, fileNameToModuleName n))
         Right n -> (path </> moduleNameToFileName n, (path' </> moduleNameToFileName n, n))
 
 --------------------------------------------------------------------------------
 
+-- | A monad with an associated 'ModuleFetcher' for the compiler to resolve
+-- module names into filepaths and a 'Modules' state which caches parsed
+-- modules.
 newtype MMT m x a = MMT { runMMT :: ReaderT (ModuleFetcher (MMT m x)) (StateT (Modules x) m) a }
-    deriving (Functor, Applicative, Monad, MonadReader (ModuleFetcher (MMT m x)), MonadState (Modules x), MonadIO, MonadThrow, MonadCatch, MonadMask)
+    deriving ( Functor, Applicative, Monad
+             , MonadReader (ModuleFetcher (MMT m x))
+             , MonadState (Modules x)
+             , MonadIO, MonadThrow, MonadCatch, MonadMask )
 
 type MM = MMT IO Infos
 
@@ -136,7 +168,10 @@ data Modules x = Modules
     , nextMId   :: !Int
     }
 
-loadModule :: MonadMask m => ((Infos, [Stmt]) -> x) -> Maybe FilePath -> Either FilePath MName -> MMT m x (Either Doc (FileInfo, Module' x))
+loadModule :: MonadMask m => ((Infos, [Stmt]) -> x)
+                             -> Maybe FilePath        -- ^ The file requesting the module.
+                             -> Either FilePath MName -- ^ The module to load.
+                             -> MMT m x (Either Doc (FileInfo, Module' x))
 loadModule ex imp mname_ = do
   r <- ask >>= \fetch -> fetch imp mname_
   case r of
@@ -195,6 +230,12 @@ loadModule ex imp mname_ = do
 getDef :: MonadMask m => FilePath -> SName -> Maybe Exp -> MMT m (Infos, [Stmt]) ((Infos, [Stmt]), Either Doc (FileInfo, Either Doc ExpType))
 getDef = getDef_ id
 
+getDef_ :: (MonadMask m, Monoid a) =>
+                 ((Infos, [Stmt]) -> a)
+                 -> FilePath        -- ^ Path to module.
+                 -> SName           -- ^ Name of symbol to fetch.
+                 -> Maybe Core.Type -- ^ Type of symbol to fetch.
+                 -> MMT m a (a, Either Doc (FileInfo, Either Doc ExpType))
 getDef_ ex m d ty = loadModule ex Nothing (Left m) <&> \case
     Left err -> (mempty, Left err)
     Right (fname, (src, Left err)) -> (mempty, Left err)
@@ -209,6 +250,10 @@ getDef_ ex m d ty = loadModule ex Nothing (Left m) <&> \case
           Nothing -> Left $ text d <+> "is not found"
         )
 
+compilePipeline' :: (MonadMask m, Monoid a) =>
+                          ((Infos, [Stmt]) -> a)
+                          -> IR.Backend -> FilePath
+                          -> MMT m a (a, Either Doc IR.Pipeline)
 compilePipeline' ex backend m
     = second (either Left (fmap (compilePipeline backend) . snd)) <$> getDef_ ex m "main" (Just outputType)
 
diff --git a/src/LambdaCube/Compiler/Core.hs b/src/LambdaCube/Compiler/Core.hs
index 83438bb9..744bc5e7 100644
--- a/src/LambdaCube/Compiler/Core.hs
+++ b/src/LambdaCube/Compiler/Core.hs
@@ -285,6 +285,13 @@ reduce _ = Nothing
 hnf (Reduced y) = hnf y  -- TODO: review hnf call here
 hnf a = a
 
+-- | Output is an existential type which wraps a framebuffer.
+--
+-- > data Output where
+-- >   ScreenOut           :: FrameBuffer a b -> Output
+--
+-- This is the run-time representation of that type.
+outputType :: Exp
 outputType = tTyCon0 F'Output []
 
 -- TODO: remove
diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs
index 4a96c141..2ad8d26d 100644
--- a/src/LambdaCube/Compiler/CoreToIR.hs
+++ b/src/LambdaCube/Compiler/CoreToIR.hs
@@ -48,7 +48,13 @@ import Paths_lambdacube_compiler (version)
 
 --------------------------------------------------------------------------
 
-compilePipeline :: IR.Backend -> I.ExpType -> IR.Pipeline
+-- | Compile a parsed (and typed) expression into the intermediate
+-- representation interpreted by the rendering engine.
+--
+-- Note: 'error' will be called if the given expression is not of type Output.
+compilePipeline :: IR.Backend
+                   -> I.ExpType -- ^ Either a 'ScreenOut' or 'TextureOut' expression (typically main).
+                   -> IR.Pipeline
 compilePipeline backend exp = IR.Pipeline
     { IR.info       = "generated by lambdacube-compiler " ++ showVersion version
     , IR.backend    = backend
@@ -812,7 +818,7 @@ data Uniform
 
 type Uniforms = Map String (Uniform, IR.InputType)
 
-tellUniform :: (MonadWriter (a, b) m, Monoid b) => a -> m ()
+tellUniform :: Uniforms -> WriterT (Uniforms, Map SName (ExpTV, ExpTV, [ExpTV])) (State [String]) ()
 tellUniform x = tell (x, mempty)
 
 simpleExpr :: ExpTV -> Bool