PreviousUpNext

15.4.588  src/lib/compiler/front/semantic/pickle/unpickler-junk.pkg

## unpickler-junk.pkg
#
# See comments in    src/lib/compiler/front/semantic/pickle/unpickler-junk.api

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



stipulate
    package acf =  anormcode_form;                                                      # anormcode_form                is from   src/lib/compiler/back/top/anormcode/anormcode-form.pkg
    package cos =  compile_statistics;                                                  # compile_statistics            is from   src/lib/compiler/front/basics/stats/compile-statistics.pkg
    package cty =  ctypes;                                                              # ctypes                        is from   src/lib/compiler/back/low/ccalls/ctypes.pkg
    package di  =  debruijn_index;                                                      # debruijn_index                is from   src/lib/compiler/front/typer/basics/debruijn-index.pkg
    package ed  =  stamppath::module_stamp_map;                                         # stamppath                     is from   src/lib/compiler/front/typer-stuff/modules/stamppath.pkg
    package hbo =  highcode_baseops;                                                    # highcode_baseops              is from   src/lib/compiler/back/top/highcode/highcode-baseops.pkg
    package hbt =  highcode_basetypes;                                                  # highcode_basetypes            is from   src/lib/compiler/back/top/highcode/highcode-basetypes.pkg
    package hut =  highcode_uniq_types;                                                 # highcode_uniq_types           is from   src/lib/compiler/back/top/highcode/highcode-uniq-types.pkg
    package hct =  highcode_type;                                                       # highcode_type                 is from   src/lib/compiler/back/top/highcode/highcode-type.pkg
    package im  =  inlining_mapstack;                                                   # inlining_mapstack             is from   src/lib/compiler/toplevel/compiler-state/inlining-mapstack.pkg
    package ip  =  inverse_path;                                                        # inverse_path                  is from   src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg
    package ij  =  inlining_junk;                                                       # inlining_junk                 is from   src/lib/compiler/front/semantic/basics/inlining-junk.pkg
    package mld =  module_level_declarations;                                           # module_level_declarations     is from   src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg
    package ph  =  picklehash;                                                          # picklehash                    is from   src/lib/compiler/front/basics/map/picklehash.pkg
    package sp  =  symbol_path;                                                         # symbol_path                   is from   src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg
    package sta =  stamp;                                                               # stamp                         is form   src/lib/compiler/front/typer-stuff/basics/stamp.pkg
    package stx =  stampmapstack;                                                       # stampmapstack                 is from   src/lib/compiler/front/typer-stuff/modules/stampmapstack.pkg
    package syx =  symbolmapstack;                                                      # symbolmapstack                is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg
    package sxe =  symbolmapstack_entry;                                                # symbolmapstack_entry          is from   src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack-entry.pkg
    package sy  =  symbol;                                                              # symbol                        is from   src/lib/compiler/front/basics/map/symbol.pkg
    package ty  =  types;                                                               # types                         is from   src/lib/compiler/front/typer-stuff/types/types.pkg
    package upr =  unpickler;                                                           # unpickler                     is from   src/lib/compiler/src/library/unpickler.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

    package   unpickler_junk
    : (weak)  Unpickler_Junk                                                            # Unpickler_Junk                is from   src/lib/compiler/front/semantic/pickle/unpickler-junk.api
    {
        Unpickling_Context
            =
            Null_Or( (Int, sy::Symbol) )   ->   stx::Stampmapstack;


        exception FORMAT = upr::FORMAT;



        # The order of the entries in the following
        # tables must be coordinated with
        #
        #     src/lib/compiler/front/semantic/pickle/pickler-junk.pkg
        #
        baseop_table
            =
             #[ hbo::MAKE_EXCEPTION_TAG,
                #
                hbo::WRAP,
                hbo::UNWRAP,
                #
                hbo::GET_RW_VECSLOT_CONTENTS,
                hbo::GET_RO_VECSLOT_CONTENTS,
                hbo::GET_RW_VECSLOT_CONTENTS_AFTER_BOUNDS_CHECK,
                hbo::GET_RO_VECSLOT_CONTENTS_AFTER_BOUNDS_CHECK,
                hbo::MAKE_RW_VECTOR_MACRO,

                hbo::POINTER_EQL,
                hbo::POINTER_NEQ,
                hbo::POLY_EQL,
                hbo::POLY_NEQ,
                hbo::IS_BOXED,
                hbo::IS_UNBOXED,
                hbo::VECTOR_LENGTH_IN_SLOTS,
                hbo::HEAPCHUNK_LENGTH_IN_WORDS,
                hbo::CAST,
                hbo::GET_RUNTIME_ASM_PACKAGE_RECORD,
                hbo::MARK_EXCEPTION_WITH_STRING,
                hbo::GET_EXCEPTION_HANDLER_REGISTER,
                hbo::SET_EXCEPTION_HANDLER_REGISTER,
                hbo::GET_CURRENT_THREAD_REGISTER,
                hbo::SET_CURRENT_THREAD_REGISTER,
                hbo::PSEUDOREG_GET,
                hbo::PSEUDOREG_SET,
                hbo::SETMARK,
                hbo::DISPOSE,
                hbo::MAKE_REFCELL,
                hbo::CALLCC,
                hbo::CALL_WITH_CURRENT_CONTROL_FATE,
                hbo::THROW,
                hbo::GET_REFCELL_CONTENTS,
                hbo::SET_REFCELL,
                hbo::SET_VECSLOT,
                hbo::SET_VECSLOT_AFTER_BOUNDS_CHECK,
                hbo::SET_VECSLOT_TO_BOXED_VALUE,
                hbo::SET_VECSLOT_TO_TAGGED_INT_VALUE,

                hbo::GET_BATAG_FROM_TAGWORD,
                hbo::MAKE_WEAK_POINTER_OR_SUSPENSION,
                hbo::SET_STATE_OF_WEAK_POINTER_OR_SUSPENSION,
                hbo::GET_STATE_OF_WEAK_POINTER_OR_SUSPENSION,
                hbo::USELVAR,
                hbo::DEFLVAR,
                hbo::NOT_MACRO,
                hbo::COMPOSE_MACRO,
                hbo::BEFORE_MACRO,
                hbo::ALLOCATE_RW_VECTOR_MACRO,
                hbo::ALLOCATE_RO_VECTOR_MACRO,
                hbo::MAKE_ISOLATED_FATE,
                hbo::WCAST,
                hbo::MAKE_ZERO_LENGTH_VECTOR,
                hbo::GET_VECTOR_DATACHUNK,
                hbo::GET_RECSLOT_CONTENTS,
                hbo::GET_RAW64SLOT_CONTENTS,
                hbo::SET_REFCELL_TO_TAGGED_INT_VALUE,
                hbo::RAW_CCALL NULL,
                hbo::IGNORE_MACRO,
                hbo::IDENTITY_MACRO,
                hbo::CVT64
              ];


        compare_op_table
            =
            #[hbo::GT, hbo::GE, hbo::LT, hbo::LE, hbo::LEU, hbo::LTU, hbo::GEU, hbo::GTU, hbo::EQL, hbo::NEQ];


        math_op_table
            =
            #[hbo::ADD, hbo::SUBTRACT, hbo::MULTIPLY, hbo::DIVIDE, hbo::NEGATE, hbo::ABS, hbo::LSHIFT, hbo::RSHIFT, hbo::RSHIFTL,
              hbo::BITWISE_AND, hbo::BITWISE_OR, hbo::BITWISE_XOR, hbo::BITWISE_NOT, hbo::FSQRT, hbo::FSIN, hbo::FCOS, hbo::FTAN,
              hbo::REM, hbo::DIV, hbo::MOD];


        equality_property_table
            =
            #[ ty::eq_type::YES,
               ty::eq_type::NO,
               ty::eq_type::INDETERMINATE,
               ty::eq_type::CHUNK,
               ty::eq_type::DATA,
               ty::eq_type::EQ_ABSTRACT,
               ty::eq_type::UNDEF
            ];


        c_type_table
            =
            #[cty::VOID,
              cty::FLOAT,
              cty::DOUBLE,
              cty::LONG_DOUBLE,
              cty::UNSIGNED cty::CHAR,
              cty::UNSIGNED cty::SHORT,
              cty::UNSIGNED cty::INT,
              cty::UNSIGNED cty::LONG,
              cty::UNSIGNED cty::LONG_LONG,
              cty::SIGNED cty::CHAR,
              cty::SIGNED cty::SHORT,
              cty::SIGNED cty::INT,
              cty::SIGNED cty::LONG,
              cty::SIGNED cty::LONG_LONG,
              cty::PTR];

        #
        fun &&& c (x, t)
            =
            (c x, t);

        #
        fun modtree_branch l
            =
            loop (l, [])
            where
                fun loop ([], [x])                                =>   x;
                    loop ([], result)                             =>   mld::MODTREE_BRANCH  result;
                    #
                    loop (mld::MODTREE_BRANCH  [] ! rest, result) =>   loop (rest,     result);
                    loop (mld::MODTREE_BRANCH [x] ! rest, result) =>   loop (rest, x ! result);                 # Cannot happen.
                    loop (                     x  ! rest, result) =>   loop (rest, x ! result);
                end;
            end;


        no_modtree =   mld::MODTREE_BRANCH [];

        #
        fun make_shared_stuff  (unpickler,  highcode_variable)
            =
            { read_picklehash,
              read_string,
              read_symbol,
              read_varhome,
              read_valcon_form,
              read_constructor_signature,
              read_baseop,
              read_list_of_bools,
              read_null_or_int,
              read_type_kind,
              read_list_of_typekinds
            }
            where
                fun read_sharable_value  sharemap  read_value
                    =
                    upr::read_sharable_value   unpickler   sharemap   read_value;

                #
                fun read_unsharable_value f
                    =
                    upr::read_unsharable_value  unpickler  f;


                read_int  =  upr::read_int   unpickler;
                read_bool =  upr::read_bool  unpickler;
                #
                fun read_list    m r = upr::read_list    unpickler m r;
                fun read_null_or m r = upr::read_null_or unpickler m r;

                read_string =   upr::read_string unpickler;
                read_symbol =   symbol_and_picklehash_unpickling::read_symbol   (unpickler, read_string);


                # These maps will all acquire different
                # types by being used in different contexts...

                varhome_sharemap                        =  upr::make_sharemap ();
                valcon_sharemap                         =  upr::make_sharemap ();

                constructor_signature_sharemap          =  upr::make_sharemap ();
                number_kind_and_bitsize_sharemap        =  upr::make_sharemap ();
                baseop_sharemap                         =  upr::make_sharemap ();
                list_of_bools_sharemap                  =  upr::make_sharemap ();
                null_or_bool_sharemap                   =  upr::make_sharemap ();
                type_kind_sharemap                      =  upr::make_sharemap ();
                list_of_typekinds_sharemap              =  upr::make_sharemap ();
                ctype_sharemap                          =  upr::make_sharemap ();
                c_type_list_sharemap                    =  upr::make_sharemap ();
                ccall_type_list_sharemap                =  upr::make_sharemap ();
                null_or_c_call_type_sharemap            =  upr::make_sharemap ();
                ccall_info_sharemap                     =  upr::make_sharemap ();
                io_m                                    =  upr::make_sharemap ();

                read_list_of_bools =  read_list     list_of_bools_sharemap     read_bool;
#               read_null_or_bool  =  read_null_or  null_or_bool_sharemap   read_bool;
                read_null_or_int   =  read_null_or  io_m  read_int;

                read_picklehash =  symbol_and_picklehash_unpickling::read_picklehash (unpickler, read_string);

                #
                fun read_varhome ()
                    =
                    read_sharable_value  varhome_sharemap  read_varhome'
                    where
                        fun read_varhome' 'A' =>   highcode_variable (read_int ());
                            read_varhome' 'B' =>   vh::EXTERN (read_picklehash ());
                            read_varhome' 'C' =>   vh::PATH (read_varhome (), read_int ());
                            read_varhome' 'D' =>   vh::NO_VARHOME;
                            read_varhome' _   =>   raise exception FORMAT;
                        end;
                    end;

                #
                fun read_valcon_form ()
                    =
                    read_sharable_value   valcon_sharemap   cr
                    where
                        fun cr 'A' =>   vh::UNTAGGED;
                            cr 'B' =>   vh::TAGGED (read_int ());
                            cr 'C' =>   vh::TRANSPARENT;
                            cr 'D' =>   vh::CONSTANT (read_int ());
                            cr 'E' =>   vh::REFCELL_REP;
                            cr 'F' =>   vh::EXCEPTION (read_varhome ());
                            cr 'G' =>   vh::LISTCONS;
                            cr 'H' =>   vh::LISTNIL;
                            cr 'I' =>   vh::SUSPENSION NULL;
                            cr 'J' =>   vh::SUSPENSION (THE (read_varhome (), read_varhome ()));
                            #
                            cr _   =>   raise exception FORMAT;
                        end;
                    end;

                #
                fun read_constructor_signature ()
                    =
                    read_sharable_value  constructor_signature_sharemap  cs
                    where
                        fun cs 'S'   =>   vh::CONSTRUCTOR_SIGNATURE (read_int (), read_int ());
                            cs 'N'   =>   vh::NULLARY_CONSTRUCTOR;
                            cs _     =>   raise exception FORMAT;
                        end;
                    end;

                #
                fun read_type_kind ()
                    =
                    read_sharable_value  type_kind_sharemap  tk
                    where
                        fun tk 'A'   =>   hct::plaintype_uniqkind;
                            tk 'B'   =>   hct::boxedtype_uniqkind;
                            tk 'C'   =>   hct::make_kindseq_uniqkind (read_list_of_typekinds ());
                            tk 'D'   =>   hct::make_kindfun_uniqkind (read_list_of_typekinds (), read_type_kind ());
                            tk _     =>   raise exception FORMAT;
                        end;
                    end


                also
                fun read_list_of_typekinds ()
                    =
                    read_list  list_of_typekinds_sharemap  read_type_kind  ();

                #
                fun read_number_kind_and_bitsize ()
                    =
                    read_sharable_value  number_kind_and_bitsize_sharemap  nk
                    where
                        fun nk 'A'   =>   hbo::INT   (read_int ());
                            nk 'B'   =>   hbo::UNT   (read_int ());
                            nk 'C'   =>   hbo::FLOAT (read_int ());
                            nk _     =>   raise exception FORMAT;
                        end;
                    end;

                #
                fun read_math_op ()
                    =
                    read_unsharable_value ao
                    where
                        fun ao c
                            =
                            vector::get (math_op_table, char::to_int c)
                            except
                                (exceptions::SUBSCRIPT|exceptions::INDEX_OUT_OF_BOUNDS) = raise exception FORMAT;
                    end;

                #
                fun read_compare_op ()
                    =
                    {   fun co c
                            =
                            vector::get (compare_op_table, char::to_int c)
                            except
                                (exceptions::SUBSCRIPT|exceptions::INDEX_OUT_OF_BOUNDS) =  raise exception FORMAT;

                        read_unsharable_value  co;
                    };

                #
                fun read_c_type ()
                    =
                    read_sharable_value  ctype_sharemap  ct
                    where       
                        fun ct '\020' =>   cty::ARRAY (read_c_type (), read_int ());
                            ct '\021' =>   cty::STRUCT (read_c_type_list ());
                            ct '\022' =>   cty::UNION  (read_c_type_list ());
                            ct c      =>   vector::get (c_type_table, char::to_int c)
                                           except
                                               (exceptions::SUBSCRIPT|exceptions::INDEX_OUT_OF_BOUNDS) =  raise exception FORMAT;
                        end;
                    end


                also
                fun read_c_type_list ()
                    =
                    read_list  c_type_list_sharemap  read_c_type  ();

                #
                fun read_c_call_type ()
                    =
                    read_unsharable_value  ct
                    where
                        fun ct '\000' =>   hbo::CCI32;
                            ct '\001' =>   hbo::CCI64;
                            ct '\002' =>   hbo::CCR64;
                            ct '\003' =>   hbo::CCML;
                            #
                            ct _      =>   raise exception FORMAT;
                        end;
                    end

                also
                fun read_c_call_type_list ()
                    =
                    read_list  ccall_type_list_sharemap  read_c_call_type  ()


                also
                fun read_null_or_c_call_type ()
                    =
                    read_null_or  null_or_c_call_type_sharemap  read_c_call_type  ();

                #
                fun read_c_call_info ()
                    =
                    read_sharable_value  ccall_info_sharemap  cp
                    where
                        fun cp 'C'
                            =>
                            {   c_prototype =>    { calling_convention => read_string (),
                                                    return_type        => read_c_type (),
                                                    parameter_types    => read_c_type_list ()
                                                  },
                                ml_argument_representations =>  read_c_call_type_list (),
                                ml_result_representation    =>  read_null_or_c_call_type (),
                                is_reentrant                =>  read_bool ()
                            };

                            cp _   =>   raise exception FORMAT;
                        end;
                    end;

                #
                fun read_baseop ()
                    =
                    read_sharable_value  baseop_sharemap  po
                    where
                        fun po '\100' =>   hbo::MATH { op => read_math_op (), overflow => read_bool (), kindbits => read_number_kind_and_bitsize () };
                            po '\101' =>   hbo::CMP   { op => read_compare_op (),                       kindbits => read_number_kind_and_bitsize () };
                            po '\102' =>   hbo::SHRINK_INT   (read_int (), read_int ());
                            po '\103' =>   hbo::SHRINK_UNT   (read_int (), read_int ());
                            po '\104' =>   hbo::CHOP         (read_int (), read_int ());
                            po '\105' =>   hbo::STRETCH      (read_int (), read_int ());
                            po '\106' =>   hbo::COPY         (read_int (), read_int ());
                            po '\107' =>   hbo::LSHIFT_MACRO  (read_number_kind_and_bitsize ());
                            po '\108' =>   hbo::RSHIFT_MACRO  (read_number_kind_and_bitsize ());
                            po '\109' =>   hbo::RSHIFTL_MACRO (read_number_kind_and_bitsize ());
                            po '\110' =>   hbo::ROUND { floor => read_bool (), from => read_number_kind_and_bitsize (), to => read_number_kind_and_bitsize () };
                            po '\111' =>   hbo::CONVERT_FLOAT                { from => read_number_kind_and_bitsize (), to => read_number_kind_and_bitsize () };
                            po '\112' =>   hbo::GET_VECSLOT_NUMERIC_CONTENTS { kindbits => read_number_kind_and_bitsize (), checked => read_bool (), immutable => read_bool () };
                            po '\113' =>   hbo::SET_VECSLOT_TO_NUMERIC_VALUE { kindbits => read_number_kind_and_bitsize (), checked => read_bool () };
                            po '\114' =>   hbo::ALLOCATE_NUMERIC_RW_VECTOR_MACRO (read_number_kind_and_bitsize ());
                            po '\115' =>   hbo::ALLOCATE_NUMERIC_RO_VECTOR_MACRO (read_number_kind_and_bitsize ());
                            po '\116' =>   hbo::GET_FROM_NONHEAP_RAM (read_number_kind_and_bitsize ());
                            po '\117' =>   hbo::SET_NONHEAP_RAM (read_number_kind_and_bitsize ());
                            po '\118' =>   hbo::RAW_CCALL (THE (read_c_call_info ()));
                            po '\119' =>   hbo::RAW_ALLOCATE_C_RECORD { fblock => read_bool () };
                            po '\120' =>   hbo::MIN_MACRO (read_number_kind_and_bitsize ());
                            po '\121' =>   hbo::MAX_MACRO (read_number_kind_and_bitsize ());
                            po '\122' =>   hbo::ABS_MACRO (read_number_kind_and_bitsize ());
                            po '\123' =>   hbo::SHRINK_INTEGER     (read_int ());
                            po '\124' =>   hbo::CHOP_INTEGER       (read_int ());
                            po '\125' =>   hbo::STRETCH_TO_INTEGER (read_int ());
                            po '\126' =>   hbo::COPY_TO_INTEGER    (read_int ());
                            po c      =>   vector::get (baseop_table, char::to_int c)
                                           except
                                               (exceptions::SUBSCRIPT|exceptions::INDEX_OUT_OF_BOUNDS) =  raise exception FORMAT;
                        end;
                    end;
            end;                                                                                # fun make_shared_stuff


        #
        fun make_symbolmapstack_unpickler
                #
                extra_info
                unpickler_info
                unpickling_context
            =
            read_symbolmapstack
            where       
                extra_info ->  { get_global_picklehash, shared_stuff, is_lib };

                unpickler_info ->  { unpickler, read_list_of_strings };
                    

                stipulate
                    fun get find (m, i)
                        =
                        case (find (unpickling_context m, i))
                            #
                            THE x => x;
                            #   
                            NULL =>
                                {   error_message::impossible "unpickler_junk: stub lookup failed";
                                    raise exception FORMAT;
                                };
                        esac;
                herein

                    find_plain_typ_record_by_typestamp  =  get  stx::find_plain_typ_record_by_typestamp;
                    find_api_record_by_apistamp                 =  get  stx::find_api_record_by_apistamp;
                    find_typechecked_package_by_packagestamp    =  get  stx::find_typechecked_package_by_packagestamp;
                    find_typechecked_generic_by_genericstamp    =  get  stx::find_typechecked_generic_by_genericstamp;
                    find_typerstore_record_by_typerstorestamp           =  get  stx::find_typerstore_record_by_typerstorestamp;
                end;
                #
                fun read_list      sharemap   read_value =   upr::read_list     unpickler   sharemap   read_value;
                fun read_null_or   sharemap   read_value =   upr::read_null_or  unpickler   sharemap   read_value;

                read_bool =   upr::read_bool   unpickler;
                read_int  =   upr::read_int    unpickler;
                #
                fun read_pair  sharemap  read_a  read_b
                    =
                    upr::read_pair  unpickler  sharemap  read_a  read_b;


                #
                fun read_sharable_value   sharemap  read_value =   upr::read_sharable_value    unpickler   sharemap   read_value;
                fun read_unsharable_value           read_value =   upr::read_unsharable_value  unpickler              read_value;


                # The following maps acquire different types
                # by being used in different contexts:
                #
                stamp_sharemap                                          = upr::make_sharemap ();
                packagestamp_sharemap                                   = upr::make_sharemap ();
                genericstamp_sharemap                                   = upr::make_sharemap ();
                null_or_stamp_sharemap                                  = upr::make_sharemap ();
                list_stamp_sharemap                                     = upr::make_sharemap ();
                null_or_symbol_sharemap                                 = upr::make_sharemap ();
                list_of_symbols_sharemap                                = upr::make_sharemap ();
                list_symbol_path_sharemap                               = upr::make_sharemap ();
                list_list_symbol_path_sharemap                          = upr::make_sharemap ();
                valcon_sharemap                                         = upr::make_sharemap ();
                typ_kind_sharemap                                       = upr::make_sharemap ();
                datatype_info_sharemap                                  = upr::make_sharemap ();
                datatype_family_sharemap                                = upr::make_sharemap ();
                datatype_member_sharemap                                = upr::make_sharemap ();
                list_datatype_member_sharemap                           = upr::make_sharemap ();
                name_form_domain_sharemap                               = upr::make_sharemap ();
                list_name_form_domain_sharemap                          = upr::make_sharemap ();
                typ_sharemap                                            = upr::make_sharemap ();
                typ_list_sharemap                                       = upr::make_sharemap ();
                type_sharemap                                           = upr::make_sharemap ();
                null_or_type_sharemap                                   = upr::make_sharemap ();
                list_type_sharemap                                      = upr::make_sharemap ();
                inlining_info_sharemap                                  = upr::make_sharemap ();
                var_sharemap                                            = upr::make_sharemap ();
                package_definition_sharemap                             = upr::make_sharemap ();
                api_sharemap                                            = upr::make_sharemap ();
                generic_api_sharemap                                    = upr::make_sharemap ();
                spec_sharemap                                           = upr::make_sharemap ();
                typerstore_sharemap                                     = upr::make_sharemap ();
                generic_closure_sharemap                                = upr::make_sharemap ();
                package_sharemap                                        = upr::make_sharemap ();
                generic_sharemap                                        = upr::make_sharemap ();
                stamp_expression_sharemap                               = upr::make_sharemap ();
                typ_expression_sharemap                         = upr::make_sharemap ();
                package_expression_sharemap                             = upr::make_sharemap ();
                generic_expression_sharemap                             = upr::make_sharemap ();
                module_expression_sharemap                              = upr::make_sharemap ();
                module_declaration_sharemap                             = upr::make_sharemap ();
                typechecked_package_dictionary_sharemap                 = upr::make_sharemap ();
                typechecked_package_sharemap                            = upr::make_sharemap ();
                typechecked_generic_sharemap                            = upr::make_sharemap ();
                fixity_sharemap                                         = upr::make_sharemap ();
                naming_sharemap                                         = upr::make_sharemap ();
                elements_sharemap                                       = upr::make_sharemap ();
                list_of_bound_generic_evaluation_paths_sharemap         = upr::make_sharemap ();
                null_or_bound_generic_evaluation_paths_sharemap         = upr::make_sharemap ();
                spec_def_sharemap                                       = upr::make_sharemap ();
                list_inlining_info_sharemap                             = upr::make_sharemap ();
                overload_sharemap                                       = upr::make_sharemap ();
                list_overload_sharemap                                  = upr::make_sharemap ();
                list_typechecked_package_declaration_sharemap           = upr::make_sharemap ();
                typechecked_package_dictionary_sharemap'                = upr::make_sharemap ();
                symbolmapstack_sharemap                                 = upr::make_sharemap ();
                symbol_path_sharemap                                    = upr::make_sharemap ();
                inverse_path_sharemap                                   = upr::make_sharemap ();
                pair_symbol_spec_sharemap                               = upr::make_sharemap ();
                pair__stamppath__type_kind__sharemap                    = upr::make_sharemap ();
                pair__package_definition__int__sharemap                 = upr::make_sharemap ();
                pair__module_stamp__typerstore_entry__sharemap          = upr::make_sharemap ();
                pair_symbol_naming_sharemap                             = upr::make_sharemap ();
                null_or_picklehash_sharemap                             = upr::make_sharemap ();
                null_or_lib_mod_spec_sharemap                           = upr::make_sharemap ();
                pair_int_symbol_sharemap                                = upr::make_sharemap ();


                shared_stuff
                    ->
                    { read_picklehash,
                      read_string,
                      read_symbol,
                      read_varhome,
                      read_valcon_form,
                      read_constructor_signature,
                      read_null_or_int,
                      read_baseop,
                      read_list_of_bools,
                      read_type_kind,
                      read_list_of_typekinds
                    };

                #
                fun read_lib_mod_spec ()
                    =
                    read_null_or  null_or_lib_mod_spec_sharemap  (read_pair  pair_int_symbol_sharemap  (read_int, read_symbol))  ();

                #
                fun read_stamp ()
                    =
                    read_sharable_value  stamp_sharemap  st
                    where
                        fun st 'A'   =>   sta::make_global_stamp
                                            {
                                              picklehash =>   get_global_picklehash (),
                                              count      =>   read_int ()
                                            };

                            st 'B'   =>   sta::make_global_stamp
                                            {
                                              picklehash =>   read_picklehash (),
                                              count      =>   read_int ()
                                            };

                            st 'C'   =>   sta::make_stale_stamp (read_string ());

                            st _     =>   raise exception FORMAT;
                        end;
                    end;    

                read_typestamp =   read_stamp;
                read_apistamp  =   read_stamp;

                #
                fun read_packagestamp ()
                    =
                    read_sharable_value  packagestamp_sharemap  si
                    where
                        fun si 'D' =>  { an_api              =>  read_stamp (),
                                         typechecked_package =>  read_stamp ()
                                        };
                            si _   =>  raise exception FORMAT;
                        end;
                    end;

                #
                fun read_genericstamp ()
                    =
                    read_sharable_value  genericstamp_sharemap  fifi
                    where
                        #
                        fun fifi 'E' => { parameter_api       => read_stamp (),
                                          body_api            => read_stamp (),
                                          typechecked_generic => read_stamp ()
                                        };
                            fifi _ => raise exception FORMAT;
                        end;
                    end;


                read_typerstorestamp = read_stamp;

                read_list_of_stamps     =   read_list           list_stamp_sharemap             read_stamp;
                read_null_or_stamp      =   read_null_or        null_or_stamp_sharemap          read_stamp;
                read_null_or_picklehash =   read_null_or        null_or_picklehash_sharemap     read_picklehash;

                read_module_stamp                    =   read_stamp;
                read_null_or_typechecked_package_var =   read_null_or_stamp;
                read_stamppath                       =   read_list_of_stamps;

                read_list_of_symbols =   read_list      list_of_symbols_sharemap        read_symbol;
                read_null_or_symbol  =   read_null_or   null_or_symbol_sharemap read_symbol;

                #
                fun read_symbol_path ()
                    =
                    read_sharable_value  symbol_path_sharemap  sp
                    where
                        fun sp 's'   =>   sp::SYMBOL_PATH (read_list_of_symbols ());
                            sp _     =>   raise exception FORMAT;
                        end;
                    end;

                #
                fun read_inverse_path ()
                    =
                    read_sharable_value  inverse_path_sharemap  ip
                    where
                        fun ip 'i'   =>   ip::INVERSE_PATH (read_list_of_symbols ());
                            ip _     =>   raise exception FORMAT;
                        end;
                    end;


                read_list_of_symbolpaths       =   read_list  list_symbol_path_sharemap       read_symbol_path;
                read_list_of_lists_of_symbolpaths   =   read_list  list_list_symbol_path_sharemap  read_list_of_symbolpaths;

                read_label       =   read_symbol;
                read_list_of_labels   =   read_list_of_symbols;

                #
                fun read_equality_property ()
                    =
                    read_unsharable_value  eqp
                    where
                        fun eqp c
                            =
                            vector::get (equality_property_table, char::to_int c)
                            except
                                (exceptions::SUBSCRIPT|exceptions::INDEX_OUT_OF_BOUNDS) =  raise exception FORMAT;
                    end;

                #
                fun read_datatyp' ()
                    =
                    read_sharable_value   valcon_sharemap   d
                    where
                        fun d 'c'
                            =>
                            {   name     =  read_symbol ();
                                is_constant =  read_bool ();

                                (read_type' ()) ->   (type, ttr);

                                form      =  read_valcon_form ();
                                signature =  read_constructor_signature ();
                                is_lazy   =  read_bool ();

                                (  ty::VALCON
                                       {
                                         name,
                                         is_constant,
                                         type,
                                         form,
                                         signature,
                                         is_lazy
                                       },
                                   ttr
                                );
                            };

                           d _ => raise exception FORMAT;
                        end;
                    end

                also
                fun read_typ_kind ()
                    =
                    read_sharable_value   typ_kind_sharemap   tk
                    where
                        fun tk 'a'
                                =>
                                ty::BASE (read_int ());

                            tk 'b'
                                =>
                                {   index =   read_int ();
                                    root  =   read_null_or_typechecked_package_var ();

                                    my (stamps, family, free_typs)
                                        =
                                        read_datatype_info ();

                                    ty::DATATYPE
                                        {
                                          index,
                                          root,
                                          stamps,
                                          family,
                                          free_typs
                                        };
                                };

                            tk 'c'   =>   ty::ABSTRACT (read_typ ());
                            tk 'd'   =>   ty::FORMAL;
                            tk 'e'   =>   ty::TEMP;
                            tk _     =>   raise exception FORMAT;
                         end;
                    end

                also
                fun read_datatype_info ()
                    =
                    read_sharable_value  datatype_info_sharemap  dti
                    where
                        fun dti 'a'
                                =>
                                (vector::from_list (read_list_of_stamps ()), read_datatype_family (), read_list_typ ());

                            dti _
                                =>
                                raise exception FORMAT;
                        end;
                    end


                also
                fun read_datatype_family ()
                    =
                    read_sharable_value  datatype_family_sharemap  dtf
                    where
                        fun dtf 'b'
                            =>
                            {   mkey          =>  read_stamp (),
                                members       =>  vector::from_list (read_list_datatype_member ()),
                                property_list =>  property_list::make_property_list ()
                            };

                           dtf _   =>   raise exception FORMAT;
                        end;
                    end


                also
                fun read_datatype_member ()
                    =
                    read_sharable_value   datatype_member_sharemap   d
                    where
                        fun d 'c'
                            =>
                            { typ_name      =>  read_symbol (),
                              constructor_list =>  read_list_name_form_domain (),
                              arity            =>  read_int (),
                              eqtype_info          =>  REF (read_equality_property ()),
                              is_lazy          =>  read_bool (),
                              an_api           =>  read_constructor_signature ()
                            };

                            d _ => raise exception FORMAT;
                        end;
                    end


                also
                fun read_list_datatype_member ()
                    =
                    read_list  list_datatype_member_sharemap  read_datatype_member  ()


                also
                fun read_name_form_domain ()
                    =
                    read_sharable_value  name_form_domain_sharemap  n
                    where
                        fun n 'd'
                            =>
                            { name   =>  read_symbol (),
                              form   =>  read_valcon_form (),
                              domain =>  read_null_or_type ()
                            };

                           n _ => raise exception FORMAT;
                        end;
                    end


                also
                fun read_list_name_form_domain ()
                    =
                    read_list   list_name_form_domain_sharemap   read_name_form_domain   ()


                also
                fun read_typ ()
                    =
                    read_sharable_value  typ_sharemap  typeconstructor
                    where
                        fun typeconstructor 'A'
                                =>
                                ty::PLAIN_TYP
                                    (find_plain_typ_record_by_typestamp
                                        ( read_lib_mod_spec (),
                                          read_typestamp ()
                                        )
                                    );

                            typeconstructor 'B'
                                =>
                                ty::PLAIN_TYP
                                    {
                                      stamp   =>  read_stamp (),
                                      arity   =>  read_int (),
                                      eqtype_info =>  REF (read_equality_property ()),
                                      kind    =>  read_typ_kind (),
                                      path    =>  read_inverse_path (),
                                      stub    =>  THE { owner => if is_lib  read_picklehash ();
                                                                 else       get_global_picklehash ();
                                                                 fi,
                                                      is_lib
                                                    }
                                    };

                            typeconstructor 'C'
                                =>
                                ty::DEFINED_TYP
                                    {
                                      stamp       =>   read_stamp (),
                                      type_scheme =>   ty::TYPE_SCHEME { arity =>  read_int (),
                                                                         body  =>  read_type ()
                                                                       },
                                      strict =>  read_list_of_bools (),
                                      path   =>  read_inverse_path ()
                                    };

                            typeconstructor 'D'
                                =>
                                ty::TYP_BY_STAMPPATH
                                    {
                                      arity       =>  read_int (),
                                      stamppath =>  read_stamppath (),
                                      path        =>  read_inverse_path ()
                                    };

                            typeconstructor 'E' =>  ty::RECORD_TYP  (read_list_of_labels ());
                            typeconstructor 'F' =>  ty::RECURSIVE_TYPE (read_int ());
                            typeconstructor 'G' =>  ty::FREE_TYPE      (read_int ());
                            typeconstructor 'H' =>  ty::ERRONEOUS_TYP;
                            typeconstructor _   =>  raise exception FORMAT;
                        end;

                    end


                also
                fun read_typ' ()
                    =
                    (typ, modtree)
                    where
                        typ  =   read_typ ();

                        modtree =   case typ
                                        #
                                        ty::PLAIN_TYP  plain_typ_record =>   mld::PLAIN_TYP_MODTREE_NODE  plain_typ_record;
                                        _                               =>   no_modtree;
                                    esac;
                    end


                also
                fun read_list_typ ()
                    =
                    read_list  typ_list_sharemap  read_typ  ()


                also
                fun read_type' ()
                    =
                    read_sharable_value  type_sharemap  read_type''
                    where
                        #
                        fun read_type''  'a'                                                                    # TYPCON_TYPE
                            =>
                            {   (read_typ' ()) ->   (typ, typ_modtree);

                                (read_list_type' ()) ->   (typelist, typelist_modtrees);

                                ( ty::TYPCON_TYPE (typ, typelist),
                                  modtree_branch [typ_modtree, typelist_modtrees]
                                );
                            };

                            read_type''  'b'   =>   (ty::TYPE_SCHEME_ARG_I (read_int ()),  no_modtree);         # TYPE_SCHEME_ARG_I

                            read_type''  'c'   =>   (ty::WILDCARD_TYPE,                    no_modtree);         # WILDCARE_TYPE

                            read_type''  'd'                                                                    # TYPE_SCHEME_TYPE
                                =>
                                {   (read_list_of_bools ()) ->  eqprops;
                                    (read_int ())           ->  arity;
                                    (read_type' ())         ->  (body, body_modtree);

                                    ( ty::TYPE_SCHEME_TYPE
                                        {
                                          type_scheme_arg_eq_properties =>  eqprops,
                                          type_scheme                   =>  ty::TYPE_SCHEME { arity, body }
                                        },
                                      #
                                      body_modtree
                                    );
                                };

                            read_type''  'e' =>   (ty::UNDEFINED_TYPE, no_modtree);                             # UNDEFINED_TYPE

                            read_type''   _  =>   raise exception FORMAT;
                        end;
                    end


                also
                fun read_type ()
                    =
                    #1 (read_type' ())


                also
                fun read_null_or_type ()
                    =
                    read_null_or  null_or_type_sharemap  read_type  ()

                                                                                                # paired_lists          is from   src/lib/std/src/paired-lists.pkg
                also
                fun read_list_type' ()
                    =
                    {   my (types, type_modtrees)
                            =
                            paired_lists::unzip                                                 # [(a,a'), (b,b'), (c,c')]   ->   ([a, b, c], [a', b', c'])
                                (read_list  list_type_sharemap  read_type' ());

                       (types, modtree_branch type_modtrees);
                    }

                also
                fun read_inlining_data ()
                    =
                    read_sharable_value  inlining_info_sharemap  ii
                    where
                        fun ii 'A'   =>   ij::make_baseop_inlining_data  (read_baseop (), read_type ());
                            ii 'B'   =>   ij::make_package_inlining_data (read_list_inlining_data ());
                            ii 'C'   =>   ij::null_inlining_data;
                            ii _     =>   raise exception FORMAT;
                        end;
                    end


                also
                fun read_list_inlining_data ()
                    =
                    read_list  list_inlining_info_sharemap   read_inlining_data ()


                also
                fun read_var' ()
                    =
                    read_sharable_value  var_sharemap  read_var''
                    where
                        fun read_var''  '1' =>                                                                                  # ORDINARY_VARIABLE
                                {   varhome       =  read_varhome ();
                                    inlining_data =  read_inlining_data ();
                                    path          =  read_symbol_path ();

                                    (read_type' ()) ->   (var_type, type_modtree);

                                    ( vac::ORDINARY_VARIABLE { varhome, inlining_data, path, var_type => REF var_type },
                                      type_modtree
                                    );
                                };

                            read_var''  '2' =>                                                                                  # OVERLOADED_IDENTIFIER
                                {   (read_symbol ())                      ->   name;
                                    (read_list_overloaded_identifier' ()) ->   (alternatives, alternatives_modtrees);
                                    (read_int ())                         ->   arity;
                                    (read_type' ())                       ->   (body, body_modtree);

                                    ( vac::OVERLOADED_IDENTIFIER
                                        { name,
                                          alternatives =>  REF alternatives,
                                          type_scheme  =>  ty::TYPE_SCHEME { arity, body }
                                        },

                                      modtree_branch [alternatives_modtrees, body_modtree]
                                    );
                                };

                            read_var''  '3'   =>   (vac::ERRORVAR, no_modtree);
                            read_var''  _     =>   raise exception FORMAT;
                        end;
                    end

                also
                fun read_overld' ()
                    =
                    read_sharable_value   overload_sharemap   read_overld''
                    where
                        fun read_overld''  'o'
                                =>
                                {   (read_type' ()) ->   (indicator, type_modtree);
                                    (read_var'  ()) ->   (variant,   var_modtree);

                                    ( { indicator, variant },
                                      modtree_branch [type_modtree, var_modtree]
                                    );
                                };

                            read_overld'' _
                                =>
                                raise exception FORMAT;
                        end;
                    end


                also
                fun read_list_overloaded_identifier' ()
                    =
                    {   my (overloaded_identifiers, modtrees)
                            =
                            paired_lists::unzip
                                (read_list  list_overload_sharemap  read_overld' ());

                        ( overloaded_identifiers,                                       # : List { indicator, variant }
                          modtree_branch modtrees
                        );
                    };


                fun read_package_definition ()
                    =
                    read_sharable_value   package_definition_sharemap   sd
                    where
                        fun sd 'C'   =>   mld::CONSTANT_PACKAGE_DEFINITION (read_a_package ());
                            sd 'V'   =>   mld::VARIABLE_PACKAGE_DEFINITION (read_an_api (), read_stamppath ());
                            sd _     =>   raise exception FORMAT;
                        end;
                    end


                also
                fun read_an_api' ()
                    =
                    read_sharable_value  api_sharemap  read_an_api''
                    where
                        #
                        fun read_an_api''  'A' => (mld::ERRONEOUS_API, no_modtree);

                            read_an_api''  'B'
                                =>
                                {   api_record
                                        =
                                        find_api_record_by_apistamp  (read_lib_mod_spec (),  read_apistamp ());

                                    ( mld::API               api_record,
                                      mld::API_MODTREE_NODE  api_record
                                    );
                                };

                            read_an_api''  'C'
                                =>
                                {   stamp            =   read_stamp ();
                                    name             =   read_null_or_symbol ();
                                    closed           =   read_bool ();
                                    contains_generic =   read_bool ();
                                    symbols          =   read_list_of_symbols ();

                                    my (api_elements, element_modtrees)
                                        =
                                        paired_lists::unzip
                                            (map (fn (symbol, (sp, tr)) =  ((symbol, sp), tr))
                                                 (read_list elements_sharemap
                                                  (read_pair pair_symbol_spec_sharemap (read_symbol, read_spec')) ()));

                                    bound_generic_evaluation_paths
                                        =
                                        read_null_or  null_or_bound_generic_evaluation_paths_sharemap
                                            #
                                            (read_list  list_of_bound_generic_evaluation_paths_sharemap
                                                #
                                                (read_pair   pair__stamppath__type_kind__sharemap
                                                    #
                                                    (read_stamppath, read_type_kind)
                                            )   )
                                            ();

                                    type_sharing    =  read_list_of_lists_of_symbolpaths ();
                                    package_sharing =  read_list_of_lists_of_symbolpaths ();

                                    api_record
                                      =
                                      { stamp,
                                        name,
                                        closed,
                                        contains_generic,
                                        symbols,
                                        api_elements,
                                        #
                                        property_list => property_list::make_property_list (),
                                        #
                                        #  Boundeps = REF beps, 
                                        #  lambdaty = REF NULL, 
                                        #
                                        type_sharing,
                                        package_sharing,
                                        #
                                        stub => THE {   modtree =>  modtree_branch  element_modtrees,
                                                        is_lib,
                                                        owner   => if is_lib    read_picklehash ();
                                                                   else         get_global_picklehash  ();
                                                                   fi
                                                    }
                                      };

                                    package_property_lists::set_api_bound_generic_evaluation_paths
                                      (
                                        api_record,
                                        bound_generic_evaluation_paths
                                      );

                                    ( mld::API                api_record,
                                      mld::API_MODTREE_NODE   api_record
                                    );
                                };

                            read_an_api''  _
                                =>
                                raise exception FORMAT;
                        end;
                    end


                also
                fun read_an_api ()
                    =
                    #1 (read_an_api' ())

                also
                fun read_generic_api' ()
                    =
                    read_sharable_value   generic_api_sharemap   read_generic_api''
                    where
                        fun read_generic_api''  'a' => (mld::ERRONEOUS_GENERIC_API, no_modtree);
                            #
                            read_generic_api''  'c' =>
                                 {   (read_null_or_symbol ()) ->  kind;
                                     (read_an_api'        ()) ->  (parameter_api, parameter_api_modtree);
                                     (read_module_stamp   ()) ->  parameter_variable;
                                     (read_null_or_symbol ()) ->  parameter_symbol;
                                     (read_an_api'        ()) ->  (body_api, body_api_modtree);

                                     ( mld::GENERIC_API { kind,
                                                          parameter_api,
                                                          parameter_variable,
                                                          parameter_symbol,
                                                          body_api
                                                        },
                                        #
                                       modtree_branch [parameter_api_modtree, body_api_modtree]
                                    );
                                 };

                            read_generic_api'' _
                                =>
                                raise exception FORMAT;
                        end;
                    end

                also
                fun read_spec' ()                                               # "spec" generally means anything in an API.
                    =
                    read_sharable_value  spec_sharemap  read_spec''
                    where
                        fun read_spec''  '1'
                                =>
                                {   (read_typ' ()) ->   (typ, typ_modtree);
                                    #
                                    ( mld::TYP_IN_API { typ,
                                                           module_stamp =>  read_module_stamp (),
                                                           is_a_replica =>  read_bool (),
                                                           scope        =>  read_int ()
                                                         },
                                        typ_modtree
                                    );
                                };

                            read_spec''  '2'
                                =>
                                {   (read_an_api' ()) ->   (an_api, api_modtree);
                                    #
                                    ( mld::PACKAGE_IN_API { an_api,
                                                            slot         =>  read_int (),
                                                            definition   =>  read_null_or  spec_def_sharemap  (read_pair pair__package_definition__int__sharemap (read_package_definition, read_int)) (),
                                                            module_stamp =>  read_module_stamp ()
                                                          },
                                      api_modtree
                                    );
                                };

                            read_spec''  '3'
                                =>
                                {   (read_generic_api' ()) ->   (a_generic_api, generic_api_modtree);
                                    #
                                    ( mld::GENERIC_IN_API { a_generic_api,
                                                            slot          =>  read_int (),
                                                             module_stamp =>  read_module_stamp ()
                                                          },
                                      generic_api_modtree
                                    );
                                };

                            read_spec''  '4'
                               =>
                               {    (read_type' ()) ->   (type, type_modtree);
                                    #
                                    ( mld::VALUE_IN_API { type, slot => read_int () },
                                      type_modtree
                                    );
                               };

                            read_spec''  '5'
                                =>
                                {   (read_datatyp' ()) ->   (datatype, datatype_modtree);
                                    #
                                    ( mld::VALCON_IN_API { datatype,
                                                                     slot => read_null_or_int ()
                                                                   },
                                      datatype_modtree
                                    );
                                };

                           read_spec'' _   =>   raise exception FORMAT;
                        end;
                    end

                also
                fun read_typerstore_entry' ()
                    =
                    read_sharable_value   typerstore_sharemap   read_typerstore_entry''
                    where
                        fun read_typerstore_entry''  'A'   =>   &&& mld::TYP_ENTRY  (read_typechecked_typ'  ());
                            read_typerstore_entry''  'B'   =>   &&& mld::PACKAGE_ENTRY (read_typechecked_package' ());
                            read_typerstore_entry''  'C'   =>   &&& mld::GENERIC_ENTRY (read_typechecked_generic' ());
                            read_typerstore_entry''  'D'   =>   (mld::ERRONEOUS_ENTRY, no_modtree);
                            read_typerstore_entry''  _     =>   raise exception FORMAT;
                        end;
                    end

                also
                fun read_generic_closure' ()
                    =
                    read_sharable_value   generic_closure_sharemap   f
                    where
                        fun f 'f'
                            =>
                            {   (read_module_stamp        ()) ->    parameter_module_stamp;
                                (read_package_expression' ()) ->   (body_package_expression, body_modtree);
                                (read_typerstore'         ()) ->   (typerstore,              typerstore_modtree);

                                ( mld::GENERIC_CLOSURE { parameter_module_stamp,
                                                         body_package_expression,
                                                         typerstore
                                                       },
                                  modtree_branch [body_modtree, typerstore_modtree]
                                );
                            };

                            f _ => raise exception FORMAT;
                        end;
                    end

                # The construction of the PACKAGE_MODTREE_NODE in the Modtree deserves some
                # comment:  Even though it contains the whole Package_Record, it does
                # _not_ take care of the an_api contained therein.  The reason
                # why PACKAGE_MODTREE_NODE has the whole Package_Record and not just the Typechecked_Package that
                # it really guards is that the identity of the Typechecked_Package is not
                # fully recoverable without also having access to the an_api.
                # The same situation occurs in the case of GENERIC_MODTREE_NODE.

                also
                fun read_a_package' ()
                    =
                    read_sharable_value   package_sharemap   read_a_package''
                    where
                        fun read_a_package'' 'A'
                            =>
                            {   (read_an_api' ()) ->   (an_api, api_modtree);
                                #
                                ( mld::PACKAGE_API { an_api, stamppath => read_stamppath () },
                                  api_modtree
                                );
                            };

                           read_a_package''  'B' => (mld::ERRONEOUS_PACKAGE, no_modtree);
                           read_a_package''  'C'
                                =>
                                {   (read_an_api' ()) ->   (an_api, api_modtree);
                                    #
                                    package_record
                                      =
                                      { an_api,
                                        typechecked_package =>  find_typechecked_package_by_packagestamp (read_lib_mod_spec (), read_packagestamp ()),
                                        varhome             =>  read_varhome (),
                                        inlining_data       =>  read_inlining_data ()
                                      };

                                    ( mld::A_PACKAGE                                         package_record,
                                      modtree_branch [api_modtree, mld::PACKAGE_MODTREE_NODE package_record]
                                    );
                                };

                           read_a_package''  'D'
                                =>
                                {   (read_an_api' ()) ->   (an_api, api_modtree);
                                    #
                                    package_record
                                      =
                                      { an_api,
                                        typechecked_package =>  read_typechecked_package (),
                                        varhome             =>  read_varhome (),
                                        inlining_data       =>  read_inlining_data ()
                                      };

                                    ( mld::A_PACKAGE                                         package_record,
                                      modtree_branch [api_modtree, mld::PACKAGE_MODTREE_NODE package_record]
                                    );
                                };

                           read_a_package''  _ => raise exception FORMAT;
                        end;
                    end

                also
                fun read_a_package ()
                    =
                    #1 (read_a_package' ())

                also
                fun read_a_generic' ()
                    =
                    read_sharable_value   generic_sharemap   read_a_generic''
                    where
                        # See the comment about PACKAGE_MODTREE_NODE, Package_Record,
                        # an_api, and Typechecked_Package in front of a_package'.
                        #  The situation for GENERIC_MODTREE_NODE, Generic_Record,
                        # generic_api, and Typechecked_Generic is analogous.
                        #
                        fun read_a_generic''  'E' => (mld::ERRONEOUS_GENERIC, no_modtree);
                            read_a_generic''  'F'
                                =>
                                {   (read_generic_api' ()) ->   (a_generic_api, api_modtree) ;
                                    #
                                    generic_record
                                      = 
                                      { a_generic_api,
                                        typechecked_generic =>  find_typechecked_generic_by_genericstamp (read_lib_mod_spec (), read_genericstamp ()),
                                        varhome             =>  read_varhome (),
                                        inlining_data       =>  read_inlining_data ()
                                      };

                                    ( mld::GENERIC                                           generic_record,
                                      modtree_branch [api_modtree, mld::GENERIC_MODTREE_NODE generic_record]
                                    );
                                };

                            read_a_generic''  'G'
                                =>
                                {   (read_generic_api' ()) ->   (a_generic_api, api_modtree);
                                    #
                                    generic_record
                                      = 
                                      { a_generic_api,
                                        typechecked_generic =>  read_typechecked_generic (),
                                        varhome             =>  read_varhome (),
                                        inlining_data       =>  read_inlining_data ()
                                      };

                                    ( mld::GENERIC                                           generic_record,
                                      modtree_branch [api_modtree, mld::GENERIC_MODTREE_NODE generic_record]
                                    );
                                };

                            read_a_generic''  _ =>  raise exception FORMAT;
                        end;
                    end

                also
                fun read_stamp_expression ()
                    =
                    read_sharable_value   stamp_expression_sharemap   sxe
                    where
                        fun sxe 'b' =>   mld::GET_STAMP (read_package_expression ());
                            sxe 'c' =>   mld::MAKE_STAMP;
                            sxe _   =>   raise exception FORMAT;
                        end;
                    end

                also
                fun read_typ_expression' ()
                    =
                    read_sharable_value   typ_expression_sharemap   tce
                    where
                        fun tce 'd' =>   &&& mld::CONSTANT_TYP (read_typ' ());
                            tce 'e' =>   (mld::FORMAL_TYP (read_typ ()), no_modtree);                   #  ? 
                            tce 'f' =>   (mld::TYPE_VARIABLE_TYP (read_stamppath ()), no_modtree);
                            tce _   =>   raise exception FORMAT;
                        end;
                    end

                also
                fun read_typ_expression ()   =   #1 (read_typ_expression' ())

                also
                fun read_package_expression' ()
                    =
                    read_sharable_value   package_expression_sharemap   pkg_exp
                    where
                        fun pkg_exp 'g' =>    (mld::VARIABLE_PACKAGE (read_stamppath ()), no_modtree);
                            pkg_exp 'h' => &&& mld::CONSTANT_PACKAGE (read_typechecked_package' ());

                            pkg_exp 'i'
                                =>
                                {   (read_stamp_expression    ()) ->   stamp;
                                    (read_module_declaration' ()) ->   (module_declaration, declaration_modtree);
                                    #
                                    ( mld::PACKAGE { stamp, module_declaration },
                                      declaration_modtree
                                    );
                                };

                            pkg_exp 'j'
                                =>
                                {   (read_generic_expression' ()) ->   (generic_expression, generic_modtree);
                                    (read_package_expression' ()) ->   (package_expression, package_modtree);
                                    #
                                    ( mld::APPLY     (generic_expression, package_expression),
                                      modtree_branch [generic_modtree,    package_modtree]
                                    );
                                };

                            pkg_exp 'k'
                                =>
                                {   (read_module_declaration' ()) ->   (declaration, declaration_modtree);
                                    (read_package_expression' ()) ->   (expression,  expression_modtree);
                                    #
                                    ( mld::PACKAGE_LET { declaration, expression },
                                      modtree_branch [declaration_modtree, expression_modtree]
                                    );
                                };

                            pkg_exp 'l'
                                =>
                                {   (read_an_api'             ()) ->  (an_api, api_modtree);
                                    (read_package_expression' ()) ->  (expression, expression_modtree);
                                    #
                                    ( mld::ABSTRACT_PACKAGE (an_api, expression),
                                      modtree_branch [api_modtree, expression_modtree]
                                    );
                                };

                            pkg_exp 'm'
                                =>
                                {   (read_module_stamp        ()) ->   boundvar;
                                    (read_package_expression' ()) ->   (raw,      raw_modtree);
                                    (read_package_expression' ()) ->   (coercion, coercion_modtree);

                                    ( mld::COERCED_PACKAGE { boundvar, raw, coercion },
                                      modtree_branch [raw_modtree, coercion_modtree]
                                    );
                                };

                            pkg_exp 'n' => &&& mld::FORMAL_PACKAGE (read_generic_api' ());
                            pkg_exp _   => raise exception FORMAT;
                        end;
                    end

                also
                fun read_package_expression ()
                    =
                    #1 (read_package_expression' ())

                also
                fun read_generic_expression' ()
                    =
                    read_sharable_value   generic_expression_sharemap   fe
                    where
                        fun fe 'o' => (mld::VARIABLE_GENERIC (read_stamppath ()), no_modtree);
                            fe 'p' => &&& mld::CONSTANT_GENERIC (read_typechecked_generic' ());

                            fe 'q'
                                =>
                                {   (read_module_stamp        ()) ->   parameter;
                                    (read_package_expression' ()) ->   (body, body_modtree);

                                    ( mld::LAMBDA { parameter, body },
                                      body_modtree
                                    );
                                };

                            fe 'r'
                                =>
                                {   (read_module_stamp        ()) ->   parameter;
                                    (read_package_expression' ()) ->   (body,   body_modtree);
                                    (read_generic_api'        ()) ->   (an_api, api_modtree);

                                    (mld::LAMBDA_TP { parameter, body, an_api },
                                     modtree_branch [body_modtree, api_modtree]);
                                };

                            fe 's'
                                =>
                                {   (read_module_declaration' ()) ->  (module_declaration, declaration_modtree);
                                    (read_generic_expression' ()) ->  (generic_expression, generic_modtree    );
                                    #
                                    ( mld::LET_GENERIC (module_declaration, generic_expression),
                                      modtree_branch [declaration_modtree, generic_modtree]
                                    );
                                };

                            fe _ => raise exception FORMAT;
                        end;
                    end

                also
                fun read_generic_expression ()   =   #1 (read_generic_expression' ())

                also
                fun read_module_expression ()
                    =
                    read_sharable_value   module_expression_sharemap   ee
                    where
                        fun ee 't'   =>   mld::TYP_EXPRESSION  (read_typ_expression  ());
                            ee 'u'   =>   mld::PACKAGE_EXPRESSION (read_package_expression ());
                            ee 'v'   =>   mld::GENERIC_EXPRESSION (read_generic_expression ());

                            ee 'w'   =>   mld::ERRONEOUS_ENTRY_EXPRESSION;
                            ee 'x'   =>   mld::DUMMY_GENERIC_EVALUATION_EXPRESSION;
                            ee _     =>   raise exception FORMAT;
                        end;
                    end

                also
                fun read_module_declaration' ()
                    =
                    read_sharable_value   module_declaration_sharemap   ed
                    where
                        fun ed 'A'
                                =>
                                {   (read_module_stamp       ()) ->   stamp;
                                    (read_typ_expression' ()) ->   (typ_expression, expression_modtree);
                                    #
                                    ( mld::TYP_DECLARATION (stamp, typ_expression),
                                      expression_modtree
                                    );
                                };

                            ed 'B'
                                =>
                                {   (read_module_stamp        ()) ->   stamp;
                                    (read_package_expression' ()) ->   (package_expression, package_expression_modtree);
                                    (read_symbol              ()) ->   symbol;
                                    #
                                    ( mld::PACKAGE_DECLARATION (stamp, package_expression, symbol),
                                      package_expression_modtree
                                    );
                                };

                            ed 'C'
                                =>
                                {   (read_module_stamp        ()) ->   stamp;
                                    (read_generic_expression' ()) ->   (generic_expression, generic_expression_modtree);
                                    #
                                    ( mld::GENERIC_DECLARATION (stamp, generic_expression),
                                      generic_expression_modtree
                                    );
                                };

                            ed 'D' => &&& mld::SEQUENTIAL_DECLARATIONS (read_typechecked_package_dec_list' ());

                            ed 'E' =>
                                {   (read_module_declaration' ()) ->   (declaration1, modtree1);
                                    (read_module_declaration' ()) ->   (declaration2, modtree2);
                                    #
                                    ( mld::LOCAL_DECLARATION (declaration1, declaration2),
                                      modtree_branch [modtree1, modtree2]
                                    );
                                };

                            ed 'F'   =>   (mld::ERRONEOUS_ENTRY_DECLARATION,          no_modtree);
                            ed 'G'   =>   (mld::EMPTY_GENERIC_EVALUATION_DECLARATION, no_modtree);
                            ed _     =>   raise exception FORMAT;
                        end;
                    end

                also
                fun read_typechecked_package_dec_list' ()
                    =
                    {   my (l, trl)
                            =
                            paired_lists::unzip (read_list  list_typechecked_package_declaration_sharemap   read_module_declaration' ());

                        (l, modtree_branch trl);
                    }

                also
                fun read_typerstore' ()
                    =
                    read_sharable_value   typechecked_package_dictionary_sharemap   eenv
                    where
                        fun eenv 'A'
                                =>
                                {   l =  read_list  typechecked_package_dictionary_sharemap'
                                             (read_pair  pair__module_stamp__typerstore_entry__sharemap
                                                 (read_module_stamp, read_typerstore_entry')
                                             )
                                             ();

                                    l' =   map   (fn (v, (e, tr)) =  ((v, e), tr))   l;

                                    (paired_lists::unzip l') ->   (l'', modtrees);
                                    #
                                    fun set ((v, e), z)
                                        =
                                        ed::set (z, v, e);

                                    typerstore_entry_map
                                        =
                                        fold_backward  set  ed::empty  l'';

                                    (read_typerstore' ()) ->   (typerstore, typerstore_modtree);
                                        

                                    ( mld::NAMED_TYPERSTORE  (typerstore_entry_map, typerstore),
                                      # 
                                      modtree_branch  (typerstore_modtree ! modtrees)
                                    );
                                };

                            eenv 'B' => (mld::NULL_TYPERSTORE,            no_modtree);
                            eenv 'C' => (mld::ERRONEOUS_ENTRY_DICTIONARY, no_modtree);

                            eenv 'D'
                                =>
                                {   typerstore_record
                                        =
                                        find_typerstore_record_by_typerstorestamp (read_lib_mod_spec (), read_typerstorestamp ());
                                    #
                                    ( mld::MARKED_TYPERSTORE        typerstore_record,
                                      mld::TYPERSTORE_MODTREE_NODE  typerstore_record
                                    );
                                };

                            eenv 'E'
                                =>
                                {   (read_stamp       ()) ->   stamp;
                                    (read_typerstore' ()) ->   (typerstore, modtree);

                                    typerstore_record
                                      =
                                      { stamp,
                                        typerstore,
                                        stub       => THE { modtree,
                                                            is_lib,
                                                            owner  => if is_lib  read_picklehash ();
                                                                      else       get_global_picklehash ();
                                                                      fi
                                                          }

                                      };

                                    ( mld::MARKED_TYPERSTORE        typerstore_record,
                                      mld::TYPERSTORE_MODTREE_NODE  typerstore_record
                                    );
                                };

                            eenv _ => raise exception FORMAT;
                        end;
                    end

                also
                fun read_typechecked_package' ()
                    =
                    read_sharable_value   typechecked_package_sharemap   read_typechecked_package''
                    where
                        fun read_typechecked_package''   's'
                                =>
                                {   (read_stamp ())       ->   stamp;
                                    (read_typerstore' ()) ->   (typerstore, modtree);

                                    typechecked_package
                                      =
                                      { stamp,
                                        typerstore,
                                        inverse_path     =>  read_inverse_path (),
                                        property_list    =>  property_list::make_property_list (),
                                        #
                                        stub => THE { modtree,
                                                      is_lib,
                                                      owner  =>  if is_lib  read_picklehash ();
                                                                 else       get_global_picklehash ();
                                                                 fi
                                                    }

                                       };

                                    ( typechecked_package,
                                      modtree
                                    );
                                };

                            read_typechecked_package''  _
                                =>
                                raise exception FORMAT;
                        end;
                    end

                also
                fun read_typechecked_package ()
                    =
                    #1 (read_typechecked_package' ())

                also
                fun read_typechecked_generic' ()
                    =
                    read_sharable_value   typechecked_generic_sharemap   read_typechecked_generic''
                    where
                        fun read_typechecked_generic''   'f'
                            =>
                            {   (read_stamp            ()) ->   stamp;
                                (read_generic_closure' ()) ->   (generic_closure, generic_closure_modtree);

                                typechecked_generic
                                  =
                                  { stamp,
                                    generic_closure,
                                    inverse_path    => read_inverse_path (),
                                    property_list   => property_list::make_property_list (),
                                    #  lambdaty = REF NULL, 
                                    typ_path => NULL,
                                    #
                                    stub => THE {   modtree =>  generic_closure_modtree,
                                                    is_lib,
                                                    owner   => if is_lib   read_picklehash ();
                                                               else        get_global_picklehash ();
                                                               fi
                                                }  
                                  };

                                ( typechecked_generic,
                                  generic_closure_modtree
                                );
                            };

                            read_typechecked_generic''  _
                                =>
                                raise exception FORMAT;
                        end;
                    end

                also
                fun read_typechecked_generic ()
                    =
                    #1 (read_typechecked_generic' ())

                also
                fun read_typechecked_typ' ()   =   read_typ' ();
                #
                fun read_fixity ()
                    =
                    read_sharable_value   fixity_sharemap   read_fixity''
                    where
                        fun read_fixity'' 'N'   =>   fixity::NONFIX;
                            read_fixity'' 'I'   =>   fixity::INFIX (read_int (), read_int ());
                            read_fixity'' _     =>   raise exception FORMAT;
                        end;
                    end;
                #
                fun read_symbolmapstack_entry' ()                                                                       # symbol table entry.
                    =
                    read_sharable_value   naming_sharemap   read_symbolmapstack_entry''
                    where
                        fun read_symbolmapstack_entry''  '1'   =>   &&& sxe::NAMED_VARIABLE       (read_var'            ());
                            read_symbolmapstack_entry''  '2'   =>   &&& sxe::NAMED_CONSTRUCTOR    (read_datatyp'        ());
                            read_symbolmapstack_entry''  '3'   =>   &&& sxe::NAMED_TYPE           (read_typ'            ());
                            read_symbolmapstack_entry''  '4'   =>   &&& sxe::NAMED_API            (read_an_api'         ());
                            read_symbolmapstack_entry''  '5'   =>   &&& sxe::NAMED_PACKAGE        (read_a_package'      ());
                            read_symbolmapstack_entry''  '6'   =>   &&& sxe::NAMED_GENERIC_API    (read_generic_api'    ());
                            read_symbolmapstack_entry''  '7'   =>   &&& sxe::NAMED_GENERIC        (read_a_generic'      ());
                            #
                            read_symbolmapstack_entry''  '8'   =>      (sxe::NAMED_FIXITY         (read_fixity          ()), no_modtree);
                            #
                            read_symbolmapstack_entry''  _     =>   raise exception FORMAT;
                        end;
                    end;
                #
                fun read_symbolmapstack ()
                    =
                    syx::consolidate  (fold_forward  bind  syx::empty  bindlist)
                    where
                        bindlist =   read_list  symbolmapstack_sharemap  (read_pair  pair_symbol_naming_sharemap  (read_symbol, read_symbolmapstack_entry'))  ();
                        #
                        fun bind ((symbol, (entry, modtree)), symbolmapstack)
                            =
                            syx::bind_full_entry (symbol, { entry, modtree => THE modtree }, symbolmapstack);
                    end;

            end;                                                                                #  fun make_symbolmapstack_unpickler 

        #
        fun unpickle_symbolmapstack
                #
               (unpickling_context:   Null_Or((Int, sy::Symbol))  ->  stx::Stampmapstack)       # Contains modtree info from combined symbol tables of all .compiled files our sourcefile depends upon.
                #
                ( picklehash:         ph::Picklehash,                                           # Hash (message digest) of 'pickle'.
                  pickle:             vector_of_one_byte_unts::Vector                                   # Pickled form of symbol table containing (only) info produced by compiling our particular sourcefile.
                )
            =
            {   unpickler
                    =
                    upr::make_unpickler
                        (upr::make_charstream_for_string
                            (byte::bytes_to_string  pickle));
                #
                fun an_import i
                    =
                    vh::PATH  (vh::EXTERN picklehash,  i);

                list_string_sharemap     =  upr::make_sharemap ();
                list_of_symbols_sharemap =  upr::make_sharemap ();

                shared_stuff =   make_shared_stuff (unpickler, an_import);

                read_list_of_strings =   upr::read_list unpickler   list_string_sharemap   shared_stuff.read_string;

                extra_info =  { get_global_picklehash =>   fn () =  picklehash,
                                shared_stuff,
                                is_lib => FALSE
                              };

                unpickler_info = { unpickler, read_list_of_strings };

                unpickle =   make_symbolmapstack_unpickler
                                extra_info
                                unpickler_info
                                unpickling_context;

                unpickle ();
            };

        #
        fun make_highcode_unpickler (unpickler, shared_stuff)
            =
            function_declaration
            where
                fun read_sharable_value  sharemap read_value =   upr::read_sharable_value  unpickler   sharemap   read_value;
                fun read_list            sharemap read_value =   upr::read_list            unpickler   sharemap   read_value;
                fun read_null_or         sharemap read_value =   upr::read_null_or         unpickler   sharemap   read_value;
                #
                fun read_pair  sharemap  fp  p
                    =
                    upr::read_pair  unpickler  sharemap  fp  p;

                read_int    = upr::read_int    unpickler;
                read_int1  = upr::read_int1  unpickler;
                read_unt    = upr::read_unt    unpickler;
                read_unt1  = upr::read_unt1  unpickler;
                read_bool   = upr::read_bool   unpickler;

                shared_stuff
                  ->
                  { read_picklehash,
                    read_string,
                    read_symbol,
                    read_varhome,
                    read_valcon_form,
                    read_constructor_signature,
                    read_baseop,
                    read_list_of_bools,
                    read_type_kind,
                    read_list_of_typekinds,
                    read_null_or_int
                  };

                lambda_type_sharemap            = upr::make_sharemap ();
                lambda_type_list_sharemap       = upr::make_sharemap ();
                typ_sharemap                    = upr::make_sharemap ();
                typ_list_sharemap               = upr::make_sharemap ();
                value_sharemap                  = upr::make_sharemap ();
                con_sharemap                    = upr::make_sharemap ();
                dcon_sharemap                   = upr::make_sharemap ();
                dictionary_sharemap             = upr::make_sharemap ();
                fprim_sharemap                  = upr::make_sharemap ();
                lambda_expression_sharemap      = upr::make_sharemap ();
                function_kind_sharemap          = upr::make_sharemap ();
                record_kind_sharemap            = upr::make_sharemap ();
                ltylo_m                         = upr::make_sharemap ();
                dictionary_table_sharemap       = upr::make_sharemap ();
                null_or_dictionary_sharemap     = upr::make_sharemap ();
                list_value_sharemap             = upr::make_sharemap ();
                list_lvar_sharemap              = upr::make_sharemap ();
                fundec_list_sharemap            = upr::make_sharemap ();
                con_list_sharemap               = upr::make_sharemap ();
                lexp_option_m                   = upr::make_sharemap ();
                function_declaration_sharemap   = upr::make_sharemap ();
                tfundec_sharemap                = upr::make_sharemap ();
                lv_lt_pm                        = upr::make_sharemap ();
                lv_lt_pl_sharemap               = upr::make_sharemap ();
                lv_tk_pm                        = upr::make_sharemap ();
                lv_tk_pl_sharemap               = upr::make_sharemap ();
                tyc_lv_pm                       = upr::make_sharemap ();
                #
                fun read_lambdatype ()
                    =
                    read_sharable_value  lambda_type_sharemap  read_lambdatype''
                    where
                        fun read_lambdatype''  'A' =>  hct::make_typ_uniqtype (read_typ ());
                            read_lambdatype''  'B' =>  hct::make_package_uniqtype (read_list_of_lambdatypes ());
                            read_lambdatype''  'C' =>  hct::make_generic_package_uniqtype (read_list_of_lambdatypes (), read_list_of_lambdatypes ());
                            read_lambdatype''  'D' =>  hct::make_typeagnostic_uniqtype (read_list_of_typekinds (), read_list_of_lambdatypes ());
                            #
                            read_lambdatype''  _   =>  raise exception FORMAT;
                        end;
                    end

                also
                fun read_list_of_lambdatypes ()
                    =
                    read_list   lambda_type_list_sharemap   read_lambdatype   ()

                also
                fun read_typ ()
                    =
                    read_sharable_value  typ_sharemap  read_typ''
                    where
                        fun read_typ''  'A'   =>   hct::make_debruijn_typevar_uniqtyp (di::di_fromint (read_int ()), read_int ());
                            read_typ''  'B'   =>   hct::make_named_typevar_uniqtyp (read_int ());
                            read_typ''  'C'   =>   hct::make_basetype_uniqtyp (hbt::basetype_from_int (read_int ()));
                            read_typ''  'D'   =>   hct::make_typefun_uniqtyp (read_list_of_typekinds (), read_typ ());
                            read_typ''  'E'   =>   hct::make_apply_typefun_uniqtyp (read_typ (), read_list_of_typs ());
                            read_typ''  'F'   =>   hct::make_typeseq_uniqtyp (read_list_of_typs ());
                            read_typ''  'G'   =>   hct::make_ith_in_typeseq_uniqtyp (read_typ (), read_int ());
                            read_typ''  'H'   =>   hct::make_sum_uniqtyp (read_list_of_typs ());
                            read_typ''  'I'   =>   hct::make_recursive_uniqtyp ((read_int (), read_typ (), read_list_of_typs ()), read_int ());
                            read_typ''  'J'   =>   hct::make_abstract_uniqtyp (read_typ ());
                            read_typ''  'K'   =>   hct::make_boxed_uniqtyp (read_typ ());
                            read_typ''  'L'   =>   hct::make_tuple_uniqtyp (read_list_of_typs ());
                            read_typ''  'M'   =>   hct::make_arrow_uniqtyp (hct::make_variable_calling_convention { arg_is_raw => read_bool (), body_is_raw => read_bool () }, read_list_of_typs (), read_list_of_typs ());
                            read_typ''  'N'   =>   hct::make_arrow_uniqtyp (hct::fixed_calling_convention, read_list_of_typs (), read_list_of_typs ());
                            read_typ''  'O'   =>   hut::typ_to_uniqtyp (hut::typ::EXTENSIBLE_TOKEN (hut::token_key (read_int ()), read_typ ()));
                            #
                            read_typ''  _     =>   raise exception FORMAT;
                        end;
                    end

                also
                fun read_list_of_typs ()    =   read_list  typ_list_sharemap  read_typ   ();

                read_highcode_variable =   read_int;
                read_list_lvar         =   read_list  list_lvar_sharemap   read_highcode_variable;
                #
                fun read_value ()
                    =
                    read_sharable_value  value_sharemap   read_value''
                    where
                        fun read_value''  'a' =>   acf::VAR     (read_highcode_variable ());
                            read_value''  'b' =>   acf::INT     (read_int    ());
                            read_value''  'c' =>   acf::INT1   (read_int1  ());
                            read_value''  'd' =>   acf::UNT     (read_unt    ());
                            read_value''  'e' =>   acf::UNT1   (read_unt1  ());
                            read_value''  'f' =>   acf::FLOAT64 (read_string ());
                            read_value''  'g' =>   acf::STRING  (read_string ());
                            #
                            read_value''  _   =>   raise exception FORMAT;
                        end;
                    end;

                read_list_value
                    =
                    read_list  list_value_sharemap  read_value;
                #
                fun con ()
                    =
                    read_sharable_value  con_sharemap  c
                    where
                        fun c '1'
                                =>
                                {   (dcon ()) ->  (dc, ts);

                                    ( acf::VAL_CASETAG (dc, ts, read_highcode_variable ()),
                                      lambda_expression ()
                                    );
                                };

                            c '2'   =>   (acf::INT_CASETAG     (read_int   ()),  lambda_expression ());
                            c '3'   =>   (acf::INT1_CASETAG   (read_int1 ()),  lambda_expression ());
                            c '4'   =>   (acf::UNT_CASETAG     (read_unt   ()),  lambda_expression ());
                            c '5'   =>   (acf::UNT1_CASETAG   (read_unt1 ()),  lambda_expression ());
                            c '6'   =>   (acf::FLOAT64_CASETAG (read_string()),  lambda_expression ());
                            c '7'   =>   (acf::STRING_CASETAG  (read_string()),  lambda_expression ());
                            c '8'   =>   (acf::VLEN_CASETAG    (read_int   ()),  lambda_expression ());
                            #
                            c _     =>   raise exception FORMAT;
                        end;
                    end


                also
                fun conlist ()
                    =
                    read_list  con_list_sharemap  con  ()


                also
                fun dcon ()
                    =
                    read_sharable_value  dcon_sharemap  d
                    where
                        fun d 'x'   =>   ((read_symbol (), read_valcon_form (), read_lambdatype ()), read_list_of_typs ());
                            d _     =>   raise exception FORMAT;
                        end;
                    end


                also
                fun dictionary ()
                    =
                    read_sharable_value  dictionary_sharemap  d
                    where
                        fun d 'y'
                              =>
                              { default =>  read_highcode_variable (),
                                table   =>  read_list   dictionary_table_sharemap  (read_pair  tyc_lv_pm  (read_list_of_typs, read_highcode_variable)) ()
                              };

                            d _ => raise exception FORMAT;
                        end;
                    end

                also
                fun fprim ()
                    =
                    read_sharable_value  fprim_sharemap  f
                    where
                        fun f 'z' => ( read_null_or   null_or_dictionary_sharemap   dictionary   (),
                                       read_baseop (),
                                       read_lambdatype (),
                                       read_list_of_typs ()
                                     );

                            f _ => raise exception FORMAT;
                        end;
                    end


                also
                fun lambda_expression ()
                    =
                    read_sharable_value  lambda_expression_sharemap  e
                    where
                        #
                        fun e 'j'   =>  acf::RET (read_list_value ());
                            e 'k'   =>  acf::LET (read_list_lvar (), lambda_expression (), lambda_expression ());
                            e 'l'   =>  acf::MUTUALLY_RECURSIVE_FNS (fundeclist (), lambda_expression ());
                            e 'm'   =>  acf::APPLY (read_value (), read_list_value ());
                            e 'n'   =>  acf::TYPEFUN (tfundec (), lambda_expression ());
                            e 'o'   =>  acf::APPLY_TYPEFUN (read_value (), read_list_of_typs ());
                            e 'p'   =>  acf::SWITCH (read_value (), read_constructor_signature (), conlist (), lexpoption ());

                            e 'q'   =>  {   (dcon ()) ->  (dc, ts);
                                            #
                                            acf::CONSTRUCTOR (dc, ts, read_value (), read_highcode_variable (), lambda_expression ());
                                        };

                            e 'r'   =>  acf::RECORD (record_kind (), read_list_value (), read_highcode_variable (), lambda_expression ());
                            e 's'   =>  acf::GET_FIELD (read_value (), read_int (), read_highcode_variable (), lambda_expression ());
                            e 't'   =>  acf::RAISE  (read_value (), read_list_of_lambdatypes ());
                            e 'u'   =>  acf::EXCEPT (lambda_expression (), read_value ());
                            e 'v'   =>  acf::BRANCH (fprim (), read_list_value (), lambda_expression (), lambda_expression ());
                            e 'w'   =>  acf::BASEOP (fprim (), read_list_value (), read_highcode_variable (), lambda_expression ());

                            e _     =>   raise exception FORMAT;
                        end;
                    end


                also
                fun lexpoption ()
                    =
                    read_null_or  lexp_option_m  lambda_expression  ()


                also
                fun function_declaration ()
                    =
                    read_sharable_value   function_declaration_sharemap   f
                    where
                        fun f 'a'
                            =>
                            (fkind (), read_highcode_variable (),
                             read_list   lv_lt_pl_sharemap   (read_pair   lv_lt_pm   (read_highcode_variable, read_lambdatype))   (),
                             lambda_expression ());

                            f _ => raise exception FORMAT;
                        end;
                    end

                also
                fun fundeclist ()
                    =
                    read_list  fundec_list_sharemap  function_declaration  ()

                also
                fun tfundec ()
                    =
                    read_sharable_value  tfundec_sharemap  t
                    where
                        fun t 'b'
                              =>
                              ( {   inlining_hint => acf::INLINE_IF_SIZE_SAFE   },
                                read_highcode_variable (),
                                read_list   lv_tk_pl_sharemap   (read_pair  lv_tk_pm  (read_highcode_variable, read_type_kind))  (),
                                lambda_expression ()
                              );

                            t _ => raise exception FORMAT;
                        end;
                    end


                also
                fun fkind ()
                    =
                    read_sharable_value  function_kind_sharemap  fk
                    where
                        fun aug_unknown x
                            =
                            (x, acf::OTHER_LOOP);
                        #
                        fun inlflag TRUE => acf::INLINE_WHENEVER_POSSIBLE;
                            inlflag FALSE => acf::INLINE_IF_SIZE_SAFE;
                        end;
                        #
                        fun fk '2' => { loop_info         =>  NULL,
                                        call_as           =>  acf::CALL_AS_GENERIC_PACKAGE,
                                        private =>  FALSE,
                                        inlining_hint     =>  acf::INLINE_IF_SIZE_SAFE
                                      };

                            fk '3' => { loop_info         =>  null_or::map aug_unknown (ltylistoption ()),
                                        call_as           =>  acf::CALL_AS_FUNCTION (hct::make_variable_calling_convention { arg_is_raw => read_bool (), body_is_raw => read_bool () }),
                                        private =>  read_bool (),
                                        inlining_hint     =>  inlflag (read_bool ())
                                      };

                            fk '4' => { loop_info         =>  null_or::map aug_unknown (ltylistoption ()),
                                        call_as           =>  acf::CALL_AS_FUNCTION  hct::fixed_calling_convention,
                                        private =>  read_bool (),
                                        inlining_hint     =>  inlflag (read_bool ())
                                      };

                            fk _ => raise exception FORMAT;
                        end;
                    end


                also
                fun ltylistoption ()
                    =
                    read_null_or  ltylo_m  read_list_of_lambdatypes  ()

                also
                fun record_kind ()
                    =
                    read_sharable_value  record_kind_sharemap  rk
                    where
                        fun rk '5'   =>   acf::RK_VECTOR (read_typ ());
                            rk '6'   =>   acf::RK_PACKAGE;
                            rk '7'   =>   anormcode_junk::rk_tuple;
                            #
                            rk _     =>   raise exception  FORMAT;
                        end;
                    end;
            end;

        #
        fun unpickle_highcode pickle
            =
            {   unpickler       =   upr::make_unpickler  (upr::make_charstream_for_string  (byte::bytes_to_string  pickle));
                shared_stuff    =   make_shared_stuff  (unpickler, vh::HIGHCODE_VARIABLE);

                highcode        =   make_highcode_unpickler (unpickler, shared_stuff);
                fo_m            =   upr::make_sharemap ();

                upr::read_null_or unpickler fo_m highcode ();
            };

        #
        fun make_unpicklers  unpickler_info  unpickling_context
            =
            # We get called (only) from:
            #
            #     src/app/makelib/freezefile/freezefile-g.pkg
            #
            {   unpickler_info ->  { unpickler, read_list_of_strings };

                shared_stuff =    make_shared_stuff (unpickler, vh::HIGHCODE_VARIABLE);

                shared_stuff ->   { read_symbol,
                                    read_picklehash,
                                    ...
                                  };

                list_of_symbols_sharemap  =   upr::make_sharemap ();
                read_list_of_symbols      =   upr::read_list  unpickler  list_of_symbols_sharemap  read_symbol;

                extra_info = { get_global_picklehash   =>    fn () = raise exception FORMAT,
                               shared_stuff,
                               is_lib         => TRUE
                             };

                read_symbolmapstack
                    =
                    make_symbolmapstack_unpickler
                        extra_info
                        unpickler_info
                        unpickling_context;

                highcode               =   make_highcode_unpickler (unpickler, shared_stuff);
                picklehash_highcode_pm =   upr::make_sharemap ();

                symbind    =   upr::read_pair unpickler  picklehash_highcode_pm   (read_picklehash, highcode);
                sbl_m      =   upr::make_sharemap ();
                sbl        =   upr::read_list  unpickler  sbl_m  symbind;
                #
                fun read_inlining_mapstack ()
                    =
                    im::from_listi (sbl ());

                { read_inlining_mapstack,
                  read_symbolmapstack,
                  read_symbol,
                  read_list_of_symbols
                };
            };


        unpickle_symbolmapstack
            =
            fn c = cos::do_compiler_phase
                       (cos::make_compiler_phase "Compiler 087 unpickle_symbolmapstack")
                       (unpickle_symbolmapstack c);
    };
end;




Comments and suggestions to: bugs@mythryl.org

PreviousUpNext