PreviousUpNext

15.4.189  src/lib/c-kit/src/ast/prettyprint/pp-lib.pkg

## pp-lib.pkg
#
# For the standard system prettyprinter stuff see
#
#     src/lib/prettyprint/big/src/standard-prettyprinter.pkg

# Compiled by:
#     src/lib/c-kit/src/ast/ast.sublib

stipulate
    package f8b =  eight_byte_float;                                    # eight_byte_float      is from   src/lib/std/eight-byte-float.pkg
    package fil =  file__premicrothread;                                # file__premicrothread  is from   src/lib/std/src/posix/file--premicrothread.pkg
herein

    package prettyprint_lib {
        #
        package pp= old_prettyprinter;                          # old_prettyprinter     is from   src/lib/prettyprint/big/src/old-prettyprinter.pkg

        Prettyprint(X)   = pp::Ppstream -> X -> Void;

        exception PRETTYPRINT_EXCEPTION  String;

        suppress_pid_underscores       = REF TRUE;

        suppress_pid_global_underscores = REF TRUE;
            #
            # Usually want to do this to preserve linkability.

        suppress_tid_underscores = REF TRUE;
            #
            # These flags are set to TRUE temporarily during parsing to make error messages
            # more readable, and are then resored to their original values.  See
            # parse-to-ast.pkg.

        fun warning f msg
            =
            {   print f;
                print ":";
                print msg;
            };

        fun prettyprint_to_strm prettyprint stream v
            = 
            {   pps = pp::make_ppstream { consumer  =>  (\\ s  =  fil::write (stream, s)),
                                          flush     =>  (\\ () =  fil::flush (stream)),
                                          close     =>  (\\ () =  ())
                                      };
                prettyprint pps v;
                pp::flush_ppstream pps;
            };


        fun prettyprint_to_string prettyprint
            =
            pp::prettyprint_to_string prettyprint;


        add_string =  pp::add_string;
        newline    =  pp::add_newline;

        b_block    =  pp::begin_block;
        e_block    =  pp::end_block;

        fun prettyprint_int pps i
            = 
            if (i >= 0)
                add_string pps (int::to_string i);
            else
                add_string pps "-";
                add_string pps (int::to_string (-i));
            fi;

        fun prettyprint_int1 pps i
            =
            if (i >= 0)
                add_string pps (one_word_int::to_string  i);
            else
                add_string pps "-";
                add_string pps (one_word_int::to_string -i);
            fi;


        fun prettyprint_li pps i
            = 
            if (i >= 0)
                add_string pps (large_int::to_string i);
            else
                add_string pps "-";
                add_string pps (large_int::to_string -i);
            fi;


        fun prettyprint_real pps r
            =
            add_string pps (f8b::to_string r);


        fun prettyprint_string pps s
            =
            {   add_string pps "\"";
                add_string pps (string::to_cstring s);
                add_string pps "\"";
            };


        fun separate (prettyprint, sep) pps []
                =>
                ();

            separate (prettyprint, sep) pps [x]
                =>
                prettyprint pps x;

            separate (prettyprint, sep) pps (x ! xs)
                =>
                {   prettyprint pps x;
                    sep pps;
                    separate (prettyprint, sep) pps xs;
                };
        end;


        fun prettyprint_list { prettyprint, sep, l_delim, r_delim } pps items
            = 
            {   add_string pps l_delim;
                separate  (prettyprint, \\ pps = add_string pps sep)  pps  items;
                add_string pps r_delim;
            };


        fun space pps
            =
            add_string pps " ";


        fun spaces pps 0 => ();
            spaces pps n => {   space pps;   spaces pps (n - 1);  };
        end;


        fun blockify n prettyprint pps v
          = 
          {   newline pps;
              b_block pps pp::INCONSISTENT n;
              spaces pps n;
              prettyprint pps v;
              e_block pps;
          };


        fun prettyprint_opt prettyprint pps (THE x) =>  prettyprint pps x;
            prettyprint_opt prettyprint pps (NULL ) =>  ();
        end;


        fun prettyprint_sp prettyprint pps v
            =
            {   space pps;
                prettyprint pps v;
            };


        fun prettyprint_sp_opt prettyprint pps opt
            =
            prettyprint_opt (prettyprint_sp prettyprint) pps opt;


        fun prettyprint_guarded s bool pps
            =
            if bool   add_string pps s;   fi;

      /*      
        fun prettyprintPid (pidtab: Tables::pidtab, _) pps pid = 
            let fun prettyprintSymbolQuietly symbol = add_string pps (symbol::name symbol)
                fun prettyprintSymbolVerbose symbol = ( add_string pps (symbol::name symbol)
                                             ; add_string pps "_"
                                             ; add_string pps (Pid::to_string pid)
                                             )
                prettyprint_symbol = if *suppressPidUnderscores then prettyprintSymbolQuietly
                               else prettyprintSymbolVerbose
            in case Pidtab::find (pidtab, pid)
                 of THE { symbol, kind, ... } =>
                     (case kind
                        of (info::FIELDp _ |
                            info::VARIABLEp { stIlk=THE raw_syntax::EXTERN, ... } |
                            info::VARIABLEp { global=TRUE, ... } ) =>
                            add_string pps (symbol2string symbol)
                         | info::VARIABLEp { global=FALSE, ... } => prettyprint_symbol symbol
                         | info::LABEL => prettyprint_symbol symbol
                         | info::TYPEDEFp _ => prettyprint_symbol symbol
                         | info::TAGp _ => prettyprint_symbol symbol)
               | _ => add_string pps (Pid::to_string pid)
            end
      */

        fun prettyprint_symbol' pps symbol
            =
            add_string pps (symbol::name symbol);


        fun prettyprint_symbol pps (symbol: symbol::Symbol, uid: pid::Uid)
            =
            {   add_string pps (symbol::name symbol);

                if (not *suppress_pid_underscores)

                    add_string pps "_";
                    add_string pps (pid::to_string uid);
                fi;
            };


        fun prettyprint_id pps ( { name, uid, kind, st_ilk, global, ... }: raw_syntax::Id)
            = 
            case (st_ilk, global)

                ((raw_syntax::EXTERN, _) | (_, TRUE))    #  globals 
                    =>
                    if *suppress_pid_global_underscores

                         prettyprint_symbol' pps  name;
                    else
                         prettyprint_symbol  pps (name, uid);
                    fi;

                _   =>
                    prettyprint_symbol pps (name, uid);
            esac;
                #
                # No uids printed for globals to preserve linkability.


        fun prettyprint_label pps ( { name, uid, ... }: raw_syntax::Label)
            = 
            prettyprint_symbol pps (name, uid);


        fun prettyprint_member pps ( { name, ... }: raw_syntax::Member)
            = 
            prettyprint_symbol' pps name;


        fun prettyprint_tid (tidtab: tables::Tidtab) pps tid
            = 
            case (tidtab::find (tidtab, tid))

                THE { name=>NULL, ... }
                    =>
                    add_string pps (tid::to_string tid);

                THE { name=>THE id, ... }
                    =>
                    if *suppress_tid_underscores

                        add_string pps id;
                    else
                        add_string pps id;
                        add_string pps "_";
                        add_string pps (tid::to_string tid);
                    fi;

                NULL =>
                    add_string pps (tid::to_string tid);
            esac;
    };
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext