#
#  File: intermediate.k3
#  Generated intermediate code.
#
#  Copyright 2005 Radboud University of Nijmegen
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU Library General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
#  CVS ID: "$Id: intermediate.k3,v 1.26 2006/08/09 11:13:09 marcs Exp $"
#
MODULE intermediate = CURR_NONT
                      CURR_NEG_MEMO
                      NO_NEG_MEMO
                      ICRULES{}.

DEFINES ACTION generate intermediate code,

        ICRULE,
        TEST ic says it is unused (>NONTERMINAL),
        FUNCTION get ic rule (>NONTERMINAL, ICRULE>),
        ACTION store ic rule (>NONTERMINAL, >ICRULE),
        FUNCTION get ICDEFS> from >ICRULE,
        FUNCTION get NR_FORMALS> and NR_LOCALS> from >ICRULE,
        FUNCTION get nr sons INT> from >ICRULE,

        ICDEFS,
        FUNCTION count (>ICDEFS, INT>),
        ICDEF,

        ICALTS,
        FUNCTION count (>ICALTS, INT>),
        ICALT,

        ICACTS,
        FUNCTION append >ICACTS1 to >ICACTS2>,
        ICACT, ICVAR,
        TEST is director test (>ICACT),
        TEST is negative memo test (>ICACT),
        VALUE,
        TEST compare (>VALUE1, >VALUE2),

        TRANSDUCTION, TRACTS, TRACT,
        
        ALTNO,
        FUNCTION empty ALTNO>,
        FUNCTION convert >ALTNO to printable TEXT>,
        FUNCTION convert >ALTNO to label TEXT>,
        
        DEBUGINFO.

USES globals, io, rule, id, set, properties, transduction, optimize, options, textstorage.

#
# ICRULE(S)
#
ICRULES = ICRULE.
ICRULE :: NR_FORMALS NR_LOCALS nr sons INT ICDEFS;
          unused.

ACTION mark ic entry unused (>INT):
  [ unused -> ICRULES{INT} ].

ACTION store ic rule (>NONTERMINAL, >ICRULE):
  assert valid NONTERMINAL,
    convert NONTERMINAL to INT,
    [ ICRULE -> ICRULES{INT} ].

FUNCTION get ic rule (>NONTERMINAL, ICRULE>):
  assert valid NONTERMINAL,
    convert NONTERMINAL to INT,
    [ ICRULES{INT} -> ICRULE ].

TEST ic says it is unused (>NONTERMINAL):
  get ic rule (NONTERMINAL, ICRULE), [ ICRULE -> unused ].

FUNCTION get ICDEFS> from >ICRULE:
  [ ICRULE -> NR_FORMALS NR_LOCALS nr sons INT ICDEFS ];
  [ ICRULE -> unused ], ?;
  ?.

FUNCTION get NR_FORMALS> and NR_LOCALS> from >ICRULE:
  [ ICRULE -> NR_FORMALS NR_LOCALS nr sons INT ICDEFS ];
  [ ICRULE -> unused ], ?;
  ?.

FUNCTION get nr sons INT> from >ICRULE:
  [ ICRULE -> NR_FORMALS NR_LOCALS nr sons INT ICDEFS ];
  [ ICRULE -> unused ], ?;
  ?.

#
# ICDEFS
#
ICDEFS :: ICDEF ICDEFS;
          nil.

ICDEF :: lhs ICACTS rhs ICALTS.

FUNCTION count (>ICDEFS, INT>):
  [ ICDEFS -> ICDEF ICDEFS ], count (ICDEFS, INT), [ INT + 1 -> INT ];
  [ ICDEFS -> nil ], [ 0 -> INT ];
  ?.
  
#
# Intermediate code alternatives
#
ICALTS :: ICALT ICALTS;
          nil.

FUNCTION append >ICALTS1 to >ICALTS2>:
  [ ICALTS2 -> ICALT2 ICALTS2 ], append ICALTS1 to ICALTS2, [ ICALT2 ICALTS2 -> ICALTS2 ];
  [ ICALTS2 -> nil], [ ICALTS1 -> ICALTS2 ];
  ?.

FUNCTION count (>ICALTS, INT>):
  [ ICALTS -> ICALT ICALTS ], count (ICALTS, INT), [ INT + 1 -> INT ];
  [ ICALTS -> nil ], [ 0 -> INT];
  ?.

#
# ICALT
#
ICALT :: ALTNO ICACTS COMMITED.

ALTNO :: INT subalts ALTNO;
         INT.

FUNCTION empty ALTNO>:
  [ 0 -> ALTNO ].

FUNCTION start subalts (>ALTNO>):
  [ ALTNO -> INT ], [ 0 -> ALTNO1 ], [ INT subalts ALTNO1 -> ALTNO ];
  [ ALTNO -> INT subalts ALTNO1 ],
    start subalts (ALTNO1),
    [ INT subalts ALTNO1 -> ALTNO ];
  ?.

FUNCTION incr >ALTNO>:
  [ ALTNO -> INT ], [ INT + 1 -> INT ], [ INT -> ALTNO ];
  [ ALTNO -> INT subalts ALTNO ], incr ALTNO,
    [ INT subalts ALTNO -> ALTNO ];
  ?.

FUNCTION convert >ALTNO to printable TEXT>:
  convert ALTNO to TEXT using seperator ":".

FUNCTION convert >ALTNO to label TEXT>:
  convert ALTNO to TEXT using seperator "_".

FUNCTION convert >ALTNO to TEXT1> using seperator >TEXT2:
  [ ALTNO -> INT ], convert INT to TEXT1;
  [ ALTNO -> INT subalts ALTNO ], convert INT to TEXT3,
    convert ALTNO to TEXT4 using seperator TEXT2,
    [ TEXT3 + TEXT2 + TEXT4 -> TEXT1 ];
  ?.

#
# ICACTS:
#
ICACTS :: ICACT ICACTS;
          nil.

FUNCTION append >ICACTS1 to >ICACTS2>:
  [ ICACTS2 -> ICACT2 ICACTS2 ], append ICACTS1 to ICACTS2, [ ICACT2 ICACTS2 -> ICACTS2 ];
  [ ICACTS2 -> nil ], [ ICACTS1 -> ICACTS2 ];
  ?.

#
# Intermediate code instructions
# MS: All IC instructions using a formal/local variant will be changed
# into an instruction using an ICVAR (intermediate code variable), as
# their only difference is in the calculation of the frame offset.
#
ICACT :: init formal INT to VALUE;
         init local INT to VALUE;
         match lexicon NONTERMINAL;
         group ICALTS;
         call NONTERMINAL;
         penalty INT;
         match terminal ID using local INT targeting ICVAR;
         skip ID using local INT targeting ICVAR;
         match ID using local INT targeting ICVAR;
	 other using local INT targeting ICVAR;
	 input pos using local INT targeting ICVAR;
         restrict local INT to VALUE;
         restrict formal INT to VALUE;
         adjust integer formal INT to output param INT;
         adjust set formal INT to output param INT;
         adjust text formal INT to output param INT;
         adjust integer local INT to output param INT;
         adjust set local INT to output param INT;
         adjust text local INT to output param INT;
         continuation trans TRANSDUCTION1 and tree TRANSDUCTION2 and params EXPRS;
         director test DIR_MEMO;
         negative memo test MEMO;
         negative memo set succeeded MEMO;
         alt marker;
         trace DEBUGINFO;
	 position INT.

ICVAR :: formal INT;
	 local INT;
	 none.

TEST is director test (>ICACT):
  [ ICACT -> director test DIR_MEMO ].

TEST is negative memo test (>ICACT):
  [ ICACT -> negative memo test MEMO ].

VALUE :: set ID;
         top text;
         text const ID;
         top integer;
         integer const INT.

FUNCTION convert >ID to VALUE>:
  id is set affix (ID), [ set ID -> VALUE ];
  id is text affix (ID), [ top text -> VALUE ];
  id is integer affix (ID), [ top integer -> VALUE ];
  ?.

FUNCTION convert text const >ID to VALUE>:
  [ text const ID -> VALUE ].

FUNCTION convert integer const >INT to VALUE>:
  [ integer const INT -> VALUE ].

TEST compare (>VALUE1, >VALUE2):
  [ VALUE1 -> set ID1 ],
    ( [ VALUE2 -> set ID2 ], [ ID1 = ID2 ];
      -
    );
  [ VALUE1 -> top text ],
    ( [ VALUE2 -> top text ];
      -
    );
  [ VALUE1 -> text const ID1 ],
    ( [ VALUE2 -> text const ID2 ], [ ID1 = ID2 ];
      -
    );
  [ VALUE1 -> top integer ],
    ( [ VALUE2 -> top integer ];
      -
    );
  [ VALUE1 -> integer const INT1 ],
    ( [ VALUE2 -> integer const INT2 ], [ INT1 = INT2 ];
      -
    );
  ?.

FUNCTION convert >VALUE to TEXT>:
  [ VALUE -> set ID ], convert id to name (ID, TEXT),
    [ "set " + TEXT -> TEXT ];
  [ VALUE -> top text ], [ "top text" -> TEXT];
  [ VALUE -> text const ID], convert id to name (ID, TEXT),
    [ "text const \"" + TEXT + "\"" -> TEXT ];
  [ VALUE -> top integer ], [ "top integer" -> TEXT ];
  [ VALUE -> integer const INT ], convert INT to TEXT,
    [ "int const \"" + TEXT + "\"" -> TEXT ];
  ?.

#
# Actual IC code generation routines
#
CURR_NONT = NONTERMINAL.

ACTION generate intermediate code:
  get number of syntax nonterminals (INT),
    generate intermediate code (INT).

ACTION generate intermediate code (>INT):
  [ INT -> 0 ];
  [ INT - 1 -> INT ],
    generate intermediate code (INT),
    generate ic for nonterminal (INT).

ACTION generate ic for nonterminal (>INT):
  convert INT to NONTERMINAL,
    ( is lexicon nonterminal (NONTERMINAL), mark ic entry unused (INT);
      is dummy nonterminal (NONTERMINAL), mark ic entry unused (INT);
      is start nonterminal (NONTERMINAL), mark ic entry unused (INT);
      is reachable (NONTERMINAL),
        [ NONTERMINAL -> CURR_NONT ],
        get syntax rule (NONTERMINAL, RULE),
        transform to ic (RULE, ICRULE),
        store ic rule (NONTERMINAL, ICRULE);
	# convert (NONTERMINAL) to (TEXT),
	# dump ("Intermediate code for " + TEXT +"\n"),
	# dump (ICRULE);
      mark ic entry unused (INT)
    ).

ACTION transform to ic (>RULE, ICRULE>):
  [ RULE -> DEFS SPECS ], count NR_FORMALS in DEFS,
    count sons (DEFS, INT), empty ALTNO,
    transform to ic (DEFS, ALTNO, NR_LOCALS, ICDEFS),
    [ NR_FORMALS NR_LOCALS nr sons INT ICDEFS -> ICRULE ].

ACTION transform to ic (>DEFS, >ALTNO, NR_LOCALS>, ICDEFS>):
  [ DEFS -> nil ], new NR_LOCALS, [ nil -> ICDEFS ];
  [ DEFS -> DEF DEFS ], incr ALTNO,
    transform to ic (DEF, ALTNO, NR_LOCALS, ICDEF),
    transform to ic (DEFS, ALTNO, NR_LOCALS1, ICDEFS),
    [ ICDEF ICDEFS -> ICDEFS ],
    maximize NR_LOCALS with NR_LOCALS1;
  ?.

ACTION transform to ic (>DEF, >ALTNO, NR_LOCALS>, ICDEF>):
  [ DEF -> FORMALS at POS with ALTS ], [ FORMALS -> EXPRS ],
    unsugar EXPRS into ICACTS,
    maybe prepend alt marker (ICACTS),
    start subalts (ALTNO),
    transform to ic (ALTS, FORMALS, ALTNO, NR_LOCALS, ICALTS),
    [ lhs ICACTS rhs ICALTS -> ICDEF ].

FUNCTION unsugar >EXPRS into ICACTS>:
  unsugar EXPRS into ICACTS after 0 formals.

FUNCTION unsugar >EXPRS into ICACTS> after >INT formals:
  [ EXPRS -> nil ], [ nil -> ICACTS ];
  [ EXPRS -> EXPR EXPRS ],
    unsugar EXPR into ICACT after INT formals,
    unsugar EXPRS into ICACTS after (INT + 1) formals,
    [ ICACT ICACTS -> ICACTS ];
  ?.

#
# MS: Is het uberhaupt mogelijk om een system affix als formal
#     te krijgen?
#
FUNCTION unsugar >EXPR into ICACT> after >INT formals:
  [ EXPR -> affix ID ], convert ID to VALUE,
    [ init formal INT to VALUE -> ICACT ];
  [ EXPR -> variable ID instance INT1 ], convert ID to VALUE,
    [ init formal INT to VALUE -> ICACT ];
  [ EXPR -> set ID ], convert ID to VALUE,
    [ init formal INT to VALUE -> ICACT ];
  [ EXPR -> text const ID ], convert text const ID to VALUE,
    [ init formal INT to VALUE -> ICACT ];
  [ EXPR -> integer const INT1], convert integer const INT1 to VALUE,
    [ init formal INT to VALUE -> ICACT ];
  [ EXPR -> system affix ID ], convert ID to VALUE,
    [ init formal INT to VALUE -> ICACT ];
  [ EXPR -> erroneous ],
    ?;
  ?.

FUNCTION maybe prepend alt marker (>ICACTS>):
  if generative grammar option,
    [ alt marker -> ICACT ],
    [ ICACT ICACTS -> ICACTS ];
  +.

ACTION transform to ic (>ALTS, >FORMALS, >ALTNO, NR_LOCALS>, ICALTS>):
  [ ALTS -> nil ], new NR_LOCALS, [ nil -> ICALTS ];
  [ ALTS -> ALT ALTS ], incr ALTNO,
    transform to ic (ALT, FORMALS, ALTNO, NR_LOCALS, ICALT),
    transform to ic (ALTS, FORMALS, ALTNO, NR_LOCALS1, ICALTS),
    maximize NR_LOCALS with NR_LOCALS1,
    [ ICALT ICALTS -> ICALTS ];
  ?.

ACTION transform to ic (>ALT, >FORMALS, >ALTNO, NR_LOCALS>, ICALT>):
  [ ALT -> FREQ MEMBERS LOCALS COMMITED SECONDPASS ],
    transform LOCALS to init ICACTS,
    maybe prepend alt marker (ICACTS),
    maybe add director set (CURR_NONT, ALT, ICACTS),
    maybe add negative memo test (CURR_NONT, ALT, ICACTS),
    transform MEMBERS and SECONDPASS and ALTNO to ICACTS1 using FORMALS and LOCALS,
    append ICACTS1 to ICACTS,
    count LOCALS into NR_LOCALS,
    [ ALTNO ICACTS COMMITED -> ICALT ];
  [ ALT -> FREQ empty COMMITED SECONDPASS ],
    [ nil -> MEMBERS ],
    [ nil -> ICACTS ],
    [ nil -> LOCALS ],
    maybe prepend alt marker (ICACTS),
    no memo here,
    transform MEMBERS and SECONDPASS and ALTNO to ICACTS1 using FORMALS and LOCALS,
    append ICACTS1 to ICACTS,
    new NR_LOCALS,
    [ ALTNO ICACTS COMMITED -> ICALT ];
  ?.

#
# Locals:
#
ACTION transform >LOCALS to init ICACTS>:
  [ LOCALS -> EXPRS ],
    transform to init locals (EXPRS, 0, ICACTS).

ACTION transform to init locals (>EXPRS, >INT, ICACTS>):
  [ EXPRS -> nil ], [ nil -> ICACTS ];
  [ EXPRS -> EXPR EXPRS ],
    ( is user affix terminal (EXPR), convert EXPR to VALUE,
        [ init local INT to VALUE -> ICACT ],
        transform to init locals (EXPRS, INT + 1, ICACTS),
        [ ICACT ICACTS -> ICACTS ];
      is user variable (EXPR), convert EXPR to VALUE,
        [ init local INT to VALUE -> ICACT ],
        transform to init locals (EXPRS, INT + 1, ICACTS),
        [ ICACT ICACTS -> ICACTS ];
      [ EXPR -> set ID ], convert EXPR to VALUE,
        [ init local INT to VALUE -> ICACT ],
        transform to init locals (EXPRS, INT + 1, ICACTS),
        [ ICACT ICACTS -> ICACTS ];
      is system affix (EXPR), [ top text -> VALUE ],
        [ init local INT to VALUE -> ICACT ],
        transform to init locals (EXPRS, INT + 1, ICACTS),
        [ ICACT ICACTS -> ICACTS ];
      write ("DEBUG: transform to init locals: didn't transform entry:\n"),
        convert EXPR to system TEXT,
        write (TEXT+"\n"),
        write ("Did you call a rule with a non-TOP INT or TEXT affix value?\n"),
        write ("That is not implemented.\n"),
        dump ast,
#      ?);
# Carry on regardless, to help the user find the problem easier.
        transform to init locals (EXPRS, INT + 1, ICACTS),
        [ICACTS -> ICACTS]
    );
  ?.

ACTION count >LOCALS into NR_LOCALS>:
  [ LOCALS -> EXPRS ], count EXPRS into NR_LOCALS.

ACTION count >EXPRS into NR_LOCALS>:
  [ EXPRS -> nil ], new NR_LOCALS;
  [ EXPRS -> EXPR EXPRS ],
    count EXPRS into NR_LOCALS, incr NR_LOCALS;
  ?.

#
# Members:
#
ACTION transform >MEMBERS and >SECONDPASS and >ALTNO to ICACTS> using >FORMALS and >LOCALS>:
  [ MEMBERS -> nil ],
    transform SECONDPASS and ALTNO to ICACTS using FORMALS ans LOCALS;
  [ MEMBERS -> MEMBER MEMBERS ],
    transform MEMBER to ICACTS using ALTNO and FORMALS and LOCALS,
    transform MEMBERS and SECONDPASS and ALTNO to ICACTS1 using FORMALS and LOCALS,
    append ICACTS1 to ICACTS;
  ?.

ACTION transform >MEMBER to ICACTS> using >ALTNO and >FORMALS and >LOCALS>:
  [ MEMBER -> guard GUARDS ],
    transform GUARDS to ICACTS using FORMALS and LOCALS,
    maybe add guard trace (ICACTS);
  [ MEMBER -> call ID def NONTERMINAL with ACTUALS at POS ],
    [ ACTUALS -> EXPRS1 ],
    build ICACTS for call to NONTERMINAL with EXPRS1 using FORMALS and LOCALS,
    maybe add call trace (NONTERMINAL, EXPRS1, ICACTS);
  [ MEMBER -> option ALTS with OPT_SPEC at POS ],
    ( [ OPT_SPEC -> NONTERMINAL with FORMALS1 ], [ FORMALS1 -> EXPRS1 ],
        build ICACTS for call to NONTERMINAL with EXPRS1 using FORMALS and LOCALS,
        maybe add option call trace (NONTERMINAL, EXPRS1, ICACTS);
      ?
    );
  [ MEMBER -> group ALTS at POS ],
    ?;
  [ MEMBER -> free word order MEMBERS ],
    ?;
  where member is final group (MEMBER, ALTS),
    start subalts (ALTNO),
    transform ALTS in final group to ICALTS using ALTNO and FORMALS and LOCALS,
    [ group ICALTS -> ICACT ],
    [ ICACT nil -> ICACTS ];
  [ MEMBER -> penalty INT ],
    [ penalty INT -> ICACT ],
    [ ICACT nil -> ICACTS],
    maybe add penalty trace (INT, ICACTS);
  [ MEMBER -> terminal ID using EXPR1 targeting EXPR2 at POS ],
    convert EXPR1 to local INT using LOCALS,
    convert EXPR2 to ICVAR using FORMALS and LOCALS,
    [ match terminal ID using local INT targeting ICVAR -> ICACT ],
    [ ICACT nil -> ICACTS ],
    maybe add terminal trace (ID, ICACTS);
  [ MEMBER -> skip regexp ID using EXPR1 targeting EXPR2 at POS ],
    convert EXPR1 to local INT using LOCALS,
    convert EXPR2 to ICVAR using FORMALS and LOCALS,
    [ skip ID using local INT targeting ICVAR -> ICACT ],
    [ ICACT nil -> ICACTS ],
    maybe add skip trace (ID, ICACTS);
  [ MEMBER -> match regexp ID using EXPR1 targeting EXPR2 at POS ],
    convert EXPR1 to local INT using LOCALS,
    convert EXPR2 to ICVAR using FORMALS and LOCALS,
    [ match ID using local INT targeting ICVAR -> ICACT ],
    [ ICACT nil -> ICACTS ],
    maybe add match trace (ID, ICACTS);
  [ MEMBER -> other using EXPR1 targeting EXPR2 at POS ],
    convert EXPR1 to local INT using LOCALS,
    convert EXPR2 to ICVAR using FORMALS and LOCALS,
    [ other using local INT targeting ICVAR -> ICACT ],
    [ ICACT nil -> ICACTS ],
    maybe add other trace (ICACTS);
  [ MEMBER -> input pos using EXPR1 targeting EXPR2 at POS ],
    convert EXPR1 to local INT using LOCALS,
    convert EXPR2 to ICVAR using FORMALS and LOCALS,
    [ input pos using local INT targeting ICVAR -> ICACT ],
    [ ICACT nil -> ICACTS ],
    maybe add input pos trace (ICACTS);
  [ MEMBER -> position INT ],
    [ position INT -> ICACT ],
    [ ICACT nil -> ICACTS ];
  ?.

#
# Calls
#
FUNCTION build ICACTS> for call to >NONTERMINAL with >EXPRS using >FORMALS and >LOCALS>:
  transform call EXPRS starting with param 1 to ICACTS using FORMALS and LOCALS,
    ( is lexicon nonterminal (NONTERMINAL),
        [ match lexicon NONTERMINAL -> ICACT ],
        [ ICACT ICACTS -> ICACTS ];
      [ call NONTERMINAL -> ICACT ], [ ICACT ICACTS -> ICACTS ]
    ).

FUNCTION transform call >EXPRS starting with param >INT to ICACTS> using >FORMALS and >LOCALS>:
  [ EXPRS -> nil ], [ nil -> ICACTS ];
  [ EXPRS -> EXPR EXPRS ],
    transform call EXPR which is param INT to ICACTS using FORMALS and LOCALS,
    [INT + 1 -> INT],
    transform call EXPRS starting with param INT to ICACTS1 using FORMALS and LOCALS,
    append ICACTS1 to ICACTS;
  ?.

FUNCTION transform call >EXPR which is param >INT2 to ICACTS> using >FORMALS and >LOCALS>:
  convert EXPR to formal INT1 using FORMALS,
    convert adjust formal INT1 of EXPR which is param INT2 to ICACT,
    [ ICACT nil -> ICACTS ];
  convert EXPR to local INT1 using LOCALS,
    convert adjust local INT1 of EXPR which is param INT2 to ICACT,
    [ ICACT nil -> ICACTS ];
  append EXPR to LOCALS,
    ( convert EXPR to local INT1 using LOCALS, convert EXPR to VALUE,
       [ init local INT1 to VALUE -> ICACT1 ],
       convert adjust local INT1 of EXPR which is param INT2 to ICACT,
       [ ICACT nil -> ICACTS ],
       [ ICACT1 ICACTS -> ICACTS ];
      ?
    ).

FUNCTION convert adjust formal >INT1 of >EXPR which is param >INT2 to ICACT>:
  is integer (EXPR), [ adjust integer formal INT1 to output param INT2 -> ICACT ];
  is set (EXPR),     [ adjust set formal INT1 to output param INT2 -> ICACT ];
  is text (EXPR),    [ adjust text formal INT1 to output param INT2 -> ICACT ];
  ?.

FUNCTION convert adjust local >INT1 of >EXPR which is param >INT2 to ICACT>:
  is integer (EXPR), [ adjust integer local INT1 to output param INT2 -> ICACT ];
  is set (EXPR),     [ adjust set local INT1 to output param INT2 -> ICACT ];
  is text (EXPR),    [ adjust text local INT1 to output param INT2 -> ICACT ];
#  ?.
# Just plod on while returning some dummy action.
# see :DEBUG: transform to init locals: didn't transform" above
# MS: Hrmmmf.
  [ trace penalty 0 -> ICACT ].

#
# Guards:
#
FUNCTION transform >GUARDS to ICACTS> using >FORMALS and >LOCALS:
  [ GUARDS -> nil ], [ nil -> ICACTS ];
  [ GUARDS -> GUARD GUARDS ],
    transform GUARD to ICACT using FORMALS and LOCALS,
    transform GUARDS to ICACTS using FORMALS and LOCALS,
    [ ICACT ICACTS -> ICACTS ];
  ?.

FUNCTION transform >GUARD to ICACT> using >FORMALS and >LOCALS:
  [ GUARD -> restrict EXPR1 to EXPR2 at POS ], convert EXPR2 to VALUE,
    ( convert EXPR1 to formal INT using FORMALS,
        [ restrict formal INT to VALUE -> ICACT ];
      convert EXPR1 to local INT using LOCALS,
        [ restrict local INT to VALUE -> ICACT ];
      ?
    );
  [ GUARD -> erroneous ],
    ?;
  ?.

#
# Final groups:
#
ACTION transform >ALTS in final group to ICALTS> using >ALTNO and >FORMALS and >LOCALS>:
  [ ALTS -> nil ], [ nil -> ICALTS ];
  [ ALTS -> ALT ALTS ],
    incr ALTNO,
    transform ALT in final group to ICALT using ALTNO and FORMALS and LOCALS,
    transform ALTS in final group to ICALTS using ALTNO and FORMALS and LOCALS,
    [ ICALT ICALTS -> ICALTS ];
  ?.

ACTION transform >ALT in final group to ICALT> using >ALTNO and >FORMALS and >LOCALS>:
  [ ALT -> FREQ MEMBERS LOCALS1 COMMITED SECONDPASS ],
#    transform LOCALS1 to init ICACTS,
    [ nil -> ICACTS ],
    maybe prepend alt marker (ICACTS),
#    maybe add director set (CURR_NONT, ALT, ICACTS),
#    maybe add negative memo test (CURR_NONT, ALT, ICACTS),
    transform MEMBERS and SECONDPASS and ALTNO to ICACTS using FORMALS and LOCALS,
    [ ALTNO ICACTS COMMITED -> ICALT ];
  [ ALT -> FREQ empty COMMITED SECONDPASS ],
    [ nil -> MEMBERS ],
    [ nil -> ICACTS ],
#    [ nil -> LOCALS ],
    maybe prepend alt marker (ICACTS),
#    maybe add director set (CURR_NONT, ALT, ICACTS),
#    maybe add negative memo test (CURR_NONT, ALT, ICACTS),
    transform MEMBERS and SECONDPASS and ALTNO to ICACTS1 using FORMALS and LOCALS,
    append ICACTS1 to ICACTS,
    new NR_LOCALS,
    [ ALTNO ICACTS COMMITED -> ICALT ];
  ?.

#
# Helper functions for handling EXPRs:
#
FUNCTION convert >EXPR to VALUE>:
  [ EXPR -> affix ID ], convert ID to VALUE;
  [ EXPR -> variable ID instance INT1 ], convert ID to VALUE;
  [ EXPR -> set ID ], convert ID to VALUE;
  [ EXPR -> text const ID ], convert text const ID to VALUE;
  [ EXPR -> integer const INT1 ], convert integer const INT1 to VALUE;
  [ EXPR -> system affix ID ], convert ID to VALUE;
  [ EXPR -> absent ],
    ?;
  [ EXPR -> erroneous ],
    ?;
  ?.

FUNCTION convert >EXPR to ICVAR> using >FORMALS and >LOCALS:
  [ EXPR -> absent ], [ none -> ICVAR ];
  convert EXPR to formal INT using FORMALS, [ formal INT -> ICVAR ];
  convert EXPR to local INT using LOCALS, [ local INT -> ICVAR ];
  convert EXPR to system TEXT,
    write ("Could not convert expression " + TEXT +" to ICVAR\n"),
    ?.

#
# Optimizations:
#
# Director sets:
#
ACTION maybe add director set (>NONTERMINAL, >ALT, >ICACTS>):
  if directors option,
    ( if negative memo option;
      create director memo (NONTERMINAL, ALT, DIR_MEMO),
        [ director test DIR_MEMO -> ICACT ], [ ICACT ICACTS -> ICACTS ],
        maybe add director trace (DIR_MEMO, ICACTS)
    );
  +.

ACTION create director memo (>NONTERMINAL, >ALT, DIR_MEMO>):
  get director set (NONTERMINAL, ALT, DIRSET),
    create new director memo (DIRSET, DIR_MEMO).

FUNCTION maybe get director set (>NONTERMINAL, >ALT, DIRSET>):
  if directors option,
    get director set (NONTERMINAL, ALT, DIRSET);
  get unrestricted director set (DIRSET).

#
# Negative memos:
#
ACTION maybe add negative memo test (>NONTERMINAL, >ALT, >ICACTS>):
  if negative memo option,
    create negative memo (NONTERMINAL, ALT, MEMO),
    [ negative memo test MEMO -> ICACT ],
    [ ICACT ICACTS -> ICACTS ],
    [ MEMO -> CURR_NEG_MEMO ];
  +.

ACTION create negative memo (>NONTERMINAL, >ALT, MEMO>):
  [ false -> NO_NEG_MEMO ],
    find penalty (ALT, BOOL),
    maybe get director set (NONTERMINAL, ALT, DIRSET),
    create new memo (DIRSET, BOOL, MEMO).

NO_NEG_MEMO = BOOL.
CURR_NEG_MEMO = MEMO.

FUNCTION maybe add negative memo set succeeded (>ICACTS>):
  if negative memo option,
    [ NO_NEG_MEMO -> false ],
    [ negative memo set succeeded CURR_NEG_MEMO -> ICACT ],
    [ ICACT ICACTS -> ICACTS ];
  +.

ACTION no memo here:
  [ true -> NO_NEG_MEMO ].


#
# Second pass:
#
FUNCTION transform >SECONDPASS and >ALTNO to ICACTS> using >FORMALS ans >LOCALS:
  has no second pass (SECONDPASS),
    [ nil -> ICACTS ];
  is user defined transduction (SECONDPASS), ?;
  is standard transduction (SECONDPASS), ?;
  get trans and tree (SECONDPASS, TREMBERS1, TREMBERS2),
#convert CURR_NONT to TEXT1,
#convert ALTNO to printable TEXT2,
#convert FORMALS pack to user TEXT3,
#convert LOCALS pack to user TEXT4,
#write ("transforming second pass for \"" + TEXT1 + "\" alt " + TEXT2 + " with:\n"),
#write ("\tformals: " + TEXT3 + "\n"),
#write ("\tlocals : " + TEXT4 + "\n"),
    generate TRANSDUCTION1 from TREMBERS1 and ALTNO using FORMALS and LOCALS,
    generate TRANSDUCTION2 from TREMBERS2 and ALTNO using FORMALS and LOCALS,
    [ FORMALS -> EXPRS ],
    [ continuation trans TRANSDUCTION1 and tree TRANSDUCTION2 and params EXPRS -> ICACT ],
    [ ICACT nil -> ICACTS ],
    maybe add negative memo set succeeded (ICACTS);
  ?.


TRANSDUCTION :: ALTNO with TRACTS.

FUNCTION generate TRANSDUCTION> from >TREMBERS and >ALTNO using >FORMALS and >LOCALS:
  generate TRACTS from TREMBERS using FORMALS and LOCALS,
    [ ALTNO with TRACTS -> TRANSDUCTION ].

#
# Transduction actions:
#
TRACTS :: TRACT TRACTS;
          nil.

FUNCTION append >TRACT1 to >TRACTS>:
  [ TRACTS -> nil ], [ TRACT1 nil -> TRACTS ];
  [ TRACTS -> TRACT TRACTS ], append TRACT1 to TRACTS, [ TRACT TRACTS -> TRACTS ];
  ?.

FUNCTION append >TRACTS1 to >TRACTS>:
  [ TRACTS -> nil ], [ TRACTS1 -> TRACTS ];
  [ TRACTS -> TRACT TRACTS ], append TRACTS1 to TRACTS, [ TRACT TRACTS -> TRACTS ];
  ?.

FUNCTION generate TRACTS> from >TREMBERS using >FORMALS and >LOCALS:
  [ TREMBERS -> TREMBER TREMBERS ],
    ( if empty (TREMBER),
#       [nil -> TRACTS];
        generate TRACTS from TREMBERS using FORMALS and LOCALS;
      generate TRACTS from TREMBER using FORMALS and LOCALS,
        generate TRACTS1 from TREMBERS using FORMALS and LOCALS,
        append TRACTS1 to TRACTS);
  [ TREMBERS -> nil ], [ nil -> TRACTS ];
  ?.

#
# Transduction intermediate code
#
TRACT :: print text ID;
         print terminal ID using local INT;
         push formal INT;
         push local INT;
         print SON;
         print lexicon SON with param TRACTS;
         print regexp using local INT;
         print other using local INT;
	 print input pos using local INT;
         print penalty INT;
         print affix ID using formal INT;
         print affix ID using local INT.

FUNCTION generate TRACTS> from >TREMBER using >FORMALS and >LOCALS:
  [ TREMBER -> text const ID ],
    [ print text ID -> TRACT ],
    [ TRACT nil -> TRACTS ];
  [ TREMBER -> terminal ID using EXPR ],
    convert EXPR to local INT using FORMALS and LOCALS,
    [ print terminal ID using local INT -> TRACT ],
    [ TRACT nil -> TRACTS ];
  [ TREMBER -> nonterminal ID instance INT at POS ],
    convert CURR_NONT to TEXT1, convert ID to TEXT2, convert INT to TEXT3,
    write ("Internal error: nonterminal \"" + TEXT2 + "\" instance " + TEXT3 +
	   " in rule \"" + TEXT1 + "\" is not expanded to son.\n"),
    log ("dying in \"FUNCTION generate TRACTS> from >TREMBER using >FORMALS and >LOCALS\"\n"),
    dump ast,
    ?; # should be expanded to SON
  [ TREMBER -> nonterminal ID at POS ],
    convert CURR_NONT to TEXT1, convert id to name (ID, TEXT2),
    write ("Internal error: nonterminal \"" + TEXT2 + "\"" +
	   " in rule \"" + TEXT1 + "\" is not expanded to son.\n"),
    log ("dying in \"FUNCTION generate TRACTS> from >TREMBER using >FORMALS and >LOCALS\"\n"),
    dump ast,
    ?; # should be expanded to SON
  [ TREMBER -> SON with params EXPRS ],
    ( if SON is lexicon nonterminal,
        convert SON to NONTERMINAL,
        get formal specification (NONTERMINAL, FSPEC),
        [ FSPEC -> SPEC ],
        convert EXPRS to print TRACTS using FORMALS and LOCALS and SPEC,
        [ print lexicon SON with param TRACTS -> TRACT ],
        [ TRACT nil -> TRACTS ];
      [ print SON -> TRACT ],
        convert EXPRS to TRACTS using FORMALS and LOCALS,
        append TRACT to TRACTS
    );
  [ TREMBER -> affix EXPR at POS],
    ( convert EXPR to local INT using LOCALS,
        convert EXPR to affix ID,
        [ print affix ID using local INT -> TRACT ],
        [ TRACT nil -> TRACTS ];
      convert EXPR to formal INT using FORMALS,
        convert EXPR to affix ID,
        [ print affix ID using formal INT -> TRACT ],
        [ TRACT nil -> TRACTS ];
#
# FIXME:
# This should have been checked before...
#
      convert CURR_NONT to TEXT1,
        convert EXPR to user TEXT2,
        error (TEXT1 + ": unknown affix \"" + TEXT2 + "\" in transduction"),
        !
    );
  [ TREMBER -> option INT at POS ], ?; # Should be done already
  [ TREMBER -> final group ], ?;
  [ TREMBER -> match at POS ], ?;
  [ TREMBER -> match instance INT at POS ], ?;
  [ TREMBER -> match using EXPR ],
    convert EXPR to local INT using FORMALS and LOCALS,
    [ print regexp using local INT -> TRACT ],
    [ TRACT nil -> TRACTS ];
  [ TREMBER -> skip at POS ], ?;
  [ TREMBER -> skip instance INT at POS ], ?;
  [ TREMBER -> skip using EXPR],
    convert EXPR to local INT using FORMALS and LOCALS,
    [ print regexp using local INT -> TRACT ],
    [ TRACT nil -> TRACTS ];
  [ TREMBER -> other at POS ], ?;
  [ TREMBER -> other instance INT at POS ], ?;
  [ TREMBER -> other using EXPR ],
    convert EXPR to local INT using FORMALS and LOCALS,
    [ print other using local INT -> TRACT ],
    [ TRACT nil -> TRACTS ];
  [ TREMBER -> input pos at POS ], ?;
  [ TREMBER -> input pos instance INT at POS ], ?;
  [ TREMBER -> input pos using EXPR ],
    convert EXPR to local INT using FORMALS and LOCALS,
    [ print input pos using local INT -> TRACT ],
    [ TRACT nil -> TRACTS ];
  [ TREMBER -> penalty INT ],
    [ print penalty INT -> TRACT ],
    [ TRACT nil -> TRACTS ];
  [ TREMBER -> empty ], ?;
  [ TREMBER -> erroneous ], ?;
  ?.

FUNCTION convert >EXPRS to TRACTS> using >FORMALS and >LOCALS:
  [ EXPRS -> nil ], [ nil -> TRACTS ];
  [ EXPRS -> EXPR EXPRS ],
    convert EXPR to TRACT using FORMALS and LOCALS,
    convert EXPRS to TRACTS using FORMALS and LOCALS,
    append TRACT to TRACTS;
  ?.

FUNCTION convert >EXPR to TRACT> using >FORMALS and >LOCALS:
  convert EXPR to formal INT using FORMALS,
    [ push formal INT -> TRACT ];
  convert EXPR to local INT using LOCALS,
    [ push local INT -> TRACT ];
  convert EXPR to system TEXT,
    convert CURR_NONT to TEXT1,
    write ("internal error in intermediate.k3: in " + TEXT1 + ": \n"),
    write ("\tEXPR not formal nor local: \"" + TEXT + "\"\n"),
    convert FORMALS pack to user TEXT2,
    write ("\tformal pack: " + TEXT2 + "\n"),
    convert LOCALS pack to user TEXT3,
    write ("\tlocals pack: " + TEXT3 + "\n"),
    dump ast,
    ?.

FUNCTION convert >EXPRS to print TRACTS> using >FORMALS and >LOCALS and >SPEC:
  convert EXPRS to print TRACTS using FORMALS and LOCALS and SPEC start at 1.

FUNCTION convert >EXPRS to print TRACTS> using >FORMALS and >LOCALS and >SPEC start at >INT:
  [ EXPRS -> nil ], [ nil -> TRACTS ];
  [ EXPRS -> EXPR EXPRS ],
    convert EXPR to print TRACT using FORMALS and LOCALS and SPEC start at INT,
    convert EXPRS to print TRACTS using FORMALS and LOCALS and SPEC start at INT + 1,
#    append TRACT to TRACTS;
    [ TRACT TRACTS -> TRACTS ];
  ?.

FUNCTION convert >EXPR to print TRACT> using >FORMALS and >LOCALS and >SPEC start at >INT:
  convert EXPR to formal INT1 using FORMALS,
    get param id (SPEC, INT, ID),
    [ print affix ID using formal INT1 -> TRACT ];
  convert EXPR to local INT1 using LOCALS,
    get param id (SPEC, INT, ID),
    [ print affix ID using local INT1 -> TRACT ];
  convert EXPR to system TEXT,
    convert CURR_NONT to TEXT1,
    write ("internal error in intermediate.k3: in " + TEXT1 + ": \n"),
    write ("EXPR not formal nor local: \"" + TEXT + "\"\n"),
    dump ast,
    ?.


#
# Debugging routines
#
ACTION dump (>ICRULE):
  [ ICRULE -> unused ], write ("unused\n");
  [ ICRULE -> NR_FORMALS NR_LOCALS nr sons INT ICDEFS ],
    convert NR_FORMALS to TEXT1,
    convert NR_LOCALS to TEXT2,
    convert INT to TEXT3,
    write (TEXT1 + " formals, " + TEXT2 + " locals, " + TEXT3 + " sons.\n"),
    dump (ICDEFS);
  ?.

ACTION dump (>ICDEFS):
  [ ICDEFS -> nil ], write ("\n");
  [ ICDEFS -> ICDEF ICDEFS ],
    dump (ICDEF),
    dump (ICDEFS);
  ?.

ACTION dump (>ICDEF):
  [ ICDEF -> lhs ICACTS rhs ICALTS ],
    write ("-- LHS:\n"),
    dump (ICACTS),
    write ("--- RHS:\n"),
    dump (ICALTS).

ACTION dump (>ICALTS):
  [ ICALTS -> nil ];
  [ ICALTS -> ICALT ICALTS ],
    dump (ICALT),
    dump (ICALTS);
  ?.

ACTION dump (>ICALT):
  [ ICALT -> ALTNO ICACTS COMMITED ],
    convert ALTNO to printable TEXT,
    write ("---> alternative " + TEXT + "\n"),
    dump (ICACTS),
    [ COMMITED -> BOOL ],
    convert BOOL to TEXT,
    write ("---- committed is " + TEXT + "\n").

ACTION dump (>ICACTS):
  [ ICACTS -> nil ];
  [ ICACTS -> ICACT ICACTS ],
    dump (ICACT),
    dump (ICACTS);
  ?.

#
# Dump intermediate instruction
# To be updated when reducing size of intermediate instruction set
#
ACTION dump (>ICACT):
  [ ICACT -> init formal INT to VALUE ],
    convert INT to TEXT1,
    convert VALUE to TEXT2,
    write ("init formal " + TEXT1 + " to " + TEXT2 + "\n");
  [ ICACT -> init local INT to VALUE ],
    convert INT to TEXT1,
    convert VALUE to TEXT2,
    write ("init local " + TEXT1 + " to " + TEXT2 + "\n");
  [ ICACT -> match lexicon NONTERMINAL ],
    convert NONTERMINAL to TEXT,
    write ("match lexicon nonterminal \"" + TEXT + "\"\n");
  [ ICACT -> group ICALTS ],
    write ("group ("),
    dump (ICALTS),
    write (") end of group\n");
  [ ICACT -> call NONTERMINAL ],
    convert NONTERMINAL to TEXT,
    write ("call to nonterminal \"" + TEXT + "\"\n");
  [ ICACT -> penalty INT ], convert INT to TEXT,
    write ("penalty (" + TEXT + ")\n");
  [ ICACT -> match terminal ID using local INT targeting ICVAR ],
    write ("match terminal\n");
  [ ICACT -> skip ID using local INT targeting ICVAR ],
    write ("skip\n");
  [ ICACT -> match ID using local INT targeting ICVAR ],
    write ("match\n");
  [ ICACT -> other using local INT targeting ICVAR ],
    write ("other\n");
  [ ICACT -> input pos using local INT targeting ICVAR ],
    write ("input pos\n");
  [ ICACT -> restrict local INT to VALUE ],
    write ("restrict\n");
  [ ICACT -> restrict formal INT to VALUE ],
    write ("restrict\n");
  [ ICACT -> adjust integer formal INT to output param INT ],
    write ("adjust\n");
  [ ICACT -> adjust set formal INT to output param INT ],
    write ("adjust\n");
  [ ICACT -> adjust text formal INT to output param INT ],
    write ("adjust\n");
  [ ICACT -> adjust integer local INT to output param INT ],
    write ("adjust\n");
  [ ICACT -> adjust set local INT to output param INT ],
    write ("adjust\n");
  [ ICACT -> adjust text local INT to output param INT ],
    write ("adjust\n");
  [ ICACT -> continuation trans TRANSDUCTION1 and tree TRANSDUCTION2 and params EXPRS ],
    write ("continuation\n");
  [ ICACT -> director test DIR_MEMO ],
    write ("director test\n");
  [ ICACT -> negative memo test MEMO ],
    write ("negative memo test\n");
  [ ICACT -> negative memo set succeeded MEMO ],
    write ("negative memo set succeeded\n");
  [ ICACT -> alt marker ],
    write ("alt marker\n");
  [ ICACT -> trace DEBUGINFO ],
    write ("trace + debuginfo\n");
  [ ICACT -> position INT ], convert INT to TEXT, 
    write ("position " + TEXT + "\n");
  ?.

#
# Debug stuff
#
DEBUGINFO :: guard;
             terminal ID;
             call NONTERMINAL;
             option call NONTERMINAL;
             penalty INT;
             skip ID;
             match ID;
             director INT;
	     other;
	     input pos;
             empty.

FUNCTION prepend >DEBUGINFO trace to >ICACTS>:
  [ trace DEBUGINFO -> ICACT ], [ ICACT ICACTS -> ICACTS ].

FUNCTION maybe add guard trace (>ICACTS>):
  if trace option, prepend (guard) trace to ICACTS;
  +.

FUNCTION maybe add terminal trace (>ID, >ICACTS>):
  if trace option, prepend (terminal ID) trace to ICACTS;
  +.

FUNCTION maybe add call trace (>NONTERMINAL, >EXPRS, >ICACTS>):
  if trace option, prepend (call NONTERMINAL) trace to ICACTS;
  +.

FUNCTION maybe add option call trace (>NONTERMINAL, >EXPRS, >ICACTS>):
  if trace option, prepend (option call NONTERMINAL) trace to ICACTS;
  +.

FUNCTION maybe add penalty trace (>INT, >ICACTS>):
  if trace option, prepend (penalty INT) trace to ICACTS;
  +.

FUNCTION maybe add skip trace (>ID, >ICACTS>):
  if trace option, prepend (skip ID) trace to ICACTS;
  +.

FUNCTION maybe add match trace (>ID, >ICACTS>):
  if trace option, prepend (match ID) trace to ICACTS;
  +.

FUNCTION maybe add other trace (>ICACTS>):
  if trace option, prepend (other) trace to ICACTS;
  +.

FUNCTION maybe add input pos trace (>ICACTS>):
  if trace option, prepend (input pos) trace to ICACTS;
  +.

FUNCTION maybe add director trace (>DIR_MEMO, >ICACTS>):
  if trace option,
    convert DIR_MEMO to INT,
    prepend (director INT) trace to ICACTS;
  +.
