PreviousUpNext

15.4.54  src/app/makelib/compile/link-in-dependency-order-g.pkg

## link-in-dependency-order-g.pkg -- Link dagwalks.
#
#
# MOTIVATION
#
#     If package A references a type/fun/value in package B
#     then we say package A "depends upon" package B.
#
#     This is important during compiles, when we must
#     have access to type information from B in order
#     to compile A, and also during linking, when we
#     must remember to link in B before we link A
#     into a program.

#     We represent the detailed dependency relationships
#     between a set of modules using a dependency graph.
#     See 

#         src/app/makelib/depend/intra-library-dependency-graph.pkg

#     We also have less detailed dependency graphs
#     accurate only to the granularity of libraries: See
#
#         src/app/makelib/depend/inter-library-dependency-graph.pkg

#     We need to do two kinds of dagwalks over these graphs,
#     compile dagwalks and link dagwalks.

#     To achieve good separation of concerns, we implement
#     the mechanics of doing these dagwalks separately
#     from the code needing them done, and hide the
#     implementation details behind an abstract api.
#
#     Compile dagwalks are implemented in
#
#         src/app/makelib/compile/compile-in-dependency-order-g.pkg
#
#     Link dagwalks are implemented here.

# Compiled by:
#     src/app/makelib/makelib.sublib



###                             "I think you didn't get a reply
###                              because you used the terms "correct"
###                              and "proper", neither of which has
###                              much meaning in Perl culture. :-) "
###
###                                           -- Larry Wall



stipulate
    package ad  =  anchor_dictionary;                   # anchor_dictionary                     is from   src/app/makelib/paths/anchor-dictionary.pkg
    package cf  =  compiledfile;                        # compiledfile                          is from   src/lib/compiler/execution/compiledfile/compiledfile.pkg
    package lg  =  inter_library_dependency_graph;      # inter_library_dependency_graph        is from   src/app/makelib/depend/inter-library-dependency-graph.pkg
    package lt  =  linking_mapstack;                    # linking_mapstack                      is from   src/lib/compiler/execution/linking-mapstack/linking-mapstack.pkg
    package ms  =  makelib_state;                       # makelib_state                         is from   src/app/makelib/main/makelib-state.pkg
    package sym =  symbol_map;                          # symbol_map                            is from   src/app/makelib/stuff/symbol-map.pkg
    package tt  =  thawedlib_tome;                      # thawedlib_tome                        is from   src/app/makelib/compilable/thawedlib-tome.pkg
herein

    api Link_In_Dependency_Order {
        #
        #
        drop_thawedlib_tome_from_linker_map
            :
            ms::Makelib_State -> tt::Thawedlib_Tome -> Void;


        drop_stale_entries_from_linker_map:   Void -> Void;
            #
            # Check all values and drop
            # those that depended on other
            # dropped ones.

        cleanup
            :
            ms::Makelib_State -> Void;


        make_linking_dagwalk
            :
            ( lg::Inter_Library_Dependency_Graph,
              tt::Thawedlib_Tome -> cf::Compiledfile
            )
            ->
            { linking_mapstack
                  :
                  ms::Makelib_State
                  ->
                  Null_Or( lt::Picklehash_To_Heapchunk_Mapstack ),

              exports
                  :
                  sym::Map(   ms::Makelib_State -> Null_Or( lt::Picklehash_To_Heapchunk_Mapstack )   )
            };



        clear_state
            :
            Void -> Void;                                       #  Discard all persistent state 



        unshare                                                 #  Discard persistent state for a specific freezefile 
            :
            ad::File
            ->
            Void;
    };
end;




stipulate
    package ad  =  anchor_dictionary;                   # anchor_dictionary                     is from   src/app/makelib/paths/anchor-dictionary.pkg
    package cf  =  compiledfile;                        # compiledfile                          is from   src/lib/compiler/execution/compiledfile/compiledfile.pkg
    package err =  error_message;                       # error_message                         is from   src/lib/compiler/front/basics/errormsg/error-message.pkg
    package fil =  file__premicrothread;                # file__premicrothread                  is from   src/lib/std/src/posix/file--premicrothread.pkg
    package flt =  frozenlib_tome;                      # frozenlib_tome                        is from   src/app/makelib/freezefile/frozenlib-tome.pkg
    package ftm =  frozenlib_tome_map;                  # frozenlib_tome_map                    is from   src/app/makelib/freezefile/frozenlib-tome-map.pkg
    package im  =  int_map;                             # int_map                               is from   src/app/makelib/stuff/int-map.pkg
    package lg  =  inter_library_dependency_graph;      # inter_library_dependency_graph        is from   src/app/makelib/depend/inter-library-dependency-graph.pkg
    package lb  =  lib_base;                            # lib_base                              is from   src/lib/src/lib-base.pkg
    package lrp =  link_and_run_package;                # link_and_run_package                  is from   src/lib/compiler/execution/main/link-and-run-package.pkg
    package lt  =  linking_mapstack;                    # linking_mapstack                      is from   src/lib/compiler/execution/linking-mapstack/linking-mapstack.pkg
    package ms  =  makelib_state;                       # makelib_state                         is from   src/app/makelib/main/makelib-state.pkg
    package mz  =  memoize;                             # memoize                               is from   src/lib/std/memoize.pkg
    package pp  =  prettyprint;                         # prettyprint                           is from   src/lib/prettyprint/big/src/prettyprint.pkg
    package sg  =  intra_library_dependency_graph;      # intra_library_dependency_graph        is from   src/app/makelib/depend/intra-library-dependency-graph.pkg
    package shm =  sharing_mode;                        # sharing_mode                          is from   src/app/makelib/stuff/sharing-mode.pkg
    package spm =  source_path_map;                     # source_path_map                       is from   src/app/makelib/paths/source-path-map.pkg
    package sps =  source_path_set;                     # source_path_set                       is from   src/app/makelib/paths/source-path-set.pkg
    package sym =  symbol_map;                          # symbol_map                            is from   src/app/makelib/stuff/symbol-map.pkg
    package tlt =  thawedlib_tome;                      # thawedlib_tome                        is from   src/app/makelib/compilable/thawedlib-tome.pkg
    package ttm =  thawedlib_tome_map;                  # thawedlib_tome_map                    is from   src/app/makelib/compilable/thawedlib-tome-map.pkg
    package tts =  thawedlib_tome_set;                  # thawedlib_tome_set                    is from   src/app/makelib/compilable/thawedlib-tome-set.pkg
    package xns =  exceptions;                          # exceptions                            is from   src/lib/std/exceptions.pkg

    Linking_Mapstack =  lt::Picklehash_To_Heapchunk_Mapstack;   # Maps picklehashes to arbitrary heapchunks.

    Posmap        =  im::Map( Linking_Mapstack );               # Given the byte offset of a pickle in a freezefile, returns (picklehash, pickle) as a Linking_Mapstack.
herein

    # GENERIC INVOCATION CONTEXT:
    #
    #     Our generic is invoked (only) by
    #
    #         src/app/makelib/main/makelib-g.pkg
    #
    #
    #


    generic package   link_in_dependency_order_g   (
        #             ==========================
        #
        package thawedlib_tome__to__compiledfile__map
             :  Thawedlib_Tome__To__Compiledfile__Map;                                  # Thawedlib_Tome__To__Compiledfile__Map         is from   src/app/makelib/compile/thawedlib-tome--to--compiledfile-contents--map-g.pkg
        #
        seed_libraries_index__local:   Ref(  spm::Map(Posmap) );
    )
    : Link_In_Dependency_Order                                                          # Link_In_Dependency_Order                      is from   src/app/makelib/compile/link-in-dependency-order-g.pkg
    {
        exception LINK  Exception;

        package t2c =  thawedlib_tome__to__compiledfile__map;                           # Local abbreviation.

        Bfun =   ms::Makelib_State -> Linking_Mapstack -> Linking_Mapstack;             # Bfun = ... "binding function"?



        Frozenlib_Tome_Info
            =
            FROZENLIB_TOME_INFO
              (
                Bfun,
                flt::Frozenlib_Tome,
                List( Frozenlib_Tome_Info )
              );

        frozenlib_tome_info_map__local
            =
            REF (ftm::empty:   ftm::Map( Frozenlib_Tome_Info ));                        # XXX BUGGO FIXME: More mutable global state :( 



        Thawedlib_Tome_Info
            =
            ( Linking_Mapstack,
              List( tlt::Thawedlib_Tome )
            );

        thawedlib_tome_info_map__local                                                  #  XXX BUGGO FIXME: More mutable global state :( 
            =
            REF (ttm::empty:  ttm::Map( Thawedlib_Tome_Info ));



        #
        fun drop_thawedlib_tome_from_linker_map
                #
                (makelib_state:     ms::Makelib_State)
                #
                (thawedlib_tome: tlt::Thawedlib_Tome)
            =
            {   fun check ()
                    =
                    case (tlt::get_sharing_mode   thawedlib_tome)
                        #                     
                        shm::SHARE  TRUE
                            =>
                            tlt::error
                                makelib_state
                                thawedlib_tome
                                err::WARNING
                                (cat ["sharing for ", tlt::describe_thawedlib_tome  thawedlib_tome, " may be lost"])
                                err::null_error_body;

                        _ =>  ();
                    esac;
            
                (   thawedlib_tome_info_map__local
                        :=
                        #1 (ttm::drop (*thawedlib_tome_info_map__local, thawedlib_tome))
                    before
                       check ()
                )
                except
                    lb::NOT_FOUND = ();
            };

        #
        fun drop_stale_entries_from_linker_map ()                                       # Called (only) by   drop_stale_entries_from_compiler_and_linker_maps()   in   src/app/makelib/main/makelib-g.pkg
            =
            thawedlib_tome_info_map__local
                :=
                ttm::keyed_filter  (tlt::is_known o #1)  *thawedlib_tome_info_map__local;

        #
        fun cleanup makelib_state
            =
            {   visited =  REF  tts::empty;

                apply
                    (ignore o visit o #1)
                    (ttm::keyvals_list  *thawedlib_tome_info_map__local)

                where
                    fun visit  (tome:  tlt::Thawedlib_Tome)
                        =
                        if (tts::member (*visited, tome))
                            #
                            TRUE;
                        else
                            case (ttm::get (*thawedlib_tome_info_map__local, tome))
                                #                          
                                THE (_, list)
                                    =>
                                    {   bool_list =  map visit list;

                                        bool_val
                                            =
                                            list::all
                                                (fn x = x)
                                                bool_list;

                                        if bool_val
                                            #
                                            visited :=  tts::add (*visited, tome);
                                            TRUE;
                                        else
                                            drop_thawedlib_tome_from_linker_map  makelib_state  tome;
                                            FALSE;
                                        fi;
                                    };
                                #
                                NULL => FALSE;
                            esac;
                        fi;
                end;
            };
        #
        fun make_linking_dagwalk'                                                               # We do not call ourself recursively.
              (
                library_to_dagwalk  as  lg::LIBRARY { catalog, libfile, ... },
                #
                get_compiledfile:       tlt::Thawedlib_Tome -> cf::Compiledfile
              )
                =>
                {
# log::note .{ "make_linking_dagwalk'/AAA"; };
# printf "make_linking_dagwalk'/AAA\n";
                    fun exception_error (msg, error, descr, my_exception)
                        =
                        {   fun ppb pps
                                =
                                { pp::newline pps;
                                  pp::string  pps (xns::exception_message my_exception);
                                  pp::newline pps;
                                };

# printf "make_linking_dagwalk'/EXCEPTION_ERROR! %s %s <======================\n" msg descr;
                            error (cat [msg, " ", descr]) ppb;
                            raise exception LINK my_exception;
                        };

                    #
                    fun link_frozenlib_tome
                          (
                            tome:          flt::Frozenlib_Tome,
                            linking_mapstack: Linking_Mapstack
                          )
                        =
                        {
# log::note .{ "link_frozenlib_tome/AAA"; };
# printf "link_frozenlib_tome/AAA\n";
                            description =   flt::describe_frozenlib_tome  tome;                 # Something like  "$ROOT/src/lib/x-kit/xkit.lib@243309(src/color/rgb.pkg)"

# log::note .{ "link_frozenlib_tome/BBB"; };
# printf "link_frozenlib_tome/BBB\n";
                            error = tome.plaint_sink  err::ERROR;

# log::note .{ "link_frozenlib_tome/CCC"; };
# printf "link_frozenlib_tome/CCC  getting compiledfile '%s' from freezefile '%s'  offset 0x%x (%d)\n"  tome.api_or_pkg_file_path  tome.freezefile_name  tome.byte_offset_in_freezefile  tome.byte_offset_in_freezefile;
                            compiledfile
                                =
                                t2c::get_compiledfile_from_freezefile
                                    {
                                      freezefile_name =>  tome.freezefile_name,
                                      offset          =>  tome.byte_offset_in_freezefile,
                                      description
                                    }
                                    except
                                        exn =  exception_error ("Unable to load library module", error, description, exn);

# log::note .{ "link_frozenlib_tome/DDD"; };
# printf "link_frozenlib_tome/DDD calling cf::link_and_run_compiledfile\n";
result =
                            cf::link_and_run_compiledfile (compiledfile, linking_mapstack, LINK)
                            except
                                LINK exn = exception_error ("link-time exception in library code", error, description, exn);
# log::note .{ "link_frozenlib_tome/ZZZ"; };
# printf "link_frozenlib_tome/ZZZ back from calling cf::link_and_run_compiledfile\n";
result;
                        };


                    #
                    fun link_thawedlib_tome
                          (
                            makelib_state:        ms::Makelib_State,
                            thawedlib_tome:       tlt::Thawedlib_Tome,
                            get_compiledfile:     tlt::Thawedlib_Tome -> cf::Compiledfile,
                            get_linking_mapstack:         ms::Makelib_State -> Null_Or( lt::Picklehash_To_Heapchunk_Mapstack ),
                            thawedlib_tome_list:  List( tlt::Thawedlib_Tome )
                          )
                        =
                        {   fun fresh ()
                                =
                                {   compiledfile
                                        =
                                        get_compiledfile  thawedlib_tome;


                                    case (get_linking_mapstack  makelib_state)
                                        #
                                        THE linking_mapstack =>
                                            THE (cf::link_and_run_compiledfile (compiledfile, linking_mapstack, LINK))
                                            except
                                                LINK exn
                                                    =
                                                    exception_error (
                                                        "link-time exception in user program",
                                                        tlt::error makelib_state thawedlib_tome err::ERROR,
                                                        tlt::describe_thawedlib_tome  thawedlib_tome,
                                                        exn
                                                    );
                                        #
                                        NULL  => NULL;
                                    esac;
                                }
                                except
                                    exn as LINK _ =>  raise exception exn;
                                    _             =>  NULL;
                                end;

                            case (tlt::get_sharing_mode thawedlib_tome)
                                #                              
                                shm::DO_NOT_SHARE
                                    =>
                                    {   drop_thawedlib_tome_from_linker_map  makelib_state  thawedlib_tome;
                                        fresh ();
                                    };

                                shm::SHARE _
                                    =>
                                    case (ttm::get (*thawedlib_tome_info_map__local, thawedlib_tome))
                                        #
                                        THE (de, _) =>   THE de;
                                        #
                                        NULL
                                            =>
                                            case (fresh ())
                                                #
                                                THE de =>   THE de
                                                            where
                                                                thawedlib_tome_info_map__local
                                                                    :=
                                                                    ttm::set
                                                                      (
                                                                       *thawedlib_tome_info_map__local,
                                                                        thawedlib_tome,
                                                                        (de, thawedlib_tome_list)
                                                                      );
                                                            end;
                                                #
                                                NULL => NULL;
                                            esac;
                                    esac;
                            esac;
                        };


                    visited =   REF  sps::empty;


                    note_library  library_to_dagwalk
                    where
                        fun note_library (library_to_note as lg::LIBRARY lib)
                                =>
                                {   lib ->  { libfile, more, sublibraries, ... };

                                    #
                                    fun note_sublib  NULL               =>  ();
                                        note_sublib (THE sublibs_index) =>  note_library ((list::nth (sublibraries, sublibs_index)).library_thunk ());
                                    end;
                                                                                            # list                              is from   src/lib/std/src/list.pkg

                                    #
                                    fun note_freezefile (lg::LIBRARY stable_library)
                                            =>
                                            {   stable_library
                                                    ->
                                                    { catalog, libfile => stable_library_path, ... };


                                                posmap                                  # Pickle-in-freezefile info: Maps byteoffset of pickle in freezefile to (picklehash, pickle)
                                                    =
                                                    {   my (seed_libraries_index', posmap)
                                                            =
                                                            spm::drop  (*seed_libraries_index__local, stable_library_path);

                                                        seed_libraries_index__local :=   seed_libraries_index';

                                                        posmap;
                                                    }
                                                    except
                                                        lb::NOT_FOUND =  im::empty;


                                                localmap
                                                    =
                                                    REF  ftm::empty;

                                                #
                                                fun do_frozenlib_tome_tin
                                                        #
                                                        (sg::FROZENLIB_TOME_TIN tin)
                                                        :
                                                        ( ms::Makelib_State -> lt::Picklehash_To_Heapchunk_Mapstack -> lt::Picklehash_To_Heapchunk_Mapstack,
                                                          Null_Or( (flt::Frozenlib_Tome, List(Frozenlib_Tome_Info)))
                                                        )
                                                    =
                                                    {   near_imports =  tin.near_imports:        List( sg::Frozenlib_Tome_Tin         );
                                                        far_imports  =  tin.far_import_thunks:   List( Void -> sg::Far_Frozenlib_Tome );
                                                        #
                                                        fun my_sysval ()
                                                            =
                                                            im::get (posmap, tin.frozenlib_tome.byte_offset_in_freezefile);
                                                        #
                                                        fun new ()
                                                            =
                                                            case (my_sysval ())
                                                                #
                                                                # We short-circuit tree
                                                                # construction (and the resulting
                                                                # dagwalk) whenever we find a
                                                                # node whose linking value was
                                                                # created at bootstrap time.
                                                                # This assumes that anything in
                                                                # sysval can be shared -- which
                                                                # is enforced by the way the
                                                                # LIBRARY_CONTENTS file is constructed.
                                                                #
                                                                THE e =>  (fn makelib_state =  fn _ =  e,  NULL);
                                                                #
                                                                NULL  =>
                                                                    {   e0 = (fn _ =  lt::empty,  []);
                                                                        #
                                                                        fun join ((bfun, NULL),        (e, l))
                                                                                =>
                                                                                (fn makelib_state
                                                                                    =
                                                                                    lt::atop (bfun makelib_state lt::empty, e makelib_state),   l);

                                                                            join ((bfun, THE (frozenlib_tome, l')), (e, l))
                                                                                =>
                                                                                (e,   FROZENLIB_TOME_INFO (bfun, frozenlib_tome, l') ! l);
                                                                        end;

                                                                        ge =  fold_forward  join  e0  (map  do_far_frozenlib_tome_thunk  far_imports);
                                                                        le =  fold_forward  join  ge  (map  do_frozenlib_tome_tin        near_imports);

                                                                        case (tin.frozenlib_tome.sharing_mode, le)
                                                                            #
                                                                            (shm::SHARE _, (e, []))
                                                                                =>
                                                                                {   fun thunk makelib_state
                                                                                        =
                                                                                        link_frozenlib_tome (tin.frozenlib_tome, e makelib_state);

                                                                                    memoized_thunk   =   mz::memoize thunk;

                                                                                    ( fn makelib_state =  fn _ =  memoized_thunk  makelib_state,
                                                                                      NULL
                                                                                    );
                                                                                };

                                                                            (shm::SHARE _, _)
                                                                                =>
                                                                                err::impossible
                                                                                  "Link: sharing_mode inconsistent";

                                                                            (shm::DO_NOT_SHARE, (e, l))
                                                                                =>
                                                                                (fn makelib_state =  fn e' =
                                                                                  link_frozenlib_tome
                                                                                     (tin.frozenlib_tome, lt::atop (e', e makelib_state)),
                                                                                       THE (tin.frozenlib_tome, l));
                                                                        esac;
                                                                    };
                                                            esac;


                                                        case (ftm::get (*frozenlib_tome_info_map__local, tin.frozenlib_tome))
                                                            #
                                                            THE (FROZENLIB_TOME_INFO (bfun, frozenlib_tome, []))
                                                                =>
                                                                case frozenlib_tome.sharing_mode
                                                                    #
                                                                    shm::DO_NOT_SHARE
                                                                        =>
                                                                        (bfun, THE (frozenlib_tome, []));

                                                                    _   =>
                                                                        (bfun, NULL);
                                                                esac;

                                                            THE (FROZENLIB_TOME_INFO (bfun, frozenlib_tome, l))
                                                                =>
                                                                (bfun, THE (frozenlib_tome, l));

                                                            NULL=>
                                                                case (ftm::get (*localmap, tin.frozenlib_tome))
                                                                    #
                                                                    THE x =>   x;
                                                                    #
                                                                    NULL =>    x
                                                                        where
                                                                            x = new ();
                                                                            #
                                                                            localmap
                                                                                :=
                                                                                ftm::set
                                                                                    (*localmap,  tin.frozenlib_tome,  x);
                                                                        end;
                                                                esac;
                                                        esac;
                                                    }                                                                   # fun do_frozenlib_tome_tin 


                                                also
                                                fun do_far_frozenlib_tome (tome: sg::Far_Frozenlib_Tome)
                                                    =
                                                    {   note_sublib             tome.sublibs_index;
                                                        do_frozenlib_tome_tin   tome.frozenlib_tome_tin;
                                                    }


                                                also
                                                fun do_far_frozenlib_tome_thunk  far_frozenlib_tome_thunk
                                                    =
                                                    do_far_frozenlib_tome  (far_frozenlib_tome_thunk ());

                                                #
                                                fun do_tome (sg::TOME_IN_FROZENLIB { frozenlib_tome_tin => frozenlib_tome_tin as sg::FROZENLIB_TOME_TIN tin, sublibs_index, ... }):   Void
                                                        =>
                                                        {   note_sublib  sublibs_index;

                                                            my frozenlib_tome_info as FROZENLIB_TOME_INFO (_, frozenlib_tome', _)
                                                                =
                                                                case (do_frozenlib_tome_tin  frozenlib_tome_tin)
                                                                    #
                                                                    (bfun, NULL)                      =>   FROZENLIB_TOME_INFO (bfun, tin.frozenlib_tome,  []);
                                                                    (bfun, THE (frozenlib_tome'', l)) =>   FROZENLIB_TOME_INFO (bfun,     frozenlib_tome'', l);
                                                                esac;

                                                            frozenlib_tome_info_map__local
                                                                :=
                                                                ftm::set
                                                                    (*frozenlib_tome_info_map__local,  frozenlib_tome',  frozenlib_tome_info);
                                                        };

                                                    do_tome (sg::TOME_IN_THAWEDLIB n)
                                                        =>
                                                        err::impossible "Link: THAWEDLIB_TOME in frozen library";       # One prime invariant is that we never allow frozen libraries to refer to thawed libraries.
                                                end;

                                                #
                                                fun do_far_tome
                                                      { exports_mask:   sg::Exports_Mask,
                                                        tome_tin:       sg::Tome_Tin
                                                      }
                                                    : Void
                                                    =
                                                    do_tome  tome_tin;

                                                #
                                                fun import_export  (t:  lg::Fat_Tome)
                                                    =
                                                    do_far_tome (t.masked_tome_thunk ());

                                                sym::apply  import_export  catalog;
                                            };


                                        note_freezefile lg::BAD_LIBRARY
                                            =>
                                            ();
                                    end;                                                                                # fun note_freezefile


                                    #
                                    fun force thunk =   thunk ();


                                    if (not (sps::member (*visited, libfile)))
                                        #
                                        visited :=   sps::add (*visited,  libfile);

                                        case more
                                            #
                                            lg::MAIN_LIBRARY { frozen_vs_thawed_stuff => lg::FROZENLIB_STUFF _, ... }
                                                =>
                                                note_freezefile  library_to_note;
                                            #
                                            _   =>
                                                apply
                                                    (note_library o force o .library_thunk)
                                                    sublibraries;
                                        esac;
                                    fi;
                                };

                            note_library lg::BAD_LIBRARY
                                =>
                                ();

                        end;                                                            # fun note_library
                    end;


                    l_stablemap =  REF  ftm::empty;
                    l_smlmap    =  REF  ttm::empty;

                    #
                    fun bin_node (FROZENLIB_TOME_INFO (f, i, l))
                        =
                        case (ftm::get  (*l_stablemap, i))
                            #                     
                            THE th =>   th;
                            #
                            NULL =>
                                memoized_thunk
                                where
                                    fl =  map  bin_node  l;
                                    #
                                    fun th makelib_state
                                        =
                                        {   fun add (t, e)
                                                =
                                                lt::atop (t makelib_state, e);

                                            f makelib_state (fold_forward  add  lt::empty  fl);
                                        };

                                    memoized_thunk
                                        =
                                        mz::memoize  th;

                                    l_stablemap
                                        :=
                                        ftm::set (*l_stablemap, i, memoized_thunk);
                                end;
                        esac;

                    #
                    fun do_tome (sg::TOME_IN_FROZENLIB { frozenlib_tome_tin => sg::FROZENLIB_TOME_TIN { frozenlib_tome, ... }, ... })
                            =>
                            {   b =  the (ftm::get (*frozenlib_tome_info_map__local,  frozenlib_tome));
                                #
                                fun th makelib_state
                                    =
                                    THE (bin_node b makelib_state)
                                    except
                                        exn as LINK _ =>  raise exception exn;
                                        _             =>  NULL;
                                    end ;

                                (th, []);
                            };

                        do_tome (sg::TOME_IN_THAWEDLIB  tome)
                            =>
                            sourcefile_node  tome;
                    end 


                    also
                    fun sourcefile_node  (sg::THAWEDLIB_TOME_TIN  tin)
                        =
                        {   tin ->  { thawedlib_tome:   tlt::Thawedlib_Tome,
                                      near_imports:     List( sg::Thawedlib_Tome_Tin ),
                                      far_imports:      List( sg::Masked_Tome  )
                                    };


                            case (ttm::get (*l_smlmap, thawedlib_tome))
                                #
                                THE thunk
                                    =>
                                    (thunk, [thawedlib_tome]);

                                NULL
                                    =>
                                    {   fun atop (THE e, THE e') =>   THE (lt::atop (e, e'));
                                            atop _               =>   NULL;
                                        end;

                                        #
                                        fun add ( (f,  l ),
                                                  (f', l')
                                                )
                                            =
                                            ( fn makelib_state
                                                 =
                                                 atop
                                                     ( f  makelib_state,
                                                       f' makelib_state
                                                     ),
                                              l @ l'
                                            );


                                        far_imports
                                            =
                                            fold_forward
                                                add
                                                (fn _ =  THE lt::empty,  [])
                                                (map
                                                     do_far_tome
                                                     far_imports
                                                );


                                        my  ( get_linking_mapstack:      ms::Makelib_State -> Null_Or( lt::Picklehash_To_Heapchunk_Mapstack ),
                                              thawedlib_tome_list:    List( tlt::Thawedlib_Tome )
                                            )
                                            =
                                            fold_forward
                                                add
                                                far_imports
                                                (map  sourcefile_node  near_imports);

                                        #
                                        fun thunk makelib_state
                                            =
                                            link_thawedlib_tome
                                                ( makelib_state,
                                                  thawedlib_tome,
                                                  get_compiledfile,
                                                  get_linking_mapstack,
                                                  thawedlib_tome_list
                                                );


                                        memoized_thunk
                                            =
                                            mz::memoize thunk;
                                                                       # memoize        is from   src/lib/std/memoize.pkg


                                        l_smlmap
                                            :=
                                            ttm::set
                                                (*l_smlmap,  thawedlib_tome,  memoized_thunk);

                                        (memoized_thunk, [thawedlib_tome]);
                                    };
                            esac;
                        }

                    also
                    fun do_far_tome { exports_mask, tome_tin }
                        =
                        do_tome  tome_tin;

                    #
                    fun import_export  (t:  lg::Fat_Tome)  makelib_state
                        =
                        #1  (do_far_tome  (t.masked_tome_thunk ()))  makelib_state
                        except
                            LINK exn =  raise exception lrp::LINK;

                    exports =   sym::map  import_export  catalog;
                    #
                    fun linking_mapstack  makelib_state
                        =
                        {   fun one (_, NULL )   =>     NULL;
                                #
                                one (f, THE e)   =>     case (f makelib_state)
                                                            #                                                        
                                                            NULL   =>  NULL;
                                                            THE e' =>  THE (lt::atop (e', e));
                                                        esac;
                            end;

                            sym::fold_forward
                                one
                                (THE lt::empty)
                                exports;
                        };

# log::note .{ "make_linking_dagwalk'/ZZZ"; };
# printf "make_linking_dagwalk'/ZZZ\n";
                    { exports, linking_mapstack };
                };

            make_linking_dagwalk' (lg::BAD_LIBRARY, _)
                =>
                {  linking_mapstack =>   fn _ = NULL,
                   exports          =>   sym::empty
                };

        end;                                                                                    #  fun make_linking_dagwalk' 


        # This is our main entrypoint, invoked twice in
        #
        #     src/app/makelib/main/makelib-g.pkg
        #
        fun make_linking_dagwalk  (x   as   (lg::LIBRARY { catalog, ... },  get_compiledfile))
            #####################
                => 
                {
# log::note .{ "make_linking_dagwalk/AAA"; };
# printf "make_linking_dagwalk/AAA\n";
                    dagwalk_thunk
                        =
                        mz::memoize
                            .{   make_linking_dagwalk'  x;   };


# log::note .{ "make_linking_dagwalk/BBB"; };
# printf "make_linking_dagwalk/BBB\n";
result =
                    { linking_mapstack
                          =>
                          fn makelib_state =   (dagwalk_thunk ()).linking_mapstack   makelib_state,

                      exports
                          =>
                          sym::keyed_map
                              # 
                              (fn (symbol, _)
                                  =
                                  fn makelib_state
                                      =
                                      the (sym::get
                                              (  (dagwalk_thunk()).exports,
                                                 symbol
                                              )
                                          )
                                          makelib_state
                              )
                              # 
                              catalog
                    };
# log::note .{ "make_linking_dagwalk/ZZZ"; };
# printf "make_linking_dagwalk/ZZZ\n";
result;
                };


            make_linking_dagwalk (x as (lg::BAD_LIBRARY, _))
                =>
                make_linking_dagwalk' x;
        end;

        #
        fun clear_state ()
            =
            {   frozenlib_tome_info_map__local :=  ftm::empty;
                thawedlib_tome_info_map__local :=  ttm::empty;
            };

        #
        fun unshare libfile
            =
            {
                frozenlib_tome_info_map__local
                    :=
                    ftm::keyed_filter
                        other
                        *frozenlib_tome_info_map__local
                    where
                        fun other (tome: flt::Frozenlib_Tome, _)
                            =
                            ad::compare (tome.libfile, libfile)  !=  EQUAL;
                    end;

                (seed_libraries_index__local
                    :=
                    #1  (spm::drop  (*seed_libraries_index__local, libfile))
                )
                except
                    lb::NOT_FOUND = ();
            };
    };
end;



## (C) 1999 Lucent Technologies, Bell Laboratories
## Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext