Copyright (C) 1994, Digital Equipment Corp.
MODULE M3CTextcatTrans;
IMPORT AST, AST_Iter;
IMPORT M3Context, M3CId, M3CStdTypes, M3Assert, M3CUnit, M3CSearch;
IMPORT M3AST_AS;
IMPORT SeqM3AST_AS_Actual, SeqM3AST_AS_EXP;
IMPORT M3AST_AS_F, M3AST_SM_F;
PROCEDURE Set(c: M3Context.T; cu: M3AST_AS.Compilation_Unit)=
VAR text_cu: M3AST_AS.Compilation_Unit; void: M3AST_AS.EXP;
BEGIN
M3Assert.Check(M3Context.Find(c, "Text", M3CUnit.Type.Interface, text_cu));
WITH cat = M3AST_AS.NewUSED_ID() DO
cat.lx_symrep := M3CId.Enter("Cat");
M3CSearch.Export(text_cu.as_root, cat);
M3Assert.Check(cat.sm_def # NIL);
EVAL Visit(cu, text_cu.as_root, cat.sm_def, NIL, NIL, void);
END
END Set;
PROCEDURE Visit(n: AST.NODE; text_intf: M3AST_AS.Interface;
textcat: M3AST_AS.Proc_id;
parent: AST.NODE; parent_iter: AST_Iter.T;
VAR (* out*) old_exp: M3AST_AS.EXP): M3AST_AS.Call=
BEGIN
(* iterate children *)
VAR
iter := n.newIter();
iter2 := n.newIter();
child, void: AST.NODE;
child_old_exp: M3AST_AS.EXP;
BEGIN
WHILE iter.next(child) DO
IF child # NIL THEN
WITH r = Visit(child, text_intf, textcat, n, iter2, child_old_exp) DO
IF r # NIL THEN
(* If we are a "Actual" node and our "as_exp_type" child
was updated, we must also fix up the "sm_actual_s"
entry of the parent "Call" node. *)
TYPECASE n OF
| M3AST_AS.Actual =>
VAR
call := NARROW(parent, M3AST_AS.Call);
exp_iter := SeqM3AST_AS_EXP.NewIter(call.sm_actual_s);
exp: M3AST_AS.EXP;
ns := SeqM3AST_AS_EXP.Null;
BEGIN
WHILE SeqM3AST_AS_EXP.Next(exp_iter, exp) DO
IF exp = child_old_exp THEN exp := r; END;
SeqM3AST_AS_EXP.AddRear(ns, exp);
END;
call.sm_actual_s := ns;
END;
ELSE
END;
END
END
END; (* if *)
EVAL iter2.next(void);
END; (* while *)
END;
TYPECASE n OF
| M3AST_AS.Binary(b) =>
IF ISTYPE(b.as_binary_op, M3AST_AS.Textcat) THEN
WITH c = TextDotCatCall(text_intf, textcat, b.as_exp1, b.as_exp2) DO
parent.update(parent_iter, c);
old_exp := b;
RETURN c;
END;
END;
ELSE
END;
RETURN NIL;
END Visit;
PROCEDURE TextDotCatCall(
text_intf: M3AST_AS.Interface;
textcat: M3AST_AS.Proc_id;
arg1, arg2: M3AST_AS.EXP): M3AST_AS.EXP=
VAR
exp_used_id1, exp_used_id2 := M3AST_AS.NewExp_used_id();
call := M3AST_AS.NewCall();
select := M3AST_AS.NewBinary();
BEGIN
select.as_binary_op := M3AST_AS.NewSelect();
select.as_exp1 := exp_used_id1;
select.as_exp2 := exp_used_id2;
exp_used_id1.vUSED_ID.lx_symrep := M3CId.Enter("Text");
exp_used_id1.vUSED_ID.sm_def := text_intf.as_id;
exp_used_id1.sm_exp_type_spec := M3CStdTypes.Void();
exp_used_id2.vUSED_ID.lx_symrep := M3CId.Enter("Cat");
exp_used_id2.vUSED_ID.sm_def := textcat;
exp_used_id2.sm_exp_type_spec := textcat.sm_type_spec;
call.as_callexp := select;
MkActual(call, arg1); MkActual(call, arg2);
select.sm_exp_type_spec := M3CStdTypes.Text();
call.sm_exp_type_spec := select.sm_exp_type_spec;
RETURN call;
END TextDotCatCall;
PROCEDURE MkActual(call: M3AST_AS.Call; arg: M3AST_AS.EXP)=
VAR
actual := M3AST_AS.NewActual();
BEGIN
actual.as_id := NIL; actual.as_exp_type := arg;
SeqM3AST_AS_Actual.AddRear(call.as_param_s, actual);
SeqM3AST_AS_EXP.AddRear(call.sm_actual_s, arg);
END MkActual;
BEGIN
END M3CTextcatTrans.