-mkWrapperArgTypeCategories
- :: Type -- wrapper's type
- -> [Demand] -- info about its arguments
- -> String -- a string saying lots about the args
-
-mkWrapperArgTypeCategories wrapper_ty wrap_info
- = case (splitFunTyExpandingDicts wrapper_ty) of { (arg_tys,_) ->
- map do_one (wrap_info `zip` (map showTypeCategory arg_tys)) }
- where
- -- ToDo: this needs FIXING UP (it was a hack anyway...)
- do_one (WwPrim, _) = 'P'
- do_one (WwEnum, _) = 'E'
- do_one (WwStrict, arg_ty_char) = arg_ty_char
- do_one (WwUnpack _, arg_ty_char)
- = if arg_ty_char `elem` "CIJFDTS"
- then toLower arg_ty_char
- else if arg_ty_char == '+' then 't'
- else trace ("mkWrapp..:funny char:"++[arg_ty_char]) '-'
- do_one (other_wrap_info, _) = '-'
-\end{code}
-
-Whether a worker exists depends on whether the worker has an
-absent argument, a @WwUnpack@ argument, (or @WwEnum@ ToDo???) arguments.
-
-If a @WwUnpack@ argument is for an {\em abstract} type (or one that
-will be abstract outside this module), which might happen for an
-imported function, then we can't (or don't want to...) unpack the arg
-as the worker requires. Hence we have to give up altogether, and call
-the wrapper only; so under these circumstances we return \tr{False}.
-
-\begin{code}
-#ifdef REALLY_HASKELL_1_3
-instance Read Demand where
-#else
-instance Text Demand where
-#endif
- readList str = read_em [{-acc-}] str
- where
- read_em acc [] = [(reverse acc, "")]
- -- lower case indicates absence...
- read_em acc ('L' : xs) = read_em (WwLazy False : acc) xs
- read_em acc ('A' : xs) = read_em (WwLazy True : acc) xs
- read_em acc ('S' : xs) = read_em (WwStrict : acc) xs
- read_em acc ('P' : xs) = read_em (WwPrim : acc) xs
- read_em acc ('E' : xs) = read_em (WwEnum : acc) xs
-
- read_em acc (')' : xs) = [(reverse acc, xs)]
- read_em acc ( 'U' : '(' : xs)
- = case (read_em [] xs) of
- [(stuff, rest)] -> read_em (WwUnpack stuff : acc) rest
- _ -> panic ("Text.Demand:"++str++"::"++xs)
-
- read_em acc other = panic ("IdInfo.readem:"++other)
-
-#ifdef REALLY_HASKELL_1_3
-instance Show Demand where
-#endif
- showList wrap_args rest = (concat (map show1 wrap_args)) ++ rest
- where
- show1 (WwLazy False) = "L"
- show1 (WwLazy True) = "A"
- show1 WwStrict = "S"
- show1 WwPrim = "P"
- show1 WwEnum = "E"
- show1 (WwUnpack args)= "U(" ++ (concat (map show1 args)) ++ ")"
-
-instance Outputable Demand where
- ppr sty si = ppStr (showList [si] "")
-
-instance OptIdInfo StrictnessInfo where
- noInfo = NoStrictnessInfo
-
- getInfo (IdInfo _ _ _ strict _ _ _ _ _ _) = strict
-
- addInfo id_info NoStrictnessInfo = id_info
- addInfo (IdInfo a b d _ e f g h i j) strict = IdInfo a b d strict e f g h i j