-------------------------------------------------------------------------------
--
--  This file is part of AdaBrowse.
--
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
--    AdaBrowse 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, or (at your option) any
--    later version. AdaBrowse is distributed in the hope that it will be
--    useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
-- </BLOCKQUOTE>
--
-- <DL><DT><STRONG>
-- Author:</STRONG><DD>
--   Thomas Wolf  (TW)
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
--
-- <DL><DT><STRONG>
-- Purpose:</STRONG><DD>
--   Parsing and evaluation of expressions; storage of expressions.</DL>
--
-- <!--
-- Revision History
--
--   18-JUN-2003   TW  Initial version.
--   08-JUL-2003   TW  Added the @ prefix operator.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Finalization;
with Ada.Strings.Unbounded;

with Asis;

package AD.Expressions is

   type Expression is private;
   --  Expressions can have boolean or string types. @Evaluate@ can only
   --  evaluate boolean expressions. The syntax for expressions is
   --  <PRE>
   --     Expression := Expr [<B>;</B>].
   --     Expr       := OR_Term {(<B>or</B>|<B>xor</B>) OR_Term}.
   --     OR_Term    := AND_Term {<B>and</B> AND_Term}.
   --     AND_Term   := EQ_Term {(<B>=</B>|<B>/=</B>) EQ_Term}.
   --     EQ_Term    := STR_Term {<B>@</B> STR_Term}.
   --     STR_Term   := Term {<B>&</B> Term}.
   --     Term       := [<B>not</B>] Factor.
   --     Factor     := <B>(</B> Expr <B>)</B> |
   --                   Identifier |
   --                   String_Literal.
   --  </PRE>
   --  The syntax of identifiers and string literals is as in Ada. Parsing
   --  (as well as string comparisons and the <CODE>@</CODE> prefix operator)
   --  is case <EM>in</EM>sensitive.
   --
   --  The identifier of a @Factor@ shall resolve to either a user-defined
   --  macro name (see @Define_Macro@ below), or be one of the predefined
   --  names corresponding to the predicates in @AD.Predicates@.
   --
   --  Note that this syntax is a bit different from the Ada one:
   --  <UL>
   --    <LI>It allows mixing different logical operators. All binary
   --        operators (including the logical ones @and@, @or@, and @xor@)
   --        are <EM>left-associative</EM>.
   --    <LI>Mixing logical operators is possible because @and@ has higher
   --        precedence than @or@ and @xor@, and because of
   --        left-associativity.
   --  </UL>
   --  Parentheses can be used to override the normal precedences. The equality
   --  operators @=@ and @/=@ can compare either two boolean expressions, or
   --  two string expressions. String comparisons are case insensitive. @&@
   --  is the string concatenation operator.
   --
   --  An expression may or may not have a terminating semicolon.
   --
   --  Example:
   --  <PRE>
   --     A and B or C = D and E = F & G = H
   --  </PRE>
   --  is the same as
   --  <PRE>
   --     (A and B) or ((C = D) and ((E = (F & G)) = H))
   --  </PRE>
   --  You may write it either way. Ada users may find this a bit strange,
   --  but it saves parentheses, and frankly said, an operator precedence
   --  grammars such as this one isn't that bad. I've always found it
   --  bizarre that Ada didn't at least give the boolean @and@ higher
   --  precedence than @or@ and @xor@ (and <CODE>and then</CODE> higher
   --  precedence than <CODE>or else</CODE>).

   Nil_Expression : constant Expression;

   Parse_Error : exception;

   function Is_Nil
     (Expr : in Expression)
     return Boolean;
   --  Returns <CODE>Expr = Nil_Expression</CODE>.

   function Is_Boolean
     (Expr : in Expression)
     return Boolean;
   --  Returns @True@ iff @Expr@ is a boolean expression.

   function Parse
     (Text : in String)
     return Expression;
   --  Parse @Text@ and construct an expression from it. Raises @Parse_Error@
   --  with a descriptive error message. Parsing is case insensitive.

   procedure Define_Macro
     (Name      : in     String;
      Expr      : in     Expression;
      Redefined :    out Boolean);
   --  Store @Expr@ under the given @Name@ for future reference in other
   --  expressions. @Redefined is set to @True@ if there already existed
   --  a prior definition for @Name@. Raises @Parse_Error@ if @Name@ happens
   --  to be one of the predefined names. The expression's type may be either
   --  boolean or string. @Name@ is treated case-insensitive.

   function Evaluate
     (Expr     : in Expression;
      Argument : in Asis.Element)
     return Boolean;
   --  Evaluate a boolean expression @Expr@ given its @Argument@. Raises
   --  @Constraint_Error@ if <CODE>not Is_Boolean (Expr)</CODE>.

private

   type Exp is abstract tagged
      record
         Ref_Count : Natural := 1;
      end record;

   type Expression_Ptr is access all Exp'Class;

   type Expression is new Ada.Finalization.Controlled with
      record
         Ptr : Expression_Ptr;
      end record;
   --  We use reference-counted Expressions and a controlled type to ensure
   --  proper memory clean-up even in the presence of parsing errors.

   procedure Adjust   (E : in out Expression);
   procedure Finalize (E : in out Expression);

   Nil_Expression : constant Expression :=
     (Ada.Finalization.Controlled with Ptr => null);

   ----------------------------------------------------------------------------
   -- Now come the real expression types.

   type Bool_Exp is abstract new Exp with null record;

   function Eval
     (E        : in Bool_Exp;
      Argument : in Asis.Element)
     return Boolean
     is abstract;

   type Predicate is
     access function (Element : in Asis.Element) return Boolean;

   type Terminal is new Bool_Exp with
      record
         P : Predicate;
      end record;

   function Eval
     (E        : in Terminal;
      Argument : in Asis.Element)
     return Boolean;

   type Value is new Bool_Exp with
      record
         Val : Boolean;
      end record;

   function Eval
     (E        : in Value;
      Argument : in Asis.Element)
     return Boolean;

   type Binary_Operator is abstract new Bool_Exp with
      record
         Left, Right : Expression;
      end record;

   type And_Exp is new Binary_Operator with null record;

   function Eval
     (E        : in And_Exp;
      Argument : in Asis.Element)
     return Boolean;

   type Or_Exp is new Binary_Operator with null record;

   function Eval
     (E        : in Or_Exp;
      Argument : in Asis.Element)
     return Boolean;

   type Xor_Exp is new Binary_Operator with null record;

   function Eval
     (E        : in Xor_Exp;
      Argument : in Asis.Element)
     return Boolean;

   type Eq_Exp is new Binary_Operator with null record;

   function Eval
     (E        : in Eq_Exp;
      Argument : in Asis.Element)
     return Boolean;

   type Prefix_Exp is new Binary_Operator with null record;

   function Eval
     (E        : in Prefix_Exp;
      Argument : in Asis.Element)
     return Boolean;

   type Unary_Operator is abstract new Bool_Exp with
      record
         Arg : Expression;
      end record;

   type Not_Exp is new Unary_Operator with null record;

   function Eval
     (E        : in Not_Exp;
      Argument : in Asis.Element)
     return Boolean;

   ----------------------------------------------------------------------------

   type String_Exp is abstract new Exp with null record;

   function Eval
     (E        : in String_Exp;
      Argument : in Asis.Element)
     return String
     is abstract;

   type Name is
     access function (Element : in Asis.Element) return Wide_String;

   type String_Terminal is new String_Exp with
      record
         P : Name;
      end record;

   function Eval
     (E        : in String_Terminal;
      Argument : in Asis.Element)
     return String;

   type Literal is new String_Exp with
      record
         Val : Ada.Strings.Unbounded.Unbounded_String;
      end record;

   function Eval
     (E        : in Literal;
      Argument : in Asis.Element)
     return String;

   type Concat_Exp is new String_Exp with
      record
         Left, Right : Expression;
      end record;

   function Eval
     (E        : in Concat_Exp;
      Argument : in Asis.Element)
     return String;

   ----------------------------------------------------------------------------

   type Operator is
     (Op_Not,
      Op_Concat, Op_Prefix,
      Op_Eq, Op_Neq,
      Op_And,
      Op_Or, Op_Xor, Op_None);

   type Predefined is new Exp with
      record
         Op : Operator;
      end record;

end AD.Expressions;
