Commit 74844cea authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Improved generation of HTML documentation

parent 5c92a0cb
......@@ -12,91 +12,71 @@
This module provides an API for dealing with several kinds of Curry
program representations.
-}
module Frontend (parse, fullParse) where
-- TODO: Should be updated/refactored
import Control.Monad.Writer
import Data.Maybe (mapMaybe)
import qualified Data.Map as Map (empty)
module Frontend (parse, fullParse, typingParse) where
import Data.Maybe (mapMaybe)
import qualified Data.Map as Map (empty)
import Control.Monad.Writer
import Curry.Base.MessageMonad
import Curry.Files.Filenames
import Curry.Files.PathUtils
import Curry.Syntax (Module (..), parseModule)
import Checks
import CompilerEnv
import CompilerOpts (Options (..), Verbosity (..), TargetType (..), defaultOptions)
import Checks (CheckResult (..))
import CompilerOpts (Options (..), defaultOptions)
import CurryBuilder (smake)
import CurryDeps (Source (..), flattenDeps, moduleDeps)
import Imports (importModules)
import Interfaces (loadInterfaces)
import Modules
import CurryDeps (Source (..), flattenDeps, moduleDeps)
import Modules (checkModule, checkModuleHeader, compileModule, loadModule)
{- |Return the result of a syntactical analysis of the source program 'src'.
The result is the syntax tree of the program (type 'Module'; see Module
"CurrySyntax").
-}
parse :: FilePath -> String -> MsgMonad Module
parse fn src = parseModule True fn src >>= genCurrySyntax fn
parse fn src = parseModule True fn src >>= genCurrySyntax
where
genCurrySyntax mod1
| null hdrErrs = return mdl
| otherwise = failWith $ show $ head hdrErrs
where (mdl, hdrErrs) = checkModuleHeader defaultOptions fn mod1
{- |Return the syntax tree of the source program 'src' (type 'Module'; see
Module "CurrySyntax") after resolving the category (i.e. function,
constructor or variable) of an identifier. 'fullParse' always
searches for standard Curry libraries in the path defined in the
Module "CurrySyntax").after inferring the types of identifiers.
'fullParse' always searches for standard Curry libraries in the path
defined in the
environment variable "PAKCSLIBPATH". Additional search paths can
be defined using the argument 'paths'.
-}
fullParse :: [FilePath] -> FilePath -> String -> IO (MsgMonad Module)
fullParse paths fn src = genFullCurrySyntax checkModule paths fn $ parse fn src
{- |Behaves like 'fullParse', but returns the syntax tree of the source
program 'src' (type 'Module'; see Module "CurrySyntax") after inferring
the types of identifiers.
-}
typingParse :: [FilePath] -> FilePath -> String -> IO (MsgMonad Module)
typingParse paths fn src = genFullCurrySyntax checkModule paths fn $ parse fn src
fullParse :: Options -> FilePath -> String -> IO (MsgMonad Module)
fullParse opts fn src = genFullCurrySyntax opts fn $ parse fn src
--
genCurrySyntax :: FilePath -> Module -> MsgMonad Module
genCurrySyntax fn mod1
| null hdrErrs = return mdl
| otherwise = failWith $ show $ head hdrErrs
where (mdl, hdrErrs) = checkModuleHeader defaultOptions fn mod1
--
genFullCurrySyntax ::
(Options -> CompilerEnv -> Module -> CheckResult (CompilerEnv, Module))
-> [FilePath] -> FilePath -> MsgMonad Module -> IO (MsgMonad Module)
genFullCurrySyntax check paths fn m = runMsgIO m $ \mod1 -> do
errs <- makeInterfaces paths fn mod1
genFullCurrySyntax :: Options -> FilePath -> MsgMonad Module -> IO (MsgMonad Module)
genFullCurrySyntax opts fn m = runMsgIO m $ \mod1 -> do
errs <- makeInterfaces opts fn mod1
if null errs
then do
(iEnv, intfErrs) <- loadInterfaces paths mod1
unless (null intfErrs) $ failWith $ msgTxt $ head intfErrs
let env = importModules opts mod1 iEnv
case check opts env mod1 of
CheckSuccess (_, mod') -> return (return mod')
loaded <- loadModule opts fn
case checkModule opts loaded of
CheckFailed errs' -> return $ failWith $ msgTxt $ head errs'
CheckSuccess (_, mod') -> return (return mod')
else return $ failWith $ head errs
where opts = mkOpts paths
-- TODO: Resembles CurryBuilder
-- Generates interface files for importes modules, if they don't exist or
-- if they are not up-to-date.
makeInterfaces :: [FilePath] -> FilePath -> Module -> IO [String]
makeInterfaces paths fn mdl = do
(deps1, errs) <- fmap flattenDeps $ moduleDeps (mkOpts paths) Map.empty fn mdl
makeInterfaces :: Options -> FilePath -> Module -> IO [String]
makeInterfaces opts fn mdl = do
(deps1, errs) <- fmap flattenDeps $ moduleDeps opts Map.empty fn mdl
when (null errs) $ mapM_ (compile deps1 . snd) deps1
return errs
where
compile deps' (Source file' mods) = smake
[flatName file', flatIntName file']
(file':mapMaybe (flatInterface deps') mods)
(compileModule (mkOpts paths) file')
(compileModule opts file')
(return ())
compile _ _ = return ()
......@@ -104,11 +84,3 @@ makeInterfaces paths fn mdl = do
Just (Source f _) -> Just $ flatIntName $ dropExtension f
Just (Interface f) -> Just $ flatIntName $ dropExtension f
_ -> Nothing
mkOpts :: [FilePath] -> Options
mkOpts paths = defaultOptions
{ optImportPaths = paths
, optVerbosity = VerbQuiet
, optWarn = False
, optTargetTypes = [AbstractCurry]
}
......@@ -24,8 +24,9 @@ import Curry.Syntax (lexFile)
import Html.SyntaxColoring
import CompilerOpts (Options(..))
import Frontend (parse, typingParse, fullParse)
import Base.Messages (abortWith)
import CompilerOpts (Options(..), TargetType (..))
import Frontend (parse, fullParse)
--- translate source file into HTML file with syntaxcoloring
......@@ -41,7 +42,7 @@ source2html opts sourcefilename = do
else outputfilename
modulname = takeFileName sourceprogname
fullfname <- lookupCurryFile imports sourcefilename
program <- filename2program imports (fromMaybe sourcefilename fullfname)
program <- filename2program opts (fromMaybe sourcefilename fullfname)
(if null outputfilename then writeModule True output'
else writeFile output')
(program2html modulname program)
......@@ -49,14 +50,17 @@ source2html opts sourcefilename = do
--- @param importpaths
--- @param filename
--- @return program
filename2program :: [String] -> String -> IO Program
filename2program paths filename = do
(Just cont) <- readModule filename
typingParseRes <- catchError $ typingParse paths filename cont
fullParseRes <- catchError $ fullParse paths filename cont
parseRes <- catchError $ return (parse filename cont)
lexRes <- catchError $ return (lexFile filename cont)
return $ genProgram cont [typingParseRes, fullParseRes, parseRes] lexRes
filename2program :: Options -> String -> IO Program
filename2program opts filename = do
mbModule <- readModule filename
case mbModule of
Nothing -> abortWith ["Missing file: " ++ filename]
Just cont -> do
typingParseRes <- catchError $ fullParse opts filename cont
fullParseRes <- catchError $ fullParse (opts { optTargetTypes = [UntypedAbstractCurry]}) filename cont
parseRes <- catchError $ return (parse filename cont)
lexRes <- catchError $ return (lexFile filename cont)
return $ genProgram cont [typingParseRes, fullParseRes, parseRes] lexRes
--- this function intercepts errors and converts it to Messages
......
......@@ -15,7 +15,7 @@
-}
module Modules
( compileModule, loadModule, checkModuleHeader, checkModule
( compileModule, loadModule, checkModuleHeader, checkModule, writeOutput
) where
import Control.Monad (unless, when)
......@@ -73,26 +73,30 @@ import Transformations
compileModule :: Options -> FilePath -> IO ()
compileModule opts fn = do
loaded <- loadModule opts fn
case uncurry (checkModule opts) loaded of
case checkModule opts loaded of
CheckFailed errs -> abortWith $ map show errs
CheckSuccess (env, modul) -> do
showWarnings opts $ uncurry warnCheck loaded
writeParsed opts fn modul
writeAbstractCurry opts fn env modul
when withFlat $ do
-- checkModule checks types, and then transModule introduces new
-- functions (by lambda lifting in 'desugar'). Consequence: The
-- types of the newly introduced functions are not inferred (hsi)
let (env2, il, dumps) = transModule opts env modul
-- dump intermediate results
mapM_ (doDump opts) dumps
-- generate target code
let intf = exportInterface env2 modul
let modSum = summarizeModule (tyConsEnv env2) intf modul
writeFlat opts fn env2 modSum il
where
withFlat = any (`elem` optTargetTypes opts)
[FlatCurry, FlatXml, ExtendedFlatCurry]
CheckSuccess res -> do
showWarnings opts $ uncurry warnCheck res
writeOutput opts fn res
writeOutput :: Options -> FilePath -> (CompilerEnv, CS.Module) -> IO ()
writeOutput opts fn (env, modul) = do
writeParsed opts fn modul
writeAbstractCurry opts fn env modul
when withFlat $ do
-- checkModule checks types, and then transModule introduces new
-- functions (by lambda lifting in 'desugar'). Consequence: The
-- types of the newly introduced functions are not inferred (hsi)
let (env2, il, dumps) = transModule opts env modul
-- dump intermediate results
mapM_ (doDump opts) dumps
-- generate target code
let intf = exportInterface env2 modul
let modSum = summarizeModule (tyConsEnv env2) intf modul
writeFlat opts fn env2 modSum il
where
withFlat = any (`elem` optTargetTypes opts)
[FlatCurry, FlatXml, ExtendedFlatCurry]
-- ---------------------------------------------------------------------------
-- Loading a module
......@@ -119,7 +123,7 @@ loadModule opts fn = do
checkModuleHeader :: Options -> FilePath -> CS.Module -> (CS.Module, [Message])
checkModuleHeader opts fn = checkModuleId fn
. importPrelude opts
. importPrelude opts fn
. CS.patchModuleId fn
-- |Check whether the 'ModuleIdent' and the 'FilePath' fit together
......@@ -135,8 +139,8 @@ checkModuleId fn m@(CS.Module mid _ _ _)
-- by a compiler option. If no explicit import for the prelude is present,
-- the prelude is imported unqualified, otherwise a qualified import is added.
importPrelude :: Options -> CS.Module -> CS.Module
importPrelude opts m@(CS.Module mid es is ds)
importPrelude :: Options -> FilePath -> CS.Module -> CS.Module
importPrelude opts fn m@(CS.Module mid es is ds)
-- the Prelude itself
| mid == preludeMIdent = m
-- disabled by compiler option
......@@ -147,7 +151,7 @@ importPrelude opts m@(CS.Module mid es is ds)
| otherwise = CS.Module mid es (preludeImp : is) ds
where
noImpPrelude = NoImplicitPrelude `elem` optExtensions opts
preludeImp = CS.ImportDecl NoPos preludeMIdent
preludeImp = CS.ImportDecl (first fn) preludeMIdent
False -- qualified?
Nothing -- no alias
Nothing -- no selection of types, functions, etc.
......@@ -161,18 +165,19 @@ importPrelude opts m@(CS.Module mid es is ds)
-- TODO (2012-01-05, bjp): The export specification check for untyped
-- AbstractCurry is deactivated as it requires the value information
-- collected by the type checker.
checkModule :: Options -> CompilerEnv -> CS.Module
checkModule :: Options -> (CompilerEnv, CS.Module)
-> CheckResult (CompilerEnv, CS.Module)
checkModule opts env mdl = kindCheck env mdl -- should be only syntax checking ?
>>= uncurry (syntaxCheck opts)
>>= uncurry precCheck
>>= (if withTypeCheck
then \x -> uncurry typeCheck x >>= uncurry exportCheck
else return)
>>= return . (uncurry (qual opts))
checkModule opts (env, mdl)
= kindCheck env mdl -- should be only syntax checking ?
>>= uncurry (syntaxCheck opts)
>>= uncurry precCheck
>>= (if withTypeCheck
then \x -> uncurry typeCheck x >>= uncurry exportCheck
else return)
>>= return . (uncurry (qual opts))
where
withTypeCheck = any (`elem` optTargetTypes opts)
[FlatCurry, ExtendedFlatCurry, FlatXml, AbstractCurry]
withTypeCheck = any (`elem` optTargetTypes opts)
[FlatCurry, ExtendedFlatCurry, FlatXml, AbstractCurry]
-- ---------------------------------------------------------------------------
-- Translating a module
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment