diff --git a/curry-frontend.cabal b/curry-frontend.cabal --- a/curry-frontend.cabal +++ b/curry-frontend.cabal @@ -1,5 +1,5 @@ Name: curry-frontend -Version: 0.2.4 +Version: 0.2.5 Cabal-Version: >= 1.6 Synopsis: Compile the functional logic language Curry to several intermediate formats Description: The Curry Frontend consists of the executable program "cymake". @@ -42,7 +42,7 @@ Imports, TypeCheck, InterfaceCheck, - Types, Frontend, PrecCheck + Types, PrecCheck TypeSubst, GenAbstractCurry Typing GenFlatCurry, KindCheck, Qual @@ -51,3 +51,6 @@ Desugar, Simplify +Library + hs-source-dirs: src + Exposed-Modules: Curry.Syntax.Frontend diff --git a/src/Curry/Syntax/Frontend.hs b/src/Curry/Syntax/Frontend.hs new file mode 100644 --- /dev/null +++ b/src/Curry/Syntax/Frontend.hs @@ -0,0 +1,202 @@ +------------------------------------------------------------------------------- +------------------------------------------------------------------------------- +-- +-- Frontend - Provides an API for dealing with several kinds of Curry +-- program representations +-- +-- December 2005, +-- Martin Engelke (men@informatik.uni-kiel.de) +-- +module Curry.Syntax.Frontend (lex, parse, fullParse, typingParse)where + +import Data.Maybe +import qualified Data.Map as Map +import Control.Monad.Writer +import Control.Monad.Error +import Prelude hiding (lex) + + +import Curry.Base.MessageMonad +import Curry.Base.Ident +import Curry.Base.Position + +import Curry.Files.Filenames +import Curry.Files.PathUtils + +import qualified Curry.Syntax as CS +import Curry.Syntax.Lexer + +import Modules +import CurryBuilder +import CurryCompilerOpts + +import CurryDeps + +import Base(ModuleEnv) + +------------------------------------------------------------------------------- +------------------------------------------------------------------------------- + +-- Returns the result of a lexical analysis of the source program 'src'. +-- The result is a list of tuples consisting of a position and a token +-- (see Modules "Position" and "CurryLexer") +lex :: FilePath -> String -> MsgMonad [(Position,Token)] +lex fn src = lexFile (first fn) src False [] + + +-- Returns 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 CS.Module +parse fn src = CS.parseModule True fn src >>= genCurrySyntax fn + + +-- Returns 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 +-- environment variable "PAKCSLIBPATH". Additional search paths can +-- be defined using the argument 'paths'. +fullParse :: [FilePath] -> FilePath -> String -> IO (MsgMonad CS.Module) +fullParse paths fn src = -- liftM msgmonad2result $ + genFullCurrySyntax simpleCheckModule 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 CS.Module) +typingParse paths fn src = genFullCurrySyntax checkModule paths fn (parse fn src) + +{- +-- Compiles the source programm 'src' to an AbstractCurry program. +-- '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'. +-- Notes: Due to the lack of error handling in the current version of the +-- front end, this function may fail when an error occurs +abstractIO :: [FilePath] -> FilePath -> String -> IO (MsgMonad ACY.CurryProg) +abstractIO paths fn src = genAbstractIO paths fn (parse fn src) + +-- Compiles the source program 'src' to a FlatCurry program. +-- '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'. +-- Note: Due to the lack of error handling in the current version of the +-- front end, this function may fail when an error occurs +flatIO :: [FilePath] -> FilePath -> String -> IO (MsgMonad FCY.Prog) +flatIO paths fn src = genFlatIO paths fn (parse fn src) +-} + +------------------------------------------------------------------------------- +------------------------------------------------------------------------------- +-- Privates... + + +opts paths = defaultOpts{ + importPaths = paths, + noVerb = True, + noWarn = True, + abstract = True + } + + +-- +genCurrySyntax :: FilePath -> CS.Module -> MsgMonad (CS.Module) +genCurrySyntax fn mod + = let mod'@(CS.Module mid _ _) = patchModuleId fn (importPrelude fn mod) + in if isValidModuleId fn mid + then return mod' + else failWith $ err_invalidModuleName mid + + +-- +genFullCurrySyntax :: (Options -> Base.ModuleEnv -> CS.Module -> IO (t1, t2, t3, CS.Module, t4, [WarnMsg])) + -> [FilePath] -> t -> MsgMonad CS.Module -> IO (MsgMonad CS.Module) +genFullCurrySyntax check paths fn m + = runMsgIO m $ \mod -> do errs <- makeInterfaces paths mod + if null errs + then do mEnv <- loadInterfaces paths mod + (_, _, _, mod', _, msgs') <- check (opts paths) mEnv mod + return (tell msgs' >> return mod') + else return (failWith (head errs)) + + +{- +genAbstractIO :: [FilePath] -> FilePath -> MsgMonad CS.Module + -> IO (MsgMonad ACY.CurryProg) +genAbstractIO paths fn m + = runMsgIO m $ \mod -> + do errs <- makeInterfaces paths mod + if null errs + then do mEnv <- loadInterfaces paths mod + (tyEnv, tcEnv, _, mod', _, msgs') + <- simpleCheckModule (opts paths) mEnv mod + return (tell msgs' >> return (genTypedAbstract tyEnv tcEnv mod')) + else return (failWith $ head errs) + + +-- +genFlatIO :: [FilePath] -> FilePath -> MsgMonad CS.Module -> IO (MsgMonad FCY.Prog) +genFlatIO paths fn m + = runMsgIO m $ \ mod -> + do errs <- makeInterfaces paths mod + if null errs then + (do mEnv <- loadInterfaces paths mod + (tyEnv, tcEnv, aEnv, mod', intf, msgs') <- + checkModule (opts paths) mEnv mod + let (il, aEnv', _) + = transModule True True False mEnv tyEnv tcEnv aEnv mod' + il' = completeCase mEnv il + cEnv = curryEnv mEnv tcEnv intf mod' + (prog,msgs'') = genFlatCurry (opts paths) cEnv mEnv + tyEnv tcEnv aEnv' il' + return (tell msgs'' >> tell msgs' >> return prog) + ) + else return (failWith $ head errs) +-} + + +------------------------------------------------------------------------------- + +-- Generates interface files for importes modules, if they don't exist or +-- if they are not up-to-date. +makeInterfaces :: [FilePath] -> CS.Module -> IO [String] +makeInterfaces paths (CS.Module mid _ decls) + = do let imports = [preludeMIdent | mid /= preludeMIdent] + ++ [imp | CS.ImportDecl _ imp _ _ _ <- decls] + (deps, errs) <- fmap flattenDeps (foldM (moduleDeps paths []) Map.empty imports) + when (null errs) (mapM_ (compile deps . snd) deps) + return errs + where + compile deps (Source file' mods) + = do smake [flatName file', flatIntName file'] + (file':mapMaybe (flatInterface deps) mods) + (compileModule (opts paths) file') + (return Nothing) + return () + compile _ _ = return () + + flatInterface deps mod + = case (lookup mod deps) of + Just (Source file _) -> Just (flatIntName (dropExtension file)) + Just (Interface file) -> Just (flatIntName (dropExtension file)) + _ -> Nothing + + +-- Returns 'True', if file name and module name are equal. +isValidModuleId :: FilePath -> ModuleIdent -> Bool +isValidModuleId fn mid + = last (moduleQualifiers mid) == takeBaseName fn + + +------------------------------------------------------------------------------- +-- Messages + +err_invalidModuleName :: ModuleIdent -> String +err_invalidModuleName mid + = "module \"" ++ moduleName mid + ++ "\" must be in a file \"" ++ moduleName mid ++ ".curry\"" + + +------------------------------------------------------------------------------- +------------------------------------------------------------------------------- diff --git a/src/CurryHtml.hs b/src/CurryHtml.hs --- a/src/CurryHtml.hs +++ b/src/CurryHtml.hs @@ -9,7 +9,7 @@ import Curry.Files.PathUtils (readModule, writeModule, getCurryPath) import SyntaxColoring -import Frontend +import Curry.Syntax.Frontend as Frontend diff --git a/src/Frontend.hs b/src/Frontend.hs deleted file mode 100644 --- a/src/Frontend.hs +++ /dev/null @@ -1,202 +0,0 @@ -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- --- --- Frontend - Provides an API for dealing with several kinds of Curry --- program representations --- --- December 2005, --- Martin Engelke (men@informatik.uni-kiel.de) --- -module Frontend (lex, parse, fullParse, typingParse)where - -import Data.Maybe -import qualified Data.Map as Map -import Control.Monad.Writer -import Control.Monad.Error -import Prelude hiding (lex) - - -import Curry.Base.MessageMonad -import Curry.Base.Ident -import Curry.Base.Position - -import Curry.Files.Filenames -import Curry.Files.PathUtils - -import qualified Curry.Syntax as CS -import Curry.Syntax.Lexer - -import Modules -import CurryBuilder -import CurryCompilerOpts - -import CurryDeps - -import Base(ModuleEnv) - -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- - --- Returns the result of a lexical analysis of the source program 'src'. --- The result is a list of tuples consisting of a position and a token --- (see Modules "Position" and "CurryLexer") -lex :: FilePath -> String -> MsgMonad [(Position,Token)] -lex fn src = lexFile (first fn) src False [] - - --- Returns 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 CS.Module -parse fn src = CS.parseModule True fn src >>= genCurrySyntax fn - - --- Returns 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 --- environment variable "PAKCSLIBPATH". Additional search paths can --- be defined using the argument 'paths'. -fullParse :: [FilePath] -> FilePath -> String -> IO (MsgMonad CS.Module) -fullParse paths fn src = -- liftM msgmonad2result $ - genFullCurrySyntax simpleCheckModule 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 CS.Module) -typingParse paths fn src = genFullCurrySyntax checkModule paths fn (parse fn src) - -{- --- Compiles the source programm 'src' to an AbstractCurry program. --- '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'. --- Notes: Due to the lack of error handling in the current version of the --- front end, this function may fail when an error occurs -abstractIO :: [FilePath] -> FilePath -> String -> IO (MsgMonad ACY.CurryProg) -abstractIO paths fn src = genAbstractIO paths fn (parse fn src) - --- Compiles the source program 'src' to a FlatCurry program. --- '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'. --- Note: Due to the lack of error handling in the current version of the --- front end, this function may fail when an error occurs -flatIO :: [FilePath] -> FilePath -> String -> IO (MsgMonad FCY.Prog) -flatIO paths fn src = genFlatIO paths fn (parse fn src) --} - -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- --- Privates... - - -opts paths = defaultOpts{ - importPaths = paths, - noVerb = True, - noWarn = True, - abstract = True - } - - --- -genCurrySyntax :: FilePath -> CS.Module -> MsgMonad (CS.Module) -genCurrySyntax fn mod - = let mod'@(CS.Module mid _ _) = patchModuleId fn (importPrelude fn mod) - in if isValidModuleId fn mid - then return mod' - else failWith $ err_invalidModuleName mid - - --- -genFullCurrySyntax :: (Options -> Base.ModuleEnv -> CS.Module -> IO (t1, t2, t3, CS.Module, t4, [WarnMsg])) - -> [FilePath] -> t -> MsgMonad CS.Module -> IO (MsgMonad CS.Module) -genFullCurrySyntax check paths fn m - = runMsgIO m $ \mod -> do errs <- makeInterfaces paths mod - if null errs - then do mEnv <- loadInterfaces paths mod - (_, _, _, mod', _, msgs') <- check (opts paths) mEnv mod - return (tell msgs' >> return mod') - else return (failWith (head errs)) - - -{- -genAbstractIO :: [FilePath] -> FilePath -> MsgMonad CS.Module - -> IO (MsgMonad ACY.CurryProg) -genAbstractIO paths fn m - = runMsgIO m $ \mod -> - do errs <- makeInterfaces paths mod - if null errs - then do mEnv <- loadInterfaces paths mod - (tyEnv, tcEnv, _, mod', _, msgs') - <- simpleCheckModule (opts paths) mEnv mod - return (tell msgs' >> return (genTypedAbstract tyEnv tcEnv mod')) - else return (failWith $ head errs) - - --- -genFlatIO :: [FilePath] -> FilePath -> MsgMonad CS.Module -> IO (MsgMonad FCY.Prog) -genFlatIO paths fn m - = runMsgIO m $ \ mod -> - do errs <- makeInterfaces paths mod - if null errs then - (do mEnv <- loadInterfaces paths mod - (tyEnv, tcEnv, aEnv, mod', intf, msgs') <- - checkModule (opts paths) mEnv mod - let (il, aEnv', _) - = transModule True True False mEnv tyEnv tcEnv aEnv mod' - il' = completeCase mEnv il - cEnv = curryEnv mEnv tcEnv intf mod' - (prog,msgs'') = genFlatCurry (opts paths) cEnv mEnv - tyEnv tcEnv aEnv' il' - return (tell msgs'' >> tell msgs' >> return prog) - ) - else return (failWith $ head errs) --} - - -------------------------------------------------------------------------------- - --- Generates interface files for importes modules, if they don't exist or --- if they are not up-to-date. -makeInterfaces :: [FilePath] -> CS.Module -> IO [String] -makeInterfaces paths (CS.Module mid _ decls) - = do let imports = [preludeMIdent | mid /= preludeMIdent] - ++ [imp | CS.ImportDecl _ imp _ _ _ <- decls] - (deps, errs) <- fmap flattenDeps (foldM (moduleDeps paths []) Map.empty imports) - when (null errs) (mapM_ (compile deps . snd) deps) - return errs - where - compile deps (Source file' mods) - = do smake [flatName file', flatIntName file'] - (file':mapMaybe (flatInterface deps) mods) - (compileModule (opts paths) file') - (return Nothing) - return () - compile _ _ = return () - - flatInterface deps mod - = case (lookup mod deps) of - Just (Source file _) -> Just (flatIntName (dropExtension file)) - Just (Interface file) -> Just (flatIntName (dropExtension file)) - _ -> Nothing - - --- Returns 'True', if file name and module name are equal. -isValidModuleId :: FilePath -> ModuleIdent -> Bool -isValidModuleId fn mid - = last (moduleQualifiers mid) == takeBaseName fn - - -------------------------------------------------------------------------------- --- Messages - -err_invalidModuleName :: ModuleIdent -> String -err_invalidModuleName mid - = "module \"" ++ moduleName mid - ++ "\" must be in a file \"" ++ moduleName mid ++ ".curry\"" - - -------------------------------------------------------------------------------- --------------------------------------------------------------------------------