(***********************************************************************)
(*                                                                     *)
(*   Copyright 2006 Philippe Wang - mail@philippewang.info             *)
(*                                                                     *)
(*   XDML Abstract Syntax Tree representation                          *)
(*                                                                     *)
(* 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   *)
(* 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., 51 Franklin St, Fifth Floor,        *)
(* Boston, MA  02110-1301, USA.                                        *)
(***********************************************************************)


type ast_code_location = { (* the location in the source code *)
  location_file_name    : string;
  location_start_line   : int;
  location_start_column : int;
  location_end_line     : int;
  location_end_column   : int;
}

(** type :
    Every node starts with an unknown type (meaning not yet calculated).
    While their types are calculated, their values change :
*)
type program =
    ast_description list

and ast_type_value =
  | Ast_type_unknown
  | Ast_type_constraint
      of  ast_description_type_constraint
  | Ast_type
      of  Types.t

and ast_visibility =
  | Ast_visibility_private
  | Ast_visibility_abstract
  | Ast_visibility_public

(** * a program is composed with
    * - global declarations
    *        (let, let rec, let + and, let rec + and)
    * - type definitions
    *        (type 'a t = Cons of 'a * 'a t | Nil)
    * - exceptions
    *        (exception Exception of string)
    * - expressions
    *        (expressions that are not of those mentionned above)
*)
and ast =
  | Ast_open_module                         (* open a module          *)
      of  string                            (* module name            *)
  | Ast_external_value
      of  string                            (* xdml name              *)
        * string                            (* external name          *)
        * ast_type_terminal                 (* type (signature)       *)
        * ast_visibility
  | Ast_type_definition                     (* type definitions       *)
      of ( ast_description_type
           * ast_visibility ) list
  | Ast_exception_definition                (* exception definitions  *)
      of  string                            (* name of the exception  *)
        * ast_type_terminal option          (* its parameters         *)
(*
| Ast_exception_copy
      of  string                            (* name of the new exception *)
        * Ident.t                           (* name of module and
                                             * name of the pre existing
                                             * exception *)
*)
  | Ast_value_definition                    (* values(let(rec)(+and)) *)
      of  ast_declaration
        * ast_visibility
  | Ast_expression                          (* other expressions      *)
      of  ast_description_expression

and ast_expression =
  | Ast_expression_value
      of  Ident.t
  | Ast_expression_constructor
      of  Ident.t
        * ast_description_expression option (* parameters             *)
  | Ast_expression_constant
      of  ast_constant                      (* constants values       *)
  | Ast_expression_application
      of  (ast_description_expression)      (* expression returning a function*)
        * (ast_description_expression)      (* the argument                   *)
  | Ast_expression_alternative              (* if/then/else          *)
      of  ast_description_expression        (* condition             *)
        * ast_description_expression        (* if condition is true  *)
        * ast_description_expression        (* if condition is false *)
  | Ast_expression_assignment
      of  ast_description_expression        (* the mutable value     *)
        * ast_description_expression        (* the new value         *)
  | Ast_expression_for_loop
      of  string                            (* name of var *)
        * ast_description_expression        (* start       *)
        * ast_description_expression        (* end         *)
        * ast_description_expression        (* body        *)
  | Ast_expression_for_downto_loop
      of  string                            (* name of var *)
        * ast_description_expression        (* start       *)
        * ast_description_expression        (* end         *)
        * ast_description_expression        (* body        *)
  | Ast_expression_while_loop
      of  ast_description_expression        (* condition   *)
        * ast_description_expression        (* body        *)
  | Ast_expression_sequence
      of  ast_description_expression        (* defines the sequence  *)
        * ast_description_expression        (* and ast_the block     *)
  | Ast_expression_local_declaration        (* let(rec) + and ... in *)
      of  ast_declaration                   (* local declaration     *)
        * ast_description_expression        (* `in which' it is used *)
  | Ast_expression_array                    (* array *)
      of  ast_description_expression list
  | Ast_expression_tuple                    (* tuples    *)
      of ast_description_expression list

  | Ast_expression_record
      (* # type t = { a : int ; b:int;c:int};;
       * type t = { a : int; b : int; c : int; }
       * # let a = { a = 2; b=2; c=2} ;;
       * val a : t = {a = 2; b = 2; c = 2}
       * # { a with c = 2; b=1} ;;
       * - : t = {a = 2; b = 1; c = 2}    *)
      of  ast_description_expression option  (* expression that returns a
                                              * record value (optional)
                                              * (if it's not a record value
                                              * that is returned, then
                                              * there's a error of type)
                                              * (the "thing" before the
                                              * optional "with")   *)
        * ( Ident.t
            * ast_description_expression
          ) list

  | Ast_expression_record_access
      of  ast_description_expression       (* expression that returns a
                                            * record value *)
        * Ident.t                          (* module name
                                            * and name of the field *)

  (* expressions with matching *)
  | Ast_expression_function
      of ( ast_description_pattern
           * ast_description_expression option (* condition          *)
           * ast_description_expression
         ) list
  | Ast_expression_pattern_matching
      of  ast_description_expression        (* matched expression *)
        * ( ast_description_pattern         (* pattern            *)
            * ast_description_expression option   (* condition    *)
            * ast_description_expression    (* consequence        *)
          ) list                            (* rules list         *)
  | Ast_expression_try
      of  ast_description_expression        (* tried expression              *)
        * ( ast_description_pattern         (* exception   *)
            * ast_description_expression option   (* condition    *)
            * ast_description_expression    (* consequence                   *)
          ) list                            (* rules list                    *)

and ast_declaration = {
  declaration_recursive : bool;
  declaration_list      :
    ( ast_description_pattern              (* pattern that can be a name    *)
      * ast_description_expression         (* body                          *)
    ) list;
  declaration_code_location : ast_code_location;
}

and ast_pattern =
  | Ast_pattern_any                    (* any pattern           *)
  | Ast_pattern_name
      of  string                       (* name assignment       *)
  | Ast_pattern_constant               (* constants             *)
      of  ast_constant
  | Ast_pattern_tuple                  (* tuple pattern         *)
      of  ast_description_pattern list
  | Ast_pattern_record                 (* record pattern        *)
      (* note:
       * with [M] standing for the module's name,
       * [f1] and [f2] standing for the fields names,
       * [p1], [2] , [Cons x] and [Cons2 x] standing for the
       * respective patterns
       * | { M.f1 = p1 ; M.f2 = 2 ; M.f3 = M.Cons x ; M.f4 = Cons2 x } ->
       * 's abstract syntax will be
       * (without code_location values)
       * Ast_pattern_record
       *    ( Some "M",
       *      [ "f1",
       *        { pattern = Ast_pattern_name "p1";
       *          pattern_type = Ast_unknown_type; };
       *        "f2",
       *        { pattern = Ast_pattern_integer 2;
       *          pattern_type = Ast_unknown_type };
       *        "f3",
       *        { pattern = Ast_pattern_constructor
       *                 (Some "M", "Cons", Ast_pattern_name "x");
       *          pattern_type = Ast_unknown_type };
       *        "f4",
       *        { pattern = Ast_pattern_constructor
       *                 (None, "Cons2", Ast_pattern_name "x")};
       *      ]
       *    )
       *)
      of
        ( Ident.t                       (* field identifier            *)
          * ast_description_pattern     (* field value pattern         *)
        ) list
  | Ast_pattern_constructor             (* constructor pattern         *)
      of  Ident.t                       (* module's name               *)
                                        (* and constructor's name      *)
        * ast_description_pattern option(* constructor's value pattern *)
  | Ast_pattern_array                   (* array pattern               *)
      of  ast_description_pattern list  (* array values (can be empty) *)

and ast_constant =                      (* constants            *)
  | Ast_constant_unit
  | Ast_constant_boolean
      of  bool
  | Ast_constant_integer
      of  int
  | Ast_constant_character
      of  char
  | Ast_constant_string
      of  string
  | Ast_constant_float
      of  float
  | Ast_constant_empty_list

(* examples :
 * type constructor = Cons of  something | Empty
 * type tuple = int * int
 * type ('a, 'b) double_parameterized =
 *     List of  'a list | Array of  'b array | Couple of  ('a * 'b)
 * type ('a, 'b, 'c) triple_parameterized =
 *     alpha of  'a | Ast_beta of  'b | Ast_gamma of  'c
 * type ('a, 'b) arrow = 'a -> 'b
 * type single = int
 *)
and ast_type_constructed =
  | Ast_type_sum                        (* sums                *)
      of ( string                       (* constructor name    *)
           * (ast_type_terminal option) (* parameters          *)
         ) list
  | Ast_type_record                     (* records             *)
      of  ast_type_record_field list    (* record fields       *)
  | Ast_type_terminal                   (* other kinds of type *)
      of  ast_type_terminal

and ast_type_record_field = {
  field_name    : string;
  field_mutable : bool;
  field_type    : ast_type_terminal;
}

and ast_description = {
  ast               : ast;
  ast_code_location : ast_code_location;
  ast_comment       : string option;
}

and ast_description_expression = {
  expression               : ast_expression;
  mutable expression_type  : ast_type_value;
  expression_location      : ast_code_location;
}

and ast_description_pattern = {
  patterns                 : ast_pattern list; (* must not be empty ! *)
  patterns_as              : string list;      (* aliases : can be empty *)
  mutable pattern_type     : ast_type_value;
  pattern_location         : ast_code_location;
}

and ast_type_terminal =
  | Ast_type_type
      of  Ident.t                       (* module name and type name  *)
        * ast_type_terminal list        (* optional parameters        *)
  | Ast_type_tuple                      (* tuple                      *)
      of  int                           (* size                       *)
        * (ast_type_terminal list)      (* definition                 *)
        (**)                            (* for instance : int*int     *)
  | Ast_type_arrow                      (* arrow                      *)
      of  ast_type_terminal             (* left member                *)
        * ast_type_terminal             (* right member               *)
        (**)                            (* for instance : 'a->int     *)

and ast_description_type = {
  type_name          : string;
  type_parameters    : string list;
  type_value         : ast_type_constructed option;
  type_code_location : ast_code_location;
}

and ast_description_type_constraint = {
  constraint_type     : ast_type_terminal;
  constraint_location : ast_code_location;
}


type interface = asti_description list

and asti_description = {
  asti               : asti;
  asti_code_location : ast_code_location;
  asti_comment       : string option;
}

and asti =
  | Asti_value
      of  string                            (* name                   *)
        * ast_type_terminal                 (* type (signature)       *)
  | Asti_type                               (* type definitions       *)
      of ( ast_description_type
           * ast_visibility ) list
  | Asti_exception                          (* exception definitions  *)
      of  string                            (* name of the exception  *)
        * ast_type_terminal option          (* its parameters         *)


(* $Id: ast.mli,v 1.2 2006/09/30 22:51:03 phil Exp $      *)
(* end of  ast.mli                                              *)