|
definition:
|
genCurryCheckProgram :: Config
-> Repository
-> GC.GlobalCache
-> [(Bool,CFuncDecl)]
-> ComparisonInfo
-> Bool
-> ACYCache -> [String]
-> ErrorLogger ()
genCurryCheckProgram cfg repo gc prodfuncs info groundequiv acyCache loadpath = do
baseTmp <- liftIOEL $ getBaseTemp
let translatorGenerator = uncurry $ genTranslatorFunction cfg repo gc info
(_, transMap) <- foldM translatorGenerator (acyCache, emptyTrans)
translateTypes
let (limittypes,testFunctions) =
unzip (map (genTestFunction info groundequiv transMap) prodfuncs)
let transFunctions = transFuncs transMap
let limittconss = nub (concatMap tconsOfType (concat limittypes))
let limittcmods = nub (map fst limittconss)
-- get the declarations of all types which require limit functions:
(_, limittdecls) <- foldM addLimitType (acyCache,[]) limittconss
typeinfos <- analyzeModules "recursive type" typesInValuesAnalysis loadpath
limittcmods
let limitFunctions = concatMap (genLimitFunction typeinfos) limittdecls
prog = simpleCurryProg "Compare" imports []
(concat testFunctions ++ transFunctions ++
(if groundequiv then limitFunctions else []))
[]
let prodops = map snd (filter fst prodfuncs)
liftIOEL $ unless (null prodops) $ putStrLn $
"Productive operations (currently not fully supported for all types):\n" ++
showFuncNames prodops ++ "\n"
liftIOEL $ writeFile (baseTmp </> "Compare.curry")
(progcmts ++ "\n" ++ showCProg prog ++ "\n")
return ()
where
addLimitType (acy,tdecls) qn =
findTypeInModules cfg repo gc info acy qn >>= \ (acy',tdecl) ->
return (acy', tdecl:tdecls)
progcmts = unlines $ map ("-- "++)
[ "This file contains properties to compare packages"
, packageId (infPackageA info) ++
" and " ++ packageId (infPackageB info) ++ "."
, ""
, "It should be processed by 'curry-check Compare' with setting"
, "export CURRYPATH=" ++ infDirA info ++ ":" ++ infDirB info
]
allReferencedTypes =
nub ((concat $ map (argTypes . typeOfQualType . funcType . snd) prodfuncs)
++ map (resultType . typeOfQualType . funcType . snd) prodfuncs)
translateTypes = filter (needToTranslatePart info) allReferencedTypes
mods = map (fst . funcName . snd) prodfuncs
modsA = map (\mod -> (infPrefixA info) ++ "_" ++ mod) mods
modsB = map (\mod -> (infPrefixB info) ++ "_" ++ mod) mods
imports = modsA ++ modsB ++ ["Test.Prop"]
|
|
iotype:
|
{(_,_,_,_,_,_,_,_) |-> _}
|