#
#  File: affix.k3
#  Defines all affix handling routines.
#
#  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: affix.k3,v 1.27 2005/10/26 13:36:54 marcs Exp $"
#
MODULE affix =
	AFFIX_RULES{}	AFFIX_RULE_COUNT
	HASHED_RULES{}	HASH_SIZE.

DEFINES MALTS,
	ACTION analyse affix rules,
        TEST get affix rule (>ID, MALTS>),

	ACTION enter affix rule (>ID, >MALTS, >POS),
	ACTION enter text affix (>ID, >POS),
	ACTION enter integer affix (>ID, >POS),

	ACTION create anonymous affix rule (>MALTS, ID>),
	ACTION create anonymous text affix (ID>),
	ACTION create anonymous integer affix (ID>),

	TEST add unique (>MALTS>, >ID),
	TEST where variable in set (>ID),

	FUNCTION convert set >ID to TEXT>,
        TEST affix nonterminal has alternatives (>ID),
        TEST check affix nonterminal id defined (>ID),

	#ACTION dump warshalled domains,

	ACTION log affix rules,
        ACTION write affixes to lif.

USES globals, io, id, set, textstorage, rule, list.

AFFIX_NR = INT.

######################### NOTICE ##########################
# Some of the routines in this file, occur in newtab.k3   #
# and matrix.k3 of lexgen2. They are indicated            #  
# by a remark '*Lexgen2-newtab*' and                      #
# '*Lexgen2-matrix*' respectively. Every change to        #
# these routines MUST be applied to newtab.k3/matrix.k3   #
# of the Lexgen2 as well.                                 #   
########################################################### 

PRELUDE init affix:
  [0 -> AFFIX_RULE_COUNT],
    init hash table.

###################
#                 #
#   Affix rules   #
#                 #
###################

AFFIX_RULES = AFFIX_RULE.

AFFIX_RULE :: ID with MALTS.

AFFIX_RULE_COUNT = INT.

TEST get affix rule (>ID, MALTS>):
  get affix rule number (ID, RULENR),
    get affix rule (RULENR, AFFIX_RULE),
    [AFFIX_RULE -> ID with MALTS].

ACTION enter affix rule (>ID, >MALTS):
  [ID with MALTS -> AFFIX_RULE],
    add affix rule (AFFIX_RULE, RULENR),
    store affix rule number (ID, RULENR).

ACTION add affix rule (>AFFIX_RULE, RULENR>):
  [AFFIX_RULE_COUNT -> RULENR],
    [AFFIX_RULE_COUNT + 1 -> AFFIX_RULE_COUNT],
    store affix rule (RULENR, AFFIX_RULE).

ACTION store affix rule (>RULENR, >AFFIX_RULE):
  [RULENR -> INT],
    [AFFIX_RULE -> AFFIX_RULES{INT}].

FUNCTION get affix rule (>RULENR, AFFIX_RULE>):
  [RULENR -> INT],
    [AFFIX_RULES{INT} -> AFFIX_RULE].

#-------------------------------------------------------------------------------
# Affix rules may be repeated for documentation purposes. However, all
# definitions should be equal, modulo ordering of alternatives.
# Ids in meta alternatives are sorted. In this way equivalent alternatives
# are also equal. Use 'add unique' for construction.

MALTS:: ID MALTS;
        nil.

# This triggers A Bug in CDL3.

#TEST add unique (>MALTS>, >ID):
#  [MALTS -> nil],
#    [ID nil -> MALTS];
#  [MALTS -> ID1 MALTS1],
#    ([ID = ID1],
#       -;
#     less (ID, ID1),
#       [ID MALTS -> MALTS];
#     add unique (MALTS1, ID),
#       [ID1 MALTS1 -> MALTS]);
#  ?.

TEST add unique (>MALTS>, >ID):
  if ID already in MALTS,
    -;
  add ID to sorted MALTS.

TEST if >ID already in >MALTS:
  [MALTS -> ID1 MALTS1],
    ([ID = ID1];
     if ID already in MALTS1;
     -);
  [MALTS -> nil],
    -;
  ?.

FUNCTION add >ID to sorted >MALTS>:
  [MALTS -> nil],
    [ID nil -> MALTS];
  [MALTS -> ID1 MALTS1],
    (less (ID, ID1),
       [ID MALTS -> MALTS];
     add ID to sorted MALTS1,
       [ID1 MALTS1 -> MALTS]);
  ?.
       
TEST where alternatives equivalent (>MALTS1, >MALTS2):
  [MALTS1 = MALTS2].

### User affix rules

ACTION enter affix rule (>ID, >MALTS, >POS):
  affix is already defined (ID, MALTS, POS);
  mark affix nonterminal (ID, MALTS),
    enter affix rule (ID, MALTS).

ACTION mark affix nonterminal (>ID, >MALTS):
  is alias definition (MALTS),
    (mark id as untyped affix nonterminal (ID);	#resolve type later
     ?);
  mark id as set affix nonterminal (ID);
  ?.

TEST is alias definition (>MALTS):
  [MALTS -> ID nil].

ACTION enter text affix (>ID, >POS):
  text affix is already defined (ID, POS);
  mark id as text affix (ID);
  ?.

ACTION enter integer affix (>ID, >POS):
  integer affix is already defined (ID, POS);
  mark id as integer affix (ID);
  ?.

PRED affix is already defined (>ID, >MALTS, >POS):
  affix is lexicon terminal (ID, POS);
  affix is text affix (ID, POS);
  affix is integer affix (ID, POS);
  affix has alternatives (ID, MALTS, POS).

PRED text affix is already defined (>ID, >POS):
  affix is lexicon terminal (ID, POS);
  affix is integer affix (ID, POS);
  affix is set affix (ID, POS);
  text affix has alternatives (ID, POS).

PRED integer affix is already defined (>ID, >POS):
  affix is lexicon terminal (ID, POS);
  affix is text affix (ID, POS);
  affix is set affix (ID, POS);
  integer affix has alternatives (ID, POS).

PRED affix is lexicon terminal (>ID, >POS):
  id is lexicon affix terminal (ID),
    convert id to name (ID, TEXT),
    interface error ("affix '" + TEXT + "' is a lexicon terminal", POS).

PRED affix is text affix (>ID, >POS):
  id is text affix (ID),
    convert id to name (ID, TEXT),
    error ("affix '" + TEXT + "' is already defined as text affix", POS).

PRED affix is integer affix (>ID, >POS):
  id is integer affix (ID),
    convert id to name (ID, TEXT),
    error ("affix '" + TEXT + "' is already defined as integer affix", POS).

PRED affix is set affix (>ID, >POS):
  id is set affix (ID),
    convert id to name (ID, TEXT),
    error ("affix '" + TEXT + "' is already defined as set affix", POS).

PRED text affix has alternatives (>ID, >POS):
  get affix rule (ID, MALTS1),
    report conflicting affix definition (ID, POS).

PRED integer affix has alternatives (>ID, >POS):
  get affix rule (ID, MALTS1),
    report conflicting affix definition (ID, POS).

PRED affix has alternatives (>ID, >MALTS, >POS):
  get affix rule (ID, MALTS1),
    (where alternatives equivalent (MALTS, MALTS1);
     report conflicting affix definition (ID, POS)).

ACTION report conflicting affix definition (>ID, >POS):
  convert id to name (ID, TEXT),
    error ("definition of affix '"+ TEXT +
           "' does not match previous definition", POS).

#######################
#                     #
#   Anonymous rules   #
#                     #
#######################

# When entering a rule for an affix expression, it is checked whether
# the expression has been entered before, in order to prevent the creation
# of a new rule for each expression. For this, meta alternatives are
# hashed onto their possible rule numbers.

HASH_SIZE = INT.

HASHED_RULES = RULES.

RULES :: RULENR RULES;
         nil.

ACTION init hash table:
  [256 -> HASH_SIZE],
    init hash table (HASH_SIZE).

ACTION init hash table (>INT):
  [INT -> 0];
  [INT - 1 -> INT1],
    [nil -> HASHED_RULES{INT}],
    init hash table (INT1).

ACTION create anonymous affix rule (>MALTS, ID>):
  hash (MALTS, INT),
    [HASHED_RULES{INT} -> RULES],
      (identify affix rule (RULES, MALTS, ID);
       create anonymous affix rule (MALTS, ID, RULENR),
         [RULENR RULES -> HASHED_RULES{INT}]).

ACTION create anonymous affix rule (>MALTS, ID>, RULENR>):
  create anonymous id (ID),
    mark id as anonymous affix nonterminal (ID),
    add affix rule (ID with MALTS, RULENR),
    store affix rule number (ID, RULENR).

FUNCTION hash (>MALTS, INT>):
  fold (MALTS, INT),
    [(INT ^ (INT >> 24) ^ (INT >> 16) ^ (INT >> 8)) & 255 -> INT],
    [INT + 1 -> INT].

FUNCTION fold (>MALTS, INT>):
  [MALTS -> nil],
    [0 -> INT];
  [MALTS -> ID MALTS1],
    fold (MALTS1, INT1),
    [ID + INT1 -> INT];
  ?.

TEST identify affix rule (>RULES, >MALTS, ID>):
  [RULES -> RULENR RULES1],
    (identify affix rule (RULENR, MALTS, ID);
     identify affix rule (RULES1, MALTS, ID)).

TEST identify affix rule (>RULENR, >MALTS, ID>):
  get affix rule (RULENR, AFFIX_RULE),
    [AFFIX_RULE -> ID with MALTS1],
      where alternatives equivalent (MALTS, MALTS1).

ACTION create anonymous text affix (ID>):
  create anonymous id (ID),
    mark id as anonymous text affix (ID).

ACTION create anonymous integer affix (ID>):
  create anonymous id (ID),
    mark id as anonymous integer affix (ID).

FUNCTION convert set >ID to TEXT>:
  get affix rule (ID, MALTS),
    convert MALTS to TEXT with separator ("|");
  ?.

TEST affix nonterminal has alternatives (>ID):
  get affix rule (ID, MALTS),
    ([MALTS -> nil], -; +).

########################
#                      #
#   Variables in set   #
#                      #
########################

# Variables in sets are forbidden, because it frustrates on the fly
# affix evaluation. Suppose that a restrict to a set containing a
# variable (or a variable itself) succeeds, then the variable may
# be restricted later to a value that result in an erroneous affix
# attribution.
# Example: Let X::x;y. Then {X1::X2},{X1::x},{X2::y} might succeed.

TEST where variable in set (>ID):
  get affix rule (ID, MALTS),
    where variable in set (MALTS).

TEST where variable in set (>MALTS):
  [MALTS -> ID MALTS1],
    (id is affix nonterminal (ID);
     where variable in set (MALTS1)).

#########################
#                       #
#   Semantic analysis   #
#                       #
#########################

ACTION analyse affix rules:
  mark unknown affix ids,
    log affix info,
    perform warshall,
    check affixes for recursion,
    resolve affix types,
    type check affix rules,
    abort if errors found,
    calculate affix weights,
    perform graph coloring,
    check affix nonterminals defined,
    check occurrence terminals,
    abort if errors found,
    check affix alternatives disjoint,
    abort if errors found.

################
#              #
#   Warshall   #
#              #
################

# Using the Warshall algorithm, the transitive closure of the affix domains
# is calculated.

ACTION perform warshall:
  initialize matrix,
    add affixes to matrix,
    warshall matrix,
    display time("warshalled affix rules").

ACTION initialize matrix:
  get number of affixes (INT),
    initialize matrix (INT).

ACTION add affixes to matrix:
  add affix rules to matrix,
    add text affixes to matrix,
    add integer affixes to matrix.

### Affix rules

ACTION add affix rules to matrix:
  add affix rules to matrix (AFFIX_RULE_COUNT).

ACTION add affix rules to matrix (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    add affix rule to matrix (INT),
    add affix rules to matrix (INT).

ACTION add affix rule to matrix (>INT):
  [AFFIX_RULES{INT} -> AFFIX_RULE],
    [AFFIX_RULE -> ID with MALTS],
    add affix rule to matrix (ID, MALTS).

ACTION add affix rule to matrix (>ID, >MALTS):
  convert id to affix (ID, AFFIX_NR),
    add affix alternatives to matrix (AFFIX_NR, MALTS).

ACTION add affix alternatives to matrix (>AFFIX_NR, >MALTS):
  [MALTS -> nil];
  [MALTS -> ID MALTS1],
    add affix alternative to matrix (AFFIX_NR, ID),
    add affix alternatives to matrix (AFFIX_NR, MALTS1);
  ?.

ACTION add affix alternative to matrix (>AFFIX_NR1, >ID):
  convert id to affix (ID, AFFIX_NR2),
    matrix set (AFFIX_NR1, AFFIX_NR2).

### Text affixes

ACTION add text affixes to matrix:
  get text affix (ID),
    convert id to affix (ID, AFFIX_NR),
    get number of text affixes (INT),
    add text affixes to matrix (INT, AFFIX_NR).

ACTION add text affixes to matrix (>INT, >AFFIX_NR):
  [INT -> 0];
  [INT - 1 -> INT],
    add text affix to matrix (INT, AFFIX_NR),
    add text affixes to matrix (INT, AFFIX_NR).

ACTION add text affix to matrix (>INT, >AFFIX_NR2):
  convert text affix to id (INT, ID),
    convert id to affix (ID, AFFIX_NR1),
      ([AFFIX_NR1 = AFFIX_NR2];	# don't add recursive rule TEXT::TEXT.
       matrix set (AFFIX_NR1, AFFIX_NR2)).

### Integer affixes

ACTION add integer affixes to matrix:
  get integer affix (ID),
    convert id to affix (ID, AFFIX_NR),
    get number of integer affixes (INT),
    add integer affixes to matrix (INT, AFFIX_NR).

ACTION add integer affixes to matrix (>INT, >AFFIX_NR):
  [INT -> 0];
  [INT - 1 -> INT],
    add integer affix to matrix (INT, AFFIX_NR),
    add integer affixes to matrix (INT, AFFIX_NR).

ACTION add integer affix to matrix (>INT, >AFFIX_NR2):
  convert integer affix to id (INT, ID),
    convert id to affix (ID, AFFIX_NR1),
      ([AFFIX_NR1 = AFFIX_NR2];	# don't add recursive rule INT::INT.
       matrix set (AFFIX_NR1, AFFIX_NR2)).

#############################
#                           #
#   Recursive affix rules   #
#                           #
#############################

# Recursion in affix rules is forbidden. Recursive affix rules are
# detected using the Warshalled affix matrix.

ACTION check affixes for recursion:
  get number of affixes (INT),
    check affixes for recursion (INT),
    display time("checked affix rules for recursion").

ACTION check affixes for recursion (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    check affix for recursion (INT),
    check affixes for recursion (INT).

ACTION check affix for recursion (>INT):
  matrix test (INT, INT),
    convert affix to id (INT, ID),
    convert id to name (ID, TEXT),
    error ("affix nonterminal '" + TEXT + "' is recursive");
  +.

#######################
#                     #
#   Resolving types   #
#                     #
#######################

# Determine types of untyped affixes. If an untyped affix nonterminal
# contains a set affix, then mark it as set affix. Otherwise, check
# whether it contains an integer or text affix, but not both.
# Note that we still need to check whether set affixes contain text
# or integer affixes, during the type checking phase

ACTION resolve affix types:
  get number of affix nonterminals (INT),
    resolve affix types (INT),
    display time ("resolved affix types").

ACTION resolve affix types (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    resolve affix type (INT),
    resolve affix types (INT).

ACTION resolve affix type (>INT):
  convert affix nonterminal to id (INT, ID),
    (id is untyped affix (ID),
       resolve untyped affix (ID);
     +).

ACTION resolve untyped affix (>ID):
  affix contains set affix (ID),
    (mark id as set affix nonterminal (ID);
     ?);
  affix contains text affix (ID),
    (affix contains integer affix (ID),
       mark id as invalid affix (ID);
     mark id as text affix (ID);
     ?);
  affix contains integer affix (ID),
    (mark id as integer affix (ID);
     ?);
  mark id as invalid affix (ID).

TEST affix contains set affix (>ID):
  get number of affix terminals (INT),
    convert id to affix (ID, AFFIX_NR),
    affix contains set affix terminal (INT, AFFIX_NR).

TEST affix contains set affix terminal (>INT, >AFFIX_NR):
  [INT -> 0],
    -;
  [INT - 1 -> INT],
    convert affix terminal to id (INT, ID),
    convert id to affix (ID, AFFIX_NR2),
      (matrix test (AFFIX_NR, AFFIX_NR2);
       affix contains set affix terminal (INT, AFFIX_NR)).

TEST affix contains text affix (>ID):
  get text affix (ID2),
    convert id to affix (ID, AFFIX_NR),
    convert id to affix (ID2, AFFIX_NR2),
    matrix test (AFFIX_NR, AFFIX_NR2).

TEST affix contains integer affix (>ID):
  get integer affix (ID2),
    convert id to affix (ID, AFFIX_NR),
    convert id to affix (ID2, AFFIX_NR2),
    matrix test (AFFIX_NR, AFFIX_NR2).

#####################
#                   #
#   Type checking   #
#                   #
#####################

# User defined rules may not contain lexicon affixes. Otherwise,
# affix weights and colors calculated by lexgen2 may differ.
# Check whether set rules do not contain text or integer affixes.
# For anonymous rules, we calculate whether the rule is included in
# some valid domain (tested later in rule.k3).

ACTION type check affix rules:
  type check affix rules (AFFIX_RULE_COUNT),
    display time ("type checked affix rules").

ACTION type check affix rules (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    type check affix rule (INT),
    type check affix rules (INT).

ACTION type check affix rule (>INT):
  get affix rule (INT, AFFIX_RULE),
    [AFFIX_RULE -> ID with MALTS],
    type check affix (ID, MALTS).

ACTION type check affix (>ID, >MALTS):
  id is set affix (ID),
    type check set affix (ID, MALTS);
  id is text affix (ID);
  id is integer affix (ID);
  id is anonymous affix (ID);		# reported later by rule.k3
  report invalid affix (ID).

ACTION report invalid affix (>ID):
  convert id to name (ID, TEXT),
    error ("affix '" + TEXT + "' has invalid type").

### Set affixes

ACTION type check set affix (>ID, >MALTS):
  id is anonymous affix (ID),
     type check anonymous set affix (ID);
  type check user set affix (ID, MALTS).

ACTION type check anonymous set affix (>ID):
  affix contains text affix (ID),
    mark id as invalid affix (ID); # reported later by rule.k3
  affix contains integer affix (ID),
    mark id as invalid affix (ID); # reported later by rule.k3
  set affix nonterminal occurs in user domain (ID);
  mark id as invalid affix (ID). # reported later by rule.k3

ACTION type check user set affix (>ID, >MALTS):
  [MALTS -> nil];
  [MALTS -> ID1 MALTS1],
    type check user set affix (ID, ID1),
    type check user set affix (ID, MALTS1);
  ?.

ACTION type check user set affix (>ID, >ID1):
  check user set affix domain (ID, ID1),
    check user set affix definition (ID, ID1).

# Check whether set domains do not contain text or integer affixes.

ACTION check user set affix domain (>ID1, >ID2):
  id is set affix (ID2);
  report invalid set domain (ID1, ID2).

# Check whether user defined domains do not contain lexicon affixes.
# This may results in inconsistent calculations of lexgen2 and AGFL.
# Solution: let AGFL calculate bit-sets, let LexGen store symbolic sets.

ACTION check user set affix definition (>ID1, >ID2):
  id is lexicon affix (ID2),
    report invalid definition (ID1, ID2);
  +.

ACTION report invalid set domain (>ID1, >ID2):
  convert id to name (ID1, TEXT1),
    convert id to name (ID2, TEXT2),
      (id is text affix (ID2),
         error ("set affix '" + TEXT1 +
                "' contains text affix '" + TEXT2 + "'");
       id is integer affix (ID2),
         error ("set affix '" + TEXT1 +
                "' contains integer affix '" + TEXT2 +"'");
       error ("set affix '" + TEXT1 +
              "' contains invalid affix '"+ TEXT2 +"'")).

ACTION report invalid definition (>ID1, >ID2):
  convert id to name (ID1, TEXT1),
    convert id to name (ID2, TEXT2),
    interface error ("definition of affix '" + TEXT1 +
                     "' contains  lexicon affix '" + TEXT2 + "'").

#####################
#                   #
#   Affix weights   #
#                   #
#####################

# The weight of an affix is the number of terminal affixes in its domain.

ACTION calculate affix weights:
  get number of affixes (INT),
    get number of affix terminals (INT1),
    calculate affix weights (INT, INT1),
    display time ("calculated affix weights").

ACTION calculate affix weights (>INT, >INT1):
  [INT -> 0];
  [INT - 1 -> INT],
    calculate affix weight (INT, INT1),
    calculate affix weights (INT, INT1).

ACTION calculate affix weight (>INT, >INT1):
  convert affix to id (INT, ID),
    (id is set affix (ID),
       weight affix terminals (INT, INT1, INT2),
       [INT2 -> WEIGHT],
       store affix weight (ID, WEIGHT);
     +).

ACTION weight affix terminals (>INT, >INT1, INT2>):
  [INT1 -> 0],
    [0 -> INT2];
  [INT1 - 1 -> INT1],
    weight affix terminal (INT, INT1, INT2),
    weight affix terminals (INT, INT1, INT3),
    [INT2 + INT3 -> INT2].

FUNCTION weight affix terminal (>INT, >INT1, INT2>):
  convert affix terminal to id (INT1, ID),
    convert id to affix (ID, INT1),
      (matrix test (INT, INT1),
         [1 -> INT2];
       [0 -> INT2]).

######################
#                    #
#   Graph coloring   #
#                    #
######################

# The affix matrix is colored using the graph coloring algorithm.
# The colors of the graph correspond to disjoint domains.

ACTION perform graph coloring:
  get number of affix nonterminals (INT),
    get number of affix terminals (INT1),
    initialize imatrix (INT1),
    fill interference matrix (INT, INT1),
    color imatrix (INT2),
    store set size (INT2),
    color affix terminals (INT1),
    color affix nonterminals (INT),
    display time ("colored affix graph").

#*Lexgen2-matrix*#
ACTION fill interference matrix (>INT, >INT1):
  [INT -> 0];
  [INT - 1 -> INT],
    fill imatrix (INT, INT1),
    fill interference matrix (INT, INT1).

#*Lexgen2-matrix*#
ACTION fill imatrix (>INT, >INT1):
  convert affix nonterminal to id (INT,ID),
    convert id to affix (ID,INT),
    fill imatrix terminals (INT,INT1).

#*Lexgen2-matrix*#
ACTION fill imatrix terminals (>INT, >INT1):
  [INT1 -> 0];
  [INT1 - 1 -> INT1],
    fill imatrix terminal (INT, INT1),
    fill imatrix terminals (INT, INT1).

#*Lexgen2-matrix*#
ACTION fill imatrix terminal (>INT, >INT1):
  convert affix terminal to id (INT1,ID),
    convert id to affix (ID,INT2),
      (matrix test (INT,INT2),
         fill imatrix terminal terminals (INT,INT1,INT1);
       +).

#*Lexgen2-matrix*#
ACTION fill imatrix terminal terminals (>INT, >INT1, >INT2):
  [INT2 -> 0];
  [INT2 - 1 -> INT2],
    fill imatrix terminal terminal (INT, INT1, INT2),
    fill imatrix terminal terminals (INT, INT1, INT2).

#*Lexgen2-matrix*#
ACTION fill imatrix terminal terminal (>INT, >INT1, >INT2):
  convert affix terminal to id (INT2, ID),
    convert id to affix (ID, INT3),
      (matrix test (INT, INT3),
         imatrix set (INT1, INT2),
         imatrix set (INT2, INT1);
       +).

#*Lexgen2-matrix*#
ACTION color affix terminals (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    color affix terminal (INT),
    color affix terminals (INT).

#*Lexgen2-matrix*#
ACTION color affix terminal (>INT):
  get color (INT, INT1),
    convert affix terminal to id (INT, ID),
    convert INT1 to SET,
    store set info (ID, SET).

#*Lexgen2-matrix*#
ACTION color affix nonterminals(>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    color affix nonterminal (INT),
    color affix nonterminals (INT).

#*Lexgen2-matrix*#
ACTION color affix nonterminal (>INT):
  get number of affix terminals (INT1),
    convert affix nonterminal to id (INT, ID),
      (id is set affix (ID),
         empty (SET),
         color affix nonterminal with terminals (ID, INT1, SET),
         store set info (ID, SET);
       +).

#*Lexgen2-matrix*#
ACTION color affix nonterminal with terminals (>ID, >INT1,  >SET>):
  [INT1 -> 0];
  [INT1 - 1 -> INT1],
    color affix nonterminal with terminal (ID, INT1, SET),
    color affix nonterminal with terminals (ID, INT1, SET).

#*Lexgen2-matrix*#
FUNCTION color affix nonterminal with terminal (>ID, >INT1, >SET>):
  convert id to affix (ID, INT),
    convert affix terminal to id (INT1, ID),
    convert id to affix (ID, INT1),
      (matrix test (INT, INT1),
         get set info (ID, SET1),
         or SET with SET1;
       +).


####################################
#                                  #
#   Undefined affix nonterminals   #
#                                  #
####################################

# Undefined affix nonterminals result from ids used syntactically as variables.
# These are marked as unknown affixes. Later, all unknown affixes are assumed
# to be of set type.

ACTION check affix nonterminals defined:
  get number of affix nonterminals (INT),
    check affix nonterminals defined (INT),
    display time ("checked affix nonterminals defined").

ACTION check affix nonterminals defined (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    check affix nonterminal defined (INT),
    check affix nonterminals defined (INT).

ACTION check affix nonterminal defined (>INT):
  convert affix nonterminal to id (INT, ID),
    (check affix nonterminal id defined (ID);
     convert id to name (ID, TEXT),
       error ("affix nonterminal '" + TEXT + "' is not defined")).

TEST check affix nonterminal id defined (>ID):
  id is set affix (ID),	# unknown affixes have been marked as set
    get set info (ID, SET),
    (is undefined (SET),
       -;
     +);
  +.


#######################################
#                                     #
#   Non-disjoint affix alternatives   #
#                                     #
#######################################

ACTION check affix alternatives disjoint:
  check affix alternatives disjoint (AFFIX_RULE_COUNT),
    display time ("checked affix alternatives disjoint").

ACTION check affix alternatives disjoint (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    check affix alternatives disjoint in rule (INT),
    check affix alternatives disjoint (INT).

ACTION check affix alternatives disjoint in rule (>INT):
  get affix rule (INT, AFFIX_RULE),
    [AFFIX_RULE -> ID with MALTS],
      (id is anonymous affix (ID);
       check affix alternatives disjoint (ID, MALTS)).

ACTION check affix alternatives disjoint (>ID, >MALTS):
  [MALTS -> nil];
  [MALTS -> ID1 MALTS1],
    check affix alternatives disjoint (ID, ID1, MALTS1),
    check affix alternatives disjoint (ID, MALTS1);
  ?.

ACTION check affix alternatives disjoint (>ID, >ID1, >MALTS):
  [MALTS -> nil];
  [MALTS -> ID2 MALTS2],
    check affix alternatives disjoint (ID, ID1, ID2),
    check affix alternatives disjoint (ID, ID1, MALTS2);
  ?.

#*Lexgen2-newtab*#
ACTION check affix alternatives disjoint (>ID, >ID1, >ID2):
  get set info (ID1, SET1),
    get set info (ID2, SET2),
      (is disjoint (SET1, SET2);
       convert id to name  (ID, TEXT),
         convert id to name (ID1, TEXT1),
         convert id to name (ID2, TEXT2),
         warning ("affix '" + TEXT + "' has non-disjoint alternatives '" +
                  TEXT1 + "' and '" + TEXT2 + "'")).


##############################
#                            #
#   Definedness of affixes   #
#                            #
##############################

# Check whether all affixes used as terminals are included in some
# affix domain. Unknown affixes are marked as set affix terminals.

ACTION check occurrence terminals:
  get number of affix terminals (INT),
    check occurrence terminals (INT),
    display time ("checked affix occurrences").

ACTION check occurrence terminals (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    convert affix terminal to id (INT, ID),
    check occurrence terminal (ID),
    check occurrence terminals (INT).

ACTION check occurrence terminal (>ID):
  affix terminal occurs in user domain (ID);
  convert id to name (ID, TEXT),
    error ("affix terminal \"" + TEXT + "\" does not occur in any domain").

### Affix terminals

TEST affix terminal occurs in user domain (>ID):
  get number of affix nonterminals (INT),
    convert id to affix (ID, AFFIX_NR),
    affix terminal occurs in user domains (INT, AFFIX_NR).

TEST affix terminal occurs in user domains (>INT, >AFFIX_NR):
  [INT -> 0],
    -;
  [INT - 1 -> INT],
    (affix terminal occurs in user domain (INT, AFFIX_NR);
     affix terminal occurs in user domains (INT, AFFIX_NR)).

TEST affix terminal occurs in user domain (>INT, >AFFIX_NR2):
  convert affix nonterminal to id (INT, ID),
    (id is anonymous affix (ID),
       -;
     convert id to affix (ID, AFFIX_NR1),
       matrix test (AFFIX_NR1, AFFIX_NR2)).


### Affix nonterminals

TEST set affix nonterminal occurs in user domain (>ID):
  get affix terminals in domain (ID, LIST),
    get number of affix nonterminals (INT),
    affix terminals occur in user domains (INT, LIST).

TEST affix terminals occur in user domains (>INT, >LIST):
  [INT -> 0],
    -;
  [INT - 1 -> INT],
    (affix terminals occur in user domain (INT, LIST);
     affix terminals occur in user domains (INT, LIST)).

TEST affix terminals occur in user domain (>INT, >LIST):
  convert affix nonterminal to id (INT, ID),
    (id is anonymous affix (ID),
       -;
     affix terminals occur in user domain with id (ID, LIST)).

TEST affix terminals occur in user domain with id (>ID, >LIST):
  convert id to affix (ID, AFFIX_NR),
    affix terminals occur in user domain with nr (AFFIX_NR, LIST).

TEST affix terminals occur in user domain with nr (>AFFIX_NR, >LIST):
  pop (LIST, AFFIX_NR2),
    (matrix test (AFFIX_NR, AFFIX_NR2),
       affix terminals occur in user domain with nr (AFFIX_NR, LIST);
     -);
  +.

FUNCTION get affix terminals in domain (>ID, LIST>):
  convert id to affix (ID, AFFIX_NR),
    empty (LIST),
    get number of affix terminals (INT),
    get affix terminals in domain (AFFIX_NR, INT, LIST).

FUNCTION get affix terminals in domain (>AFFIX_NR, >INT, >LIST>):
  [INT -> 0];
  [INT - 1 -> INT],
    get affix terminal in domain (AFFIX_NR, INT, LIST),
    get affix terminals in domain (AFFIX_NR, INT, LIST).

FUNCTION get affix terminal in domain (>AFFIX_NR, >INT, >LIST>):
  convert affix terminal to id (INT, ID),
    convert id to affix (ID, AFFIX_NR2),
      (matrix test (AFFIX_NR, AFFIX_NR2),
         push (LIST, AFFIX_NR2);
       +).


###############
#             #
#   Logging   #
#             #
###############

ACTION log affix info:
  if log option,
    log ("Affix statistics:"),

    convert AFFIX_RULE_COUNT to TEXT,
    log (TEXT + " affix rules found"),

    get number of affix terminals (INT),
    convert INT to TEXT,
    log (TEXT + " affix terminals found"),

    get number of affix nonterminals (INT),
    convert INT to TEXT,
    log (TEXT + " affix nonterminals found"),

    get number of integer affixes (INT),
    convert INT to TEXT,
    log (TEXT + " integer affixes found"),

    get number of text affixes (INT),
    convert INT to TEXT,
    log (TEXT + " text affixes found"),

    log ("");
  +.

###############
#             #
#   Dumping   #
#             #
###############

#ACTION dump hash table:
#  log ("\nHash table:"),
#    dump hash table (HASH_SIZE, 0|INT),
#    convert HASH_SIZE to TEXT1,
#    convert INT to TEXT2,
#    convert (INT * 100 % HASH_SIZE) to TEXT3,
#    log ("Used " + TEXT2 + " of " + TEXT1 + "entries (" + TEXT3 + "%)").

#ACTION dump hash table (>INT, >INT1>):
#  [INT -> 0];
#  [INT - 1 -> INT],
#    dump hash (INT, INT1),
#    dump hash table (INT, INT1).

#ACTION dump hash (>INT, >INT1>):
#  [HASHED_RULES{INT} -> RULES],
#    count (RULES, INT2),
#      (greater (INT2, 0),
#         [INT1 + 1 -> INT1],
#         convert INT to TEXT,
#         convert INT2 to TEXT2,
#         log (TEXT + ": " + TEXT2);
#       +).

#FUNCTION count (>RULES, INT>):
#  [RULES -> nil],
#    [0 -> INT];
#  [RULES -> INT1 RULES1],
#     count (RULES1, INT),
#     [INT + 1 -> INT];
#  ?.

ACTION log affix rules:
  log ("Affix rules"),
    log affix rules (AFFIX_RULE_COUNT),
    log no nl ("\n").

ACTION log affix rules (>INT):
  [INT->0];
  [INT - 1 -> INT],
    log affix rules (INT),
    log affix rule (INT).

ACTION log affix rule (>INT):
  [INT -> RULENR],
    get affix rule (RULENR, AFFIX_RULE),
    log affix rule (RULENR, AFFIX_RULE).

ACTION log affix rule (>RULENR, >AFFIX_RULE):
  convert RULENR to TEXT1,
    convert AFFIX_RULE to TEXT2,
    log ("affix rule " + TEXT1 + ": " + TEXT2).


FUNCTION convert >AFFIX_RULE to TEXT>:
  [AFFIX_RULE -> ID with MALTS],
    convert id to name (ID, TEXT1),
    convert MALTS to TEXT2 with separator ("; "),
    [TEXT1 + " :: " + TEXT2 + "." -> TEXT].

FUNCTION convert >AFFIX_RULE to lefthand TEXT>:
  [AFFIX_RULE -> ID with MALTS],
  convert id to name (ID, TEXT).

FUNCTION convert >MALTS to TEXT> with separator >TEXT2:
  [MALTS -> nil],
    ["<nil>" -> TEXT];
  [MALTS -> ID MALTS1],
    convert id to name (ID, TEXT),
      ([MALTS1 -> nil];
       convert MALTS1 to TEXT1 with separator TEXT2,
         [TEXT + TEXT2 + TEXT1 -> TEXT]);
  ?.

#ACTION dump warshalled domains:
#  log no nl("\nWarshalled domains\n"),
#    get number of affix nonterminals (INT),
#    dump warshalled domains (INT),
#    log no nl("\n").

#ACTION dump warshalled domains (>INT):
#  [INT -> 0];
#  [INT - 1 -> INT],
#    dump warshalled domain (INT),
#    dump warshalled domains (INT).

#ACTION dump warshalled domain (>INT):
#  convert affix nonterminal to id (INT, ID),
#    convert id to name (ID, TEXT), 
#    log no nl (TEXT + " :: "),
#    convert id to affix (ID, INT),
#    get number of affixes (INT1),
#    dump warshalled domain (INT, INT1).

#ACTION dump warshalled domain (>INT, >INT1):
#  [INT1 -> 0],
#    log no nl("\n");
#  [INT1 - 1 -> INT1],
#    (matrix test (INT, INT1),
#       convert affix to id (INT1, ID),
#       convert id to name (ID, TEXT),
#       log no nl (TEXT + " "),
#       dump warshalled domain (INT, INT1);
#     dump warshalled domain (INT, INT1)).

###################################
#                                 #
# Lexicon Interface File writing: #
#                                 #
###################################

ACTION write affixes to lif:
  write affix rules to lif (AFFIX_RULE_COUNT),
    write separator to lif.

ACTION write affix rules to lif (>INT):
  [INT -> 0];
  [INT - 1 -> INT],
    write affix rule to lif (INT),
    write affix rules to lif (INT).

ACTION write affix rule to lif (>INT):
  [INT -> RULENR],
    get affix rule (RULENR, AFFIX_RULE),
    [AFFIX_RULE -> ID with MALTS],
    (id is anonymous affix (ID);
     write affix rule lhs to lif (INT, ID),
       write affix alts to lif (MALTS)).

ACTION write affix rule lhs to lif (>INT, >ID):
  convert id to name (ID, TEXT),
    get affix number (ID, INT),
    get set info (ID, SET),
    write affix to lif (TEXT, INT, SET, "lhs").

FUNCTION get affix rule nr (>ID, INT>):
  get affix rule number (ID, RULENR),
    [RULENR -> INT];
  ?.

ACTION write affix alts to lif (>MALTS):
  [MALTS -> nil];
  [MALTS -> ID MALTS],
    write affix alt to lif (ID),
    write affix alts to lif (MALTS);
  ?.

ACTION write affix alt to lif (>ID):
  id is set affix (ID),
    convert id to name (ID, TEXT),
    get affix number (ID, INT),
    get set info (ID, SET),
    write affix to lif (TEXT, INT, SET, "rhs");
  id is text affix (ID),
    +;
  id is integer affix (ID),
    +;
  ?.

ACTION write affix to lif (>TEXT1, >INT, >SET, >TEXT2):
  write to lif (TEXT1 + "\t"),
    convert INT to TEXT,
    write to lif (TEXT + "\t"),
    convert SET to TEXT,
    write to lif (TEXT + "\t"),
    write to lif (TEXT2 + "\n").


#############
#           #
# Externals #
#           #
#############

EXTERNAL ACTION initialize matrix(>INT):208
EXTERNAL ACTION warshall matrix:209
EXTERNAL TEST matrix test(>INT,>INT1):210
EXTERNAL ACTION matrix set(>INT,>INT1):211
EXTERNAL ACTION initialize imatrix(>INT):212
EXTERNAL ACTION imatrix set(>INT,>INT1):213
EXTERNAL ACTION color imatrix(INT>):214
EXTERNAL FUNCTION get color(>INT,INT1>):215

