PreviousUpNext

15.4.659  src/lib/compiler/front/typer/print/latex-print-value.pkg

## latex-print-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 Latex_Print_Value {

         backslash_latex_special_chars:   String -> String;

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

         latex_print_varhome:    pp::Stream ->  vh::Varhome  -> Void;
         latex_print_dcon:       pp::Stream ->  ty::Valcon   -> Void;
         latex_print_var:        pp::Stream -> vac::Variable -> Void;

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

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

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

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

    };
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
                                                # latex_print_type              is from   src/lib/compiler/front/typer/print/latex-print-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   latex_print_value
    : (weak)  Latex_Print_Value
    {
        internals = typer_control::internals;

        # La/TeX wants all literal underlines backslashed
        # (otherwise they denote subscripting), and similarly
        # for $ % # { } so we need a function to do
        #     s/([$%#{}_])/\\\1/g:
        #
        fun backslash_latex_special_chars  string
            =
            string::implode  (quote_em ( string::explode string, [] ))
            where
                fun quote_em ([], done)
                        =>
                        reverse done;

                    quote_em (c ! rest, done)
                        =>
                        case c
                        '\'' => quote_em (rest, '_' ! '\\' ! '_' ! '\\' ! 'e' ! 'm' ! 'i' ! 'r' ! 'p' ! '_' ! '\\' ! '_' ! '\\' ! done);
                        '!' =>  quote_em (rest, '_' ! '\\' ! '_' ! '\\' !       'g' ! 'n' ! 'a' ! 'b' ! '_' ! '\\' ! '_' ! '\\' ! done);
                        '_' =>  quote_em (rest, c ! '\\' ! done);
                        '$' =>  quote_em (rest, c ! '\\' ! done);
                        '&' =>  quote_em (rest, c ! '\\' ! done);
                        '%' =>  quote_em (rest, c ! '\\' ! done);
                        '#' =>  quote_em (rest, c ! '\\' ! done);
                        '@' =>  quote_em (rest, c ! '\\' ! done);
                        '{' =>  quote_em (rest, c ! '\\' ! done);
                        '}' =>  quote_em (rest, c ! '\\' ! done);
                         _  =>  quote_em (rest, c !        done);
                        esac;
                end;
            end;

        fun by f x y
            =
            f y x;

        pps = pp::string;

        latex_print_some_type        =  latex_print_type::latex_print_some_type;
        latex_print_type             =  latex_print_type::latex_print_type;
        latex_print_type_scheme    =  latex_print_type::latex_print_type_scheme;

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

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

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

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

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

                        if *internals
                             latex_print_varhome  stream  acc; 
                        fi;
                    };

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

        fun latex_print_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 = "; latex_print_some_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 =";
                latex_print_constructor_representation
                    stream
                    form;
                                                                                     unparse_comma_newline stream;
                pps "signature = [";   latex_print_csig stream signature;   pps "] }";
                end_box ();
            };

        fun latex_print_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 " : ";
                latex_print_some_type  symbolmapstack  stream  type;
                end_box ();
            };

        fun latex_print_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 " : ";
                latex_print_some_type  symbolmapstack  stream  type;
                end_box ();
            };

# Is this ever used?
        fun latex_print_con_naming stream
            =
            latex_print_constructor
            where

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

                fun latex_print_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 " "; 
                                     latex_print_some_type  symbolmapstack  stream  (type_types::domain  type);
                                 };
                            fi;

                            pps ";"; 

                            end_box();
                        };

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

                            visible_dcon_typ
                                =
                                {   typ = tys::datatyp_to_typ con;

                                    (   tys::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 ";
                                 latex_print_datatyp (symbolmapstack, con) stream;
                                 pps ";";
                                 end_box ();
                            fi;
                        };
                end;
            end;

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

                    if *internals
                         latex_print_varhome stream varhome;
                    fi;
                };

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

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

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

                latex_print_varhome = latex_print_varhome stream;
                latex_print_inlining_data   = latex_print_inlining_data inlining_info_to_string stream;

                fun latexprintdebugvar (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=";   latex_print_varhome varhome;          unparse_comma_newline stream;
                            pps "inlining_data="; latex_print_inlining_data inlining_data;        unparse_comma_newline stream;
                            pps "path=";       pps (symbol_path::to_string path);    unparse_comma_newline stream;
                            pps "var_type=REF "; latex_print_some_type  symbolmapstack  stream  *var_type; 
                            pps "} )";
                            end_box();
                            end_box();
                        };

                    latexprintdebugvar (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 "alternatives=["; 
                            (ppvseq stream 0 ", "
                             (fn stream =  fn { indicator, variant } =
                                { pps "{ indicator=";  latex_print_some_type  symbolmapstack  stream   indicator; 
                                 unparse_comma_newline stream;
                                 pps " variant =";
                                 latex_print_debug_var inlining_info_to_string stream symbolmapstack variant; pps "}";})
                             *alternatives);
                            pps "]"; unparse_comma_newline stream;
                            pps "type_scheme=";   latex_print_type_scheme  symbolmapstack  stream  type_scheme;   pps "} )";
                            end_box();
                            end_box();
                        };

                    latexprintdebugvar  errorvar
                        =>
                        pps "<ERRORvar>";
                end;
            
                latexprintdebugvar;
            };

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

                fun latexprintvariable (   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
                                 latex_print_varhome  stream  varhome;
                            fi;

                            pps ": ";
                            latex_print_some_type  symbolmapstack  stream  *var_type;
                            pps ";";

                            end_box ();
                        };

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

                    latexprintvariable(_, errorvar)
                        =>
                        pps "<ERRORvar>;";
                end;
            end;
    };                  #  package latex_print_value 
end;                    #  stipulate











Comments and suggestions to: bugs@mythryl.org

PreviousUpNext