/* Author: Jeff Dalton <J.Dalton@ed.ac.uk>
 * Updated: Sun Jun 17 20:35:15 2001 by Jeff Dalton
 * Copyright: (c) 2000, AIAI, University of Edinburgh
 */

package ix.iface.domain;

import java.io.*;
import ix.icore.domain.*;
import ix.util.*;
import ix.util.lisp.*;
import ix.util.match.*;

/**
 * A parser for domains described in a Lisp-like syntax. <p>
 *
 * The parser parses a file of schema definitions to populate a Domain. <p>
 *
 * In the syntax definitions below, upper-case names are literals
 * and lower-case names are syntactic variables.  The literals
 * can be written in either case in domain definitions.
 *
 * <pre>
 *    (DEFINE-PROCESS pattern clause*)
 *    (DEFINE-ACTION  pattern clause*)
 *    (DEFINE-SCHEMA  name pattern clause*)
 *    (DEFINE-PRODUCT (name))
 *
 *    name ::= symbol | string
 *    pattern ::= (item*)
 *    item ::= number | symbol | string | pattern | variable
 *    variable ::= ?symbol
 *    clause ::= (NODES node*)
 *            | (ORDERINGS ordering*) 
 *            | (EFFECTS effect*)
 *            | (PROPERTIES property*)
 *    node ::= (node-number pattern)
 *    ordering ::= ({node-humber | (node-number*)}*)
 *    effect ::= (AT when pattern = value)
 *    when ::= START | FINISH
 *    value ::= item
 *    property ::= (string value)
 * </pre>
 *
 * @see Domain
 */

public class LTF_Parser extends DomainParser implements LTF_SchemaSymbols {

    protected String filename;
    protected LispReader lin;

    public LTF_Parser(String filename) throws FileNotFoundException {
	this.filename = filename;
	this.lin = new LispFileReader(filename);
    }

    public LTF_Parser(File file) throws FileNotFoundException {
	this(file.getPath());
    }

    public Domain readDomain() {
	return readDomain(new Domain());
    }

    public Domain readDomain(Domain dom) {
	Debug.noteln("Reading schemas from", filename);
	try {
	    Object item;
	    while ((item = lin.readObject()) != Lisp.EOF) {
		LList def = (LList)item;
		Symbol defForm = (Symbol)def.elementAt(0);
		if (defForm == S_DEFINE_PROCESS ||
		    defForm == S_DEFINE_ACTION  ||
		    defForm == S_DEFINE_SCHEMA) {
		    dom.addSchema(
		       new Schema(
			   canonicalSchemaDescription(def)));
		}
		else if (defForm == S_DEFINE_PRODUCT) {
		    dom.addProductSchema(
		       new ProductSchema(
			   canonicalProductDescription(def)));
		}
		else {
		    Debug.warn("Illegal definition type " + defForm);
		}
	    }
	}
	catch (LispReadException e) {
	    Debug.noteException(e);
	}
	return dom;	
    }

    /*
     * Process and action definitions 
     */

    public LList canonicalSchemaDescription(LList def) {
	LListCollector defElements = new LListCollector(def);
	Symbol defForm;
	Symbol defType;
	Object defName;
	LList  defPat;
	LList  defBody;

	defForm = (Symbol)defElements.popElement();

	// Definition type: process or action
	if (defForm == S_DEFINE_PROCESS) {
	    defType = S_PROCESS;
	}
	else if (defForm == S_DEFINE_ACTION || defForm == S_DEFINE_SCHEMA) {
	    defType = S_ACTION;
	}
	else {
	    defType = S_ACTION;
	    Debug.warn("Illegal schema definition type" + defForm);
	}

	// define-schema allows a name to be given
	if (defForm == S_DEFINE_SCHEMA) {
	    defName = defElements.popElement();
	    defPat = (LList)defElements.popElement();
	}
	else {
	    defPat = (LList)defElements.popElement();
	    defName = defPat.elementAt(0);
	}

	defBody = defElements.contents();

	// Stick it all together as (name type pattern . slot-alist)
	return Lisp.list(defName, defType, defPat).append(parseBody(defBody));
    }

    public LList parseBody(LList body) {
	LListCollector result = new LListCollector();
	for (LList slots = body; slots != Lisp.NIL; slots = slots.cdr()) {
	    Cons slot = (Cons)slots.car();
	    Symbol name = (Symbol)slot.car();
	    LList value = slot.cdr();
	    if (name == S_NODES)
		result.addElement(new Cons(name, value));
	    else if (name == S_ORDERINGS) {
		value = expandAllOrderings(value);
		result.addElement(new Cons(name, value));
	    }
	    else if (name == S_PROPERTIES)
		result.addElement(new Cons(name, value));
	    else if (name == S_EFFECTS) {
		value = value.mapcar(new Function1() {
		    public Object funcall(Object description) {
			return parseEffect((LList)description);
		    }
		});
	        result.addElement(new Cons(name, value));
	    }
	    else
		Debug.warn("Illegal schema slot:" + slot);
	}
	return result.contents();
    }


    /*
     * Orderings
     */

    /**
     * Expands a list of orderings into a list of simple orderings.
     * Each simple ordering is a pair of node numbers: (before after). <p>
     *
     * Each ordering is a list representing a sequence.  Consider
     * adjacent elements A and B in such a list.  Each node in A is
     * linked before each node in B.  For example, (1 (2 3) 4) is
     * equivalent to the four separate lists (1 2), (1 3), (2 4), (3 4).
     */
    public static LList expandAllOrderings(LList orderings) {
	LListCollector result = new LListCollector();
	for (LList ords = orderings; ords != Lisp.NIL; ords = ords.cdr()) {
	    result.concLList(expandOrdering((LList)ords.car()));
	}
	return result.contents();
    }

    public static LList expandOrdering(LList ordering) {
	LListCollector result = new LListCollector();
	// for adjacent elements left and right ...
	for (LList ords = ordering; ords != Lisp.NIL; ords = ords.cdr()) {
	    Object left = ords.car();
	    Object right = ords.cdr().car();
	    result.concLList(expandOrderPair(left, right));
	}
	return result.contents();
    }

    static LList expandOrderPair(Object left, Object right) {
	LListCollector result = new LListCollector();
	for (LList l = ensureList(left); l != Lisp.NIL; l = l.cdr()) {
	    for (LList r = ensureList(right); r != Lisp.NIL; r = r.cdr()) {
		result.addElement(Lisp.list(l.car(), r.car()));
	    }
	}
	return result.contents();
    }

    static LList ensureList(Object a) {
	return a instanceof LList ? (LList)a : Lisp.list(a);
    }


    /*
     * Effects
     */

    static final Object effectSyntax = Lisp.readFromString(
        "(at ?when ?pattern = ?value)"
    );

    static final Symbol
        Q_WHEN     = Symbol.intern("?when"),
	Q_PATTERN  = Symbol.intern("?pattern"),
	Q_VALUE    = Symbol.intern("?value");

    // /\/: Shouldn't have to repeat the "at ?when" part.  That is,
    // syntax should be (at ?when {?pattern = ?value}...).

    public static Effect parseEffect(LList description) {
	MatchEnv env = SimpleMatcher.mustMatch(effectSyntax, description);
	return new Effect(env.get(Q_WHEN),
			  env.get(Q_PATTERN),
			  env.get(Q_VALUE));
    }


    /* Product definitions */

    static Object defineProductSyntax = Lisp.readFromString(
      "(define-product (?name))"
    );

    static Symbol Q_NAME = Symbol.intern("?name");

    public LList canonicalProductDescription(LList def) {
	MatchEnv e = SimpleMatcher.mustMatch(defineProductSyntax, def);
	Object name = e.get(Q_NAME);
	return Lisp.list(Lisp.list(K_NAME, name));
    }

}

// Issues:
// * Add schemas one at a time or pass a list to new Domain()?
// * Tell the domain to analyse itself or leave it "raw"?
// * If we gave the domain a list of all schemas, it could
//   do the analysis automaticlly.  When we give it schemas
//   one at a time, it needs to be told it has them all.
// * Should new Schema() know how to precess an LList definition,
//   or should only the parser know?
// * Should the constructor take a String or a File?
// * Need to do more syntax-checking.