From acf412d6ee24b1c13af8c296e7609bbc7f0af305 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Thu, 8 Apr 2010 14:28:34 +0200
Subject: [PATCH] Don't prefix item names by the module name with -ec option.
---
src/ident.ml | 15 +++++++++----
src/ident.mli | 4 +++-
src/licDump.ml | 58 ++++++++++++++++++++++++++++----------------------
src/main.ml | 2 +-
4 files changed, 48 insertions(+), 31 deletions(-)
diff --git a/src/ident.ml b/src/ident.ml
index 75b9ad09..24e070af 100644
--- a/src/ident.ml
+++ b/src/ident.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 11/03/2009 (at 16:17) by Erwan Jahier> *)
+(** Time-stamp: <modified the 01/02/2010 (at 15:18) by Erwan Jahier> *)
(* J'ai appele ca symbol (mais ca remplace le ident) :
c'est juste une couche qui garantit l'unicite en memoire
@@ -46,10 +46,10 @@ type pack_name = t
type long = pack_name * t
let (pack_of_long : long -> pack_name) =
- fst
+ fun l -> fst l
let (of_long : long -> t) =
- snd
+ fun l -> snd l
let (to_string : t -> string) =
fun x -> x
@@ -73,6 +73,10 @@ let (string_of_long2 : long -> string) =
fun (pn, id) ->
pn ^"::"^ id
+let (no_pack_string_of_long : long -> string) =
+ fun (pn, id) ->
+ id
+
let (long_to_string : long -> string) =
string_of_long
@@ -119,7 +123,10 @@ let (long_of_string : string -> long) =
let string_of_idref i = (
match i.id_pack with
- Some p -> if !Global.lv4 then (p^"__"^i.id_id) else (p^"::"^i.id_id)
+ Some p ->
+ if !Global.ec then i.id_id else
+ if !Global.lv4 then (p^"__"^i.id_id) else
+ (p^"::"^i.id_id)
| None -> i.id_id
)
diff --git a/src/ident.mli b/src/ident.mli
index c40fe5ff..1f818366 100644
--- a/src/ident.mli
+++ b/src/ident.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 11/03/2009 (at 16:17) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/01/2010 (at 17:44) by Erwan Jahier> *)
type t = string
@@ -15,6 +15,8 @@ val pack_of_long : long -> pack_name
val string_of_long : long -> string
val string_of_long2 : long -> string
+(* To ignore pack name (meaningful when generating ec code for exemple *)
+val no_pack_string_of_long : long -> string
val long_to_string : long -> string
val long_of_string : string -> long
diff --git a/src/licDump.ml b/src/licDump.ml
index c2073bca..fdab05d5 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -1,11 +1,16 @@
-(** Time-stamp: <modified the 14/01/2010 (at 09:05) by Erwan Jahier> *)
+(** Time-stamp: <modified the 19/03/2010 (at 14:29) by Erwan Jahier> *)
open Printf
open Lxm
open Eff
open List
-let (long : Ident.long -> string) = Ident.string_of_long
+(* XXX changer le nom de cette fonction *)
+let (dump_long : Ident.long -> string) = fun x ->
+ if !Global.ec then
+ Ident.no_pack_string_of_long x
+ else
+ Ident.string_of_long x
(* fun id -> *)
(* let str = Ident.string_of_long id in *)
(* Str.global_replace (Str.regexp "::") "__" str *)
@@ -45,16 +50,18 @@ let rec string_of_const_eff =
| Bool_const_eff false -> "false"
| Int_const_eff i -> sprintf "%d" i
| Real_const_eff r -> r
- | Extern_const_eff (s,t) -> (long s)
- | Abstract_const_eff (s,t,v,_) -> (long s) ^ (string_of_const_eff v)
- (* | Abstract_const_eff (s,t,v,false) -> (long s) *)
+ | Extern_const_eff (s,t) -> (dump_long s)
+ | Abstract_const_eff (s,t,v,_) ->
+ (dump_long s) ^ (* XXX ? *)
+ (string_of_const_eff v)
+ (* | Abstract_const_eff (s,t,v,false) -> (dump_long s) *)
| Enum_const_eff (s,t) ->
if !Global.expand_enums then
match t with
| Enum_type_eff(_,l) -> string_of_int (get_rank s l)
| _ -> assert false
else
- (long s)
+ (dump_long s)
| Struct_const_eff (fl, t) -> (
let string_of_field =
function (id, veff) ->
@@ -80,7 +87,7 @@ and string_ident_of_const_eff c =
| Enum_const_eff _ -> string_of_const_eff c
| Struct_const_eff (_, t) -> (
match t with
- | Struct_type_eff (sn,_) -> Ident.string_of_long sn
+ | Struct_type_eff (sn,_) -> dump_long sn
| _ -> assert false
)
| Array_const_eff (ctab, t) -> string_of_type_eff t
@@ -93,12 +100,12 @@ and string_def_of_type_eff = function
| Bool_type_eff -> "bool"
| Int_type_eff -> "int"
| Real_type_eff -> "real"
- | External_type_eff (i) -> long i
+ | External_type_eff (i) -> dump_long i
| Abstract_type_eff (i, t) -> string_def_of_type_eff t ^ " -- abstract in the source "
| Enum_type_eff (i, sl) ->
assert (sl <>[]);
if !Global.expand_enums then "int" else
- let f sep acc s = acc ^ sep ^ (long s) in
+ let f sep acc s = acc ^ sep ^ (dump_long s) in
(List.fold_left (f ", ") (f "" "enum {" (List.hd sl)) (List.tl sl)) ^ "}"
| Array_type_eff (ty, sz) -> sprintf "%s^%d" (string_of_type_eff ty) sz
| Struct_type_eff (name, fl) ->
@@ -123,12 +130,12 @@ and string_of_type_eff = function
| Bool_type_eff -> "bool"
| Int_type_eff -> "int"
| Real_type_eff -> "real"
- | External_type_eff (name) -> prefix ^ (long name)
- | Abstract_type_eff (name, t) -> prefix ^ (long name)
+ | External_type_eff (name) -> prefix ^ (dump_long name)
+ | Abstract_type_eff (name, t) -> prefix ^ (dump_long name)
(* string_of_type_eff t *)
- | Enum_type_eff (name, _) -> prefix ^ (long name)
+ | Enum_type_eff (name, _) -> prefix ^ (dump_long name)
| Array_type_eff (ty, sz) -> array_alias ty sz
- | Struct_type_eff (name, _) -> prefix ^ (long name)
+ | Struct_type_eff (name, _) -> prefix ^ (dump_long name)
| Any -> string_of_type_eff (Polymorphism.get_type ())
| Overload -> string_of_type_eff (Polymorphism.get_type ())
@@ -137,12 +144,12 @@ and string_of_type_eff4msg = function
| Bool_type_eff -> "bool"
| Int_type_eff -> "int"
| Real_type_eff -> "real"
- | External_type_eff (name) -> prefix ^ (long name)
- | Abstract_type_eff (name, t) -> prefix ^ (long name)
+ | External_type_eff (name) -> prefix ^ (dump_long name)
+ | Abstract_type_eff (name, t) -> prefix ^ (dump_long name)
(* string_of_type_eff4msg t *)
- | Enum_type_eff (name, _) -> prefix ^ (long name)
+ | Enum_type_eff (name, _) -> prefix ^ (dump_long name)
| Array_type_eff (ty, sz) -> (string_of_type_eff4msg ty) ^ "^" ^(string_of_int sz)
- | Struct_type_eff (name, _) -> prefix ^ (long name)
+ | Struct_type_eff (name, _) -> prefix ^ (dump_long name)
| Any -> "'a"
| Overload -> "'o"
@@ -210,19 +217,19 @@ and string_of_type_eff_list4msg = function
(* for printing recursive node *)
and string_of_node_key_rec (nkey: node_key) =
match nkey with
- | (ik, []) -> long ik
+ | (ik, []) -> dump_long ik
| (ik, salst) ->
let astrings = List.map static_arg2string salst in
- let name = sprintf "%s_%s" (long ik) (String.concat "_" astrings) in
+ let name = sprintf "%s_%s" (dump_long ik) (String.concat "_" astrings) in
Name.node_key nkey name
(* for printing iterators *)
and string_of_node_key_iter lxm (nkey: node_key) =
match nkey with
- | (ik, []) -> long ik
+ | (ik, []) -> dump_long ik
| (ik, salst) ->
let astrings = List.map (static_arg2string) salst in
- sprintf "%s<<%s>>" (long ik) (String.concat ", " astrings)
+ sprintf "%s<<%s>>" (dump_long ik) (String.concat ", " astrings)
(* for printing recursive node and iterators *)
and static_arg2string (sa : Eff.static_arg) =
@@ -230,7 +237,7 @@ and static_arg2string (sa : Eff.static_arg) =
| ConstStaticArgEff (id, ceff) -> sprintf "%s" (string_ident_of_const_eff ceff)
| TypeStaticArgEff (id, teff) -> sprintf "%s" (string_of_type_eff teff)
| NodeStaticArgEff (id, (long, _, _)) ->
- sprintf "%s" (Ident.string_of_long long)
+ sprintf "%s" (dump_long long)
and (string_of_var_info_eff4msg: Eff.var_info -> string) =
fun x ->
@@ -550,7 +557,7 @@ and (string_of_node_def : Eff.node_def -> string list) =
(* exported *)
and (type_decl: Ident.long -> Eff.type_ -> string) =
fun tname teff ->
- "type " ^ prefix ^ (long tname) ^
+ "type " ^ prefix ^ (dump_long tname) ^
(match teff with
| External_type_eff (_)
| Abstract_type_eff(_,External_type_eff (_)) -> ";\n"
@@ -560,7 +567,7 @@ and (type_decl: Ident.long -> Eff.type_ -> string) =
(* exported *)
and (const_decl: Ident.long -> Eff.const -> string) =
fun tname ceff ->
- let begin_str = ("const " ^ (long tname)) in
+ let begin_str = ("const " ^ (dump_long tname)) in
let end_str = (string_of_const_eff ceff) ^ ";\n" in
(match ceff with
| Enum_const_eff _ ->
@@ -573,7 +580,8 @@ and (const_decl: Ident.long -> Eff.const -> string) =
| Extern_const_eff _
| Abstract_const_eff _ ->
begin_str ^ ":" ^ (string_of_type_eff (Eff.type_of_const ceff)) ^
- (if !Global.ec then ".\n" else ";\n")
+(* (if !Global.ec then ".\n" else *)
+ (";\n")
| Struct_const_eff _
| Array_const_eff _
| Bool_const_eff _
diff --git a/src/main.ml b/src/main.ml
index 1b44bcad..3cf81637 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 22/01/2010 (at 17:43) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/01/2010 (at 18:26) by Erwan Jahier> *)
(** Here follows a description of the different modules used by this lus2lic compiler.
--
GitLab