Commit 492e104d authored by Kai-Oliver Prott's avatar Kai-Oliver Prott
Browse files

Modify for base-2.0.0

parent 83fe0dfc
......@@ -5,17 +5,16 @@
"synopsis": "The standard preprocessor of Curry",
"category": [ "Programming", "Analysis" ],
"dependencies": {
"base" : ">= 1.0.0, < 2.0.0",
"abstract-curry": ">= 2.0.0",
"cass-analysis" : ">= 2.0.0",
"cass" : ">= 2.0.0",
"cdbi" : ">= 2.0.0",
"currycheck" : ">= 2.0.0",
"abstract-curry": ">= 3.0.0",
"cass-analysis" : ">= 3.0.0",
"cass" : ">= 3.0.0",
"cdbi" : ">= 3.0.0",
"currycheck" : ">= 3.0.0",
"fl-parser" : ">= 1.0.0",
"html" : ">= 2.0.0",
"regexp" : ">= 1.1.0",
"wl-pprint" : ">= 0.0.1",
"xml" : ">= 2.0.0"
"html" : ">= 3.0.0",
"regexp" : ">= 2.0.0",
"wl-pprint" : ">= 2.0.0",
"xml" : ">= 3.0.0"
},
"compilerCompatibility": {
"pakcs": ">= 2.0.0",
......
......@@ -23,5 +23,3 @@ sort'post xs ys = length xs == length ys
sort7 = sort (map showInt [7,1,6,3,5,4,2]) -=- map (\d -> "+00"++show d) [1..7]
sortEmpty = toError (sort ([] :: [Int]))
......@@ -22,14 +22,15 @@ import AbstractCurry.Pretty
import AbstractCurry.Build
import AbstractCurry.Select
import AbstractCurry.Transform
import Char
import ContractUsage
import Directory
import System.Directory
import System.Process
import System.Environment (getArgs)
import System.FilePath (takeDirectory)
import Distribution
import FilePath (takeDirectory)
import List
import Maybe (fromJust, isNothing)
import System
import Data.List
import Data.Char
import Data.Maybe (fromJust, isNothing)
-- in order to use the determinism analysis:
import Analysis.ProgInfo (ProgInfo, lookupProgInfo)
......
......@@ -4,7 +4,7 @@ import Test.EasyCheck
-- Example: predicate to check for float strings
import Char(isDigit)
import Data.Char (isDigit)
-- Is the argument a non-negative float string (without exponent)?
isNNFloat :: String -> Bool
......@@ -15,4 +15,3 @@ main = map isNNFloat ["3.14","314"]
test1 = isNNFloat "3.14" -=- True
test2 = isNNFloat "314" -=- False
......@@ -5,7 +5,7 @@ import Test.EasyCheck
-- Example: parse World Cup soccer scores (e.g., "_:_", "3:2")
import Char(isDigit)
import Data.Char (isDigit)
parse (team1++" _:_ "++team2) = (team1, team2, Nothing)
parse (team1++[' ',x,':',y,' ']++team2)
......
......@@ -11,14 +11,14 @@ import AbstractCurry.Files
import AbstractCurry.Select
import AbstractCurry.Build
import AbstractCurry.Pretty
import Char(isDigit,digitToInt)
import DefaultRuleUsage
import Directory
import Data.Char (isDigit,digitToInt)
import Data.List(isPrefixOf,isSuffixOf,partition)
import System.Directory
import System.FilePath (takeDirectory)
import System.Process
import Distribution
import FilePath (takeDirectory)
import List(isPrefixOf,isSuffixOf,partition)
import System
import TheoremUsage
import DefaultRuleUsage
--------------------------------------------------------------------
......
......@@ -7,8 +7,8 @@
------------------------------------------------------------------------------
module CIParser(parse) where
import List
import Char
import Data.List
import Data.Char
import ParseTypes
......
......@@ -35,4 +35,3 @@ printFl f = ``printf "% 20.4f\n",f''
printEl :: Float -> IO ()
printEl f = do ``printf "%+20.3E",f'' >> putStr " meters\n"
putStrLn "DONE!"
import Uni
import Database.CDBI.ER
import Database.CDBI.Connection
import Time
import Data.Time
--- Creates the test data for Uni database.
main :: IO ()
......
......@@ -4,7 +4,7 @@
--- Checking whether the preprocessor detects errors
import Database.CDBI.ER as C
import Time
import Data.Time
import Uni
-- "Scanner" errors
......
......@@ -4,7 +4,7 @@
--- using currypp
import Database.CDBI.ER
import Time
import Data.Time
import Uni
-- Selecting key Values
......
......@@ -4,7 +4,7 @@
import Database.CDBI.Connection
import Database.CDBI.ER
import Time
import Data.Time
import Uni
import Test.Prop
......
......@@ -29,8 +29,8 @@
module FormatParser(parse) where
import Parser
import Char
import ReadNumeric
import Data.Char
import Numeric
import AllSolutions
import ParseTypes
......@@ -143,13 +143,13 @@ addVarsToSpecifiers po ((Left x):xs) [] =
addVarsToSpecifiers po (q:qs) varis@(v:vs) = case q of
(Left stri) -> liftPM ((:) (Left stri))
(addVarsToSpecifiers po qs varis)
(Right (Spec f w p t)) -> if (isStar w)
(Right (Spec f w p t)) -> if isStar w
then
let iv = Just (Left (fst $ maybe failed id $ readNat v))
let iv = Just (Left (extractNat v))
in addVarsToSpecifiers po (Right (Spec f iv p t):qs) vs
else if (isStar p)
else if isStar p
then
let iv = Just (Left (fst $ maybe failed id $ readNat v))
let iv = Just (Left (extractNat v))
in addVarsToSpecifiers po (Right (Spec f w iv t):qs) vs
else liftPM ((:) (Right (SpecV f (eE w) (eE p) t v)))
(addVarsToSpecifiers po qs vs)
......@@ -246,4 +246,6 @@ varInner :: Char -> String -> String
varInner = satisfy (\c -> isVarInnerLetter c) i >>> i where i free
extractNat :: String -> Int
extractNat s = maybe failed (fst . id) (readNat s)
extractNat s = case readNat s of
[(v,_)] -> v
_ -> failed
......@@ -8,7 +8,7 @@ module HTMLContentModel where
import MLTypes
import Char
import Data.Char
isHtmlElement :: Symbol -> Bool
isHtmlElement sym = isTag sym && elem (map toLower (tgn sym)) htmlElements
......
......@@ -14,8 +14,8 @@ import HTMLContentModel
import MLTypes
import MLWarning
import Char
import List
import Data.Char
import Data.List
-- characters
HT = chr 009 -- '\t'
......
......@@ -11,7 +11,7 @@ import ParseTypes
import MLParser
import MLTypes
import List
import Data.List
showText :: Text -> String
showText (Raw s) = show (dropTrailingCR s)
......
......@@ -7,7 +7,7 @@
module MLTypes where
import ParseTypes
import Char
import Data.Char
data L = X | H
......
......@@ -10,9 +10,9 @@
module RegexParser(parse) where
import Parser
import Char
import List
import ReadNumeric
import Data.Char
import Data.List
import Numeric
import ParseTypes
......@@ -304,8 +304,12 @@ parseCBracket p r ts = pars p (cleanPM [(Times (curlyParser (init cont)) r)])
curlyParser :: [Token] -> (Int,Int)
curlyParser tks = (fst fir,fst sec)
where
fir = maybe failed id (readNat (extractChars tks))
sec = maybe failed id (readNat (tail (snd fir)))
fir = case readNat (extractChars tks) of
[v] -> v
_ -> failed
sec = case readNat (tail (snd fir)) of
[v] -> v
_ -> failed
--- Arrow bracket (Variable)
parseABracket :: Pos -> [Token] -> PM (String,[Token])
......
......@@ -6,7 +6,7 @@
module SQLAst where
import Time(CalendarTime)
import Data.Time (CalendarTime)
data Statement = Select SelectHead Order (Maybe Int)
| Update Table [Assign] Condition
......
......@@ -19,9 +19,9 @@
module SQLConsistency(checkConsistency) where
import Char(toLower, toUpper)
import FiniteMap
import List(delete)
import Data.Char (toLower, toUpper)
import qualified Data.Map as Map
import Data.List (delete)
import ParseTypes
......@@ -69,7 +69,7 @@ checkStatement p relMap colMap _ (Update tab assigns cond) =
(checkColUpdate p relMap colMap assigns cond)
checkStatement p relMap colMap _ (Select selHead order limit) =
liftPM (\(chHead, chOrd) -> Select chHead chOrd limit)
(checkSelect p relMap colMap selHead order (emptyFM (>)))
(checkSelect p relMap colMap selHead order (Map.empty))
-- ------------------------delete statement ------------------------------
......@@ -77,7 +77,7 @@ checkDelete :: Pos ->
RelationFM ->
AttributesFM ->
Condition ->
((FM String (String, [String])), Table) ->
((Map.Map String (String, [String])), Table) ->
PM Statement
checkDelete p relMap colMap cond (fm, tab) =
liftPM (\chCond -> (Delete tab chCond))
......@@ -94,7 +94,7 @@ checkSelect :: Pos ->
AttributesFM ->
SelectHead ->
Order ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
PM (SelectHead, Order)
checkSelect p relMap colMap selhead order fm =
let (chHead, tabMap) = checkSelHead p relMap colMap selhead fm
......@@ -115,8 +115,8 @@ checkSelHead :: Pos ->
RelationFM ->
AttributesFM ->
SelectHead ->
FM String (String, [String]) ->
(PM SelectHead, FM String (String, [String]))
Map.Map String (String, [String]) ->
(PM SelectHead, Map.Map String (String, [String]))
checkSelHead p relMap colMap (Query selClause (TableRef tab join) cond gr) fm =
let chTabs = checkTableRefs p colMap tab join fm
in case chTabs of
......@@ -130,15 +130,15 @@ checkSelHead p relMap colMap (Query selClause (TableRef tab join) cond gr) fm =
(checkCondGr p relMap colMap tabMap cond gr),
tabMap)
(Left tabname) -> (throwPM p ("Undefined table name: "++tabname),
(emptyFM (>)))
(Map.empty))
checkSelHead p relMap colMap (Set setOp head1 head2) fm =
let (chHead1, fm1) = checkSelHead p relMap colMap head1 fm
(chHead2, fm2) = checkSelHead p relMap colMap head2 fm
in ((combinePMs (\h1 h2 -> Set setOp h1 h2) chHead1 chHead2),(plusFM fm1 fm2))
in ((combinePMs (\h1 h2 -> Set setOp h1 h2) chHead1 chHead2),(Map.union fm2 fm1))
checkSelClause :: Pos ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
RelationFM ->
AttributesFM ->
SelectClause ->
......@@ -151,7 +151,7 @@ checkSelClause p fm relMap colMap (SelColumns sp elems) =
checkSelElems :: Pos ->
[SelElement] ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
RelationFM ->
AttributesFM ->
PM [SelElement]
......@@ -159,7 +159,7 @@ checkSelElems p elems fm relMap colMap =
sequencePM (map (checkSelElem p fm relMap colMap) elems)
checkSelElem :: Pos ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
RelationFM ->
AttributesFM ->
SelElement ->
......@@ -182,32 +182,32 @@ checkTableRefs :: Pos ->
AttributesFM ->
Table ->
Maybe JoinClause ->
FM String (String, [String]) ->
Either String (FM String (String, [String]))
Map.Map String (String, [String]) ->
Either String (Map.Map String (String, [String]))
checkTableRefs p colMap (Table name al nAl) join fm =
let columns = lookupFM colMap (lowerCase name)
let columns = Map.lookup (lowerCase name) colMap
in case columns of
Nothing -> Left name
(Just (tn, cols)) ->
case join of
Nothing -> Right (addToFM fm (lowerCase name) (tn,cols))
Nothing -> Right (Map.insert (lowerCase name) (tn,cols) fm)
(Just (CrossJoin tab j)) ->
checkTableRefs p
colMap
tab
j
(addToFM fm (lowerCase name) (tn,cols))
(Map.insert (lowerCase name) (tn,cols) fm)
(Just (InnerJoin tab _ j)) ->
checkTableRefs p
colMap
tab
j
(addToFM fm (lowerCase name) (tn,cols))
(Map.insert (lowerCase name) (tn,cols) fm)
checkJoinConds :: Pos ->
Table ->
(Maybe JoinClause) ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
RelationFM ->
AttributesFM ->
PM TableRef
......@@ -230,7 +230,7 @@ checkJoinConds p tab (Just (InnerJoin tab2 cond join)) fm relMap colMap =
checkJoinCondition :: Pos ->
JoinCond ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
RelationFM ->
AttributesFM ->
PM JoinCond
......@@ -240,7 +240,7 @@ checkJoinCondition p (JC cond) fm relMap colMap =
checkJoinConds' :: Pos ->
(Maybe JoinClause) ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
RelationFM ->
AttributesFM ->
PM (Maybe JoinClause)
......@@ -257,9 +257,9 @@ checkJoinConds' p (Just (InnerJoin tab cond join)) fm relMap colMap =
(checkJoinConds' p join fm relMap colMap)
-- Generates warning if different notation is used for table name.
checkTableName :: Pos -> Table -> FM String (String, [String]) -> PM Table
checkTableName :: Pos -> Table -> Map.Map String (String, [String]) -> PM Table
checkTableName p (Table tn al nAl) fm =
case lookupFM fm (lowerCase tn) of
case Map.lookup (lowerCase tn) fm of
(Just (name, _)) ->
if name == tn
then cleanPM (Table name al nAl)
......@@ -271,7 +271,7 @@ checkTableName p (Table tn al nAl) fm =
checkCondGr :: Pos ->
RelationFM ->
AttributesFM ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
Condition ->
Maybe Group ->
PM (Condition, (Maybe Group))
......@@ -288,11 +288,11 @@ checkSelCond :: Pos ->
RelationFM ->
AttributesFM ->
Condition ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
PM Condition
checkSelCond p relMap _ (FK (name1, al1) (NotSpec rel) (name2, al2)) fm =
let tab1 = maybe name1 fst (lookupFM fm (lowerCase name1))
tab2 = maybe name2 fst (lookupFM fm (lowerCase name2))
let tab1 = maybe name1 fst (Map.lookup (lowerCase name1) fm)
tab2 = maybe name2 fst (Map.lookup (lowerCase name2) fm)
in case (lookupRel (tab1, rel, tab2) relMap) of
Nothing -> throwPM p ("Undefined relation "++rel++" between "++name1++
" and "++name2)
......@@ -349,7 +349,7 @@ checkGroup :: Pos ->
RelationFM ->
AttributesFM ->
(Maybe Group) ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
PM (Maybe Group)
checkGroup _ _ _ Nothing _ = cleanPM Nothing
checkGroup p relMap colMap (Just (GroupBy cols hav)) fm =
......@@ -361,7 +361,7 @@ checkHaving :: Pos ->
RelationFM ->
AttributesFM ->
Having ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
PM Having
checkHaving _ _ _ NoHave _ = cleanPM NoHave
checkHaving p rM cM (CmpHave logop hav1 hav2) fm =
......@@ -378,13 +378,13 @@ checkHaving p rM cM (SimpleHave cond) fm =
liftPM (\chCond -> SimpleHave chCond)
(checkSelCond p rM cM cond fm)
checkOrder :: Pos -> FM String (String, [String]) -> Order -> PM Order
checkOrder :: Pos -> Map.Map String (String, [String]) -> Order -> PM Order
checkOrder p fm (OrderBy colDirs) =
liftPM (\chColDirs -> (OrderBy chColDirs))
(sequencePM (map (checkColDir p fm) colDirs))
checkColDir :: Pos ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
(ColumnRef, Dir) ->
PM (ColumnRef, Dir)
checkColDir p fm (col, dir) = liftPM (\chCol -> (chCol, dir))
......@@ -397,14 +397,14 @@ checkColUpdate :: Pos ->
AttributesFM ->
[Assign] ->
Condition ->
(FM String (String, [String]), Table) ->
(Map.Map String (String, [String]), Table) ->
PM Statement
checkColUpdate p relMap colMap assigns cond (fm, tab) =
combinePMs (\chAssigns chCond -> (Update tab chAssigns chCond))
(sequencePM (map (checkAssign p fm) assigns))
(checkCondition p relMap colMap cond fm)
checkAssign :: Pos -> FM String (String, [String]) -> Assign -> PM Assign
checkAssign :: Pos -> Map.Map String (String, [String]) -> Assign -> PM Assign
checkAssign p fm (Assign col val) =
liftPM (\chCol -> (Assign chCol val))
(checkColumnRef p col fm)
......@@ -425,7 +425,7 @@ checkInsert :: Pos ->
NullableFM ->
[ColumnRef] ->
[[Value]] ->
(FM String (String, [String]), Table) ->
(Map.Map String (String, [String]), Table) ->
PM Statement
checkInsert p colMap nullMap cols valss (fm, tab) =
combinePMs (\chCols chValss -> (Insert tab chCols chValss))
......@@ -437,10 +437,10 @@ checkValueClause :: Pos ->
Table ->
[ColumnRef] ->
[[Value]] ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
PM [[Value]]
checkValueClause p nullMap tab@(Table tn _ _) cols valss fm =
let colNames = foldr (++) [] (map snd (eltsFM fm))
let colNames = foldr (++) [] (map snd (Map.elems fm))
in
if not (and (map (checkValueCnt (length cols)) valss))
then throwPM p ("Number of values given in insert statement is not equal "
......@@ -497,7 +497,7 @@ checkNulls p _ tab [] (_:_) = throwPM p ("Too much values given for table "
++tab)
checkNulls p nullables tab (c:cols) (v:vals) =
case v of
AbsNull -> case lookupFM nullables ((firstLow tab)++c) of
AbsNull -> case Map.lookup ((firstLow tab)++c) nullables of
(Just True) -> liftPM (\vs -> (v:vs))
(checkNulls p nullables tab cols vals)
_ -> throwPM p ("Column "++c++" is not nullable.")
......@@ -537,7 +537,7 @@ getNullColumns :: NullableFM ->
Either String [Int]
getNullColumns _ _ [] [] _ nulls = Right nulls
getNullColumns nullables tab (n:ns) [] cnt nulls =
case lookupFM nullables ((firstLow tab)++n) of
case Map.lookup ((firstLow tab)++n) nullables of
(Just True) -> getNullColumns nullables tab ns [] (cnt+1) (cnt:nulls)
_ -> Left n
getNullColumns _ _ [] ((Column _ col _ _ _):_) _ _ = Left col
......@@ -546,7 +546,7 @@ getNullColumns nullables tab (n:ns) cols@((Column _ col _ _ _):cs) cnt nulls =
then getNullColumns nullables tab ns cs (cnt+1) nulls
else if n == "Key"
then getNullColumns nullables tab ns cols (cnt+1) (0:nulls)
else case lookupFM nullables ((firstLow tab)++n) of
else case Map.lookup ((firstLow tab)++n) nullables of
(Just True) -> getNullColumns nullables
tab
ns
......@@ -579,14 +579,14 @@ insertColumnRefs :: AttributesFM ->
Table ->
PM [ColumnRef]
insertColumnRefs colMap nullMap (Table name _ _) =
let cols = lookupFM colMap (lowerCase name)
let cols = Map.lookup (lowerCase name) colMap
in case cols of
(Just (tab,cs)) -> cleanPM (map (buildColRef nullMap name) cs)
Nothing -> cleanPM []
buildColRef :: NullableFM -> String -> String -> ColumnRef
buildColRef nullMap tab col =
case lookupFM nullMap ((firstLow tab)++ col) of
case Map.lookup ((firstLow tab)++ col) nullMap of
Nothing -> (Column (Unique tab) col Unknown False 0) --should not happen
(Just b) -> (Column (Unique tab) col Unknown b 0)
......@@ -600,14 +600,14 @@ buildColRef nullMap tab col =
checkTable :: Pos ->
AttributesFM ->
Table ->
PM ((FM String (String,[String])), Table)
PM ((Map.Map String (String,[String])), Table)
checkTable p colMap (Table name al nAl) =
case lookupFM colMap (lowerCase name) of
case Map.lookup (lowerCase name) colMap of
Nothing -> throwPM p ("There is no Table called "++name)
(Just (tab,cs)) -> if name == tab
then cleanPM ((unitFM (>) (lowerCase name) (tab,cs)),
then cleanPM ((Map.singleton (lowerCase name) (tab,cs)),
(Table tab al nAl))
else warnOKPM ((unitFM (>) (lowerCase name) (tab,cs)),
else warnOKPM ((Map.singleton (lowerCase name) (tab,cs)),
(Table tab al nAl))
[(p, ("Different notation used for "++
"table "++tab++" : "++name))]
......@@ -618,7 +618,7 @@ checkCondition :: Pos ->
RelationFM ->
AttributesFM ->
Condition ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
PM Condition
checkCondition p rM cM (Not cond) fm = liftPM (\chCond -> Not chCond)
(checkCondition p rM cM cond fm)
......@@ -658,7 +658,7 @@ checkSubquery :: Pos ->
RelationFM ->
AttributesFM ->
Statement ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
PM Statement
checkSubquery p rM cM (Select selHead order lim) fm =
liftPM (\(chHead, chOrd) -> Select chHead chOrd lim)
......@@ -666,7 +666,7 @@ checkSubquery p rM cM (Select selHead order lim) fm =
-- Checks the operands that are used in the condition.
-- An error is thrown in case a null-value is passed.
checkOperand :: Pos -> Operand -> FM String (String, [String]) -> PM Operand
checkOperand :: Pos -> Operand -> Map.Map String (String, [String]) -> PM Operand
checkOperand p (Left col) fm = liftPM (\chCol -> Left chCol)
(checkColumnRef p col fm)
checkOperand p op@(Right val) _ =
......@@ -683,10 +683,10 @@ checkOperand p op@(Right val) _ =
-- one table this one is set. An error is thrown in all other cases.
checkColumnRef :: Pos ->
ColumnRef ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->
PM ColumnRef
checkColumnRef p cr@(Column (Unique tab) _ _ _ _) fm =
case lookupFM fm (lowerCase tab) of
case Map.lookup (lowerCase tab) fm of
Nothing -> throwPM p ("Table called "++tab++" is not defined.")
Just (tn,cols) -> findCorresName p cols tn cr
checkColumnRef p (Column (Def tabs) colName typ n nAl) fm =
......@@ -702,12 +702,12 @@ checkColumnRef p (Column (Def tabs) colName typ n nAl) fm =
-- Looks up a column name in all tables that were given without an alias.
checkAllTables :: [String] ->
String ->
FM String (String, [String]) ->
Map.Map String (String, [String]) ->