/*  GENERATE.P  */


/*
tree ::=
    [ TREE <type> <st> <st>* ]

st ::=
    tree |
    terminal              
*/


define random_rule();
    generate( "Prog", non_terminals, terminals );
enddefine;


vars non_terminals;
[
    [ Prog TYPE A
        [ if Perception_test then Action_fn else Action_fn endif ]
    ]

    [ Action_fn TYPE A
        [ if Perception_test then Action_fn else Action_fn endif ]
        [ Action_const ]
    ]

    [ Perception_test TYPE PT
        [ (Perception_test and Perception_test) ]
        [ (Perception_test or Perception_test) ]
        [ Smell_fn Neeq Smell_const ]
        [ Inventory_fn Neeq Portable_object_const ]
;;;        [ energy() Gtlt Energy_const ]
    ]

    [ Smell_fn TYPE S
        [ smell() ]
    ]

    [ Inventory_fn TYPE I
        [ inventory() ]
    ]

] -> non_terminals;


vars terminals;
[
    [ Action_const TYPE A
        ["forward"] ["back"] ["left"] ["right"] ["grab"] ["drop"] ["use"]
    ]

    [ Smell_const TYPE S
        ["forward"] ["back"] ["left"] ["right"] ["here"] ["carried"]
    ]

    [ Portable_object_const TYPE I                
        [`+`] [`k`] [`T`] [` `]
    ]

    [ Neeq
        [=] [/=]
    ]

    [ Gtlt
        [<] [>]
    ]

    [ Energy_const
        INT 1 500
    ]
]  -> terminals;


/*
Generation
----------

Now some functions for generating sentences at random given a grammar
and a lexicon. generate(grammar,lexicon) will produce a list of words
from the lexicon forming a sentence according to the grammar, which is
assumed to use "s" as the non-terminal name for sentences. Recursion is
controlled by maxlevel.

*/


vars Level maxlevel;
20 -> maxlevel;


vars sub_gen;/*forward*/


/*  expand_to_terminals( category ):
        Return a lexical item of type -category-, or -false- if there
        isn't one.

        The result will be either
            a list of terminal symbols
        or
            [ [ TREE <type> ^^<list of terminals> ] ]
        or
            -false-
*/
define expand_to_terminals( category );
    lvars category;

    lvars entry, typed, terminals;
    vars name, type, rest, l, u;

    for entry in Lexicon do
        /*  Each entry is of the form
                [ <name> <list> <list>* ]
            or
                [ <name> TYPE <type> <list> <list>* ]
            where <list> is a list of terminal symbols.
        */
        if  entry matches [ ?name TYPE ?type ??rest ] then
            true -> typed;
        else
            entry --> [ ?name ??rest ];
            false -> typed;
        endif;

        if name = category then
            if rest matches [ INT ?l ?u ] then
                [% random(u-l+1)+l-1 %]
            else
                oneof( rest )
            endif -> terminals;

            if typed then
                return( [ [ TREE ^type ^^terminals ] ] )
            else
                return( terminals )
            endif;
        endif;
    endfor;

    /*  If -category- did name a lexical non-terminal, we will have
        already returned from this procedure. So if we get here,
        return false.
    */
    false
enddefine;


/*  expand_rhs( rhs ):
        -rhs- is a list representing the right-hand side of a
        production. Each element is either a terminal symbol, or a
        category name (non-terminal).

        The result is
            a list of terminals and/or trees
        or
            -false-
*/
define expand_rhs( rhs );
    lvars rhs;

    vars first, rest;
    lvars first_expanded, rest_expanded;

    if rhs = [] then
        []
    else
        rhs --> [ ?first ??rest ];
        if  ( sub_gen(first) ->> first_expanded ) = false then
            false
        elseif ( expand_rhs(rest) ->> rest_expanded ) = false then
            false
        else
            [ ^^first_expanded ^^rest_expanded ]
        endif
    endif;

enddefine;


/*  expand_rhss( rules ):
        -rules- is a list of possible right-hand-sides. Repeatedly try
        expanding one till a non-false result is obtained, i.e.
        recursion level doesn't get exceeded.

        Result is the same as for -expand_rhs-.     
*/
define expand_rhss( rules ) -> result;
    lvars rules, result;

    vars rule;

    until rules = [] do
        oneof(rules) -> rule;
        if  ( expand_rhs(rule)->> result ) then
            return
        else
            delete(rule,rules) -> rules
        endif
    enduntil;

    false->result;
enddefine;


/*  sub_gen( category ):
        -category- is either the name of a grammatical category (including
        terminal symbols), or a list of possible right hand sides of a
        rule. This function is called by generate which has Grammar and
        Lexicon as local variables. sub_gen does all the work. If depth
        of recursion exceeds maxlevel, then return false

        The result will be either
            a list of trees and/or terminal symbols
        or
            -false-
*/
define sub_gen( category );
    lvars category;

    lvars typed, result;
    vars entry, name, type, rest, Level;

    Level + 1 -> Level;

    if  Level > maxlevel then
        return( false )
    elseif islist(category) then
        return( expand_rhss( category ) )
    elseif ( expand_to_terminals(category) ->> result ) then
        if result /= false then return(result) endif;
    endif;

    /*  If we get this far, -category- is either a terminal symbol
        or the name of a non-terminal. Check next to see whether
        it is a non-terminal.
    */
    for entry in Grammar do
        /*  Each entry is of the form
                [ <name> <rhs> <rhs>* ]
            or
                [ <name> TYPE <type> <rhs> <rhs>* ]
            where <rhs> is a list representing a right-hand side.
        */
        if entry matches [ ?name TYPE ?type ??rest ] then
            true -> typed;
        else
            entry --> [ ?name ??rest ];
            false -> typed;
        endif;

        if name = category then
            sub_gen( rest ) -> result;
            if result /= false then
                if typed then
                    if result matches [ [ TREE ^type == ] ] then
                        /*  Leave it as it is.  */
                    else
                        [ [ TREE ^type ^^result ] ] -> result;
                    endif;
                endif;
            endif;
            return( result );
        endif;

    endfor;

    /*  If we get this far, -category- is a terminal.  */
    [% category %]

enddefine;


define generate( Category, Grammar, Lexicon );
    vars Category, Grammar, Lexicon;

    vars Level=0;
    ;;; Controls depth of recursion.

    sub_gen( Category )
enddefine;