## read-eval-print-loop-g.pkg
#
# This generates the top-level read-evaluate-print
# loop for interactive compiler sessions.
#
# For higher-level context, see comments at top of
#
# src/app/makelib/main/makelib-g.pkg# src/app/makelib/mythryl-compiler-compiler/mythryl-compiler-compiler-g.pkg#
#
#
# Compile-time invocation
# -----------------------
#
# The 'compile' argument gives us an abstract
# interface to the actual mechanics of generating
# executable machine code from a syntax tree.
#
#
#
# Run-time invocation
# -------------------
#
# At start of execution
#
# src/lib/core/internal/make-mythryld-executable.pkg#
# calls run_commandline in
#
# src/app/makelib/main/makelib-g.pkg#
# to process commandline arguments, print
# the start-up banner and such, and then
# (for an interactive session) invokes our
#
# read_eval_print_from_user
#
# entrypoint via the trivial 'read_eval_print_from_user' wrapper in
#
# src/lib/compiler/toplevel/interact/read-eval-print-loops-g.pkg#
#
# See also:
# src/lib/core/init/read-eval-print-hook.pkg# src/lib/compiler/toplevel/interact/read-eval-print-loops-g.pkg# Compiled by:
# src/lib/compiler/core.sublib
### "We make a living by what we get, but
### we make a life by what we give."
###
### -- Winston Churchill
stipulate
package cms = compiler_mapstack_set; # compiler_mapstack_set is from src/lib/compiler/toplevel/compiler-state/compiler-mapstack-set.pkg package cs = compiler_state; # compiler_state is from src/lib/compiler/toplevel/interact/compiler-state.pkg package ds = deep_syntax; # deep_syntax is from src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax.pkg package ctl = global_controls; # global_controls is from src/lib/compiler/toplevel/main/global-controls.pkg package cw = callcc_wrapper; # callcc_wrapper is from src/lib/compiler/execution/main/callcc-wrapper.pkg package cx = compilation_exception; # compilation_exception is from src/lib/compiler/front/basics/map/compilation-exception.pkg package ed = typer_debugging; # typer_debugging is from src/lib/compiler/front/typer/main/typer-debugging.pkg package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package fat = fate; # fate is from src/lib/std/src/nj/fate.pkg package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package ims = inlining_mapstack; # inlining_mapstack is from src/lib/compiler/toplevel/compiler-state/inlining-mapstack.pkg package it = import_tree; # import_tree is from src/lib/compiler/execution/main/import-tree.pkg package ph = picklehash; # picklehash is from src/lib/compiler/front/basics/map/picklehash.pkg package lt = linking_mapstack; # linking_mapstack is from src/lib/compiler/execution/linking-mapstack/linking-mapstack.pkg package seg = code_segment; # code_segment is from src/lib/compiler/execution/code-segments/code-segment.pkg package acf = anormcode_form; # anormcode_form is from src/lib/compiler/back/top/anormcode/anormcode-form.pkg package iox = io_exceptions; # io_exceptions is from src/lib/std/src/io/io-exceptions.pkg package lrp = link_and_run_package; # link_and_run_package is from src/lib/compiler/execution/main/link-and-run-package.pkg package mcv = mythryl_compiler_version; # mythryl_compiler_version is from src/lib/core/internal/mythryl-compiler-version.pkg package myp = mythryl_parser; # mythryl_parser is from src/lib/compiler/front/parser/main/mythryl-parser.pkg package pcs = per_compile_stuff; # per_compile_stuff is from src/lib/compiler/front/typer-stuff/main/per-compile-stuff.pkg package pm = parse_mythryl; # parse_mythryl is from src/lib/compiler/front/parser/main/parse-mythryl.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.pkg package cv = compiler_verbosity; # compiler_verbosity is from src/lib/compiler/front/basics/main/compiler-verbosity.pkg package prs = prettyprint_raw_syntax; # prettyprint_raw_syntax is from src/lib/compiler/front/typer/print/prettyprint-raw-syntax.pkg package rpc = runtime_internals::rpc; # runtime_internals is from src/lib/std/src/nj/runtime-internals.pkg package rsj = raw_syntax_junk; # raw_syntax_junk is from src/lib/compiler/front/parser/raw-syntax/raw-syntax-junk.pkg package raw = raw_syntax; # raw_syntax is from src/lib/compiler/front/parser/raw-syntax/raw-syntax.pkg package sci = sourcecode_info; # sourcecode_info is from src/lib/compiler/front/basics/source/sourcecode-info.pkg package syx = symbolmapstack; # symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg package tbi = winix_base_text_file_io_driver_for_posix__premicrothread; # winix_base_text_file_io_driver_for_posix__premicrothread is from src/lib/std/src/io/winix-base-text-file-io-driver-for-posix--premicrothread.pkg package un = unsafe; # unsafe is from src/lib/std/src/unsafe/unsafe.pkg package urs = unparse_raw_syntax; # unparse_raw_syntax is from src/lib/compiler/front/typer/print/unparse-raw-syntax.pkg package wnx = winix__premicrothread; # winix__premicrothread is from src/lib/std/winix--premicrothread.pkg package wpr = write_time_profiling_report; # write_time_profiling_report is from src/lib/compiler/debugging-and-profiling/profiling/write-time-profiling-report.pkg package xs = exceptions; # exceptions is from src/lib/std/exceptions.pkg package tmp = highcode_codetemp; # highcode_codetemp is from src/lib/compiler/back/top/highcode/highcode-codetemp.pkg #
# include package compiler_mapstack_set; # compiler_mapstack_set is from src/lib/compiler/toplevel/compiler-state/compiler-mapstack-set.pkg# include package pp;
nb = log::note_on_stderr; # log is from src/lib/std/src/log.pkgherein
# This generic is invoked (only) from:
#
# src/lib/compiler/toplevel/compiler/mythryl-compiler-g.pkg #
generic package read_eval_print_loop_g (
#
cpl: Toplevel_Translate_Raw_Syntax_To_Execode # Toplevel_Translate_Raw_Syntax_To_Execode is from src/lib/compiler/toplevel/main/translate-raw-syntax-to-execode.api ) # "cpl" == "compile".
: (weak) Read_Eval_Print_Loop # Read_Eval_Print_Loop is from src/lib/compiler/toplevel/interact/read-eval-print-loop.api {
exception CONTROL_C_SIGNAL; # PUBLIC
# Variable = tmp::Codetemp;
fun say msg
=
{ ctl::print::say msg;
ctl::print::flush ();
};
exception END_OF_FILE;
#
fun interruptible f x # Execute f(x); if POSIX SIGINT signal (^C) is received while f(x) is running, raise CONTROL_C_SIGNAL. In other words, run a possibly long computation with user allowed to ^C out of it.
= # This had obvious application and functionality in single-threaded SML/NJ; it is less clear what it should (or can) do in Mythryl where we have multiple hostthreads and multiple microthreads. -- 2015-09-21 CrT
{ old_fate = *un::sigint_fate;
#
un::sigint_fate # Set up a handler so a SIGINT signal (typically generated by Ctrl-C) coming in will result in the CONTROL_C_SIGNAL exception being raised.
:= # XXX BUGGO FIXME this isn't going to work multithreaded!
fat::call_with_current_fate # The SIGINT handler handle_int() calls *un::sigint_fate -- established in src/lib/core/internal/make-mythryld-executable.pkg (\\ fate
=
{ fat::call_with_current_fate
(\\ fate' = (fat::switch_to_fate fate fate') ); #
#
raise exception CONTROL_C_SIGNAL;
}
);
( f x # Execute given f(x) computation.
then #
un::sigint_fate := old_fate # Restore original SIGINT handler and return result of f(x).
)
except
e = { un::sigint_fate := old_fate; # f(x) resulted in an exception. Restore the original SIGINT handler...
# #
raise exception e; # ... and re-raise the exception.
};
};
exception EXCEPTION_DURING_EXECUTION Exception;
# ``Here is the core loop handling user interaction
# at the interactive prompt.
#
# ``The base_dictionary and local_dictionary are refs
# so that a top-level command can re-assign either
# one of them and have the next iteration of the loop
# see the new value.
#
# ``It is important that the toplevel environment fate
# NOT see the "fetched" dictionary, but only the REF:
# This way, if the user "filters" the dictionary REF
# a smaller image can be written.''
#
# -- Matthias Blume (?) circa 2000 (?)
stipulate
#
fun read_eval_print_loop
{
sourcecode_info: sci::Sourcecode_Info,
keep_looping: Bool
}
=
{ cv = cv::print_expression_value; # Probably should not be hardwiring this here, but not clear where it should be coming from.
#
prompt_read_parse_and_return_one_toplevel_mythryl_expression
=
pm::prompt_read_parse_and_return_one_toplevel_mythryl_expression
#
sourcecode_info;
# parse_nada::prompt_read_parse_and_return_one_toplevel_nada_expression # Experimental provision for supporting an alternate syntax via an alternate parser.
# sourcecode_info; # If this goes production, we should have a control settable via commandline switch(?)
# with an 'if' here to select which one to use.
per_compile_stuff # per_compile_stuff is from src/lib/compiler/front/typer-stuff/main/per-compile-stuff.pkg = #
cpl::make_per_compile_stuff # This record actually just contains stuff like a stamp generator and optional prettyprinter,
{ # nothing really core to the compile like sourcecode, parsetree or symbol table -- the serious
sourcecode_info, # symbol table stuff is in compiler_state.
deep_syntax_transform => \\ x = x, # This can be used to profile or instrument code or insert debug support code. This transform gets applied in src/lib/compiler/front/typer/main/type-package-language-g.pkg prettyprinter_or_null => NULL,
compiler_verbosity => pcs::print_everything
};
#
fun raise_compile_error_if_compile_errors s
=
if (pcs::saw_errors per_compile_stuff)
#
raise exception err::COMPILE_ERROR;
fi;
fun evaluate_and_print_toplevel_mythryl_declaration raw_declaration
=
{
top_level_pkg_etc_defs_jar = cs::get_top_level_pkg_etc_defs_jar ();
baselevel_pkg_etc_defs_jar = cs::get_baselevel_pkg_etc_defs_jar ();
#
fun get_current_compiler_mapstack_set ()
=
cms::layer_compiler_mapstack_sets
(
top_level_pkg_etc_defs_jar.get_mapstack_set (),
baselevel_pkg_etc_defs_jar.get_mapstack_set ()
);
print_depth = control_print::print_depth;
(get_current_compiler_mapstack_set ())
->
{ symbolmapstack,
linking_mapstack,
inlining_mapstack
};
crossmodule_inlining_aggressiveness
=
ctl::inline::get ();
#
fun debug_print
#
(debugging: Ref( Bool ))
#
( msg: String,
printfn: pp::Prettyprinter -> X -> Void,
arg: X
)
=
if *debugging
#
pp::with_standard_prettyprinter
#
(err::default_plaint_sink ()) []
#
(\\ pp: pp::Prettyprinter
=
{ pp.box {. pp.rulename "repl1";
pp.lit msg;
pp.newline();
pp.box {. pp.rulename "repl2";
printfn pp arg;
};
};
pp.newline();
}
);
fi;
fun unparse_raw_syntax_tree_debug
( msg,
declaration
)
=
debug_print
ctl::unparse_raw_syntax_tree
( msg,
unparse_raw_syntax_tree_declaration,
declaration
)
where
fun unparse_raw_syntax_tree_declaration
prettyprinter
declaration
=
urs::unparse_declaration
(symbolmapstack, NULL)
prettyprinter
(declaration, *print_depth);
end;
#
fun prettyprint_raw_syntax_tree_debug
( msg,
declaration
)
=
{ fun prettyprint_raw_syntax_tree_declaration
prettyprinter
declaration
=
prs::prettyprint_declaration
(symbolmapstack, NULL)
prettyprinter
(declaration, *print_depth);
debug_print
ctl::prettyprint_raw_syntax_tree
( msg,
prettyprint_raw_syntax_tree_declaration,
declaration
);
};
#
fun print_raw_syntax_tree_as_nada_debug (msg, declaration) # More experimental alternate syntax support.
=
{ fun print_raw_syntax_tree_as_nada prettyprinter declaration
=
print_raw_syntax_tree_as_nada::print_declaration_as_nada
(symbolmapstack, NULL)
prettyprinter
(declaration, *print_depth);
debug_print (ctl::unparse_raw_syntax_tree) (msg, print_raw_syntax_tree_as_nada, declaration);
};
#
fun unparse_deep_syntax_tree_debug (msg, declaration)
=
{ fun unparse_deep_syntax_tree_declaration prettyprinter declaration
=
unparse_deep_syntax::unparse_declaration # unparse_deep_syntax is from src/lib/compiler/front/typer/print/unparse-deep-syntax.pkg (symbolmapstack, NULL)
prettyprinter
(declaration, *print_depth);
debug_print
(ctl::unparse_deep_syntax_tree)
( msg,
unparse_deep_syntax_tree_declaration,
declaration
);
};
#
fun print_deep_syntax_tree_as_nada_debug (msg, declaration) # More experimental alternate syntax support.
=
{ fun print_deep_syntax_tree_as_nada prettyprinter declaration
=
print_deep_syntax_as_nada::print_declaration_as_nada
(symbolmapstack, NULL)
prettyprinter
(declaration, *print_depth);
debug_print
(ctl::unparse_deep_syntax_tree)
( msg,
print_deep_syntax_tree_as_nada,
declaration
);
};
# NB: The difference between unparsing and prettyprinting is that unparsing tries to reproduce the original sourcecode but prettyprinting just dumps the parsetree datastructure literally.
unparse_raw_syntax_tree_debug( "Raw_Syntax: ", raw_declaration); # Testing code to print raw_declaration.
prettyprint_raw_syntax_tree_debug( "Raw_Syntax: ", raw_declaration); # Testing code to print raw_declaration.
# print_raw_syntax_tree_as_nada_debug( "LIB7_SYNTAX:", raw_declaration); # Testing code to translate raw_declaration to lib7.
# "Returning deep_syntax_tree and
# exported_highcode_variables here
# is a bad idea: They hold on to
# things unnecessarily.- # (But they are used in the prettyprint_declaration below. --CrT)
# This must be fixed in the long run."
# -- Zhong # XXX SUCKO FIXME
#
# We do this one other place:
# src/app/makelib/compile/compile-in-dependency-order-g.pkg #
(cpl::translate_raw_syntax_to_execode
{
sourcecode_info,
raw_declaration,
#
symbolmapstack,
inlining_mapstack,
#
per_compile_stuff,
handle_compile_errors => raise_compile_error_if_compile_errors,
crossmodule_inlining_aggressiveness,
#
compiledfile_version => () # We don't have real on-disk compiled-code binaries here, we're just compiling console strings to memory.
})
->
{ code_and_data_segments,
new_symbolmapstack,
deep_syntax_declaration,
export_picklehash,
exported_highcode_variables,
import_trees,
inline_expression,
...
};
package_closure
=
lrp::make_package_closure
{
code_and_data_segments,
exception_wrapper => EXCEPTION_DURING_EXECUTION
}
then raise_compile_error_if_compile_errors ();
package_closure
=
cw::trap_callcc (interruptible package_closure);
rpc::this_fn_profiling_hook_refcell__global # Ultimately from src/c/main/construct-runtime-package.c
:=
wpr::in_other_code__cpu_user_index;
new_linking_mapstack
=
if *ctl::execute_compiled_code # TRUE unless manually overriden.
#
lrp::link_and_run_package_closure
{
package_closure, # Package being linked into memory image.
import_trees, # Values which it needs to import from other packages.
linking_mapstack, # Values available for import from other packages.
export_picklehash # 'Name' under which exports from this package will be published.
};
else
linking_mapstack; # This is a delta including only exports from this package.
fi;
rpc::this_fn_profiling_hook_refcell__global # Ultimately from src/c/main/construct-runtime-package.c
:=
wpr::in_compiler__cpu_user_index; # Remember that we are now "in compiler" for CPU-cycle-accounting purposes.
new_compiler_mapstack_set
=
cms::make_compiler_mapstack_set
{
symbolmapstack => new_symbolmapstack,
linking_mapstack => new_linking_mapstack,
#
inlining_mapstack => ims::make_inlining_mapstack
( export_picklehash,
inline_expression
)
};
# Re-fetch toplevel tables because execution
# may have changed their contents:
#
new_local_compiler_mapstack_set
=
cms::concatenate_compiler_mapstack_sets
(
new_compiler_mapstack_set,
top_level_pkg_etc_defs_jar.get_mapstack_set ()
);
# Install any new package defs etc
# in the global environment:
#
top_level_pkg_etc_defs_jar.set_mapstack_set
#
new_local_compiler_mapstack_set;
#
# NB: We install the new local compiler state
# before printing: Otherwise we would
# find ourselves in trouble if the
# autoloader changed the the contents
# of loc out from under our feet:
#
fun look_and_load symbol
=
{ fun get ()
=
syx::get
( cms::symbolmapstack_part (get_current_compiler_mapstack_set ()),
symbol
);
get ()
except
syx::UNBOUND = get ();
};
# Notice that even through several potential rounds
# the result of get_symbols is constant (up to list
# order), so memoization (as performed by
# syx::special) is ok.
#
fun get_symbols ()
=
{ symbolmapstack
=
cms::symbolmapstack_part
(get_current_compiler_mapstack_set ());
syx::symbols symbolmapstack;
};
symbolmapstack1
=
syx::special
(
look_and_load,
get_symbols
);
e0 = get_current_compiler_mapstack_set ();
e1 = cms::make_compiler_mapstack_set
{
symbolmapstack => symbolmapstack1,
linking_mapstack => cms::linking_part e0,
inlining_mapstack => cms::inlining_part e0
};
unparse_deep_syntax_tree_debug( "Deep_Syntax:", deep_syntax_declaration); # Testing code to print deep_syntax_tree.
# print_deep_syntax_tree_as_nada_debug( "LIB7_SYNTAx:", deep_syntax_declaration); # Testing code to translate deep_syntax_tree to lib7.
if *myp::print_interactive_prompts
#
print "\n";
fi;
if *myp::unparse_result
#
# Print the result of the evaluated expression:
#
pp::with_standard_prettyprinter
#
sourcecode_info.error_consumer [] # unparse_interactive_deep_syntax_declaration is from src/lib/compiler/src/print/unparse-interactive-deep-syntax-declaration.pkg #
(\\ pp: pp::Prettyprinter
=
unparse_interactive_deep_syntax_declaration::unparse_declaration
e1
(pp, cv)
(deep_syntax_declaration, exported_highcode_variables)
);
fi;
}; # fun evaluate_and_print_toplevel_mythryl_declaration
fun evaluate_and_print_toplevel_mythryl_declarations []
=>
();
evaluate_and_print_toplevel_mythryl_declarations (declaration ! declarations)
=>
{ evaluate_and_print_toplevel_mythryl_declaration declaration;
evaluate_and_print_toplevel_mythryl_declarations declarations;
};
end;
#
fun prompt_read_evaluate_and_print_one_toplevel_mythryl_expression ()
=
case (prompt_read_parse_and_return_one_toplevel_mythryl_expression ())
#
THE raw_declaration => evaluate_and_print_toplevel_mythryl_declarations (rsj::extract_toplevel_declarations raw_declaration);
NULL => raise exception END_OF_FILE;
esac;
#
# The point of the
#
# rsj::extract_toplevel_declarations
#
# call above is that the current
#
# src/lib/compiler/front/parser/yacc/mythryl.grammar
#
# returns the entire body of a Mythryl script as a single
# raw-syntax tree, but we need scripts like
#
# #!/usr/bin/mythryl
# use "foo.lib";
# foo::whatever();
#
# to compile and execute one statement at a time,
# otherwise package 'foo' will come up undefined
# during compilation of 'foo::whatever();', because
# that becomes defined only after 'load "foo.lib";'
# has actually executed.
#
# To fix this problem we use rsj::extract_toplevel_declarations
# to break the script syntax tree back into its natural parts,
# and then call evaluate_and_print_toplevel_mythryl_declaration
# separately on each part. -- 2012-01-22 CrT
#
fun inner_read_eval_print_loop ()
=
{ prompt_read_evaluate_and_print_one_toplevel_mythryl_expression ();
inner_read_eval_print_loop ();
};
#
# This is the core interactive
# read-eval-print loop.
#
# You might expect to find the
# the interactive prompt printed out
# here, but in fact the code for
# -that- is buried deep in the
# get_line ()
# function in
# src/lib/compiler/front/parser/main/mythryl-parser-guts.pkg #
# The actual prompt strings are kept in
# myp::primary_prompt and
# myp::secondary_prompt
interruptible
if keep_looping inner_read_eval_print_loop;
else prompt_read_evaluate_and_print_one_toplevel_mythryl_expression;
fi
();
}; # fun read_eval_print_loop
herein
#
fun with_exception_trapping # PUBLIC.
#
{ treat_as_user: Bool,
pp: Null_Or( pp::Prettyprinter )
}
#
{ thunk: Void -> Void,
flush: Void -> Void,
fate: Exception -> Void
}
=
{
say = case pp
#
THE pp => say
where
fun say (msg: String)
=
{ pp.lit msg;
pp.newline();
};
end;
NULL => say;
esac;
# fun show_history' [s] => say (cat [" raised at: ", s, "\n"]);
# show_history' (s ! r) => { show_history' r; say (cat [" ", s, "\n"]);};
# show_history' [] => ();
# end;
fun show_history' [s] => {
say (cat [" raised at: ", s, "\n"]);
};
show_history' (s ! r) => {
show_history' r;
say (cat [" ", s, "\n"]);
};
show_history' [] => ();
end;
#
fun exception_message
(cx::COMPILE s)
=>
cat ["Compile: \"", s, "\""];
exception_message exception'
=>
xs::exception_message
exception';
end;
#
fun show_history exception'
=
show_history'
(lib7::exception_history exception');
#
fun user_handle (EXCEPTION_DURING_EXECUTION exception')
=>
user_handle exception';
user_handle exception'
=>
{
msg = exception_message exception';
name = exception_name exception';
if (name == "CONTROL_C_SIGNAL")
# 2008-01-07 CrT: This case wasn't here originally,
# and is probably only needed due to
# my screwing up the logic elsewhere.
#
# (Before my last round of frigging around,
# the non-bt_handle CONTROL_C_SIGNAL case
# was handling this.) XXX BUGGO FIXME
#
say "\nCaught <CTRL>-C. (Do <CTRL>-D to exit.)";
else
if (msg == name) say (cat ["\nUncaught exception ", name, "\n"]);
else say (cat ["\nUncaught exception ", name, " [", msg, "]\n"]);
fi;
show_history exception';
fi;
flush ();
fate exception';
};
end;
#
fun bug_handle exception'
=
{
msg = exception_message exception';
name = exception_name exception';
say (cat ["\nUnexpected exception (bug?): ", name, " [", msg, "]\n"]);
show_history exception';
flush();
fate exception';
};
#
fun non_bt_handle exception' # "bt" might be "base type" here... ?
=
case exception'
#
END_OF_FILE
=>
say "\n";
(CONTROL_C_SIGNAL | EXCEPTION_DURING_EXECUTION CONTROL_C_SIGNAL)
=>
{
say "\nSignal caught. (Do <CTRL>-D to exit.)\n";
flush();
fate exception';
};
err::COMPILE_ERROR
=>
{
flush();
fate exception';
};
cx::COMPILE "syntax error"
=>
{
flush();
fate exception';
};
cx::COMPILE s
=>
{
say (cat ["\nUncaught exception COMPILE: \"", s, "\"\n"]);
flush();
fate exception';
};
cw::TOPLEVEL_CALLCC
=>
{
say("Error: throw from one top-level expression into another\n");
flush ();
fate exception';
};
(lrp::LINK | EXCEPTION_DURING_EXECUTION lrp::LINK)
=>
{
flush ();
fate exception';
};
EXCEPTION_DURING_EXECUTION exception''
=>
{
user_handle exception'';
};
exception''
=>
{
if treat_as_user user_handle exception'';
else bug_handle exception'';
fi;
};
esac;
runtime_internals::tdp::with_monitors # runtime_internals is from src/lib/std/src/nj/runtime-internals.pkg FALSE
thunk
except
e = non_bt_handle e;
}; # fun with_exception_trapping
# Interactive loop, with error handling.
#
# We wind up here primarily to execute
# #!/usr/bin/mythryl
# scripts:
#
# o Logic in
# src/c/o/mythryl.c
# invokes /usr/bin/mythryld
# with the unix environment setting
# MYTHRYL_SCRIPT=<stdin>
#
# o Our main executable
# /usr/bin/mythryld
# starts execution near the bottom of
# src/lib/core/internal/mythryld-app.pkg # where the first thing it does is check
# MYTHRYL_SCRIPT and if it is set (to script_name) it
#
# * Sets
# mythryl_parser::print_interactive_prompts := FALSE;
# to suppress interactive prompting;
#
# * Skips commandline switch processing,
# and thus the usual
# src/app/makelib/main/makelib-g.pkg # entry into read_eval_print_from_user()
# in this file.
#
# * Invokes read_eval_print_from_script() in
# src/lib/compiler/toplevel/interact/read-eval-print-loops-g.pkg # which promptly invokes us.
#
fun read_eval_print_from_script file_name # PUBLIC. 'file_name' can be "<stdin>" else filename for script -- in practice, currently always the former.
=
{
source_stream
=
if (file_name == "<stdin>") fil::stdin;
else fil::open_for_read file_name;
fi;
source = sci::make_sourcecode_info
{
file_name,
line_num => 1,
source_stream,
is_interactive => TRUE, # ?
error_consumer => err::default_plaint_sink ()
};
#
fun flush' ()
=
();
# case (fil::max_readable_without_blocking # Commented out 2012-12-23 CrT because this is basically the only use and the whole idea of max_readable_without_blocking() seems ill-advised -- encourages polling.
# (
# fil::stdin,
# 4096
# ))
#
# (NULL | THE 0)
# =>
# ();
#
# THE _
# =>
# { ignore (fil::read fil::stdin);
# flush'();
# };
# esac;
#
fun flush ()
=
{ source.saw_errors := FALSE;
#
flush' ()
except
iox::IO _ = ();
};
#
# We want scripts to exit cleanly on the first
# uncaught exception, so we do NOT loop here
# after catching one:
with_exception_trapping
{ treat_as_user => FALSE,
pp => NULL
}
{ thunk => \\ () = read_eval_print_loop { sourcecode_info => source, keep_looping => TRUE },
flush,
fate => ignore
};
}; # fun read_eval_print_from_script
fun input_is_tty f # This fn is duplicated between here and src/app/makelib/main/makelib-g.pkg XXX SUCKO FIXME (Should probably be a standard library function anyhow.) =
{ (fil::pur::get_reader (fil::get_instream f))
->
(rd, buf);
is_tty = case rd
#
tbi::FILEREADER { io_descriptor => THE iod, ... }
=>
(wnx::io::iod_to_iodkind iod == wnx::io::CHAR_DEVICE);
_ => FALSE;
esac;
# Since getting the reader will have terminated
# the stream, we now need to build a new stream:
#
fil::set_instream
(f, fil::pur::make_instream (rd, buf) );
is_tty;
};
fun read_eval_print_from_stream # PUBLIC.
(
(file_name: String), # Filename for 'stream', else "<Input_Stream>" or such.
(source_stream: fil::Input_Stream)
)
= # We get wrapped in src/lib/compiler/toplevel/interact/read-eval-print-loops-g.pkg { # mythryl_compiler_compiler_g that wrapper to compile_in_dependency_order_g
# where it gets used in maybe_compile_and_run_mythryl_codestring to compile the
# facility to compile and run little code fragments before/after each file compile.
#
# mythryl_compiler_compiler_g is from src/app/makelib/mythryl-compiler-compiler/mythryl-compiler-compiler-g.pkg # compile_in_dependency_order_g is from src/app/makelib/compile/compile-in-dependency-order-g.pkg is_interactive = input_is_tty source_stream;
#
source = sci::make_sourcecode_info
{
file_name, # Filename for 'stream', else "<Input_Stream>" or such.
line_num => 1,
source_stream,
is_interactive,
error_consumer => err::default_plaint_sink ()
};
read_eval_print_loop { sourcecode_info => source, keep_looping => TRUE }
except
exception'
=
{ sci::close_source source;
#
case exception'
#
END_OF_FILE => ();
_ => raise exception exception';
esac;
};
};
#
fun parse_string_to_raw_declarations # PUBLIC. This facility created for src/lib/x-kit/widget/edit/eval-mode.pkg { #
sourcecode_info: sci::Sourcecode_Info, # Source code to compile, also error sink.
pp: pp::Prettyprinter # Where to prettyprint results.
} #
: #
List( raw::Declaration ) #
=
{
prompt_read_parse_and_return_one_toplevel_mythryl_expression
=
pm::prompt_read_parse_and_return_one_toplevel_mythryl_expression
#
sourcecode_info;
result = REF ([]: List(raw::Declaration));
fun parse_one_toplevel_mythryl_expression ()
=
case (prompt_read_parse_and_return_one_toplevel_mythryl_expression ())
#
THE raw_declaration
=>
result := rsj::extract_toplevel_declarations raw_declaration;
NULL => ();
esac;
fun do_it_with_exception_trapping () # I do not know if the parser throws exceptions, but I presume it does in the case of syntax errors.
= # If not, we can dispense with this stuff. -- 2015-09-27 CrT
{
with_exception_trapping
{ treat_as_user => FALSE,
pp => THE pp
}
{ thunk => parse_one_toplevel_mythryl_expression,
flush => \\ () = (),
fate => ignore
};
};
interruptible # Trap CTRL-C (i.e. Posix SIGINT interrupts). I've retained this from parent code mostly as a guide to future interrupt trapping if desired,
do_it_with_exception_trapping # but while in single-threaded SML/NJ this was obviously desirable and the required functionality clear, in the multi-hostthreaded, multi-microthreaded
(); # Mythryl context is is far from clear that this is useful, or what its functionality should be. (Also mythryl-emacs traps ^C anyhow!) -- 2015-09-21 CrT
*result;
}; # fun parse_string_to_raw_declarations
# # so I thought it was better to clone-and-mutate than to add more conditionals and make it an even bigger mess. -- 2015-09-09 CrT
fun compile_raw_declaration_to_package_closure # PUBLIC. This facility created for src/lib/x-kit/widget/edit/eval-mode.pkg { #
declaration: raw::Declaration, #
sourcecode_info: sci::Sourcecode_Info, # Source code to compile, also error sink.
pp: pp::Prettyprinter, # Where to prettyprint results.
compiler_state_stack: (cs::Compiler_State, List(cs::Compiler_State)), # Compiler symbol tables to use for this compile.
options: List( cs::Compile_And_Eval_String_Option ) # Future-proofing, lets us add more parameters in future without breaking backward compatibility at the client-call level.
} #
: #
Null_Or (
{ package_closure: seg::Package_Closure,
import_trees: List( it::Import_Tree ),
export_picklehash: Null_Or( ph::Picklehash ),
linking_mapstack: lt::Picklehash_To_Heapchunk_Mapstack,
code_and_data_segments: seg::Code_And_Data_Segments,
new_symbolmapstack: syx::Symbolmapstack, # A symbol table delta containing (only) stuff from raw_declaration.
deep_syntax_declaration: ds::Declaration, # Typechecked form of raw_declaration.
exported_highcode_variables: List( tmp::Codetemp ),
inline_expression: Null_Or( acf::Function ),
top_level_pkg_etc_defs_jar: cs::Compiler_Mapstack_Set_Jar,
get_current_compiler_mapstack_set: Void -> cs::Compiler_Mapstack_Set,
compiler_verbosity: pcs::Compiler_Verbosity,
compiler_state_stack: (cs::Compiler_State, List(cs::Compiler_State))
}
)
=
{
Compile_And_Eval_String_Options
=
{ compiler_verbosity: pcs::Compiler_Verbosity,
deep_syntax_transform: ds::Declaration -> ds::Declaration
};
fun process_options (options: List( cs::Compile_And_Eval_String_Option ))
=
{ my_compiler_verbosity = REF pcs::print_expression_value;
my_deep_syntax_transform = REF (\\ x = x);
#
apply do_option options
where
fun do_option (cs::COMPILER_VERBOSITY v) => my_compiler_verbosity := v;
do_option (cs::DEEP_SYNTAX_TRANSFORM t) => my_deep_syntax_transform := t;
end;
end;
{ compiler_verbosity => *my_compiler_verbosity,
deep_syntax_transform => *my_deep_syntax_transform
};
};
(process_options options)
->
{ compiler_verbosity,
deep_syntax_transform
};
per_compile_stuff # per_compile_stuff is from src/lib/compiler/front/typer-stuff/main/per-compile-stuff.pkg = #
cpl::make_per_compile_stuff # This record actually just contains stuff like a stamp generator and optional prettyprinter,
{ # nothing really core to the compile like sourcecode, parsetree or symbol table -- the serious
sourcecode_info, # symbol table stuff is in compiler_state.
deep_syntax_transform, # This can be used to profile or instrument code or insert debug support code. This transform gets applied in src/lib/compiler/front/typer/main/type-package-language-g.pkg prettyprinter_or_null => THE pp,
compiler_verbosity
};
fun raise_compile_error_if_compile_errors s
=
if (pcs::saw_errors per_compile_stuff)
#
raise exception err::COMPILE_ERROR;
fi;
fun compile_toplevel_mythryl_declaration
(
raw_declaration: raw::Declaration,
compiler_state_stack: (cs::Compiler_State, List(cs::Compiler_State))
)
=
{
compiler_state_stack
->
( compiler_state: cs::Compiler_State,
compiler_states: List( cs::Compiler_State )
);
top_level_pkg_etc_defs_jar = compiler_state.top_level_pkg_etc_defs_jar;
baselevel_pkg_etc_defs_jar = compiler_state.baselevel_pkg_etc_defs_jar;
#
fun get_current_compiler_mapstack_set ()
=
cms::layer_compiler_mapstack_sets
(
top_level_pkg_etc_defs_jar.get_mapstack_set (),
baselevel_pkg_etc_defs_jar.get_mapstack_set ()
);
print_depth = control_print::print_depth;
(get_current_compiler_mapstack_set ())
->
{ symbolmapstack,
linking_mapstack,
inlining_mapstack
};
crossmodule_inlining_aggressiveness
=
ctl::inline::get ();
#
fun debug_print
#
(debugging: Ref( Bool ))
#
( msg: String,
printfn: pp::Prettyprinter -> X -> Void,
arg: X
)
=
if *debugging
#
pp.box {. pp.rulename "repl1";
pp.lit msg;
pp.newline();
pp.box {. pp.rulename "repl2";
printfn pp arg;
};
};
pp.newline();
fi;
fun unparse_raw_syntax_tree_debug
( msg,
declaration
)
=
debug_print
ctl::unparse_raw_syntax_tree
( msg,
unparse_raw_syntax_tree_declaration,
declaration
)
where
fun unparse_raw_syntax_tree_declaration
prettyprinter
declaration
=
urs::unparse_declaration
(symbolmapstack, NULL)
prettyprinter
(declaration, *print_depth);
end;
#
fun prettyprint_raw_syntax_tree_debug
( msg,
declaration
)
=
{ fun prettyprint_raw_syntax_tree_declaration
prettyprinter
declaration
=
prs::prettyprint_declaration
(symbolmapstack, NULL)
prettyprinter
(declaration, *print_depth);
debug_print
ctl::prettyprint_raw_syntax_tree
( msg,
prettyprint_raw_syntax_tree_declaration,
declaration
);
};
#
fun print_raw_syntax_tree_as_nada_debug (msg, declaration) # More experimental alternate syntax support.
=
{ fun print_raw_syntax_tree_as_nada prettyprinter declaration
=
print_raw_syntax_tree_as_nada::print_declaration_as_nada
(symbolmapstack, NULL)
prettyprinter
(declaration, *print_depth);
debug_print (ctl::unparse_raw_syntax_tree) (msg, print_raw_syntax_tree_as_nada, declaration);
};
#
fun unparse_deep_syntax_tree_debug (msg, declaration)
=
{ fun unparse_deep_syntax_tree_declaration prettyprinter declaration
=
unparse_deep_syntax::unparse_declaration # unparse_deep_syntax is from src/lib/compiler/front/typer/print/unparse-deep-syntax.pkg (symbolmapstack, NULL)
prettyprinter
(declaration, *print_depth);
debug_print
(ctl::unparse_deep_syntax_tree)
( msg,
unparse_deep_syntax_tree_declaration,
declaration
);
};
#
fun print_deep_syntax_tree_as_nada_debug (msg, declaration) # More experimental alternate syntax support.
=
{ fun print_deep_syntax_tree_as_nada prettyprinter declaration
=
print_deep_syntax_as_nada::print_declaration_as_nada
(symbolmapstack, NULL)
prettyprinter
(declaration, *print_depth);
debug_print
(ctl::unparse_deep_syntax_tree)
( msg,
print_deep_syntax_tree_as_nada,
declaration
);
};
# NB: The difference between unparsing and prettyprinting is that unparsing tries to reproduce the original sourcecode but prettyprinting just dumps the parsetree datastructure literally.
unparse_raw_syntax_tree_debug( "Raw_Syntax: ", raw_declaration); # Testing code to print raw_declaration.
prettyprint_raw_syntax_tree_debug( "Raw_Syntax: ", raw_declaration); # Testing code to print raw_declaration.
# print_raw_syntax_tree_as_nada_debug( "LIB7_SYNTAX:", raw_declaration); # Testing code to translate raw_declaration to lib7.
# "Returning deep_syntax_tree and
# exported_highcode_variables here
# is a bad idea: They hold on to
# things unnecessarily.- # (But they are used in the prettyprint_declaration below. --CrT)
# This must be fixed in the long run."
# -- Zhong # XXX SUCKO FIXME
#
# We do this one other place:
# src/app/makelib/compile/compile-in-dependency-order-g.pkg #
(cpl::translate_raw_syntax_to_execode
{
sourcecode_info,
raw_declaration,
#
symbolmapstack,
inlining_mapstack,
#
per_compile_stuff,
handle_compile_errors => raise_compile_error_if_compile_errors,
crossmodule_inlining_aggressiveness,
#
compiledfile_version => () # We don't have real on-disk compiled-code binaries here, we're just compiling console strings to memory.
})
->
{ code_and_data_segments,
/* */ new_symbolmapstack,
deep_syntax_declaration,
/* */ export_picklehash,
/* */ exported_highcode_variables,
/* */ import_trees,
/* */ inline_expression,
...
};
package_closure
=
lrp::make_package_closure
{
code_and_data_segments,
exception_wrapper => EXCEPTION_DURING_EXECUTION
}
then raise_compile_error_if_compile_errors ();
package_closure
=
cw::trap_callcc (interruptible package_closure);
rpc::this_fn_profiling_hook_refcell__global # Ultimately from src/c/main/construct-runtime-package.c
:=
wpr::in_other_code__cpu_user_index;
THE
{
package_closure, # Package being linked into memory image.
import_trees, # Values which it needs to import from other packages.
linking_mapstack, # Values available for import from other packages.
export_picklehash, # 'Name' under which exports from this package will be published.
code_and_data_segments,
new_symbolmapstack,
deep_syntax_declaration,
exported_highcode_variables,
inline_expression,
top_level_pkg_etc_defs_jar,
get_current_compiler_mapstack_set,
compiler_verbosity,
compiler_state_stack => (compiler_state, compiler_states)
};
}; # fun compile_toplevel_mythryl_declaration
result = REF NULL;
fun do_it ()
=
result := compile_toplevel_mythryl_declaration
( declaration,
compiler_state_stack
);
fun do_it_with_exception_trapping () # The compiler handles errors by throwing an exception, so we need to trap it and return normally.
=
{
with_exception_trapping
{ treat_as_user => FALSE,
pp => THE pp
}
{ thunk => do_it,
flush => \\ () = (),
fate => ignore
};
};
interruptible # Trap CTRL-C (i.e. Posix SIGINT interrupts). I've retained this from parent code mostly as a guide to future interrupt trapping if desired,
do_it_with_exception_trapping # but while in single-threaded SML/NJ this was obviously desirable and the required functionality clear, in the multi-hostthreaded, multi-microthreaded
(); # Mythryl context is is far from clear that this is useful, or what its functionality should be. (Also mythryl-emacs traps ^C anyhow!) -- 2015-09-21 CrT
*result;
}; # fun compile_raw_declaration_to_package_closure
#
fun link_and_run_package_closure # PUBLIC. This facility created for src/lib/x-kit/widget/edit/eval-mode.pkg { #
sourcecode_info: sci::Sourcecode_Info, # Source code to compile, also error sink.
pp: pp::Prettyprinter # Where to prettyprint results.
}
{ package_closure: seg::Package_Closure,
import_trees: List( it::Import_Tree ),
export_picklehash: Null_Or( ph::Picklehash ),
linking_mapstack: lt::Picklehash_To_Heapchunk_Mapstack,
code_and_data_segments: seg::Code_And_Data_Segments,
new_symbolmapstack: syx::Symbolmapstack, # A symbol table delta containing (only) stuff from raw_declaration.
deep_syntax_declaration: ds::Declaration, # Typechecked form of raw_declaration.
exported_highcode_variables: List( tmp::Codetemp ),
inline_expression: Null_Or( acf::Function ),
top_level_pkg_etc_defs_jar: cs::Compiler_Mapstack_Set_Jar,
get_current_compiler_mapstack_set: Void -> cs::Compiler_Mapstack_Set,
compiler_verbosity: pcs::Compiler_Verbosity,
compiler_state_stack: (cs::Compiler_State, List(cs::Compiler_State)) # Compiler symbol tables to use for this compile.
} #
: #
(cs::Compiler_State, List(cs::Compiler_State)) # Updated compiler symbol tables. Caller may keep or discard.
=
{ compiler_state_stack -> (compiler_state, compiler_states);
#
fun link_and_run
(
)
=
{
#
fun debug_print
#
(debugging: Ref( Bool ))
#
( msg: String,
printfn: pp::Prettyprinter -> X -> Void,
arg: X
)
=
if *debugging
#
pp.box {. pp.rulename "repl1";
pp.lit msg;
pp.newline();
pp.box {. pp.rulename "repl2";
printfn pp arg;
};
};
pp.newline();
fi;
# NB: The difference between unparsing and prettyprinting is that unparsing tries to reproduce the original sourcecode but prettyprinting just dumps the parsetree datastructure literally.
new_linking_mapstack
=
lrp::link_and_run_package_closure
{
package_closure, # Package being linked into memory image.
import_trees, # Values which it needs to import from other packages.
linking_mapstack, # Values available for import from other packages.
export_picklehash # 'Name' under which exports from this package will be published.
};
rpc::this_fn_profiling_hook_refcell__global # Ultimately from src/c/main/construct-runtime-package.c
:=
wpr::in_compiler__cpu_user_index; # Remember that we are now "in compiler" for CPU-cycle-accounting purposes.
new_compiler_mapstack_set
=
cms::make_compiler_mapstack_set
{
symbolmapstack => new_symbolmapstack,
linking_mapstack => new_linking_mapstack,
#
inlining_mapstack => ims::make_inlining_mapstack
( export_picklehash,
inline_expression
)
};
# Re-fetch toplevel tables because execution
# may have changed their contents:
#
new_local_compiler_mapstack_set
=
cms::concatenate_compiler_mapstack_sets
(
new_compiler_mapstack_set,
top_level_pkg_etc_defs_jar.get_mapstack_set ()
);
# Install any new package defs etc
# in our compile environment:
#
top_level_pkg_etc_defs_jar.set_mapstack_set
#
new_local_compiler_mapstack_set;
#
# NB: We install the new local compiler state
# before printing: Otherwise we would
# find ourselves in trouble if the
# autoloader changed the the contents
# of loc out from under our feet.
#
fun look_and_load symbol
=
{ fun get ()
=
syx::get
( cms::symbolmapstack_part (get_current_compiler_mapstack_set ()),
symbol
);
get ()
except
syx::UNBOUND = get ();
};
# Notice that even through several potential rounds
# the result of get_symbols is constant (up to list
# order), so memoization (as performed by
# syx::special) is ok.
#
fun get_symbols ()
=
{ symbolmapstack
=
cms::symbolmapstack_part
(get_current_compiler_mapstack_set ());
syx::symbols symbolmapstack;
};
symbolmapstack1
=
syx::special
(
look_and_load,
get_symbols
);
e0 = get_current_compiler_mapstack_set ();
e1 = cms::make_compiler_mapstack_set
{
symbolmapstack => symbolmapstack1,
linking_mapstack => cms::linking_part e0,
inlining_mapstack => cms::inlining_part e0
};
# unparse_deep_syntax_tree_debug( "Deep_Syntax:", deep_syntax_declaration); # Testing code to print deep_syntax_tree.
# print_deep_syntax_tree_as_nada_debug( "LIB7_SYNTAx:", deep_syntax_declaration); # Testing code to translate deep_syntax_tree to lib7.
# Print the result of the evaluated expression:
#
if compiler_verbosity.print_expression_value
#
unparse_interactive_deep_syntax_declaration::unparse_declaration
e1
(pp, compiler_verbosity)
(deep_syntax_declaration, exported_highcode_variables);
fi;
(compiler_state, compiler_states): (cs::Compiler_State, List(cs::Compiler_State));
}; # fun link_and_run
result = REF compiler_state_stack;
fun link_and_run_package_closure' ()
=
result := link_and_run ();
fun do_it_with_exception_trapping ()
=
{
with_exception_trapping
{ treat_as_user => FALSE,
pp => THE pp
}
{ thunk => link_and_run_package_closure',
flush => \\ () = (),
fate => ignore
};
};
interruptible # Trap CTRL-C (i.e. Posix SIGINT interrupts). I've retained this from parent code mostly as a guide to future interrupt trapping if desired,
do_it_with_exception_trapping # but while in single-threaded SML/NJ this was obviously desirable and the required functionality clear, in the multi-hostthreaded, multi-microthreaded
(); # Mythryl context is is far from clear that this is useful, or what its functionality should be. (Also mythryl-emacs traps ^C anyhow!) -- 2015-09-21 CrT
*result;
}; # fun link_and_run_package_closure
fun read_eval_print_from_user () # PUBLIC. This is the interactive loop used at the Linux commandline, invoked by src/app/makelib/main/makelib-g.pkg =
{
# is_interactive
# =
# input_is_tty fil::stdin;
print "\n";
print mcv::mythryl_interactive_banner; # Something like: "Mythryl 110.58.3.0.2 built Thu Dec 23 14:11:49 2010"
print "\n(You might prefer to use M-x eval in mythryl-emacs.)";
print "\nDo help(); for help.";
outer_loop ();
}
where
#
fun read_eval_print_from_stream' stream
=
{ source = sci::make_sourcecode_info
{
file_name => "stdin", # "filename"
line_num => 1,
source_stream => stream,
is_interactive => FALSE, # Not interactive.
error_consumer => err::default_plaint_sink ()
};
read_eval_print_loop { sourcecode_info => source, keep_looping => FALSE }
except
exception'
=
{ sci::close_source source;
#
case exception'
#
END_OF_FILE => ();
_ => raise exception exception';
esac;
};
};
#
fun eval_string code_string
=
safely::do
{
open_it => {. fil::open_string code_string; },
close_it => fil::close_input,
cleanup => \\ _ = ()
}
read_eval_print_from_stream';
# Drop any terminal newline:
#
fun chomp line
=
string::is_suffix "\n" line ?? string::substring (line, 0, string::length_in_bytes line - 1)
:: line;
#
# There's another implementation of this fn in src/lib/std/src/string-guts.pkg # Probably one of them should be dropped. XXX SUCKO FIXME
#
fun main_loop ()
=
{ print *myp::primary_prompt;
#
input_line = fil::read_line fil::stdin;
case input_line
#
THE line
=>
{ eval_string (chomp line + " ;;");
main_loop ();
};
NULL
=>
# EOF on stdin means it
# is time to shut down:
#
wnx::process::exit
wnx::process::success;
esac;
};
#
fun flush' ()
=
();
# case (fil::max_readable_without_blocking # Commented out 2012-12-23 CrT because this is basically the only use and the whole idea of max_readable_without_blocking() seems ill-advised -- encourages polling.
# (
# fil::stdin,
# 4096
# ))
#
# (NULL | THE 0)
# =>
# ();
#
# THE _ => { ignore (fil::read fil::stdin);
# flush'();
# };
# esac;
#
fun flush ()
=
{
# source.saw_errors := FALSE;
flush' ()
except
iox::IO _ = ();
};
#
fun main_loop_wrapper ()
=
{ include package trap_control_c; # trap_control_c is from src/lib/std/trap-control-c.pkg #
catch_interrupt_signal
main_loop;
();
};
#
fun outer_loop ()
=
{ with_exception_trapping
#
{ treat_as_user => TRUE,
pp => NULL
}
#
{ thunk => \\ () = { main_loop_wrapper (); (); },
flush => \\ () = { flush (); (); },
fate => \\ _ = { outer_loop (); (); }
};
};
# { thunk => main_loop,
# flush => \\ () = (),
# fate => outer_loop o ignore
# };
# fun loop ()
# =
# { fil::write (fil::stdout, *myp::primary_prompt);
# fil::flush fil::stdout;
# input_line = REF (THE "");
# with_exception_trapping
# { treat_as_user => TRUE,
# pp => NULL
# }
# { thunk => \\ () = input_line := fil::read_line fil::stdin,
# flush => \\ () = (),
# fate => loop o ignore
# };
# input_line
# =
# fil::read_line
# fil::stdin;
# case *input_line
# in
# THE line
# =>
# {
# with_exception_trapping
# { treat_as_user => TRUE,
# pp => NULL
# }
# { thunk => \\ () = eval_string (case (fil::read_line fil::stdin) THE line => line; NULL => ""; esac + " ;;"),
# flush => \\ () = (),
# fate => loop o ignore
# };
#
## eval_string (line + " ;;");
# loop ();
# };
# NULL => ();
# esac;
# };
end;
end;
}; # read_eval_print_loop_g
end; # stipulate