## accumulator.pkg
# Compiled by:
# src/lib/x-kit/tut/calculator/calculator-app.lib# The accumulator of the calculator.
#DO set_control "compiler::trap_int_overflow" "TRUE";
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg #
trace = xtr::log_if xtr::io_logging 0; # Conditionally write strings to tracing.log or whatever.
#
# To debug via tracelogging, annotate the code with lines like
#
# trace {. sprintf "foo/top: bar d=%d" bar; };
#
herein
package accumulator
: Accumulator # Accumulator is from src/lib/x-kit/tut/calculator/accumulator.api {
Op_T = PLUS | MINUS | DIVIDE | TIMES;
Plea_Mail = OP Op_T | CLEAR | EQUAL | DIGIT Int;
Out_Val = OVAL Int | OINFINITY | OOVERFLOW;
Accumulator = ACCUMULATOR (Mailslot(Plea_Mail), Mailslot(Out_Val) );
fun math_op_of PLUS => int::(+);
math_op_of MINUS => int::(-);
math_op_of TIMES => int::(*);
math_op_of DIVIDE => int::(/);
end;
fun op_to_string PLUS => "+";
op_to_string MINUS => "-";
op_to_string TIMES => "*";
op_to_string DIVIDE => "/";
end;
fun make_accumulator ()
=
{
plea_slot = make_mailslot ();
result_slot = make_mailslot ();
fun get_plea () = take_from_mailslot plea_slot;
# We use these three functions to
# update the value displayed in the
# GUI number window:
#
fun display v = put_in_mailslot (result_slot, OVAL v);
fun display_infinity () = put_in_mailslot (result_slot, OINFINITY);
fun display_overflow () = put_in_mailslot (result_slot, OOVERFLOW);
fun add_digit_to_operand (operand, digit)
=
{ operand = 10*operand + digit;
#
display operand;
operand;
}
except OVERFLOW = operand;
fun do_err DIVIDE_BY_ZERO => display_infinity ();
do_err OVERFLOW => display_overflow ();
do_err a => raise exception a;
end;
# We have four major states:
#
# Reading_First_Digit_Of_First_Operand
# Reading_Rest_Of_First_Operand
# Reading_First_Digit_Of_Second_Operand
# Reading_Rest_Of_Second_Operand
#
# We represent these states with one loop \\ each,
# and implement transitions between the
# states via calls from one to another.
fun read_first_digit_of_first_operand ()
=
{
case (get_plea ())
#
OP op => {
read_first_digit_of_first_operand ();
};
CLEAR => {
do_clear ();
};
EQUAL => {
read_first_digit_of_first_operand ();
};
DIGIT digit => {
display digit;
read_rest_of_first_operand digit;
};
esac;
}
also
fun read_rest_of_first_operand first_operand
=
{
case (get_plea ())
#
OP operator => {
read_first_digit_of_second_operand (first_operand, operator);
};
CLEAR => {
do_clear ();
};
EQUAL => {
read_first_digit_of_first_operand ();
};
DIGIT digit => {
read_rest_of_first_operand (add_digit_to_operand (first_operand, digit));
};
esac;
}
also
fun read_first_digit_of_second_operand (first_operand, operator)
=
{
display 0;
case (get_plea ())
#
OP operator => {
read_first_digit_of_second_operand (first_operand, operator);
};
CLEAR => {
do_clear ();
};
EQUAL => {
read_first_digit_of_first_operand ();
};
DIGIT digit => {
display digit;
read_rest_of_second_operand (first_operand, operator, digit);
};
esac;
}
also
fun read_rest_of_second_operand (first_operand, operator, second_operand)
=
{
case (get_plea ())
#
CLEAR => {
do_clear ();
};
EQUAL => {
do_equal (first_operand, operator, second_operand);
};
DIGIT digit => {
read_rest_of_second_operand (first_operand, operator, add_digit_to_operand (second_operand, digit));
};
#
OP operator'
=>
{
result = (math_op_of operator) (first_operand, second_operand);
#
display result;
read_first_digit_of_second_operand (result, operator');
}
except
err = { do_err err;
read_first_digit_of_first_operand ();
};
esac;
}
also
fun do_clear ()
=
{ display 0;
read_first_digit_of_first_operand ();
}
also
fun do_equal (first_operand, operator, second_operand)
=
{ { math_op = (math_op_of operator);
result = math_op (first_operand, second_operand);
display result;
}
except
err = do_err err;
read_first_digit_of_first_operand ();
};
make_thread "accumulator" read_first_digit_of_first_operand;
ACCUMULATOR (plea_slot, result_slot);
};
fun send_to_accumulator (ACCUMULATOR (plea_slot, _)) msg
=
put_in_mailslot (plea_slot, msg);
fun from_accumulator_mailop_of (ACCUMULATOR(_, result_slot))
=
take_from_mailslot' result_slot;
}; # package accumulator
end;