## at.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublib# This provides a mechanism for registering at-functions
# which should be invoked at startup and/or shutdown time.
# We define five distinct contexts
# for an at-function:
#
# FORK_TO_DISK just prior to exporting a heap image (fork_to_disk).
# SPAWN_TO_DISK exit because of spawn_to_disk.
# SHUTDOWN normal program exit.
# STARTUP initialization of a program that was generated by fork_to_disk.
# APP_STARTUP initialization of a program that was generated by spawn_to_disk.
# Compiled by:
# src/lib/std/src/standard-core.sublib### "No pessimist ever discovered the secret of the stars,
### or sailed to an uncharted land, or opened a new doorway
### for the human spirit."
###
### -- Helen Keller
# At is from src/lib/std/src/nj/at.apipackage at
: (weak) At
{
When
= FORK_TO_DISK
| SPAWN_TO_DISK
| SHUTDOWN
| STARTUP
| APP_STARTUP
;
all = [ FORK_TO_DISK, SPAWN_TO_DISK, SHUTDOWN, STARTUP, APP_STARTUP ];
at_functions
=
REF ([]: List( (String, List( When ), (When -> Void)) ) );
# Return the list of at-functions
# which satisfy 'when_predicate'.
#
fun filter_by_when when_predicate
=
f *at_functions
where
fun f [] => [];
#
f ((item as (_, when_list, _)) ! r)
=>
if (list::exists when_predicate when_list) item ! (f r);
else (f r);
fi;
end;
end;
# Run the at-functions for the given time.
#
# In some cases, this causes the list
# of at_functions to be redefined.
#
# NB: We reverse the order of application at startup time.
#
fun run_functions_scheduled_to_run when
=
{ at_fns
=
case when
#
(STARTUP | APP_STARTUP)
=>
list::reverse
(filter_by_when (fn w = w == when));
_ => (filter_by_when (fn w = w == when));
esac;
fun export_fn_predicate (APP_STARTUP | SHUTDOWN) => TRUE;
export_fn_predicate _ => FALSE;
end;
fun startup_fn_predicate SHUTDOWN => TRUE;
startup_fn_predicate _ => FALSE;
end;
# Remove uneccesary clean-up routines:
#
case when
#
SPAWN_TO_DISK => at_functions := filter_by_when export_fn_predicate;
APP_STARTUP => at_functions := filter_by_when startup_fn_predicate;
_ => ();
esac;
# Now apply the selected at-functions:
#
list::apply
( fn (_, _, f)
=
(f when)
except
_ = ()
)
at_fns;
};
# Find and remove the named at-function
# from the at-function list.
#
# Return the at-function and
# the new at-function list.
#
# Return NULL if the named
# at-function does not exist.
#
fun filter_by_name fn_name
=
remove *at_functions
where
fun remove []
=>
NULL;
remove ((at_function as (fn_name', when_list, function_proper)) ! rest)
=>
if (fn_name == fn_name')
#
THE ((when_list, function_proper), rest);
else
case (remove rest)
#
THE (at_function', rest')
=>
THE (at_function', at_function ! rest');
NULL => NULL;
esac;
fi;
end;
end;
# Add a named at-function.
# This returns the previous definition, or NULL.
#
fun schedule (at_function as (fn_name, _, _))
=
case (filter_by_name fn_name)
#
THE (old_at_function, new_at_function_list)
=>
{ at_functions := at_function ! new_at_function_list;
#
THE old_at_function;
};
NULL =>
{ at_functions := at_function ! *at_functions;
#
NULL;
};
esac;
# Remove and return the named at-function.
# Return NULL if it is not found:
#
fun deschedule fn_name
=
case (filter_by_name fn_name)
#
THE (old_at_function, at_function_list)
=>
{ at_functions := at_function_list;
#
THE old_at_function;
};
NULL => NULL;
esac;
}; # at