PreviousUpNext

15.4.458  src/lib/compiler/back/top/anormcode/prettyprint-anormcode.pkg

##  prettyprint-anormcode.pkg -- Pretty printer for A-Normal intermediate code format.

# Compiled by:
#     src/lib/compiler/core.sublib


# 2007-09-17CrT note:
#   The original code here wrote text exclusively to 'control_print::say',
#   clashing with the frontend convention of writing to a prettyprint stream
#   (and incidentally forcing use of yet another primitive prettyprint library).
#
#   As initial clean-up, I created duplicates of the 'say'-based functions
#   which instead write to a prettyprint stream via a Prettyprinter.
#   (Only) these new functions all have names starting with "prettyprint_";
#   the matching older functions have names starting with "print_" or "p_".
#
#   Eventually, of course, I'd like to eliminate the older forms completely.  XXX BUGGO FIXME.


stipulate
    package acf  =  anormcode_form;             # anormcode_form                is from   src/lib/compiler/back/top/anormcode/anormcode-form.pkg
    package acj  =  anormcode_junk;             # anormcode_junk                is from   src/lib/compiler/back/top/anormcode/anormcode-junk.pkg
    package ctrl =  global_controls::highcode;  # global_controls               is from   src/lib/compiler/toplevel/main/global-controls.pkg
    package hbo  =  highcode_baseops;           # highcode_baseops              is from   src/lib/compiler/back/top/highcode/highcode-baseops.pkg
    package hcf  =  highcode_form;              # highcode_form                 is from   src/lib/compiler/back/top/highcode/highcode-form.pkg
    package tmp  =  highcode_codetemp;          # highcode_codetemp             is from   src/lib/compiler/back/top/highcode/highcode-codetemp.pkg
    package pp   =  prettyprint;                # prettyprint                   is from   src/lib/prettyprint/big/src/prettyprint.pkg
    package ppr  =  prettyprinter;              # prettyprinter                 is from   src/lib/prettyprint/big/src/prettyprinter.pkg
    package pu   =  print_junk;                 # print_junk                    is from   src/lib/compiler/front/basics/print/print-junk.pkg
    package sy   =  symbol;                     # symbol                        is from   src/lib/compiler/front/basics/map/symbol.pkg
herein

    package   prettyprint_anormcode
    :         Prettyprint_Anormcode                     # Prettyprint_Anormcode is from   src/lib/compiler/back/top/anormcode/prettyprint-anormcode.api
    {
        # Some print utilities:
        say    =  control_print::say;
        margin =  REF 0;

        exception UNDENT;


        fun indent n
            =
            margin := *margin + n;


        fun undent n
            =
            {   margin := *margin - n;

                if   (*margin < 0)

                     raise exception UNDENT;
                fi;
            };


        fun dent ()
            =
            pu::tab *margin;


        newline = pu::newline;

        infix my  & ;

        fun (&) (f1, f2) ()
            =
            {   f1 ();
                f2 ();
            };


        fun calling_convention_to_string  calling_convention
            = 
            {   fun h b
                    =
                    if b  "r";          # Raw.
                    else  "c";          # Cooked.
                    fi;

                hcf::if_calling_convention_is_variable ( calling_convention,
                               fn { arg_is_raw, body_is_raw } =   (h arg_is_raw) + (h body_is_raw),
                               fn _                           =   "f"
                           );
            };

        fun to_string_fkind ( { loop_info, call_as, inlining_hint, ... }:  acf::Function_Notes)
            =
            case inlining_hint
                #
                acf::INLINE_WHENEVER_POSSIBLE  =>  "(i)";
                acf::INLINE_ONCE_WITHIN_ITSELF =>  "(u)";
                acf::INLINE_MAYBE (s, ws)      =>  "(i:" + (int::to_string s) + ")";
                acf::INLINE_IF_SIZE_SAFE       =>  "";
            esac
            +
            case loop_info
                #
                THE (_, acf::OTHER_LOOP)             =>  "R";
                THE (_, acf::PREHEADER_WRAPPED_LOOP) =>  "LR";
                THE (_, acf::TAIL_RECURSIVE_LOOP)    =>  "TR";
                NULL => "";
            esac
            +
            case call_as
                #
                acf::CALL_AS_GENERIC_PACKAGE =>  "GENERIC";
                acf::CALL_AS_FUNCTION fixed  =>  ("FUN " + (calling_convention_to_string fixed));
            esac;


    #    fun toStringFKind acf::FK_ESCAPE  = "FK_ESCAPE"
    #      | toStringFKind acf::FK_KNOWN   = "FK_KNOWN"
    #      | toStringFKind acf::FK_KREC    = "FK_KREC"
    #      | toStringFKind acf::FK_KTAIL   = "FK_KTAIL"
    #      | toStringFKind acf::FK_NOINL   = "FK_NOINL"
    #      | toStringFKind acf::FK_HANDLER = "FK_HANDLER"


        print_fkind = say o to_string_fkind;


        # Classifications of various kinds of records:
        fun to_string_rkind (acf::RK_VECTOR typ) =>  "VECTOR[" + hcf::uniqtyp_to_string typ + "]";
            to_string_rkind acf::RK_PACKAGE                    =>  "STRUCT";
            to_string_rkind (acf::RK_TUPLE _)                 =>  "RECORD";
        end;


        print_rkind
            =
            say  o  to_string_rkind;


        # Con: Used to specify all possible switching statements:
        #
        fun case_constant_to_string (acf::VAL_CASETAG((symbol, _, _), _, _))   => sy::name symbol;
            #
            case_constant_to_string (acf::INT_CASETAG     i) =>  "(I)"   + (int::to_string   i);
            case_constant_to_string (acf::INT1_CASETAG   i) =>  "(I32)" + (one_word_int::to_string i);
            case_constant_to_string (acf::UNT_CASETAG     i) =>  "(W)"   + (unt::to_string   i);
            case_constant_to_string (acf::UNT1_CASETAG   i) =>  "(W32)" + (one_word_unt::to_string i);
            case_constant_to_string (acf::FLOAT64_CASETAG r) =>  r;
            case_constant_to_string (acf::STRING_CASETAG  s) =>  pu::heap_string s;
            case_constant_to_string (acf::VLEN_CASETAG    n) =>  int::to_string n;
        end;


        print_case_constant
            =
            say  o  case_constant_to_string;


        # Simple values, including variables and static constants:
        fun to_string_value (acf::VAR     v) =>  tmp::name_of_highcode_codetemp v;
            #   
            to_string_value (acf::INT     i) =>  "(I)"   +   int::to_string i;
            to_string_value (acf::INT1   i) =>  "(I32)" + one_word_int::to_string i;
            to_string_value (acf::UNT     i) =>  "(W)"   +   unt::to_string i;
            to_string_value (acf::UNT1   i) =>  "(W32)" + one_word_unt::to_string i;
            #
            to_string_value (acf::FLOAT64 r) =>  r;
            to_string_value (acf::STRING  s) =>  pu::heap_string s;
        end;

        print_sval
            =
            say  o  to_string_value;

        lvar_string
            =
            REF tmp::name_of_highcode_codetemp;


        fun print_variable v
            =
            say (*lvar_string v);


        print_typ
            =
            say  o  hcf::uniqtyp_to_string;


        print_lty
            =
            say  o  hcf::uniqtype_to_string;


        fun print_tv_tk (tv: tmp::Codetemp, tk)
            = 
            say ( (tmp::name_of_highcode_codetemp tv)
                  +
                  ":"
                  +
                  (hcf::uniqkind_to_string tk)
                );

        paren_comma_sep = ("(", ", ", ")");

        print_val_list              =  pu::print_closed_sequence ("[", ", ", "]")  print_sval;
        print_var_list              =  pu::print_closed_sequence ("[", ", ", "]")  print_variable;
        print_typ_list =  pu::print_closed_sequence ("[", ", ", "]")  print_typ;
        print_lty_list              =  pu::print_closed_sequence ("[", ", ", "]")  print_lty;
        print_tv_tk_list            =  pu::print_closed_sequence ("[", ", ", "]")  print_tv_tk;



        fun print_decon (acf::VAL_CASETAG((_, varhome::CONSTANT _, _), _, _))
                =>
                (); 

            #  WARNING: a hack, but then what about constant exceptions ?  XXX BUGGO FIXME

            print_decon (acf::VAL_CASETAG((symbol, pick_valcon_form, lambda_type), typs, highcode_variable))
                =>
                #  <highcode_variable> = DECON(<symbol>,<datatypeConstructorRepresentation>,<lambdaType>,[<typs>]) 
                {   print_variable  highcode_variable; 
                    say " = DECON("; 
                    say (sy::name symbol);
                    say ", ";
                    say (varhome::print_representation pick_valcon_form);
                    say ", ";
                    print_lty lambda_type;
                    say ", ";
                    print_typ_list typs;
                    say ")"; 
                    newline();
                    dent();
                };

            print_decon _
                =>
                ();
        end;

        fun apply_print prfun sepfun []
                =>
                ();

            apply_print prfun sepfun (x ! xs)
                =>
                {   prfun x;

                    apply
                        (fn y =  { sepfun(); prfun y;})
                        xs;
                };
        end;



        # Definitions of the lambda expressions:

        fun complex (acf::LET         _) =>  TRUE;
            complex (acf::MUTUALLY_RECURSIVE_FNS         _) =>  TRUE;
            complex (acf::TYPEFUN     _) =>  TRUE;
            complex (acf::SWITCH      _) =>  TRUE;
            complex (acf::CONSTRUCTOR _) =>  TRUE;
            complex (acf::EXCEPT      _) =>  TRUE;
            complex _                  =>  FALSE;
        end;

        fun p_lexp (acf::RET values)
                => 
                #   RETURN [values] 
                {   say "RETURN ";
                    print_val_list values;
                };

            p_lexp (acf::APPLY (f, args))
                =>
                #   APPLY (f, [args]) 
                {   say "APPLY(";
                    print_sval f;
                    say ", ";
                    print_val_list args;
                    say ")";
                };

            p_lexp (acf::APPLY_TYPEFUN (tf, typs))
                =>
                #   APPLY_TYPEFUN (tf, [typs]) 
                {   say "APPLY_TYPEFUN(";
                    print_sval tf;
                    say ", ";
                    print_typ_list typs;
                    say ")";
                };

            p_lexp (acf::LET (vars, lambda_expression, body))
                =>
                # [vars] = lambda_expression   OR
                # [vars] =
                #   body                 lambda_expression
                #                      body

                {   print_var_list vars;
                    say " = ";  

                    if   (complex lambda_expression)

                         indent 2;
                         newline();
                         dent();
                         p_lexp lambda_expression;
                         undent 2;
                    else
                         len = (3               #  for the " = " 
                                    + 2         #  for the "[]" 
                                    + (length vars) #  for each comma 
                                    + (fold_forward     #  sum of varname lengths 
                                      (fn (v, n) =  n + (size (*lvar_string v)))
                                          0 vars));

                         indent len;
                         p_lexp lambda_expression;
                         undent len;
                    fi;

                    newline ();
                    dent ();
                    p_lexp body;
                };

            p_lexp (acf::MUTUALLY_RECURSIVE_FNS (fundecs, body))
                =>
                # MUTUALLY_RECURSIVE_FNS(<fundec1>,
                #     <fundec2>,
                #     <fundec3>)
                # <body>

                {   say "MUTUALLY_RECURSIVE_FNS(";
                    indent 4;
                    apply_print print_fundec (newline & dent) fundecs;
                    undent 4;
                    say ")";
                    newline();
                    dent();  
                    p_lexp body;
                };

            p_lexp (acf::TYPEFUN ((tfk as { inlining_hint, ... }, highcode_variable, tv_tk_list, tfnbody), body))
                =>
                # v = 
                #   TYPEFUN([tk], lambdaType,
                #     <tfnbody>)
                # <body>

                {   print_variable highcode_variable;
                    say " = ";
                    newline();
                    indent 2;
                    dent();

                    if   (inlining_hint != acf::INLINE_IF_SIZE_SAFE)

                         say "i";
                    fi;
                    say "TYPEFUN(";

                    print_tv_tk_list tv_tk_list;
                    say ", ";
                    # ** printLty lambdaType; say ", "; *** lambdaType no longer available **
                    newline();
                    indent 2;
                    dent();
                    p_lexp tfnbody;
                    undent 4;
                    say ")";
                    newline();
                    dent();
                    p_lexp body;
                };


            # NOTE: I'm ignoring the Valcon_Signature here:

            p_lexp (acf::SWITCH (value, constructor_api, con_lexp_list, lexp_option))
                =>
                # SWITCH <value>
                #   <con> => 
                #       <Lambda_Expression>
                #   <con> => 
                #       <Lambda_Expression>

                {   say "SWITCH ";
                    print_sval value;
                    newline();
                    indent 2;
                    dent();  

                    apply_print
                        print_case (newline & dent) con_lexp_list;

                    case lexp_option

                         NULL => ();

                         THE lambda_expression          #  Default case 
                             =>
                             {   newline ();
                                 dent ();
                                 say "_ => ";
                                 indent 4;
                                 newline ();
                                 dent ();
                                 p_lexp lambda_expression;
                                 undent 4;
                             };
                    esac;

                    undent 2;
                };

            p_lexp (acf::CONSTRUCTOR ((symbol, _, _), typs, value, highcode_variable, body))
                =>
                # <highcode_variable> = CON(<symbol>, <typs>, <value>)
                # <body>

                {   print_variable highcode_variable;
                    say " = CON(";
                    say (sy::name symbol);
                    say ", ";
                    print_typ_list typs;
                    say ", ";
                    print_sval value;
                    say ")";  
                    newline();
                    dent();
                    p_lexp body;
                };

            p_lexp (acf::RECORD (record_kind, values, highcode_variable, body))
                =>
                # <highcode_variable> = RECORD(<recordKind>, <values>)
                # <body>

                {   print_variable highcode_variable;
                    say " = ";
                    print_rkind record_kind;
                    say " ";
                    print_val_list values; 
                    newline ();
                    dent ();
                    p_lexp body;
                };

            p_lexp (acf::GET_FIELD (value, int, highcode_variable, body))
                =>
                # <highcode_variable> = SELECT(<value>, <int>)
                # <body>

                {   print_variable highcode_variable;
                    say " = SELECT(";
                    print_sval value;
                    say ", ";
                    say (int::to_string int);
                    say ")";
                    newline();
                    dent();
                    p_lexp body;
                };

            p_lexp (acf::RAISE (value, ltys))
                =>
                # NOTE: I'm ignoring the Uniqtype list here. It is the return type 
                # of the raise exception expression. (ltys temporarily being printed --v)

                #  RAISE(<value>) 
                {   say "RAISE(";
                    print_sval value;
                    say ") : ";
                    print_lty_list ltys;
                };

            p_lexp (acf::EXCEPT (body, value))
                =>
                # <body>
                # EXCEPT(<value>)

                {   p_lexp body;  
                    newline();
                    dent();
                    say "EXCEPT(";
                    print_sval value;
                    say ")";
                };

            p_lexp (acf::BRANCH ((d, baseop, lambda_type, typs), values, body1, body2))
                =>
                # IF PRIM(<baseop>, <lambdaType>, [<typs>]) [<values>] 
                # THEN
                #   <body1>
                # ELSE
                #   <body2>

                {   case d
                        NULL =>  say "IF BASEOP(";
                         _   =>  say "IF GENOP(";
                    esac;

                    say (hbo::baseop_to_string baseop);
                    say ", ";
                    print_lty lambda_type;
                    say ", ";
                    print_typ_list typs;
                    say ") ";
                    print_val_list values;
                    newline();
                    dent();

                    apply_print print_branch (newline & dent) 
                        [("THEN", body1), ("ELSE", body2)];
                };

            p_lexp (acf::BASEOP (p as (_, hbo::MAKE_EXCEPTION_TAG, _, _), [value], highcode_variable, body))
                =>
                # <highcode_variable> = EXCEPTION_TAG(<value>[<typ>])
                # <body>

                {   print_variable highcode_variable;
                    say " = EXCEPTION_TAG(";
                    print_sval value;
                    say "[";
                    print_typ (acj::get_etag_typ p);
                    say "])";
                    newline();
                    dent();
                    p_lexp body;
                };

            p_lexp (acf::BASEOP (p as (_, hbo::WRAP, _, _), [value], highcode_variable, body))
                =>
                # <highcode_variable> = WRAP(<typ>, <value>)
                # <body>

                {   print_variable highcode_variable;
                    say " = WRAP(";
                    print_typ (acj::get_wrap_typ p);
                    say ", ";
                    print_sval value;
                    say ")";
                    newline();
                    dent();
                    p_lexp body;
                };

            p_lexp (acf::BASEOP (p as (_, hbo::UNWRAP, _, []), [value], highcode_variable, body))
                =>
                # <highcode_variable> = UNWRAP(<typ>, <value>)
                # <body>

                {   print_variable highcode_variable;
                    say " = UNWRAP(";
                    print_typ (acj::get_un_wrap_typ p);
                    say ", ";
                    print_sval value;
                    say ")";
                    newline();
                    dent();
                    p_lexp body;
                };

            p_lexp (acf::BASEOP ((d, baseop, lambda_type, typs), values, highcode_variable, body))
                =>
                # <highcode_variable> = PRIM(<baseop>, <lambdaType>, [<typs>]) [<values>]
                # <body>

                {   print_variable highcode_variable;  

                    case d

                         NULL => say " = BASEOP(";
                         _    => say " = GENOP(";
                    esac;

                    say (hbo::baseop_to_string baseop);
                    say ", ";
                    print_lty lambda_type;
                    say ", ";
                    print_typ_list typs;
                    say ") ";
                    print_val_list values;
                    newline();
                    dent();
                    p_lexp body;
                };
        end 

        also
        fun print_fundec (fkind as { call_as, ... }, highcode_variable, lvar_lty_list, body)
            =
            #  <highcode_variable> : (<fkind>) <lambdaType> =
            #    FN([v1:  lambdaType1,
            #        v2:  lambdaType2],
            #      <body>)

            {   print_variable highcode_variable;
                say " : "; 
                say "(";
                print_fkind fkind;
                say ") ";
                # ** the return-result lambdaType no longer available ---- printLty lambdaType; *
                say " = ";
                newline();
                indent 2;
                dent();
                say "FN([";
                indent 4;

                case lvar_lty_list

                     [] => ();

                     ((highcode_variable, lambda_type) ! lll)
                         => 
                         {   print_variable  highcode_variable;
                             say " : ";

                             if  (*ctrl::print_function_types
                                  or
                                  call_as != acf::CALL_AS_GENERIC_PACKAGE
                             )
                                  print_lty lambda_type;
                             else
                                  say "???";
                             fi;

                             apply
                                 (fn (highcode_variable, lambda_type)
                                     =
                                     {   say ", ";
                                         newline ();
                                         dent ();
                                         print_variable highcode_variable;
                                         say " : ";
                                         print_lty lambda_type;
                                     })
                                 lll;
                         };
                esac;

                say "], ";
                newline();
                undent 2;
                dent();
                p_lexp body;
                say ")";
                undent 4;
            }

        also
        fun print_case (case_constant, lambda_expression)
            =
            {   print_case_constant  case_constant;
                say " => ";
                indent 4;
                newline();
                dent();
                print_decon case_constant;
                p_lexp lambda_expression;
                undent 4;
            }

        also
        fun print_branch (s, lambda_expression)
            =
            {   say s;
                indent 4;
                newline ();
                dent ();
                p_lexp lambda_expression;
                undent 4;
            };

        fun print_lexp lambda_expression
            =
            p_lexp lambda_expression
            before
                {   newline();
                    newline();
                };

        fun print_prog program
            =
            {   print_fundec program;
                newline();
            };




        # Here's the new function which
        # writes to a Prettyprinter
        # instead of 'control_print::say'.
        # It duplicates much of the above
        # logic :-/

        fun prettyprint_prog  pp  program
            =
            {   {   prettyprint_fundec  pp  program;
                    pp.put "\n";
                }
                where

                    fun prettyprint_sequence (separator: String) pr elements
                        =
                        prettyprint_elements elements
                        where
                            fun prettyprint_elements [el]        =>  pr el;
                                prettyprint_elements (el ! rest) =>  { pr el;  pp.put separator;   prettyprint_elements rest;};
                                prettyprint_elements []          =>  ();
                            end;
                        end;

                    fun prettyprint_closed_sequence (front: String, sep, back: String) pr elements
                        =
                        {   pp.put front;

                            prettyprint_sequence sep pr elements;

                            pp.put back;
                        };


                    fun prettyprint_fkind  (pp: ppr::Prettyprinter)  fkind
                        =
                        pp.put (to_string_fkind  fkind);


                    fun prettyprint_rkind  (pp: ppr::Prettyprinter)  rkind
                        =
                        pp.put (to_string_rkind  rkind);


                    fun prettyprint_case_constant  (pp: ppr::Prettyprinter)  case_constant
                        =
                        pp.put (case_constant_to_string  case_constant);


                    fun prettyprint_sval  (pp: ppr::Prettyprinter)  sval
                        =
                        pp.put (to_string_value  sval);


                    fun prettyprint_variable  (pp: ppr::Prettyprinter)  v
                        =
                        pp.put (*lvar_string v);


                    fun prettyprint_type  (pp: ppr::Prettyprinter)  t
                        =
                        pp.put (hcf::uniqtyp_to_string  t);


                    fun prettyprint_lty  (pp: ppr::Prettyprinter)  lty
                        =
                        pp.put (hcf::uniqtype_to_string  lty);


                    fun prettyprint_lty  (pp: ppr::Prettyprinter)  lty
                        =
                        pp.put (hcf::uniqtype_to_string  lty);


                    fun prettyprint_tv_tk  (pp: ppr::Prettyprinter)  (tv: tmp::Codetemp, tk)
                        = 
                        pp.put ( (tmp::name_of_highcode_codetemp tv)
                                 +
                                 ":"
                                 +
                                 (hcf::uniqkind_to_string tk)
                               );

                    fun prettyprint_val_list            (pp: ppr::Prettyprinter) =   { pr =  prettyprint_sval             pp;    prettyprint_closed_sequence ("[", ", ", "]")  pr;  };
                    fun prettyprint_var_list            (pp: ppr::Prettyprinter) =   { pr =  prettyprint_variable         pp;    prettyprint_closed_sequence ("[", ", ", "]")  pr;  };
                    fun prettyprint_typ_list    (pp: ppr::Prettyprinter) =   { pr =  prettyprint_type             pp;    prettyprint_closed_sequence ("[", ", ", "]")  pr;  };
                    fun prettyprint_lty_list            (pp: ppr::Prettyprinter) =   { pr =  prettyprint_lty              pp;    prettyprint_closed_sequence ("[", ", ", "]")  pr;  };
                    fun prettyprint_tv_tk_list          (pp: ppr::Prettyprinter) =   { pr =  prettyprint_tv_tk            pp;    prettyprint_closed_sequence ("[", ", ", "]")  pr;  };

                    fun prettyprint_decon (pp: ppr::Prettyprinter)  (acf::VAL_CASETAG((_, varhome::CONSTANT _, _), _, _))
                            =>
                            (); 

                        #  WARNING: a hack, but then what about constant exceptions ?  XXX BUGGO FIXME

                        prettyprint_decon  pp  (acf::VAL_CASETAG((symbol, pick_valcon_form, lambda_type), typs, highcode_variable))
                            =>
                            #  <highcode_variable> = DECON(<symbol>,<datatypeConstructorRepresentation>,<lambdaType>,[<typs>]) 
                            {   prettyprint_variable  pp  highcode_variable; 
                                pp.put " = DECON("; 
                                pp.put (sy::name symbol);
                                pp.put ", ";
                                pp.put (varhome::print_representation pick_valcon_form);
                                pp.put ", ";
                                prettyprint_lty  pp  lambda_type;
                                pp.put ", ";
                                prettyprint_typ_list  pp  typs;
                                pp.put ")\n"; 
                            };

                        prettyprint_decon _ _
                            =>
                            ();
                    end;

                    fun prettyprint_fundec  pp  (fkind as { call_as, ... }, highcode_variable, lvar_lty_list, body)
                        =
                        #  <highcode_variable> : (<fkind>) <lambdaType> =
                        #    FN([v1:  lambdaType1,
                        #        v2:  lambdaType2],
                        #      <body>)

                        {   prettyprint_variable  pp  highcode_variable;
                            pp.put " : ("; 
                            prettyprint_fkind  pp  fkind;
                            pp.put ")  =\n";                # ** the return-result lambdaType no longer available ---- printLty lambdaType; *
                            pp.put "  FN( [ ";
                            pp.wrap .{

                                case lvar_lty_list

                                     [] => ();

                                     ((highcode_variable, lambda_type) ! lll)
                                         => 
                                         {   prettyprint_variable  pp  highcode_variable;
                                             pp.put " : ";

                                             if ( *ctrl::print_function_types
                                                  or
                                                  call_as != acf::CALL_AS_GENERIC_PACKAGE
                                             )
                                                  prettyprint_lty  pp  lambda_type;
                                             else
                                                  pp.put "???";
                                             fi;

                                             apply
                                                 (fn (highcode_variable, lambda_type)
                                                     =
                                                     {   pp.put ",\n";     prettyprint_variable  pp  highcode_variable;
                                                         pp.put " : ";     prettyprint_lty       pp  lambda_type;
                                                     })
                                                 lll;
                                         };
                                esac;

                                pp.put "],\n";

                                prettyprint_lexp  pp  body;

                                pp.put ")";
                            };
                        }

                    also
                    fun prettyprint_lexp  pp  (acf::RET values)
                            => 
                            #   RETURN [values] 
                            {   pp.put "RETURN ";
                                prettyprint_val_list  pp  values;
                            };

                        prettyprint_lexp  pp  (acf::APPLY (f, args))
                            =>
                            #   APPLY (f, [args]) 
                            {   pp.put "APPLY(";
                                prettyprint_sval  pp  f;
                                pp.put ", ";
                                prettyprint_val_list  pp  args;
                                pp.put ")";
                            };

                        prettyprint_lexp  pp  (acf::APPLY_TYPEFUN (tf, typs))
                            =>
                            #   APPLY_TYPEFUN (tf, [typs]) 
                            {   pp.put "APPLY_TYPEFUN(";
                                prettyprint_sval  pp  tf;
                                pp.put ", ";
                                prettyprint_typ_list  pp  typs;
                                pp.put ")";
                            };

                        prettyprint_lexp  pp  (acf::LET (vars, lambda_expression, body))
                            =>
                            # [vars] = lambda_expression   OR
                            # [vars] =
                            #   body                 lambda_expression
                            #                      body

                            {   prettyprint_var_list  pp  vars;
                                pp.put " = ";  

                                if   (complex lambda_expression)

                                     pp.wrap .{
                                         pp.put "\n";

                                         prettyprint_lexp  pp  lambda_expression;
                                     };
                                else
                                     len = (3           #  for the " = " 
                                                + 2             #  for the "[]" 
                                                + (length vars) #  for each comma 
                                                + (fold_forward #  sum of varname lengths 
                                                  (fn (v, n) =  n + (size (*lvar_string v)))
                                                      0 vars));

                                     pp.wrap' len .{
                                         prettyprint_lexp  pp  lambda_expression;
                                     };
                                fi;

                                pp.put "\n";
                                prettyprint_lexp  pp  body;
                            };

                        prettyprint_lexp  pp  (acf::MUTUALLY_RECURSIVE_FNS (fundecs, body))
                            =>
                            # MUTUALLY_RECURSIVE_FNS(<fundec1>,
                            #     <fundec2>,
                            #     <fundec3>)
                            # <body>

                            {   pp.put "MUTUALLY_RECURSIVE_FNS(";
                                pp.wrap .{
                                    apply_print
                                        (prettyprint_fundec  pp)
                                        .{ pp.put "\n";}
                                        fundecs;
                                };
                                pp.put ")\n";
                                prettyprint_lexp  pp  body;
                            };

                        prettyprint_lexp  pp  (acf::TYPEFUN ((tfk as { inlining_hint, ... }, highcode_variable, tv_tk_list, tfnbody), body))
                            =>
                            # v = 
                            #   TYPEFUN([tk], lambdaType,
                            #     <tfnbody>)
                            # <body>

                            {   prettyprint_variable  pp  highcode_variable;
                                pp.put " = \n";
                                pp.wrap' 2 .{

                                    if   (inlining_hint != acf::INLINE_IF_SIZE_SAFE)

                                         pp.put "i";
                                    fi;
                                    pp.put "TYPEFUN(";

                                    prettyprint_tv_tk_list  pp  tv_tk_list;
                                    pp.put ", \n";                  # ** printLty lambdaType; say ", "; *** lambdaType no longer available **

                                    pp.wrap' 2 .{
                                        prettyprint_lexp  pp  tfnbody;
                                    };
                                };
                                pp.put ")\n";

                                prettyprint_lexp  pp  body;
                            };


                        # NOTE: I'm ignoring the Valcon_Signature here:

                        prettyprint_lexp  pp  (acf::SWITCH (value, constructor_api, con_lexp_list, lexp_option))
                            =>
                            # SWITCH <value>
                            #   <con> => 
                            #       <Lambda_Expression>
                            #   <con> => 
                            #       <Lambda_Expression>

                            {   pp.put "SWITCH ";
                                prettyprint_sval  pp   value;
                                pp.put "\n";
                                pp.wrap' 2 .{

                                    apply_print
                                        (prettyprint_case pp)
                                        .{ pp.put "\n"; }
                                        con_lexp_list;

                                    case lexp_option

                                         NULL => ();

                                         THE lambda_expression          #  Default case 
                                             =>
                                             {   pp.put "\n_ => ";
                                                 pp.wrap .{
                                                     pp.put "\n";
                                                     prettyprint_lexp  pp  lambda_expression;
                                                 };
                                             };
                                    esac;

                                };
                            };

                        prettyprint_lexp  pp  (acf::CONSTRUCTOR ((symbol, _, _), typs, value, highcode_variable, body))
                            =>
                            # <highcode_variable> = CONSTRUCTOR(<symbol>, <typs>, <value>)
                            # <body>
                            #
                            {   prettyprint_variable  pp  highcode_variable;
                                pp.put " = CONSTRUCTOR(";
                                pp.put (sy::name symbol);
                                pp.put ", ";
                                prettyprint_typ_list  pp  typs;
                                pp.put ", ";
                                prettyprint_sval  pp  value;
                                pp.put ")\n";
                                prettyprint_lexp  pp  body;
                            };

                        prettyprint_lexp  pp  (acf::RECORD (record_kind, values, highcode_variable, body))
                            =>
                            # <highcode_variable> = RECORD(<recordKind>, <values>)
                            # <body>

                            {   prettyprint_variable  pp  highcode_variable;
                                pp.put " = ";
                                prettyprint_rkind  pp  record_kind;
                                pp.put " ";
                                prettyprint_val_list  pp  values; 
                                pp.put "\n";
                                prettyprint_lexp  pp  body;
                            };

                        prettyprint_lexp  pp  (acf::GET_FIELD (value, int, highcode_variable, body))
                            =>
                            # <highcode_variable> = SELECT(<value>, <int>)
                            # <body>

                            {   prettyprint_variable  pp  highcode_variable;
                                pp.put " = SELECT(";
                                prettyprint_sval  pp  value;
                                pp.put ", ";
                                pp.put (int::to_string int);
                                pp.put ")\n";
                                prettyprint_lexp  pp  body;
                            };

                        prettyprint_lexp  pp  (acf::RAISE (value, ltys))
                            =>
                            # NOTE: I'm ignoring the Uniqtype list here. It is the return type 
                            # of the raise exception expression. (ltys temporarily being printed --v)

                            #  RAISE(<value>) 
                            {   pp.put "RAISE(";
                                prettyprint_sval  pp  value;
                                pp.put ") : ";
                                prettyprint_lty_list  pp  ltys;
                            };

                        prettyprint_lexp  pp  (acf::EXCEPT (body, value))
                            =>
                            # <body>
                            # EXCEPT(<value>)

                            {   prettyprint_lexp  pp  body;  
                                pp.put "\n";
                                pp.put "EXCEPT(";
                                prettyprint_sval  pp  value;
                                pp.put ")";
                            };

                        prettyprint_lexp  pp  (acf::BRANCH ((d, baseop, lambda_type, typs), values, body1, body2))
                            =>
                            # IF PRIM(<baseop>, <lambdaType>, [<typs>]) [<values>] 
                            # THEN
                            #   <body1>
                            # ELSE
                            #   <body2>

                            {   case d

                                     NULL =>  pp.put "IF BASEOP(";
                                      _   =>  pp.put "IF GENOP(";
                                esac;

                                pp.put (hbo::baseop_to_string baseop);
                                pp.put ", ";
                                prettyprint_lty  pp  lambda_type;
                                pp.put ", ";
                                prettyprint_typ_list  pp  typs;
                                pp.put ") ";
                                prettyprint_val_list  pp  values;
                                pp.put "\n";


                                apply_print
                                    (prettyprint_branch pp)
                                    .{ pp.put "\n";}
                                    [("THEN", body1), ("ELSE", body2)];
                            };

                        prettyprint_lexp  pp  (acf::BASEOP (p as (_, hbo::MAKE_EXCEPTION_TAG, _, _), [value], highcode_variable, body))
                            =>
                            # <highcode_variable> = EXCEPTION_TAG(<value>[<typ>])
                            # <body>

                            {   prettyprint_variable  pp  highcode_variable;
                                pp.put " = EXCEPTION_TAG(";
                                prettyprint_sval  pp  value;
                                pp.put "[";
                                prettyprint_type  pp  (acj::get_etag_typ p);
                                pp.put "])\n";
                                prettyprint_lexp  pp  body;
                            };

                        prettyprint_lexp  pp  (acf::BASEOP (p as (_, hbo::WRAP, _, _), [value], highcode_variable, body))
                            =>
                            # <highcode_variable> = WRAP(<typ>, <value>)
                            # <body>

                            {   prettyprint_variable  pp  highcode_variable;
                                pp.put " = WRAP(";
                                prettyprint_type  pp  (acj::get_wrap_typ p);
                                pp.put ", ";
                                prettyprint_sval  pp  value;
                                pp.put ")\n";
                                prettyprint_lexp  pp  body;
                            };

                        prettyprint_lexp  pp  (acf::BASEOP (p as (_, hbo::UNWRAP, _, []), [value], highcode_variable, body))
                            =>
                            # <highcode_variable> = UNWRAP(<typ>, <value>)
                            # <body>

                            {   prettyprint_variable  pp  highcode_variable;
                                pp.put " = UNWRAP(";
                                prettyprint_type  pp  (acj::get_un_wrap_typ p);
                                pp.put ", ";
                                prettyprint_sval  pp  value;
                                pp.put ")\n";
                                prettyprint_lexp  pp  body;
                            };

                        prettyprint_lexp  pp  (acf::BASEOP ((d, baseop, lambda_type, typs), values, highcode_variable, body))
                            =>
                            # <highcode_variable> = PRIM(<baseop>, <lambdaType>, [<typs>]) [<values>]
                            # <body>

                            {   prettyprint_variable  pp  highcode_variable;  

                                case d
                                    NULL => pp.put " = BASEOP(";
                                    _    => pp.put " = GENOP(";
                                esac;

                                pp.put (hbo::baseop_to_string baseop);
                                pp.put ", ";
                                prettyprint_lty  pp  lambda_type;
                                pp.put ", ";
                                prettyprint_typ_list  pp  typs;
                                pp.put ") ";
                                prettyprint_val_list  pp  values;
                                pp.put "\n";
                                prettyprint_lexp  pp  body;
                            };
                    end 

                    also
                    fun prettyprint_case  pp  (case_constant, lambda_expression)
                        =
                        {   prettyprint_case_constant  pp  case_constant;
                            pp.put " => ";
                            pp.wrap .{
                                pp.put "\n";
                                prettyprint_decon     pp  case_constant;
                                prettyprint_lexp      pp  lambda_expression;
                            };
                        }

                    also
                    fun prettyprint_branch  (pp: ppr::Prettyprinter)  (s, lambda_expression)
                        =
                        {   pp.put s;
                            pp.wrap .{
                                pp.put "\n";
                                prettyprint_lexp  pp  lambda_expression;
                            };
                        };


                end;
            };                                  # fun prettyprint_prog
    };                                          # package prettyprint_anormcode 
end;                                            # stipulate


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext