From da648254d846b0e0e796c79e5e9f447a1ad13bd0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gwena=EBl=20Delaval?= Date: Tue, 10 May 2011 16:55:46 +0200 Subject: [PATCH] Added type string to pervasives, with string constants in AST --- compiler/global/global_compare.ml | 8 ++++++-- compiler/global/global_mapfold.ml | 2 +- compiler/global/global_printer.ml | 1 + compiler/global/initial.ml | 5 ++++- compiler/global/static.ml | 2 +- compiler/global/types.ml | 1 + compiler/heptagon/analysis/typing.ml | 1 + compiler/heptagon/parsing/hept_parsetree.ml | 1 + compiler/heptagon/parsing/hept_parsetree_mapfold.ml | 2 +- compiler/heptagon/parsing/hept_scoping.ml | 1 + compiler/obc/c/cgen.ml | 1 + compiler/obc/java/obc2java.ml | 1 + lib/pervasives.epi | 1 + 13 files changed, 21 insertions(+), 6 deletions(-) diff --git a/compiler/global/global_compare.ml b/compiler/global/global_compare.ml index 9fb14ba..46292de 100644 --- a/compiler/global/global_compare.ml +++ b/compiler/global/global_compare.ml @@ -46,6 +46,7 @@ let rec static_exp_compare se1 se2 = | Sint i1, Sint i2 -> c i1 i2 | Sfloat f1, Sfloat f2 -> c f1 f2 | Sbool b1, Sbool b2 -> c b1 b2 + | Sstring s1, Sstring s2 -> c s1 s2 | Sconstructor c1, Sconstructor c2 -> c c1 c2 | Sfield f1, Sfield f2 -> c f1 f2 | Stuple sel1, Stuple sel2 -> @@ -75,10 +76,13 @@ let rec static_exp_compare se1 se2 = | Sbool _, (Svar _ | Sint _ | Sfloat _) -> -1 | Sbool _, _ -> 1 - | Sconstructor _, (Svar _ | Sint _ | Sfloat _ | Sbool _) -> -1 + | Sstring _, (Svar _ | Sint _ | Sfloat _ | Sbool _) -> -1 + | Sstring _, _ -> 1 + + | Sconstructor _, (Svar _ | Sint _ | Sfloat _ | Sbool _ | Sstring _) -> -1 | Sconstructor _, _ -> 1 - | Sfield _, (Svar _ | Sint _ | Sfloat _ | Sbool _ | Sconstructor _) -> -1 + | Sfield _, (Svar _ | Sint _ | Sfloat _ | Sbool _ | Sstring _ | Sconstructor _) -> -1 | Sfield _, _ -> 1 | Stuple _, (Srecord _ | Sop _ | Sarray _ | Sarray_power _ ) -> 1 diff --git a/compiler/global/global_mapfold.ml b/compiler/global/global_mapfold.ml index c96f595..00c89a5 100644 --- a/compiler/global/global_mapfold.ml +++ b/compiler/global/global_mapfold.ml @@ -28,7 +28,7 @@ and static_exp_desc_it funs acc sd = with Fallback -> static_exp_desc funs acc sd and static_exp_desc funs acc sd = match sd with - | Svar _ | Sint _ | Sfloat _ | Sbool _ | Sconstructor _ | Sfield _ -> sd, acc + | Svar _ | Sint _ | Sfloat _ | Sbool _ | Sstring _ | Sconstructor _ | Sfield _ -> sd, acc | Stuple se_l -> let se_l, acc = mapfold (static_exp_it funs) acc se_l in Stuple se_l, acc diff --git a/compiler/global/global_printer.ml b/compiler/global/global_printer.ml index 8c8f60c..85e3a6a 100644 --- a/compiler/global/global_printer.ml +++ b/compiler/global/global_printer.ml @@ -40,6 +40,7 @@ let rec print_static_exp_desc ff sed = match sed with | Sint i -> fprintf ff "%d" i | Sbool b -> fprintf ff "%b" b | Sfloat f -> fprintf ff "%f" f + | Sstring s -> fprintf ff "\"%s\"" s | Sconstructor ln -> print_qualname ff ln | Sfield ln -> print_qualname ff ln | Svar id -> fprintf ff "%a" print_qualname id diff --git a/compiler/global/initial.ml b/compiler/global/initial.ml index 99e2b4e..501b65b 100644 --- a/compiler/global/initial.ml +++ b/compiler/global/initial.ml @@ -23,7 +23,8 @@ let pint = { qual = Pervasives; name = "int" } let tint = Types.Tid pint let pfloat = { qual = Pervasives; name = "float" } let tfloat = Types.Tid pfloat - +let pstring = { qual = Pervasives; name = "string" } +let tstring = Types.Tid pstring let mk_pervasives s = { qual = Pervasives; name = s } @@ -36,6 +37,8 @@ let mk_static_int i = let mk_static_bool b = mk_static_exp tbool (Sbool b) +let mk_static_string s = + mk_static_exp tstring (Sstring s) (* build the initial environment *) diff --git a/compiler/global/static.ml b/compiler/global/static.ml index b099779..a207df9 100644 --- a/compiler/global/static.ml +++ b/compiler/global/static.ml @@ -90,7 +90,7 @@ let apply_op partial loc op se_list = @raise Partial_evaluation when a static var cannot be evaluated, a local static parameter for example. Otherwise evaluate in a best effort manner. *) let rec eval_core partial env se = match se.se_desc with - | Sint _ | Sfloat _ | Sbool _ | Sconstructor _ | Sfield _ -> se + | Sint _ | Sfloat _ | Sbool _ | Sstring _ | Sconstructor _ | Sfield _ -> se | Svar ln -> (try (* first try to find in global const env *) let cd = find_const ln in diff --git a/compiler/global/types.ml b/compiler/global/types.ml index 5e0d2b2..4537736 100644 --- a/compiler/global/types.ml +++ b/compiler/global/types.ml @@ -19,6 +19,7 @@ and static_exp_desc = | Sint of int | Sfloat of float | Sbool of bool + | Sstring of string (** without enclosing quotes *) | Sconstructor of constructor_name | Sfield of field_name | Stuple of static_exp list diff --git a/compiler/heptagon/analysis/typing.ml b/compiler/heptagon/analysis/typing.ml index a1c4da2..9e7eb08 100644 --- a/compiler/heptagon/analysis/typing.ml +++ b/compiler/heptagon/analysis/typing.ml @@ -399,6 +399,7 @@ and typing_static_exp const_env se = | Sint v -> Sint v, Tid Initial.pint | Sbool v-> Sbool v, Tid Initial.pbool | Sfloat v -> Sfloat v, Tid Initial.pfloat + | Sstring v -> Sstring v, Tid Initial.pstring | Svar ln -> (try (* this can be a global const*) let cd = Modules.find_const ln in diff --git a/compiler/heptagon/parsing/hept_parsetree.ml b/compiler/heptagon/parsing/hept_parsetree.ml index f567ddb..a2f4436 100644 --- a/compiler/heptagon/parsing/hept_parsetree.ml +++ b/compiler/heptagon/parsing/hept_parsetree.ml @@ -40,6 +40,7 @@ and static_exp_desc = | Sint of int | Sfloat of float | Sbool of bool + | Sstring of string | Sconstructor of constructor_name | Sfield of field_name | Stuple of static_exp list diff --git a/compiler/heptagon/parsing/hept_parsetree_mapfold.ml b/compiler/heptagon/parsing/hept_parsetree_mapfold.ml index 73e5410..29e6824 100644 --- a/compiler/heptagon/parsing/hept_parsetree_mapfold.ml +++ b/compiler/heptagon/parsing/hept_parsetree_mapfold.ml @@ -54,7 +54,7 @@ and static_exp_desc_it funs acc sd = with Fallback -> static_exp_desc funs acc sd and static_exp_desc funs acc sd = match sd with - | Svar _ | Sint _ | Sfloat _ | Sbool _ | Sconstructor _ | Sfield _ -> sd, acc + | Svar _ | Sint _ | Sfloat _ | Sbool _ | Sstring _ | Sconstructor _ | Sfield _ -> sd, acc | Stuple se_l -> let se_l, acc = mapfold (static_exp_it funs) acc se_l in Stuple se_l, acc diff --git a/compiler/heptagon/parsing/hept_scoping.ml b/compiler/heptagon/parsing/hept_scoping.ml index d83ca19..f5bfc85 100644 --- a/compiler/heptagon/parsing/hept_scoping.ml +++ b/compiler/heptagon/parsing/hept_scoping.ml @@ -205,6 +205,7 @@ and translate_static_exp_desc loc ed = | Sint i -> Types.Sint i | Sfloat f -> Types.Sfloat f | Sbool b -> Types.Sbool b + | Sstring s -> Types.Sstring s | Sconstructor c -> Types.Sconstructor (qualify_constrs c) | Sfield c -> Types.Sfield (qualify_field c) | Stuple se_list -> Types.Stuple (List.map t se_list) diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml index 392429d..502d75b 100644 --- a/compiler/obc/c/cgen.ml +++ b/compiler/obc/c/cgen.ml @@ -241,6 +241,7 @@ let rec cexpr_of_static_exp se = | Sint i -> Cconst (Ccint i) | Sfloat f -> Cconst (Ccfloat f) | Sbool b -> Cconst (Ctag (if b then "true" else "false")) + | Sstring s -> Cconst (Cstrlit s) | Sfield _ -> assert false | Sconstructor c -> Cconst (Ctag (cname_of_qn c)) | Sarray sl -> Carraylit (List.map cexpr_of_static_exp sl) diff --git a/compiler/obc/java/obc2java.ml b/compiler/obc/java/obc2java.ml index 611adb3..7712bd6 100644 --- a/compiler/obc/java/obc2java.ml +++ b/compiler/obc/java/obc2java.ml @@ -100,6 +100,7 @@ let rec static_exp param_env se = match se.Types.se_desc with | Types.Sint i -> Sint i | Types.Sfloat f -> Sfloat f | Types.Sbool b -> Sbool b + | Types.Sstring s -> Sstring s | Types.Sconstructor c -> let c = translate_constructor_name c in Sconstructor c | Types.Sfield f -> eprintf "ojSfield @."; assert false; | Types.Stuple se_l -> tuple param_env se_l diff --git a/lib/pervasives.epi b/lib/pervasives.epi index 65cb291..e0aded0 100644 --- a/lib/pervasives.epi +++ b/lib/pervasives.epi @@ -4,6 +4,7 @@ type bool = true | false type int type float +type string val fun (&)(bool;bool) returns (bool) val fun ( * )(int;int) returns (int) val fun ( *. )(float;float) returns (float)