| definition: |
genPeval :: String -> FC.TypeDecl -> CFuncDecl
genPeval _ (FC.TypeSyn _ _ _ _) =
error "genPeval: cannot translate type synonyms"
genPeval _ (FC.TypeNew _ _ _ _) =
error "genPeval: cannot translate newtypes"
genPeval mainmod (FC.Type qtc@(_,tc) _ tvars consdecls) =
cmtfunc ("Evaluate a `"++tc++"` value up to a partial approxmiation.")
(mainmod,"peval_"++transQN tc) 1 Public
(emptyClassType
(foldr1 (~>) (map (\ (a,b) -> CTVar a ~> CTVar b ~> CTVar b)
(zip polyavars polyrvars) ++
[applyTC qtc (map CTVar polyavars),
applyTC (mainmod,t2bt tc) (map CTVar polyrvars),
applyTC (mainmod,t2bt tc) (map CTVar polyrvars)])))
(simpleRule (map CPVar (polyavars ++ [(0,"_")]) ++ [CPComb botSym []])
(constF botSym) :
if isPrimExtType qtc
then [valueRule]
else map genConsRule consdecls)
where
botSym = (mainmod, "Bot_" ++ transQN tc) -- bottom constructor
-- variables for polymorphic type arguments:
polyavars = [ (i,"a" ++ show i) | i <- map fst tvars]
polyrvars = [ (i,"b" ++ show i) | i <- map fst tvars]
genConsRule (FC.Cons qc@(_,cons) _ _ argtypes) =
let args = [(i,"x" ++ show i) | i <- [0 .. length argtypes - 1]]
pargs = [(i,"y" ++ show i) | i <- [0 .. length argtypes - 1]]
pcons = (mainmod,t2bt cons)
in simpleRule (map CPVar polyavars ++
[CPComb qc (map CPVar args), CPComb pcons (map CPVar pargs)])
(applyF pcons
(map (\ (e1,e2,te) ->
applyE (ftype2pvalOf mainmod "peval" polyavars te)
[e1,e2])
(zip3 (map CVar args) (map CVar pargs) argtypes)))
valueRule =
let xvar = (0,"x")
yvar = (1,"y")
valcons = (mainmod,"Value_"++tc)
in guardedRule [CPVar xvar, CPComb valcons [CPVar yvar]]
[(constF (pre "True"), --applyF (pre "=:=") [CVar xvar, CVar yvar],
applyF valcons [CVar xvar])]
[]
|
| demand: |
argument 2 |
| deterministic: |
deterministic operation |
| documentation: |
-------------------------------------------------------------------------
-- Create `peval_` operation for a data type with explicit bottom constructors
-- according to the following scheme:
{-
peval_AB :: AB -> P_AB -> P_AB
peval_AB _ Bot_AB = Bot_AB -- no evaluation
peval_AB A P_A = P_A
peval_AB B P_B = P_B
peval_C :: C -> P_C -> P_C
peval_C _ Bot_C = Bot_C -- no evaluation
peval_C (C x) (P_C y) = P_C (peval_AB x y)
f_equiv_g x p = peval_C (f x) p <~> peval_C (g x) p
-}
|
| indeterministic: |
referentially transparent operation |
| infix: |
no fixity defined |
| name: |
genPeval |
| precedence: |
no precedence defined |
| result-values: |
_ |
| signature: |
String -> FlatCurry.Types.TypeDecl -> AbstractCurry.Types.CFuncDecl |
| solution-complete: |
operation might suspend on free variables |
| terminating: |
possibly non-terminating |
| totally-defined: |
possibly non-reducible on same data term |