diff --git a/Curry/ExtendedFlat/Goodies.hs b/Curry/ExtendedFlat/Goodies.hs
index 2c5110f15cfce78d0912a0db30f97131a4e9c5c5..1f256dad4481022b2b7104627e2ea1403c57a6d6 100644
--- a/Curry/ExtendedFlat/Goodies.hs
+++ b/Curry/ExtendedFlat/Goodies.hs
@@ -19,6 +19,7 @@ module Curry.ExtendedFlat.Goodies where
import Control.Monad(mplus, msum)
+
import Curry.ExtendedFlat.Type
--------------------------------
@@ -498,7 +499,7 @@ updFuncBody = updFuncRule . updRuleBody
--- transform rule
trRule :: ([VarIndex] -> Expr -> a) -> (String -> a) -> Rule -> a
-trRule rule _ (Rule args exp) = rule args exp
+trRule rule _ (Rule args e) = rule args e
trRule _ ext (External s) = ext s
-- Selectors
@@ -509,7 +510,7 @@ ruleArgs = trRule (\args _ -> args) failed
--- get rules body if it's not external
ruleBody :: Rule -> Expr
-ruleBody = trRule (\_ exp -> exp) failed
+ruleBody = trRule (\_ e -> e) failed
--- get rules external declaration
ruleExtDecl :: Rule -> String
@@ -529,7 +530,7 @@ updRule :: ([VarIndex] -> [VarIndex]) ->
(String -> String) -> Rule -> Rule
updRule fa fe fs = trRule rule ext
where
- rule args exp = Rule (fa args) (fe exp)
+ rule as e = Rule (fa as) (fe e)
ext s = External (fs s)
--- update rules arguments
@@ -707,25 +708,25 @@ trExpr var _ _ _ _ _ _ _ (Var n) = var n
trExpr _ lit _ _ _ _ _ _ (Lit l) = lit l
-trExpr var lit comb lt fr or cas branch (Comb ct name args)
- = comb ct name (map (trExpr var lit comb lt fr or cas branch) args)
+trExpr var lit comb lt fr oR cas branch (Comb ct name args)
+ = comb ct name (map (trExpr var lit comb lt fr oR cas branch) args)
-trExpr var lit comb lt fr or cas branch (Let bs e)
- = lt (map (\ (n,exp) -> (n,f exp)) bs) (f e)
+trExpr var lit comb lt fr oR cas branch (Let bs e)
+ = lt (map (\ (n,e) -> (n,f e)) bs) (f e)
where
- f = trExpr var lit comb lt fr or cas branch
+ f = trExpr var lit comb lt fr oR cas branch
-trExpr var lit comb lt fr or cas branch (Free vs e)
- = fr vs (trExpr var lit comb lt fr or cas branch e)
+trExpr var lit comb lt fr oR cas branch (Free vs e)
+ = fr vs (trExpr var lit comb lt fr oR cas branch e)
-trExpr var lit comb lt fr or cas branch (Or e1 e2) = or (f e1) (f e2)
+trExpr var lit comb lt fr oR cas branch (Or e1 e2) = oR (f e1) (f e2)
where
- f = trExpr var lit comb lt fr or cas branch
+ f = trExpr var lit comb lt fr oR cas branch
-trExpr var lit comb lt fr or cas branch (Case pos ct e bs)
- = cas pos ct (f e) (map (\ (Branch pat exp) -> branch pat (f exp)) bs)
+trExpr var lit comb lt fr oR cas branch (Case pos ct e bs)
+ = cas pos ct (f e) (map (\ (Branch pat e) -> branch pat (f e)) bs)
where
- f = trExpr var lit comb lt fr or cas branch
+ f = trExpr var lit comb lt fr oR cas branch
-- Update Operations
@@ -751,7 +752,7 @@ updFrees fr = trExpr Var Lit Comb Let fr Or Case Branch
--- update all or expressions in given expression
updOrs :: (Expr -> Expr -> Expr) -> Expr -> Expr
-updOrs or = trExpr Var Lit Comb Let Free or Case Branch
+updOrs oR = trExpr Var Lit Comb Let Free oR Case Branch
--- update all case expressions in given expression
updCases :: (SrcRef -> CaseType -> Expr -> [BranchExpr] -> Expr) -> Expr -> Expr
@@ -781,20 +782,20 @@ isConsPartCall e = isComb e && isCombTypeConsPartCall (combType e)
--- is expression fully evaluated?
isGround :: Expr -> Bool
-isGround exp
- = case exp of
+isGround e
+ = case e of
Comb ConsCall _ args -> all isGround args
- _ -> isLit exp
+ _ -> isLit e
--- get all variables (also pattern variables) in expression
allVars :: Expr -> [VarIndex]
-allVars e = trExpr (:) (const id) comb lt fr (.) cas branch e []
+allVars expr = trExpr (:) (const id) comb lt fr (.) cas branch expr []
where
comb _ _ = foldr (.) id
- lt bs exp = exp . foldr (.) id (map (\ (n,ns) -> (n:) . ns) bs)
- fr vs exp = (vs++) . exp
- cas _ _ exp bs = exp . foldr (.) id bs
- branch pat exp = ((args pat)++) . exp
+ lt bs e = e . foldr (.) id (map (\ (n,ns) -> (n:) . ns) bs)
+ fr vs e = (vs++) . e
+ cas _ _ e bs = e . foldr (.) id bs
+ branch pat e = ((args pat)++) . e
args pat | isConsPattern pat = patArgs pat
| otherwise = []
@@ -802,7 +803,7 @@ allVars e = trExpr (:) (const id) comb lt fr (.) cas branch e []
rnmAllVars :: Update Expr VarIndex
rnmAllVars f = trExpr (Var . f) Lit Comb lt (Free . map f) Or Case branch
where
- lt = Let . map (\ (n,exp) -> (f n,exp))
+ lt = Let . map (\ (n,e) -> (f n,e))
branch = Branch . updPatArgs (map f)
--- update all qualified names in expression
@@ -815,13 +816,13 @@ updQNames f = trExpr Var Lit comb Let Free Or Case (Branch . updPatCons f)
--- transform branch expression
trBranch :: (Pattern -> Expr -> a) -> BranchExpr -> a
-trBranch branch (Branch pat exp) = branch pat exp
+trBranch branch (Branch p e) = branch p e
-- Selectors
--- get pattern from branch expression
branchPattern :: BranchExpr -> Pattern
-branchPattern = trBranch (\pat _ -> pat)
+branchPattern = trBranch (\p _ -> p)
--- get expression from branch expression
branchExpr :: BranchExpr -> Expr
@@ -833,7 +834,7 @@ branchExpr = trBranch (\_ e -> e)
updBranch :: (Pattern -> Pattern) -> (Expr -> Expr) -> BranchExpr -> BranchExpr
updBranch fp fe = trBranch branch
where
- branch pat exp = Branch (fp pat) (fe exp)
+ branch pat e = Branch (fp pat) (fe e)
--- update pattern of branch expression
updBranchPattern :: Update BranchExpr Pattern
@@ -904,19 +905,20 @@ patExpr = trPattern (\ name -> Comb ConsCall name . map Var) Lit
-- (Will only succeed if all VarIndices and QNames contain the
-- required type information.)
typeofExpr :: Expr -> Maybe TypeExpr
-typeofExpr e = case e of
- Var vi -> typeofVar vi
- Lit l -> Just (typeofLiteral l)
- Comb _ qn as -> fmap (combType as) (typeofQName qn)
- Free _ e -> typeofExpr e
- Let _ e -> typeofExpr e
- Or e1 e2 -> typeofExpr e1 `mplus` typeofExpr e2
- Case _ _ _ bs -> msum (map (typeofExpr . branchExpr) bs)
+typeofExpr expr
+ = case expr of
+ Var vi -> typeofVar vi
+ Lit l -> Just (typeofLiteral l)
+ Comb _ qn as -> fmap (typeofApp as) (typeofQName qn)
+ Free _ e -> typeofExpr e
+ Let _ e -> typeofExpr e
+ Or e1 e2 -> typeofExpr e1 `mplus` typeofExpr e2
+ Case _ _ _ bs -> msum (map (typeofExpr . branchExpr) bs)
where
- combType [] t = t
- combType (_:as) (FuncType _ t) = combType as t
- combType (_:_) (TVar _) = ierr
- combType (_:_) (TCons _ _) = ierr
+ typeofApp [] t = t
+ typeofApp (_:as) (FuncType _ t) = typeofApp as t
+ typeofApp (_:_) (TVar _) = ierr
+ typeofApp (_:_) (TCons _ _) = ierr
ierr = error $ "internal error in typeofExpr: FuncType expected"
diff --git a/Curry/ExtendedFlat/Type.hs b/Curry/ExtendedFlat/Type.hs
index c190264deb479588c62b68087c4df2f09a3deecc..98e4d5fadca215e7cc6fb2e8c6f2ba18c2282935 100644
--- a/Curry/ExtendedFlat/Type.hs
+++ b/Curry/ExtendedFlat/Type.hs
@@ -78,7 +78,7 @@ data QName = QName {srcRef :: Maybe SrcRef,
instance Read QName where
readsPrec d r =
[ (mkQName nm,s) | (nm,s) <- readsPrec d r ]
- ++ [ (QName r t m n, s) | ((r, t, m, n),s) <- readsPrec d r ]
+ ++ [ (QName r' t m n, s) | ((r', t, m, n),s) <- readsPrec d r ]
instance Show QName where
showsPrec d (QName r t m n)
@@ -432,22 +432,22 @@ gshowsPrec showType d =
where
showsQName :: Bool -> QName -> ShowS
- showsQName d qn@QName{modName=m,localName=n,typeofQName=t} =
- if showType then showParen d (shows qn{srcRef=Nothing})
+ showsQName d' qn@QName{modName=m,localName=n} =
+ if showType then showParen d' (shows qn{srcRef=Nothing})
else shows (m,n)
showsVarIndex :: Bool -> VarIndex -> ShowS
- showsVarIndex d
- | showType = showParen d . shows
+ showsVarIndex d'
+ | showType = showParen d' . shows
| otherwise = shows . idxOf
genericShowsPrec :: Data a => Bool -> a -> ShowS
- genericShowsPrec d t = let args = intersperse (showChar ' ') $
- gmapQ (gshowsPrec showType True) t in
- showParen (d && not (null args)) $
- showString (showConstr (toConstr t)) .
- (if null args then id else showChar ' ') .
- foldr (.) id args
+ genericShowsPrec d' t = let args = intersperse (showChar ' ') $
+ gmapQ (gshowsPrec showType True) t in
+ showParen (d' && not (null args)) $
+ showString (showConstr (toConstr t)) .
+ (if null args then id else showChar ' ') .
+ foldr (.) id args
showsList :: Data a => [a] -> ShowS
showsList xs = showChar '[' .
diff --git a/Curry/Files/PathUtils.hs b/Curry/Files/PathUtils.hs
index 6e842ac6967f57a1ad429abd99ef0d171ec812ee..35734fc06da0c36558d09d7f0d9894eec65243c0 100644
--- a/Curry/Files/PathUtils.hs
+++ b/Curry/Files/PathUtils.hs
@@ -52,9 +52,9 @@ lookupFile paths exts file = lookupFile' paths'
let fn = p `combine` replaceExtension file e
[fn, inCurrySubdir fn]
lookupFile' [] = return Nothing
- lookupFile' (fn:paths)
+ lookupFile' (fn:ps)
= do so <- doesFileExist fn
- if so then return (Just fn) else lookupFile' paths
+ if so then return (Just fn) else lookupFile' ps
@@ -69,7 +69,7 @@ inSubdir sub fn = joinPath $ add (splitDirectories fn)
add ps@[_] = sub:ps
add ps@[p,_] | p==sub = ps
add (p:ps) = p:add ps
- add "" = error "inSubdir: called with empty path"
+ add [] = error "inSubdir: called with empty path"
--The sub directory to hide files in:
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000000000000000000000000000000000000..c463fe8ff05245a89667e652d0147d9dcab916c6
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 1998-2004, Wolfgang Lux
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+3. None of the names of the copyright holders and contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/curry-base.cabal b/curry-base.cabal
new file mode 100644
index 0000000000000000000000000000000000000000..1f6af5222706085a3d7e5624afb998eecd1e9591
--- /dev/null
+++ b/curry-base.cabal
@@ -0,0 +1,23 @@
+Name: curry-base
+Version: 0.2.2
+Cabal-Version: >= 1.6
+Synopsis: Functions for manipulating Curry programs
+Description:
+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
+Build-Type: Simple
+Stability: experimental
+
+Library
+ Build-Depends: base >= 3 && < 4, mtl, old-time, directory, filepath, containers, pretty
+ ghc-options: -Wall -fwarn-unused-binds -fwarn-unused-imports -auto-all
+ Exposed-Modules: Curry.Base.Position, Curry.Base.Ident, Curry.Base.MessageMonad
+ Curry.ExtendedFlat.Type, Curry.ExtendedFlat.Goodies, Curry.ExtendedFlat.TypeInference
+ Curry.FlatCurry.Type, Curry.FlatCurry.Goodies, Curry.FlatCurry.Tools
+ Curry.Files.Filenames, Curry.Files.PathUtils
+ Other-Modules: