PreviousUpNext

15.4.673  src/lib/compiler/front/typer/print/unparse-value.pkg

## unparse-value.pkg 
## Copyright 2003 by The SML/NJ Fellowship 

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

#  Modified to use Lib7 Lib pp. [dbm, 7/30/03]) 

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 Unparse_Value {

         unparse_constructor_representation:  pp::Stream
                                                -> vh::Valcon_Form
                                                -> Void;

         unparse_varhome:     pp::Stream ->  vh::Varhome  -> Void;
         unparse_dcon:        pp::Stream ->  ty::Valcon   -> Void;
         unparse_var:         pp::Stream -> vac::Variable -> Void;

         unparse_variable
             :
             pp::Stream
             ->
             (syx::Symbolmapstack, vac::Variable)
             ->
             Void;

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

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

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

    }; #  Api Unparse_Value 
end;


stipulate
    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 fis =  find_in_symbolmapstack;      # find_in_symbolmapstack        is from   src/lib/compiler/front/typer-stuff/symbolmapstack/find-in-symbolmapstack.pkg
    package vh  =  varhome;                     # varhome                       is from   src/lib/compiler/front/typer-stuff/basics/varhome.pkg
                                                # unparse_type                  is from   src/lib/compiler/front/typer/print/unparse-type.pkg

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

    include prettyprint;
    include unparse_junk;
    include variables_and_constructors;
    include types;

herein 

    package   unparse_value
    : (weak)  Unparse_Value
    {
        internals = typer_control::internals;

        fun by f x y
            =
            f y x;

        pps = pp::string;

        unparse_type             =  unparse_type::unparse_type;
        unparse_typ =  unparse_type::unparse_typ;
        unparse_type_scheme      =  unparse_type::unparse_type_scheme;

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

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

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

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

        fun unparse_dcon stream
            =
            unparse_d
            where
                fun unparse_d ( VALCON { name, form => vh::EXCEPTION acc, ... } )
                        =>
                        {   unparse_symbol  stream  name;

                            if *internals     unparse_varhome  stream  acc;     fi;
                        };

                    unparse_d (VALCON { name, ... } )
                        =>
                        unparse_symbol  stream  name;
                end;
            end;

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

                unparse_symbol = unparse_symbol stream;
            
                begin_horizontal_else_vertical_box 3;
                pps "VALCON";
                break { spaces=>0, indent_on_wrap=>0 };
                pps "{ name = "; unparse_symbol name;                              unparse_comma_newline stream;
                pps "is_constant = "; pps (bool::to_string is_constant);                         unparse_comma_newline stream;
                pps "type = "; unparse_type  symbolmapstack  stream  type;    unparse_comma_newline stream;
                pps "is_lazy = "; pps (bool::to_string is_lazy);                     unparse_comma_newline stream;

                pps "pick_valcon_form =";
                unparse_constructor_representation
                    stream
                    form;
                                                                                     unparse_comma_newline stream;
                pps "signature = [";  unparse_csig stream signature;  pps "] }";
                end_box ();
            };

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

                unparse_symbol = unparse_symbol stream;
            
                begin_horizontal_else_vertical_box 3;
                unparse_symbol name;
                pps " : ";
                unparse_type  symbolmapstack  stream  type;
                end_box ();
            };

        fun unparse_datatyp
              (
                symbolmapstack: syx::Symbolmapstack,
                VALCON { name, type, ... }
              )
              stream
            =
            {   (en_pp  stream) ->   { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };
                #           
                begin_wrap_box 0;
                unparse_symbol stream name;   pps " : ";
                unparse_type  symbolmapstack  stream  type;
                end_box ();
            };

# Is this ever used?
        fun unparse_con_naming stream
            =
            unparse_constructor
            where

                (en_pp  stream) ->   { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };

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

                            if   (type_types::is_arrow_type  type)
                                
                                 {   pps " "; 
                                     unparse_type  symbolmapstack  stream  (type_types::domain  type);
                                 };
                            fi;

                            pps ";"; 

                            end_box();
                        };

                    unparse_constructor (con, symbolmapstack)
                        => 
                        {   exception HIDDEN;

                            visible_dcon_typ
                                =
                                {   typ =   tys::datatyp_to_typ   con;

                                    (   type_junk::typ_equality (
                                            fis::find_typ_via_symbol_path
                                            (    symbolmapstack,
                                                 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 ";
                                unparse_datatyp (symbolmapstack, con) stream;
                                pps ";";
                                end_box ();
                            fi;
                        };
                end;
            end;

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

                    if *internals
                         unparse_varhome stream varhome;
                    fi;
                };

            unparse_var stream (OVERLOADED_IDENTIFIER { name, ... } )
                =>
                unparse_symbol stream (name);

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

        fun unparse_debug_var inlining_info_to_string stream symbolmapstack
            = 
            {   my { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... }
                    =
                    en_pp stream;

                unparse_varhome = unparse_varhome stream;
                unparse_inlining_data   = unparse_inlining_data inlining_info_to_string stream;

                fun unparsedebugvar (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=";   unparse_varhome varhome;                   unparse_comma_newline stream;
                            pps "inlining_data="; unparse_inlining_data inlining_data;        unparse_comma_newline stream;
                            pps "path=";       pps (symbol_path::to_string path);             unparse_comma_newline stream;
                            pps "var_type=REF "; unparse_type  symbolmapstack  stream  *var_type; 
                            pps "} )";
                            end_box();
                            end_box();
                        };

                    unparsedebugvar (OVERLOADED_IDENTIFIER { name, alternatives, type_scheme } )
                        => 
                        {   begin_horizontal_else_vertical_box 0;
                            pps "OVERLOADED_IDENTIFIER";
                            begin_horizontal_else_vertical_box 3;
                            pps "( { name="; unparse_symbol stream (name); unparse_comma_newline stream;
                            pps "alternative=["; 
                            (ppvseq stream 0 ", "
                              (fn stream = fn { indicator, variant }
                                  =
                                  {   pps "{ indicator=";  unparse_type  symbolmapstack  stream   indicator; 
                                      unparse_comma_newline stream;
                                      pps " variant =";
                                      unparse_debug_var inlining_info_to_string stream symbolmapstack variant; pps "}";
                                  }
                              )
                              *alternatives);
                            pps "]"; unparse_comma_newline stream;
                            pps "type_scheme=";   unparse_type_scheme  symbolmapstack  stream  type_scheme;   pps "} )";
                            end_box();
                            end_box();
                        };

                    unparsedebugvar (errorvar) => pps "<ERRORvar>";
                end;
            
                unparsedebugvar;
            };

        fun unparse_variable stream
            =
            unparse_variable'
            where
                (en_pp stream) ->   { begin_horizontal_else_vertical_box, begin_wrap_box, end_box, pps, ... };

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

                            if *internals
                                 unparse_varhome stream  varhome;
                            fi;

                            pps ": ";
                            unparse_type  symbolmapstack  stream  *var_type;
                            pps ";";
                            end_box ();
                        };

                    unparse_variable'
                        (
                          symbolmapstack,
                          OVERLOADED_IDENTIFIER { name, alternatives=>REF alternatives, type_scheme=>TYPE_SCHEME { body, ... } }
                        )
                        =>
                        {   begin_horizontal_else_vertical_box 0;
                            unparse_symbol stream (name);
                            pps ": ";
                            unparse_type  symbolmapstack  stream  body; 
                            pps " as ";
                            unparse_sequence
                                stream
                                  { sep   => by pp::break { spaces=>1, indent_on_wrap=>0 },
                                    pr    => (fn stream = fn { variant, ... } = unparse_variable' (symbolmapstack, variant)),
                                    style => CONSISTENT
                                  }
                                alternatives;
                            pps ";";
                            end_box();
                        };

                    unparse_variable' (_, errorvar)
                        =>
                        pps "<ERRORvar>;";
                end;
            end;
    };                  #  package unparse_value 
end;                    #  stipulate











Comments and suggestions to: bugs@mythryl.org

PreviousUpNext