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

docs/manual.tex

@@ -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}
 
 

package.json

 {
     "name": "currypp",
-    "version": "0.3.1",
+    "version": "0.3.2",
     "author": "Michael Hanus <mh@informatik.uni-kiel.de>",
     "synopsis": "The standard preprocessor of Curry",
     "category": [ "Analysis" ],

src/ContractWrapper/TransContracts.curry

@@ -219,8 +219,9 @@ transformProgram opts funposs allfdecls detinfo specdecls predecls postdecls
                (nub ("Test.Contract":"SetFunctions":imps))
                tdecls
                (map deleteCmtIfEmpty
-                  (map (addContract opts funposs allfdecls predecls contractpcs)
-                       wonewfuns ++
+                  (concatMap
+                     (addContract opts funposs allfdecls predecls contractpcs)
+                     wonewfuns ++
                    newpostconds))
                opdecls
 
@@ -307,48 +308,78 @@ genPostCond4Spec _ allfdecls detinfo postdecls (CmtFunc _ (m,f) ar vis 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 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 predecl==Nothing
-                 then applyF (cMod $ "withPostContract" ++ show ar ++ encapsSuf)
-                        ([fref, encaps postname (ar+1), obsfunexp, orgfunexp] ++
-                         map CVar argvars)
-                 else if postdecl==Nothing
-                 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 predecl==Nothing && postdecl==Nothing then fdecl else
-       cmtfunc cmt (m,f) ar vis texp
-               [simpleRuleWithLocals (map CPVar argvars) asrtCall [oldfdecl]]
 
+     -- 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 texp
+                   [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 texp
+                 [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 :: (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
@@ -381,7 +412,15 @@ extendFuncType (CFuncType t1 t2) texp = t1 ~> (extendFuncType t2 texp)
 --- 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

src/IntegratedCode/Examples/RegexpExamples.curry

@@ -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"
 

src/IntegratedCode/Examples/testRegExps.curry

@@ -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 :: [a] -> a -> a -> Bool
-pregexp1 s v1 v2 = s ``regex [<v1>-<v2>]*''
+pregexp1 :: 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 :: [a] -> a -> a -> Bool
-pregexp2 s v1 v2 = s ``regex (<v1>|<v2>)*''
+pregexp2 :: 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
 

src/IntegratedCode/Parser/RegexParser.curry

@@ -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

src/Main.curry

@@ -7,7 +7,7 @@
 --- is supported (option `foreigncode`, see module `Translator`).
 ---
 --- @author Michael Hanus
---- @version September 2016
+--- @version July 2017
 ------------------------------------------------------------------------------
 
 import AbstractCurry.Types
@@ -29,7 +29,7 @@ import TransContracts(transContracts)
 cppBanner :: String
 cppBanner = unlines [bannerLine,bannerText,bannerLine]
  where
-   bannerText = "Curry Preprocessor (version of 01/04/2017)"
+   bannerText = "Curry Preprocessor (version of 24/07/2017)"
    bannerLine = take (length bannerText) (repeat '=')
 
 --- Preprocessor targets, i.e., kind of entities to be preprocessed: