## nextcode-function-stack-g.pkg --- code and data fragments that need to be compiled.
#
# Decompose a compilation unit into clusters:
#
# This package is used (only) in:
#
# src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg# Compiled by:
# src/lib/compiler/core.sublib### "I remember one occasion when I tried to add a little
### seasoning to a review, but I wasn't allowed to.
### The paper was by Dorothy Maharam, and it was a
### perfectly sound contribution to abstract measure theory.
### The domains of the underlying measures were not sets but
### elements of more general Boolean algebras, and their range
### consisted not of positive numbers but of certain abstract
### equivalence classes. My proposed first sentence was:
###
### "The author discusses valueless measures in pointless spaces."
###
### In: I want to be a Mathematician, Washington: MAA Spectrum, 1985, p. 120.
stipulate
package ncf = nextcode_form; # nextcode_form is from src/lib/compiler/back/top/nextcode/nextcode-form.pkg package lbl = codelabel; # codelabel is from src/lib/compiler/back/low/code/codelabel.pkgherein
# This generic is invoked (only) from:
#
# src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg #
generic package nextcode_function_stack_g (
# =========================
#
tcf: Treecode_Form # Treecode_Form is from src/lib/compiler/back/low/treecode/treecode-form.api )
: (weak) Nextcode_Function_Stack # Nextcode_Function_Stack is from src/lib/compiler/back/low/main/nextcode/nextcode-function-stack.api {
# Export to client packages:
#
package tcf = tcf; # "tcf" == "treecode_form".
# This is state used in
#
# src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg #
# to distinguish between functions still in nextcode form
# and functions which have been converted to treecode form:
#
Function_Form
#
= TREECODE_FORM List( tcf::Expression )
#
| NEXTCODE_FORM
( ncf::Codetemp, # Function id.
List( ncf::Codetemp ), # Function formal args.
List( ncf::Type ), # Types of function formal args.
ncf::Instruction # Function body.
)
;
Callers_Info
#
= PRIVATE_FN Ref( Function_Form )
| PRIVATE_FN_WHICH_NEEDS_HEAPLIMIT_CHECK Ref( Function_Form )
#
| PUBLIC_FN { func: Ref( Null_Or( ncf::Function ) ),
fml_typs: List( ncf::Type ) # "fml_typs" may be cryptic for "formal types", maybe?
}
;
fun error msg
=
error_message::impossible ("Function." + msg);
functions = REF ([]: List( (lbl::Codelabel, Callers_Info) ) ); # XXX BUGGO FIXME Icky thread-hostile mutable global variable.
fun pop_function ()
=
case *functions
#
function ! rest => THE function before (functions := rest);
[] => NULL;
esac;
fun push_function lf
=
functions := lf ! *functions;
# Make compilation functions for this cluster.
# Note the icky side-effects:
#
fun push_nextcode_function (arg as (callers_info, fun_id, fun_parameters, fun_parameter_types, fun_body), codelabel)
=
function
where
function = case callers_info
#
(ncf::PUBLIC_FN | ncf::NEXT_FN) => PUBLIC_FN { func=>REF (THE arg), fml_typs=>fun_parameter_types };
#
ncf::PRIVATE_FN => PRIVATE_FN (REF (NEXTCODE_FORM (fun_id, fun_parameters, fun_parameter_types, fun_body)));
ncf::PRIVATE_FN_WHICH_NEEDS_HEAPLIMIT_CHECK => PRIVATE_FN_WHICH_NEEDS_HEAPLIMIT_CHECK (REF (NEXTCODE_FORM (fun_id, fun_parameters, fun_parameter_types, fun_body)));
#
_ => error "make_fragments";
esac;
functions := (codelabel, function) ! *functions;
end;
}; # nextcode_function_stack_g
end;
## COPYRIGHT (c) 1995 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.