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 pbool PROTO( (BOOLEAN) );
21 static void pconstr PROTO( (constr) );
22 static void pcoresyn PROTO((coresyn));
23 static void pentid PROTO( (entidt) );
24 static void pgrhses PROTO( (list) );
25 static void pid PROTO( (id) );
26 static void plist PROTO( (void (*)(/*NOT WORTH IT: void * */), list) );
27 static void pmaybe PROTO( (void (*)(), maybe) );
28 static void pmaybe_list PROTO( (void (*)(), maybe) );
29 static void ppbinding PROTO((pbinding));
30 static void ppragma PROTO( (hpragma) );
31 static void pqid PROTO( (qid) );
32 static void prbind PROTO( (binding) );
33 static void pstr PROTO( (char *) );
34 static void ptree PROTO( (tree) );
35 static void pttype PROTO( (ttype) );
37 extern char *input_filename;
38 extern BOOLEAN hashIds;
40 /* How to print tags */
43 #define PUTTAG(c) putchar(c);
44 #define PUTTAGSTR(s) printf("%s",(s));
46 #define PUTTAG(c) putchar(c); \
48 #define PUTTAGSTR(s) printf("%s",(s)); \
53 /* Performs a post order walk of the tree
65 /* print_string: we must escape \t and \\, as described in
66 char/string lexer comments. (WDP 94/11)
69 print_string(hstring str)
76 str_length = str->len;
79 for (i = 0; i < str_length; i++) {
84 } else if ( c == '\\' ) {
95 get_character(hstring str)
97 int c = (int)((str->bytes)[0]);
99 if (str->len != 1) { /* ToDo: assert */
100 fprintf(stderr, "get_character: length != 1? (%ld: %s)\n", str->len, str->bytes);
104 c += 256; /* "This is not a hack" -- KH */
113 switch(tliteral(t)) {
128 pstr(gdoubleprim(t));
136 /* Changed %d to %u, since negative chars
137 make little sense -- KH @ 16/4/91
139 printf("#%u\t", get_character(gchar(t)));
143 printf("#%u\t", get_character(gcharprim(t)));
147 print_string(gstring(t));
151 print_string(gstringprim(t));
156 pstr(gclitlit_kind(t));
170 print_string(gnoreps(t));
173 error("Bad pliteral");
183 case par: t = gpare(t); goto again;
186 printf("#%lu\t",ghmodline(t));
188 pstr(input_filename);
189 prbind(ghmodlist(t));
191 plist(prbind, ghimplist(t));
192 pmaybe_list(pentid, ghexplist(t));
216 printf("#%lu\t",glamline(t));
217 plist(ptree,glampats(t));
223 prbind(gletvdefs(t));
229 plist(ppbinding, gcasebody(t));
265 plist(ptree,gtuplelist(t));
269 plist(ptree,gllist(t));
274 pmaybe(ptree,gestep(t));
275 pmaybe(ptree,geto(t));
280 plist(ptree,gcquals(t));
305 plist(ptree,gccargs(t));
309 print_string(gsccid(t));
323 void (*fun)(/* NOT WORTH IT: void * */);
326 if (tlist(l) == lnil) {
337 void (*fun)(/* NOT WORTH IT: void * */);
340 if (tmaybe(m) == nothing) {
350 void (*fun)(/* NOT WORTH IT: void * */);
353 if (tmaybe(m) == nothing) {
357 plist(fun, gthing(m));
366 printf("!%lu\t", hash_index(i));
368 printf("#%s\t", id_to_string(i));
376 printf("!%lu\t", hash_index(qid_to_id(i)));
378 printf("#%s\t", qid_to_string(i));
392 switch(tbinding(b)) {
395 printf("#%lu\t",gtline(b));
396 plist(pttype, gtbindc(b));
397 pmaybe_list(pid, gtbindd(b));
399 plist(pconstr, gtbindl(b));
400 ppragma(gtpragma(b));
405 printf("#%lu\t",gnline(b));
411 printf("#%lu\t",gpline(b));
412 plist(ppbinding, gpbindl(b));
416 printf("#%lu\t",gfline(b));
417 plist(ppbinding, gfbindl(b));
421 prbind(gabindfst(b));
422 prbind(gabindsnd(b));
426 printf("#%lu\t",gcline(b));
427 plist(pttype,gcbindc(b));
430 ppragma(gcpragma(b));
434 printf("#%lu\t",giline(b));
435 plist(pttype,gibindc(b));
439 ppragma(gipragma(b));
443 printf("#%lu\t",gdline(b));
444 plist(pttype,gdbindts(b));
447 /* signature(-like) things, including user pragmas */
450 printf("#%lu\t",gsline(b));
451 plist(pqid,gsbindids(b));
453 ppragma(gspragma(b));
458 printf("#%lu\t",gvspec_line(b));
460 plist(pttype,gvspec_tys(b));
464 printf("#%lu\t",gispec_line(b));
465 pqid(gispec_clas(b));
466 pttype(gispec_ty(b));
470 printf("#%lu\t",ginline_line(b));
475 printf("#%lu\t",gdeforest_line(b));
476 pqid(gdeforest_id(b));
480 printf("#%lu\t",gmagicuf_line(b));
481 pqid(gmagicuf_id(b));
482 pid(gmagicuf_str(b));
486 printf("#%lu\t",gdspec_line(b));
488 plist(pttype,gdspec_tys(b));
491 /* end of signature(-like) things */
495 printf("#%lu\t",gmline(b));
497 plist(pentid,gmbindimp(b));
501 printf("#%lu\t",gibindline(b));
504 /* plist(pentid,giebindexp(b)); ??? */
505 /* prbind(giebinddef(b)); ???? */
510 default : error("Bad prbind");
520 case tname : PUTTAG('T');
523 case namedtvar : PUTTAG('y');
526 case tllist : PUTTAG(':');
529 case ttuple : PUTTAG(',');
530 plist(pttype,gttuple(t));
532 case tfun : PUTTAG('>');
536 case tapp : PUTTAG('@');
540 case tbang : PUTTAG('!');
543 case context : PUTTAG('3');
544 plist(pttype,gtcontextl(t));
545 pttype(gtcontextt(t));
548 case unidict : PUTTAGSTR("2A");
549 pqid(gunidict_clas(t));
550 pttype(gunidict_ty(t));
552 case unityvartemplate : PUTTAGSTR("2B");
553 pid(gunityvartemplate(t));
555 case uniforall : PUTTAGSTR("2C");
556 plist(pid,guniforall_tv(t));
557 pttype(guniforall_ty(t));
560 default : error("bad pttype");
568 switch (tconstr(a)) {
571 printf("#%lu\t",gconcline(a));
573 plist(pttype, gconctypel(a));
577 printf("#%lu\t",gconiline(a));
583 default : fprintf(stderr, "Bad tag in abstree %d\n", tconstr(a));
593 switch (tentidt(i)) {
594 case entid : PUTTAG('x');
597 case enttype : PUTTAG('X');
600 case enttypeall : PUTTAG('z');
603 case enttypenamed:PUTTAG('8');
605 plist(pqid,gnentnames(i));
607 case entmod : PUTTAG('m');
620 switch(tpbinding(p)) {
621 case pgrhs : PUTTAG('W');
622 printf("#%lu\t",ggline(p));
625 plist(pgrhses,ggdexprs(p));
629 error("Bad pbinding");
638 ptree(lhd(l)); /* Guard */
639 ptree(lhd(ltl(l))); /* Expression */
646 switch(thpragma(p)) {
647 case no_pragma: PUTTAGSTR("PN");
649 case idata_pragma: PUTTAGSTR("Pd");
650 plist(pconstr, gprag_data_constrs(p));
651 plist(ppragma, gprag_data_specs(p));
653 case itype_pragma: PUTTAGSTR("Pt");
655 case iclas_pragma: PUTTAGSTR("Pc");
656 plist(ppragma, gprag_clas(p));
658 case iclasop_pragma: PUTTAGSTR("Po");
659 ppragma(gprag_dsel(p));
660 ppragma(gprag_defm(p));
663 case iinst_simpl_pragma: PUTTAGSTR("Pis");
664 /* pid(gprag_imod_simpl(p));
665 */ ppragma(gprag_dfun_simpl(p));
667 case iinst_const_pragma: PUTTAGSTR("Pic");
668 /* pid(gprag_imod_const(p));
669 */ ppragma(gprag_dfun_const(p));
670 plist(ppragma, gprag_constms(p));
673 case igen_pragma: PUTTAGSTR("Pg");
674 ppragma(gprag_arity(p));
675 ppragma(gprag_update(p));
676 ppragma(gprag_deforest(p));
677 ppragma(gprag_strictness(p));
678 ppragma(gprag_unfolding(p));
679 plist(ppragma, gprag_specs(p));
681 case iarity_pragma: PUTTAGSTR("PA");
682 pid(gprag_arity_val(p));
684 case iupdate_pragma: PUTTAGSTR("Pu");
685 pid(gprag_update_val(p));
687 case ideforest_pragma: PUTTAGSTR("PD");
689 case istrictness_pragma: PUTTAGSTR("PS");
690 print_string(gprag_strict_spec(p));
691 ppragma(gprag_strict_wrkr(p));
693 case imagic_unfolding_pragma: PUTTAGSTR("PM");
694 pid(gprag_magic_str(p));
697 case iunfolding_pragma: PUTTAGSTR("PU");
698 ppragma(gprag_unfold_guide(p));
699 pcoresyn(gprag_unfold_core(p));
702 case iunfold_always: PUTTAGSTR("Px");
704 case iunfold_if_args: PUTTAGSTR("Py");
705 pid(gprag_unfold_if_t_args(p));
706 pid(gprag_unfold_if_v_args(p));
707 pid(gprag_unfold_if_con_args(p));
708 pid(gprag_unfold_if_size(p));
711 case iname_pragma_pr: PUTTAGSTR("P1");
712 pid(gprag_name_pr1(p));
713 ppragma(gprag_name_pr2(p));
715 case itype_pragma_pr: PUTTAGSTR("P2");
716 plist(pttype, gprag_type_pr1(p));
717 pid(gprag_type_pr2(p));
718 ppragma(gprag_type_pr3(p));
721 case idata_pragma_4s: PUTTAGSTR("P4");
722 plist(pttype, gprag_data_spec(p));
725 default: error("Bad Pragma");
744 switch(tcoresyn(p)) {
745 case cobinder: PUTTAGSTR("Fa");
747 pttype(gcobinder_ty(p));
750 case colit: PUTTAGSTR("Fb");
753 case colocal: PUTTAGSTR("Fc");
754 pcoresyn(gcolocal_v(p));
757 case cononrec: PUTTAGSTR("Fd");
758 pcoresyn(gcononrec_b(p));
759 pcoresyn(gcononrec_rhs(p));
761 case corec: PUTTAGSTR("Fe");
762 plist(pcoresyn,gcorec(p));
764 case corec_pair: PUTTAGSTR("Ff");
765 pcoresyn(gcorec_b(p));
766 pcoresyn(gcorec_rhs(p));
769 case covar: PUTTAGSTR("Fg");
772 case coliteral: PUTTAGSTR("Fh");
773 pliteral(gcoliteral(p));
775 case cocon: PUTTAGSTR("Fi");
776 pcoresyn(gcocon_con(p));
777 plist(pttype, gcocon_tys(p));
778 plist(pcoresyn, gcocon_args(p));
780 case coprim: PUTTAGSTR("Fj");
781 pcoresyn(gcoprim_op(p));
782 plist(pttype, gcoprim_tys(p));
783 plist(pcoresyn, gcoprim_args(p));
785 case colam: PUTTAGSTR("Fk");
786 plist(pcoresyn, gcolam_vars(p));
787 pcoresyn(gcolam_body(p));
789 case cotylam: PUTTAGSTR("Fl");
790 plist(pid, gcotylam_tvs(p));
791 pcoresyn(gcotylam_body(p));
793 case coapp: PUTTAGSTR("Fm");
794 pcoresyn(gcoapp_fun(p));
795 plist(pcoresyn, gcoapp_args(p));
797 case cotyapp: PUTTAGSTR("Fn");
798 pcoresyn(gcotyapp_e(p));
799 pttype(gcotyapp_t(p));
801 case cocase: PUTTAGSTR("Fo");
802 pcoresyn(gcocase_s(p));
803 pcoresyn(gcocase_alts(p));
805 case colet: PUTTAGSTR("Fp");
806 pcoresyn(gcolet_bind(p));
807 pcoresyn(gcolet_body(p));
809 case coscc: PUTTAGSTR("Fz"); /* out of order! */
810 pcoresyn(gcoscc_scc(p));
811 pcoresyn(gcoscc_body(p));
814 case coalg_alts: PUTTAGSTR("Fq");
815 plist(pcoresyn, gcoalg_alts(p));
816 pcoresyn(gcoalg_deflt(p));
818 case coalg_alt: PUTTAGSTR("Fr");
819 pcoresyn(gcoalg_con(p));
820 plist(pcoresyn, gcoalg_bs(p));
821 pcoresyn(gcoalg_rhs(p));
823 case coprim_alts: PUTTAGSTR("Fs");
824 plist(pcoresyn, gcoprim_alts(p));
825 pcoresyn(gcoprim_deflt(p));
827 case coprim_alt: PUTTAGSTR("Ft");
828 pliteral(gcoprim_lit(p));
829 pcoresyn(gcoprim_rhs(p));
831 case conodeflt: PUTTAGSTR("Fu");
833 case cobinddeflt: PUTTAGSTR("Fv");
834 pcoresyn(gcobinddeflt_v(p));
835 pcoresyn(gcobinddeflt_rhs(p));
838 case co_primop: PUTTAGSTR("Fw");
841 case co_ccall: PUTTAGSTR("Fx");
842 pbool(gco_ccall_may_gc(p));
844 plist(pttype, gco_ccall_arg_tys(p));
845 pttype(gco_ccall_res_ty(p));
847 case co_casm: PUTTAGSTR("Fy");
848 pbool(gco_casm_may_gc(p));
849 pliteral(gco_casm(p));
850 plist(pttype, gco_casm_arg_tys(p));
851 pttype(gco_casm_res_ty(p));
854 /* Cost-centre stuff */
855 case co_preludedictscc: PUTTAGSTR("F?a");
856 pcoresyn(gco_preludedictscc_dupd(p));
858 case co_alldictscc: PUTTAGSTR("F?b");
859 print_string(gco_alldictscc_m(p));
860 print_string(gco_alldictscc_g(p));
861 pcoresyn(gco_alldictscc_dupd(p));
863 case co_usercc: PUTTAGSTR("F?c");
864 print_string(gco_usercc_n(p));
865 print_string(gco_usercc_m(p));
866 print_string(gco_usercc_g(p));
867 pcoresyn(gco_usercc_dupd(p));
868 pcoresyn(gco_usercc_cafd(p));
870 case co_autocc: PUTTAGSTR("F?d");
871 pcoresyn(gco_autocc_i(p));
872 print_string(gco_autocc_m(p));
873 print_string(gco_autocc_g(p));
874 pcoresyn(gco_autocc_dupd(p));
875 pcoresyn(gco_autocc_cafd(p));
877 case co_dictcc: PUTTAGSTR("F?e");
878 pcoresyn(gco_dictcc_i(p));
879 print_string(gco_dictcc_m(p));
880 print_string(gco_dictcc_g(p));
881 pcoresyn(gco_dictcc_dupd(p));
882 pcoresyn(gco_dictcc_cafd(p));
885 case co_scc_noncaf: PUTTAGSTR("F?f");
887 case co_scc_caf: PUTTAGSTR("F?g");
889 case co_scc_nondupd: PUTTAGSTR("F?h");
891 case co_scc_dupd: PUTTAGSTR("F?i");
895 case co_id: PUTTAGSTR("F1");
898 case co_orig_id: PUTTAGSTR("F9");
899 pid(gco_orig_id_m(p));
900 pid(gco_orig_id_n(p));
902 case co_sdselid: PUTTAGSTR("F2");
903 pid(gco_sdselid_c(p));
904 pid(gco_sdselid_sc(p));
906 case co_classopid: PUTTAGSTR("F3");
907 pid(gco_classopid_c(p));
908 pid(gco_classopid_o(p));
910 case co_defmid: PUTTAGSTR("F4");
911 pid(gco_defmid_c(p));
912 pid(gco_defmid_op(p));
914 case co_dfunid: PUTTAGSTR("F5");
915 pid(gco_dfunid_c(p));
916 pttype(gco_dfunid_ty(p));
918 case co_constmid: PUTTAGSTR("F6");
919 pid(gco_constmid_c(p));
920 pid(gco_constmid_op(p));
921 pttype(gco_constmid_ty(p));
923 case co_specid: PUTTAGSTR("F7");
924 pcoresyn(gco_specid_un(p));
925 plist(pttype,gco_specid_tys(p));
927 case co_wrkrid: PUTTAGSTR("F8");
928 pcoresyn(gco_wrkrid_un(p));
932 default : error("Bad Core syntax");