PreviousUpNext

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

## latex-print-value.pkg 

# 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  =  standard_prettyprinter;      # standard_prettyprinter        is from   src/lib/prettyprint/big/src/standard-prettyprinter.pkg
    package syx =  symbolmapstack;              # symbolmapstack                is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg
    package tdt =  type_declaration_types;      # type_declaration_types        is from   src/lib/compiler/front/typer-stuff/types/type-declaration-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::Prettyprinter
                                                   -> vh::Valcon_Form
                                                   -> Void;

        latex_print_varhome:    pp::Prettyprinter ->  vh::Varhome  -> Void;
        latex_print_valcon:     pp::Prettyprinter -> tdt::Valcon   -> Void;
        latex_print_var:        pp::Prettyprinter -> vac::Variable -> Void;

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

        latex_print_debug_valcon
            :
            pp::Prettyprinter
            -> syx::Symbolmapstack
            -> tdt::Valcon
            -> Void
            ;

        latex_print_constructor
            :
            pp::Prettyprinter
            -> syx::Symbolmapstack
            -> tdt::Valcon
            -> Void
            ;

        latex_print_debug_var
            :
            pp::Prettyprinter 
            -> syx::Symbolmapstack
            -> vac::Variable
            -> Void
            ;

        latex_print_inlining_data
            :
            pp::Prettyprinter
            -> syx::Symbolmapstack
            -> id::Inlining_Data
            -> 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 id  =  inlining_data;               # inlining_data                 is from   src/lib/compiler/front/typer-stuff/basics/inlining-data.pkg
    package ip  =  inverse_path;                # inverse_path                  is from   src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg
    package pp  =  standard_prettyprinter;      # standard_prettyprinter        is from   src/lib/prettyprint/big/src/standard-prettyprinter.pkg
    package syp =  symbol_path;                 # symbol_path                   is from   src/lib/compiler/front/typer-stuff/basics/symbol-path.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 tdt =  type_declaration_types;      # type_declaration_types        is from   src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg
    package uj  =  unparse_junk;                # unparse_junk                  is from   src/lib/compiler/front/typer/print/unparse-junk.pkg
    package mtt =  more_type_types;             # more_type_types               is from   src/lib/compiler/front/typer/types/more-type-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
                                                # latex_print_type              is from   src/lib/compiler/front/typer/print/latex-print-type.pkg
    Pp = pp::Pp;

    include package   type_declaration_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;

        latex_print_some_type     =  latex_print_type::latex_print_some_type;
        latex_print_type          =  latex_print_type::latex_print_type;
        latex_print_typescheme    =  latex_print_type::latex_print_typescheme;

        fun latex_print_varhome  (pp:Pp)  a
            =
            pp.lit (   " ["
                       +   (vh::print_varhome a)
                       +   "]"
                       );

        fun latex_print_inlining_data  pp  symbolmapstack  inlining_data
            =
            {   (id::get_inlining_data_for_prettyprinting  inlining_data)
                    ->
                    (baseop, typoid);

                pp.box {.       
                    pp.lit "{";
                    pp.ind 4;

                    pp.box {.
                        pp.lit "baseop =>";
                        pp.txt " ";
                        pp.lit baseop;
                        pp.endlit ",";
                    };

                    pp.txt " ";

                    pp.box {.   
                        pp.lit "typoid =>";
                        pp.txt " ";
                        latex_print_some_type  symbolmapstack  pp  typoid;
                    };

                    pp.ind 0;
                    pp.txt " ";
                    pp.lit "}";
                };
            };

        fun latex_print_constructor_representation  (pp:Pp)  representation
            =
            pp.lit (vh::print_representation representation);


        fun latex_print_csig  (pp:Pp)  csig
            =
            pp.lit (vh::print_constructor_api csig);


        fun latex_print_valcon pp
            =
            latex_print_d
            where       
                fun latex_print_d ( VALCON { name, form => vh::EXCEPTION acc, ... } )
                    =>
                    {   uj::unparse_symbol  pp  name;
                        #
                        if *internals
                             latex_print_varhome  pp  acc; 
                        fi;
                    };

                    latex_print_d (VALCON { name, ... } )
                        =>
                        uj::unparse_symbol  pp  name;
                end;
            end;

        fun latex_print_debug_valcon pp symbolmapstack (VALCON { name, form, is_constant, typoid, signature, is_lazy } )
            =
            {   unparse_symbol =  uj::unparse_symbol  pp;
                #
                pp.box {.                                                                                       pp.rulename "lpv1";
                    pp.lit "VALCON";
                    pp.cut ();
                    pp.lit "{ name = ";  unparse_symbol name;                                   pp.txt ", \n";
                    pp.lit "is_constant = "; pp.lit (bool::to_string is_constant);              pp.txt ", \n";
                    pp.lit "typoid = "; latex_print_some_type  symbolmapstack  pp  typoid;      pp.txt ", \n";
                    pp.lit "is_lazy = "; pp.lit (bool::to_string is_lazy);                      pp.txt ", \n";

                    pp.lit "pick_valcon_form =";
                    latex_print_constructor_representation
                        pp
                        form;
                                                                                         pp.txt ", \n";
                    pp.lit "signature = [";   latex_print_csig pp signature;   pp.lit "] }";
                };
            };

        fun latex_print_constructor pp symbolmapstack (VALCON { name, form, is_constant, typoid, signature, is_lazy } )
            =
            {   unparse_symbol =  uj::unparse_symbol pp;
                #
                pp.box {.                                                                                       pp.rulename "lpv2";
                    #
                    unparse_symbol name;
                    pp.txt " : ";
                    latex_print_some_type  symbolmapstack  pp  typoid;
                };
            };

        fun latex_print_sumtype
              (
                symbolmapstack: syx::Symbolmapstack,
                VALCON { name, typoid, ... }
              )
              pp
            =
            pp.wrap' 0 -1 {.                                                                                                    pp.rulename "lptw7";
                uj::unparse_symbol pp name;
                pp.txt " : ";
                latex_print_some_type  symbolmapstack  pp  typoid;
            };

# Is this ever used?
        fun latex_print_con_naming pp
            =
            latex_print_constructor
            where
                fun latex_print_constructor (VALCON { name, typoid, form=>vh::EXCEPTION _, ... }, symbolmapstack)
                        =>
                        {   pp.box' 0 -1 {.                                                                                     pp.rulename "lpv3";
                                #
                                pp.txt "exception ";
                                uj::unparse_symbol  pp  name; 

                                if (mtt::is_arrow_type typoid)
                                    #
                                     pp.txt " "; 
                                     latex_print_some_type  symbolmapstack  pp  (mtt::domain  typoid);
                                fi;

                                pp.endlit ";"; 
                            };
                        };

                    latex_print_constructor (con, symbolmapstack)
                        => 
                        {   exception HIDDEN;
                            #
                            visible_valcon_type
                                =
                                {   type = tys::sumtype_to_type  con;

                                    (   tys::type_equality (
                                            fis::find_type_via_symbol_path
                                            (    symbolmapstack,
                                                 syp::SYMBOL_PATH
                                                 [ ip::last (tys::namepath_of_type type) ],
                                                 \\ _ = raise exception HIDDEN
                                            ),
                                            type
                                        )
                                        except
                                            HIDDEN = FALSE
                                    );
                                };

                            if (*internals
                                or
                                not visible_valcon_type 
                            )
                                 pp.box' 0 -1 {.                                                                                        pp.rulename "lpv4";
                                     pp.txt "con ";
                                     latex_print_sumtype (symbolmapstack, con) pp;
                                     pp.endlit ";";
                                 };
                            fi;
                        };
                end;
            end;

        fun latex_print_var  (pp:Pp)  (vac::PLAIN_VARIABLE { varhome, path, ... } )
                =>
                {   pp.txt (syp::to_string path);
                    #
                    if *internals
                         latex_print_varhome pp varhome;
                    fi;
                };

            latex_print_var pp (vac::OVERLOADED_VARIABLE { name, ... } )
                =>
                uj::unparse_symbol pp (name);

            latex_print_var  (pp:Pp)  (errorvar)
                =>
                pp.lit  "<errorvar>";
        end;

        fun latex_print_debug_var (pp:Pp)  symbolmapstack
            = 
            {
                latex_print_varhome       =  latex_print_varhome pp;
                latex_print_inlining_data =  latex_print_inlining_data  pp  symbolmapstack;

                fun latexprintdebugvar (vac::PLAIN_VARIABLE { varhome, path, vartypoid_ref, inlining_data } )
                        => 
                        {   pp.box' 0 -1 {.                                                                                     pp.rulename "lpv5";
                                pp.lit "vac::PLAIN_VARIABLE";
                                pp.box {.                                                                                       pp.rulename "lpv6";
                                    pp.lit "( { varhome=";   latex_print_varhome varhome;               pp.txt ", \n";
                                    pp.lit "inlining_data="; latex_print_inlining_data inlining_data;   pp.txt ", \n";
                                    pp.lit "path=";          pp.lit (syp::to_string path);              pp.txt ", \n";
                                    pp.lit "vartypoid_ref=REF "; latex_print_some_type  symbolmapstack  pp  *vartypoid_ref; 
                                    pp.endlit "} )";
                                };
                            };
                        };

                    latexprintdebugvar (vac::OVERLOADED_VARIABLE { name, alternatives, typescheme } )
                        => 
                        {   pp.box' 0 -1 {.                                                                                     pp.rulename "lpv7";
                                pp.lit "vac::OVERLOADED_VARIABLE";
                                pp.box {.                                                                                       pp.rulename "lpv8";
                                    pp.lit "( { name=";   uj::unparse_symbol pp (name);   pp.txt ", \n";
                                    pp.lit "alternatives=["; 
                                    (uj::ppvseq pp 0 ", "
                                     (\\ pp =  \\ { indicator, variant } =
                                        { pp.lit "{ indicator=";  latex_print_some_type  symbolmapstack  pp   indicator; 
                                          pp.txt ", \n";
                                          pp.lit " variant =";
                                          latex_print_debug_var pp symbolmapstack variant;
                                          pp.lit "}";
                                          pp.cut ();
                                        }
                                     )
                                     *alternatives);
                                    pp.lit "]";
                                    pp.txt ", \n";
                                    pp.lit "typescheme=";
                                    latex_print_typescheme  symbolmapstack  pp  typescheme;
                                    pp.lit "} )";
                                };
                            };
                        };

                    latexprintdebugvar  errorvar
                        =>
                        pp.lit "<ERRORvar>";
                end;
            
                latexprintdebugvar;
            };

        fun latex_print_variable  (pp:Pp)
            =
            latexprintvariable
            where
                #
                fun latexprintvariable (   symbolmapstack: syx::Symbolmapstack,
                                            vac::PLAIN_VARIABLE { path, varhome, vartypoid_ref, inlining_data }
                                        )
                        => 
                        {   pp.box' 0 -1 {.                                                                                     pp.rulename "lpv9";
                                pp.lit (syp::to_string path);

                                if *internals
                                    latex_print_varhome  pp  varhome;
                                    #
                                    pp.lit "inlining_data =>";
                                    pp.txt " ";
                                    latex_print_inlining_data  pp  symbolmapstack  inlining_data;
                                fi;

                                pp.txt ": ";
                                latex_print_some_type  symbolmapstack  pp  *vartypoid_ref;
                                pp.endlit ";";
                            };
                        };

                    latexprintvariable (symbolmapstack, vac::OVERLOADED_VARIABLE { name, alternatives, typescheme=>TYPESCHEME { body, ... } } )
                        =>
                        {   pp.box' 0 -1 {.                                                                                     pp.rulename "lpv10";
                                uj::unparse_symbol pp name;
                                pp.txt ": ";
                                latex_print_some_type  symbolmapstack  pp  body; 
                                pp.txt " as ";
                                uj::unparse_sequence pp { separator  => (\\ pp = pp::break pp { blanks=>1, indent_on_wrap=>0 }),
                                                          print_one  => (\\ pp = \\ { variant, ... } = latexprintvariable (symbolmapstack, variant)),
                                                          breakstyle => uj::ALIGN
                                                        }
                                    *alternatives;
                                pp.endlit ";";
                            };
                        };

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











Comments and suggestions to: bugs@mythryl.org

PreviousUpNext