| definition: |
genPValOf :: String -> FC.TypeDecl -> CFuncDecl
genPValOf _ (FC.TypeSyn _ _ _ _) =
error "genPValOf: cannot translate type synonyms"
genPValOf _ (FC.TypeNew _ _ _ _) =
error "genPValOf: cannot translate newtypes"
genPValOf mainmod (FC.Type qtc@(_,tc) _ tvars consdecls) =
cmtfunc ("Map a `"++tc++"` value into all its partial approximations.")
(mainmod,"pvalOf_"++transQN tc) 1 Public
(emptyClassType
(foldr1 (~>) (map (\ (a,b) -> CTVar a ~> CTVar b)
(zip polyavars polyrvars) ++
[applyTC qtc (map CTVar polyavars),
applyTC (mainmod,t2bt tc) (map CTVar polyrvars)])))
(simpleRule (map CPVar (polyavars ++ [(0,"_")]))
(constF (mainmod,"Bot_"++transQN tc)) :
if isPrimExtType qtc
then [valueRule]
else map genConsRule consdecls)
where
-- 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]]
in simpleRule (map CPVar polyavars ++ [CPComb qc (map CPVar args)])
(applyF (mainmod,t2bt cons)
(map (\ (e,te) ->
applyE (ftype2pvalOf mainmod "pvalOf" polyavars te) [e])
(zip (map CVar args) argtypes)))
valueRule =
let var = (0,"x")
in simpleRule [CPVar var] (applyF (mainmod,"Value_"++tc) [CVar var])
|
| demand: |
argument 2 |
| deterministic: |
deterministic operation |
| documentation: |
-------------------------------------------------------------------------
-- Create `pvalOf` operation for a data type with explicit bottom constructors
-- according to the following scheme:
{-
pvalOf_AB :: AB -> P_AB
pvalOf_AB _ = Bot_AB
pvalOf_AB A = P_A
pvalOf_AB B = P_B
pvalOf_C :: C -> P_C
pvalOf_C _ = Bot_C
pvalOf_C (C x) = P_C (pvalOf_AB x)
f_equiv_g x = pvalOf_C (f x) <~> pvalOf_C (g x)
-}
|
| indeterministic: |
referentially transparent operation |
| infix: |
no fixity defined |
| name: |
genPValOf |
| 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 |