
% Parser for Lang.

% $Id: parse.pl,v 2.4 1994/05/05 16:12:18 dbc Exp dbc $

% $Log: parse.pl,v $
% Revision 2.4  1994/05/05  16:12:18  dbc
% Take `..' instead of `rep' in input for replicated embedding.
%
% Revision 1.2  1994/04/15  13:40:11  dbc
% Eliminate lower bounds in index ranges.  Replace `in' by `opName(:)'.
% Eliminate subscript lists from variable refereces, and allow
% subscripting of arbitrary expression primaries.
% Add expression ``abbreviations'' amongst declarations, and following
% index declarations.
% Operators resolve to functions with names of form `op(<name>)'.
%
% Revision 1.1  1994/04/11  10:40:03  dbc
% Initial revision
%

% Input tokens are...
%
%   name(<name>)        <name> built from lower case + digits; initial letter
%   opName(<opName>)    <opName> string built from "+-*/\^<>:=~.%|"
%   literal(<literal>)  <literal> built from digits
%   variable
%   function
%   expression
%   align
%   with
%   distribute
%   forall
%   end
%   is
%   rightBrack
%   leftBrack
%   rightParen
%   leftParen
%   rightBrace
%   leftBrace
%   comma
%   semicolon

% Output syntax is
%
%  <declaration>  ::= variable(<name>, <index_declaration_list>,
%                                      <abbreviation_list>,
%                                      <mapping>)                    |
%                     function(<fun_name>, <name_list>,
%                              <declaration_list>, <statement_list>) |
%                     <abbreviation>
%
%  <abbreviation> ::= expression(<name>, <expression>)
%
%  <statement>    ::= forall(<index_declaration_list>,
%                            <abbreviation_list>,
%                            <statement_list>) |
%                     <expression>
%
%  <expression>   ::= literal(<literal>)                          |
%                     funRef(<fun_name>, <expression_list>)           |
%                     varRef(<name>)                              |
%                     subscript(<expression>, <expression_list>)  |
%                     interval(<bound>, <bound>)
%
%  <index_declaration> ::= index(<index>, <bound>)  |  <bound>
%
%  <mapping>      ::= align(<name>, <embedding_list>)  |
%                     distribute                       |
%                     def
%
%  <embedding>    ::= <expression> | rep
%
%  <bound>        ::= <expression> | def
%
%  <fun_name>     ::= op(<name>) | <name>


parse(Ts, S) :- declarationTermList(S, Ts, []), !.
parse(_, _)  :- printString("Syntax error."), abort.


declaration(S) --> expressionDeclaration(S).
declaration(S) --> variableDeclaration(S).
declaration(S) --> functionDeclaration(S).


expressionDeclaration(expression(A, E)) -->
   [expression, name(A)], expression(E).


variableDeclaration(variable(V, [], [], M)) -->
   [variable, name(V)], mapping(M).
variableDeclaration(variable(V, Is, As, M)) -->
   [variable, name(V)], indexDeclarationBlock(Is, As), mapping(M).


functionDeclaration(function(F, As, Ds, Ss)) -->
   [function, name(F), leftParen], nameSepList(As), [rightParen],
    declarationBlock(Ds),
    statementTermList(Ss),
   [end].

declarationBlock(Ds) --> [leftBrace], declarationTermList(Ds), [rightBrace].


statement(forall(Is, As, Ss)) -->
   [forall], indexDeclarationBlock(Is, As),
    statementTermList(Ss),
   [end].
statement(E) --> expression(E).

expression(interval(LB, UB)) --> bound(LB), [opName("..")], bound(UB).
expression(E)                --> opExpression(0, E).

opExpression(P, E) --> primary(Head), opExpressionTail(P, Head, E).
opExpression(P, E) --> unaryOp(F, Q), {Q > P}, opExpression(Q, Operand),
		       opExpressionTail(P, funRef(op(F), [Operand]), E).

opExpressionTail(P, Head, E)    -->
    binaryOp(F, Q), {Q > P, !}, opExpression(Q, Operand),
    opExpressionTail(P, funRef(op(F), [Head, Operand]), E).
opExpressionTail(_, Head, Head) --> [].


% Equivalent to
%
%   primary(E)                --> atomic(E)
%   primary(subscript(E, Ss)) -->
%       primary(E), [leftBrack], nonEmptyExpressionSepList(Ss), [rightBrack].
%
% but eliminates left recursion (unclear really need this generality?).

primary(E) --> atomic(Head), primaryTail(Head, E).

primaryTail(Head, E)    -->
    [leftBrack], nonEmptyExpressionSepList(Ss), [rightBrack],
    primaryTail(subscript(Head, Ss), E).
primaryTail(Head, Head) --> [].


atomic(E)                --> [leftParen], expression(E), [rightParen].
atomic(literal(N))       --> [literal(N)].
atomic(varRef(V))        --> [name(V)].
atomic(funRef(F, As))    -->
   [name(F), leftParen], expressionSepList(As), [rightParen].


indexDeclarationBlock(Rs, As) -->
   [leftBrack], nonEmptyIndexDeclarationSepList(Rs),
		abbreviationGroup(As), [rightBrack].

abbreviationGroup([]) --> [].
abbreviationGroup(As) --> [opName("|")], nonEmptyAbbreviationSepList(As).

abbreviation(expression(N, E)) --> [name(N), is], opExpression(0, E).

indexDeclaration(index(X, E)) --> [name(X), opName(":")], bound(E).
indexDeclaration(E)           --> bound(E).


mapping(align(T, Es)) --> [align, with], alignTarget(T, Es).
mapping(distribute)   --> [distribute].
mapping(def)          --> [].

alignTarget(T, Es) -->
   [name(T), leftBrack], nonEmptyEmbeddingSepList(Es), [rightBrack].
alignTarget(T, []) --> [name(T)].

embedding(rep) --> [opName("..")], !.
embedding(E)   --> expression(E).


bound(def) --> [].
bound(E)   --> opExpression(0, E).

% Miscellaneous comma-separated lists

nameSepList([]) --> [].
nameSepList(Xs) --> nonEmptyNameSepList(Xs).

nonEmptyNameSepList([X])      --> [name(X)].
nonEmptyNameSepList([X | Xs]) --> [name(X), comma], nonEmptyNameSepList(Xs).


nonEmptyEmbeddingSepList([X])      --> embedding(X).
nonEmptyEmbeddingSepList([X | Xs]) -->
    embedding(X), [comma], nonEmptyEmbeddingSepList(Xs).


nonEmptyAbbreviationSepList([A])      --> abbreviation(A).
nonEmptyAbbreviationSepList([A | As]) -->
    abbreviation(A), [comma], nonEmptyAbbreviationSepList(As).


nonEmptyIndexDeclarationSepList([X])      --> indexDeclaration(X).
nonEmptyIndexDeclarationSepList([X | Xs]) -->
    indexDeclaration(X), [comma], nonEmptyIndexDeclarationSepList(Xs).


expressionSepList([]) --> [].
expressionSepList(Xs) --> nonEmptyExpressionSepList(Xs).

nonEmptyExpressionSepList([X])      --> expression(X).
nonEmptyExpressionSepList([X | Xs]) -->
    expression(X), [comma], nonEmptyExpressionSepList(Xs).


% Miscellaneous semicolon-terminated lists

declarationTermList([])       --> [].
declarationTermList([X | Xs]) -->
    declaration(X), [semicolon], declarationTermList(Xs).

statementTermList([])       --> [].
statementTermList([X | Xs]) -->
    statement(X), [semicolon], statementTermList(Xs).

% operator declarations.

binaryOp(assign, 100) --> [opName(":=")], !.
binaryOp(decim,  200) --> [opName("%")],  !.
binaryOp(or,     300) --> [opName("\/")], !.
binaryOp(and,    400) --> [opName("/\")], !.
binaryOp(gt,     600) --> [opName(">")],  !.
binaryOp(ge,     600) --> [opName(">=")], !.
binaryOp(lt,     600) --> [opName("<")],  !.
binaryOp(le,     600) --> [opName("=<")], !.
binaryOp(eq,     600) --> [opName("==")], !.
binaryOp(ne,     600) --> [opName("==")], !.
binaryOp(add,    700) --> [opName("+")],  !.
binaryOp(sub,    700) --> [opName("-")],  !.
binaryOp(mul,    800) --> [opName("*")],  !.
binaryOp(div,    800) --> [opName("/")],  !.
binaryOp(mod,    800) --> [opName("\")],  !.
binaryOp(exp,    900) --> [opName("^")],  !.
binaryOp(_,      _  ) --> [opName("..")], {!, fail}.
binaryOp(_,      _  ) --> [opName(":")],  {!, fail}.
binaryOp(_,      _  ) --> [opName("|")],  {!, fail}.
binaryOp(_,      _  ) --> [opName(O)],
   {printString("Undefined binary operator "), printString(O),
    printString("."), abort}.

unaryOp(not,    500) --> [opName("~")],  !.
unaryOp(neg,    700) --> [opName("-")],  !.
unaryOp(_,      _  ) --> [opName("..")], {!, fail}.
unaryOp(_,      _  ) --> [opName(":")],  {!, fail}.
unaryOp(_,      _  ) --> [opName("|")],  {!, fail}.
unaryOp(_,      _  ) --> [opName(O)],
   {printString("Undefined unary operator "), printString(O),
    printString("."), abort}.

% (Not convinced that the ad hoc attempt at error reporting here
%  is well-advised).

