15.4.526  src/lib/compiler/debugging-and-profiling/profiling/tell-env.pkg

## tell-dictionary.pkg

# Compiled by:
#     src/lib/compiler/debugging-and-profiling/debugprof.sublib

# This provides an abstract interface to the symbol tables for
# the profiler to use. 



###       "There has never been an unexpectedly
###        short debugging period in the history
###        of computers."
###
###                          -- Steven Levy


api Tell_Dictionary {

    Symbol;
    Dictionary = symbolmapstack::Symbolmapstack;
    Naming;
    Typoid;
    name:  Symbol -> String;
    components:  Dictionary -> List( (Symbol, Naming) );
    str_bind:  Naming -> Null_Or( Dictionary );
    val_bind:  Naming -> Null_Or( Typoid );
    fun_type:  Typoid -> Null_Or( (Typoid, Typoid) );
};

stipulate
    package tdt =  type_declaration_types;                              # type_declaration_types        is from   src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg
herein

    package tell_dictionary
    :       Tell_Dictionary                                             # Tell_Dictionary       is from   src/lib/compiler/debugging-and-profiling/profiling/tell-env.pkg
    {
        Symbol     =  symbol::Symbol;
        Dictionary =  symbolmapstack::Symbolmapstack;
        Naming     =  symbolmapstack_entry::Symbolmapstack_Entry;
        Typoid     =  tdt::Typoid;

        name = symbol::name;

        fun components _ = [];
        fun str_bind _ = NULL;
        fun val_bind _ = NULL;
        fun fun_type _ = NULL;

     /*
       fun components e = 
        let namings = REF (NIL:  List( Symbol * naming ))
            fun get x = namings := x . *namings
         in Dictionary::apply get (Dictionary::consolidate e);
            *namings
        end

       fun strBind (module::NAMED_PACKAGE (module::STRvar { access, naming, ... } )) =
                   THE (module_junk::makeDict (naming, access))
         | strBind _ = NULL

       fun named_value (module::VARBIND (Variables::PLAIN_VARIABLE { access=access::INLINE _, ... } )) = NULL
         | named_value (module::VARBIND (Variables::PLAIN_VARIABLE { type=REF type, ... } )) = THE type
         | named_value _ = NULL

       fun funType type =
         let type' = type_junk::head_reduce_type type
          in if mtt::is_arrow_type type'
              then THE (mtt::domain type', mtt::range type')
              else NULL
         end
     */
    };
end;



## COPYRIGHT (c) 1995 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.