|
definition:
|
insertFreeVarsShowInMainExp :: ReplState -> CurryProg -> String
-> IO (Maybe (CurryProg, String, [String]))
insertFreeVarsShowInMainExp rst (CurryProg _ _ _ _ _ _ fdecls _) mainexp = do
let [mfunc@(CFunc _ _ _ (CQualType _ ty) _)] = fdecls
let freevars = freeVarsInFuncRule mfunc
(exp, whereclause) = breakWhereFreeClause mainexp
if safeExec rst && isIOType ty
then do writeErrorMsg "Operation not allowed in safe mode!"
return Nothing
else
if null freevars
|| not (showBindings rst)
|| ((not (withShow rst) && isLegacyFreeMode (freeMode rst))
&& length freevars > 10) -- due to tuple limit
|| null whereclause
then do
let freevarexp = addPrintShow exp ty ++ whereclause
writeVerboseInfo rst 2 "Adding show/print to expression"
writeVerboseInfo rst 3 $ "New expression: " ++ freevarexp
writeSimpleMainExpFile rst freevarexp
getAcyOfMainExpMod rst >>=
maybe (return Nothing)
(\p -> return $ Just (p,freevarexp,[]))
else if isLegacyFreeMode (freeMode rst)
then do
let freevarexp = addFreeShowLegacy exp freevars whereclause ty
writeVerboseInfo rst 2 $
"Adding printing of bindings for free variables: " ++
intercalate "," freevars
writeVerboseInfo rst 3 $ "New expression: " ++ freevarexp
writeSimpleMainExpFile rst freevarexp
getAcyOfMainExpMod rst >>=
maybe (return Nothing)
(\p -> return $ Just (p,freevarexp, []))
else do
let freevarexp = addFreeShowCmdLine exp whereclause ty
writeVerboseInfo rst 2 "Adding show/print to expression"
writeVerboseInfo rst 3 $ "New expression: " ++ freevarexp
writeSimpleMainExpFile rst freevarexp
getAcyOfMainExpMod rst >>=
maybe (return Nothing)
(\p -> return $ Just (p,freevarexp,freevars))
where
addPrintShow exp ty
| withShow rst && isIOReturnType ty = exp ++ " Prelude.>>= Prelude.print"
| withShow rst && not (isIOType ty) = "show (" ++ exp ++ ")"
| otherwise = exp
addFreeShowLegacy exp freevars whereclause ty = unwords $
if withShow rst
then if null freevars || isIOReturnType ty
then [addPrintShow exp ty, whereclause]
else
["((\"{\""] ++
intersperse ("++ \", \" ")
(map (\v-> "++ \"" ++ v ++ " = \" ++ show " ++ v) freevars) ++
["++ \"} \") ++) $!! "] ++ [addPrintShow exp ty] ++ [whereclause]
else ["(", exp] ++
map (\v-> ", \"" ++ v ++ ":\", " ++ v) freevars ++
[")"] ++ [whereclause]
addFreeShowCmdLine exp whereclause ty = unwords $
if withShow rst
then [addPrintShow exp ty, whereclause]
else [exp, whereclause]
freeVarsInFuncRule f = case f of
CFunc _ _ _ _ (CRule _ rhs : _) -> freeVarsInRhs rhs
_ -> error "REPL.insertFreeVarsShowInMainGoal.freeVarsInFuncRule"
freeVarsInRhs rhs = case rhs of
CSimpleRhs _ ldecls -> concatMap lvarName ldecls
CGuardedRhs _ ldecls -> concatMap lvarName ldecls
lvarName ldecl = case ldecl of CLocalVars vs -> map snd vs
_ -> []
|
|
documentation:
|
-- In LegacyFreeMode:
-- Insert free variables occurring in the main expressions
-- as components of the main expression so that their bindings are shown.
-- The arguments are the AbstractCurry program of the main expression
-- and the main expression as a string.
-- Also adds show/print if desired.
-- The result is Nothing (if some error occurred) or the transformed
-- AbstractCurry program, expression and any free variables.
-- If not in LegacyFreeMode:
-- Only add show/print if desired,
-- the rest is done by the respective compiler.
-- The result structure is the same as in LegacyFreeMode.
|