Create branch for handling issue #104

https://forge.onera.fr/issues/104


git-svn-id: https://svn.onera.fr/Prelude/Prelude/branches/add_double_type@539 49f62630-d767-4ccd-930e-b3f5589f52e1

src/corelang.ml

@@ -33,6 +33,7 @@ type tag = Utils.tag
 type constant =
   | Const_int of int
   | Const_float of float
+  | Const_double of float
   | Const_bool of bool
 
 type type_dec =
@@ -43,6 +44,7 @@ and type_dec_desc =
   | Tydec_any
   | Tydec_int
   | Tydec_float
+  | Tydec_double
   | Tydec_bool
   | Tydec_clock
 

src/corelang.mli

@@ -28,6 +28,7 @@ type tag = Utils.tag
 type constant =
   | Const_int of int
   | Const_float of float
+  | Const_double of float
   | Const_bool of bool
 
 type type_dec =
@@ -38,6 +39,7 @@ and type_dec_desc =
   | Tydec_any
   | Tydec_int
   | Tydec_float
+  | Tydec_double
   | Tydec_bool
   | Tydec_clock
 

src/lexer.mll

@@ -51,6 +51,7 @@ let keyword_table =
   "int", TINT;
   "bool", TBOOL;
   "float", TFLOAT;
+  "double", TDOUBLE;
   "real", TREAL;
   "clock", TCLOCK;
   "rate", RATE;
@@ -85,6 +86,8 @@ rule token = parse
     {token lexbuf}
 | ['0'-'9'] ['0'-'9']* '.' ['0'-'9']*
     {FLOAT (float_of_string (Lexing.lexeme lexbuf))}
+| ['0'-'9'] ['0'-'9']* '.' ['0'-'9']*
+    {DOUBLE (float_of_string (Lexing.lexeme lexbuf))}
 | ['0'-'9']+ 
     {INT (int_of_string (Lexing.lexeme lexbuf)) }
 | ['A'-'Z' 'a'-'z'] ['A'-'Z' 'a'-'z' '_' '0'-'9'] *

src/parser.mly

@@ -28,6 +28,7 @@ let type_table =
     "int",Tydec_int;
     "bool",Tydec_bool;
     "float",Tydec_float;
+    "double",Tydec_double;
     "real",Tydec_float
   ]
 let mktyp d =
@@ -58,6 +59,7 @@ let mktop_decl d =
 
 %token <int> INT
 %token <float> FLOAT
+%token <double> DOUBLE
 %token TRUE FALSE
 %token <string> IDENT
 %token LPAR RPAR SCOL COL COMMA COLCOL
@@ -66,7 +68,7 @@ let mktop_decl d =
 %token UCLOCK DCLOCK PHCLOCK TAIL
 %token MERGE FBY WHEN WHENNOT
 %token NODE LET TEL RETURNS VAR IMPORTED SENSOR ACTUATOR WCET TYPE
-%token TINT TFLOAT TREAL TBOOL TCLOCK
+%token TINT TFLOAT TDOUBLE TREAL TBOOL TCLOCK
 %token RATE DUE
 %token EQ DIV
 %token <string> INFIX0
@@ -143,6 +145,7 @@ typ_def:
 | TYPE IDENT EQ TBOOL {Hashtbl.add type_table $2 Tydec_bool} 
 | TYPE IDENT EQ TREAL {Hashtbl.add type_table $2 Tydec_float} 
 | TYPE IDENT EQ TFLOAT {Hashtbl.add type_table $2 Tydec_float} 
+| TYPE IDENT EQ TDOUBLE {Hashtbl.add type_table $2 Tydec_double} 
 eq_list:
     eq {[$1]}
 | eq_list eq {$2::$1}
@@ -190,6 +193,7 @@ expr:
 const:
     INT {Const_int $1}
 | FLOAT {Const_float $1}
+| DOUBLE {Const_double $1}
 | TRUE {Const_bool true}
 | FALSE {Const_bool false}
 
@@ -236,6 +240,7 @@ typ:
   with Not_found -> raise (Corelang.Unbound_type ($1,Location.symbol_rloc()))
 }
 | TFLOAT {mktyp Tydec_float}
+| TDOUBLE {mktyp Tydec_double}
 | TREAL {mktyp Tydec_float}
 | TBOOL {mktyp Tydec_bool}
 | TCLOCK {mktyp Tydec_clock}

src/type_predef.ml

@@ -25,6 +25,7 @@ open Types
 
 let type_int = new_ty Tint
 let type_float = new_ty Tfloat
+let type_double = new_ty Tdouble
 let type_bool = new_ty Tbool
 let type_clock = new_ty Tclock
 

src/types.ml

@@ -31,6 +31,7 @@ and type_desc =
     Tvar (* Monomorphic type variable *)
   | Tint
   | Tfloat
+  | Tdouble
   | Tbool
   | Trat (* Actually unused for now. Only place where it can appear is
             in a clock declaration *)
@@ -87,7 +88,7 @@ let type_of_type_list tyl =
 (** [is_polymorphic ty] returns true if [ty] is polymorphic. *)
 let rec is_polymorphic ty =
   match ty.tdesc with
-  | Tvar | Tint | Tfloat | Tbool | Trat | Tclock -> false
+  | Tvar | Tint | Tfloat | Tdouble | Tbool | Trat | Tclock -> false
   | Tarrow (ty1,ty2) -> (is_polymorphic ty1) || (is_polymorphic ty2)
   | Ttuple tl -> List.exists (fun t -> is_polymorphic t) tl
   | Tlink t' -> is_polymorphic t'
@@ -105,6 +106,8 @@ let rec print_ty ty =
       print_string "int"
   | Tfloat ->
       print_string "float"
+  | Tdouble ->
+      print_string "double"
   | Tbool ->
       print_string "bool"
   | Tclock ->

src/typing.ml

@@ -45,7 +45,7 @@ let rec occurs tvar ty =
   | Ttuple tl ->
       List.exists (occurs tvar) tl
   | Tlink t -> occurs tvar t
-  | Tunivar | Tint | Tfloat | Tbool | Trat | Tclock -> false
+  | Tunivar | Tint | Tfloat | Tdouble | Tbool | Trat | Tclock -> false
 
 (** Promote monomorphic type variables to polymorphic type variables. *)
 (* Generalize by side-effects *)
@@ -60,13 +60,13 @@ let rec generalize ty =
       List.iter generalize tlist
   | Tlink t ->
       generalize t
-  | Tunivar | Tint | Tfloat | Tbool | Tclock | Trat -> ()
+  | Tunivar | Tint | Tfloat | Tdouble | Tbool | Tclock | Trat -> ()
 
 (** Downgrade polymorphic type variables to monomorphic type variables *)
 let rec instanciate inst_vars ty =
   let ty = repr ty in
   match ty.tdesc with
-  | Tvar | Tint | Tfloat | Tbool | Tclock | Trat -> ty
+  | Tvar | Tint | Tfloat | Tdouble | Tbool | Tclock | Trat -> ty
   | Tarrow (t1,t2) ->
       {ty with tdesc =
        Tarrow ((instanciate inst_vars t1), (instanciate inst_vars t2))}