MODULE CalcParseTree;
generated by kext
IMPORT CalcParseStd;
IMPORT Fmt;
IMPORT Wr, Thread;
FROM Stdio IMPORT stdout;
<* FATAL Wr.Failure, Thread.Alerted *>
PROCEDURE Format(e: expr): TEXT =
BEGIN
CASE e.kind OF
| 'U' => RETURN "(uminus " & Format(e.e1) & ")";
| '+','-','*','/' =>
RETURN "(" & Fmt.Char(e.kind) & " " &
Format(e.e1) & " " & Format(e.e2) & ")";
| 'N' => RETURN Fmt.Int(e.val);
ELSE
RETURN Fmt.Char(e.kind);
END;
END Format;
PROCEDURE Explain(e: expr) =
BEGIN
Wr.PutText(stdout, " = " & Format(e) & "\n\n");
Wr.Flush(stdout);
END Explain;
REVEAL
T = Public BRANDED "CalcParseTree" OBJECT
allocate_expr: Allocator := NIL;
allocate_list: Allocator := NIL;
allocate_number: Allocator := NIL;
allocate_stat: Allocator := NIL;
OVERRIDES
purge := Proc_Purge;
add_expr := Proc_add_expr;
num_expr := Proc_num_expr;
div_expr := Proc_div_expr;
sub_expr := Proc_sub_expr;
eval_stat := Proc_eval_stat;
uminus_expr := Proc_uminus_expr;
mul_expr := Proc_mul_expr;
paren_expr := Proc_paren_expr;
ident_expr := Proc_ident_expr;
assign_stat := Proc_assign_stat;
END;
PROCEDURE Proc_Purge(self: T): INTEGER =
BEGIN
RETURN CalcParseStd.T.purge(self)
+ Purge(self.allocate_expr)
+ Purge(self.allocate_list)
+ Purge(self.allocate_number)
+ Purge(self.allocate_stat);
END Proc_Purge;
rule procedures
PROCEDURE Proc_eval_stat(self: T;
VAR p0: Original_stat; p1: Original_expr) =
VAR
result: stat;
n1 := NARROW(p1, expr);
BEGIN
IF p0 = NIL THEN
p0 := NewPT(self.allocate_stat, TYPECODE(stat));
END;
result := NARROW(p0, stat);(*%TYPEINIT%stat%*)
CalcParseStd.T.eval_stat(self, p0, p1);
result := NARROW(p0, stat);
BEGIN (* user code *)
Explain(n1.detach())
END;
p0 := result;
END Proc_eval_stat;
PROCEDURE Proc_assign_stat(self: T;
VAR p0: Original_stat; p1: Original_LETTER; p2: Original_expr) =
VAR
result: stat;
n1 := NARROW(p1, LETTER);
n2 := NARROW(p2, expr);
BEGIN
IF p0 = NIL THEN
p0 := NewPT(self.allocate_stat, TYPECODE(stat));
END;
result := NARROW(p0, stat);(*%TYPEINIT%stat%*)
CalcParseStd.T.assign_stat(self, p0, p1, p2);
result := NARROW(p0, stat);
BEGIN (* user code *)
Wr.PutText(stdout, Fmt.Char(n1.val) & " := " &
Fmt.Int(n2.val) & "\n");Explain(n2.detach())
END;
p0 := result;
END Proc_assign_stat;
PROCEDURE Proc_add_expr(self: T;
VAR p0: Original_expr; p1: Original_expr; p2: Original_expr) =
VAR
result: expr;
n1 := NARROW(p1, expr);
n2 := NARROW(p2, expr);
BEGIN
IF p0 = NIL THEN
p0 := NewPT(self.allocate_expr, TYPECODE(expr));
END;
result := NARROW(p0, expr);
result.kind := 'N';
CalcParseStd.T.add_expr(self, p0, p1, p2);
result := NARROW(p0, expr);
BEGIN (* user code *)
result.e1 := n1.detach(); result.e2 := n2.detach(); result.kind := '+'
END;
p0 := result;
END Proc_add_expr;
PROCEDURE Proc_sub_expr(self: T;
VAR p0: Original_expr; p1: Original_expr; p2: Original_expr) =
VAR
result: expr;
n1 := NARROW(p1, expr);
n2 := NARROW(p2, expr);
BEGIN
IF p0 = NIL THEN
p0 := NewPT(self.allocate_expr, TYPECODE(expr));
END;
result := NARROW(p0, expr);
result.kind := 'N';
CalcParseStd.T.sub_expr(self, p0, p1, p2);
result := NARROW(p0, expr);
BEGIN (* user code *)
result.e1 := n1.detach(); result.e2 := n2.detach(); result.kind := '-'
END;
p0 := result;
END Proc_sub_expr;
PROCEDURE Proc_mul_expr(self: T;
VAR p0: Original_expr; p1: Original_expr; p2: Original_expr) =
VAR
result: expr;
n1 := NARROW(p1, expr);
n2 := NARROW(p2, expr);
BEGIN
IF p0 = NIL THEN
p0 := NewPT(self.allocate_expr, TYPECODE(expr));
END;
result := NARROW(p0, expr);
result.kind := 'N';
CalcParseStd.T.mul_expr(self, p0, p1, p2);
result := NARROW(p0, expr);
BEGIN (* user code *)
result.e1 := n1.detach(); result.e2 := n2.detach(); result.kind := '*'
END;
p0 := result;
END Proc_mul_expr;
PROCEDURE Proc_div_expr(self: T;
VAR p0: Original_expr; p1: Original_expr; p2: Original_expr) =
VAR
result: expr;
n1 := NARROW(p1, expr);
n2 := NARROW(p2, expr);
BEGIN
IF p0 = NIL THEN
p0 := NewPT(self.allocate_expr, TYPECODE(expr));
END;
result := NARROW(p0, expr);
result.kind := 'N';
CalcParseStd.T.div_expr(self, p0, p1, p2);
result := NARROW(p0, expr);
BEGIN (* user code *)
result.e1 := n1.detach(); result.e2 := n2.detach(); result.kind := '/'
END;
p0 := result;
END Proc_div_expr;
PROCEDURE Proc_uminus_expr(self: T;
VAR p0: Original_expr; p1: Original_expr) =
VAR
result: expr;
n1 := NARROW(p1, expr);
BEGIN
IF p0 = NIL THEN
p0 := NewPT(self.allocate_expr, TYPECODE(expr));
END;
result := NARROW(p0, expr);
result.kind := 'N';
CalcParseStd.T.uminus_expr(self, p0, p1);
result := NARROW(p0, expr);
BEGIN (* user code *)
result.e1 := n1.detach(); result.kind := 'U'
END;
p0 := result;
END Proc_uminus_expr;
PROCEDURE Proc_ident_expr(self: T;
VAR p0: Original_expr; p1: Original_LETTER) =
VAR
result: expr;
n1 := NARROW(p1, LETTER);
BEGIN
IF p0 = NIL THEN
p0 := NewPT(self.allocate_expr, TYPECODE(expr));
END;
result := NARROW(p0, expr);
result.kind := 'N';
CalcParseStd.T.ident_expr(self, p0, p1);
result := NARROW(p0, expr);
BEGIN (* user code *)
result.kind := n1.val
END;
p0 := result;
END Proc_ident_expr;
PROCEDURE Proc_num_expr(self: T;
VAR p0: Original_expr; p1: Original_number) =
VAR
result: expr;
n1 := NARROW(p1, number);
BEGIN
IF p0 = NIL THEN
p0 := NewPT(self.allocate_expr, TYPECODE(expr));
END;
result := NARROW(p0, expr);
result.kind := 'N';
CalcParseStd.T.num_expr(self, p0, p1);
result := NARROW(p0, expr);
BEGIN (* user code *)
EVAL n1;(* just allocating the new type *)
END;
p0 := result;
END Proc_num_expr;
PROCEDURE Proc_paren_expr(self: T;
VAR p0: Original_expr; p1: Original_expr) =
VAR
result: expr;
n1 := NARROW(p1, expr);
BEGIN
IF p0 = NIL THEN
p0 := NewPT(self.allocate_expr, TYPECODE(expr));
END;
result := NARROW(p0, expr);
result.kind := 'N';
CalcParseStd.T.paren_expr(self, p0, p1);
result := NARROW(p0, expr);
BEGIN (* user code *)
EVAL n1;(* just allocating the new type *)
END;
p0 := result;
END Proc_paren_expr;
BEGIN
END CalcParseTree.