PreviousUpNext

15.4.611  src/lib/compiler/front/typer-stuff/modules/stamppath-context.pkg

## stamppath-context.pkg 

# Compiled by:
#     src/lib/compiler/front/typer-stuff/typecheckdata.sublib



stipulate
    package mp  =  stamppath;                   # stamppath             is from   src/lib/compiler/front/typer-stuff/modules/stamppath.pkg
    package sta =  stamp;                       # stamp                 is from   src/lib/compiler/front/typer-stuff/basics/stamp.pkg
    package stx =  stampmapstack;               # stampmapstack         is from   src/lib/compiler/front/typer-stuff/modules/stampmapstack.pkg
herein

    api Stamppath_Context {

        Context;

        init_context:  Context;

        is_empty:  Context -> Bool;

        enter_open:        (Context, Null_Or( sta::Stamp )) -> Context;
        enter_closed:      Context -> Context;

        find_stamppath_for_type:        (Context, stx::Typestamp   ) -> Null_Or( mp::Stamppath );
        find_stamppath_for_package:     (Context, stx::Packagestamp) -> Null_Or( mp::Stamppath );
        find_stamppath_for_generic:     (Context, stx::Genericstamp) -> Null_Or( mp::Stamppath );

        bind_typepath:          (Context, stx::Typestamp,    sta::Stamp) -> Void;
        bind_stamppath:         (Context, stx::Packagestamp, sta::Stamp) -> Void;
        bind_generic_path:              (Context, stx::Genericstamp, sta::Stamp) -> Void;

        bind_type_long_path:            (Context, stx::Typestamp,    mp::Stamppath) -> Void;
        bind_package_long_path:         (Context, stx::Packagestamp, mp::Stamppath) -> Void;
        bind_generic_long_path:         (Context, stx::Genericstamp, mp::Stamppath) -> Void;

    };  #  Api GENERIC_EVALUATION_PATH_CONTEXT 
end;

stipulate
    package mp  =  stamppath;                   # stamppath             is from   src/lib/compiler/front/typer-stuff/modules/stamppath.pkg
    package stx =  stampmapstack;               # stampmapstack         is from   src/lib/compiler/front/typer-stuff/modules/stampmapstack.pkg
herein

    package stamppath_context
    :       Stamppath_Context                   # Stamppath_Context     is from   src/lib/compiler/front/typer-stuff/modules/stamppath-context.pkg
    {
        Path_Map = stx::Stampmapstackx( mp::Reverse_Stamppath );

        # A package body (pkg decls end) is "closed"
        # if it is a generic body package.
        #
        # The idea is that the elements of a closed package are not
        # directly referenced from outside the package, so the path dictionary
        # local to the closed package can be discarded after the package
        # body is typechecked.


        # path_map maps stamps to full stamppaths
        # relative to current generic context.
        #
        # Each "closed" package body pushes a new layer:
        #
        Context
          = EMPTY
          | LAYER  {   locals:        Ref( Path_Map ), 
                         get_context: mp::Stamppath,
                         bind_context:   mp::Reverse_Stamppath,
                         outer:         Context
                     };

        my init_context:  Context = EMPTY;

        fun is_empty (EMPTY:  Context) =>  TRUE;
            is_empty _                 =>  FALSE;
        end;


        # Called on entering a closed package scope,
        # whose elements will not be accessed from
        # outside (hence the null bindContext):
        #
        fun enter_closed  stamppath_context
            = 
            LAYER {   locals       =>  REF (stx::stampmapstackx),
                      get_context  =>  mp::null_stamppath,
                      bind_context =>  mp::null_reverse_stamppath,
                      outer        =>  stamppath_context
                  };


        # Called on entering an open package scope.
        # (Claim:  This is always an unconstrained
        # package decl body.) Our 'module_stamp' is the
        # Module_Stamp of the package being typechecked:
        #
        fun enter_open (EMPTY, _)
                =>
                EMPTY;

            enter_open (stamppath_context, NULL)
                =>
                stamppath_context;

            enter_open (LAYER { locals, get_context, bind_context, outer }, THE module_stamp)
                => 
                LAYER {   locals,
                          get_context  => get_context @ [module_stamp],
                          bind_context => mp::prepend_to_reverse_stamppath2 (module_stamp, bind_context),
                          outer
                      };
        end;



        # Relative (path, ctx) - subtract common prefix of path and ctx from path 
        #
        fun relative( [], _ )
                =>
                [];

            relative( stamppath, [])
                =>
                stamppath;

            relative( p as (x ! rest),  y ! rest')
                => 
                if (mp::same_module_stamp (x, y))   relative (rest, rest');
                else                                      p;
                fi;
        end;

        fun find_stamppath_for_id find (   EMPTY,    _   )
                =>
                NULL;

            find_stamppath_for_id find (   LAYER { locals, get_context, bind_context, outer },   id   )
                =>
                case (find (*locals, id))
                     NULL   => find_stamppath_for_id find (outer, id);
                     THE rp => THE (relative (mp::reverse_stamppath_to_stamppath rp, get_context));
                esac;
        end;

        find_stamppath_for_type   =   find_stamppath_for_id   stx::find_x_by_typestamp;
        find_stamppath_for_package  =   find_stamppath_for_id   stx::find_x_by_packagestamp;
        find_stamppath_for_generic  =   find_stamppath_for_id   stx::find_x_by_genericstamp;

        # Probe (context, stamp) checks whether a stamp has already been bound: 
        #
        fun probe find (EMPTY, stamp)
                =>
                FALSE;

            probe find (LAYER { locals, outer, ... }, stamp)
                => 
                case (find (*locals, stamp))
                     NULL => probe find (outer, stamp);
                     _    => TRUE;
                esac;
        end;

        fun bind_path (find, insert) (EMPTY, _, _)
                =>
                ();

            bind_path (find, insert) (xx as LAYER { locals, bind_context, ... }, s, ev)
                =>
                if (not (probe find (xx, s)))

                     locals := insert ( *locals,
                                         s,
                                         mp::prepend_to_reverse_stamppath2 (ev, bind_context)
                                       );
                fi;
        end;

        bind_typepath   =   bind_path (stx::find_x_by_typestamp,   stx::enter_x_by_typestamp);
        bind_stamppath    =   bind_path (stx::find_x_by_packagestamp,  stx::enter_x_by_packagestamp);
        bind_generic_path  =   bind_path (stx::find_x_by_genericstamp,  stx::enter_x_by_genericstamp);

        fun bind_long_path (find, insert) (EMPTY, _, _)
                =>
                ();

            bind_long_path (find, insert)
                         (xx as LAYER { locals, bind_context, ... }, s, ep)
                =>
                if (not (probe find (xx, s)))

                     locals := insert ( *locals,
                                         s,
                                         mp::reverse_and_prepend_to_reverse_stamppath (ep, bind_context)
                                       );
                fi;
        end;

        bind_type_long_path  =   bind_long_path (stx::find_x_by_typestamp,  stx::enter_x_by_typestamp);
        bind_package_long_path =   bind_long_path (stx::find_x_by_packagestamp, stx::enter_x_by_packagestamp);
        bind_generic_long_path =   bind_long_path (stx::find_x_by_genericstamp, stx::enter_x_by_genericstamp);

    };                                                  # package stamppath_context 
end;                                                    # Stipulate.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext