test/derived/CalcParseTree.m3


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.