15.4.698  src/lib/compiler/toplevel/interact/compiler-state.pkg

## compiler-state.pkg

# Compiled by:
#     src/lib/compiler/core.sublib




###            "There is no practical obstacle whatsoever now
###             to the creation of an efficient index to all
###             human knowledge, ideas and achievements,
###             to the creation, that is, of a complete
###             planetary memory for all mankind."
###
###                                  -- H G Wells



stipulate
    package cms =  compiler_mapstack_set;                                               # compiler_mapstack_set         is from   src/lib/compiler/toplevel/compiler-state/compiler-mapstack-set.pkg
    package pl  =  property_list;                                                       # property_list                 is from   src/lib/src/property-list.pkg
    package syx =  symbolmapstack;                                                      # symbolmapstack                is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg
herein

    package   compiler_state
    : (weak)  Compiler_State                                                            # Compiler_State                is from   src/lib/compiler/toplevel/interact/compiler-state.api
    {
        Compiler_Mapstack_Set
            =
            cms::Compiler_Mapstack_Set;                                                 # compiler_mapstack_set         is from   src/lib/compiler/toplevel/compiler-state/compiler-mapstack-set.pkg

        Compiler_Mapstack_Set_Jar
          =
          { get_mapstack_set:  Void -> Compiler_Mapstack_Set,
            set_mapstack_set:          Compiler_Mapstack_Set -> Void
          };

        Compiler_State
          =
          { top_level_pkg_etc_defs_jar: Compiler_Mapstack_Set_Jar,
            baselevel_pkg_etc_defs_jar: Compiler_Mapstack_Set_Jar,
            #   
            property_list:              pl::Property_List
          }; 

        fun make_compiler_mapstack_set_jar
                #
                table_set
            =
            {   table_set_ref      =  REF  table_set;
                #
                fun get_mapstack_set ()         =  *table_set_ref;
                fun set_mapstack_set table_set  =   table_set_ref := table_set;

                { get_mapstack_set,
                  set_mapstack_set
                };
            };

        pervasive_fun_etc_defs_jar                                                      # XXX SUCKO FIXME more icky thread-hostile mutable global state :(
            =
            make_compiler_mapstack_set_jar
                #
                cms::null_compiler_mapstack_set;


        my compiler_state_stack                                                         # More icky thread-hostile global mutable state.
            :
            Ref ((Compiler_State, List(Compiler_State)))
            =
            {   top_level_pkg_etc_defs_jar
                    =
                    make_compiler_mapstack_set_jar
                        #
                        cms::null_compiler_mapstack_set;

                property_list
                    =
                    pl::make_property_list ();

                REF ( { top_level_pkg_etc_defs_jar,
                        baselevel_pkg_etc_defs_jar =>  pervasive_fun_etc_defs_jar,
                        property_list
                      },
                      []
                    );
            };

        fun compiler_state ()
            =
            #1 *compiler_state_stack;

        get_top_level_pkg_etc_defs_jar  =  .top_level_pkg_etc_defs_jar  o  compiler_state;
        get_baselevel_pkg_etc_defs_jar  =  .baselevel_pkg_etc_defs_jar  o  compiler_state;
        property_list                   =  .property_list               o  compiler_state;

        fun combined ()
            =
            cms::layer_compiler_mapstack_sets
              (
                (get_top_level_pkg_etc_defs_jar ()).get_mapstack_set (),
                (get_baselevel_pkg_etc_defs_jar ()).get_mapstack_set ()
              );

        fun run_thunk_in_compiler_state
                (thunk, compiler_state)
            =
            {   old_stack =  *compiler_state_stack;

                compiler_state_stack
                    :=
                    (compiler_state, (!) old_stack);

                thunk ()
                before
                    compiler_state_stack :=  old_stack;
            };

        fun list_bound_symbols ()
            =
            syx::symbols (
                syx::atop (
                     ((get_top_level_pkg_etc_defs_jar ()).get_mapstack_set ()).symbolmapstack,
                     ((get_baselevel_pkg_etc_defs_jar ()).get_mapstack_set ()).symbolmapstack
                )
            );
    };
end;