From 55213204d45553c874902e19c552ba9fcb952ce7 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Fri, 30 May 2014 10:35:11 +0200
Subject: [PATCH] Some work on the soc2c code generator.
It generates C code that compile on at least one example.
---
AUTHORS.txt | 9 +-
INSTALL.txt | 9 +-
README.txt | 16 +-
src/compile.ml | 5 +-
src/ident.ml | 4 +-
src/l2lExpandArrays.ml | 2 +-
src/lic2soc.ml | 9 +-
src/licDump.ml | 12 +-
src/lv6util.ml | 34 +--
src/main.ml | 6 +-
src/soc2c.ml | 351 +++++++++++++++++++++++--------
src/soc2c.mli | 4 +-
test/lus2lic.sum | 13 +-
test/lus2lic.time | 4 +-
test/should_work/modes3x2-v3.lus | 12 +-
15 files changed, 332 insertions(+), 158 deletions(-)
diff --git a/AUTHORS.txt b/AUTHORS.txt
index a6673b93..f0653dcf 100644
--- a/AUTHORS.txt
+++ b/AUTHORS.txt
@@ -1,5 +1,8 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: 15c1c574199bb18305867c0430ab2e6d) *)
-Authors of lus2lic
-Erwan Jahier and Pascal Raymond
+(* DO NOT EDIT (digest: 982e32f8188f2de2fbc63dc711de49a9) *)
+
+Authors of lus2lic:
+
+* Erwan Jahier and Pascal Raymond
+
(* OASIS_STOP *)
diff --git a/INSTALL.txt b/INSTALL.txt
index 71ce69aa..c9e66d89 100644
--- a/INSTALL.txt
+++ b/INSTALL.txt
@@ -1,5 +1,6 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: 3faca0f954ecfa4d577df94e53d1878d) *)
+(* DO NOT EDIT (digest: 6654b1d4c0725c67fd685887eb061fa7) *)
+
This is the INSTALL file for the lus2lic distribution.
This package uses OASIS to generate its build system. See section OASIS for
@@ -9,9 +10,9 @@ Dependencies
============
In order to compile this package, you will need:
-* ocaml
-* findlib
-* rdbg-plugin
+ * ocaml
+ * findlib
+ * rdbg-plugin
Installing
==========
diff --git a/README.txt b/README.txt
index 51e9c03b..89486017 100644
--- a/README.txt
+++ b/README.txt
@@ -1,12 +1,18 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: ad5c8edb7bf1ce8552ea81a7377dd519) *)
-This is the README file for the lus2lic distribution.
+(* DO NOT EDIT (digest: 30ebd78b05a3c0b5762501067915c9f0) *)
-The Lustre V6 Verimag compiler and interpreter
+lus2lic - The Lustre V6 Verimag compiler and interpreter
+========================================================
-See the files INSTALL.txt for building and installation instructions.
+See the file [INSTALL.txt](INSTALL.txt) for building and installation
+instructions.
-Home page: http://www-verimag.imag.fr/lustre-v6.html
+[Home page](http://www-verimag.imag.fr/lustre-v6.html)
+Copyright and license
+---------------------
+
+lus2lic is distributed under the terms of the Proprietary license, all rights
+reserved.
(* OASIS_STOP *)
diff --git a/src/compile.ml b/src/compile.ml
index 98399219..6ade5f91 100644
--- a/src/compile.ml
+++ b/src/compile.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 13/12/2013 (at 14:16) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/05/2014 (at 10:21) by Erwan Jahier> *)
open Lxm
open Lv6errors
@@ -68,7 +68,8 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Ident.idref option -> L
info "Expanding nodes...\n";
L2lExpandNodes.doit opt.Lv6MainArgs.dont_expand_nodes zelic)
in
- (* Array and struct expansion: to do after polymorphism elimination *)
+ (* Array and struct expansion: to do after polymorphism elimination
+ and after node expansion *)
let zelic = if not opt.Lv6MainArgs.expand_arrays then zelic else (
info "Expanding arrays...\n";
L2lExpandArrays.doit zelic)
diff --git a/src/ident.ml b/src/ident.ml
index a9f3b01e..26c192c6 100644
--- a/src/ident.ml
+++ b/src/ident.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 25/04/2013 (at 09:23) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/05/2014 (at 10:44) by Erwan Jahier> *)
(* J'ai appele ca symbol (mais ca remplace le ident) :
c'est juste une couche qui garantit l'unicite en memoire
@@ -190,6 +190,6 @@ type clk = long * t
let (string_of_clk : clk -> string) =
fun (cc,cv) ->
- (long_to_string cc) ^ "(" ^ (to_string cv) ^ ")"
+ (string_of_long cc) ^ "(" ^ (to_string cv) ^ ")"
(*************************************************************************)
diff --git a/src/l2lExpandArrays.ml b/src/l2lExpandArrays.ml
index ba9d642b..9e207d6c 100644
--- a/src/l2lExpandArrays.ml
+++ b/src/l2lExpandArrays.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 27/05/2013 (at 16:23) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/05/2014 (at 10:39) by Erwan Jahier> *)
(* Replace structures and arrays by as many variables as necessary.
Since structures can be recursive, it migth be a lot of new variables...
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index f5707afa..95cb1ff5 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 21/05/2014 (at 10:51) by Erwan Jahier> *)
+(** Time-stamp: <modified the 26/05/2014 (at 10:30) by Erwan Jahier> *)
open Lxm
open Lic
@@ -305,7 +305,7 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
| CONST Extern_const_eff _ -> assert false
| CONST Abstract_const_eff _ -> assert false
| CONST Enum_const_eff _ -> assert false
- | CONST Struct_const_eff _ -> assert false
+ | CONST Struct_const_eff _ -> assert false
| CONST Array_const_eff _ -> assert false
| CONST Tuple_const_eff _ -> assert false
@@ -329,7 +329,7 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
in
Soc.Index(filter_expr, i, type_)
)
- | PREDEF_CALL _
+ | PREDEF_CALL _
| CALL _
| PRE
| ARROW
@@ -342,7 +342,8 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
| ARRAY_SLICE _ ->
let lxm = by_pos_op_flg.src in
let msg = (Lxm.details lxm) ^
- ": only one operator per equation is allowed.\n"
+ ": only one operator per equation is allowed ("^
+ (LicDump.string_of_val_exp_eff val_exp)^").\n"
in
raise (Lv6errors.Global_error msg)
)
diff --git a/src/licDump.ml b/src/licDump.ml
index f1a73af5..a231681a 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 28/05/2013 (at 10:42) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/05/2014 (at 10:44) by Erwan Jahier> *)
open Lv6errors
open Printf
@@ -668,11 +668,11 @@ and (string_of_ident_clk : Ident.clk -> string) =
| "Lustre","true" -> (Ident.to_string v)
| "Lustre","false" -> "not " ^ (Ident.to_string v)
| _ ->
-(* if global_opt.lv4 then *)
-(* raise (Lv6errors.Global_error *)
-(* ("*** Cannot generate V4 style Lustre for programs with enumerated "^ *)
-(* "clocks (yet), sorry.")) *)
-(* else *)
+(* if global_opt.lv4 || global_opt.ec then *)
+(* raise (Lv6errors.Global_error *)
+(* ("Cannot generate V4 style Lustre for programs with enumerated "^ *)
+(* "clocks (yet), sorry.")) *)
+(* else *)
Ident.string_of_clk clk
in
clk_exp_str
diff --git a/src/lv6util.ml b/src/lv6util.ml
index 3ddca881..34be9498 100644
--- a/src/lv6util.ml
+++ b/src/lv6util.ml
@@ -1,20 +1,19 @@
let my_string_of_float = string_of_float
-let (dump_entete : out_channel -> unit) =
- fun oc ->
+let (entete : out_channel -> string -> string -> unit) =
+ fun oc cb ce ->
let time = Unix.localtime (Unix.time ()) in
- let sys_call, _ = Array.fold_left
- (fun (acc,i) x ->
- if 70 < i + (String.length x) then
- acc ^ "\n--\t\t" ^ x, String.length ("\n--\t\t" ^ x)
- else
- acc ^ " " ^ x , (i+1+(String.length x))
- )
- ("",0)
- Sys.argv
- and
- date = Printf.sprintf "%02d/%02d/%d"
+ let sys_call, _ = Array.fold_left
+ (fun (acc,i) x ->
+ if 70 < i + (String.length x) then
+ acc ^ ce^ "\n"^cb^"\t\t" ^ x, String.length ("\n \t\t" ^ x)
+ else
+ acc ^ " " ^ x , (i+1+(String.length x))
+ )
+ ("",0)
+ Sys.argv
+ and date = Printf.sprintf "%02d/%02d/%d"
(time.Unix.tm_mday)
(time.Unix.tm_mon+1)
(1900+time.Unix.tm_year)
@@ -29,10 +28,13 @@ let (dump_entete : out_channel -> unit) =
(* Printf.fprintf oc "-- lus2lic version %s\n" LustreVersion.str; *)
(* Printf.fprintf oc "-- cmd: %s\n" sys_call; *)
(* Printf.fprintf oc "-- host: %s date: %s time: %s\n" hostname date time_str *)
- Printf.fprintf oc "(* This file was generated by lus2lic version %s. *)\n" Lv6version.str;
- Printf.fprintf oc "(* %s *)\n" sys_call;
- Printf.fprintf oc "(* on %s the %s at %s *)\n" hostname date time_str
+ Printf.fprintf oc "%s This file was generated by lus2lic version %s. %s\n"
+ cb Lv6version.str ce;
+ Printf.fprintf oc "%s %s %s\n" cb sys_call ce;
+ Printf.fprintf oc "%s on %s the %s at %s %s\n" cb hostname date time_str ce
+let (dump_entete : out_channel -> unit) =
+ fun oc -> entete oc "(*" "*)"
let rec pos_in_list i x l =
match l with
diff --git a/src/main.ml b/src/main.ml
index d9c71294..f2bd0ecb 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 17/04/2014 (at 15:20) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/05/2014 (at 15:27) by Erwan Jahier> *)
open Verbose
open AstV6
@@ -217,7 +217,7 @@ let main () = (
info "Soc Compilation done.\n";
if opt.gen_c then (
info "Start generating C code...\n";
- Soc2c.f opt zesoc);
+ Soc2c.f opt zesoc lic_prg);
if opt.exec then (
info "Start interpreting soc...\n";
SocExec.f opt zesoc msk)
@@ -234,7 +234,7 @@ let main () = (
info "Soc Compilation done. \n";
if opt.gen_c then (
info "Start generating C code...\n";
- Soc2c.f opt zesoc);
+ Soc2c.f opt zesoc lic_prg);
if opt.exec then (
info "Start interpreting soc...\n";
diff --git a/src/soc2c.ml b/src/soc2c.ml
index 9b66b382..0b8c2361 100644
--- a/src/soc2c.ml
+++ b/src/soc2c.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 12/05/2014 (at 15:44) by Erwan Jahier> *)
+(* Time-stamp: <modified the 28/05/2014 (at 11:53) by Erwan Jahier> *)
(* let put (os: out_channel) (fmt:('a, unit, string, unit) format4) : 'a = *)
@@ -6,6 +6,20 @@
open Printf
+let colcol = Str.regexp "::"
+let id2s id = (* XXX Refuser les noms de module à la con plutot *)
+ let str =
+ match Str.split colcol id with
+ | [s] -> s
+ | [m;s] -> if Lv6MainArgs.global_opt.Lv6MainArgs.no_prefix then s else m^"_"^s
+ | _ -> id
+ in
+ let str = Str.global_replace colcol "_" str in
+ let str = Str.global_replace (Str.regexp "-") "" str in
+ str
+
+let long2s l = id2s (Ident.string_of_long l)
+
let rec (type_to_string : Data.t -> string) =
fun v ->
let str =
@@ -14,21 +28,13 @@ let rec (type_to_string : Data.t -> string) =
| Int -> "_integer"
| Real-> "_real"
| Extern s -> s ^ "(*extern*)"
- | Enum (s, sl) -> s
- | Struct (sid,_) -> sid ^ "(*struct*)"
+ | Enum (s, sl) -> id2s s
+ | Struct (sid,_) -> (id2s sid) ^ "(*struct*)"
| Array (ty, sz) -> Printf.sprintf "%s^%d" (type_to_string ty) sz
| Alpha nb -> assert false
in
str
-let colcol = Str.regexp "::"
-let id2s id =
- match Str.split colcol id with
- | [s] -> s
- | [m;s] -> if Lv6MainArgs.global_opt.Lv6MainArgs.no_prefix then s else m^"_"^s
- | _ -> assert false
-
-
(* Soc printer *)
type 'a soc_pp = {
hfmt: ('a, unit, string, unit) format4 -> 'a;
@@ -46,9 +52,9 @@ let rec (type_to_short_string : Data.t -> string) =
| Data.Int -> "i"
| Data.Real-> "r"
| Data.Extern s -> s
- | Data.Enum (s, sl) -> s
+ | Data.Enum (s, sl) -> "i" (* s *)
| Data.Struct (sid,_) -> sid
- | Data.Array (ty, sz) -> Printf.sprintf "%sp%d" (type_to_string ty) sz
+ | Data.Array (ty, sz) -> Printf.sprintf "%sp%d" (type_to_short_string ty) sz
| Data.Alpha nb ->
(* On génère des "types" à la Caml : 'a, 'b, 'c, etc. *)
let a_value = Char.code('a') in
@@ -63,93 +69,151 @@ let rec (type_to_short_string : Data.t -> string) =
in
str
-let (ctx_name : Soc.key -> string) =
+let (get_ctx_name : Soc.key -> string) =
fun (name,tl,_) ->
let l = List.map type_to_short_string tl in
- Printf.sprintf "%s_%s_ctx" (id2s name) (String.concat "" l)
+ (id2s (Printf.sprintf "%s_%s_ctx" (id2s name) (String.concat "" l)))
let (step_name : Soc.key -> string -> string) =
fun (soc_name,tl,_) sm ->
let l = List.map type_to_short_string tl in
- sprintf "%s_%s_%s" (id2s soc_name) (String.concat "" l) sm
+ let str = sprintf "%s_%s_%s" (id2s soc_name) (String.concat "" l) sm in
+ id2s str
let (string_of_soc_key : Soc.key -> string) =
fun (name,_,_) -> (id2s name)
-let string_of_flow_decl (id, t) = Printf.sprintf " %s %s;\n" (type_to_string t) id
+let string_of_flow_decl (id, t) =
+ Printf.sprintf " %s %s;\n" (type_to_string t) (id2s id)
let (mem_interface : Soc.t -> string -> bool) =
fun soc id ->
let ins,outs = soc.profile in
List.mem_assoc id ins || List.mem_assoc id outs
+let (is_memory_less : Soc.t -> bool) =
+ fun soc ->
+ soc.have_mem = None && soc.instances = []
+
let rec (string_of_var_expr: Soc.t -> Soc.var_expr -> string) =
fun soc -> function
- | Const(id, _) | Var (id,_) -> if not (mem_interface soc id) then id else
- sprintf "ctx->%s" id
- | Field(f, id,_) -> sprintf "%s.%s" (string_of_var_expr soc f) id
+ | Const(id, _) -> id2s id
+ | Var ("mem_pre",_) -> (* XXX Clutch! correct? *) "ctx->mem_pre"
+ | Var (id,_) -> if not (mem_interface soc id) then id2s id else
+ if is_memory_less soc then
+ sprintf "%s.%s" (get_ctx_name soc.key) (id2s id)
+ else
+ sprintf "ctx->%s" (id2s id) (* XXX Clutch! correct? *)
+ | Field(f, id,_) -> sprintf "%s.%s" (string_of_var_expr soc f) (id2s id)
| Index(f, index,_) -> sprintf "%s[%i]" (string_of_var_expr soc f) index
| Slice(f,fi,la,st,wi,vt) -> sprintf "%s[%i..%i step %i]; // XXX fixme!\n"
(string_of_var_expr soc f) fi la st
-let (gao2c : 'a soc_pp -> Soc.gao -> unit) =
- fun sp gao ->
+open Soc
+
+let gen_set_inputs ctx soc curr_soc vel =
+ if vel = [] then "" (* occurs for pre *) else
+ let inputs = fst soc.profile in
+ let l = try (
+ List.map2
+ (fun (name,_t) ve ->
+ Printf.sprintf " %s.%s = %s;\n" ctx name (string_of_var_expr curr_soc ve))
+ inputs
+ vel
+ ) with _ -> assert false (* XXX not all parameters are necessaryly used! *)
+ in
+ (String.concat "" l)
+
+let gen_get_outputs ctx soc curr_soc vel =
+ if vel = [] then "" (* occurs for pre *) else
+ let outputs = snd soc.profile in
+ let l = try (
+ List.map2
+ (fun (name,_t) ve ->
+ Printf.sprintf " %s = %s.%s;\n" (string_of_var_expr curr_soc ve) ctx name)
+ outputs
+ vel
+ ) with _ -> assert false
+ in
+ (String.concat "" l) ^"\n"
+
+let (gao2c : Soc.tbl -> 'a soc_pp -> Soc.gao -> unit) =
+ fun stbl sp gao ->
let string_of_var_expr_list vel =
let vel = List.map (string_of_var_expr sp.soc) vel in
String.concat "," vel
in
- match gao with
- | Case(id, id_gao_l) -> assert false
- | Call(vel_out, Assign, vel_in) ->
- let vel_in_str = string_of_var_expr_list vel_in in
- let vel_out_str = string_of_var_expr_list vel_out in
- let str = sprintf " %s = %s;\n" vel_out_str vel_in_str in
- sp.cput str
-
- | Call(vel_out, Method((inst_name,sk),sname), vel_in) ->
-(* let vel_in_str = string_of_var_expr_list vel_in in *)
-(* let vel_out_str = string_of_var_expr_list vel_out in *)
- let vel_str = string_of_var_expr_list (vel_in@vel_out) in
- let str = sprintf " %s(ctx->%s,%s); //method call\n" (* XXX fixme ! *)
- (step_name sk sname) (id2s inst_name) vel_str in
- sp.cput str
-
-
- | Call(vel_out, Procedure sk, vel_in) ->
- let vel_in_str = string_of_var_expr_list vel_in in
- let vel_out_str = string_of_var_expr_list vel_out in
- let sk = (string_of_soc_key sk) in
- let str = sprintf " %s = %s(%s); //procedure call\n" vel_out_str sk vel_in_str in
- sp.cput str
-
-
-
-let (step2c : 'a soc_pp -> Soc.step_method -> unit) =
- fun sp sm ->
- let cname = ctx_name sp.soc.key in
+ let rec gao2str gao =
+ match gao with
+ | Case(id, id_gao_l) -> (
+ let to_case_str (v,gaol) =
+ let gaol_str = (List.map gao2str gaol)@["break;"] in
+ let gaol_block = String.concat " " gaol_str in
+ sprintf "\n case %s:\n %s" (id2s v) gaol_block
+ in
+ let cases = List.map to_case_str id_gao_l in
+ let str = sprintf " switch(%s){%s\n }\n" (id2s id) (String.concat "\n" cases) in
+ str
+ )
+ | Call(vel_out, Assign, vel_in) -> (
+ let l = List.map2
+ (fun vi vo -> Printf.sprintf " %s = %s;\n"
+ (string_of_var_expr sp.soc vi) (string_of_var_expr sp.soc vo)
+ ) vel_out vel_in
+ in
+ String.concat "" l
+ )
+ | Call(vel_out, Method((inst_name,sk),sname), vel_in) -> (
+ let called_soc = Soc.SocMap.find sk stbl in
+ let ctx = Printf.sprintf "ctx->%s" (id2s inst_name) in
+ let si_str = gen_set_inputs ctx called_soc sp.soc vel_in in
+ let go_str = gen_get_outputs ctx called_soc sp.soc vel_out in
+ let str = sprintf " %s(&ctx->%s); // method call\n"
+ (step_name sk sname) (id2s inst_name)
+ in
+ (si_str ^ str ^ go_str)
+ )
+ | Call(vel_out, Procedure sk, vel_in) -> (
+ let called_soc = Soc.SocMap.find sk stbl in
+ let ctx = get_ctx_name called_soc.key in
+ let si_str = gen_set_inputs ctx called_soc sp.soc vel_in in
+ let go_str = gen_get_outputs ctx called_soc sp.soc vel_out in
+ let str = sprintf " %s(); //procedure call\n"
+ (step_name sk "step")
+ in
+ (si_str ^ str ^ go_str)
+ )
+ in
+ sp.cput (gao2str gao)
+
+let (step2c : Soc.tbl -> 'a soc_pp -> Soc.step_method -> unit) =
+ fun stbl sp sm ->
let sm_str = SocUtils.string_of_method sp.soc sm in
let sname = step_name sp.soc.key sm.name in
-(* sp.put (sprintf "/* %s */\n" sm_str); *)
- sp.cfmt "void %s(%s* ctx){\n" sname cname;
-
-
+ let ctx = if is_memory_less sp.soc then "" else
+ Printf.sprintf "%s_type* ctx" (get_ctx_name sp.soc.key)
+ in
+ let ctx_decl = if is_memory_less sp.soc then "" else
+ Printf.sprintf "%s_type*" (get_ctx_name sp.soc.key)
+ in
+ sp.hfmt "void %s(%s);\n" sname ctx_decl;
+ sp.cfmt "void %s(%s){\n" sname ctx;
(match sm.impl with
| Predef -> sp.cput " //xxx predef_finish_me!"
| Gaol(vl, gaol) ->
List.iter (fun v -> sp.cput (string_of_flow_decl v)) vl ;
sp.cput "\n";
- List.iter (gao2c sp) gaol
+ List.iter (gao2c stbl sp) gaol
(* of var list * gao list (* local vars + body *) *)
| Iterator(it,it_soc,s) -> assert false
| Boolred(i,j,k) -> assert false
| Condact(k,el) -> assert false
);
sp.cput (sprintf "\n} // End of %s\n\n" sname)
-
-let (soc2c: out_channel -> out_channel -> Soc.t -> unit) =
- fun hfile cfile soc ->
+let (soc2c: int -> out_channel -> out_channel -> Soc.tbl -> Soc.t -> unit) =
+ fun pass hfile cfile stbl soc ->
let hfmt fmt = Printf.kprintf (fun t -> output_string hfile t) fmt in
let cfmt fmt = Printf.kprintf (fun t -> output_string cfile t) fmt in
let hput str = output_string hfile str in
@@ -163,42 +227,112 @@ let (soc2c: out_channel -> out_channel -> Soc.t -> unit) =
| Soc.Slic(_,_,_) -> assert false (* fixme *)
| Soc.MemInit(ve) -> Printf.sprintf " = %s" (string_of_var_expr soc ve)
in
- Printf.sprintf " %s %s%s;\n" (ctx_name sk) (id2s id) init
+ Printf.sprintf " %s_type %s%s;\n" (get_ctx_name sk) (id2s id) init
in
let name, _,_ = soc.key in
let name = id2s name in
let il,ol = soc.profile in
let sp = { hfmt = hfmt; cfmt=cfmt; hput = hput; cput = cput; soc = soc } in
- let ctx_name = ctx_name soc.key in
+ let ctx_name = get_ctx_name soc.key in
+ let ctx_name_type = ctx_name^"_type" in
- fmt "/* %s */\ntypedef struct {\n /*INPUTS*/\n" ctx_name;
- List.iter (fun v -> put (string_of_flow_decl v)) il ;
-
- put " /*OUTPUTS*/\n";
- List.iter (fun v -> put (string_of_flow_decl v)) ol ;
-
- (match soc.have_mem with
- | None -> ()
- | Some t ->
- put " /*Memory cell*/\n";
- fmt " %s mem_pre;\n" (Data.type_to_string t) ;
- );
-
- if soc.instances <> [] then put " /*INSTANCES*/\n";
- List.iter (fun inst -> put (string_of_instance inst)) soc.instances;
- fmt "} %s;\n\n" ctx_name;
-
- cfmt "// Step function(s) for %s\n" ctx_name;
- List.iter (step2c sp) soc.step;
- ()
-
-
+ if pass=1 then (
+ hfmt "/* %s */\ntypedef struct {\n /*INPUTS*/\n" ctx_name;
+ List.iter (fun v -> hput (string_of_flow_decl v)) il ;
+
+ hput " /*OUTPUTS*/\n";
+ List.iter (fun v -> hput (string_of_flow_decl v)) ol ;
+
+ (match soc.have_mem with
+ | None -> ()
+ | Some t ->
+ hput " /*Memory cell*/\n";
+ hfmt " %s mem_pre;\n" (id2s (Data.type_to_string t));
+ );
+
+ if soc.instances <> [] then hput " /*INSTANCES*/\n";
+ List.iter (fun inst -> hput (string_of_instance inst)) soc.instances;
+ hfmt "} %s;\n\n" ctx_name_type;
+ (* Only for ctx of memoryless nodes + main node *)
+ if is_memory_less soc then cfmt "%s %s;\n" ctx_name_type ctx_name;
+ ) else (
+ cfmt "// Step function(s) for %s\n" ctx_name;
+ List.iter (step2c stbl sp) soc.step;
+ ()
+ )
+
+(****************************************************************************)
+let rec (lic_type_to_c: Lic.type_ -> string) =
+ function
+ | Bool_type_eff -> "_boolean"
+ | Int_type_eff -> "_integer"
+ | Real_type_eff -> "_real"
+ | External_type_eff (name) -> long2s name
+ | Abstract_type_eff (name, t) -> long2s name
+ | Enum_type_eff (name, l) -> "_integer"
+ | Array_type_eff (ty, sz) ->
+ Printf.sprintf "%s [%d]" (lic_type_to_c ty) sz
+ | Struct_type_eff (name, fl) ->
+ let field_to_c (id,(tf,_opt)) =
+ Printf.sprintf "%s %s" (id2s id) (lic_type_to_c tf)
+ in
+ Printf.sprintf "struct %s { %s };"
+ (long2s name)
+ (String.concat ";\n" (List.map field_to_c fl))
+ | TypeVar Any -> assert false
+ | (TypeVar AnyNum) -> assert false
+
+
+let (typedef : LicPrg.t -> string) =
+ fun licprg ->
+ let to_c k t =
+ Printf.sprintf "typedef %s %s;\n"
+ (lic_type_to_c t)
+ (long2s k)
+ in
+ LicPrg.fold_types (fun k t acc -> acc ^ (to_c k t)) licprg "// Type definitions \n"
+
+let rec (const_to_c: Lic.const -> string) =
+ function
+ | Bool_const_eff true -> "1"
+ | Bool_const_eff false -> "0"
+ | Int_const_eff i -> (sprintf "%s" i)
+ | Real_const_eff r -> r
+ | Extern_const_eff (s,t) -> (long2s s)
+ | Abstract_const_eff (s,t,v,_) -> const_to_c v
+ | Enum_const_eff (s,Enum_type_eff(_,ll)) -> Lic.enum_to_string s ll
+ | Struct_const_eff (fl, t) -> (
+ let string_of_field =
+ function (id, veff) ->
+ (Ident.to_string id)^" = "^ (const_to_c veff)
+ in
+ let flst = List.map string_of_field fl in
+(* (string_of_type_eff t)^ *)
+ "{"^(String.concat "; " flst)^"}"
+ )
+ | Array_const_eff (ctab, t) -> (
+ let vl = List.map const_to_c ctab in
+ "["^(String.concat ", " vl)^"]"
+ )
+ | Tuple_const_eff cl -> assert false
+
+
+let (constdef : LicPrg.t -> string) =
+ fun licprg ->
+ let to_c k c =
+ Printf.sprintf "#define %s %s\n"
+(* Printf.sprintf "const %s = %s;\n" *)
+ (long2s k)
+ (const_to_c c)
+ in
+ LicPrg.fold_consts (fun k t acc -> acc ^ (to_c k t)) licprg "\n// Constant definitions \n"
+(****************************************************************************)
(* The entry point for lus2lic --to-c *)
-let (f : Lv6MainArgs.t -> Soc.tbl -> unit) =
- fun args soc ->
- let socs = Soc.SocMap.bindings soc in
+let (f : Lv6MainArgs.t -> Soc.tbl -> LicPrg.t -> unit) =
+ fun args stbl licprg ->
+ let socs = Soc.SocMap.bindings stbl in
let socs = snd (List.split socs) in
(* XXX que fait-on pour les soc predef ? *)
(* let _, socs = List.partition is_predef socs in *)
@@ -206,12 +340,43 @@ let (f : Lv6MainArgs.t -> Soc.tbl -> unit) =
let cfile = "cfile.c" in
let occ = open_out cfile in
let och = open_out hfile in
-
- Lv6util.dump_entete stdout ;
- List.iter (soc2c och occ) socs;
+ let putc s = output_string occ s in
+ let puth s = output_string och s in
+
+ Lv6util.entete occ "/*" "*/" ;
+ Lv6util.entete och "/*" "*/";
+ (* clutch *)
+ output_string occ "
+#include <stdlib.h>
+#include <string.h>
+
+#ifndef _SOC2C_PREDEF_TYPES
+typedef int _boolean;
+typedef int _integer;
+typedef char* _string;
+typedef double _real;
+typedef double _double;
+typedef float _float;
+#define _false 0
+#define _true 1
+#endif
+// _SOC2C_PREDEF_TYPES
+";
+
+ putc "#include \"hfile.h\"\n";
+ puth (typedef licprg);
+ putc (constdef licprg);
+ puth "/////////////////////////////////////////////////\n";
+ puth "// ctx type definitions\n";
+ putc "/////////////////////////////////////////////////\n";
+ putc "// Allocating memoryless ctx\n";
+ List.iter (soc2c 1 och occ stbl) socs;
+ putc "/////////////////////////////////////////////////\n";
+ putc "// Defining step functions\n";
+ List.iter (soc2c 2 och occ stbl) socs;
+ putc "/////////////////////////////////////////////////\n";
+ putc "// main : XXX TODO! (ctx allocation + main function)\n";
+ putc "void main(void) {}";
flush occ; close_out occ;
flush och; close_out och;
- Printf.printf "%s and %s have been generated.\n" hfile cfile;
-
- (* XXX remove me: *) List.iter (soc2c stdout stdout) socs
-
+ Printf.printf "%s and %s have been generated.\n" hfile cfile
diff --git a/src/soc2c.mli b/src/soc2c.mli
index 621fc9a8..0d6ca215 100644
--- a/src/soc2c.mli
+++ b/src/soc2c.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 17/04/2014 (at 15:20) by Erwan Jahier> *)
+(* Time-stamp: <modified the 26/05/2014 (at 15:13) by Erwan Jahier> *)
(* The entry point for lus2lic -toC *)
-val f : Lv6MainArgs.t -> Soc.tbl -> unit
+val f : Lv6MainArgs.t -> Soc.tbl -> LicPrg.t -> unit
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index bd1478ed..dae77e64 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Wed May 21 16:17:37 2014
+Test Run By jahier on Wed May 28 15:24:38 2014
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
@@ -901,6 +901,9 @@ PASS: ./lus2lic {-o /tmp/call03.lic should_work/call03.lus}
PASS: ./lus2lic {-ec -o /tmp/call03.ec should_work/call03.lus}
PASS: ./myec2c {-o /tmp/call03.c /tmp/call03.ec}
PASS: ../utils/test_lus2lic_no_node should_work/call03.lus
+PASS: ./lus2lic {-o /tmp/modes3x2-simu.lic should_work/modes3x2-simu.lus}
+PASS: ./lus2lic {-ec -o /tmp/modes3x2-simu.ec should_work/modes3x2-simu.lus}
+FAIL: Try ec2c on the result: ./myec2c {-o /tmp/modes3x2-simu.c /tmp/modes3x2-simu.ec}
PASS: ./lus2lic {-o /tmp/count.lic should_work/count.lus}
PASS: ./lus2lic {-ec -o /tmp/count.ec should_work/count.lus}
PASS: ./myec2c {-o /tmp/count.c /tmp/count.ec}
@@ -1031,9 +1034,9 @@ XPASS: Test bad programs (semantics): lus2lic {-o /tmp/bug.lic should_fail/seman
=== lus2lic Summary ===
-# of expected passes 885
-# of unexpected failures 76
+# of expected passes 887
+# of unexpected failures 77
# of unexpected successes 21
# of expected failures 37
-testcase ./lus2lic.tests/non-reg.exp completed in 129 seconds
-testcase ./lus2lic.tests/progression.exp completed in 0 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 139 seconds
+testcase ./lus2lic.tests/progression.exp completed in 1 seconds
diff --git a/test/lus2lic.time b/test/lus2lic.time
index b771258b..07c734aa 100644
--- a/test/lus2lic.time
+++ b/test/lus2lic.time
@@ -1,2 +1,2 @@
-testcase ./lus2lic.tests/non-reg.exp completed in 129 seconds
-testcase ./lus2lic.tests/progression.exp completed in 0 seconds
+testcase ./lus2lic.tests/non-reg.exp completed in 139 seconds
+testcase ./lus2lic.tests/progression.exp completed in 1 seconds
diff --git a/test/should_work/modes3x2-v3.lus b/test/should_work/modes3x2-v3.lus
index 83435e5d..bfda61ee 100644
--- a/test/should_work/modes3x2-v3.lus
+++ b/test/should_work/modes3x2-v3.lus
@@ -18,10 +18,6 @@ node A2(x:data) returns (y:data); let y = 43; tel
node B0(x:data) returns (y:data); let y = 15; tel
node B1(x:data) returns (y:data); let y = 5; tel
-node copy(x:bool) returns (y: bool);
-let
- y = x;
-tel
type state = enum { idle, low, high };
node A(x:data; ca1, ca2: bool) returns (y:data);
@@ -38,12 +34,8 @@ let
( high -> A2(x when high(s)) ) ;
tel
-node B(x:data; _nom, _sby: bool) returns (z:data);
-var
- nom, sby: bool;
+node B(x:data; nom, sby: bool) returns (z:data);
let
- nom = copy(_nom);
- sby = copy(_sby);
z = if nom then current (B0(x when nom))
else if sby then current (B1(x when sby))
else (0 -> pre z);
@@ -55,7 +47,7 @@ var
sby : bool;
nom : bool;
let
- assert #(on_off, toggle);
+-- assert #(on_off, toggle);
y = A(x, on_off, toggle);
z = B(y, nom, sby);
--
GitLab