## stamppath-context.pkg
# Compiled by:
# src/lib/compiler/front/typer-stuff/typecheckdata.sublibstipulate
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.pkgherein
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.pkgherein
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.