1 /**********************************************************************
4 * Syntax Tree Printing Routines *
7 **********************************************************************/
10 #define COMPACT TRUE /* No spaces in output -- #undef this for debugging */
16 #include "constants.h"
19 /* fwd decls, necessary and otherwise */
20 static void ptree PROTO( (tree) );
21 static void plist PROTO( (void (*)(/*NOT WORTH IT: void * */), list) );
22 static void pid PROTO( (id) );
23 static void pstr PROTO( (char *) );
24 static void pbool PROTO( (BOOLEAN) );
25 static void prbind PROTO( (binding) );
26 static void pttype PROTO( (ttype) );
27 static void patype PROTO( (atype) );
28 static void pentid PROTO( (entidt) );
29 static void prename PROTO( (list) );
30 static void pfixes PROTO( (void) );
31 static void ppbinding PROTO((pbinding));
32 static void pgrhses PROTO( (list) );
33 static void ppragma PROTO( (hpragma) );
34 static void pcoresyn PROTO((coresyn));
36 extern char *fixop PROTO((int));
37 extern char *fixtype PROTO((int));
39 extern char *input_filename;
40 extern BOOLEAN hashIds;
42 /* How to print tags */
45 #define PUTTAG(c) putchar(c);
46 #define PUTTAGSTR(s) printf("%s",(s));
48 #define PUTTAG(c) putchar(c); \
50 #define PUTTAGSTR(s) printf("%s",(s)); \
55 /* Performs a post order walk of the tree
67 /* print_string: we must escape \t and \\, as described in
68 char/string lexer comments. (WDP 94/11)
71 print_string(hstring str)
78 str_length = str->len;
81 for (i = 0; i < str_length; i++) {
86 } else if ( c == '\\' ) {
97 get_character(hstring str)
99 int c = (int)((str->bytes)[0]);
101 if (str->len != 1) { /* ToDo: assert */
102 fprintf(stderr, "get_character: length != 1? (%ld: %s)\n", str->len, str->bytes);
106 c += 256; /* "This is not a hack" -- KH */
115 switch(tliteral(t)) {
130 pstr(gdoubleprim(t));
138 /* Changed %d to %u, since negative chars
139 make little sense -- KH @ 16/4/91
141 printf("#%u\t", get_character(gchar(t)));
145 printf("#%u\t", get_character(gcharprim(t)));
149 print_string(gstring(t));
153 print_string(gstringprim(t));
158 pstr(gclitlit_kind(t));
172 print_string(gnoreps(t));
175 error("Bad pliteral");
185 case par: t = gpare(t); goto again;
188 printf("#%lu\t",ghmodline(t));
190 pstr(input_filename);
191 prbind(ghmodlist(t));
193 plist(prbind, ghimplist(t));
194 plist(pentid, ghexplist(t));
222 ptree(ginarg1((struct Sap *)t));
223 pid(gident(ginfun((struct Sap *)t)));
224 ptree(ginarg2((struct Sap *)t));
229 printf("#%lu\t",glamline(t));
230 plist(ptree,glampats(t));
236 prbind(gletvdeflist(t));
242 plist(ppbinding, gcasebody(t));
252 plist(ptree,gtuplelist(t));
257 plist(ptree,gestep(t));
258 plist(ptree,geto(t));
262 plist(ptree,gllist(t));
271 plist(ptree,gcquals(t));
284 ptree(ggdef(t)); /* was: prbind (WDP 94/10) */
312 plist(ptree,gccargs(t));
316 print_string(gsccid(t));
323 plist(ptree,gpzfqual(t));
327 plist(ptree,gpod(t));
331 plist(ptree,gprocid(t));
357 void (*fun)(/* NOT WORTH IT: void * */);
360 if (tlist(l) == lcons) {
374 printf("!%lu\t", hash_index(i));
376 printf("#%s\t", id_to_string(i));
390 switch(tbinding(b)) {
393 printf("#%lu\t",gtline(b));
394 plist(pttype, gtbindc(b));
395 plist(pid, gtbindd(b));
397 plist(patype, gtbindl(b));
398 ppragma(gtpragma(b));
402 printf("#%lu\t",gnline(b));
405 ppragma(gnpragma(b));
409 printf("#%lu\t",gpline(b));
410 plist(ppbinding, gpbindl(b));
414 printf("#%lu\t",gfline(b));
415 plist(ppbinding, gfbindl(b));
419 prbind(gabindfst(b));
420 prbind(gabindsnd(b));
424 printf("#%lu\t",gcline(b));
425 plist(pttype,gcbindc(b));
428 ppragma(gcpragma(b));
432 printf("#%lu\t",giline(b));
433 plist(pttype,gibindc(b));
437 ppragma(gipragma(b));
441 printf("#%lu\t",gdline(b));
442 plist(pttype,gdbindts(b));
445 /* signature(-like) things, including user pragmas */
448 printf("#%lu\t",gsline(b));
449 plist(pid,gsbindids(b));
451 ppragma(gspragma(b));
456 printf("#%lu\t",gvspec_line(b));
458 plist(pttype,gvspec_tys(b));
462 printf("#%lu\t",gispec_line(b));
464 pttype(gispec_ty(b));
468 printf("#%lu\t",ginline_line(b));
470 plist(pid,ginline_howto(b));
474 printf("#%lu\t",gdeforest_line(b));
475 pid(gdeforest_id(b));
479 printf("#%lu\t",gmagicuf_line(b));
481 pid(gmagicuf_str(b));
485 printf("#%lu\t",gabstract_line(b));
486 pid(gabstract_id(b));
490 printf("#%lu\t",gdspec_line(b));
492 plist(pttype,gdspec_tys(b));
495 /* end of signature(-like) things */
499 printf("#%lu\t",gmline(b));
501 plist(pentid,gmbindimp(b));
502 plist(prename,gmbindren(b));
506 printf("#%lu\t",giebindline(b));
507 pstr(giebindfile(b));
509 plist(pentid,giebindexp(b));
510 plist(prename,giebindren(b));
511 prbind(giebinddef(b));
515 printf("#%lu\t",gihbindline(b));
516 pstr(gihbindfile(b));
518 plist(pentid,gihbindexp(b));
519 plist(prename,gihbindren(b));
520 prbind(gihbinddef(b));
525 default : error("Bad prbind");
535 case tname : PUTTAG('T');
537 plist(pttype, gtypel(t));
539 case namedtvar : PUTTAG('y');
542 case tllist : PUTTAG(':');
545 case ttuple : PUTTAG(',');
546 plist(pttype,gttuple(t));
548 case tfun : PUTTAG('>');
552 case context : PUTTAG('3');
553 plist(pttype,gtcontextl(t));
554 pttype(gtcontextt(t));
557 case unidict : PUTTAGSTR("2A");
558 pid(gunidict_clas(t));
559 pttype(gunidict_ty(t));
561 case unityvartemplate : PUTTAGSTR("2B");
562 pid(gunityvartemplate(t));
564 case uniforall : PUTTAGSTR("2C");
565 plist(pid,guniforall_tv(t));
566 pttype(guniforall_ty(t));
569 case ty_maybe_nothing : PUTTAGSTR("2D");
571 case ty_maybe_just: PUTTAGSTR("2E");
572 pttype(gty_maybe(t));
578 plist(pttype,gtpid(t));
586 default : error("bad pttype");
597 printf("#%lu\t",gatcline(a));
599 plist(pttype, gatctypel(a));
601 default : fprintf(stderr, "Bad tag in abstree %d\n", tatype(a));
611 switch (tentidt(i)) {
612 case entid : PUTTAG('x');
615 case enttype : PUTTAG('X');
618 case enttypeall : PUTTAG('z');
621 case entmod : PUTTAG('m');
624 case enttypecons: PUTTAG('8');
626 plist(pid,gctentcons(i));
628 case entclass : PUTTAG('9');
630 plist(pid,gcentops(i));
653 for(i = 0; i < m; i++) {
659 printf("#%lu\t",precedence(i));
670 switch(tpbinding(p)) {
671 case pgrhs : PUTTAG('W');
672 printf("#%lu\t",ggline(p));
675 plist(pgrhses,ggdexprs(p));
679 error("Bad pbinding");
688 ptree(lhd(l)); /* Guard */
689 ptree(lhd(ltl(l))); /* Expression */
696 switch(thpragma(p)) {
697 case no_pragma: PUTTAGSTR("PN");
699 case idata_pragma: PUTTAGSTR("Pd");
700 plist(patype, gprag_data_constrs(p));
701 plist(ppragma, gprag_data_specs(p));
703 case itype_pragma: PUTTAGSTR("Pt");
705 case iclas_pragma: PUTTAGSTR("Pc");
706 plist(ppragma, gprag_clas(p));
708 case iclasop_pragma: PUTTAGSTR("Po");
709 ppragma(gprag_dsel(p));
710 ppragma(gprag_defm(p));
713 case iinst_simpl_pragma: PUTTAGSTR("Pis");
714 pid(gprag_imod_simpl(p));
715 ppragma(gprag_dfun_simpl(p));
717 case iinst_const_pragma: PUTTAGSTR("Pic");
718 pid(gprag_imod_const(p));
719 ppragma(gprag_dfun_const(p));
720 plist(ppragma, gprag_constms(p));
722 case iinst_spec_pragma: PUTTAGSTR("PiS");
723 pid(gprag_imod_spec(p));
724 ppragma(gprag_dfun_spec(p));
725 plist(ppragma, gprag_inst_specs(p));
728 case igen_pragma: PUTTAGSTR("Pg");
729 ppragma(gprag_arity(p));
730 ppragma(gprag_update(p));
731 ppragma(gprag_deforest(p));
732 ppragma(gprag_strictness(p));
733 ppragma(gprag_unfolding(p));
734 plist(ppragma, gprag_specs(p));
736 case iarity_pragma: PUTTAGSTR("PA");
737 pid(gprag_arity_val(p));
739 case iupdate_pragma: PUTTAGSTR("Pu");
740 pid(gprag_update_val(p));
742 case ideforest_pragma: PUTTAGSTR("PD");
744 case istrictness_pragma: PUTTAGSTR("PS");
745 print_string(gprag_strict_spec(p));
746 ppragma(gprag_strict_wrkr(p));
748 case imagic_unfolding_pragma: PUTTAGSTR("PM");
749 pid(gprag_magic_str(p));
752 case iunfolding_pragma: PUTTAGSTR("PU");
753 ppragma(gprag_unfold_guide(p));
754 pcoresyn(gprag_unfold_core(p));
757 case iunfold_always: PUTTAGSTR("Px");
759 case iunfold_if_args: PUTTAGSTR("Py");
760 pid(gprag_unfold_if_t_args(p));
761 pid(gprag_unfold_if_v_args(p));
762 pid(gprag_unfold_if_con_args(p));
763 pid(gprag_unfold_if_size(p));
766 case iname_pragma_pr: PUTTAGSTR("P1");
767 pid(gprag_name_pr1(p));
768 ppragma(gprag_name_pr2(p));
770 case itype_pragma_pr: PUTTAGSTR("P2");
771 plist(pttype, gprag_type_pr1(p));
772 pid(gprag_type_pr2(p));
773 ppragma(gprag_type_pr3(p));
775 case iinst_pragma_3s: PUTTAGSTR("P3");
776 plist(pttype, gprag_inst_pt1(p));
777 pid(gprag_inst_pt2(p));
778 ppragma(gprag_inst_pt3(p));
779 plist(ppragma,gprag_inst_pt4(p));
782 case idata_pragma_4s: PUTTAGSTR("P4");
783 plist(pttype, gprag_data_spec(p));
786 default: error("Bad Pragma");
805 switch(tcoresyn(p)) {
806 case cobinder: PUTTAGSTR("Fa");
808 pttype(gcobinder_ty(p));
811 case colit: PUTTAGSTR("Fb");
814 case colocal: PUTTAGSTR("Fc");
815 pcoresyn(gcolocal_v(p));
818 case cononrec: PUTTAGSTR("Fd");
819 pcoresyn(gcononrec_b(p));
820 pcoresyn(gcononrec_rhs(p));
822 case corec: PUTTAGSTR("Fe");
823 plist(pcoresyn,gcorec(p));
825 case corec_pair: PUTTAGSTR("Ff");
826 pcoresyn(gcorec_b(p));
827 pcoresyn(gcorec_rhs(p));
830 case covar: PUTTAGSTR("Fg");
833 case coliteral: PUTTAGSTR("Fh");
834 pliteral(gcoliteral(p));
836 case cocon: PUTTAGSTR("Fi");
837 pcoresyn(gcocon_con(p));
838 plist(pttype, gcocon_tys(p));
839 plist(pcoresyn, gcocon_args(p));
841 case coprim: PUTTAGSTR("Fj");
842 pcoresyn(gcoprim_op(p));
843 plist(pttype, gcoprim_tys(p));
844 plist(pcoresyn, gcoprim_args(p));
846 case colam: PUTTAGSTR("Fk");
847 plist(pcoresyn, gcolam_vars(p));
848 pcoresyn(gcolam_body(p));
850 case cotylam: PUTTAGSTR("Fl");
851 plist(pid, gcotylam_tvs(p));
852 pcoresyn(gcotylam_body(p));
854 case coapp: PUTTAGSTR("Fm");
855 pcoresyn(gcoapp_fun(p));
856 plist(pcoresyn, gcoapp_args(p));
858 case cotyapp: PUTTAGSTR("Fn");
859 pcoresyn(gcotyapp_e(p));
860 pttype(gcotyapp_t(p));
862 case cocase: PUTTAGSTR("Fo");
863 pcoresyn(gcocase_s(p));
864 pcoresyn(gcocase_alts(p));
866 case colet: PUTTAGSTR("Fp");
867 pcoresyn(gcolet_bind(p));
868 pcoresyn(gcolet_body(p));
870 case coscc: PUTTAGSTR("Fz"); /* out of order! */
871 pcoresyn(gcoscc_scc(p));
872 pcoresyn(gcoscc_body(p));
875 case coalg_alts: PUTTAGSTR("Fq");
876 plist(pcoresyn, gcoalg_alts(p));
877 pcoresyn(gcoalg_deflt(p));
879 case coalg_alt: PUTTAGSTR("Fr");
880 pcoresyn(gcoalg_con(p));
881 plist(pcoresyn, gcoalg_bs(p));
882 pcoresyn(gcoalg_rhs(p));
884 case coprim_alts: PUTTAGSTR("Fs");
885 plist(pcoresyn, gcoprim_alts(p));
886 pcoresyn(gcoprim_deflt(p));
888 case coprim_alt: PUTTAGSTR("Ft");
889 pliteral(gcoprim_lit(p));
890 pcoresyn(gcoprim_rhs(p));
892 case conodeflt: PUTTAGSTR("Fu");
894 case cobinddeflt: PUTTAGSTR("Fv");
895 pcoresyn(gcobinddeflt_v(p));
896 pcoresyn(gcobinddeflt_rhs(p));
899 case co_primop: PUTTAGSTR("Fw");
902 case co_ccall: PUTTAGSTR("Fx");
903 pbool(gco_ccall_may_gc(p));
905 plist(pttype, gco_ccall_arg_tys(p));
906 pttype(gco_ccall_res_ty(p));
908 case co_casm: PUTTAGSTR("Fy");
909 pbool(gco_casm_may_gc(p));
910 pliteral(gco_casm(p));
911 plist(pttype, gco_casm_arg_tys(p));
912 pttype(gco_casm_res_ty(p));
915 /* Cost-centre stuff */
916 case co_preludedictscc: PUTTAGSTR("F?a");
917 pcoresyn(gco_preludedictscc_dupd(p));
919 case co_alldictscc: PUTTAGSTR("F?b");
920 print_string(gco_alldictscc_m(p));
921 print_string(gco_alldictscc_g(p));
922 pcoresyn(gco_alldictscc_dupd(p));
924 case co_usercc: PUTTAGSTR("F?c");
925 print_string(gco_usercc_n(p));
926 print_string(gco_usercc_m(p));
927 print_string(gco_usercc_g(p));
928 pcoresyn(gco_usercc_dupd(p));
929 pcoresyn(gco_usercc_cafd(p));
931 case co_autocc: PUTTAGSTR("F?d");
932 pcoresyn(gco_autocc_i(p));
933 print_string(gco_autocc_m(p));
934 print_string(gco_autocc_g(p));
935 pcoresyn(gco_autocc_dupd(p));
936 pcoresyn(gco_autocc_cafd(p));
938 case co_dictcc: PUTTAGSTR("F?e");
939 pcoresyn(gco_dictcc_i(p));
940 print_string(gco_dictcc_m(p));
941 print_string(gco_dictcc_g(p));
942 pcoresyn(gco_dictcc_dupd(p));
943 pcoresyn(gco_dictcc_cafd(p));
946 case co_scc_noncaf: PUTTAGSTR("F?f");
948 case co_scc_caf: PUTTAGSTR("F?g");
950 case co_scc_nondupd: PUTTAGSTR("F?h");
952 case co_scc_dupd: PUTTAGSTR("F?i");
956 case co_id: PUTTAGSTR("F1");
959 case co_orig_id: PUTTAGSTR("F9");
960 pid(gco_orig_id_m(p));
961 pid(gco_orig_id_n(p));
963 case co_sdselid: PUTTAGSTR("F2");
964 pid(gco_sdselid_c(p));
965 pid(gco_sdselid_sc(p));
967 case co_classopid: PUTTAGSTR("F3");
968 pid(gco_classopid_c(p));
969 pid(gco_classopid_o(p));
971 case co_defmid: PUTTAGSTR("F4");
972 pid(gco_defmid_c(p));
973 pid(gco_defmid_op(p));
975 case co_dfunid: PUTTAGSTR("F5");
976 pid(gco_dfunid_c(p));
977 pttype(gco_dfunid_ty(p));
979 case co_constmid: PUTTAGSTR("F6");
980 pid(gco_constmid_c(p));
981 pid(gco_constmid_op(p));
982 pttype(gco_constmid_ty(p));
984 case co_specid: PUTTAGSTR("F7");
985 pcoresyn(gco_specid_un(p));
986 plist(pttype,gco_specid_tys(p));
988 case co_wrkrid: PUTTAGSTR("F8");
989 pcoresyn(gco_wrkrid_un(p));
993 default : error("Bad Core syntax");