Commit fc05abf2 authored by Michael Hanus 's avatar Michael Hanus
Browse files

currypp typeclass version packaged, sequential rules translation removed

parent 5d3f0bbe
{
"name": "currypp",
"version": "0.3.1",
"version": "2.0.0",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "The standard preprocessor of Curry",
"category": [ "Analysis" ],
"dependencies": {
"cass-analysis": ">= 0.0.4",
"cass" : ">= 0.0.1",
"currycheck" : ">= 1.0.0",
"verify" : ">= 0.0.1"
"cass-analysis": ">= 2.0.0",
"cass" : ">= 2.0.0",
"currycheck" : ">= 2.0.0"
},
"compilerCompatibility": {
"pakcs": ">= 1.14.0, < 2.0.0",
"kics2": ">= 0.5.0, < 2.0.0"
"pakcs": ">= 2.0.0",
"kics2": ">= 2.0.0"
},
"sourceDirs": [ "src", "src/IntegratedCode", "src/IntegratedCode/Parser",
"sourceDirs": [ "src", "src/IntegratedCode",
"src/IntegratedCode/Parser",
"src/IntegratedCode/Parser/ML",
"src/IntegratedCode/Parser/SQL",
"src/SequentialRules", "src/DefaultRules",
"src/DefaultRules",
"src/ContractWrapper"
],
"exportedModules": [ "Main" ],
......
......@@ -10,7 +10,7 @@ import Test.Prop
showInt i = ``format "%+.3d",i''
-- Bubble sort formulation with default rule as deterministic operation:
sort :: [a] ->DET [a]
sort :: (Ord a, Show a) => [a] ->DET [a]
sort (xs++[x,y]++ys) | x>y = sort (xs++[y,x]++ys)
sort'default xs = xs
......@@ -22,6 +22,6 @@ 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 [])
sortEmpty = toError (sort ([] :: [Int]))
......@@ -2,17 +2,21 @@
import Test.Prop
-- Examples with nondeterministicm specifications
-- Examples with non-determinististic specifications
coin'spec :: Int
coin'spec = 0 ? 1
coin :: Int
coin = 1 ? 0 --> should be executed without violation
coinCorrect = coin <~> coin'spec
coin3'spec :: Int
coin3'spec = coin'spec
coin3 :: Int
coin3 = coin ? 2 --> should produce a violation
coin3Violation = toError coin3
......@@ -6,6 +6,7 @@ import Test.Prop
-- recursive definition
-- (Deterministic!) specification of all Fibonacci numbers:
fibs'spec :: [Int]
fibs'spec = map fib [0..]
where fib n | n == 0 = 0
| n == 1 = 1
......@@ -15,6 +16,7 @@ fibs'spec = map fib [0..]
fibs'post'observe xs = take 10 xs
-- A more efficient (but erroneous) implementation of all Fibonacci numbers:
fibs :: [Int]
fibs = fiblist 0 1
where
fiblist x y = x : fiblist (x+y) y
......
......@@ -11,7 +11,7 @@
--- > Declarative Languages (PADL 2012), pp. 33-47, Springer LNCS 7149, 2012
---
--- @author Michael Hanus
--- @version August 2016
--- @version October 2016
------------------------------------------------------------------------
module TransContracts(main,transContracts) where
......@@ -28,7 +28,7 @@ import Directory
import Distribution
import FilePath (takeDirectory)
import List
import Maybe (fromJust)
import Maybe (fromJust, isNothing)
import System
-- in order to use the determinism analysis:
......@@ -201,7 +201,7 @@ transformProgram :: Options -> [(QName,Int)]-> [CFuncDecl]
-> ProgInfo Deterministic -> [CFuncDecl]
-> [CFuncDecl] -> [CFuncDecl] -> CurryProg -> CurryProg
transformProgram opts funposs allfdecls detinfo specdecls predecls postdecls
(CurryProg mname imps tdecls orgfdecls opdecls) =
(CurryProg mname imps dfltdecl clsdecls instdecls tdecls orgfdecls opdecls) =
let -- replace in program old postconditions by new simplified postconditions:
fdecls = filter (\fd -> funcName fd `notElem` map funcName postdecls)
orgfdecls ++ postdecls
......@@ -217,7 +217,7 @@ transformProgram opts funposs allfdecls detinfo specdecls predecls postdecls
contractpcs = postdecls++newpostconds
in CurryProg mname
(nub ("Test.Contract":"SetFunctions":imps))
tdecls
dfltdecl clsdecls instdecls tdecls
(map deleteCmtIfEmpty
(map (addContract opts funposs allfdecls predecls contractpcs)
wonewfuns ++
......@@ -226,8 +226,10 @@ transformProgram opts funposs allfdecls detinfo specdecls predecls postdecls
-- Add an empty comment to each function which has no comment
addCmtFuncInProg :: CurryProg -> CurryProg
addCmtFuncInProg (CurryProg mname imps tdecls fdecls opdecls) =
CurryProg mname imps tdecls (map addCmtFunc fdecls) opdecls
addCmtFuncInProg
(CurryProg mname imps dfltdecl clsdecls instdecls tdecls fdecls opdecls) =
CurryProg mname imps dfltdecl clsdecls instdecls tdecls
(map addCmtFunc fdecls) opdecls
where
addCmtFunc (CFunc qn ar vis texp rs) = CmtFunc "" qn ar vis texp rs
addCmtFunc (CmtFunc cmt qn ar vis texp rs) = CmtFunc cmt qn ar vis texp rs
......@@ -239,7 +241,8 @@ addCmtFuncInProg (CurryProg mname imps tdecls fdecls opdecls) =
genPostCond4Spec :: Options -> [CFuncDecl] -> ProgInfo Deterministic
-> [CFuncDecl] -> CFuncDecl -> [CFuncDecl]
genPostCond4Spec _ _ _ _ (CFunc _ _ _ _ _) = error "genPostCond4Spec"
genPostCond4Spec _ allfdecls detinfo postdecls (CmtFunc _ (m,f) ar vis texp _) =
genPostCond4Spec _ allfdecls detinfo postdecls
(CmtFunc _ (m,f) ar vis (CQualType (CContext clscons) texp) _) =
let fname = fromSpecName f
-- is the specification deterministic?
detspec = maybe False (== Det) (lookupProgInfo (m,f) detinfo)
......@@ -260,11 +263,12 @@ genPostCond4Spec _ allfdecls detinfo postdecls (CmtFunc _ (m,f) ar vis texp _) =
allfdecls)
gspecname = (m,f++"'g")
gspec = cfunc gspecname ar Private
((resultType texp ~> gtype) ~> replaceResultType texp gtype)
[let gsargvars = map (\i -> (i,"x"++show i)) [1..ar] in
simpleRule (CPVar varg : map CPVar gsargvars)
(CApply (CVar varg)
(applyF (m,f) (map CVar gsargvars)))]
(CQualType (CContext ((pre "Eq", gtype) : clscons))
((resultType texp ~> gtype) ~> replaceResultType texp gtype))
[let gsargvars = map (\i -> (i,"x"++show i)) [1..ar]
in simpleRule (CPVar varg : map CPVar gsargvars)
(CApply (CVar varg)
(applyF (m,f) (map CVar gsargvars)))]
postcheck = CLetDecl
[CLocalPat (CPVar varz)
(CSimpleRhs (CApply (CVar varg) (CVar resultvar)) [])]
......@@ -283,7 +287,8 @@ genPostCond4Spec _ allfdecls detinfo postdecls (CmtFunc _ (m,f) ar vis texp _) =
("Parametric postcondition for '"++fname++
"' (generated from specification). "++oldcmt)
(m,fpgenname) (ar+2) Private
((resultType texp ~> gtype) ~> extendFuncType texp boolType)
(CQualType (CContext ((pre "Eq", gtype) : clscons))
((resultType texp ~> gtype) ~> extendFuncType texp boolType))
[if null oldfpostc
then simpleRule (map CPVar (varg:argvars)) postcheck
else simpleRuleWithLocals
......@@ -299,18 +304,34 @@ genPostCond4Spec _ allfdecls detinfo postdecls (CmtFunc _ (m,f) ar vis texp _) =
("Postcondition for '"++fname++"' (generated from specification). "++
oldcmt)
(m,fpostname) (ar+1) vis
(extendFuncType texp boolType)
(CQualType
(CContext (union (type2EqConstraints (resultType texp)) clscons))
(extendFuncType texp boolType))
[simpleRule (map CPVar argvars)
(applyF (m,fpgenname)
(constF obsfun : map CVar argvars))]
]
-- Transform a type into Eq constraints for all type variables occurring
-- in this type. Note: this is not sufficient since one needs also be
-- sure that each type constructor has an Eq instance.
type2EqConstraints :: CTypeExpr -> [CConstraint]
type2EqConstraints texp =
map (\tv -> (pre "Eq",CTVar tv)) (nub (tvarsOfType texp))
-- Transform a type into Eq constraints for all type variables occurring
-- in this type. Note: this is not sufficient since one needs also be
-- sure that each type constructor has an Eq instance.
type2ShowConstraints :: CTypeExpr -> [CConstraint]
type2ShowConstraints texp =
map (\tv -> (pre "Show",CTVar tv)) (nub (tvarsOfType texp))
-- adds contract checking to a function if it has a pre- or postcondition
addContract :: Options -> [(QName,Int)] -> [CFuncDecl] -> [CFuncDecl]
-> [CFuncDecl] -> CFuncDecl -> CFuncDecl
addContract _ _ _ _ _ (CFunc _ _ _ _ _) = error "addContract"
addContract opts funposs allfdecls predecls postdecls
fdecl@(CmtFunc cmt qn@(m,f) ar vis texp _) =
fdecl@(CmtFunc cmt qn@(m,f) ar vis (CQualType (CContext clscons) texp) _) =
let argvars = map (\i -> (i,"x"++show i)) [1..ar]
predecl = find (\fd -> fromPreCondName (snd(funcName fd)) == f) predecls
prename = funcName (fromJust predecl)
......@@ -330,11 +351,11 @@ addContract opts funposs allfdecls predecls postdecls
funcName
(find (\fd -> snd (funcName fd) == f++"'post'observe")
allfdecls)
asrtCall = if predecl==Nothing
asrtCall = if isNothing predecl
then applyF (cMod $ "withPostContract" ++ show ar ++ encapsSuf)
([fref, encaps postname (ar+1), obsfunexp, orgfunexp] ++
map CVar argvars)
else if postdecl==Nothing
else if isNothing postdecl
then applyF (cMod $ "withPreContract" ++ show ar ++ encapsSuf)
([fref, encaps prename ar, orgfunexp] ++
map CVar argvars)
......@@ -345,9 +366,13 @@ addContract opts funposs allfdecls predecls postdecls
oldfdecl = if topLevelContracts opts
then updQNamesInCLocalDecl rename (CLocalFunc (deleteCmt fdecl))
else CLocalFunc (renameFDecl rename (deleteCmt fdecl))
in if predecl==Nothing && postdecl==Nothing then fdecl else
cmtfunc cmt (m,f) ar vis texp
[simpleRuleWithLocals (map CPVar argvars) asrtCall [oldfdecl]]
in if isNothing predecl && isNothing postdecl then fdecl else
cmtfunc cmt (m,f) ar vis
(CQualType (CContext
(union (type2EqConstraints (resultType texp))
(union (type2ShowConstraints texp) clscons)))
texp)
[simpleRuleWithLocals (map CPVar argvars) asrtCall [oldfdecl]]
-- An operation of the module Test.Contract:
......@@ -374,9 +399,9 @@ replaceResultType texp ntype =
-- Transform a n-ary function type into a (n+1)-ary function type with
-- a given new result type
extendFuncType :: CTypeExpr -> CTypeExpr -> CTypeExpr
extendFuncType t@(CTVar _) texp = t ~> texp
extendFuncType t@(CTCons _ _) texp = t ~> texp
extendFuncType (CFuncType t1 t2) texp = t1 ~> (extendFuncType t2 texp)
extendFuncType t texp = case t of
CFuncType t1 t2 -> t1 ~> (extendFuncType t2 texp)
_ -> t ~> texp
--- Renames a function declaration (but not the body).
renameFDecl :: (QName -> QName) -> CFuncDecl -> CFuncDecl
......@@ -429,7 +454,7 @@ infixIDs = "~!@#$%^&*+-=<>?./|\\:"
-- Rename all module references to "Test.Prog" into "Test.EasyCheck"
renameProp2EasyCheck :: CurryProg -> CurryProg
renameProp2EasyCheck prog =
updCProg id (map rnmMod) id id id
updCProg id (map rnmMod) id id id id id id
(updQNamesInCProg (\ (mod,n) -> (rnmMod mod,n)) prog)
where
rnmMod mod | mod == propModule = easyCheckModule
......
......@@ -7,12 +7,14 @@ import Test.EasyCheck
-- (by Sergio Antoy).
data State = WA | OR | ID | BC
deriving (Eq,Show)
states = [WA,OR,ID,BC]
adjacent = [(WA,OR),(WA,ID),(WA,BC),(OR,ID),(ID,BC)]
data Color = Red | Green | Blue
deriving (Eq,Show)
color x = (x, Red ? Green ? Blue)
......
......@@ -5,6 +5,7 @@ import Test.EasyCheck
-- Dijsktra's Dutch National Flag problem with functional patterns
data Color = Red | White | Blue
deriving (Eq,Show)
-- Formulation with default rule:
solveD :: [Color] -> [Color]
......
......@@ -6,6 +6,7 @@ import Test.EasyCheck
-- default rule declared as a deterministic function:
data Color = Red | White | Blue
deriving (Eq,Show)
solveD :: [Color] -> DET [Color]
solveD (x++[White]++y++[Red ]++z) = solveD (x++[Red ]++y++[White]++z)
......
......@@ -13,7 +13,7 @@ take'default _ _ = []
main1 = (take 0 [], take 2 [1..8], take 3 [1,2])
takeTest1 = take 0 [] -=- []
takeTest1 = take 0 [] -=- ([] :: [Int])
takeTest2 = take 2 [1..8] -=- [1,2]
takeTest3 = take 3 [1,2] -=- [1,2]
......
......@@ -12,8 +12,8 @@ main3 = nlookup 3 [(1,11),(3,14),(6,7),(3,19)] --> Just 14 | Just 19
main4 = nlookup 3 failed
main5 = nlookup () [((),1),(failed,2)] --> Just 1
test1 = nlookup 3 [] -=- Nothing
test1 = nlookup 3 [] -=- (Nothing :: Maybe Int)
test2 = nlookup 3 [(1,11),(3,14),(6,7)] -=- Just 14
test3 = nlookup 3 [(1,11),(3,14),(6,7),(3,19)] <~> (Just 14 ? Just 19)
test4 = failing $ nlookup 3 failed
test4 = failing $ (nlookup 3 failed :: Maybe Int)
test5 = nlookup () [((),1),(failed,2)] -=- Just 1
......@@ -27,6 +27,7 @@ move (x:xs) = (pick x : xs) ? (x : move xs)
pick (S n) = n ? pick n
data Nat = Z | S Nat
deriving (Eq,Show)
main = winMove [S (S Z), S Z]
......
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=defaultrules #-}
{-# OPTIONS_CYMAKE -Wnone #-}
import Integer(abs)
import Test.EasyCheck
-------------------------------------------------------------------------
......
......@@ -11,7 +11,7 @@ rev2'default xs = xs
main :: [[Int]]
main = map rev2 (map (\n->[1..n]) [0..4])
test1 = rev2 [] -=- []
test1 = rev2 [] -=- ([] :: [Int])
test2 = rev2 [1] -=- [1]
test3 = rev2 [1,2] -=- [2,1]
test4 = rev2 [1,2,3] -=- [1,2,3]
......
......@@ -3,7 +3,7 @@
--- and deterministic functions.
---
--- @author Michael Hanus
--- @version May 2016
--- @version October 2016
-----------------------------------------------------------------------------
import AbstractCurry.Types
......@@ -34,6 +34,7 @@ banner = unlines [bannerLine,bannerText,bannerLine]
-- Available translation schemes
data TransScheme = SpecScheme -- as specified in the PADL'16 paper
| NoDupScheme -- scheme without checking conditions twice
deriving (Eq,Show)
-- The default translation scheme:
defaultTransScheme :: TransScheme
......@@ -112,7 +113,8 @@ showQName (qn,fn) = "'" ++ qn ++ "." ++ fn ++ "'"
-- If the program was not transformed, `Nothing` is returned.
translateProg :: TransScheme -> CurryProg -> IO (Maybe ([QName],CurryProg))
translateProg trscm prog@(CurryProg mn imps tdecls fdecls ops) = do
translateProg trscm
prog@(CurryProg mn imps dfltdecl clsdecls instdecls tdecls fdecls ops) = do
let usageerrors = checkDefaultRules prog
unless (null usageerrors) $ do
putStr (unlines $ "ERROR: ILLEGAL USE OF DEFAULT RULES:" :
......@@ -122,7 +124,8 @@ translateProg trscm prog@(CurryProg mn imps tdecls fdecls ops) = do
-- now we do not have to check the correct usage of default rules...
return $ if null deffuncs && null detfuncnames
then Nothing
else Just (detfuncnames, CurryProg mn newimports tdecls newfdecls ops)
else Just (detfuncnames, CurryProg mn newimports dfltdecl clsdecls
instdecls tdecls newfdecls ops)
where
newimports = if setFunMod `elem` imps then imps else setFunMod:imps
detfuncnames = map funcName (filter isDetFun fdecls)
......@@ -138,11 +141,12 @@ translateProg trscm prog@(CurryProg mn imps tdecls fdecls ops) = do
isDetFun :: CFuncDecl -> Bool
isDetFun (CmtFunc _ qf ar vis texp rules) =
isDetFun (CFunc qf ar vis texp rules)
isDetFun (CFunc _ _ _ texp _) = hasDetResultType texp
isDetFun (CFunc _ _ _ (CQualType _ texp) _) = hasDetResultType texp
where
hasDetResultType (CTVar _) = False
hasDetResultType (CTVar _) = False
hasDetResultType (CTCons _) = False
hasDetResultType (CFuncType _ rt) = hasDetResultType rt
hasDetResultType (CTCons tc _) = tc == pre "DET"
hasDetResultType (CTApply tc _) = tc == CTCons (pre "DET")
-- translate a function (where the names of all deterministic functions
-- is provided as a first argument):
......@@ -171,15 +175,13 @@ transDetFun detfnames fdecl@(CFunc qf@(mn,fn) ar vis texp rules)
argvars = map (\i->(i,"x"++show i)) [1..ar]
removeDetResultType :: CTypeExpr -> CTypeExpr
removeDetResultType tv@(CTVar _) = tv
removeDetResultType (CFuncType t1 t2) =
CFuncType (removeDetResultType t1) (removeDetResultType t2)
removeDetResultType (CTCons tc texps) =
if tc == pre "DET"
then head texps
else CTCons tc (map removeDetResultType texps)
removeDetResultType :: CQualTypeExpr -> CQualTypeExpr
removeDetResultType (CQualType clsctxt te) = CQualType clsctxt (removeDet te)
where
removeDet tv@(CTVar _) = tv
removeDet tc@(CTCons _) = tc
removeDet (CFuncType t1 t2) = CFuncType t1 (removeDet t2)
removeDet t@(CTApply tc ta) = if tc == CTCons (pre "DET") then ta else t
------------------------------------------------------------------------
-- implementation of default rule transformation:
......@@ -263,14 +265,17 @@ transFDecl2ApplyCond nqf (CFunc _ ar _ texp rules) =
in CRule (map (anonymPat singlepatvars) rpats)
(CGuardedRhs (map (\gd -> (fst gd,preUnit)) gds) rlocals)
-- Adjust the result type of a type by setting the result type to ():
adjustResultTypeToUnit :: CTypeExpr -> CTypeExpr
adjustResultTypeToUnit texp =
if texp == preUntyped
then texp
else case texp of
CFuncType te1 te2 -> CFuncType te1 (adjustResultTypeToUnit te2)
_ -> unitType
-- Adjust the result type of a function type by setting this type to ():
adjustResultTypeToUnit :: CQualTypeExpr -> CQualTypeExpr
adjustResultTypeToUnit (CQualType clsctxt te) =
CQualType clsctxt (adjustRType te)
where
adjustRType texp =
if texp == preUntyped
then texp
else case texp of
CFuncType te1 te2 -> CFuncType te1 (adjustRType te2)
_ -> unitType
-- Translates a function declaration into one where the right-hand side
-- is encapsulated in a unary function, i.e., it just checks for applicability
......@@ -291,14 +296,18 @@ transFDecl2FunRHS nqf (CFunc _ ar _ texp rules) =
(map (\ (gd,rhs) -> (gd,(CLambda [CPVar (999,"_")] rhs))) gds)
rlocals)
-- Adjust the result type of a type by setting the result type to ():
adjustResultTypeToFunRHS :: CTypeExpr -> CTypeExpr
adjustResultTypeToFunRHS texp =
if texp == preUntyped
then texp
else case texp of
CFuncType te1 te2 -> CFuncType te1 (adjustResultTypeToFunRHS te2)
_ -> CFuncType unitType texp
-- Adjust the result type of a function type by setting the result type
-- `te` to `() -> texp`:
adjustResultTypeToFunRHS :: CQualTypeExpr -> CQualTypeExpr
adjustResultTypeToFunRHS (CQualType clsctxt te) =
CQualType clsctxt (adjustRType te)
where
adjustRType texp =
if texp == preUntyped
then texp
else case texp of
CFuncType te1 te2 -> CFuncType te1 (adjustRType te2)
_ -> CFuncType unitType texp
transDefaultRule :: QName -> Int -> CRule -> CRule
transDefaultRule _ _ (CRule _ (CGuardedRhs _ _)) =
......@@ -327,13 +336,13 @@ preUnit :: CExpr
preUnit = CSymbol (pre "()")
preUntyped :: CTypeExpr
preUntyped = CTCons (pre "untyped") []
preUntyped = CTCons (pre "untyped")
setFunMod :: String
setFunMod = "SetFunctions"
--- Extracts all elements with a single occurrence in a given list.
extractSingles :: [a] -> [a]
extractSingles :: Eq a => [a] -> [a]
extractSingles [] = []
extractSingles (x:xs) =
if null (filter (==x) xs)
......
......@@ -122,7 +122,7 @@ parserL1Iter acc accP p s@(c:cs)
--- @l2 - The list
--- @return (b,l) where b states wether l1 is a prefix of l2 and
--- l is the remaining list
isPrefixAndDrop :: [a] -> [a] -> (Bool,[a])
isPrefixAndDrop :: Eq a => [a] -> [a] -> (Bool,[a])
isPrefixAndDrop [] [] = (True,[])
isPrefixAndDrop (_:_) [] = (False,[])
isPrefixAndDrop [] (c:cs) = (True,(c:cs))
......@@ -136,7 +136,7 @@ isPrefixAndDrop (c:cs) (d:ds) | c == d = isPrefixAndDrop cs ds
--- @param l - The list
--- @return (i,l) where i states the amount of dropped elements and
--- l is the remaining list
countAndDrop :: a -> [a] -> (Int,[a])
countAndDrop :: Eq a => a -> [a] -> (Int,[a])
countAndDrop c s = countAndDropIter 0 s
where
countAndDropIter n [] = (n,[])
......
......@@ -37,4 +37,15 @@ htmlDoc1 =
[HtmlText "eoJ", HtmlText "\n"],
HtmlText "Bye!"]]]
test_Html_code = htmlTest1 "Joe" -=- htmlDoc1
------------------------------------------------------------------------------
-- Partial equality on HTML documents for testing.
instance Eq HtmlExp where
hexp1 == hexp2 = case (hexp1,hexp2) of
(HtmlText s, HtmlText t) -> s == t
(HtmlStruct t ats hes, HtmlStruct t' ats' hes') ->
t==t' && ats==ats' && hes == hes'
_ -> error "HTML.==: cannot compare cgi refs or handlers"
------------------------------------------------------------------------------
test_Html_code = always (htmlTest1 "Joe" == htmlDoc1)
......@@ -30,14 +30,14 @@ test_a_z_plus_2 = ("Abc" ``regex [a-z]+'') -=- False
-- Examples with parameterized regular expressions:
pregexp1 :: [a] -> a -> a -> Bool
pregexp1 :: Ord a => [a] -> a -> a -> Bool
pregexp1 s v1 v2 = s ``regex [<v1>-<v2>]*''
test_para_a_c_1 = pregexp1 "abccba" 'a' 'c' -=- True
test_para_a_c_2 = pregexp1 "abcdcba" 'a' 'c' -=- False
pregexp2 :: [a] -> a -> a -> Bool
pregexp2 :: Ord a => [a] -> a -> a -> Bool
pregexp2 s v1 v2 = s ``regex (<v1>|<v2>)*''
test_para_0_1_star_1 = pregexp2 [0,1,1,0,0] 0 1 -=- True
......
......@@ -266,14 +266,14 @@ testS36 = ``sql Select Count( Distinct r.StudentTakingKey)
from Result as r, Student as s
Group By r.Grade Having (Satisfies r belongs_to s);''
printResult :: SQLResult [a] -> IO()
printResult :: Show a => SQLResult [a] -> IO()
printResult result =
case result of
Left err -> putStrLn $ show err
Right res -> printList res
printList :: [a] -> IO ()
printList :: Show a => [a] -> IO ()
printList (x:xs) = do putStrLn $ show x
printList xs
printList [] = putStrLn ""
\ No newline at end of file
printList [] = putStrLn ""
......@@ -23,6 +23,7 @@ data WarnID = TagNameFirstDigit
--- A text element can be a raw text, a Curry expression that evaluates to some
--- text, or a Curry expression that evaluates to some content.
data Text = Raw String | ExpT String | ExpC String
deriving Eq
type TPos = (SimplePos,Int)
type Symbol = (Token,TPos)
......
......@@ -33,8 +33,7 @@ warn pos id ws = (fromSimplePos (fst pos),msg) : ws
-- map a list with a warning function, to get all warnings
wmap :: (a -> (b,[Warning])) -> [a] -> ([b],[Warning])
wmap f ys = wmapper ys
where wmapper :: [a] -> ([b],[Warning])
wmapper [] = ([],[])
where wmapper [] = ([],[])
wmapper (x:xs) =
let (p,q) = f x
(a,b) = wmapper xs
......
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