PreviousUpNext

15.4.667  src/lib/compiler/front/typer/print/print-value-as-nada.pkg

## yprint-value-as-nada.pkg 
#
#  Modified to use Lib7 Lib pp. [dbm, 7/30/03]) 

# Compiled by:
#     src/lib/compiler/front/typer/typer.sublib



stipulate
    package id  =  inlining_data;               # inlining_data                 is from   src/lib/compiler/front/typer-stuff/basics/inlining-data.pkg
    package pp  =  prettyprint;                 # prettyprint                   is from   src/lib/prettyprint/big/src/prettyprint.pkg
    package syx =  symbolmapstack;              # symbolmapstack                is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg
    package ty  =  types;                       # types                         is from   src/lib/compiler/front/typer-stuff/types/types.pkg
    package vac =  variables_and_constructors;  # variables_and_constructors    is from   src/lib/compiler/front/typer-stuff/deep-syntax/variables-and-constructors.pkg
    package vh  =  varhome;                     # varhome                       is from   src/lib/compiler/front/typer-stuff/basics/varhome.pkg
herein

    api Print_Value_As_Lib7 {
        #
        print_datatyp_represetation_as_nada:  pp::Stream
                                                       -> vh::Valcon_Form
                                                       -> Void;

        print_varhome_as_nada:    pp::Stream ->  vh::Varhome  -> Void;
        print_dcon_as_nada:       pp::Stream ->  ty::Valcon   -> Void;
        print_var_as_nada:        pp::Stream -> vac::Variable -> Void;

        print_debug_decon_as_nada:  pp::Stream
                                -> syx::Symbolmapstack
                                ->  ty::Valcon
                                ->      Void;

        print_debug_var_as_nada:  (id::Inlining_Data -> String)
                              -> pp::Stream 
                              -> syx::Symbolmapstack
                              -> vac::Variable
                              -> Void;

    }; #  Api Print_Value_As_Lib7 
end;



stipulate
    package fis =  find_in_symbolmapstack;      # find_in_symbolmapstack        is from   src/lib/compiler/front/typer-stuff/symbolmapstack/find-in-symbolmapstack.pkg
    package pp  =  prettyprint;                 # prettyprint                   is from   src/lib/prettyprint/big/src/prettyprint.pkg
    package syx =  symbolmapstack;              # symbolmapstack                is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg
    package tys =  type_junk;                   # type_junk                     is from   src/lib/compiler/front/typer-stuff/types/type-junk.pkg
    package vh  =  varhome;                     # varhome                       is from   src/lib/compiler/front/typer-stuff/basics/varhome.pkg

#   package id  =  inlining_data;               # inlining_data                 is from   src/lib/compiler/front/typer-stuff/basics/inlining-data.pkg

    include prettyprint;
    include print_as_nada_junk;
    include variables_and_constructors;
    include types;
herein 

    package   print_value_as_nada
    : (weak)  Print_Value_As_Lib7               # Print_Value_As_Lib7   is from   src/lib/compiler/front/typer/print/print-value-as-nada.pkg
    {

        internals = typer_control::internals;

        fun by f x y
            =
            f y x;

        pps = pp::string;

        print_type_as_nada  = print_type_as_nada::print_type_as_nada;
        print_typ_as_nada = print_type_as_nada::print_typ_as_nada;
        print_tyfun_as_nada = print_type_as_nada::print_tyfun_as_nada;


        fun print_varhome_as_nada stream a
            =
            pps stream (" [" + (vh::print_varhome a) + "]");


        fun print_inlining_info_as_nada inlining_info_to_string stream a
            =
            pps stream (" [" + (inlining_info_to_string a) + "]");


        fun print_datatyp_represetation_as_nada stream representation
            =
            pp::string stream (vh::print_representation representation);


        fun print_csig_as_nada stream csig
            =
            pp::string stream (vh::print_constructor_api csig);


        fun print_dcon_as_nada stream
            =
            {   fun print_dcon_as_nada' ( VALCON { name, form => vh::EXCEPTION acc, ... } )
                        =>
                        {   print_symbol_as_nada  stream  name;

                            if *internals
                                 print_varhome_as_nada  stream  acc; 
                            fi;
                        };

                    print_dcon_as_nada' (VALCON { name, ... } )
                        =>
                        print_symbol_as_nada  stream  name;
                end;

                print_dcon_as_nada';
            };

        fun print_debug_decon_as_nada stream dictionary (VALCON { name, form, is_constant, type, signature, is_lazy } )
            =
            {   (en_pp  stream) ->   { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, break, ... };
                    

                print_symbol_as_nada
                    =
                    print_symbol_as_nada stream;

                begin_horizontal_else_vertical_box 3;
                pps "VALCON";
                break { spaces=>0, indent_on_wrap=>0 };
                pps "{ name = "; print_symbol_as_nada name;            print_comma_newline_as_nada stream;
                pps "is_constant = "; pps (bool::to_string is_constant);                  print_comma_newline_as_nada stream;
                pps "type = "; print_type_as_nada dictionary stream  type;   print_comma_newline_as_nada stream;
                pps "is_lazy = "; pps (bool::to_string is_lazy); print_comma_newline_as_nada stream;
                pps "Valcon_Form =";
                    print_datatyp_represetation_as_nada stream  form;
                    print_comma_newline_as_nada stream;
                pps "signature = [";   print_csig_as_nada stream signature;   pps "] }";
                end_box()
            ;};

        fun print_datatyp_as_nada
                (
                    dictionary: syx::Symbolmapstack,
                    VALCON { name, type, ... }
                )
                stream
            =
            {   (en_pp  stream) ->   { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
                #
                begin_wrap_box 0;
                print_symbol_as_nada stream name;   pps " : ";   print_type_as_nada dictionary stream  type;
                end_box()
            ;};

        fun print_con_naming_as_nada stream
            =
            {   my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... }
                    =
                    en_pp stream;

                fun print_constructor_as_nada (VALCON { name, type, form=>vh::EXCEPTION _, ... }, dictionary)
                        =>
                        {   begin_horizontal_else_vertical_box 0;
                            pps "exception "; print_symbol_as_nada  stream  name; 

                            if   (type_types::is_arrow_type  type)
                                
#                            pps " of "; 
                                 pps " "; 
                                 print_type_as_nada dictionary stream (type_types::domain  type);
                            fi;

                            end_box();
                        };

                    print_constructor_as_nada (con, dictionary)
                        => 
                        {   exception HIDDEN;

                            visible_dcon_typ
                                =
                                {   typ = tys::datatyp_to_typ con;

                                    (   type_junk::typ_equality (
                                            fis::find_typ_via_symbol_path
                                            (    dictionary,
                                                 symbol_path::SYMBOL_PATH
                                                 [ inverse_path::last (type_junk::typ_path typ) ],
                                                 fn _ = raise exception HIDDEN
                                            ),
                                            typ
                                        )
                                        except HIDDEN = FALSE
                                    );
                                };


                            if (*internals
                                or
                                not visible_dcon_typ
                            ) 
                                begin_horizontal_else_vertical_box 0;
                                pps "con ";
                                print_datatyp_as_nada (dictionary, con) stream;
                                end_box ();
                            fi;
                        };
                end;

                print_constructor_as_nada;
            };

        fun print_var_as_nada stream (ORDINARY_VARIABLE { varhome, path, ... } )
            =>
            {   pps stream (symbol_path::to_string path);

                if   *internals      print_varhome_as_nada stream varhome;   fi;
            };

            print_var_as_nada stream (OVERLOADED_IDENTIFIER { name, ... } )
                =>
                print_symbol_as_nada stream (name);

            print_var_as_nada stream (errorvar)
                =>
                pp::string stream "<errorvar>";
        end;

        fun print_debug_var_as_nada inlining_info_to_string stream dictionary
            = 
            {   (en_pp stream)
                    ->
                    { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };

                print_varhome_as_nada        = print_varhome_as_nada stream;
                print_inlining_info_as_nada   = print_inlining_info_as_nada inlining_info_to_string stream;

                fun print_debug_var_as_nada' (ORDINARY_VARIABLE { varhome, path, var_type, inlining_data } )
                        => 
                        {   begin_horizontal_else_vertical_box 0;
                            pps "ORDINARY_VARIABLE";
                            begin_horizontal_else_vertical_box 3;
                            pps "( { varhome=";   print_varhome_as_nada varhome;          print_comma_newline_as_nada stream;
                            pps "inlining_data="; print_inlining_info_as_nada inlining_data;  print_comma_newline_as_nada stream;
                            pps "path=";       pps (symbol_path::to_string path);     print_comma_newline_as_nada stream;
                            pps "var_type=REF "; print_type_as_nada dictionary stream *var_type; 
                            pps "} )";
                            end_box();
                            end_box();
                        };

                    print_debug_var_as_nada' (OVERLOADED_IDENTIFIER { name, alternatives, type_scheme } )
                        => 
                        {   begin_horizontal_else_vertical_box 0;
                            pps "OVERLOADED_IDENTIFIER";
                            begin_horizontal_else_vertical_box 3;
                            pps "( { name="; print_symbol_as_nada stream (name); print_comma_newline_as_nada stream;
                            pps "alternatives=["; 
                            (ppvseq stream 0 ", "
                             (fn stream = fn { indicator, variant } =
                                { pps "{ indicator=";print_type_as_nada dictionary stream  indicator; 
                                 print_comma_newline_as_nada stream;
                                 pps " variant =";
                                 print_debug_var_as_nada inlining_info_to_string stream dictionary variant; pps "}";}
                             )
                             *alternatives);
                            pps "]"; print_comma_newline_as_nada stream;
                            pps "type_scheme=";   print_tyfun_as_nada  dictionary  stream  type_scheme;   pps "} )";
                            end_box();
                            end_box();
                        };

                    print_debug_var_as_nada'  errorvar
                        =>
                        pps "<ERRORvar>";
                end;

                print_debug_var_as_nada';
            };

        # Is this ever called?
        fun print_variable_as_nada stream
            =
            {   my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... } = en_pp stream;

                fun print_variable_as_nada' (   dictionary: syx::Symbolmapstack,
                                                    ORDINARY_VARIABLE { path, varhome, var_type, inlining_data }
                                                )
                    => 
                        {   begin_horizontal_else_vertical_box 0;
                            pps (symbol_path::to_string path);

                            if   *internals      print_varhome_as_nada stream varhome;   fi;

                            pps " : "; print_type_as_nada dictionary stream (*var_type);
                            end_box ();
                        };

                    print_variable_as_nada' (dictionary, OVERLOADED_IDENTIFIER { name, alternatives, type_scheme=>TYPE_SCHEME { body, ... } } )
                        =>
                        {   begin_horizontal_else_vertical_box 0;
                            print_symbol_as_nada stream (name); pps " : "; print_type_as_nada dictionary stream body; 
                            pps " as ";
                            print_sequence_as_nada
                                stream
                                { sep   => by pp::break { spaces=>1, indent_on_wrap=>0 },
                                  pr    => (fn stream =  fn { variant, ... } =  print_variable_as_nada'(dictionary, variant)),
                                  style => CONSISTENT
                                }
                                *alternatives;
                            end_box();
                        };

                   print_variable_as_nada'(_, errorvar) => pps "<ERRORvar>";
             end;

                print_variable_as_nada';
           };
    };          # package print_value_as_nada 
end;            # stipulate


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext