curry-frontend 0.2.11 → 0.2.12
raw patch · 8 files changed
+241/−437 lines, 8 filesdep +sybdep ~basedep ~curry-basenew-uploader
Dependencies added: syb
Dependency ranges changed: base, curry-base
Files
- curry-frontend.cabal +29/−21
- src/Curry/Files/CymakePath.hs +5/−0
- src/Curry/Syntax.hs +8/−8
- src/Curry/Syntax/LexComb.lhs +3/−3
- src/CurryCompilerOpts.hs +140/−141
- src/GetOpt.hs +0/−194
- src/Modules.lhs +6/−6
- src/cymake.hs +50/−64
curry-frontend.cabal view
@@ -1,42 +1,50 @@ Name: curry-frontend-Version: 0.2.11+Version: 0.2.12 Cabal-Version: >= 1.6-Synopsis: Compile the functional logic language Curry to several intermediate formats+Synopsis: Compile the functional logic language Curry to several+ intermediate formats Description: The Curry Frontend consists of the executable program "cymake".- It is used by various backends to compile Curry programs to - an internal representation. + It is used by various backends to compile Curry programs to+ an internal representation. The code is a stripped-down version of an early version of- the Muenster Curry Compiler + the Muenster Curry Compiler (<http://danae.uni-muenster.de/~lux/curry/>) Category: Language License: OtherLicense License-File: LICENSE Author: Wolfgang Lux, Martin Engelke, Bernd Brassel, Holger Siegel-Maintainer: Holger Siegel-Bug-Reports: mailto:hsi@informatik.uni-kiel.de-Homepage: http://curry-language.org+Maintainer: Björn Peemöller+Bug-Reports: http://www-ps.informatik.uni-kiel.de/redmine/projects/curry-frontend+Homepage: http://www.curry-language.org Build-Type: Simple Stability: experimental Extra-Source-Files: LIESMICH-Data-Files: src/currydoc.css+Data-Files: src/currydoc.css +Flag split-syb+ Description: Has the syb functionality been split into the package syb?+ Default: True Executable cymake- hs-source-dirs: src- Main-is: cymake.hs- Build-Depends: base >= 3 && < 4, - curry-base >= 0.2.8, - mtl, old-time, containers, pretty- ghc-options: -fwarn-unused-binds -fwarn-unused-imports -auto-all + hs-source-dirs: src+ Main-is: cymake.hs+ if flag(split-syb)+ Build-Depends: base == 4.*, syb+ else+ Build-Depends: base == 3.*+ Build-Depends:+ curry-base >= 0.2.9 && < 0.3+ , mtl, old-time, containers, pretty+ ghc-options: -Wall Other-Modules: Curry.Syntax.Lexer, Curry.Syntax.LexComb Curry.Syntax.Parser, Curry.Syntax.LLParseComb Curry.Syntax.ShowModule, Curry.Syntax.Pretty Curry.Syntax, Curry.Syntax.Type- Curry.Syntax.Unlit, + Curry.Syntax.Unlit, Curry.Syntax.Utils, Curry.Syntax.Frontend,- CurryBuilder, IL.Type + CurryBuilder, IL.Type CurryCompilerOpts, Modules, Subst, Arity CurryDeps, Eval, IL.Pretty, NestEnv, SyntaxCheck, Base Exports, IL.Scope, SyntaxColoring, CurryEnv@@ -44,20 +52,20 @@ IL.XML, PatchPrelude, TopEnv, CaseCompletion Imports, TypeCheck,- InterfaceCheck, + InterfaceCheck, Types, PrecCheck TypeSubst, GenAbstractCurry Typing GenFlatCurry, KindCheck, Qual- SCC, Utils, GetOpt+ SCC, Utils Lift, ScopeEnv, WarnCheck- Desugar, + Desugar, Simplify Library hs-source-dirs: src Build-Depends: filepath- Exposed-Modules: + Exposed-Modules: Curry.Files.CymakePath Other-Modules: Paths_curry_frontend
src/Curry/Files/CymakePath.hs view
@@ -4,7 +4,12 @@ import System.FilePath import Paths_curry_frontend +-- | Retrieve the version number of cymake+cymakeVersion :: String cymakeVersion = showVersion version++-- | Retrieve the location of the cymake executable+getCymake :: IO String getCymake = do cymakeDir <- getBinDir return (cymakeDir </> "cymake")
src/Curry/Syntax.hs view
@@ -5,27 +5,26 @@ (c) 2009, Holger Siegel. -} -module Curry.Syntax(module Curry.Syntax.Type,- parseModule, parseHeader- ) where+module Curry.Syntax+ ( module Curry.Syntax.Type+ , parseModule+ , parseHeader+ ) where import Control.Monad import Data.List import Curry.Base.MessageMonad import Curry.Syntax.Type- import qualified Curry.Syntax.Parser as CSP- import Curry.Syntax.Unlit --+-- | Parses a curry module. parseModule :: Bool -> FilePath -> String -> MsgMonad Module parseModule likeFlat fn = unlitLiterate fn >=> CSP.parseSource likeFlat fn -+-- | Pares a curry header parseHeader :: FilePath -> String -> MsgMonad Module parseHeader fn = unlitLiterate fn >=> CSP.parseHeader fn@@ -36,6 +35,7 @@ | isLiterateSource fn = unlit fn s | otherwise = return s +-- | Compute if a file contains literate curry by its extension isLiterateSource :: FilePath -> Bool isLiterateSource fn = litExt `isSuffixOf` fn
src/Curry/Syntax/LexComb.lhs view
@@ -9,8 +9,8 @@ The module \texttt{LexComb} provides the basic types and combinators to implement the lexers. The combinators use continuation passing code in a monadic style. The first argument of the continuation function is-the string to be parsed, the second is the current position, and the-third is a flag which signals the lexer that it is lexing the+the current position, and the second is the string to be parsed. The third+argument is a flag which signals the lexer that it is lexing the beginning of a line and therefore has to check for layout tokens. The fourth argument is a stack of indentations that is used to handle nested layout groups.@@ -66,7 +66,7 @@ > popContext :: P a -> P a > popContext cont pos s bol (_:ctxt) = cont pos s bol ctxt-> popContext cont pos s bol [] = +> popContext cont pos s bol [] = > error "parse error: popping layout from empty context stack. \ > \Perhaps you have inserted too many '}'?"
src/CurryCompilerOpts.hs view
@@ -1,6 +1,5 @@-------------------------------------------------------------------------------------------------------------------------------------------------------------------+-- -----------------------------------------------------------------------------+-- | -- CurryCompilerOpts - Defines data structures containing options for -- compiling Curry programs (see module "CurryCompiler") --@@ -8,160 +7,160 @@ -- Martin Engelke (men@informatik.uni-kiel.de) -- March 2007, extensions by Sebastian Fischer (sebf@informatik.uni-kiel.de) --+-- -----------------------------------------------------------------------------+ module CurryCompilerOpts where -import GetOpt---import Options (Dump(..))+import System.Console.GetOpt ------------------------------------------------------------------------------------ Data type for recording compiler options+-- | Data type for recording compiler options data Options- = Options{ force :: Bool, -- force compilation- html :: Bool, -- generate Html code - importPaths :: [FilePath], -- directories for searching imports- output :: Maybe FilePath, -- name of output file- noInterface :: Bool, -- do not create an interface file- noVerb :: Bool, -- verbosity on/off- noWarn :: Bool, -- warnings on/off- noOverlapWarn :: Bool, -- "overlap" warnings on/off- flat :: Bool, -- generate FlatCurry code- extendedFlat :: Bool, -- generate FlatCurry code with extensions- flatXml :: Bool, -- generate flat XML code- abstract :: Bool, -- generate typed AbstracCurry code- untypedAbstract :: Bool, -- generate untyped AbstractCurry code- parseOnly :: Bool, -- generate source representation- withExtensions :: Bool, -- enable extended functionalities- dump :: [Dump], -- dumps- writeToSubdir :: Bool -- should output be written to subdir?- } deriving Show+ = Options+ { force :: Bool -- ^ force compilation+ , html :: Bool -- ^ generate Html code+ , importPaths :: [FilePath] -- ^ directories for searching imports+ , output :: Maybe FilePath -- ^ name of output file+ , noInterface :: Bool -- ^ do not create an interface file+ , noVerb :: Bool -- ^ verbosity on/off+ , noWarn :: Bool -- ^ warnings on/off+ , noOverlapWarn :: Bool -- ^ "overlap" warnings on/off+ , flat :: Bool -- ^ generate FlatCurry code+ , extendedFlat :: Bool -- ^ generate FlatCurry code with extensions+ , flatXml :: Bool -- ^ generate flat XML code+ , abstract :: Bool -- ^ generate typed AbstracCurry code+ , untypedAbstract :: Bool -- ^ generate untyped AbstractCurry code+ , parseOnly :: Bool -- ^ generate source representation+ , withExtensions :: Bool -- ^ enable extended functionalities+ , dump :: [Dump] -- ^ dumps+ , writeToSubdir :: Bool -- ^ should the output be written to the subdir?+ } deriving Show --- Default compiler options-defaultOpts = Options{ force = False,- html = False,- importPaths = [],- output = Nothing,- noInterface = False,- noVerb = False,- noWarn = False,- noOverlapWarn = False,- extendedFlat = False,- flat = False,- flatXml = False,- abstract = False,- untypedAbstract = False,- parseOnly = False,- withExtensions = False,- dump = [],- writeToSubdir = True- }+-- | Default compiler options+defaultOpts = Options+ { force = False+ , html = False+ , importPaths = []+ , output = Nothing+ , noInterface = False+ , noVerb = False+ , noWarn = False+ , noOverlapWarn = False+ , extendedFlat = False+ , flat = False+ , flatXml = False+ , abstract = False+ , untypedAbstract = False+ , parseOnly = False+ , withExtensions = False+ , dump = []+ , writeToSubdir = True+ } --- Data type for representing all available options (needed to read and parse--- the options from the command line; see module "GetOpt")-data Option = Help | Force | Html- | ImportPath FilePath | Output FilePath- | NoInterface | NoVerb | NoWarn | NoOverlapWarn- | FlatXML | Flat | ExtFlat- | Abstract | UntypedAbstract | ParseOnly- | WithExtensions- | Dump [Dump]- | WriteToSubdir- deriving Eq+-- | Data type for representing all available options (needed to read and parse+-- the options from the command line; see module 'GetOpt')+data Option+ = Help | Force | Html+ | ImportPath FilePath | Output FilePath+ | NoInterface | NoVerb | NoWarn | NoOverlapWarn+ | FlatXML | Flat | ExtFlat | Abstract | UntypedAbstract | ParseOnly+ | WithExtensions+ | Dump [Dump]+ | WriteToSubdir+ deriving Eq --- All available compiler options-options = [Option "f" ["force"] (NoArg Force)- "force compilation of dependent files",- Option "" ["html"] (NoArg Html)- "generate html code",- Option "i" ["import-dir"] (ReqArg ImportPath "DIR")- "search for imports in DIR",- Option "o" ["output"] (ReqArg Output "FILE")- "write code to FILE",- Option "" ["no-intf"] (NoArg NoInterface)- "do not create an interface file",- Option "" ["no-verb"] (NoArg NoVerb)- "do not print compiler messages",- Option "" ["no-warn"] (NoArg NoWarn)- "do not print warnings",- Option "" ["no-overlap-warn"] (NoArg NoOverlapWarn)- "do not print warnings for overlapping rules",- Option "" ["flat"] (NoArg Flat)- "generate FlatCurry code",- Option "" ["extflat"] (NoArg ExtFlat)- "generate FlatCurry code with source references",- Option "" ["xml"] (NoArg FlatXML)- "generate flat xml code",- Option "" ["acy"] (NoArg Abstract)- "generate (type infered) AbstractCurry code",- Option "" ["uacy"] (NoArg UntypedAbstract)- "generate untyped AbstractCurry code",- Option "" ["parse-only"] (NoArg ParseOnly)- "generate source representation",- Option "e" ["extended"] (NoArg WithExtensions)- "enable extended Curry functionalities",- Option "" ["dump-all"] (NoArg (Dump [minBound..maxBound]))- "dump everything",- Option "" ["dump-renamed"] (NoArg (Dump [DumpRenamed]))- "dump source code after renaming",- Option "" ["dump-types"] (NoArg (Dump [DumpTypes]))- "dump types after type-checking",- Option "" ["dump-desugared"] (NoArg (Dump [DumpDesugared]))- "dump source code after desugaring",- Option "" ["dump-simplified"] (NoArg (Dump [DumpSimplified]))- "dump source code after simplification",- Option "" ["dump-lifted"] (NoArg (Dump [DumpLifted]))- "dump source code after lambda-lifting",- Option "" ["dump-il"] (NoArg (Dump [DumpIL]))- "dump intermediate language before lifting",- Option "" ["dump-case"] (NoArg (Dump [DumpCase]))- "dump intermediate language after case simplification",- Option "?h" ["help"] (NoArg Help)- "display this help and exit",- Option "" ["no-hidden-subdir"] (NoArg WriteToSubdir)- "write all output to hidden .curry subdirectory"- ]+-- | All available compiler options+options =+ [ Option "f" ["force"] (NoArg Force)+ "force compilation of dependent files"+ , Option "" ["html"] (NoArg Html)+ "generate html code"+ , Option "i" ["import-dir"] (ReqArg ImportPath "DIR")+ "search for imports in DIR"+ , Option "o" ["output"] (ReqArg Output "FILE")+ "write code to FILE"+ , Option "" ["no-intf"] (NoArg NoInterface)+ "do not create an interface file"+ , Option "" ["no-verb"] (NoArg NoVerb)+ "do not print compiler messages"+ , Option "" ["no-warn"] (NoArg NoWarn)+ "do not print warnings"+ , Option "" ["no-overlap-warn"] (NoArg NoOverlapWarn)+ "do not print warnings for overlapping rules"+ , Option "" ["flat"] (NoArg Flat)+ "generate FlatCurry code"+ , Option "" ["extended-flat"] (NoArg ExtFlat)+ "generate FlatCurry code with source references"+ , Option "" ["xml"] (NoArg FlatXML)+ "generate flat xml code"+ , Option "" ["acy"] (NoArg Abstract)+ "generate (type infered) AbstractCurry code"+ , Option "" ["uacy"] (NoArg UntypedAbstract)+ "generate untyped AbstractCurry code"+ , Option "" ["parse-only"] (NoArg ParseOnly)+ "generate source representation"+ , Option "e" ["extended"] (NoArg WithExtensions)+ "enable extended Curry functionalities"+ , Option "" ["dump-all"] (NoArg (Dump [minBound..maxBound]))+ "dump everything"+ , Option "" ["dump-renamed"] (NoArg (Dump [DumpRenamed]))+ "dump source code after renaming"+ , Option "" ["dump-types"] (NoArg (Dump [DumpTypes]))+ "dump types after type-checking"+ , Option "" ["dump-desugared"] (NoArg (Dump [DumpDesugared]))+ "dump source code after desugaring"+ , Option "" ["dump-simplified"] (NoArg (Dump [DumpSimplified]))+ "dump source code after simplification"+ , Option "" ["dump-lifted"] (NoArg (Dump [DumpLifted]))+ "dump source code after lambda-lifting"+ , Option "" ["dump-il"] (NoArg (Dump [DumpIL]))+ "dump intermediate language before lifting"+ , Option "" ["dump-case"] (NoArg (Dump [DumpCase]))+ "dump intermediate language after case simplification"+ , Option "?h" ["help"] (NoArg Help)+ "display this help and exit"+ , Option "" ["no-hidden-subdir"] (NoArg WriteToSubdir)+ "write all output to hidden .curry subdirectory"+ ] --- Inserts an option (type 'Option') into the options record (type 'Options')+-- | Marks an 'Option' as selected in the 'Options' record selectOption :: Option -> Options -> Options-selectOption Force opts = opts{ force = True }-selectOption (ImportPath dir) opts - = opts{ importPaths = dir:(importPaths opts) }-selectOption (Output file) opts = opts{ output = Just file }-selectOption NoInterface opts = opts{ noInterface = True }-selectOption NoVerb opts = opts{ noVerb = True } -selectOption NoWarn opts = opts{ noWarn = True }-selectOption NoOverlapWarn opts = opts{ noOverlapWarn = True }-selectOption Flat opts = opts{ flat = True }-selectOption ExtFlat opts = opts{ extendedFlat = True }-selectOption Html opts = opts{ html = True }-selectOption FlatXML opts = opts{ flatXml = True }-selectOption Abstract opts = opts{ abstract = True }-selectOption UntypedAbstract opts = opts{ untypedAbstract = True }-selectOption ParseOnly opts = opts{ parseOnly = True }-selectOption WithExtensions opts = opts{ withExtensions = True }-selectOption (Dump ds) opts = opts{ dump = ds ++ dump opts }-selectOption WriteToSubdir opts = opts{ writeToSubdir = False }+selectOption Force opts = opts { force = True }+selectOption (ImportPath dir) opts+ = opts { importPaths = dir:(importPaths opts) }+selectOption (Output file) opts = opts { output = Just file }+selectOption NoInterface opts = opts { noInterface = True }+selectOption NoVerb opts = opts { noVerb = True }+selectOption NoWarn opts = opts { noWarn = True }+selectOption NoOverlapWarn opts = opts { noOverlapWarn = True }+selectOption Flat opts = opts { flat = True }+selectOption ExtFlat opts = opts { extendedFlat = True }+selectOption Html opts = opts { html = True }+selectOption FlatXML opts = opts { flatXml = True }+selectOption Abstract opts = opts { abstract = True }+selectOption UntypedAbstract opts = opts { untypedAbstract = True }+selectOption ParseOnly opts = opts { parseOnly = True }+selectOption WithExtensions opts = opts { withExtensions = True }+selectOption (Dump ds) opts = opts { dump = ds ++ dump opts }+selectOption WriteToSubdir opts = opts { writeToSubdir = False } ------------------------------------------------------------------------------------ Data type for representing code dumps--- TODO: dump FlatCurry code, dump AbstractCurry code, dump after 'case'--- expansion-data Dump = DumpRenamed -- dump source after renaming- | DumpTypes -- dump types after typechecking- | DumpDesugared -- dump source after desugaring- | DumpSimplified -- dump source after simplification- | DumpLifted -- dump source after lambda-lifting- | DumpIL -- dump IL code after translation- | DumpCase -- dump IL code after case elimination- deriving (Eq,Bounded,Enum,Show)-+-- | Data type for representing code dumps+-- TODO: dump FlatCurry code, dump AbstractCurry code, dump after 'case'+-- expansion+data Dump+ = DumpRenamed -- ^ dump source after renaming+ | DumpTypes -- ^ dump types after typechecking+ | DumpDesugared -- ^ dump source after desugaring+ | DumpSimplified -- ^ dump source after simplification+ | DumpLifted -- ^ dump source after lambda-lifting+ | DumpIL -- ^ dump IL code after translation+ | DumpCase -- ^ dump IL code after case elimination+ deriving (Eq,Bounded,Enum,Show) ------------------------------------------------------------------------------- -------------------------------------------------------------------------------
− src/GetOpt.hs
@@ -1,194 +0,0 @@--------------------------------------------------------------------------------------------- A Haskell port of GNU's getopt library--- --- Sven Panne <Sven.Panne@informatik.uni-muenchen.de> Oct. 1996 (small changes Dec. 1997)------ Two rather obscure features are missing: The Bash 2.0 non-option hack (if you don't--- already know it, you probably don't want to hear about it...) and the recognition of--- long options with a single dash (e.g. '-help' is recognised as '--help', as long as--- there is no short option 'h').------ Other differences between GNU's getopt and this implementation:--- * To enforce a coherent description of options and arguments, there are explanation--- fields in the option/argument descriptor.--- * Error messages are now more informative, but no longer POSIX compliant... :-(--- --- And a final Haskell advertisement: The GNU C implementation uses well over 1100 lines,--- we need only 195 here, including a 46 line example! :-)--------------------------------------------------------------------------------------------module GetOpt (ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, getOpt) where--import Data.List(isPrefixOf)--data ArgOrder a -- what to do with options following non-options:- = RequireOrder -- no option processing after first non-option- | Permute -- freely intersperse options and non-options- | ReturnInOrder (String -> a) -- wrap non-options into options--data OptDescr a = -- description of a single options:- Option [Char] -- list of short option characters- [String] -- list of long option strings (without "--")- (ArgDescr a) -- argument descriptor- String -- explanation of option for user--data ArgDescr a -- description of an argument option:- = NoArg a -- no argument expected- | ReqArg (String -> a) String -- option requires argument- | OptArg (Maybe String -> a) String -- optional argument--data OptKind a -- kind of cmd line arg (internal use only):- = Opt a -- an option- | NonOpt String -- a non-option- | EndOfOpts -- end-of-options marker (i.e. "--")- | OptErr String -- something went wrong...--usageInfo :: String -- header- -> [OptDescr a] -- option descriptors- -> String -- nicely formatted decription of options-usageInfo header optDescr = unlines (header:table)- where (ss,ls,ds) = (unzip3 . map fmtOpt) optDescr- table = zipWith3 paste (sameLen ss) (sameLen ls) (sameLen ds)- paste x y z = " " ++ x ++ " " ++ y ++ " " ++ z- sameLen xs = flushLeft ((maximum . map length) xs) xs- flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]--fmtOpt :: OptDescr a -> (String,String,String)-fmtOpt (Option sos los ad descr) = (sepBy ", " (map (fmtShort ad) sos),- sepBy ", " (map (fmtLong ad) los),- descr)- where sepBy sep [] = ""- sepBy sep [x] = x- sepBy sep (x:xs) = x ++ sep ++ sepBy sep xs--fmtShort :: ArgDescr a -> Char -> String-fmtShort (NoArg _ ) so = "-" ++ [so]-fmtShort (ReqArg _ ad) so = "-" ++ [so] ++ " " ++ ad-fmtShort (OptArg _ ad) so = "-" ++ [so] ++ "[" ++ ad ++ "]"--fmtLong :: ArgDescr a -> String -> String-fmtLong (NoArg _ ) lo = "--" ++ lo-fmtLong (ReqArg _ ad) lo = "--" ++ lo ++ "=" ++ ad-fmtLong (OptArg _ ad) lo = "--" ++ lo ++ "[=" ++ ad ++ "]"--getOpt :: ArgOrder a -- non-option handling- -> [OptDescr a] -- option descriptors- -> [String] -- the commandline arguments- -> ([a],[String],[String]) -- (options,non-options,error messages)-getOpt _ _ [] = ([],[],[])-getOpt ordering optDescr (arg:args) = procNextOpt opt ordering- where procNextOpt (Opt o) _ = (o:os,xs,es)- procNextOpt (NonOpt x) RequireOrder = ([],x:rest,[])- procNextOpt (NonOpt x) Permute = (os,x:xs,es)- procNextOpt (NonOpt x) (ReturnInOrder f) = (f x :os, xs,es)- procNextOpt EndOfOpts RequireOrder = ([],rest,[])- procNextOpt EndOfOpts Permute = ([],rest,[])- procNextOpt EndOfOpts (ReturnInOrder f) = (map f rest,[],[])- procNextOpt (OptErr e) _ = (os,xs,e:es)-- (opt,rest) = getNext arg args optDescr- (os,xs,es) = getOpt ordering optDescr rest---- take a look at the next cmd line arg and decide what to do with it-getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])-getNext "--" rest _ = (EndOfOpts,rest)-getNext ('-':'-':xs) rest optDescr = longOpt xs rest optDescr-getNext ('-':x:xs) rest optDescr = shortOpt x xs rest optDescr-getNext a rest _ = (NonOpt a,rest)---- handle long option-longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])-longOpt xs rest optDescr = long ads arg rest- where (opt,arg) = break (=='=') xs- options = [ o | o@(Option _ ls _ _) <- optDescr, l <- ls, opt `isPrefixOf` l ]- ads = [ ad | Option _ _ ad _ <- options ]- optStr = ("--"++opt)-- long (_:_:_) _ rest = (errAmbig options optStr,rest)- long [NoArg a ] [] rest = (Opt a,rest)- long [NoArg a ] ('=':xs) rest = (errNoArg optStr,rest)- long [ReqArg f d] [] [] = (errReq d optStr,[])- long [ReqArg f _] [] (r:rest) = (Opt (f r),rest)- long [ReqArg f _] ('=':xs) rest = (Opt (f xs),rest)- long [OptArg f _] [] rest = (Opt (f Nothing),rest)- long [OptArg f _] ('=':xs) rest = (Opt (f (Just xs)),rest)- long _ _ rest = (errUnrec optStr,rest)---- handle short option-shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String])-shortOpt x xs rest optDescr = short ads xs rest- where options = [ o | o@(Option ss _ _ _) <- optDescr, s <- ss, x == s ]- ads = [ ad | Option _ _ ad _ <- options ]- optStr = '-':[x]-- short (_:_:_) _ rest = (errAmbig options optStr,rest)- short (NoArg a :_) [] rest = (Opt a,rest)- short (NoArg a :_) xs rest = (Opt a,('-':xs):rest)- short (ReqArg f d:_) [] [] = (errReq d optStr,[])- short (ReqArg f _:_) [] (r:rest) = (Opt (f r),rest)- short (ReqArg f _:_) xs rest = (Opt (f xs),rest)- short (OptArg f _:_) [] rest = (Opt (f Nothing),rest)- short (OptArg f _:_) xs rest = (Opt (f (Just xs)),rest)- short [] [] rest = (errUnrec optStr,rest)- short [] xs rest = (errUnrec optStr,('-':xs):rest)---- miscellaneous error formatting--errAmbig :: [OptDescr a] -> String -> OptKind a-errAmbig ods optStr = OptErr (usageInfo header ods)- where header = "option `" ++ optStr ++ "' is ambiguous; could be one of:"--errReq :: String -> String -> OptKind a-errReq d optStr = OptErr ("option `" ++ optStr ++ "' requires an argument " ++ d ++ "\n")--errUnrec :: String -> OptKind a-errUnrec optStr = OptErr ("unrecognized option `" ++ optStr ++ "'\n")--errNoArg :: String -> OptKind a-errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n")--{---------------------------------------------------------------------------------------------- and here a small and hopefully enlightening example:--data Flag = Verbose | Version | Name String | Output String | Arg String deriving Show--options :: [OptDescr Flag]-options =- [Option ['v'] ["verbose"] (NoArg Verbose) "verbosely list files",- Option ['V','?'] ["version","release"] (NoArg Version) "show version info",- Option ['o'] ["output"] (OptArg out "FILE") "use FILE for dump",- Option ['n'] ["name"] (ReqArg Name "USER") "only dump USER's files"]--out :: Maybe String -> Flag-out Nothing = Output "stdout"-out (Just o) = Output o--test :: ArgOrder Flag -> [String] -> String-test order cmdline = case getOpt order options cmdline of- (o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n ++ "\n"- (_,_,errs) -> concat errs ++ usageInfo header options- where header = "Usage: foobar [OPTION...] files..."---- example runs:--- putStr (test RequireOrder ["foo","-v"])--- ==> options=[] args=["foo", "-v"]--- putStr (test Permute ["foo","-v"])--- ==> options=[Verbose] args=["foo"]--- putStr (test (ReturnInOrder Arg) ["foo","-v"])--- ==> options=[Arg "foo", Verbose] args=[]--- putStr (test Permute ["foo","--","-v"])--- ==> options=[] args=["foo", "-v"]--- putStr (test Permute ["-?o","--name","bar","--na=baz"])--- ==> options=[Version, Output "stdout", Name "bar", Name "baz"] args=[]--- putStr (test Permute ["--ver","foo"])--- ==> option `--ver' is ambiguous; could be one of:--- -v --verbose verbosely list files--- -V, -? --version, --release show version info --- Usage: foobar [OPTION...] files...--- -v --verbose verbosely list files --- -V, -? --version, --release show version info --- -o[FILE] --output[=FILE] use FILE for dump --- -n USER --name=USER only dump USER's files--------------------------------------------------------------------------------------------}
src/Modules.lhs view
@@ -29,7 +29,7 @@ > import Control.Monad > import Curry.Base.MessageMonad-> import Curry.Base.Position+> import Curry.Base.Position as P > import Curry.Base.Ident > import Curry.Files.Filenames@@ -411,7 +411,7 @@ > importPrelude fn (Module m es ds) = > Module m es (if m == preludeMIdent then ds else ds') > where ids = [decl | decl@(ImportDecl _ _ _ _ _) <- ds]-> ds' = ImportDecl (first fn) preludeMIdent+> ds' = ImportDecl (P.first fn) preludeMIdent > (preludeMIdent `elem` map importedModule ids) > Nothing Nothing : ds > importedModule (ImportDecl _ m q asM is) = fromMaybe m asM@@ -449,10 +449,10 @@ > compileInterface paths ctxt mEnv m fn = > do > mintf <- readFlatInterface fn-> let intf = fromMaybe (errorAt (first fn) (interfaceNotFound m)) mintf+> let intf = fromMaybe (errorAt (P.first fn) (interfaceNotFound m)) mintf > (Prog mod _ _ _ _) = intf > m' = mkMIdent [mod]-> unless (m' == m) (errorAt (first fn) (wrongInterface m m'))+> unless (m' == m) (errorAt (P.first fn) (wrongInterface m m')) > mEnv' <- loadFlatInterfaces paths ctxt mEnv intf > return (bindFlatInterface intf mEnv') @@ -468,7 +468,7 @@ > foldM (loadInterface paths ((mkMIdent [m]):ctxt)) > mEnv > (map (\i -> (p, mkMIdent [i])) is)-> where p = first m+> where p = P.first m Interface files are updated by the Curry builder when necessary.@@ -676,7 +676,7 @@ > = (name == "[]" || name == "()") && mod == "Prelude" > isSpecialPreludeType _ = False >-> pos = first m+> pos = P.first m > ts' = filter (not . isSpecialPreludeType) ts
src/cymake.hs view
@@ -1,111 +1,97 @@-------------------------------------------------------------------------------------------------------------------------------------------------------------------+-- -----------------------------------------------------------------------------+-- | -- cymake - The Curry builder -- -- Command line tool for generating Curry representations (e.g. -- FlatCurry, AbstractCurry) for a Curry source file including -- all imported modules. ----- September 2005,--- Martin Engelke (men@informatik.uni-kiel.de)+-- September 2005, Martin Engelke (men@informatik.uni-kiel.de) --+-- ----------------------------------------------------------------------------- module Main(main) where -- import Data.List import Data.Maybe-import System.IO+import System.Console.GetOpt import System.Environment(getArgs, getProgName) import System.Exit(ExitCode(..), exitWith)+import System.IO import Control.Monad (unless) -import GetOpt import CurryBuilder(buildCurry) import CurryCompilerOpts import CurryHtml import Curry.Files.CymakePath (cymakeVersion) -------------------------------------------------------------------------------- --- The command line tool.+-- | The command line tool cymake main :: IO ()-main = do prog <- getProgName- args <- getArgs- cymake prog args ----------------------------------------------------------------------------------+main = do+ prog <- getProgName+ args <- getArgs+ cymake prog args --- Checks the command line arguments and invokes the builder.+-- | Checks the command line arguments and invokes the curry builder cymake :: String -> [String] -> IO ()-cymake prog args - | elem Help opts = printUsage prog- | null files = badUsage prog ["no files"]- | null errs' && not (elem Html opts) = do- unless (noVerb options') - (putStrLn $ "This is cymake, version " ++ cymakeVersion)- mapM_ (buildCurry options') files- | null errs' = do- let importFiles = nub $ importPaths opts'- outputFile = maybe "" id (output opts')- mapM_ (source2html importFiles outputFile) files- - | otherwise = badUsage prog errs'- where- (opts, files, errs) = getOpt Permute options args- opts' = foldr selectOption defaultOpts opts- options' = if flat opts' || flatXml opts' - || abstract opts' || untypedAbstract opts' || parseOnly opts'- then opts'- else opts'{ flat = True }- errs' = errs ++ check options' files-+cymake prog args+ | elem Help opts = printUsage prog+ | null files = badUsage prog ["no files"]+ | null errs'+ && not (elem Html opts) = do+ unless (noVerb options')+ (putStrLn $ "This is cymake, version " ++ cymakeVersion)+ mapM_ (buildCurry options') files+ | null errs' = do+ let importFiles = nub $ importPaths opts'+ outputFile = maybe "" id (output opts')+ mapM_ (source2html importFiles outputFile) files+ | otherwise = badUsage prog errs'+ where+ (opts, files, errs) = getOpt Permute options args+ opts' = foldr selectOption defaultOpts opts+ options' = if flat opts' || flatXml opts' || abstract opts'+ || untypedAbstract opts' || parseOnly opts'+ then opts'+ else opts'{ flat = True }+ errs' = errs ++ check options' files --- Prints usage information of the command line tool.+-- | Prints usage information of the command line tool. printUsage :: String -> IO ()-printUsage prog- = do putStrLn (usageInfo header options)- exitWith ExitSuccess- where- header = "usage: " ++ prog ++ " [OPTION] ... MODULE ..."-+printUsage prog = do+ putStrLn (usageInfo header options)+ exitWith ExitSuccess+ where header = "usage: " ++ prog ++ " [OPTION] ... MODULE ..." --- Prints errors+-- | Prints errors badUsage :: String -> [String] -> IO ()-badUsage prog errs- = do mapM (\err -> putErrLn (prog ++ ": " ++ err)) errs- abortWith ["Try '" ++ prog ++ " -" ++ "-help' for more information"]-+badUsage prog errs = do+ putErrsLn $ map (\err -> prog ++ ": " ++ err) errs+ abortWith ["Try '" ++ prog ++ " -" ++ "-help' for more information"] --- Checks options and files.+-- | Checks options and files and return a list of error messages check :: Options -> [String] -> [String] check opts files- | null files + | null files = ["no files"] | isJust (output opts) && length files > 1 = ["cannot specify -o with multiple targets"] | otherwise = [] ------------------------------------------------------------------------------------ Error handling---- Prints an error message on 'stderr'+-- | Prints an error message on 'stderr' putErrLn :: String -> IO () putErrLn = hPutStrLn stderr --- Prints a list of error messages on 'stderr'+-- | Prints a list of error messages on 'stderr' putErrsLn :: [String] -> IO () putErrsLn = mapM_ putErrLn --- Prints a list of error messages on 'stderr' and aborts the program+-- | Prints a list of error messages on 'stderr' and aborts the program with+-- exit code 1 abortWith :: [String] -> IO a abortWith errs = putErrsLn errs >> exitWith (ExitFailure 1) -----------------------------------------------------------------------------------------------------------------------------------------------------------------+-- -----------------------------------------------------------------------------+-- -----------------------------------------------------------------------------