2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: CgClosure.lhs,v 1.41 2000/07/14 08:14:53 simonpj Exp $
6 \section[CgClosure]{Code generation for closures}
8 This module provides the support code for @StgToAbstractC@ to deal
9 with {\em closures} on the RHSs of let(rec)s. See also
10 @CgCon@, which deals with constructors.
13 module CgClosure ( cgTopRhsClosure,
16 closureCodeBody ) where
18 #include "HsVersions.h"
20 import {-# SOURCE #-} CgExpr ( cgExpr )
26 import AbsCUtils ( mkAbstractCs, getAmodeRep )
27 import CgBindery ( getCAddrMode, getArgAmodes,
28 getCAddrModeAndInfo, bindNewToNode,
30 bindNewToReg, bindArgsToRegs,
31 stableAmodeIdInfo, heapIdInfo, CgIdInfo
33 import CgUpdate ( pushUpdateFrame )
34 import CgHeapery ( allocDynClosure,
35 fetchAndReschedule, yield, -- HWL
36 fastEntryChecks, thunkChecks
38 import CgStackery ( mkTaggedVirtStkOffsets, freeStackSlots )
39 import CgUsages ( adjustSpAndHp, setRealAndVirtualSp, getVirtSp,
40 getSpRelOffset, getHpRelOffset
42 import CLabel ( CLabel, mkClosureLabel, mkFastEntryLabel,
43 mkRednCountsLabel, mkInfoTableLabel
45 import ClosureInfo -- lots and lots of stuff
46 import CmdLineOpts ( opt_GranMacros, opt_SccProfilingOn, opt_DoTickyProfiling )
48 import Id ( Id, idName, idType, idPrimRep )
49 import Name ( Name, isLocalName )
50 import Module ( Module, pprModule )
51 import ListSetOps ( minusList )
52 import PrimRep ( PrimRep(..) )
53 import PprType ( showTypeCategory )
55 import CmdLineOpts ( opt_SccProfilingOn )
58 import Name ( nameOccName )
59 import OccName ( occNameFS )
61 getWrapperArgTypeCategories = panic "CgClosure.getWrapperArgTypeCategories (ToDo)"
64 %********************************************************
66 \subsection[closures-no-free-vars]{Top-level closures}
68 %********************************************************
70 For closures bound at top level, allocate in static space.
71 They should have no free variables.
75 -> CostCentreStack -- Optional cost centre annotation
80 -> FCode (Id, CgIdInfo)
82 cgTopRhsClosure id ccs binder_info args body lf_info
83 = -- LAY OUT THE OBJECT
85 closure_info = layOutStaticNoFVClosure name lf_info
88 -- BUILD THE OBJECT (IF NECESSARY)
89 ({- if staticClosureRequired name binder_info lf_info
91 (if opt_SccProfilingOn
94 closure_label -- Labelled with the name on lhs of defn
96 (mkCCostCentreStack ccs)
100 closure_label -- Labelled with the name on lhs of defn
110 -- GENERATE THE INFO TABLE (IF NECESSARY)
111 forkClosureBody (closureCodeBody binder_info closure_info
116 returnFC (id, cg_id_info)
119 closure_label = mkClosureLabel name
120 cg_id_info = stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info
123 %********************************************************
125 \subsection[non-top-level-closures]{Non top-level closures}
127 %********************************************************
129 For closures with free vars, allocate in heap.
134 -> CostCentreStack -- Optional cost centre annotation
140 -> [StgArg] -- payload
141 -> FCode (Id, CgIdInfo)
143 cgStdRhsClosure binder cc binder_info fvs args body lf_info payload
144 -- AHA! A STANDARD-FORM THUNK
146 -- LAY OUT THE OBJECT
147 getArgAmodes payload `thenFC` \ amodes ->
149 (closure_info, amodes_w_offsets)
150 = layOutDynClosure (idName binder) getAmodeRep amodes lf_info
152 (use_cc, blame_cc) = chooseDynCostCentres cc args fvs body
155 allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
157 `thenFC` \ heap_offset ->
160 returnFC (binder, heapIdInfo binder heap_offset lf_info)
163 Here's the general case.
167 -> CostCentreStack -- Optional cost centre annotation
173 -> FCode (Id, CgIdInfo)
175 cgRhsClosure binder cc binder_info fvs args body lf_info
177 -- LAY OUT THE OBJECT
179 -- If the binder is itself a free variable, then don't store
180 -- it in the closure. Instead, just bind it to Node on entry.
181 -- NB we can be sure that Node will point to it, because we
182 -- havn't told mkClosureLFInfo about this; so if the binder
183 -- *was* a free var of its RHS, mkClosureLFInfo thinks it *is*
184 -- stored in the closure itself, so it will make sure that
185 -- Node points to it...
187 is_elem = isIn "cgRhsClosure"
189 binder_is_a_fv = binder `is_elem` fvs
190 reduced_fvs = if binder_is_a_fv
191 then fvs `minusList` [binder]
194 mapFCs getCAddrModeAndInfo reduced_fvs `thenFC` \ amodes_and_info ->
196 fvs_w_amodes_and_info = reduced_fvs `zip` amodes_and_info
198 closure_info :: ClosureInfo
199 bind_details :: [((Id, (CAddrMode, LambdaFormInfo)), VirtualHeapOffset)]
201 (closure_info, bind_details)
202 = layOutDynClosure (idName binder) get_kind fvs_w_amodes_and_info lf_info
204 bind_fv ((id, (_, lf_info)), offset) = bindNewToNode id offset lf_info
206 amodes_w_offsets = [(amode,offset) | ((_, (amode,_)), offset) <- bind_details]
208 get_kind (id, amode_and_info) = idPrimRep id
210 -- BUILD ITS INFO TABLE AND CODE
213 mapCs bind_fv bind_details `thenC`
215 -- Bind the binder itself, if it is a free var
216 (if binder_is_a_fv then
217 bindNewToReg binder node lf_info
222 closureCodeBody binder_info closure_info cc args body
227 (use_cc, blame_cc) = chooseDynCostCentres cc args fvs body
229 allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
230 ) `thenFC` \ heap_offset ->
233 returnFC (binder, heapIdInfo binder heap_offset lf_info)
236 %************************************************************************
238 \subsection[code-for-closures]{The code for closures}
240 %************************************************************************
243 closureCodeBody :: StgBinderInfo
244 -> ClosureInfo -- Lots of information about this closure
245 -> CostCentreStack -- Optional cost centre attached to closure
251 There are two main cases for the code for closures. If there are {\em
252 no arguments}, then the closure is a thunk, and not in normal form.
253 So it should set up an update frame (if it is shared). Also, it has
254 no argument satisfaction check, so fast and slow entry-point labels
258 closureCodeBody binder_info closure_info cc [] body
259 = -- thunks cannot have a primitive type!
260 getAbsC body_code `thenFC` \ body_absC ->
261 moduleName `thenFC` \ mod_name ->
263 absC (CClosureInfoAndCode closure_info body_absC Nothing
266 cl_descr mod_name = closureDescription mod_name (closureName closure_info)
268 body_label = entryLabelFromCI closure_info
270 is_box = case body of { StgApp fun [] -> True; _ -> False }
272 body_code = profCtrC SLIT("TICK_ENT_THK") [] `thenC`
273 thunkWrapper closure_info body_label (
274 -- We only enter cc after setting up update so that cc
275 -- of enclosing scope will be recorded in update frame
276 -- CAF/DICT functions will be subsumed by this enclosing cc
277 enterCostCentreCode closure_info cc IsThunk is_box `thenC`
281 If there is {\em at least one argument}, then this closure is in
282 normal form, so there is no need to set up an update frame. On the
283 other hand, we do have to check that there are enough args, and
284 perform an update if not!
286 The Macros for GrAnSim are produced at the beginning of the
287 argSatisfactionCheck (by calling fetchAndReschedule). There info if
288 Node points to closure is available. -- HWL
291 closureCodeBody binder_info closure_info cc all_args body
292 = getEntryConvention name lf_info
293 (map idPrimRep all_args) `thenFC` \ entry_conv ->
295 -- get the current virtual Sp (it might not be zero, eg. if we're
296 -- compiling a let-no-escape).
297 getVirtSp `thenFC` \vSp ->
300 -- Figure out what is needed and what isn't
302 -- SDM: need everything for now in case the heap/stack check refers
304 slow_code_needed = True
305 --slowFunEntryCodeRequired name binder_info entry_conv
306 info_table_needed = True
307 --funInfoTableRequired name binder_info lf_info
309 -- Arg mapping for standard (slow) entry point; all args on stack,
311 (sp_all_args, arg_offsets, _)
312 = mkTaggedVirtStkOffsets vSp idPrimRep all_args
314 -- Arg mapping for the fast entry point; as many args as poss in
315 -- registers; the rest on the stack
316 -- arg_regs are the registers used for arg passing
317 -- stk_args are the args which are passed on the stack
319 -- Args passed on the stack are tagged, but the tags may not
320 -- actually be present (just gaps) if the function is called
321 -- by jumping directly to the fast entry point.
323 arg_regs = case entry_conv of
324 DirectEntry lbl arity regs -> regs
325 other -> trace ("*** closureCodeBody:arg_regs " ++ (pprHWL entry_conv) ++ "(HWL ignored; no args passed in regs)") []
327 pprHWL :: EntryConvention -> String
328 pprHWL (ViaNode) = "ViaNode"
329 pprHWL (StdEntry cl) = "StdEntry"
330 pprHWL (DirectEntry cl i l) = "DirectEntry"
332 num_arg_regs = length arg_regs
334 (reg_args, stk_args) = splitAt num_arg_regs all_args
336 (sp_stk_args, stk_offsets, stk_tags)
337 = mkTaggedVirtStkOffsets vSp idPrimRep stk_args
339 -- HWL; Note: empty list of live regs in slow entry code
340 -- Old version (reschedule combined with heap check);
341 -- see argSatisfactionCheck for new version
342 --slow_entry_code = forceHeapCheck [node] True slow_entry_code'
343 -- where node = UnusedReg PtrRep 1
344 --slow_entry_code = forceHeapCheck [] True slow_entry_code'
347 = profCtrC SLIT("TICK_ENT_FUN_STD") [
348 CLbl ticky_ctr_label DataPtrRep
351 -- Bind args, and record expected position of stk ptrs
352 mapCs bindNewToStack arg_offsets `thenC`
353 setRealAndVirtualSp sp_all_args `thenC`
355 argSatisfactionCheck closure_info arg_regs `thenC`
357 -- OK, so there are enough args. Now we need to stuff as
358 -- many of them in registers as the fast-entry code
359 -- expects. Note that the zipWith will give up when it hits
360 -- the end of arg_regs.
362 mapFCs getCAddrMode all_args `thenFC` \ stk_amodes ->
363 absC (mkAbstractCs (zipWith assign_to_reg arg_regs stk_amodes))
366 -- Now adjust real stack pointers (no need to adjust Hp,
367 -- but call this function for convenience).
368 adjustSpAndHp sp_stk_args `thenC`
370 absC (CFallThrough (CLbl fast_label CodePtrRep))
372 assign_to_reg reg_id amode = CAssign (CReg reg_id) amode
375 -- Old version (reschedule combined with heap check);
376 -- see argSatisfactionCheck for new version
377 -- fast_entry_code = forceHeapCheck [] True fast_entry_code'
380 = moduleName `thenFC` \ mod_name ->
381 profCtrC SLIT("TICK_CTR") [
382 CLbl ticky_ctr_label DataPtrRep,
383 mkCString (_PK_ (ppr_for_ticky_name mod_name name)),
384 mkIntCLit stg_arity, -- total # of args
385 mkIntCLit sp_stk_args, -- # passed on stk
386 mkCString (_PK_ (map (showTypeCategory . idType) all_args))
389 profCtrC SLIT("TICK_ENT_FUN_DIRECT") [
390 CLbl ticky_ctr_label DataPtrRep
393 -- Nuked for now; see comment at end of file
394 -- CString (_PK_ (show_wrapper_name wrapper_maybe)),
395 -- CString (_PK_ (show_wrapper_arg_kinds wrapper_maybe))
398 -- Bind args to regs/stack as appropriate, and
399 -- record expected position of sps.
400 bindArgsToRegs reg_args arg_regs `thenC`
401 mapCs bindNewToStack stk_offsets `thenC`
402 setRealAndVirtualSp sp_stk_args `thenC`
404 -- free up the stack slots containing tags
405 freeStackSlots (map fst stk_tags) `thenC`
407 -- Enter the closures cc, if required
408 enterCostCentreCode closure_info cc IsFunction False `thenC`
411 funWrapper closure_info arg_regs stk_tags info_label (cgExpr body)
414 setTickyCtrLabel ticky_ctr_label (
416 -- Make a labelled code-block for the slow and fast entry code
417 forkAbsC (if slow_code_needed then slow_entry_code else absC AbsCNop)
418 `thenFC` \ slow_abs_c ->
419 forkAbsC fast_entry_code `thenFC` \ fast_abs_c ->
420 moduleName `thenFC` \ mod_name ->
422 -- Now either construct the info table, or put the fast code in alone
423 -- (We never have slow code without an info table)
424 -- XXX probably need the info table and slow entry code in case of
425 -- a heap check failure.
427 if info_table_needed then
428 CClosureInfoAndCode closure_info slow_abs_c (Just fast_abs_c)
431 CCodeBlock fast_label fast_abs_c
435 ticky_ctr_label = mkRednCountsLabel name
437 stg_arity = length all_args
438 lf_info = closureLFInfo closure_info
440 cl_descr mod_name = closureDescription mod_name name
442 -- Manufacture labels
443 name = closureName closure_info
444 fast_label = mkFastEntryLabel name stg_arity
445 info_label = mkInfoTableLabel name
448 -- When printing the name of a thing in a ticky file, we want to
449 -- give the module name even for *local* things. We print
450 -- just "x (M)" rather that "M.x" to distinguish them from the global kind.
451 ppr_for_ticky_name mod_name name
452 | isLocalName name = showSDocDebug (ppr name <+> (parens (ppr mod_name)))
453 | otherwise = showSDocDebug (ppr name)
456 For lexically scoped profiling we have to load the cost centre from
457 the closure entered, if the costs are not supposed to be inherited.
458 This is done immediately on entering the fast entry point.
460 Load current cost centre from closure, if not inherited.
461 Node is guaranteed to point to it, if profiling and not inherited.
464 data IsThunk = IsThunk | IsFunction -- Bool-like, local
470 :: ClosureInfo -> CostCentreStack
472 -> Bool -- is_box: this closure is a special box introduced by SCCfinal
475 enterCostCentreCode closure_info ccs is_thunk is_box
476 = if not opt_SccProfilingOn then
479 ASSERT(not (noCCSAttached ccs))
481 if isSubsumedCCS ccs then
482 ASSERT(isToplevClosure closure_info)
483 ASSERT(is_thunk == IsFunction)
484 costCentresC SLIT("ENTER_CCS_FSUB") []
486 else if isCurrentCCS ccs then
487 if re_entrant && not is_box
488 then costCentresC SLIT("ENTER_CCS_FCL") [CReg node]
489 else costCentresC SLIT("ENTER_CCS_TCL") [CReg node]
491 else if isCafCCS ccs then
492 ASSERT(isToplevClosure closure_info)
493 ASSERT(is_thunk == IsThunk)
494 -- might be a PAP, in which case we want to subsume costs
496 then costCentresC SLIT("ENTER_CCS_FSUB") []
497 else costCentresC SLIT("ENTER_CCS_CAF") c_ccs
499 else panic "enterCostCentreCode"
502 c_ccs = [mkCCostCentreStack ccs]
503 re_entrant = closureReEntrant closure_info
506 %************************************************************************
508 \subsubsection[pre-closure-code-stuff]{Pre-closure-code code}
510 %************************************************************************
512 The argument-satisfaction check code is placed after binding
513 the arguments to their stack locations. Hence, the virtual stack
514 pointer is pointing after all the args, and virtual offset 1 means
515 the base of frame and hence most distant arg. Hence
516 virtual offset 0 is just beyond the most distant argument; the
517 relative offset of this word tells how many words of arguments
521 argSatisfactionCheck :: ClosureInfo -> [MagicId] {-GRAN-} -> Code
523 argSatisfactionCheck closure_info arg_regs
525 = nodeMustPointToIt (closureLFInfo closure_info) `thenFC` \ node_points ->
528 -- emit_gran_macros = opt_GranMacros
532 -- absC (CMacroStmt GRAN_FETCH []) `thenC`
533 -- forceHeapCheck [] node_points (absC AbsCNop) `thenC`
535 -- then if node_points
536 -- then fetchAndReschedule arg_regs node_points
537 -- else yield arg_regs node_points
538 -- else absC AbsCNop) `thenC`
540 getSpRelOffset 0 `thenFC` \ (SpRel sp) ->
543 rel_arg = mkIntCLit off
547 absC (CMacroStmt ARGS_CHK [rel_arg]) -- node already points
549 absC (CMacroStmt ARGS_CHK_LOAD_NODE [rel_arg, set_Node_to_this])
551 -- We must tell the arg-satis macro whether Node is pointing to
552 -- the closure or not. If it isn't so pointing, then we give to
553 -- the macro the (static) address of the closure.
555 set_Node_to_this = CLbl (closureLabelFromCI closure_info) PtrRep
558 %************************************************************************
560 \subsubsection[closure-code-wrappers]{Wrappers around closure code}
562 %************************************************************************
565 thunkWrapper:: ClosureInfo -> CLabel -> Code -> Code
566 thunkWrapper closure_info lbl thunk_code
567 = -- Stack and heap overflow checks
568 nodeMustPointToIt (closureLFInfo closure_info) `thenFC` \ node_points ->
570 -- HWL: insert macros for GrAnSim; 2 versions depending on liveness of node
571 -- (we prefer fetchAndReschedule-style context switches to yield ones)
574 then fetchAndReschedule [] node_points
575 else yield [] node_points
576 else absC AbsCNop) `thenC`
578 -- stack and/or heap checks
579 thunkChecks lbl node_points (
581 -- Overwrite with black hole if necessary
582 blackHoleIt closure_info node_points `thenC`
584 setupUpdate closure_info ( -- setupUpdate *encloses* the rest
586 -- Finally, do the business
590 funWrapper :: ClosureInfo -- Closure whose code body this is
591 -> [MagicId] -- List of argument registers (if any)
592 -> [(VirtualSpOffset,Int)] -- tagged stack slots
593 -> CLabel -- info table for heap check ret.
594 -> Code -- Body of function being compiled
596 funWrapper closure_info arg_regs stk_tags info_label fun_body
597 = -- Stack overflow check
598 nodeMustPointToIt (closureLFInfo closure_info) `thenFC` \ node_points ->
601 then yield arg_regs node_points
602 else absC AbsCNop) `thenC`
604 -- heap and/or stack checks
605 fastEntryChecks arg_regs stk_tags info_label node_points (
607 -- Finally, do the business
613 %************************************************************************
615 \subsubsubsection[update-and-BHs]{Update and black-hole wrappers}
617 %************************************************************************
621 blackHoleIt :: ClosureInfo -> Bool -> Code -- Only called for closures with no args
623 blackHoleIt closure_info node_points
624 = if blackHoleOnEntry closure_info && node_points
627 info_label = infoTableLabelFromCI closure_info
628 args = [ CLbl info_label DataPtrRep ]
630 absC (if closureSingleEntry(closure_info) then
631 CMacroStmt UPD_BH_SINGLE_ENTRY args
633 CMacroStmt UPD_BH_UPDATABLE args)
639 setupUpdate :: ClosureInfo -> Code -> Code -- Only called for closures with no args
640 -- Nota Bene: this function does not change Node (even if it's a CAF),
641 -- so that the cost centre in the original closure can still be
642 -- extracted by a subsequent ENTER_CC_TCL
644 -- I've tidied up the code for this function, but it should still do the same as
645 -- it did before (modulo ticky stuff). KSW 1999-04.
646 setupUpdate closure_info code
647 = if closureReEntrant closure_info
651 case (closureUpdReqd closure_info, isStaticClosure closure_info) of
652 (False,False) -> profCtrC SLIT("TICK_UPDF_OMITTED") [] `thenC`
654 (False,True ) -> (if opt_DoTickyProfiling
656 -- blackhole the SE CAF
657 link_caf seCafBlackHoleClosureInfo `thenFC` \ _ -> nopC
660 profCtrC SLIT("TICK_UPD_CAF_BH_SINGLE_ENTRY") [mkCString cl_name] `thenC`
661 profCtrC SLIT("TICK_UPDF_OMITTED") [] `thenC`
663 (True ,False) -> pushUpdateFrame (CReg node) code
664 (True ,True ) -> -- blackhole the (updatable) CAF:
665 link_caf cafBlackHoleClosureInfo `thenFC` \ update_closure ->
666 profCtrC SLIT("TICK_UPD_CAF_BH_UPDATABLE") [mkCString cl_name] `thenC`
667 pushUpdateFrame update_closure code
669 cl_name :: FAST_STRING
670 cl_name = (occNameFS . nameOccName . closureName) closure_info
672 link_caf :: (ClosureInfo -> ClosureInfo) -- function yielding BH closure_info
673 -> FCode CAddrMode -- Returns amode for closure to be updated
675 = -- To update a CAF we must allocate a black hole, link the CAF onto the
676 -- CAF list, then update the CAF to point to the fresh black hole.
677 -- This function returns the address of the black hole, so it can be
678 -- updated with the new value when available.
680 -- Alloc black hole specifying CC_HDR(Node) as the cost centre
682 use_cc = CMacroExpr PtrRep CCS_HDR [nodeReg]
685 allocDynClosure (bhCI closure_info) use_cc blame_cc [] `thenFC` \ heap_offset ->
686 getHpRelOffset heap_offset `thenFC` \ hp_rel ->
687 let amode = CAddr hp_rel
689 absC (CMacroStmt UPD_CAF [CReg node, amode]) `thenC`
693 %************************************************************************
695 \subsection[CgClosure-Description]{Profiling Closure Description.}
697 %************************************************************************
699 For "global" data constructors the description is simply occurrence
700 name of the data constructor itself (see \ref{CgConTbls-info-tables}).
702 Otherwise it is determind by @closureDescription@ from the let
706 closureDescription :: Module -- Module
707 -> Name -- Id of closure binding
710 -- Not called for StgRhsCon which have global info tables built in
711 -- CgConTbls.lhs with a description generated from the data constructor
713 closureDescription mod_name name
723 chooseDynCostCentres ccs args fvs body
725 use_cc -- cost-centre we record in the object
726 = if currentOrSubsumedCCS ccs
727 then CReg CurCostCentre
728 else mkCCostCentreStack ccs
730 blame_cc -- cost-centre on whom we blame the allocation
731 = case (args, fvs, body) of
732 ([], _, StgApp fun [{-no args-}])
733 -> mkCCostCentreStack overheadCCS
736 -- if it's an utterly trivial RHS, then it must be
737 -- one introduced by boxHigherOrderArgs for profiling,
738 -- so we charge it to "OVERHEAD".
740 -- This looks like a HACK to me --SDM
747 ========================================================================
748 OLD CODE THAT EMITTED INFORMATON FOR QUANTITATIVE ANALYSIS
750 It's pretty wierd, so I've nuked it for now. SLPJ Nov 96
753 getWrapperArgTypeCategories
754 :: Type -- wrapper's type
755 -> StrictnessInfo bdee -- strictness info about its args
758 getWrapperArgTypeCategories _ NoStrictnessInfo = Nothing
759 getWrapperArgTypeCategories _ BottomGuaranteed
760 = trace "getWrapperArgTypeCategories:BottomGuaranteed!" Nothing -- wrong
761 getWrapperArgTypeCategories _ (StrictnessInfo [] _) = Nothing
763 getWrapperArgTypeCategories ty (StrictnessInfo arg_info _)
764 = Just (mkWrapperArgTypeCategories ty arg_info)
766 mkWrapperArgTypeCategories
767 :: Type -- wrapper's type
768 -> [Demand] -- info about its arguments
769 -> String -- a string saying lots about the args
771 mkWrapperArgTypeCategories wrapper_ty wrap_info
772 = case (splitFunTy_maybe wrapper_ty) of { Just (arg_tys,_) ->
773 map do_one (wrap_info `zip` (map showTypeCategory arg_tys)) }
775 -- ToDo: this needs FIXING UP (it was a hack anyway...)
776 do_one (WwPrim, _) = 'P'
777 do_one (WwEnum, _) = 'E'
778 do_one (WwStrict, arg_ty_char) = arg_ty_char
779 do_one (WwUnpack _ _ _, arg_ty_char)
780 = if arg_ty_char `elem` "CIJFDTS"
781 then toLower arg_ty_char
782 else if arg_ty_char == '+' then 't'
783 else trace ("mkWrapp..:funny char:"++[arg_ty_char]) '-'
784 do_one (other_wrap_info, _) = '-'