Commit fa44695e authored by simonpj's avatar simonpj
Browse files

[project @ 1997-01-17 00:32:23 by simonpj]

Cross module worker-wrappers
parent e640627a
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.6 1997/01/06 21:08:42 simonpj Exp $
# $Id: Makefile,v 1.7 1997/01/17 00:32:23 simonpj Exp $
TOP = ../..
FlexSuffixRules = YES
......@@ -23,7 +23,7 @@ include $(TOP)/mk/rules.mk
#-----------------------------------------------------------------------------
# make libhsp.a
YFLAGS = -d
YFLAGS = -d -v
CFLAGS = -Iparser -I. -IcodeGen
ARCHIVE = libhsp.a
DESTDIR = $(INSTLIBDIR_GHC)
......
......@@ -34,6 +34,7 @@ data Demand
-- calling-convention magic)
| WwUnpack -- Argument is strict & a single-constructor
Bool -- True <=> wrapper unpacks it; False <=> doesn't
[Demand] -- type; its constituent parts (whose StrictInfos
-- are in the list) should be passed
-- as arguments to the worker.
......@@ -53,7 +54,7 @@ type MaybeAbsent = Bool -- True <=> not even used
-- versions that don't worry about Absence:
wwLazy = WwLazy False
wwStrict = WwStrict
wwUnpack xs = WwUnpack xs
wwUnpack xs = WwUnpack False xs
wwPrim = WwPrim
wwEnum = WwEnum
\end{code}
......@@ -69,7 +70,7 @@ wwEnum = WwEnum
isStrict :: Demand -> Bool
isStrict WwStrict = True
isStrict (WwUnpack _) = True
isStrict (WwUnpack _ _) = True
isStrict WwPrim = True
isStrict WwEnum = True
isStrict _ = False
......@@ -97,24 +98,30 @@ instance Text Demand where
read_em acc ('E' : xs) = read_em (WwEnum : acc) xs
read_em acc (')' : xs) = [(reverse acc, xs)]
read_em acc ( 'U' : '(' : xs)
read_em acc ( 'U' : '(' : xs) = do_unpack True acc xs
read_em acc ( 'u' : '(' : xs) = do_unpack False acc xs
read_em acc rest = [(reverse acc, rest)]
do_unpack wrapper_unpacks acc xs
= case (read_em [] xs) of
[(stuff, rest)] -> read_em (WwUnpack stuff : acc) rest
[(stuff, rest)] -> read_em (WwUnpack wrapper_unpacks stuff : acc) rest
_ -> panic ("Text.Demand:"++str++"::"++xs)
read_em acc rest = [(reverse acc, rest)]
#ifdef REALLY_HASKELL_1_3
instance Show Demand where
#endif
showList wrap_args rest = foldr show1 rest wrap_args
where
show1 (WwLazy False) rest = 'L' : rest
show1 (WwLazy True) rest = 'A' : rest
show1 WwStrict rest = 'S' : rest
show1 WwPrim rest = 'P' : rest
show1 WwEnum rest = 'E' : rest
show1 (WwUnpack args) rest = "U(" ++ showList args (')' : rest)
show1 (WwLazy False) rest = 'L' : rest
show1 (WwLazy True) rest = 'A' : rest
show1 WwStrict rest = 'S' : rest
show1 WwPrim rest = 'P' : rest
show1 WwEnum rest = 'E' : rest
show1 (WwUnpack wu args) rest = ch ++ "(" ++ showList args (')' : rest)
where
ch = if wu then "U" else "u"
instance Outputable Demand where
ppr sty si = ppStr (showList [si] "")
......
......@@ -134,11 +134,9 @@ type UniqSM result = UniqSupply -> result
-- the initUs function also returns the final UniqSupply
initUs :: UniqSupply -> UniqSM a -> (UniqSupply, a)
initUs :: UniqSupply -> UniqSM a -> a
initUs init_us m
= case (splitUniqSupply init_us) of { (s1, s2) ->
(s2, m s1) }
initUs init_us m = m init_us
{-# INLINE thenUs #-}
{-# INLINE returnUs #-}
......
......@@ -980,7 +980,7 @@ mkWrapperArgTypeCategories wrapper_ty wrap_info
do_one (WwPrim, _) = 'P'
do_one (WwEnum, _) = 'E'
do_one (WwStrict, arg_ty_char) = arg_ty_char
do_one (WwUnpack _, 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'
......
......@@ -52,7 +52,7 @@ import RdrHsSyn ( RdrName )
import OccurAnal ( occurAnalyseGlobalExpr )
import CoreUtils ( coreExprType )
import CostCentre ( ccMentionsId )
import Id ( idType, getIdArity, isBottomingId,
import Id ( idType, getIdArity, isBottomingId, isDataCon, isPrimitiveId_maybe,
SYN_IE(IdSet), GenId{-instances-} )
import PrimOp ( primOpCanTriggerGC, fragilePrimOp, PrimOp(..) )
import IdInfo ( ArityInfo(..), bottomIsGuaranteed )
......@@ -64,6 +64,7 @@ import UniqSet ( emptyUniqSet, unitUniqSet, mkUniqSet,
addOneToUniqSet, unionUniqSets
)
import Usage ( SYN_IE(UVar) )
import Maybes ( maybeToBool )
import Util ( isIn, panic, assertPanic )
\end{code}
......@@ -179,6 +180,7 @@ mkFormSummary expr
go n (App fun other_arg) = go n fun
go n (Var f) | isBottomingId f = BottomForm
| isDataCon f = ValueForm -- Can happen inside imported unfoldings
go 0 (Var f) = VarForm
go n (Var f) = case getIdArity f of
ArityExactly a | n < a -> ValueForm
......@@ -235,39 +237,31 @@ calcUnfoldingGuidance
calcUnfoldingGuidance True bOMB_OUT_SIZE expr = UnfoldAlways -- Always inline if the INLINE pragma says so
calcUnfoldingGuidance False any_size (Con _ _ ) = UnfoldAlways -- We are very gung ho about inlining
calcUnfoldingGuidance False any_size (Lit _) = UnfoldAlways -- constructors and literals
calcUnfoldingGuidance False bOMB_OUT_SIZE expr
= let
(use_binders, ty_binders, val_binders, body) = collectBinders expr
in
case (sizeExpr bOMB_OUT_SIZE val_binders body) of
Nothing -> UnfoldNever
Nothing -> UnfoldNever
Just (size, cased_args)
-> let
uf = UnfoldIfGoodArgs
-> UnfoldIfGoodArgs
(length ty_binders)
(length val_binders)
(map discount_for val_binders)
size
discount_for b
where
discount_for b
| is_data && b `is_elem` cased_args = tyConFamilySize tycon
| otherwise = 0
where
(is_data, tycon)
= --trace "CoreUnfold.getAppDataTyConExpandingDicts:1" $
case (maybeAppDataTyConExpandingDicts (idType b)) of
= case (maybeAppDataTyConExpandingDicts (idType b)) of
Nothing -> (False, panic "discount")
Just (tc,_,_) -> (True, tc)
in
-- pprTrace "calcUnfold:" (ppAbove (ppr PprDebug uf) (ppr PprDebug expr))
uf
where
is_elem = isIn "calcUnfoldingGuidance"
is_elem = isIn "calcUnfoldingGuidance"
\end{code}
\begin{code}
......@@ -280,13 +274,31 @@ sizeExpr :: Int -- Bomb out if it gets bigger than this
)
sizeExpr bOMB_OUT_SIZE args expr
| data_or_prim fun
-- We are very keen to inline literals, constructors, or primitives
-- including their slightly-disguised forms as applications (the latter
-- can show up in the bodies of things imported from interfaces).
= Just (0, [])
| otherwise
= size_up expr
where
size_up (Var v) = sizeOne
size_up (App fun arg) = size_up fun `addSize` size_up_arg arg
(fun, _) = splitCoreApps expr
data_or_prim (Var v) = maybeToBool (isPrimitiveId_maybe v) ||
isDataCon v
data_or_prim (Con _ _) = True
data_or_prim (Prim _ _) = True
data_or_prim (Lit _) = True
data_or_prim other = False
size_up (Var v) = sizeZero
size_up (App fun arg) = size_up fun `addSize` size_up_arg arg `addSizeN` 1
-- 1 for application node
size_up (Lit lit) = if isNoRepLit lit
then sizeN uNFOLDING_NOREP_LIT_COST
else sizeOne
else sizeZero
-- I don't understand this hack so I'm removing it! SLPJ Nov 96
-- size_up (SCC _ (Con _ _)) = Nothing -- **** HACK *****
......@@ -294,8 +306,10 @@ sizeExpr bOMB_OUT_SIZE args expr
size_up (SCC lbl body) = size_up body -- SCCs cost nothing
size_up (Coerce _ _ body) = size_up body -- Coercions cost nothing
size_up (Con con args) = -- 1 + # of val args
sizeN (1 + numValArgs args)
size_up (Con con args) = sizeN (numValArgs args)
-- We don't count 1 for the constructor because we're
-- quite keen to get constructors into the open
size_up (Prim op args) = sizeN op_cost -- NB: no charge for PrimOp args
where
op_cost = if primOpCanTriggerGC op
......@@ -331,16 +345,23 @@ sizeExpr bOMB_OUT_SIZE args expr
-- We charge for the "case" itself in "size_up_alts"
------------
size_up_arg arg = if isValArg arg then sizeOne else sizeZero{-it's free-}
size_up_arg (LitArg lit) | isNoRepLit lit = sizeN uNFOLDING_NOREP_LIT_COST
size_up_arg other = sizeZero
------------
size_up_alts scrut_ty (AlgAlts alts deflt)
= foldr (addSize . size_alg_alt) (size_up_deflt deflt) alts
`addSizeN` (if is_data then tyConFamilySize tycon else 1{-??-})
= foldr (addSize . size_alg_alt) (size_up_deflt deflt) alts `addSizeN` 1
-- "1" for the case itself
-- `addSizeN` (if is_data then tyConFamilySize tycon else 1)
--
-- OLD COMMENT: looks unfair to me! So I've nuked this extra charge
-- SLPJ Jan 97
-- NB: we charge N for an alg. "case", where N is
-- the number of constructors in the thing being eval'd.
-- (You'll eventually get a "discount" of N if you
-- think the "case" is likely to go away.)
where
size_alg_alt (con,args,rhs) = size_up rhs
-- Don't charge for args, so that wrappers look cheap
......@@ -367,8 +388,8 @@ sizeExpr bOMB_OUT_SIZE args expr
-- Second, we want to charge nothing for the srutinee if it's just
-- a variable. That way wrapper-like things look cheap.
size_up_scrut (Var v) | v `is_elem` args = Just (0, [v])
| otherwise = Just (0, [])
size_up_scrut other = size_up other
| otherwise = Just (0, [])
size_up_scrut other = size_up other
is_elem :: Id -> [Id] -> Bool
is_elem = isIn "size_up_scrut"
......@@ -393,6 +414,12 @@ sizeExpr bOMB_OUT_SIZE args expr
where
tot = n+m
xys = xs ++ ys
splitCoreApps e
= go e []
where
go (App fun arg) args = go fun (arg:args)
go fun args = (fun,args)
\end{code}
%************************************************************************
......
......@@ -249,7 +249,8 @@ instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
ppCurlies (ppInterleave pp'SP (map pp_field fields))
]
where
pp_field (n, ty) = ppCat [ppr sty n, ppPStr SLIT("::"), ppr_bang sty ty]
pp_field (ns, ty) = ppCat [ppCat (map (ppr sty . getOccName) ns),
ppPStr SLIT("::"), ppr_bang sty ty]
ppr_bang sty (Banged ty) = ppBeside (ppChar '!') (pprParendHsType sty ty)
ppr_bang sty (Unbanged ty) = pprParendHsType sty ty
......
......@@ -56,11 +56,8 @@ data HsType name
| MonoTyVar name -- Type variable
| MonoTyApp name -- Type constructor or variable
[HsType name]
-- We *could* have a "MonoTyCon name" equiv to "MonoTyApp name []"
-- (for efficiency, what?) WDP 96/02/18
| MonoTyApp (HsType name)
(HsType name)
| MonoFunTy (HsType name) -- function type
(HsType name)
......@@ -167,13 +164,9 @@ ppr_mono_ty sty ctxt_prec (MonoTupleTy _ tys)
ppr_mono_ty sty ctxt_prec (MonoListTy _ ty)
= ppBesides [ppLbrack, ppr_mono_ty sty pREC_TOP ty, ppRbrack]
ppr_mono_ty sty ctxt_prec (MonoTyApp tycon tys)
= let pp_tycon = ppr_hs_tyname sty tycon in
if null tys then
pp_tycon
else
maybeParen (ctxt_prec >= pREC_CON)
(ppCat [pp_tycon, ppInterleave ppNil (map (ppr_mono_ty sty pREC_CON) tys)])
ppr_mono_ty sty ctxt_prec (MonoTyApp fun_ty arg_ty)
= maybeParen (ctxt_prec >= pREC_CON)
(ppCat [ppr_mono_ty sty pREC_FUN fun_ty, ppr_mono_ty sty pREC_CON arg_ty])
ppr_mono_ty sty ctxt_prec (MonoDictTy clas ty)
= ppCurlies (ppCat [ppr sty clas, ppr_mono_ty sty pREC_CON ty])
......@@ -221,9 +214,8 @@ cmpHsType cmp (MonoTupleTy _ tys1) (MonoTupleTy _ tys2)
cmpHsType cmp (MonoListTy _ ty1) (MonoListTy _ ty2)
= cmpHsType cmp ty1 ty2
cmpHsType cmp (MonoTyApp tc1 tys1) (MonoTyApp tc2 tys2)
= cmp tc1 tc2 `thenCmp`
cmpList (cmpHsType cmp) tys1 tys2
cmpHsType cmp (MonoTyApp fun_ty1 arg_ty1) (MonoTyApp fun_ty2 arg_ty2)
= cmpHsType cmp fun_ty1 fun_ty2 `thenCmp` cmpHsType cmp arg_ty1 arg_ty2
cmpHsType cmp (MonoFunTy a1 b1) (MonoFunTy a2 b2)
= cmpHsType cmp a1 a2 `thenCmp` cmpHsType cmp b1 b2
......
......@@ -83,7 +83,7 @@ import Util
All pretty arbitrary:
\begin{code}
uNFOLDING_USE_THRESHOLD = ( 3 :: Int)
uNFOLDING_USE_THRESHOLD = ( 8 :: Int)
uNFOLDING_CREATION_THRESHOLD = (30 :: Int)
iNTERFACE_UNFOLD_THRESHOLD = (30 :: Int)
lIBERATE_CASE_THRESHOLD = (10 :: Int)
......@@ -91,7 +91,7 @@ lIBERATE_CASE_THRESHOLD = (10 :: Int)
uNFOLDING_CHEAP_OP_COST = ( 1 :: Int)
uNFOLDING_DEAR_OP_COST = ( 4 :: Int)
uNFOLDING_NOREP_LIT_COST = ( 4 :: Int)
uNFOLDING_NOREP_LIT_COST = ( 20 :: Int) -- Strings can be pretty big
uNFOLDING_CON_DISCOUNT_WEIGHT = ( 1 :: Int)
\end{code}
......
......@@ -228,7 +228,7 @@ BOOLEAN inpat;
constrs constr1 fields
types atypes batypes
types_and_maybe_ids
pats context context_list tyvar_list
pats context context_list /* tyvar_list */
export_list enames
import_list inames
impdecls maybeimpdecls impdecl
......@@ -269,9 +269,11 @@ BOOLEAN inpat;
%type <upbinding> valrhs1 altrest
%type <uttype> simple ctype type atype btype
gtyconapp ntyconapp ntycon gtyconvars
bbtype batype btyconapp
class restrict_inst general_inst tyvar
gtyconvars
bbtype batype
class tyvar
/* gtyconapp0 gtyconapp1 ntyconapp0 ntyconapp1 btyconapp */
/* restrict_inst general_inst */
%type <uconstr> constr field
......@@ -513,9 +515,9 @@ cbody : /* empty */ { $$ = mknullbind(); }
| WHERE vocurly decls vccurly { checkorder($3); $$ = $3; }
;
instd : instkey context DARROW gtycon restrict_inst rinst
instd : instkey context DARROW gtycon atype rinst
{ $$ = mkibind($2,$4,$5,$6,startlineno); }
| instkey gtycon general_inst rinst
| instkey gtycon atype rinst
{ $$ = mkibind(Lnil,$2,$3,$4,startlineno); }
;
......@@ -524,6 +526,13 @@ rinst : /* empty */ { $$ = mknullbind(); }
| WHERE vocurly instdefs vccurly { $$ = $3; }
;
/* I now allow a general type in instance declarations, relying
on the type checker to reject instance decls which are ill-formed.
Some (non-standard) extensions of Haskell may allow more general
types than the Report syntax permits, and in any case not all things
can be checked in the syntax (eg repeated type variables).
SLPJ Jan 97
restrict_inst : gtycon { $$ = mktname($1); }
| OPAREN gtyconvars CPAREN { $$ = $2; }
| OPAREN tyvar COMMA tyvar_list CPAREN { $$ = mkttuple(mklcons($2,$4)); }
......@@ -532,11 +541,12 @@ restrict_inst : gtycon { $$ = mktname($1); }
;
general_inst : gtycon { $$ = mktname($1); }
| OPAREN gtyconapp CPAREN { $$ = $2; }
| OPAREN gtyconapp1 CPAREN { $$ = $2; }
| OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
| OBRACK type CBRACK { $$ = mktllist($2); }
| OPAREN btype RARROW type CPAREN { $$ = mktfun($2,$4); }
;
*/
defaultd: defaultkey OPAREN types CPAREN { $$ = mkdbind($3,startlineno); }
| defaultkey OPAREN CPAREN { $$ = mkdbind(Lnil,startlineno); }
......@@ -579,7 +589,7 @@ decl : qvarsk DCOLON ctype
PREVPATT = NULL; FN = NULL; SAMEFN = 0;
}
| SPECIALISE_UPRAGMA INSTANCE gtycon general_inst END_UPRAGMA
| SPECIALISE_UPRAGMA INSTANCE gtycon atype END_UPRAGMA
{
$$ = mkispec_uprag($3, $4, startlineno);
PREVPATT = NULL; FN = NULL; SAMEFN = 0;
......@@ -663,25 +673,12 @@ type : btype { $$ = $1; }
| btype RARROW type { $$ = mktfun($1,$3); }
;
/* btype is split so we can parse gtyconapp without S/R conflicts */
btype : gtyconapp { $$ = $1; }
| ntyconapp { $$ = $1; }
;
ntyconapp: ntycon { $$ = $1; }
| ntyconapp atype { $$ = mktapp($1,$2); }
;
gtyconapp: gtycon { $$ = mktname($1); }
| gtyconapp atype { $$ = mktapp($1,$2); }
btype : atype { $$ = $1; }
| btype atype { $$ = mktapp($1,$2); }
;
atype : gtycon { $$ = mktname($1); }
| ntycon { $$ = $1; }
;
ntycon : tyvar { $$ = $1; }
| tyvar { $$ = $1; }
| OPAREN type COMMA types CPAREN { $$ = mkttuple(mklcons($2,$4)); }
| OBRACK type CBRACK { $$ = mktllist($2); }
| OPAREN type CPAREN { $$ = $2; }
......@@ -737,23 +734,47 @@ constrs : constr { $$ = lsing($1); }
| constrs VBAR constr { $$ = lapp($1,$3); }
;
constr : btyconapp { qid tyc; list tys;
constr :
/* This stuff looks really baroque. I've replaced it with simpler stuff.
SLPJ Jan 97
btyconapp { qid tyc; list tys;
splittyconapp($1, &tyc, &tys);
$$ = mkconstrpre(tyc,tys,hsplineno); }
| OPAREN qconsym CPAREN { $$ = mkconstrpre($2,Lnil,hsplineno); }
| OPAREN qconsym CPAREN batypes { $$ = mkconstrpre($2,$4,hsplineno); }
| btyconapp qconop bbtype { checknobangs($1);
| btyconapp qconop bbtype { checknobangs($1);
$$ = mkconstrinf($1,$2,$3,hsplineno); }
| ntyconapp qconop bbtype { $$ = mkconstrinf($1,$2,$3,hsplineno); }
| ntyconapp0 qconop bbtype { $$ = mkconstrinf($1,$2,$3,hsplineno); }
| BANG atype qconop bbtype { $$ = mkconstrinf(mktbang($2),$3,$4,hsplineno); }
| OPAREN qconsym CPAREN { $$ = mkconstrpre($2,Lnil,hsplineno); }
*/
/* 1 S/R conflict on OCURLY -> shift */
btype { qid tyc; list tys;
splittyconapp($1, &tyc, &tys);
$$ = mkconstrpre(tyc,tys,hsplineno); }
/* We have to parse the constructor application as a *type*, else we get
into terrible ambiguity problems. Consider the difference between
data T = S Int Int Int `R` Int
and
data T = S Int Int Int
It isn't till we get to the operator that we discover that the "S" is
part of a type in the first, but part of a constructor application in the
second.
*/
| OPAREN qconsym CPAREN batypes { $$ = mkconstrpre($2,$4,hsplineno); }
| bbtype qconop bbtype { $$ = mkconstrinf($1,$2,$3,hsplineno); }
| gtycon OCURLY fields CCURLY { $$ = mkconstrrec($1,$3,hsplineno); }
/* 1 S/R conflict on OCURLY -> shift */
;
/*
btyconapp: gtycon { $$ = mktname($1); }
| btyconapp batype { $$ = mktapp($1,$2); }
;
*/
bbtype : btype { $$ = $1; }
| BANG atype { $$ = mktbang($2); }
......@@ -763,7 +784,7 @@ batype : atype { $$ = $1; }
| BANG atype { $$ = mktbang($2); }
;
batypes : batype { $$ = lsing($1); }
batypes : { $$ = Lnil; }
| batypes batype { $$ = lapp($1,$2); }
;
......@@ -1452,9 +1473,11 @@ tycon : CONID
modid : CONID
;
/*
tyvar_list: tyvar { $$ = lsing($1); }
| tyvar_list COMMA tyvar { $$ = lapp($1,$3); }
;
*/
/**********************************************************************
* *
......
......@@ -279,7 +279,7 @@ creategid(i)
{
switch(i) {
case -2:
return(mkgid(i,install_literal("(->)")));
return(mkgid(i,install_literal("->")));
case -1:
return(mkgid(i,install_literal("[]")));
case 0:
......
......@@ -19,7 +19,7 @@
/* fwd decls, necessary and otherwise */
static void pbool PROTO( (BOOLEAN) );
static void pconstr PROTO( (constr) );
static void pcoresyn PROTO((coresyn));
/* static void pcoresyn PROTO((coresyn)); */
static void pentid PROTO( (entidt) );
static void pgrhses PROTO( (list) );
static void pid PROTO( (id) );
......@@ -27,12 +27,13 @@ static void plist PROTO( (void (*)(/*NOT WORTH IT: void * */), list) );
static void pmaybe PROTO( (void (*)(), maybe) );
static void pmaybe_list PROTO( (void (*)(), maybe) );
static void ppbinding PROTO((pbinding));
static void ppragma PROTO( (hpragma) );
/* static void ppragma PROTO( (hpragma) ); */
static void pqid PROTO( (qid) );
static void prbind PROTO( (binding) );
static void pstr PROTO( (char *) );
static void ptree PROTO( (tree) );
static void pttype PROTO( (ttype) );
static void plineno PROTO( (long) );
extern char *input_filename;
extern BOOLEAN hashIds;
......@@ -91,6 +92,15 @@ print_string(hstring str)
putchar('\t');
}
static void
plineno (l)
long l;
{
printf("#%lu\t",l);
return;
}
static int
get_character(hstring str)
{
......@@ -153,21 +163,7 @@ pliteral(literal t)
case clitlit:
PUTTAG('Y');
pstr(gclitlit(t));
pstr(gclitlit_kind(t));
break;
case norepi:
PUTTAG('I');
pstr(gnorepi(t));
break;
case norepr:
PUTTAG('R');
pstr(gnorepr_n(t));
pstr(gnorepr_d(t));
break;
case noreps:
PUTTAG('s');
print_string(gnoreps(t));
/* pstr(gclitlit_kind(t)); */
break;
default:
error("Bad pliteral");
......@@ -180,17 +176,22 @@ ptree(t)
{
again:
switch(ttree(t)) {
case par: t = gpare(t); goto again;
case hmodule:
PUTTAG('M');
printf("#%lu\t",ghmodline(t));
plineno(ghmodline(t));
pid(ghname(t));
printf("#%lu\t",ghversion(t));
pstr(input_filename);
prbind(ghmodlist(t));
/* pfixes(); */
plist(prbind, ghimplist(t));
pmaybe_list(pentid, ghexplist(t));
break;
case fixop:
PUTTAG('I');
pqid(gfixop(t));
printf("%lu\t%lu",gfixinfx(t),gfixprec(t));
break;
case ident:
PUTTAG('i');
pqid(gident(t));
......@@ -211,9 +212,13 @@ again:
ptree(ginfarg1(t));
ptree(ginfarg2(t));
break;
case negate:
PUTTAG('-');
ptree(gnexp(t));
break;
case lambda:
PUTTAG('l');
printf("#%lu\t",glamline(t));
plineno(glamline(t));
plist(ptree,glampats(t));
ptree(glamexpr(t));
break;
......@@ -225,6 +230,7 @@ again:
break;
case casee:
PUTTAG('c');
plineno(gcaseline(t));
ptree(gcaseexpr(t));
plist(ppbinding, gcasebody(t));
break;
......@@ -234,13 +240,45 @@ again:
ptree(gifthen(t));
ptree(gifelse(t));
break;
/* case doe: */