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));
723 case igen_pragma: PUTTAGSTR("Pg");
724 ppragma(gprag_arity(p));
725 ppragma(gprag_update(p));
726 ppragma(gprag_deforest(p));
727 ppragma(gprag_strictness(p));
728 ppragma(gprag_unfolding(p));
729 plist(ppragma, gprag_specs(p));
731 case iarity_pragma: PUTTAGSTR("PA");
732 pid(gprag_arity_val(p));
734 case iupdate_pragma: PUTTAGSTR("Pu");
735 pid(gprag_update_val(p));
737 case ideforest_pragma: PUTTAGSTR("PD");
739 case istrictness_pragma: PUTTAGSTR("PS");
740 print_string(gprag_strict_spec(p));
741 ppragma(gprag_strict_wrkr(p));
743 case imagic_unfolding_pragma: PUTTAGSTR("PM");
744 pid(gprag_magic_str(p));
747 case iunfolding_pragma: PUTTAGSTR("PU");
748 ppragma(gprag_unfold_guide(p));
749 pcoresyn(gprag_unfold_core(p));
752 case iunfold_always: PUTTAGSTR("Px");
754 case iunfold_if_args: PUTTAGSTR("Py");
755 pid(gprag_unfold_if_t_args(p));
756 pid(gprag_unfold_if_v_args(p));
757 pid(gprag_unfold_if_con_args(p));
758 pid(gprag_unfold_if_size(p));
761 case iname_pragma_pr: PUTTAGSTR("P1");
762 pid(gprag_name_pr1(p));
763 ppragma(gprag_name_pr2(p));
765 case itype_pragma_pr: PUTTAGSTR("P2");
766 plist(pttype, gprag_type_pr1(p));
767 pid(gprag_type_pr2(p));
768 ppragma(gprag_type_pr3(p));
771 case idata_pragma_4s: PUTTAGSTR("P4");
772 plist(pttype, gprag_data_spec(p));
775 default: error("Bad Pragma");
794 switch(tcoresyn(p)) {
795 case cobinder: PUTTAGSTR("Fa");
797 pttype(gcobinder_ty(p));
800 case colit: PUTTAGSTR("Fb");
803 case colocal: PUTTAGSTR("Fc");
804 pcoresyn(gcolocal_v(p));
807 case cononrec: PUTTAGSTR("Fd");
808 pcoresyn(gcononrec_b(p));
809 pcoresyn(gcononrec_rhs(p));
811 case corec: PUTTAGSTR("Fe");
812 plist(pcoresyn,gcorec(p));
814 case corec_pair: PUTTAGSTR("Ff");
815 pcoresyn(gcorec_b(p));
816 pcoresyn(gcorec_rhs(p));
819 case covar: PUTTAGSTR("Fg");
822 case coliteral: PUTTAGSTR("Fh");
823 pliteral(gcoliteral(p));
825 case cocon: PUTTAGSTR("Fi");
826 pcoresyn(gcocon_con(p));
827 plist(pttype, gcocon_tys(p));
828 plist(pcoresyn, gcocon_args(p));
830 case coprim: PUTTAGSTR("Fj");
831 pcoresyn(gcoprim_op(p));
832 plist(pttype, gcoprim_tys(p));
833 plist(pcoresyn, gcoprim_args(p));
835 case colam: PUTTAGSTR("Fk");
836 plist(pcoresyn, gcolam_vars(p));
837 pcoresyn(gcolam_body(p));
839 case cotylam: PUTTAGSTR("Fl");
840 plist(pid, gcotylam_tvs(p));
841 pcoresyn(gcotylam_body(p));
843 case coapp: PUTTAGSTR("Fm");
844 pcoresyn(gcoapp_fun(p));
845 plist(pcoresyn, gcoapp_args(p));
847 case cotyapp: PUTTAGSTR("Fn");
848 pcoresyn(gcotyapp_e(p));
849 pttype(gcotyapp_t(p));
851 case cocase: PUTTAGSTR("Fo");
852 pcoresyn(gcocase_s(p));
853 pcoresyn(gcocase_alts(p));
855 case colet: PUTTAGSTR("Fp");
856 pcoresyn(gcolet_bind(p));
857 pcoresyn(gcolet_body(p));
859 case coscc: PUTTAGSTR("Fz"); /* out of order! */
860 pcoresyn(gcoscc_scc(p));
861 pcoresyn(gcoscc_body(p));
864 case coalg_alts: PUTTAGSTR("Fq");
865 plist(pcoresyn, gcoalg_alts(p));
866 pcoresyn(gcoalg_deflt(p));
868 case coalg_alt: PUTTAGSTR("Fr");
869 pcoresyn(gcoalg_con(p));
870 plist(pcoresyn, gcoalg_bs(p));
871 pcoresyn(gcoalg_rhs(p));
873 case coprim_alts: PUTTAGSTR("Fs");
874 plist(pcoresyn, gcoprim_alts(p));
875 pcoresyn(gcoprim_deflt(p));
877 case coprim_alt: PUTTAGSTR("Ft");
878 pliteral(gcoprim_lit(p));
879 pcoresyn(gcoprim_rhs(p));
881 case conodeflt: PUTTAGSTR("Fu");
883 case cobinddeflt: PUTTAGSTR("Fv");
884 pcoresyn(gcobinddeflt_v(p));
885 pcoresyn(gcobinddeflt_rhs(p));
888 case co_primop: PUTTAGSTR("Fw");
891 case co_ccall: PUTTAGSTR("Fx");
892 pbool(gco_ccall_may_gc(p));
894 plist(pttype, gco_ccall_arg_tys(p));
895 pttype(gco_ccall_res_ty(p));
897 case co_casm: PUTTAGSTR("Fy");
898 pbool(gco_casm_may_gc(p));
899 pliteral(gco_casm(p));
900 plist(pttype, gco_casm_arg_tys(p));
901 pttype(gco_casm_res_ty(p));
904 /* Cost-centre stuff */
905 case co_preludedictscc: PUTTAGSTR("F?a");
906 pcoresyn(gco_preludedictscc_dupd(p));
908 case co_alldictscc: PUTTAGSTR("F?b");
909 print_string(gco_alldictscc_m(p));
910 print_string(gco_alldictscc_g(p));
911 pcoresyn(gco_alldictscc_dupd(p));
913 case co_usercc: PUTTAGSTR("F?c");
914 print_string(gco_usercc_n(p));
915 print_string(gco_usercc_m(p));
916 print_string(gco_usercc_g(p));
917 pcoresyn(gco_usercc_dupd(p));
918 pcoresyn(gco_usercc_cafd(p));
920 case co_autocc: PUTTAGSTR("F?d");
921 pcoresyn(gco_autocc_i(p));
922 print_string(gco_autocc_m(p));
923 print_string(gco_autocc_g(p));
924 pcoresyn(gco_autocc_dupd(p));
925 pcoresyn(gco_autocc_cafd(p));
927 case co_dictcc: PUTTAGSTR("F?e");
928 pcoresyn(gco_dictcc_i(p));
929 print_string(gco_dictcc_m(p));
930 print_string(gco_dictcc_g(p));
931 pcoresyn(gco_dictcc_dupd(p));
932 pcoresyn(gco_dictcc_cafd(p));
935 case co_scc_noncaf: PUTTAGSTR("F?f");
937 case co_scc_caf: PUTTAGSTR("F?g");
939 case co_scc_nondupd: PUTTAGSTR("F?h");
941 case co_scc_dupd: PUTTAGSTR("F?i");
945 case co_id: PUTTAGSTR("F1");
948 case co_orig_id: PUTTAGSTR("F9");
949 pid(gco_orig_id_m(p));
950 pid(gco_orig_id_n(p));
952 case co_sdselid: PUTTAGSTR("F2");
953 pid(gco_sdselid_c(p));
954 pid(gco_sdselid_sc(p));
956 case co_classopid: PUTTAGSTR("F3");
957 pid(gco_classopid_c(p));
958 pid(gco_classopid_o(p));
960 case co_defmid: PUTTAGSTR("F4");
961 pid(gco_defmid_c(p));
962 pid(gco_defmid_op(p));
964 case co_dfunid: PUTTAGSTR("F5");
965 pid(gco_dfunid_c(p));
966 pttype(gco_dfunid_ty(p));
968 case co_constmid: PUTTAGSTR("F6");
969 pid(gco_constmid_c(p));
970 pid(gco_constmid_op(p));
971 pttype(gco_constmid_ty(p));
973 case co_specid: PUTTAGSTR("F7");
974 pcoresyn(gco_specid_un(p));
975 plist(pttype,gco_specid_tys(p));
977 case co_wrkrid: PUTTAGSTR("F8");
978 pcoresyn(gco_wrkrid_un(p));
982 default : error("Bad Core syntax");