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

Integrated code of regexps does not implicitly "match" the expression

parent 72c2351f
......@@ -91,12 +91,12 @@ in a Curry program. The number of starting back ticks and ending ticks
must always be identical.
After the initial back ticks, there must be an identifier
specifying the kind of integrated code,
e.g., \code{regexp} or \code{html} (see below).
e.g., \code{regex} or \code{html} (see below).
For instance, if one uses regular expressions (see below for more details),
the following expressions are valid in source programs:
\begin{curry}
s ``regex (a|(bc*))+''
s ````regex aba*c''''
match ``regex (a|(bc*))+''
match ````regex aba*c''''
\end{curry}
The Curry preprocessor transforms these code pieces into regular
Curry expressions.
......@@ -115,7 +115,7 @@ In order to match strings against regular expressions, i.e.,
to check whether a string is contained in the language
generated by a regular expression, one can specify
regular expression similar to POSIX. The foreign regular
expression code must be marked by \ccode{regexp}.
expression code must be marked by \ccode{regex}.
Since this code is transformed into operations of the \CYS library
\code{RegExp}, this library must be imported.
......@@ -128,7 +128,7 @@ to check whether a string is a valid identifier:
import RegExp
isID :: String -> Bool
isID s = s ``regex [a-zA-Z][a-zA-Z0-9_']*''
isID = match ``regex [a-zA-Z][a-zA-Z0-9_']*''
\end{curry}
......
......@@ -219,8 +219,9 @@ transformProgram opts funposs allfdecls detinfo specdecls predecls postdecls
(nub ("Test.Contract":"SetFunctions":imps))
dfltdecl clsdecls instdecls tdecls
(map deleteCmtIfEmpty
(map (addContract opts funposs allfdecls predecls contractpcs)
wonewfuns ++
(concatMap
(addContract opts funposs allfdecls predecls contractpcs)
wonewfuns ++
newpostconds))
opdecls
......@@ -328,52 +329,83 @@ type2ShowConstraints 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"
-> [CFuncDecl] -> CFuncDecl -> [CFuncDecl]
addContract _ _ _ _ _ (CFunc _ _ _ _ _) =
error "Internal error in addContract: CFunc occurred"
addContract opts funposs allfdecls predecls postdecls
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)
postdecl = find (\fd-> fromPostCondName (snd(funcName fd)) == f) postdecls
postname = funcName (fromJust postdecl)
encapsSuf = if withEncapsulate opts then "ND" else ""
encaps fn n = if withEncapsulate opts then setFun n fn [] else constF fn
rename qf = if qf==(m,f) then (m,f++"'org") else qf
fref = string2ac $
"'" ++ f ++ "' (module " ++ m ++
maybe ")"
(\l -> ", line " ++ show l ++ ")")
(lookup qn funposs)
orgfunexp = constF (rename (m,f))
-- Textual comment about function source:
fref = string2ac $ "'" ++ f ++ "' (module " ++ m ++
maybe ")"
(\l -> ", line " ++ show l ++ ")")
(lookup qn funposs)
-- call to observation function (if provided):
obsfunexp = constF $
maybe (pre "id")
funcName
(find (\fd -> snd (funcName fd) == f++"'post'observe")
allfdecls)
asrtCall = if isNothing predecl
then applyF (cMod $ "withPostContract" ++ show ar ++ encapsSuf)
([fref, encaps postname (ar+1), obsfunexp, orgfunexp] ++
map CVar argvars)
else if isNothing postdecl
then applyF (cMod $ "withPreContract" ++ show ar ++ encapsSuf)
([fref, encaps prename ar, orgfunexp] ++
map CVar argvars)
else applyF (cMod $ "withContract" ++ show ar ++ encapsSuf)
([fref, encaps prename ar,
encaps postname (ar+1), obsfunexp, orgfunexp] ++
map CVar argvars)
oldfdecl = if topLevelContracts opts
then updQNamesInCLocalDecl rename (CLocalFunc (deleteCmt fdecl))
else CLocalFunc (renameFDecl rename (deleteCmt fdecl))
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]]
ctexp = CQualType (CContext
(union (type2EqConstraints (resultType texp))
(union (type2ShowConstraints texp) clscons)))
texp
-- Construct function with precondition added and a function without prec.:
(precheck,woprefdecl) =
maybe ([],fdecl)
(\predecl ->
let prename = funcName predecl
rename = updateFunc id qn (withSuffix qn "'WithoutPreCondCheck")
in ([cmtfunc cmt (m,f) ar vis ctexp
[simpleRule (map CPVar argvars)
(applyF (cMod $ "withPreContract" ++ show ar ++ encapsSuf)
([fref, encaps prename ar, constF (rename qn)] ++
map CVar argvars))]],
addCmtLine "Without precondition checking!" $
rnmFDecl rename fdecl))
(find (\fd -> fromPreCondName (snd (funcName fd)) == f) predecls)
-- Construct function with postcond. added and a function without postc.:
(postcheck,wopostfdecl) =
maybe ([],woprefdecl)
(\postdecl ->
let postname = funcName postdecl
qnp = funcName woprefdecl
rename = updateFunc id qnp
(withSuffix qnp "'WithoutPostCondCheck")
in ([cmtfunc (funcComment woprefdecl) qnp ar vis ctexp
[simpleRule (map CPVar argvars)
(applyF (cMod $ "withPostContract" ++ show ar ++ encapsSuf)
([fref, encaps postname (ar+1), obsfunexp,
constF (rename qnp)] ++
map CVar argvars))]],
setPrivate $ addCmtLine "Without postcondition checking!" $
rnmFDecl rename woprefdecl))
(find (\fd-> fromPostCondName (snd (funcName fd)) == f) postdecls)
rnmFDecl rnm fdcl = if topLevelContracts opts
then updQNamesInCFuncDecl rnm fdcl
else renameFDecl rnm fdcl
in precheck ++ postcheck ++ [wopostfdecl]
--- Updates a function at some point.
updateFunc :: Eq a => (a -> b) -> a -> b -> (a -> b)
updateFunc f x v y = if y==x then v else f y
--- Define a function as private.
setPrivate :: CFuncDecl -> CFuncDecl
setPrivate = updCFuncDecl id id id (const Private) id id
--- Adds a suffix to qualified name.
withSuffix :: QName -> String -> QName
withSuffix (m,f) s = (m, f ++ s)
-- An operation of the module Test.Contract:
cMod :: String -> QName
......@@ -406,7 +438,15 @@ extendFuncType t texp = case t of
--- Renames a function declaration (but not the body).
renameFDecl :: (QName -> QName) -> CFuncDecl -> CFuncDecl
renameFDecl rn (CFunc qn ar vis texp rules) = CFunc (rn qn) ar vis texp rules
renameFDecl _ (CmtFunc _ _ _ _ _ _) = error "renameFDecl"
renameFDecl rn (CmtFunc cmt qn ar vis texp rules) =
CmtFunc cmt (rn qn) ar vis texp rules
--- Adds a line to the comment in a function declaration.
addCmtLine :: String -> CFuncDecl -> CFuncDecl
addCmtLine s (CFunc qn ar vis texp rules) =
CmtFunc s qn ar vis texp rules
addCmtLine s (CmtFunc cmt qn ar vis texp rules) =
CmtFunc (if null cmt then s else unlines [cmt,s]) qn ar vis texp rules
--- Deletes the comment in a function declaration.
deleteCmt :: CFuncDecl -> CFuncDecl
......
......@@ -10,29 +10,29 @@
import RegExp -- required in the pre-processed program
check1 :: Bool
check1 = "abc" ``regex abc''
check1 = match ``regex abc'' "abc"
check2 :: Bool
check2 = "abaaaaaaaaaaaaac" ``regex aba*c''
check2 = match ``regex aba*c'' "abaaaaaaaaaaaaac"
check3 :: String -> Bool
check3 s = s ``regex (a|(bc*))+''
check3 = match ``regex (a|(bc*))+''
check4 :: String -> Bool
check4 s = s ``regex [:alpha:]''
check4 = match ``regex [:alpha:]''
check5 :: String -> Bool
check5 s = s ``regex [a-z]+''
check5 = match ``regex [a-z]+''
-- Examples with parameterized regular expressions:
pregexp1 :: [a] -> a -> a -> Bool
pregexp1 s v1 v2 = s ``regex [<v1>-<v2>]*''
pregexp1 :: a -> a -> [a] -> Bool
pregexp1 v1 v2 = match ``regex [<v1>-<v2>]*''
pregexp2 :: [a] -> a -> a -> Bool
pregexp2 s v1 v2 = s ``regex (<v1>|<v2>)*''
pregexp2 :: a -> a -> [a] -> Bool
pregexp2 v1 v2 = match ``regex (<v1>|<v2>)*''
-- A regular expression containing a complex Curry expression:
check6 :: Bool
check6 = "a" ``regex <((\x -\> x) 'a')>''
check6 = match ``regex <((\x -\> x) 'a')>'' "a"
......@@ -10,47 +10,47 @@
import RegExp -- required in the pre-processed program
import Test.EasyCheck
test_abc = ("abc" ``regex abc'') -=- True
test_abc = (match ``regex abc'' "abc") -=- True
test_abastarc = ("abaaaaaaaaaaaaac" ````regex aba*c'''') -=- True
test_abastarc = (match ````regex aba*c'''' "abaaaaaaaaaaaaac") -=- True
test_a_bcstar_plus = ("aabcccaba" ``regex (a|(bc*))+'') -=- True
test_a_bcstar_plus = (match ``regex (a|(bc*))+'' "aabcccaba") -=- True
test_alpha_1 = ("a" ``regex [:alpha:]'') -=- True
test_alpha_1 = (match ``regex [:alpha:]'' "a") -=- True
test_alpha_2 = (not ("4" ``regex [:alpha:]'')) -=- True
test_alpha_2 = (not (match ``regex [:alpha:]'' "4")) -=- True
test_alpha_star_1 = ("Abc" ``regex [:alpha:]*'') -=- True
test_alpha_star_1 = (match ``regex [:alpha:]*'' "Abc") -=- True
test_alpha_star_2 = ("ab9c" ``regex [:alpha:]*'') -=- False
test_alpha_star_2 = (match ``regex [:alpha:]*'' "ab9c") -=- False
test_a_z_plus_1 = ("abc" ``regex [a-z]+'') -=- True
test_a_z_plus_1 = (match ``regex [a-z]+'' "abc") -=- True
test_a_z_plus_2 = ("Abc" ``regex [a-z]+'') -=- False
test_a_z_plus_2 = (match ``regex [a-z]+'' "Abc") -=- False
-- Examples with parameterized regular expressions:
pregexp1 :: Ord a => [a] -> a -> a -> Bool
pregexp1 s v1 v2 = s ``regex [<v1>-<v2>]*''
pregexp1 :: Ord a => a -> a -> [a] -> Bool
pregexp1 v1 v2 = match ``regex [<v1>-<v2>]*''
test_para_a_c_1 = pregexp1 "abccba" 'a' 'c' -=- True
test_para_a_c_1 = pregexp1 'a' 'c' "abccba" -=- True
test_para_a_c_2 = pregexp1 "abcdcba" 'a' 'c' -=- False
test_para_a_c_2 = pregexp1 'a' 'c' "abcdcba" -=- False
pregexp2 :: Ord a => [a] -> a -> a -> Bool
pregexp2 s v1 v2 = s ``regex (<v1>|<v2>)*''
pregexp2 :: Ord a => a -> a -> [a] -> Bool
pregexp2 v1 v2 = match ``regex (<v1>|<v2>)*''
test_para_0_1_star_1 = pregexp2 [0,1,1,0,0] 0 1 -=- True
test_para_0_1_star_1 = pregexp2 0 1 [0,1,1,0,0] -=- True
test_para_0_1_star_2 = pregexp2 [0,1,2,0,0] 0 1 -=- False
test_para_0_1_star_2 = pregexp2 0 1 [0,1,2,0,0] -=- False
-- A regular expression containing a complex Curry expression:
test_complexexp = ("a" ``regex <((\x -\> x) 'a')>'') -=- True
test_complexexp = (match ``regex <((\x -\> x) 'a')>'' "a") -=- True
-- Email address matching:
isEmail :: String -> Bool
isEmail s = s ``regex
isEmail = match ``regex
[a-zA-Z0-9]([a-zA-Z0-9\._])*
@
[a-zA-Z0-9][a-zA-Z0-9\-]*\.
......@@ -63,7 +63,7 @@ test_Email2 = isEmail "pa%kcs@curry-language.org" -=- False
isID :: String -> Bool
isID s = s ``regex [a-zA-Z][a-zA-Z0-9_']*''
isID = match ``regex [a-zA-Z][a-zA-Z0-9_']*''
test_ID1 = isID "ab_4'aux" -=- True
......
......@@ -2,7 +2,7 @@
--- A Regex Parser
---
--- @author Jasper Sikorra
--- @version January 2014
--- @version July 2017
------------------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-missing-signatures -Wno-incomplete-patterns #-}
......@@ -23,7 +23,7 @@ import ParseTypes
--- @return A string containg normal curry code with the same semantics as the
--- original ERE code
parse :: LangParser
parse po st = return (liftPM (\p -> ("`match` (" ++ (showRegex p) ++ ")"))
parse po st = return (liftPM (\p -> "(" ++ showRegex p ++ ")")
(parsen po (lex st)))
--- The function showRegex is used to generate a string containing the
......
......@@ -7,7 +7,7 @@
--- is supported (option `foreigncode`, see module `Translator`).
---
--- @author Michael Hanus
--- @version October 2016
--- @version July 2017
------------------------------------------------------------------------------
import AbstractCurry.Types
......@@ -28,7 +28,7 @@ import TransContracts (transContracts)
cppBanner :: String
cppBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText = "Curry Preprocessor (version of 12/01/2017)"
bannerText = "Curry Preprocessor (version of 24/07/2017)"
bannerLine = take (length bannerText) (repeat '=')
--- Preprocessor targets, i.e., kind of entities to be preprocessed:
......
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