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