X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2Fprinttree.c;h=d529fb94cbb28741a30f1eca4339ece0fd9edf6b;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=a5056ef6358035a471d5de639386a93d2867dc49;hpb=6c381e873e222417d9a67aeec77b9555eca7b7a8;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/printtree.c b/ghc/compiler/parser/printtree.c index a5056ef..d529fb9 100644 --- a/ghc/compiler/parser/printtree.c +++ b/ghc/compiler/parser/printtree.c @@ -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: */ - /* case dobind: */ - /* case doexp: */ - /* case seqlet: */ - /* case record: */ - /* case rupdate: */ - /* case rbind: */ + case doe: + PUTTAG('O'); + plineno(gdoline(t)); + plist(ptree, gdo(t)); + break; + case dobind: + PUTTAG('Q'); + plineno(gdobindline(t)); + ptree(gdobindpat(t)); + ptree(gdobindexp(t)); + break; + case doexp: + PUTTAG('R'); + plineno(gdoexpline(t)); + ptree(gdoexp(t)); + break; + case seqlet: + PUTTAG('U'); + prbind(gseqlet(t)); + break; + case record: + PUTTAG('d'); + pqid(grcon(t)); + plist(prbind,grbinds(t)); + break; + + case rupdate: + PUTTAG('h'); + ptree(gupdexp(t)); + plist(prbind,gupdbinds(t)); + break; + + case rbind: + PUTTAG('o'); + pqid(grbindvar(t)); + pmaybe(ptree,grbindexp(t)); + break; + + case par: t = gpare(t); goto again; case as: PUTTAG('s'); @@ -309,10 +347,6 @@ again: print_string(gsccid(t)); ptree(gsccexp(t)); break; - case negate: - PUTTAG('-'); - ptree(gnexp(t)); - break; default: error("Bad ptree"); } @@ -392,28 +426,34 @@ prbind(b) switch(tbinding(b)) { case tbind: PUTTAG('t'); - printf("#%lu\t",gtline(b)); + plineno(gtline(b)); plist(pttype, gtbindc(b)); pmaybe_list(pid, gtbindd(b)); pttype(gtbindid(b)); plist(pconstr, gtbindl(b)); - ppragma(gtpragma(b)); break; - /* case ntbind: */ + case ntbind: + PUTTAG('q'); + plineno(gntline(b)); + plist(pttype,gntbindcty(b)); + pmaybe_list(pid, gntbindd(b)); + pttype(gntbindid(b)); + plist(pconstr, gntbindcty(b)); + break; case nbind : PUTTAG('n'); - printf("#%lu\t",gnline(b)); + plineno(gnline(b)); pttype(gnbindid(b)); pttype(gnbindas(b)); break; case pbind : PUTTAG('p'); - printf("#%lu\t",gpline(b)); + plineno(gpline(b)); plist(ppbinding, gpbindl(b)); break; case fbind : PUTTAG('f'); - printf("#%lu\t",gfline(b)); + plineno(gfline(b)); plist(ppbinding, gfbindl(b)); break; case abind : @@ -421,92 +461,99 @@ prbind(b) prbind(gabindfst(b)); prbind(gabindsnd(b)); break; - case cbind : - PUTTAG('$'); - printf("#%lu\t",gcline(b)); - plist(pttype,gcbindc(b)); - pttype(gcbindid(b)); - prbind(gcbindw(b)); - ppragma(gcpragma(b)); - break; case ibind : PUTTAG('%'); - printf("#%lu\t",giline(b)); - plist(pttype,gibindc(b)); - pqid(gibindid(b)); + plineno(giline(b)); pttype(gibindi(b)); prbind(gibindw(b)); - ppragma(gipragma(b)); + /* ppragma(gipragma(b)); */ break; case dbind : PUTTAG('D'); - printf("#%lu\t",gdline(b)); + plineno(gdline(b)); plist(pttype,gdbindts(b)); break; + case cbind : + PUTTAG('$'); + plineno(gcline(b)); + plist(pttype,gcbindc(b)); + pttype(gcbindid(b)); + prbind(gcbindw(b)); + break; + /* signature(-like) things, including user pragmas */ case sbind : - PUTTAGSTR("St"); - printf("#%lu\t",gsline(b)); + PUTTAG('r'); + plineno(gsline(b)); plist(pqid,gsbindids(b)); pttype(gsbindid(b)); - ppragma(gspragma(b)); break; + case nullbind : + PUTTAG('B'); + break; + + case import: + PUTTAG('e'); + plineno(gibindline(b)); + /* pid(gibindfile(b)); */ + pid(gibindimod(b)); + printf("#%lu\t",gibindqual(b)); /* 1 -- qualified */ + printf("#%lu\t",gibindsource(b)); /* 1 -- from source */ + pmaybe(pid, gibindas(b)); + pmaybe(pconstr, gibindspec(b)); + /* plist(pentid,giebindexp(b)); ??? */ + /* prbind(giebinddef(b)); ???? */ + break; + + /* User pragmas till the end */ + case vspec_uprag: PUTTAGSTR("Ss"); - printf("#%lu\t",gvspec_line(b)); + plineno(gvspec_line(b)); pqid(gvspec_id(b)); plist(pttype,gvspec_tys(b)); break; + case vspec_ty_and_id: + PUTTAGSTR("St"); + pttype(gvspec_ty(b)); + pmaybe(pttype,gvspec_tyid(b)); + break; + case ispec_uprag: PUTTAGSTR("SS"); - printf("#%lu\t",gispec_line(b)); + plineno(gispec_line(b)); pqid(gispec_clas(b)); pttype(gispec_ty(b)); break; case inline_uprag: PUTTAGSTR("Si"); - printf("#%lu\t",ginline_line(b)); + plineno(ginline_line(b)); pqid(ginline_id(b)); break; - case deforest_uprag: - PUTTAGSTR("Sd"); - printf("#%lu\t",gdeforest_line(b)); - pqid(gdeforest_id(b)); - break; case magicuf_uprag: PUTTAGSTR("Su"); - printf("#%lu\t",gmagicuf_line(b)); + plineno(gmagicuf_line(b)); pqid(gmagicuf_id(b)); pid(gmagicuf_str(b)); break; case dspec_uprag: PUTTAGSTR("Sd"); - printf("#%lu\t",gdspec_line(b)); + plineno(gdspec_line(b)); pqid(gdspec_id(b)); plist(pttype,gdspec_tys(b)); break; /* end of signature(-like) things */ - +/* not used: case mbind: PUTTAG('7'); - printf("#%lu\t",gmline(b)); + plineno(gmline(b)); pid(gmbindmodn(b)); plist(pentid,gmbindimp(b)); break; - case import: - PUTTAG('e'); - printf("#%lu\t",gibindline(b)); - pid(gibindfile(b)); - pid(gibindmod(b)); - /* plist(pentid,giebindexp(b)); ??? */ - /* prbind(giebinddef(b)); ???? */ - break; - case nullbind : - PUTTAG('B'); - break; +*/ default : error("Bad prbind"); break; } @@ -521,7 +568,7 @@ pttype(t) pqid(gtypeid(t)); break; case namedtvar : PUTTAG('y'); - pid(gnamedtvar(t)); + pstr(gnamedtvar(t)); break; case tllist : PUTTAG(':'); pttype(gtlist(t)); @@ -540,23 +587,11 @@ pttype(t) case tbang : PUTTAG('!'); pttype(gtbang(t)); break; - case context : PUTTAG('3'); - plist(pttype,gtcontextl(t)); - pttype(gtcontextt(t)); + case forall : PUTTAG('3'); + plist(pstr, gtforalltv(t)); + plist(pttype,gtforallctxt(t)); + pttype(gtforallt(t)); break; - - case unidict : PUTTAGSTR("2A"); - pqid(gunidict_clas(t)); - pttype(gunidict_ty(t)); - break; - case unityvartemplate : PUTTAGSTR("2B"); - pid(gunityvartemplate(t)); - break; - case uniforall : PUTTAGSTR("2C"); - plist(pid,guniforall_tv(t)); - pttype(guniforall_ty(t)); - break; - default : error("bad pttype"); } } @@ -568,18 +603,35 @@ pconstr(a) switch (tconstr(a)) { case constrpre : PUTTAG('1'); - printf("#%lu\t",gconcline(a)); + plineno(gconcline(a)); pqid(gconcid(a)); plist(pttype, gconctypel(a)); break; case constrinf : PUTTAG('2'); - printf("#%lu\t",gconiline(a)); + plineno(gconiline(a)); pqid(gconiop(a)); pttype(gconity1(a)); pttype(gconity2(a)); break; + case constrrec : + PUTTAG('u'); + plineno(gconrline(a)); + pqid(gconrid(a)); + plist(pqid,gconrfieldl(a)); + break; + case constrnew : + PUTTAG('v'); + plineno(gconnline(a)); + pqid(gconnid(a)); + pttype(gconnty(a)); + break; + case field : + PUTTAG('5'); + plist(pqid,gfieldn(a)); + pttype(gfieldt(a)); + break; default : fprintf(stderr, "Bad tag in abstree %d\n", tconstr(a)); exit(1); } @@ -619,12 +671,25 @@ ppbinding(p) { switch(tpbinding(p)) { case pgrhs : PUTTAG('W'); - printf("#%lu\t",ggline(p)); + plineno(ggline(p)); pqid(ggfuncname(p)); ptree(ggpat(p)); - plist(pgrhses,ggdexprs(p)); + ppbinding(ggdexprs(p)); prbind(ggbind(p)); break; + case pnoguards : + PUTTAG('6'); + ptree(gpnoguard(p)); + break; + case pguards : + PUTTAG('9'); + plist(ptree, gpguards(p)); + break; + case pgdexp : + PUTTAG('&'); + plist(ptree, gpguard(p)); /* Experimental: pattern guards */ + ptree(gpexp(p)); + break; default : error("Bad pbinding"); } @@ -638,7 +703,7 @@ pgrhses(l) ptree(lhd(l)); /* Guard */ ptree(lhd(ltl(l))); /* Expression */ } - +/* static void ppragma(p) hpragma p; @@ -661,19 +726,18 @@ ppragma(p) break; case iinst_simpl_pragma: PUTTAGSTR("Pis"); - pid(gprag_imod_simpl(p)); - ppragma(gprag_dfun_simpl(p)); +/ * pid(gprag_imod_simpl(p)); +* / ppragma(gprag_dfun_simpl(p)); break; case iinst_const_pragma: PUTTAGSTR("Pic"); - pid(gprag_imod_const(p)); - ppragma(gprag_dfun_const(p)); +/ * pid(gprag_imod_const(p)); +* / ppragma(gprag_dfun_const(p)); plist(ppragma, gprag_constms(p)); break; case igen_pragma: PUTTAGSTR("Pg"); ppragma(gprag_arity(p)); ppragma(gprag_update(p)); - ppragma(gprag_deforest(p)); ppragma(gprag_strictness(p)); ppragma(gprag_unfolding(p)); plist(ppragma, gprag_specs(p)); @@ -684,8 +748,6 @@ ppragma(p) case iupdate_pragma: PUTTAGSTR("Pu"); pid(gprag_update_val(p)); break; - case ideforest_pragma: PUTTAGSTR("PD"); - break; case istrictness_pragma: PUTTAGSTR("PS"); print_string(gprag_strict_spec(p)); ppragma(gprag_strict_wrkr(p)); @@ -725,6 +787,7 @@ ppragma(p) default: error("Bad Pragma"); } } +*/ static void pbool(b) @@ -737,198 +800,3 @@ pbool(b) } } -static void -pcoresyn(p) - coresyn p; -{ - switch(tcoresyn(p)) { - case cobinder: PUTTAGSTR("Fa"); - pid(gcobinder_v(p)); - pttype(gcobinder_ty(p)); - break; - - case colit: PUTTAGSTR("Fb"); - pliteral(gcolit(p)); - break; - case colocal: PUTTAGSTR("Fc"); - pcoresyn(gcolocal_v(p)); - break; - - case cononrec: PUTTAGSTR("Fd"); - pcoresyn(gcononrec_b(p)); - pcoresyn(gcononrec_rhs(p)); - break; - case corec: PUTTAGSTR("Fe"); - plist(pcoresyn,gcorec(p)); - break; - case corec_pair: PUTTAGSTR("Ff"); - pcoresyn(gcorec_b(p)); - pcoresyn(gcorec_rhs(p)); - break; - - case covar: PUTTAGSTR("Fg"); - pcoresyn(gcovar(p)); - break; - case coliteral: PUTTAGSTR("Fh"); - pliteral(gcoliteral(p)); - break; - case cocon: PUTTAGSTR("Fi"); - pcoresyn(gcocon_con(p)); - plist(pttype, gcocon_tys(p)); - plist(pcoresyn, gcocon_args(p)); - break; - case coprim: PUTTAGSTR("Fj"); - pcoresyn(gcoprim_op(p)); - plist(pttype, gcoprim_tys(p)); - plist(pcoresyn, gcoprim_args(p)); - break; - case colam: PUTTAGSTR("Fk"); - plist(pcoresyn, gcolam_vars(p)); - pcoresyn(gcolam_body(p)); - break; - case cotylam: PUTTAGSTR("Fl"); - plist(pid, gcotylam_tvs(p)); - pcoresyn(gcotylam_body(p)); - break; - case coapp: PUTTAGSTR("Fm"); - pcoresyn(gcoapp_fun(p)); - plist(pcoresyn, gcoapp_args(p)); - break; - case cotyapp: PUTTAGSTR("Fn"); - pcoresyn(gcotyapp_e(p)); - pttype(gcotyapp_t(p)); - break; - case cocase: PUTTAGSTR("Fo"); - pcoresyn(gcocase_s(p)); - pcoresyn(gcocase_alts(p)); - break; - case colet: PUTTAGSTR("Fp"); - pcoresyn(gcolet_bind(p)); - pcoresyn(gcolet_body(p)); - break; - case coscc: PUTTAGSTR("Fz"); /* out of order! */ - pcoresyn(gcoscc_scc(p)); - pcoresyn(gcoscc_body(p)); - break; - - case coalg_alts: PUTTAGSTR("Fq"); - plist(pcoresyn, gcoalg_alts(p)); - pcoresyn(gcoalg_deflt(p)); - break; - case coalg_alt: PUTTAGSTR("Fr"); - pcoresyn(gcoalg_con(p)); - plist(pcoresyn, gcoalg_bs(p)); - pcoresyn(gcoalg_rhs(p)); - break; - case coprim_alts: PUTTAGSTR("Fs"); - plist(pcoresyn, gcoprim_alts(p)); - pcoresyn(gcoprim_deflt(p)); - break; - case coprim_alt: PUTTAGSTR("Ft"); - pliteral(gcoprim_lit(p)); - pcoresyn(gcoprim_rhs(p)); - break; - case conodeflt: PUTTAGSTR("Fu"); - break; - case cobinddeflt: PUTTAGSTR("Fv"); - pcoresyn(gcobinddeflt_v(p)); - pcoresyn(gcobinddeflt_rhs(p)); - break; - - case co_primop: PUTTAGSTR("Fw"); - pid(gco_primop(p)); - break; - case co_ccall: PUTTAGSTR("Fx"); - pbool(gco_ccall_may_gc(p)); - pid(gco_ccall(p)); - plist(pttype, gco_ccall_arg_tys(p)); - pttype(gco_ccall_res_ty(p)); - break; - case co_casm: PUTTAGSTR("Fy"); - pbool(gco_casm_may_gc(p)); - pliteral(gco_casm(p)); - plist(pttype, gco_casm_arg_tys(p)); - pttype(gco_casm_res_ty(p)); - break; - - /* Cost-centre stuff */ - case co_preludedictscc: PUTTAGSTR("F?a"); - pcoresyn(gco_preludedictscc_dupd(p)); - break; - case co_alldictscc: PUTTAGSTR("F?b"); - print_string(gco_alldictscc_m(p)); - print_string(gco_alldictscc_g(p)); - pcoresyn(gco_alldictscc_dupd(p)); - break; - case co_usercc: PUTTAGSTR("F?c"); - print_string(gco_usercc_n(p)); - print_string(gco_usercc_m(p)); - print_string(gco_usercc_g(p)); - pcoresyn(gco_usercc_dupd(p)); - pcoresyn(gco_usercc_cafd(p)); - break; - case co_autocc: PUTTAGSTR("F?d"); - pcoresyn(gco_autocc_i(p)); - print_string(gco_autocc_m(p)); - print_string(gco_autocc_g(p)); - pcoresyn(gco_autocc_dupd(p)); - pcoresyn(gco_autocc_cafd(p)); - break; - case co_dictcc: PUTTAGSTR("F?e"); - pcoresyn(gco_dictcc_i(p)); - print_string(gco_dictcc_m(p)); - print_string(gco_dictcc_g(p)); - pcoresyn(gco_dictcc_dupd(p)); - pcoresyn(gco_dictcc_cafd(p)); - break; - - case co_scc_noncaf: PUTTAGSTR("F?f"); - break; - case co_scc_caf: PUTTAGSTR("F?g"); - break; - case co_scc_nondupd: PUTTAGSTR("F?h"); - break; - case co_scc_dupd: PUTTAGSTR("F?i"); - break; - - /* Id stuff */ - case co_id: PUTTAGSTR("F1"); - pid(gco_id(p)); - break; - case co_orig_id: PUTTAGSTR("F9"); - pid(gco_orig_id_m(p)); - pid(gco_orig_id_n(p)); - break; - case co_sdselid: PUTTAGSTR("F2"); - pid(gco_sdselid_c(p)); - pid(gco_sdselid_sc(p)); - break; - case co_classopid: PUTTAGSTR("F3"); - pid(gco_classopid_c(p)); - pid(gco_classopid_o(p)); - break; - case co_defmid: PUTTAGSTR("F4"); - pid(gco_defmid_c(p)); - pid(gco_defmid_op(p)); - break; - case co_dfunid: PUTTAGSTR("F5"); - pid(gco_dfunid_c(p)); - pttype(gco_dfunid_ty(p)); - break; - case co_constmid: PUTTAGSTR("F6"); - pid(gco_constmid_c(p)); - pid(gco_constmid_op(p)); - pttype(gco_constmid_ty(p)); - break; - case co_specid: PUTTAGSTR("F7"); - pcoresyn(gco_specid_un(p)); - plist(pttype,gco_specid_tys(p)); - break; - case co_wrkrid: PUTTAGSTR("F8"); - pcoresyn(gco_wrkrid_un(p)); - break; - /* more to come?? */ - - default : error("Bad Core syntax"); - } -}