## expand-type.pkg
#
# Compiled by:
# src/lib/compiler/front/typer/typer.sublib# The center of the typechecker is
#
# src/lib/compiler/front/typer/main/type-package-language-g.pkg#
# -- see it for a higher-level overview.
#
# It calls src/lib/compiler/front/typer/main/type-api.pkg# which calls us, and we in turn offload much of our work
# to module_junk: translateTypeConstructor
# in src/lib/compiler/front/typer-stuff/modules/module-junk.api# src/lib/compiler/front/typer-stuff/modules/module-junk.pkgstipulate
package mld = module_level_declarations; # module_level_declarations is from src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg package tro = typerstore; # typerstore is from src/lib/compiler/front/typer-stuff/modules/typerstore.pkgherein
api Expand_Type {
#
Api_Context = List( mld::Api_Elements );
#
expand_type: (tdt::Type, Api_Context, tro::Typerstore)
->
tdt::Type;
debugging: Ref( Bool );
};
end;
stipulate
package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg package tyj = type_junk; # type_junk is from src/lib/compiler/front/typer-stuff/types/type-junk.pkg package sp = stamppath; # stamppath is from src/lib/compiler/front/typer-stuff/modules/stamppath.pkg package mld = module_level_declarations; # module_level_declarations is from src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg package mj = module_junk; # module_junk is from src/lib/compiler/front/typer-stuff/modules/module-junk.pkgherein
package expand_type
: (weak) Expand_Type # Expand_Type is from src/lib/compiler/front/typer/modules/expand-type.pkg {
# Debug hooks:
say = control_print::say;
debugging = REF FALSE;
fun if_debugging_say (msg: String)
=
if *debugging
say msg;
say "\n";
fi;
fun bug s = err::impossible ("expand_type: " + s);
Api_Context = List( mld::Api_Elements );
exception OUTER;
# Search a list of typechecked_package stamp namings.
# We ignore GENERIC_IN_API --
# we won't find any types there:
#
fun get_typechecked_package_variable ( module_stamp,
( _,
s as ( mld::TYPE_IN_API { module_stamp => module_stamp', ... }
| mld::PACKAGE_IN_API { module_stamp => module_stamp', ... }
)
) ! rest
)
=>
if (sp::same_module_stamp (module_stamp, module_stamp')) THE s;
else get_typechecked_package_variable (module_stamp, rest);
fi;
get_typechecked_package_variable (module_stamp, _ ! rest) => get_typechecked_package_variable (module_stamp, rest);
get_typechecked_package_variable (module_stamp, NIL ) => NULL;
end;
fun find_in_api_context ( module_stamp, api_context as elements0 ! outer_context )
=>
case (get_typechecked_package_variable (module_stamp, elements0))
#
THE (mld::PACKAGE_IN_API { an_api as mld::API { api_elements, ... }, ... } )
=>
api_elements ! api_context;
NULL
=>
find_in_api_context (module_stamp, outer_context);
_ => bug "find_in_api_context - bad element";
esac;
find_in_api_context (module_stamp, NIL)
=>
raise exception OUTER;
end;
fun expand_type (type, api_context, typerstore)
=
{ fun expand_typevar ( module_stamp, api_context as elements ! outer_context )
:
tdt::Type
=>
case (get_typechecked_package_variable (module_stamp, elements))
#
THE (mld::TYPE_IN_API { type, ... } )
=>
case type
#
tdt::SUM_TYPE _ => type;
tdt::NAMED_TYPE { stamp, strict, namepath, typescheme }
=>
tdt::NAMED_TYPE {
stamp,
strict,
namepath,
typescheme => expand_typescheme (typescheme, api_context)
};
_ => bug "expand_type 2";
esac;
NULL => expand_typevar (module_stamp, outer_context); # Try outer context
_ => bug "expandTypeConstructor 1";
esac;
expand_typevar (module_stamp, NIL)
=>
raise exception OUTER;
end
also
fun expand_type api_context
=
\\ (type as tdt::TYPE_BY_STAMPPATH { stamppath, ... } )
=>
( expand_path (stamppath, api_context)
except
OUTER # Path outside current api context
=
mj::translate_type typerstore type
);
type => type;
end
also
fun expand_typescheme (tdt::TYPESCHEME { arity, body }, api_context)
=
tdt::TYPESCHEME { arity,
body => tyj::map_constructor_typoid_dot_type (expand_type api_context) body
}
also
fun expand_path (stamppath, api_context)
=
case stamppath
#
NIL => bug "expandPath 1";
module_stamp ! NIL # type!
=>
expand_typevar (module_stamp, api_context);
module_stamp ! rest # Subpackage.
=>
expand_path (rest, find_in_api_context (module_stamp, api_context));
esac;
expand_type api_context type;
};
}; # package expand_type
end; # stipulate
## (C) 2001 Lucent Technologies, Bell Labs
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.