#
#  File: optimize.k3
#  Defines routines and datastructures for runtime optimization support.
#
#  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: optimize.k3,v 1.31 2006/01/09 10:23:54 marcs Exp $"
#
MODULE optimize =
	MEMO_COUNT
	LR_MEMO_COUNT
	DIR_MEMO_COUNT
	MEMO_INFOS{}
	TERM_TO_MEMO{}
	SKIP_TO_MEMO{}
	MATCH_TO_MEMO{}
	LEX_TO_MEMO{}
	MEMO_VEC_SIZE.

DEFINES	MEMO,
	LR_MEMO,
	DIR_MEMO,
	MEMO_OBJECT,

	ACTION left factorize grammar,
	ACTION create new memo (>DIRSET, >BOOL, MEMO>),
	FUNCTION get number of memos (INT>),
	FUNCTION convert >MEMO to INT>,
	FUNCTION convert >MEMO to TEXT>,
	FUNCTION get memo penalty (>MEMO, BOOL>),

	ACTION create new lr memo (>DIRSET, LR_MEMO>),
	FUNCTION get number of lr memos (INT>),
	FUNCTION convert >LR_MEMO to INT>,
	FUNCTION convert >LR_MEMO to TEXT>,

	ACTION create new director memo (>DIRSET, DIR_MEMO>),
	FUNCTION get number of director memos (INT>),
	FUNCTION convert >DIR_MEMO to INT>,
	FUNCTION convert >DIR_MEMO to TEXT>,

	ACTION initialize directors with memos,
	FUNCTION get memo vector size (INT>),
	FUNCTION get memo slice (>MEMO_OBJECT, >INT1, INT2>),
	ACTION log memo directors.

USES rule, globals, properties, io, id, list, textstorage, transduction.

#############################
#                           #
#   Module initialisation   #
#                           #
#############################

PRELUDE init optimize:
  [0 -> MEMO_COUNT],
    [0 -> LR_MEMO_COUNT],
    [0 -> DIR_MEMO_COUNT].

#############
#           #
#   Memos   #
#           #
#############

MEMO :: memo INT.
MEMO_COUNT = INT.

MEMO_INFO :: penalty BOOL directors DIRSET.
MEMO_INFOS = MEMO_INFO.

FUNCTION get number of memos (INT>):
  [MEMO_COUNT -> INT].

ACTION create new memo (>DIRSET, >BOOL, MEMO>):
  [memo MEMO_COUNT -> MEMO],
    [MEMO_COUNT + 1 -> MEMO_COUNT],
    store memo info (MEMO, penalty BOOL directors DIRSET).

ACTION store memo info (>MEMO, >MEMO_INFO):
  convert MEMO to INT,
    [MEMO_INFO -> MEMO_INFOS{INT}].

FUNCTION get memo info (>MEMO, MEMO_INFO>):
  convert MEMO to INT,
    [MEMO_INFOS{INT} -> MEMO_INFO].

FUNCTION get memo penalty (>MEMO, BOOL>):
  get memo info (MEMO, MEMO_INFO),
    [MEMO_INFO -> penalty BOOL directors DIRSET].

FUNCTION get memo directors (>MEMO, DIRSET>):
  get memo info (MEMO, MEMO_INFO),
    [MEMO_INFO -> penalty BOOL directors DIRSET].

FUNCTION convert >INT to MEMO>:
  [memo INT -> MEMO].

FUNCTION convert >MEMO to INT>:
  [MEMO -> memo INT].

FUNCTION convert >MEMO to TEXT>:
  get memo penalty (MEMO, BOOL),
    convert MEMO to INT,
    convert INT to TEXT,
      ([BOOL -> true],
         ["memo " + TEXT + " with penalty" -> TEXT];
       ["memo " + TEXT -> TEXT]).

### Left-recursion blocks

# For left-recursion blocks, we use the same memo table as for
# negative memos.

LR_MEMO :: lr MEMO.

LR_MEMO_COUNT = INT.

FUNCTION get number of lr memos (INT>):
  [LR_MEMO_COUNT -> INT].

ACTION create new lr memo (>DIRSET, LR_MEMO>):
  create new memo (DIRSET, false, MEMO),
    [lr MEMO -> LR_MEMO],
    [LR_MEMO_COUNT + 1 -> LR_MEMO_COUNT].

FUNCTION convert >LR_MEMO to INT>:
  [LR_MEMO -> lr MEMO],
    convert MEMO to INT.

FUNCTION convert >LR_MEMO to TEXT>:
  convert LR_MEMO to INT,
    convert INT to TEXT,
    ["lr memo " + TEXT -> TEXT].

### Director test memos

# For director set blocks, we use the same memo table as for
# negative memos.

DIR_MEMO :: director MEMO.

DIR_MEMO_COUNT = INT.

FUNCTION get number of director memos (INT>):
  [DIR_MEMO_COUNT -> INT].

ACTION create new director memo (>DIRSET, DIR_MEMO>):
  create new memo (DIRSET, false, MEMO),
    [director MEMO -> DIR_MEMO],
    [DIR_MEMO_COUNT + 1 -> DIR_MEMO_COUNT].

FUNCTION convert >DIR_MEMO to INT>:
  [DIR_MEMO -> director MEMO],
    convert MEMO to INT.

FUNCTION convert >DIR_MEMO to TEXT>:
  convert DIR_MEMO to INT,
    convert INT to TEXT,
    ["director memo " + TEXT -> TEXT].

#####################
#                   #
#   Director sets   #
#                   #
#####################

# Director set look-ahead is implemented by closing memo blocks,
# using the director-sets of memo tests.
# We will map bitmatrices TERMINAL x MEMO -> {true, false} on arrays.
# Memo bitvectors for each terminal are mapped on consecutive slices
# of an integer array, aligned on integer boundaries.

TERM_TO_MEMO,
SKIP_TO_MEMO,
MATCH_TO_MEMO,
LEX_TO_MEMO,
MEMO_VEC_SIZE = INT.
BITS = INT.

MEMO_OBJECT :: terminal; 
               regexp skip;
               regexp match;
               lexicon nonterminal.

ACTION initialize directors with memos:
  determine memo vector size,
    init memo vectors,
    add memos to directors.

ACTION determine memo vector size:
  get number of memos (INT),
#    get bits per word (BITS),
    [ 32 -> BITS ],
    [INT % BITS + 1 -> MEMO_VEC_SIZE].

ACTION init memo vectors:
  init terminal memos,
    init regexp skip memos,
    init regexp match memos,
    init lexicon memos.

ACTION init terminal memos:
  get number of syntax terminals (INT),
    init terminal memo vector (INT * MEMO_VEC_SIZE).

ACTION init regexp skip memos:
  get number of regexp skips (INT),
    init regexp skip memo vector (INT * MEMO_VEC_SIZE).

ACTION init regexp match memos:
  get number of regexp matches (INT),
    init regexp match memo vector (INT * MEMO_VEC_SIZE).

ACTION init lexicon memos:
  get number of lexicon nonterminals (INT),
    init lexicon memo vector (INT * MEMO_VEC_SIZE).

ACTION init terminal memo vector (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    [0 -> TERM_TO_MEMO{INT}],
    init terminal memo vector (INT).

ACTION init regexp skip memo vector (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    [0 -> SKIP_TO_MEMO{INT}],
    init regexp skip memo vector (INT).

ACTION init regexp match memo vector (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    [0 -> MATCH_TO_MEMO{INT}],
    init regexp match memo vector (INT).

ACTION init lexicon memo vector (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    [0 -> LEX_TO_MEMO{INT}],
    init lexicon memo vector (INT).

ACTION add memos to directors:
  get number of memos (INT),
    add memos to directors (INT).

ACTION add memos to directors (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    add memo to directors (INT),
    add memos to directors (INT).

ACTION add memo to directors (>INT):
#  get bits per word (BITS),
  [ 32 -> BITS ],
    convert INT to MEMO,
    get memo directors (MEMO, DIRSET),
      (is unrestricted (DIRSET),
         add memo to all terminals (MEMO, BITS),
         add memo to all regexp skips (MEMO, BITS),
         add memo to all regexp matches (MEMO, BITS),
         add memo to all lexicon nonterminals (MEMO, BITS);
       convert DIRSET to terminal G_SET,
         add memo to terminals (MEMO, G_SET, BITS),
         add memo to regexp skips (MEMO, G_SET, BITS),
         add memo to regexp matches (MEMO, G_SET, BITS),
         add memo to lexicon nonterminals (MEMO, G_SET, BITS)).

ACTION add memo to all terminals (>MEMO, >BITS):
  get number of syntax terminals (INT),
    add MEMO to each (terminal, INT, BITS).

ACTION add memo to all regexp skips (>MEMO, >BITS):
  get number of regexp skips (INT),
    add MEMO to each (regexp skip, INT, BITS).

ACTION add memo to all regexp matches (>MEMO, >BITS):
  get number of regexp matches (INT),
    add MEMO to each (regexp match, INT, BITS).

ACTION add memo to all lexicon nonterminals (>MEMO, >BITS):
  get number of lexicon nonterminals (INT),
    add MEMO to each (lexicon nonterminal, INT, BITS).

ACTION add memo to terminals (>MEMO, >G_SET, >BITS):
  convert G_SET to terminal LIST,
    add MEMO to (terminal, LIST, BITS).

ACTION add memo to regexp skips (>MEMO, >G_SET, >BITS):
  convert G_SET to regexp skip LIST,
    add MEMO to (regexp skip, LIST, BITS).

ACTION add memo to regexp matches (>MEMO, >G_SET, >BITS):
  convert G_SET to regexp match LIST,
    add MEMO to (regexp match, LIST, BITS).

ACTION add memo to lexicon nonterminals (>MEMO, >G_SET, >BITS):
  convert G_SET to lexicon nonterminal LIST,
    add MEMO to (lexicon nonterminal, LIST, BITS).

ACTION add >MEMO to each (>MEMO_OBJECT, >INT, >BITS):
  [INT -> 0];
  [INT - 1 -> INT],
    add MEMO to (MEMO_OBJECT, INT, BITS),
    add MEMO to each (MEMO_OBJECT, INT, BITS).

ACTION add >MEMO to (>MEMO_OBJECT, >LIST, >BITS):
  pop (LIST, INT),
    add MEMO to (MEMO_OBJECT, INT, BITS),
    add MEMO to (MEMO_OBJECT, LIST, BITS);
  +.

# memo_vector_size = nr_memos % bits_per_word + 1
# base = terminal_nr * memo_vector_size
# array_elem = base + memo % bits_per_word
# bit = memo %% bits_per_word

ACTION add >MEMO to (>MEMO_OBJECT, >INT2, >BITS):
  convert MEMO to INT1,
    [INT2 * MEMO_VEC_SIZE + INT1 % BITS -> INT3],
    get memo slice (MEMO_OBJECT, INT3, INT),
    [(1 << (INT1 %% BITS)) || INT -> INT],
    store memo slice (MEMO_OBJECT, INT3, INT).

FUNCTION get memo vector size (INT>):
  [MEMO_VEC_SIZE -> INT].

FUNCTION get memo slice (>MEMO_OBJECT, >INT1, INT2>):
  [MEMO_OBJECT -> terminal],
    [TERM_TO_MEMO{INT1} -> INT2];
  [MEMO_OBJECT -> regexp skip],
    [SKIP_TO_MEMO{INT1} -> INT2];
  [MEMO_OBJECT -> regexp match],
    [MATCH_TO_MEMO{INT1} -> INT2];
  [MEMO_OBJECT -> lexicon nonterminal],
    [LEX_TO_MEMO{INT1} -> INT2];
  ?.

ACTION store memo slice (>MEMO_OBJECT, >INT1, >INT2):
  [MEMO_OBJECT -> terminal],
    [INT2 -> TERM_TO_MEMO{INT1}];
  [MEMO_OBJECT -> regexp skip],
    [INT2 -> SKIP_TO_MEMO{INT1}];
  [MEMO_OBJECT -> regexp match],
    [INT2 -> MATCH_TO_MEMO{INT1}];
  [MEMO_OBJECT -> lexicon nonterminal],
    [INT2 -> LEX_TO_MEMO{INT1}];
  ?.

### Logging

ACTION log memo directors:
  log ("MEMO DIRECTORS TABLE:"),
    get number of memos (INT),
    log memo directors (INT),
    flush log.
    
ACTION log memo directors (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    log directors of memo (INT),
    log memo directors (INT).

ACTION log directors of memo (>INT):
  convert INT to MEMO,
    get memo directors (MEMO, DIRSET),
    convert MEMO to TEXT,
    convert DIRSET to terminal G_SET,
      (is unrestricted (DIRSET),
         log (" Directors of " + TEXT + " (unrestricted):", G_SET);
       log (" Directors of " + TEXT + ":", G_SET)).

######################
#                    #
#   Left factoring   #
#                    #
######################

ACTION left factorize grammar:
  get number of syntax nonterminals (INT),
    left factorize grammar (INT).

ACTION left factorize grammar (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    left factorize rule (INT),
    left factorize grammar (INT).

ACTION left factorize rule (>INT):
  convert INT to NONTERMINAL,
    (is start nonterminal (NONTERMINAL);
     is lexicon nonterminal (NONTERMINAL);
     get definitions (NONTERMINAL, DEFS),
       left factorize (DEFS),		# defined in rule.k3
       store definitions (NONTERMINAL, DEFS)).

ACTION left factorize (>DEFS>):
  [DEFS -> nil];
  [DEFS -> DEF DEFS1],
    left factorize (DEF),
    left factorize (DEFS1),
    [DEF DEFS1 -> DEFS];
  ?.

ACTION left factorize (>DEF>):
  [DEF -> FORMALS at POS with ALTS],
    left factorize alternatives (ALTS),
    [FORMALS at POS with ALTS -> DEF].

ACTION left factorize alternatives (>ALTS>):
  get commit seperated group of ALTS1 from ALTS,
    group and left factorize ALTS1 with the same starting members,
#    left factorize alternatives (ALTS),
    put ALTS1 back in front of ALTS.

FUNCTION count nr of alts(>ALTS,INT>):
  [ALTS -> nil],
    [0 -> INT];
  [ALTS -> ALT ALTS],
    count nr of alts (ALTS,INT),
    [INT+1 -> INT];
  ?.

FUNCTION get commit seperated group of ALTS1> from >ALTS>:
  [ALTS -> nil],
    [nil -> ALTS1];
  [ALTS -> ALT ALTS],
    (is committed (ALT),
       [ALT nil -> ALTS1];
     get commit seperated group of ALTS1 from ALTS,
       [ALT ALTS1 -> ALTS1]);
  ?.

FUNCTION put >ALTS1 back in front of >ALTS>:
  [ALTS1 -> nil];
  [ALTS -> nil],
    [ALTS1 -> ALTS];
  [ALTS1 -> ALT2 ALTS2],
    put ALTS2 back in front of ALTS,
    [ALT2 ALTS -> ALTS];
  ?.

ACTION group and left factorize >ALTS> with the same starting members:
  [ALTS -> nil];
  [ALTS -> ALT1 ALTS1],
    ([ALT1 -> FREQ MEMBERS LOCALS COMMITED SECONDPASS],
       [MEMBERS -> MEMBER MEMBERS9],
       get ALTS2 from ALTS1 which start with MEMBER,
       left factorize ALT1 and ALTS2 into ALT2 because they start with MEMBER,
       group and left factorize ALTS1 with the same starting members,
       [ALT2 ALTS1 -> ALTS];
     group and left factorize ALTS1 with the same starting members,
       [ALT1 ALTS1 -> ALTS]);
  ?.

FUNCTION get ALTS1> from >ALTS> which start with >MEMBER:
  [ALTS -> nil],
    [ALTS -> ALTS1];
  [ALTS -> ALT ALTS],
    (is ALT with a starting MEMBER,
       get ALTS1 from ALTS which start with MEMBER,
       [ALT ALTS1 -> ALTS1];
     get ALTS1 from ALTS which start with MEMBER,
       [ALT ALTS -> ALTS]);
  ?.

TEST is >ALT with a starting >MEMBER:
  get starting MEMBER1 from ALT,
    is equivalent (MEMBER, MEMBER1);
  -.

TEST get starting MEMBER> from >ALT:
  [ALT -> FREQ MEMBERS LOCALS COMMITED SECONDPASS],
    [MEMBERS -> MEMBER MEMBERS1].


ACTION left factorize >ALT1 and >ALTS into ALT> because they start with >MEMBER:
  [ALTS -> nil],
    [ALT1 -> ALT];
  [ALT1 ALTS -> ALTS],
    remove 1 starting members from ALTS,
    fix 1 starting trembers in ALTS,
    group and left factorize ALTS with the same starting members,
    generate internal final group (ALTS, MEMBER2),
    [MEMBER2 nil -> MEMBERS2],
    [MEMBER MEMBERS2 -> MEMBERS],
    [trans nil and tree nil -> SECONDPASS],
    unspecified (FREQ),
    [FREQ MEMBERS nil false SECONDPASS -> ALT].

FUNCTION remove >INT starting members from >ALTS>:
  [ALTS -> nil];
  [ALTS -> ALT1 ALTS1],
    remove INT starting members from ALT1,
    remove INT starting members from ALTS1,
    [ALT1 ALTS1 -> ALTS];
  ?.

FUNCTION remove >INT starting members from >ALT>:
  [ALT -> FREQ MEMBERS LOCALS COMMITED SECONDPASS],
    remove INT starting members from MEMBERS,
    [FREQ MEMBERS LOCALS COMMITED SECONDPASS -> ALT];
  ?.

FUNCTION remove >INT starting members from >MEMBERS>:
  [INT -> 0];
  [INT - 1 -> INT],
    ([MEMBERS -> MEMBER MEMBERS],
       remove INT starting members from MEMBERS;
     ?).

FUNCTION fix >INT starting trembers in >ALTS>:
  [ALTS -> ALT1 ALTS1],
    get INT pieces of TREMBERS from ALT1,
    replace INT starting trembers in ALTS1 by TREMBERS,
    [ALT1 ALTS1 -> ALTS];
  ?.

FUNCTION get >INT pieces of TREMBERS> from >ALT:
  [ALT -> FREQ MEMBERS LOCALS COMMITED SECONDPASS],
    [SECONDPASS -> trans TREMBERS1 and tree TREMBERS],
    get INT pieces of TREMBERS;
  ?.

FUNCTION get >INT pieces of >TREMBERS>:
  [INT -> 0],
    [nil -> TREMBERS];
  [INT - 1 -> INT],
    ([TREMBERS -> TREMBER1 TREMBERS1],
       get INT pieces of TREMBERS1,
       [TREMBER1 TREMBERS1 -> TREMBERS];
     ?).

FUNCTION replace >INT starting trembers in >ALTS> by >TREMBERS:
  [ALTS -> nil];
  [ALTS -> ALT1 ALTS1],
    replace INT starting trembers in ALT1 by TREMBERS,
    replace INT starting trembers in ALTS1 by TREMBERS,
    [ALT1 ALTS1 -> ALTS];
  ?.

FUNCTION replace >INT starting trembers in >ALT> by >TREMBERS:
  [ALT -> FREQ MEMBERS LOCALS COMMITED SECONDPASS],
    replace INT starting trembers in SECONDPASS by TREMBERS,
    [FREQ MEMBERS LOCALS COMMITED SECONDPASS -> ALT];
  ?.

FUNCTION replace >INT starting trembers in >SECONDPASS> by >TREMBERS:
  [SECONDPASS -> trans TREMBERS1 and tree TREMBERS2],
    replace INT starting trembers in TREMBERS1 by TREMBERS,
    replace INT starting trembers in TREMBERS2 by TREMBERS,
    [trans TREMBERS1 and tree TREMBERS2 -> SECONDPASS];
  ?.

#
# FUNCTION replace >INT starting trembers in >TREMBERS> by >TREMBERS1
# does only replace the terminal trembers (more ain't needed)!
#
FUNCTION replace >INT starting trembers in >TREMBERS> by >TREMBERS1:
  [INT -> 0];
  [TREMBERS -> nil];
  [TREMBERS -> TREMBER2 TREMBERS2],
    [TREMBERS1 -> TREMBER1 TREMBERS1],
    [INT - 1 -> INT],
    (if TREMBER1 is terminal trans,
       replace INT starting trembers in TREMBERS2 by TREMBERS1,
       [TREMBER1 TREMBERS2 -> TREMBERS];
     replace INT starting trembers in TREMBERS2 by TREMBERS1,
       [TREMBER2 TREMBERS2 -> TREMBERS]);
  ?.

TEST if >TREMBER is terminal trans:
  [ TREMBER -> terminal ID using EXPR ].
