From 5316f18a01d3d41cd969ec5fe8e403235421be14 Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Mon, 8 Apr 2013 15:00:17 +0200
Subject: [PATCH] Some work to prepare the merge with the lurette git repo.
I took the data type definition from SocExecValue to define a Data
module that is a strict extension of the Lutin Data module.
The duplicated Genlex module is now also identical to the one of
Lurette.
Quite boring, but simple thanks to the ocaml type system.
---
.gitignore | 16 +-
Makefile | 2 +
src/actionsDeps.ml | 8 +-
src/actionsDeps.mli | 4 +-
src/data.ml | 101 ++++++++++
src/data.mli | 28 +++
src/genlex.ml | 273 ++++++++++++++++++++++++++
src/genlex.mli | 71 +++++++
src/lic2soc.ml | 107 ++++++-----
src/lic2soc.mli | 4 +-
src/rif_base.ml | 326 ++++++++++++++++++++++++++++++++
src/rif_base.mli | 42 ++++
src/soc.ml | 22 +--
src/socExec.ml | 14 +-
src/socExecEvalPredef.ml | 7 +-
src/socExecValue.ml | 88 +++------
src/socExecValue.mli | 22 +--
src/socPredef.ml | 36 ++--
src/socPredef.mli | 6 +-
src/socUtils.ml | 28 +--
src/socUtils.mli | 6 +-
test/Makefile.dist | 17 ++
test/board_triglav.exp | 4 +
test/lus2lic.sum | 2 +-
test/should_fail/type/merge.lus | 11 ++
todo.org | 7 +-
26 files changed, 1031 insertions(+), 221 deletions(-)
create mode 100644 src/data.ml
create mode 100644 src/data.mli
create mode 100644 src/genlex.ml
create mode 100644 src/genlex.mli
create mode 100644 src/rif_base.ml
create mode 100644 src/rif_base.mli
create mode 100644 test/Makefile.dist
create mode 100644 test/board_triglav.exp
create mode 100644 test/should_fail/type/merge.lus
diff --git a/.gitignore b/.gitignore
index 62191435..1249110b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,7 +1,13 @@
src/*.cm[ixo]
src/*.o
*~
-src/TAGS
+_test*
+test-old/
+test/ec2c
+test/perf
+bug
+lus2lic
+TAGS
*log
*.dump
*.ec
@@ -41,3 +47,11 @@ lv6-ref-man/lv6-ref-man.pdf
old
,poub
src/prof
+*.out
+*.output
+*.aux
+ec.yacc.pdf
+lus2lic-types.pdf
+lus2lic.pdf
+*.tex
+ocamldoc
\ No newline at end of file
diff --git a/Makefile b/Makefile
index 923ed399..1f54a6eb 100644
--- a/Makefile
+++ b/Makefile
@@ -35,6 +35,8 @@ CFLAGS=-mno-cygwin
endif
SOC_SOURCES = \
+ $(OBJDIR)/data.mli \
+ $(OBJDIR)/data.ml \
$(OBJDIR)/soc.ml \
$(OBJDIR)/socUtils.mli \
$(OBJDIR)/socUtils.ml \
diff --git a/src/actionsDeps.ml b/src/actionsDeps.ml
index 71de5fab..461d6394 100644
--- a/src/actionsDeps.ml
+++ b/src/actionsDeps.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 02/04/2013 (at 16:05) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2013 (at 14:13) by Erwan Jahier> *)
let dbg = Some(Verbose.get_flag "exec")
@@ -219,8 +219,8 @@ let to_string: t -> string = fun m ->
(*********************************************************************************)
(* exported *)
-let build_data_deps_from_actions: (Lic.type_ -> Soc.var_type) -> t -> action list -> t =
- fun lic_to_soc_type deps al ->
+let build_data_deps_from_actions: (Lic.type_ -> Data.t) -> t -> action list -> t =
+ fun lic_to_data_type deps al ->
let tbl = get_var2actions_tbl al in
let deps =
List.fold_left
@@ -229,7 +229,7 @@ let build_data_deps_from_actions: (Lic.type_ -> Soc.var_type) -> t -> action li
let dep_vars = match clk with
| Lic.BaseLic -> rhs
| Lic.ClockVar int -> assert false
- | Lic.On ((cc,cv,ct),_) -> (Soc.Var(cv, lic_to_soc_type ct))::rhs
+ | Lic.On ((cc,cv,ct),_) -> (Soc.Var(cv, lic_to_data_type ct))::rhs
in
let deps = actions_of_vars dep_vars tbl in
(* The guard should be computed before the guarded expression *)
diff --git a/src/actionsDeps.mli b/src/actionsDeps.mli
index afa57216..6baf10ef 100644
--- a/src/actionsDeps.mli
+++ b/src/actionsDeps.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 02/04/2013 (at 16:06) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2013 (at 14:11) by Erwan Jahier> *)
(** Compute dependencies between actions *)
@@ -39,7 +39,7 @@ val string_of_action_simple: action -> string
Lic2soc.lic_to_soc_type is passed inn argument to break a mutuel dep loop
*)
-val build_data_deps_from_actions: (Lic.type_ -> Soc.var_type) -> t -> action list -> t
+val build_data_deps_from_actions: (Lic.type_ -> Data.t) -> t -> action list -> t
(** Use the dependency constraints that come from the SOC (e.g., 'get' before 'set'
in memory SOC).
diff --git a/src/data.ml b/src/data.ml
new file mode 100644
index 00000000..a1519159
--- /dev/null
+++ b/src/data.ml
@@ -0,0 +1,101 @@
+
+type ident = string
+type v = I of int | F of float | B of bool
+ | E of ident * int
+ | A of v array | S of (ident * v) list | U
+
+type t =
+ | Bool | Int | Real
+ | Extern of ident
+ | Enum of (ident * ident list)
+ | Struct of ident * (ident * t) list
+ | Array of (t * int)
+ | Alpha of int
+
+
+let rec (val_to_string : v -> string) =
+ function
+ | I i -> string_of_int i
+ | F f -> string_of_float f (* Util.my_string_of_float f *)
+ | B true -> "t"
+ | B false -> "f"
+ | E (e,_) -> e
+ | S fl -> String.concat " " (List.map (fun (fn,fv) -> val_to_string fv) fl)
+ | A a ->
+ let str = ref "" in
+ let f i a = str := !str ^ " " ^ (val_to_string a) in
+ Array.iteri f a;
+ !str
+ | U -> "not initialised"
+
+
+let rec (type_to_string : t -> string) =
+ fun v ->
+ let str =
+ match v with
+ | Bool -> "bool"
+ | Int -> "int"
+ | Real-> "real"
+ | Extern s -> s ^ "(*extern*)"
+ | Enum (s, sl) -> "enum " ^ s ^ " {" ^ (String.concat ", " sl) ^ "}"
+ | Struct (sid,_) -> sid ^ "(*struct*)"
+ | Array (ty, sz) -> Printf.sprintf "%s^%d" (type_to_string ty) sz
+ | Alpha nb ->
+ (* On génère des "types" à la Caml : 'a, 'b, 'c, etc. *)
+ let a_value = Char.code('a') in
+ let z_value = Char.code('z') in
+ let str =
+ if (nb >= 0 && nb <= (z_value - a_value)) then
+ ("'" ^ (Char.escaped (Char.chr(a_value + nb))))
+ else
+ ("'a" ^ (string_of_int nb))
+ in
+ str
+ in
+ str
+
+let (type_of_string : string -> t) =
+ function
+ | "bool" -> Bool
+ | "real" -> Real
+ | "float" -> Real
+ | "int" -> Int
+ | s -> failwith (s ^ ": unsupported type.\n")
+
+
+type vntl = (string * string) list
+type subst = (string * v)
+
+
+type access = Idx of int | Fld of ident
+
+(* exported *)
+let rec (update_val : v -> v -> access list -> v) =
+ fun pre_v v access ->
+ match pre_v,access with
+ | _,[] -> v
+ | A a, (Idx i)::access ->
+ let a_i = update_val a.(i) v access in
+ a.(i) <- a_i;
+ A a
+ | S(fl), (Fld fn)::access ->
+ S (List.map
+ (fun (fn2,v2) -> if fn=fn2 then fn,update_val v2 v access else (fn2,v2))
+ fl)
+ | _,_ -> assert false (* finish me (field struct) *)
+
+
+(* exported *)
+let rec (create_val : t -> v -> access list -> v) =
+ fun vt v access ->
+ match vt,access with
+ | _,[] -> v
+ | Array(vt,size), (Idx i)::access ->
+ let a = Array.make size U in
+ let a_i = create_val vt v access in
+ a.(i) <- a_i;
+ A a
+ | Struct(sn,fl), (Fld fn)::access ->
+ S(List.map (fun (fn2,vt2) -> if fn=fn2 then fn,create_val vt2 v access else fn2,U) fl)
+ | _,_ -> assert false
+
diff --git a/src/data.mli b/src/data.mli
new file mode 100644
index 00000000..7d26bfd5
--- /dev/null
+++ b/src/data.mli
@@ -0,0 +1,28 @@
+type ident = string
+type v = I of int | F of float | B of bool
+ | E of ident * int
+ | A of v array | S of (ident * v) list | U
+
+type t =
+ | Bool | Int | Real
+ | Extern of ident
+ | Enum of (ident * ident list)
+ | Struct of ident * (ident * t) list
+ | Array of (t * int)
+ | Alpha of int
+
+val val_to_string : v -> string
+val type_to_string : t -> string
+val type_of_string : string -> t
+
+
+type vntl = (string * string) list
+type subst = (string * v)
+
+type access = Idx of int | Fld of ident
+
+(* Replace access(pre_v) by v in pre_v *)
+val update_val : v -> v -> access list -> v
+
+(* The same as update_val in the case where no previous value exists *)
+val create_val : t -> v -> access list -> v
diff --git a/src/genlex.ml b/src/genlex.ml
new file mode 100644
index 00000000..1a27d89b
--- /dev/null
+++ b/src/genlex.ml
@@ -0,0 +1,273 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the GNU Library General Public License, with *)
+(* the special exception on linking described in file ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: genlex.ml,v 1.9 2002/04/18 07:27:42 garrigue Exp $ *)
+
+(*
+ Modified by Erwan Jahier
+ in order to add source info to tokens
+
+*)
+
+type source_info = int * int (* line and column *)
+
+type token =
+ Kwd of source_info * string
+ | Ident of source_info * string
+ | Int of source_info * int
+ | Float of source_info * float
+ | String of source_info * string
+ | Char of source_info * char
+
+
+(* The string buffering machinery *)
+
+let initial_buffer = String.create 32
+
+let buffer = ref initial_buffer
+let bufpos = ref 0
+
+let reset_buffer () = buffer := initial_buffer; bufpos := 0
+
+let store c =
+ if !bufpos >= String.length !buffer then
+ begin
+ let newbuffer = String.create (2 * !bufpos) in
+ String.blit !buffer 0 newbuffer 0 !bufpos; buffer := newbuffer
+ end;
+ String.set !buffer !bufpos c;
+ incr bufpos
+
+let get_string () =
+ let s = String.sub !buffer 0 !bufpos in buffer := initial_buffer; s
+
+(* The lexer *)
+
+(* Avoid crashing if int are too big *)
+let my_int_of_string str =
+ try int_of_string str
+ with _ ->
+ let i64 = Int64.of_string str in
+ let i = if i64 > (Int64.of_int max_int) then
+ max_int / 4
+ else if i64 < (Int64.of_int min_int) then
+ min_int / 4
+ else
+ Int64.to_int i64 (* deadcode IMHO *)
+ in
+ Printf.eprintf "Warning: The integer %s is too big: truncate it to %i\n" str i;
+ flush stderr;
+ i
+
+
+let make_lexer keywords =
+ let kwd_table = Hashtbl.create 17 in
+ List.iter (fun s -> Hashtbl.add kwd_table s "dummy") keywords;
+ let ident_or_keyword id s e =
+ if
+ Hashtbl.mem kwd_table id
+ then
+ Kwd ((s, e), id)
+ else
+ Ident ((s, e), id)
+ and keyword_or_error c s e=
+ let id = String.make 1 c in
+ if
+ Hashtbl.mem kwd_table id
+ then
+ Kwd ((s, e), id)
+ else
+ raise (Stream.Error ("Illegal character " ^ id))
+ in
+ let rec next_token (strm__ : _ Stream.t) =
+ let debut = Stream.count strm__ in
+ match Stream.peek strm__ with
+ Some (' ' | '\010' | '\013' | '\009' | '\026' | '\012') ->
+ Stream.junk strm__; next_token strm__
+ | Some ('A'..'Z' | 'a'..'z' | '_' | '\192'..'\255' as c) ->
+ Stream.junk strm__;
+ let s = strm__ in reset_buffer (); store c; ident s debut
+ | Some
+ ('!' | '%' | '&' | '$' | '#' | '+' | '/' | ':' | '<' | '=' | '>' |
+ '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) ->
+ Stream.junk strm__;
+ let s = strm__ in reset_buffer (); store c; ident2 s debut
+ | Some ('0'..'9' as c) ->
+ Stream.junk strm__;
+ let s = strm__ in reset_buffer (); store c; number s
+ | Some '\'' ->
+ Stream.junk strm__;
+ let c =
+ try char strm__ with
+ Stream.Failure -> raise (Stream.Error "")
+ in
+ begin match Stream.peek strm__ with
+ Some '\'' -> Stream.junk strm__; Some (Char ((debut, Stream.count strm__),c))
+ | _ -> raise (Stream.Error "")
+ end
+ | Some '"' ->
+ Stream.junk strm__;
+ let s = strm__ in
+ let str = reset_buffer ();(string s) in
+ Some (String ((debut,(Stream.count strm__)), str))
+ | Some '-' -> Stream.junk strm__; maybe_one_line_comment strm__
+ | Some '(' -> Stream.junk strm__; maybe_comment strm__
+ | Some c -> Stream.junk strm__; Some (keyword_or_error c debut (Stream.count strm__))
+ | _ -> None
+ and ident (strm__ : _ Stream.t) (debut : int) =
+ match Stream.peek strm__ with
+ Some
+ ('A'..'Z' | 'a'..'z' | '\192'..'\255' | '0'..'9' | '_' | '\'' as c) ->
+ Stream.junk strm__; let s = strm__ in store c; ident s debut
+ | _ ->
+ let str = (get_string ()) in
+ let fin = (Stream.count strm__) in
+ Some (ident_or_keyword str debut fin)
+ and ident2 (strm__ : _ Stream.t) debut =
+ match Stream.peek strm__ with
+ Some
+ ('!' | '%' | '&' | '$' | '#' | '+' | '-' | '/' | ':' | '<' | '=' |
+ '>' | '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) ->
+ Stream.junk strm__; let s = strm__ in store c; ident2 s debut
+ | _ ->
+ let str = (get_string ()) in
+ let fin = (Stream.count strm__) in
+ Some (ident_or_keyword str debut fin)
+ and neg_number (strm__ : _ Stream.t) =
+ let debut = Stream.count strm__ in
+ match Stream.peek strm__ with
+ Some ('0'..'9' as c) ->
+ Stream.junk strm__;
+ let s = strm__ in reset_buffer (); store '-'; store c; number s
+ | _ -> let s = strm__ in reset_buffer (); store '-'; ident2 s debut
+ and number (strm__ : _ Stream.t) =
+ let debut = Stream.count strm__ in
+ match Stream.peek strm__ with
+ Some ('0'..'9' as c) ->
+ Stream.junk strm__; let s = strm__ in store c; number s
+ | Some '.' ->
+ Stream.junk strm__; let s = strm__ in store '.'; decimal_part s
+ | Some ('e' | 'E') ->
+ Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s
+ | _ ->
+ let s = (get_string ()) in
+ Some (Int ((debut,(Stream.count strm__)),
+ (my_int_of_string s)
+ ))
+ and decimal_part (strm__ : _ Stream.t) =
+ let debut = Stream.count strm__ in
+ match Stream.peek strm__ with
+ Some ('0'..'9' as c) ->
+ Stream.junk strm__; let s = strm__ in store c; decimal_part s
+ | Some ('e' | 'E') ->
+ Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s
+ | _ ->
+ let s = (get_string ()) in
+ Some (Float ((debut,(Stream.count strm__)), (float_of_string s )))
+ and exponent_part (strm__ : _ Stream.t) =
+ match Stream.peek strm__ with
+ Some ('+' | '-' as c) ->
+ Stream.junk strm__; let s = strm__ in store c; end_exponent_part s
+ | _ -> end_exponent_part strm__
+ and end_exponent_part (strm__ : _ Stream.t) =
+ let debut = Stream.count strm__ in
+ match Stream.peek strm__ with
+ Some ('0'..'9' as c) ->
+ Stream.junk strm__; let s = strm__ in store c; end_exponent_part s
+ | _ ->
+ let s = (get_string ()) in
+ Some (Float ((debut,(Stream.count strm__)), (float_of_string s)))
+ and string (strm__ : _ Stream.t) =
+ match Stream.peek strm__ with
+ Some '"' -> Stream.junk strm__; get_string ()
+ | Some '\\' ->
+ Stream.junk strm__;
+ let c =
+ try escape strm__ with
+ Stream.Failure -> raise (Stream.Error "")
+ in
+ let s = strm__ in store c; string s
+ | Some c -> Stream.junk strm__; let s = strm__ in store c; string s
+ | _ -> raise Stream.Failure
+ and char (strm__ : _ Stream.t) =
+ match Stream.peek strm__ with
+ Some '\\' ->
+ Stream.junk strm__;
+ begin try escape strm__ with
+ Stream.Failure -> raise (Stream.Error "")
+ end
+ | Some c -> Stream.junk strm__; c
+ | _ -> raise Stream.Failure
+ and escape (strm__ : _ Stream.t) =
+ match Stream.peek strm__ with
+ Some 'n' -> Stream.junk strm__; '\n'
+ | Some 'r' -> Stream.junk strm__; '\r'
+ | Some 't' -> Stream.junk strm__; '\t'
+ | Some ('0'..'9' as c1) ->
+ Stream.junk strm__;
+ begin match Stream.peek strm__ with
+ Some ('0'..'9' as c2) ->
+ Stream.junk strm__;
+ begin match Stream.peek strm__ with
+ Some ('0'..'9' as c3) ->
+ Stream.junk strm__;
+ Char.chr
+ ((Char.code c1 - 48) * 100 + (Char.code c2 - 48) * 10 +
+ (Char.code c3 - 48))
+ | _ -> raise (Stream.Error "")
+ end
+ | _ -> raise (Stream.Error "")
+ end
+ | Some c -> Stream.junk strm__; c
+ | _ -> raise Stream.Failure
+
+
+(* lustre-like one line comment "--" *)
+ and maybe_one_line_comment (strm__ : _ Stream.t) =
+ let _debut = Stream.count strm__ in
+ match Stream.peek strm__ with
+ Some '-' ->
+ Stream.junk strm__; let s = strm__ in one_line_comment s; next_token s
+ | _ -> neg_number strm__
+ and one_line_comment (strm__ : _ Stream.t) =
+ match Stream.peek strm__ with
+ Some '\n' -> Stream.junk strm__; ()
+ | Some c -> Stream.junk strm__; one_line_comment strm__
+ | None -> ()
+
+(* multiple line comments *)
+ and maybe_comment (strm__ : _ Stream.t) =
+ let debut = Stream.count strm__ in
+ match Stream.peek strm__ with
+ Some '*' ->
+ Stream.junk strm__; let s = strm__ in comment s; next_token s
+ | _ -> Some (keyword_or_error '(' debut (debut+1))
+ and comment (strm__ : _ Stream.t) =
+ match Stream.peek strm__ with
+ Some '(' -> Stream.junk strm__; maybe_nested_comment strm__
+ | Some '*' -> Stream.junk strm__; maybe_end_comment strm__
+ | Some c -> Stream.junk strm__; comment strm__
+ | _ -> raise Stream.Failure
+ and maybe_nested_comment (strm__ : _ Stream.t) =
+ match Stream.peek strm__ with
+ Some '*' -> Stream.junk strm__; let s = strm__ in comment s; comment s
+ | Some c -> Stream.junk strm__; comment strm__
+ | _ -> raise Stream.Failure
+ and maybe_end_comment (strm__ : _ Stream.t) =
+ match Stream.peek strm__ with
+ Some ')' -> Stream.junk strm__; ()
+ | Some '*' -> Stream.junk strm__; maybe_end_comment strm__
+ | Some c -> Stream.junk strm__; comment strm__
+ | _ -> raise Stream.Failure
+ in
+ fun input -> Stream.from (fun count -> next_token input)
diff --git a/src/genlex.mli b/src/genlex.mli
new file mode 100644
index 00000000..db168a2c
--- /dev/null
+++ b/src/genlex.mli
@@ -0,0 +1,71 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the GNU Library General Public License, with *)
+(* the special exception on linking described in file ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: genlex.mli 1.2 Fri, 22 Jul 2005 17:06:41 +0200 jahier $ *)
+
+(** A generic lexical analyzer.
+
+
+ This module implements a simple ``standard'' lexical analyzer, presented
+ as a function from character streams to token streams. It implements
+ roughly the lexical conventions of Caml, but is parameterized by the
+ set of keywords of your language.
+
+
+ Example: a lexer suitable for a desk calculator is obtained by
+ {[ let lexer = make_lexer ["+";"-";"*";"/";"let";"="; "("; ")"] ]}
+
+ The associated parser would be a function from [token stream]
+ to, for instance, [int], and would have rules such as:
+
+ {[
+ let parse_expr = parser
+ [< 'Int n >] -> n
+ | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n
+ | [< n1 = parse_expr; n2 = parse_remainder n1 >] -> n2
+ and parse_remainder n1 = parser
+ [< 'Kwd "+"; n2 = parse_expr >] -> n1+n2
+ | ...
+ ]}
+*)
+
+type source_info = int * int (* line and column *)
+
+(** The type of tokens. The lexical classes are: [Int] and [Float]
+ for integer and floating-point numbers; [String] for
+ string literals, enclosed in double quotes; [Char] for
+ character literals, enclosed in single quotes; [Ident] for
+ identifiers (either sequences of letters, digits, underscores
+ and quotes, or sequences of ``operator characters'' such as
+ [+], [*], etc); and [Kwd] for keywords (either identifiers or
+ single ``special characters'' such as [(], [}], etc). *)
+type token =
+ Kwd of source_info * string
+ | Ident of source_info * string
+ | Int of source_info * int
+ | Float of source_info * float
+ | String of source_info * string
+ | Char of source_info * char
+
+
+val make_lexer : string list -> char Stream.t -> token Stream.t
+(** Construct the lexer function. The first argument is the list of
+ keywords. An identifier [s] is returned as [Kwd s] if [s]
+ belongs to this list, and as [Ident s] otherwise.
+ A special character [s] is returned as [Kwd s] if [s]
+ belongs to this list, and cause a lexical error (exception
+ [Parse_error]) otherwise. Blanks and newlines are skipped.
+ Comments delimited by [(*] and [*)] are skipped as well,
+ and can be nested. *)
+
+
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index f99fad6e..cf5fa775 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 08/04/2013 (at 13:31) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2013 (at 14:25) by Erwan Jahier> *)
open Lxm
open Lic
@@ -9,7 +9,7 @@ type action = ActionsDeps.action
(* Raised when a soc that haven't been translated yet is used in
another soc during the translation *)
-exception Undef_soc of Soc.key * Lxm.t * Lic.by_pos_op * Soc.var_type list * Soc.var_expr option
+exception Undef_soc of Soc.key * Lxm.t * Lic.by_pos_op * Data.t list * Soc.var_expr option
exception Undef_merge_soc of Soc.key * Lxm.t * val_exp * (const srcflagged * val_exp) list
(*********************************************************************************)
@@ -30,26 +30,26 @@ let create_context: (LicPrg.t -> ctx) =
locals = [];
}
-let rec lic_to_soc_type: (Lic.type_ -> Soc.var_type) =
+let rec lic_to_data_type: (Lic.type_ -> Data.t) =
function
- | Lic.Bool_type_eff -> Soc.Bool
- | Lic.Int_type_eff -> Soc.Int
- | Lic.Real_type_eff -> Soc.Real
- | Lic.External_type_eff s -> Soc.Extern (Ident.string_of_long s)
+ | Lic.Bool_type_eff -> Data.Bool
+ | Lic.Int_type_eff -> Data.Int
+ | Lic.Real_type_eff -> Data.Real
+ | Lic.External_type_eff s -> Data.Extern (Ident.string_of_long s)
| Lic.Enum_type_eff (id, l) -> (
- Soc.Enum(Ident.string_of_long id, List.map Ident.string_of_long l)
+ Data.Enum(Ident.string_of_long id, List.map Ident.string_of_long l)
)
| Lic.Struct_type_eff (id, fl) -> (
let trans_field (id,(t,_)) = (* fde_value is ignored. Good idea? *)
- Ident.to_string id, lic_to_soc_type t
+ Ident.to_string id, lic_to_data_type t
in
let id = Ident.string_of_long id in
- Soc.Struct(id, List.map trans_field fl)
+ Data.Struct(id, List.map trans_field fl)
)
- | Lic.Array_type_eff(ty,i) -> Soc.Array(lic_to_soc_type ty,i)
+ | Lic.Array_type_eff(ty,i) -> Data.Array(lic_to_data_type ty,i)
| Lic.Abstract_type_eff (id, _) -> assert false
- | Lic.TypeVar Lic.Any -> Soc.Alpha 0
- | Lic.TypeVar Lic.AnyNum -> Soc.Alpha 1
+ | Lic.TypeVar Lic.Any -> Data.Alpha 0
+ | Lic.TypeVar Lic.AnyNum -> Data.Alpha 1
(*********************************************************************************)
(** Renomme une variable définie par l'utilisateur.
@@ -92,13 +92,13 @@ let (slice_info_to_index_list : Lic.slice_info -> int list) =
let rec (lic2soc_const : Lic.const -> Soc.var_expr list) =
function
- | Bool_const_eff true -> [Soc.Const("true", Soc.Bool)]
- | Bool_const_eff false -> [Soc.Const("false", Soc.Bool)]
- | Int_const_eff i -> [Soc.Const(i, Soc.Int)]
- | Real_const_eff r -> [Soc.Const(r, Soc.Real)]
- | Extern_const_eff (s, teff) -> [Soc.Const(Ident.string_of_long s, lic_to_soc_type teff)]
- | Abstract_const_eff (s, teff,_,_) -> [Soc.Const(Ident.string_of_long s, lic_to_soc_type teff)]
- | Enum_const_eff (s, teff) -> [Soc.Const(Ident.string_of_long s, lic_to_soc_type teff)]
+ | Bool_const_eff true -> [Soc.Const("true", Data.Bool)]
+ | Bool_const_eff false -> [Soc.Const("false", Data.Bool)]
+ | Int_const_eff i -> [Soc.Const(i, Data.Int)]
+ | Real_const_eff r -> [Soc.Const(r, Data.Real)]
+ | Extern_const_eff (s, teff) -> [Soc.Const(Ident.string_of_long s, lic_to_data_type teff)]
+ | Abstract_const_eff (s, teff,_,_) -> [Soc.Const(Ident.string_of_long s, lic_to_data_type teff)]
+ | Enum_const_eff (s, teff) -> [Soc.Const(Ident.string_of_long s, lic_to_data_type teff)]
| Struct_const_eff (fl, teff) -> assert false (* todo *)
| Array_const_eff (ct, teff) -> assert false (* todo *)
| Tuple_const_eff cl -> List.flatten (List.map lic2soc_const cl)
@@ -120,18 +120,18 @@ let rec get_leaf: (LicPrg.t -> Lic.val_exp -> Soc.var_expr list option) =
let type_ = (List.hd type_) in
let translation =
match is_predefined_const name with
- | Some type_ -> Soc.Const(name, lic_to_soc_type type_)
- | None -> Soc.Var(rename_user_var name, lic_to_soc_type type_)
+ | Some type_ -> Soc.Const(name, lic_to_data_type type_)
+ | None -> Soc.Var(rename_user_var name, lic_to_data_type type_)
in
Some [translation]
| Lic.CONST_REF l -> (
- let type_ = lic_to_soc_type (List.hd type_) in
+ let type_ = lic_to_data_type (List.hd type_) in
Some [Soc.Const(Ident.string_of_long l, type_)]
)
| Lic.CONST c -> Some(lic2soc_const c)
| Lic.STRUCT_ACCESS(field) -> (
let expr = match val_exp_list with [e] -> e | _ -> assert false in
- let type_ = lic_to_soc_type (List.hd type_) in
+ let type_ = lic_to_data_type (List.hd type_) in
let filter_expr = match get_leaf licprg expr with
| Some [f] -> f
| None -> assert false
@@ -141,7 +141,7 @@ let rec get_leaf: (LicPrg.t -> Lic.val_exp -> Soc.var_expr list option) =
)
| Lic.ARRAY_ACCES i -> (
let expr = match val_exp_list with [e] -> e | _ -> assert false in
- let type_ = lic_to_soc_type (List.hd type_) in
+ let type_ = lic_to_data_type (List.hd type_) in
let filter_expr = match get_leaf licprg expr with
| Some [f] -> f
| None -> assert false (* should not happen, since the expression should be a leaf *)
@@ -164,15 +164,14 @@ let rec get_leaf: (LicPrg.t -> Lic.val_exp -> Soc.var_expr list option) =
let type_elt_ref,type_ref =
match type_ with
| [Lic.Array_type_eff(t,i)] ->
- let t_soc = lic_to_soc_type t in
- t_soc, Soc.Array(t_soc,i)
+ let t_soc = lic_to_data_type t in
+ t_soc, Data.Array(t_soc,i)
| _ -> assert false (* should not occur *)
in
let index_list = slice_info_to_index_list si in
let exploded_array =
- (* val_exp is a var ident (t) of type array; we want to gen the list
- t[i1], ...,t[in], where the index are specified by the slice
- *)
+ (* val_exp is a var ident (t) of type array; we want to gen the list
+ t[i1], ...,t[in], where the index are specified by the slice *)
List.map
(fun i -> Soc.Index(Soc.Const(id, type_ref), i, type_elt_ref))
index_list
@@ -197,22 +196,22 @@ let rec filter_of_left_part: (LicPrg.t -> Lic.left -> Soc.var_expr list) =
let type_ = Lic.type_of_left lp in
match lp with
| Lic.LeftVarLic (vi, _lxm) -> (
- [Soc.Var (rename_user_var vi.Lic.var_name_eff, lic_to_soc_type vi.Lic.var_type_eff)]
+ [Soc.Var (rename_user_var vi.Lic.var_name_eff, lic_to_data_type vi.Lic.var_type_eff)]
)
| Lic.LeftFieldLic(lp,field,t) -> (
let lpl = filter_of_left_part licprg lp in
- List.map (fun lp -> Soc.Field(lp, field, lic_to_soc_type t)) lpl
+ List.map (fun lp -> Soc.Field(lp, field, lic_to_data_type t)) lpl
)
| Lic.LeftArrayLic(lp,index,t) -> (
let lpl = filter_of_left_part licprg lp in
- List.map (fun lp -> Soc.Index(lp, index, lic_to_soc_type t (* type_ ? *))) lpl
+ List.map (fun lp -> Soc.Index(lp, index, lic_to_data_type t (* type_ ? *))) lpl
)
| Lic.LeftSliceLic(lp,si,t) -> (
(* we expand left part slices *)
let lpl = filter_of_left_part licprg lp in
let index_list = slice_info_to_index_list si in
List.flatten (List.map (
- fun lp -> List.map (fun index -> Soc.Index(lp, index, lic_to_soc_type t)) index_list) lpl)
+ fun lp -> List.map (fun index -> Soc.Index(lp, index, lic_to_data_type t)) index_list) lpl)
)
(*********************************************************************************)
@@ -252,7 +251,7 @@ let build_step: Lxm.t -> string -> Lic.node_exp -> Soc.var list ->
let (lic_to_soc_var : Lic.var_info -> Soc.var) =
fun vi ->
- vi.Lic.var_name_eff, lic_to_soc_type vi.Lic.var_type_eff
+ vi.Lic.var_name_eff, lic_to_data_type vi.Lic.var_type_eff
let soc_profile_of_node: Lic.node_exp -> Soc.var list * Soc.var list =
fun n ->
@@ -260,7 +259,7 @@ let soc_profile_of_node: Lic.node_exp -> Soc.var list * Soc.var list =
let outputs = List.map lic_to_soc_var n.Lic.outlist_eff in
inputs, outputs
-let (make_soc_key_of_node_exp : Lic.node_key -> Soc.var_type list -> Soc.key) =
+let (make_soc_key_of_node_exp : Lic.node_key -> Data.t list -> Soc.key) =
fun nk vl ->
LicDump.string_of_node_key_rec nk, vl, None
@@ -289,18 +288,18 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
let type_ = (List.hd type_) in
let translation =
match is_predefined_const name with
- | Some type_ -> Soc.Const(name, lic_to_soc_type type_)
- | None -> Soc.Var(rename_user_var name, lic_to_soc_type type_)
+ | Some type_ -> Soc.Const(name, lic_to_data_type type_)
+ | None -> Soc.Var(rename_user_var name, lic_to_data_type type_)
in
translation
| CONST_REF l -> (
- let type_ = lic_to_soc_type (List.hd type_) in
+ let type_ = lic_to_data_type (List.hd type_) in
Soc.Const(Ident.string_of_long l, type_)
)
- | CONST (Bool_const_eff true) -> Soc.Const("true", Soc.Bool)
- | CONST (Bool_const_eff false) -> Soc.Const("false", Soc.Bool)
- | CONST (Int_const_eff i) -> Soc.Const(i, Soc.Int)
- | CONST (Real_const_eff str) -> Soc.Const(str, Soc.Real)
+ | CONST (Bool_const_eff true) -> Soc.Const("true", Data.Bool)
+ | CONST (Bool_const_eff false) -> Soc.Const("false", Data.Bool)
+ | CONST (Int_const_eff i) -> Soc.Const(i, Data.Int)
+ | CONST (Real_const_eff str) -> Soc.Const(str, Data.Real)
| CONST Extern_const_eff _ -> assert false
| CONST Abstract_const_eff _ -> assert false
| CONST Enum_const_eff _ -> assert false
@@ -310,7 +309,7 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
| STRUCT_ACCESS(field) -> (
let expr = match val_exp_list with [e] -> e | _ -> assert false in
- let type_ = match type_ with [t] -> lic_to_soc_type t | _ -> assert false in
+ let type_ = match type_ with [t] -> lic_to_data_type t | _ -> assert false in
let filter_expr = match get_leaf licprg expr with
| Some [f] -> f
| None -> assert false
@@ -320,7 +319,7 @@ let rec (val_exp_to_filter: LicPrg.t -> Lic.val_exp -> Soc.var_expr) =
)
| ARRAY_ACCES i -> (
let expr = match val_exp_list with [e] -> e | _ -> assert false in
- let type_ = lic_to_soc_type (List.hd type_) in
+ let type_ = lic_to_data_type (List.hd type_) in
let filter_expr = match get_leaf licprg expr with
| Some [f] -> f
| None -> assert false
@@ -430,8 +429,8 @@ let by_pos_op_to_soc_ident = function
| _ -> assert false
-let (get_exp_type : Soc.var_expr list -> Soc.var_type list) =
- List.map Soc.var_type_of_var_expr
+let (get_exp_type : Soc.var_expr list -> Data.t list) =
+ List.map Soc.data_type_of_var_expr
let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
Lic.clock -> Soc.var_expr list -> e2a_acc -> Lic.val_exp -> e2a_acc) =
@@ -453,7 +452,7 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
let filter_to_field filter field ftype =
let ftype = match ftype with [x] -> x | _ -> assert false in
let filter = match filter with [x] -> x | _ -> assert false in
- Soc.Field(filter, field, lic_to_soc_type ftype)
+ Soc.Field(filter, field, lic_to_data_type ftype)
in
let actions =
List.map
@@ -495,8 +494,8 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
(* retreive the soc of "expr" in soc_tbl *)
let id = by_pos_op_to_soc_ident by_pos_op_flg.it in
let soc : Soc.t =
- let args_types : Soc.var_type list =
- List.map lic_to_soc_type
+ let args_types : Data.t list =
+ List.map lic_to_data_type
(List.flatten (List.map (fun ve -> ve.ve_typ) val_exp_list))
in
let res_type = get_exp_type lpl in
@@ -524,8 +523,8 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
)
| Merge(mclk, cl) -> (
let soc : Soc.t =
- let (args_types : Soc.var_type list) =
- List.map lic_to_soc_type
+ let (args_types : Data.t list) =
+ List.map lic_to_data_type
(List.flatten (List.map (fun (_,ve) -> ve.ve_typ) cl))
in
let res_type = get_exp_type lpl in
@@ -719,7 +718,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
and (soc_of_node: LicPrg.t -> Lic.node_exp -> Soc.tbl -> (ctx * Soc.t * Soc.tbl) option) =
fun licprg node soc_tbl ->
let io_list = node.Lic.inlist_eff @ node.Lic.outlist_eff in
- let io_type = List.map (fun vi -> lic_to_soc_type vi.var_type_eff) io_list in
+ let io_type = List.map (fun vi -> lic_to_data_type vi.var_type_eff) io_list in
let soc_key = make_soc_key_of_node_exp node.Lic.node_key_eff io_type in
let lxm = node.Lic.lxm in
let ctx = create_context licprg in
@@ -736,7 +735,7 @@ let rec f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
b.eqs_eff
in
(* Construction des dépendances entre les expressions *)
- let all_deps = ActionsDeps.build_data_deps_from_actions lic_to_soc_type deps actions in
+ let all_deps = ActionsDeps.build_data_deps_from_actions lic_to_data_type deps actions in
Verbose.exe ~flag:dbg
(fun () -> print_string (ActionsDeps.to_string all_deps); flush stdout);
let actions =
diff --git a/src/lic2soc.mli b/src/lic2soc.mli
index 74705332..c08eed8a 100644
--- a/src/lic2soc.mli
+++ b/src/lic2soc.mli
@@ -1,7 +1,7 @@
-(** Time-stamp: <modified the 02/04/2013 (at 15:46) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2013 (at 14:12) by Erwan Jahier> *)
val f: LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl
val user_var_prefix:string
-val lic_to_soc_type: Lic.type_ -> Soc.var_type
+val lic_to_data_type: Lic.type_ -> Data.t
diff --git a/src/rif_base.ml b/src/rif_base.ml
new file mode 100644
index 00000000..ebc39d42
--- /dev/null
+++ b/src/rif_base.ml
@@ -0,0 +1,326 @@
+(*-----------------------------------------------------------------------
+** Copyright (C) - Verimag.
+** This file may only be copied under the terms of the GNU Library General
+** Public License
+**-----------------------------------------------------------------------
+**
+** File: rif.ml
+** Author: jahier@imag.fr
+*)
+
+
+open List
+
+let lexer = Genlex.make_lexer ["q"; "#"; "x"; "load_luc"; "#@"; "@#"]
+
+(* xxx Which pragmas should be defined ? *)
+
+let rif_pragmas = ["inputs"]
+(* let rif_pragmas = ["outs";"outputs";"program";"inputs";"step";"reset"] *)
+
+
+type stream = Genlex.token Stream.t
+
+let rec (parse_string_list : stream -> string list -> string list) =
+ fun stream sl ->
+ try (
+ match (Stream.next stream) with
+ (Genlex.String(_, str)) -> parse_string_list stream (str::sl)
+ | _ -> failwith ("### rif parse error. A \"string\" (wrapped with double" ^
+ "quotes) was expected. \n")
+ )
+ with Stream.Failure ->
+ sl
+
+open Data
+
+(*------------------------------------------------------------------------*)
+
+let debug = false
+let read_line label ic oc =
+ let str = input_line ic in
+ let _ = if debug then (print_string (label^ "read_line:"^str^"\n"); flush stdout) in
+ let str = Str.global_replace (Str.regexp "\013") "" str in
+ (match oc with
+ | Some oc -> output_string oc str; flush oc
+ | None -> ());
+ str
+
+let get_stream ic oc =
+ try lexer (Stream.of_string (read_line "" ic oc))
+ with e ->
+ print_string ("*** Error when parsing RIF: " ^ (Printexc.to_string e) ^ "\n");
+ flush stdout;
+ exit 2
+
+
+let (rm_blank : string -> string) =
+ fun s ->
+ let buff = ref "" in
+ for i = 0 to String.length s - 1 do
+ match s.[i] with
+ | ' ' | '\t' | '\n' | '\"' -> ()
+ | c -> buff:=!buff^(String.make 1 c)
+ done;
+ !buff
+
+let (to_pair : string -> string * string) =
+ fun s ->
+ match Str.split (Str.regexp ":") s with
+ | [n;t] -> rm_blank n, rm_blank t
+ | _ -> failwith ("Rif internal error: Cannot split '"^s^"'. It should contain exactly one ':'")
+
+
+let _ = assert (to_pair "T:bool" = ("T","bool"))
+
+
+let rec (read_until_pragma_end : in_channel -> out_channel option -> string -> string) =
+ fun ic oc str ->
+ let line = read_line "" ic oc in
+ try
+ let i = Str.search_forward (Str.regexp "#@") line 0 in
+ (
+ String.sub line 0 i) ^ str
+ with Not_found ->
+ (* let _ = print_string ("read_until_pragma_end done: '"^str^"'\n"); flush stdout in *)
+
+(* let _ = print_string ("read_until_pragma_end adding: "^line^"\n"); flush stdout in *)
+ read_until_pragma_end ic oc (str^" "^line)
+
+(* exported *)
+let rec (read_interface : string -> in_channel -> out_channel option ->
+ (string * string) list * (string * string) list) =
+ fun label ic oc ->
+(* let _ = print_string ("read_interface\n"); flush stdout in *)
+ let rec loop ins outs =
+ if ins <> [] && outs <> [] then ins, outs else
+ let line = read_line label ic oc in
+ try
+ if Str.string_match (Str.regexp "#inputs") line 0 then
+ let str = String.sub line 7 (String.length line - 7) in
+ let l = Str.split (Str.regexp " ") str in
+ let l = List.filter (fun str -> str <> "") l in
+ loop (List.map to_pair l) outs
+
+ else if Str.string_match (Str.regexp "@#inputs") line 0 then
+ let str = String.sub line 8 (String.length line - 8) in
+ let str = read_until_pragma_end ic oc str in
+ let l = Str.split (Str.regexp " ") str in
+ let l = List.filter (fun str -> str <> "") l in
+ loop (List.map to_pair l) outs
+
+ else if Str.string_match (Str.regexp "#outputs") line 0 then
+ let str = String.sub line 8 (String.length line - 8) in
+ let l = Str.split (Str.regexp " ") str in
+ let l = List.filter (fun str -> str <> "") l in
+ loop ins (List.map to_pair l)
+
+ else if Str.string_match (Str.regexp "@#outputs") line 0 then
+ let str = String.sub line 9 (String.length line - 9) in
+ let str = read_until_pragma_end ic oc str in
+ let l = Str.split (Str.regexp " ") str in
+ let l = List.filter (fun str -> str <> "") l in
+ loop ins (List.map to_pair l)
+ else
+ loop ins outs
+ with _ ->
+ print_string "*** Error when parsing socket content: I was expecting #inputs/#outputs\n";
+ print_string ("*** And I've read '" ^ line ^"'\n");
+ flush stdout;
+ loop ins outs
+ in
+ loop [] []
+
+exception Bye
+
+(* exported *)
+let rec (read : ?pragma:(string list) -> in_channel -> out_channel option -> vntl -> subst list) =
+ fun ?(pragma = []) ic oc vntl ->
+ (** Reads input values on ic. It should follow the rif format. *)
+ let tbl = [] in
+ if vntl = [] then tbl else
+ let stream = get_stream ic oc in
+ parse_rif_stream ic oc vntl stream tbl pragma
+
+and (parse_rif_stream : in_channel -> out_channel option -> vntl -> stream ->
+ subst list -> string list -> subst list) =
+ fun ic oc vntl stream tbl pragma ->
+ if vntl = [] then tbl else
+ let tok_list = Stream.npeek 2 stream in
+ match tok_list with
+ | [Genlex.Kwd (_,"#"); Genlex.Ident (_,id)] ->
+ if List.mem id pragma then (
+ Stream.junk stream ;
+ Stream.junk stream ;
+ parse_rif_stream ic oc vntl stream tbl pragma
+ ) else (
+ (* We skip everything that occurs after a [#], until the next eol. *)
+ Stream.junk stream ;
+ parse_rif_stream ic oc
+ vntl (get_stream ic oc) tbl pragma
+ )
+ | (Genlex.Kwd (_,"#"))::_ ->
+ Stream.junk stream ;
+ parse_rif_stream ic oc vntl (get_stream ic oc)
+ tbl pragma
+ | (Genlex.Kwd (_,"q"))::_ -> print_string "# bye!\n"; raise Bye
+ | (Genlex.Kwd (_,"#@"))::_ ->
+ (* Beginning of multi-line comment. Note that here,
+ unlike the rif format, we ignore multi line pragmas;
+ namely, we handle them as a multi-line comment. *)
+ (
+ Stream.junk stream ;
+ ignore_toks_until_end_of_pragmas ic oc vntl stream tbl pragma
+ )
+ | (Genlex.Float (_,f))::_ ->
+ (
+ Stream.junk stream ;
+ (* Hashtbl.add tbl (Var.name (hd vntl)) (N(F(f))) ; *)
+ let v =
+ match snd (hd vntl) with
+ | "bool" -> B(f<>0.0)
+ | "real" -> F(f)
+ | "int" ->
+ let i = int_of_float f in
+ print_string "\n*** Warning: type error, ";
+ print_string ((string_of_float f)
+ ^ " is an real, but an int is expected. I convert it to '"^
+ (string_of_int i)^"'\n");
+ I(i)
+ | e ->
+ print_string ("\n*** Error: unknown type: "^ e ^ "\n");
+ assert false
+ in
+ let tbl = tbl@ [fst (hd vntl), v] in
+ parse_rif_stream ic oc (tl vntl) stream tbl pragma
+ )
+ | (Genlex.Int (_,i))::_ -> (
+ Stream.junk stream ;
+ let v =
+ match snd (hd vntl) with
+ | "bool" -> B(i<>0)
+ | "int" -> I(i)
+ | "real" ->
+ let f = float_of_int i in
+ print_string "\n*** Warning: type error, ";
+ print_string ((string_of_int i)
+ ^ " is an int, but a real is expected. I convert it to '"^
+ (string_of_float f)^"'\n");
+ F(f)
+ | e ->
+ print_string ("\n*** Error: unknown type: "^ e ^ "\n");
+ assert false
+ in
+ let tbl = tbl @[fst (hd vntl), v] in
+ parse_rif_stream ic oc (tl vntl) stream tbl pragma
+ )
+ | (Genlex.Ident (_,b))::_ -> (
+ Stream.junk stream ;
+ let v = if mem b ["f"; "F";"false"] then B(false)
+ else if mem b ["t"; "T";"true"] then B(true)
+ else failwith ("### rif parse error: `" ^ b ^ "' read, where a bool was expected.\n")
+ in
+ let tbl = tbl @ [fst (hd vntl), v] in
+ parse_rif_stream ic oc (tl vntl) stream tbl pragma
+ )
+ | [] ->
+ (* Eol is is reached; proceed with the next one *)
+ parse_rif_stream ic oc vntl (get_stream ic oc)
+ tbl pragma
+ | _ -> failwith ("### rif parse error: not in RIF format.\n")
+
+and (ignore_toks_until_end_of_pragmas :
+ in_channel -> out_channel option-> vntl -> stream -> subst list -> string list -> subst list) =
+ fun ic oc vntl stream tbl pragma ->
+ (* ignore all tokens until "@#" is reached *)
+ let tok_opt = Stream.peek stream in
+ match tok_opt with
+ | Some(Genlex.Kwd (_,"@#")) ->
+ (
+ Stream.junk stream ;
+ parse_rif_stream ic oc vntl stream tbl pragma
+ )
+ | Some(_) ->
+ (
+ Stream.junk stream ;
+ ignore_toks_until_end_of_pragmas ic oc vntl stream tbl pragma
+ )
+ | None ->
+ (* Eol is is reached; proceed with the next one *)
+ (ignore_toks_until_end_of_pragmas ic oc vntl
+ (get_stream ic oc) tbl pragma)
+
+
+
+
+(*------------------------------------------------------------------------*)
+(* exported *)
+let (write : out_channel -> string -> unit) =
+ fun oc str ->
+ output_string oc str
+
+let (flush : out_channel -> unit) =
+ fun oc ->
+ flush oc
+
+(*------------------------------------------------------------------------*)
+(* exported *)
+let (write_interface : out_channel -> vntl -> vntl -> vntl option -> vntl option -> unit) =
+ fun oc in_vars out_vars loc_vars_opt oracle_vars_opt ->
+ let str =
+ (List.fold_left
+ (fun acc (vn,vt) ->
+ acc ^ "\"" ^ vn ^ "\":" ^ vt ^ " ")
+ "#inputs "
+ in_vars) ^
+
+ "\n#outputs " ^
+
+ (List.fold_left
+ (fun acc (vn,vt) ->
+ acc ^ "\"" ^ vn ^ "\":" ^ vt ^ " ")
+ ""
+ out_vars) ^
+
+ (match loc_vars_opt with
+ | None -> "\n"
+ | Some loc_vars ->
+ ((List.fold_left
+ (fun acc (vn,vt) ->
+ acc^"\"" ^ vn ^ "\":" ^ vt ^ " ")
+ "\n#locals "
+ loc_vars
+ ) ^ "\n")
+ )
+ ^
+ (match oracle_vars_opt with
+ | None -> ""
+ | Some vars ->
+ ((List.fold_left
+ (fun acc (vn,vt) ->
+ acc^"\"" ^ vn ^ "\":" ^ vt ^ " ")
+ "#oracle_outputs "
+ vars
+ ) ^ "\n")
+ )
+ in
+ write oc str
+
+(*------------------------------------------------------------------------*)
+(* exported *)
+let (write_outputs : out_channel -> vntl -> subst list -> unit) =
+ fun oc vntl sl ->
+ let str =
+ List.fold_left
+ (fun acc (vn,vt) ->
+ acc^ (try Data.val_to_string (List.assoc vn sl)
+ with Not_found ->
+ print_string ("*** " ^ vn ^ " not found in ");
+ print_string (String.concat "," (List.map (fun (n,_) -> n) sl));
+ flush stdout;
+ assert false) ^ " "
+ )
+ ""
+ vntl
+ in
+ output_string oc str
diff --git a/src/rif_base.mli b/src/rif_base.mli
new file mode 100644
index 00000000..92f18c55
--- /dev/null
+++ b/src/rif_base.mli
@@ -0,0 +1,42 @@
+(*-----------------------------------------------------------------------
+** Copyright (C) - Verimag.
+** This file may only be copied under the terms of the GNU Library General
+** Public License
+**-----------------------------------------------------------------------
+**
+** File: rif.ml
+** Author: jahier@imag.fr
+*)
+
+
+(** RIF (Reactive Input Format) utilities *)
+
+
+
+(** [read_interface label ic oc_opt] reads the IO names and types on ic. The string
+read on ic should looks like :
+ #inputs v1:t1 v2:t2 ...
+ #outputs x1:tx1 ...
+ #step
+
+ [label] is a string used in debug mode to hint who is calling.
+
+ *)
+val read_interface : string -> in_channel -> out_channel option -> (string * string) list * (string * string) list
+
+exception Bye
+
+(** Reads the input values. raises Bye if a line equal to "q" is read. *)
+val read : ?pragma:(string list) -> in_channel -> out_channel option -> Data.vntl -> Data.subst list
+
+val write : out_channel -> string -> unit
+
+(** [write_outputs oc outputs ] writes the Lucky outputs *)
+val write_outputs : out_channel -> Data.vntl -> Data.subst list -> unit
+
+(** [write_interface oc in_vars_ out_vars loc_vars oracle_vars] writes the input
+ and output var names and types *)
+val write_interface : out_channel -> Data.vntl -> Data.vntl -> Data.vntl option ->
+ Data.vntl option -> unit
+
+val flush : out_channel -> unit
diff --git a/src/soc.ml b/src/soc.ml
index 589d38d4..f7d63431 100644
--- a/src/soc.ml
+++ b/src/soc.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/04/2013 (at 13:25) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 14:10) by Erwan Jahier> *)
(** Synchronous Object Component *)
@@ -8,19 +8,11 @@
*)
type ident = string
-type var_type =
- | Bool | Int | Real
- | Extern of ident
- | Enum of (ident * ident list)
- | Struct of ident * (ident * var_type) list
- | Array of (var_type * int)
- | Alpha of int
-
-type var = ident * var_type
+type var = ident * Data.t
type key =
ident *
- var_type list * (* I/O type list *)
+ Data.t list * (* I/O type list *)
(int * int * int) option (* to deal with slices (unused FTTB) *)
type instance = ident * key
@@ -29,10 +21,10 @@ type instance = ident * key
type var_expr =
| Var of var
| Const of var (* useful? *)
- | Field of var_expr * ident * var_type
- | Index of var_expr * int * var_type
+ | Field of var_expr * ident * Data.t
+ | Index of var_expr * int * Data.t
-let (var_type_of_var_expr : var_expr -> var_type) =
+let (data_type_of_var_expr : var_expr -> Data.t) =
function
| Var(_,vt)
| Const(_,vt)
@@ -87,7 +79,7 @@ type t = {
step : step_method list; (* the order in the list is a valid w.r.t.
the partial order defined in precedences *)
precedences : precedence list; (* partial order over step methods *)
- have_mem : (var_type * var_expr option) option;
+ have_mem : (Data.t * var_expr option) option;
(* Do this soc have a memory (pre, fby) + its type + default value *)
}
diff --git a/src/socExec.ml b/src/socExec.ml
index edf1e629..05c74cf6 100644
--- a/src/socExec.ml
+++ b/src/socExec.ml
@@ -1,6 +1,7 @@
-(* Time-stamp: <modified the 08/04/2013 (at 10:36) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 14:58) by Erwan Jahier> *)
open Soc
+open Data
open SocExecValue
let dbg = Some(Verbose.get_flag "exec")
@@ -198,14 +199,14 @@ and expand_var var = match var with
| (vn,Extern id) -> assert false (* finish me! *)
| (vn,Alpha _) -> assert false (* should not occur *)
-let (int_to_enum : SocExecValue.t -> Soc.ident list -> SocExecValue.t) =
+let (int_to_enum : Data.v -> Soc.ident list -> Data.v) =
fun v el ->
match v with
| I i -> (try E (List.nth el i,i) with _ ->
failwith ("Enum out of the range [0,"^(string_of_int (List.length el))^"]"))
| _ -> assert false (* should not occur *)
-let rec (expand_subst: Rif_base.subst -> Rif_base.subst list) =
+let rec (expand_subst: Data.subst -> Data.subst list) =
fun s ->
let rec aux acc (n,v) =
match v with
@@ -226,7 +227,7 @@ let rec (expand_subst: Rif_base.subst -> Rif_base.subst list) =
aux [] s
(* A local shortcut to ease the profile def *)
-type sl = Rif_base.subst list
+type sl = Data.subst list
(* Reconstruct the flattenned data *)
let (unexpand : sl -> Soc.var list -> sl) =
@@ -265,8 +266,7 @@ let (unexpand : sl -> Soc.var list -> sl) =
| _, (vn,Alpha _ )::_ -> assert false (* should not occur *)
| [],_::_ -> assert false (* should not occur *)
- and (aux_field : sl * (ident * SocExecValue.t) list -> ident * var_type
- -> sl * (ident * SocExecValue.t) list ) =
+ and (aux_field : sl * (ident * Data.v) list -> ident * Data.t -> sl * (ident * Data.v) list ) =
fun (sl_todo, fl) (fn, t) ->
let new_sl_done, sl_todo = aux [] sl_todo [fn,t] in
let (_,v) = List.hd new_sl_done in
@@ -281,7 +281,7 @@ let (read_soc_input : Soc.t -> out_channel -> substs -> substs) =
fun soc oc ctx_s ->
let profile = expand_profile (fst soc.profile) in
let vntl = List.map (fun (x,t) -> x,SocUtils.string_of_type_ref t) profile in
- let s:Rif_base.subst list = Rif_base.read stdin (Some oc) vntl in
+ let s:Data.subst list = Rif_base.read stdin (Some oc) vntl in
let s = unexpand s (fst soc.profile) in
List.fold_left (fun acc (id,v) -> sadd acc [id] v) ctx_s s
diff --git a/src/socExecEvalPredef.ml b/src/socExecEvalPredef.ml
index 552bc9fd..40c2d018 100644
--- a/src/socExecEvalPredef.ml
+++ b/src/socExecEvalPredef.ml
@@ -1,6 +1,7 @@
-(* Time-stamp: <modified the 08/04/2013 (at 10:36) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 14:48) by Erwan Jahier> *)
open SocExecValue
+open Data
open Soc
(* A boring but simple module... *)
@@ -212,7 +213,7 @@ let make_names str start stop =
let lustre_array tl ctx =
let t,size = match List.hd (List.rev tl) with
- | Soc.Array(t,i) -> t,i
+ | Data.Array(t,i) -> t,i
| _ -> assert false
in
let inames = make_names "x" 1 size in
@@ -259,7 +260,7 @@ let lustre_arrow ctx =
let lustre_hat tl ctx =
let i = match tl with
- | [_;Soc.Array(_,i)] -> i
+ | [_;Data.Array(_,i)] -> i
| _ -> assert false
in
let (vn,vv) =
diff --git a/src/socExecValue.ml b/src/socExecValue.ml
index 82dd6130..5aea8e33 100644
--- a/src/socExecValue.ml
+++ b/src/socExecValue.ml
@@ -1,11 +1,9 @@
-(* Time-stamp: <modified the 08/04/2013 (at 13:24) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 14:45) by Erwan Jahier> *)
let dbg = Some(Verbose.get_flag "exec")
open Soc
-
-type t = I of int | F of float | B of bool | E of Soc.ident * int
- | A of t array | S of (Soc.ident * t) list | U
+open Data
(* Meant to represent paths in the call tree. Actually it both
represent path and variable with a path, depending on the
@@ -16,7 +14,7 @@ let (path_to_string: ident list -> string) =
fun l ->
String.concat "->" (List.rev l)
-type subst = (path * t)
+type subst = (path * Data.v)
(* soc environnement holding memory values.
@@ -29,7 +27,7 @@ type subst = (path * t)
(* type substs = subst list *)
type substs =
| Node of (ident * substs) list
- | Leaf of t
+ | Leaf of v
type ctx = {
cpath: path;
@@ -37,7 +35,7 @@ type ctx = {
}
(**************************************************************************)
-let rec (get_top_var_type : Soc.var_expr -> Soc.var_type) =
+let rec (get_top_var_type : Soc.var_expr -> Data.t) =
fun ve ->
match ve with
| Var(_,vt) -> vt
@@ -45,9 +43,9 @@ let rec (get_top_var_type : Soc.var_expr -> Soc.var_type) =
| Field(ve, _, _) -> get_top_var_type ve
| Const(id,_) -> assert false
-type access = Idx of int | Fld of ident
-let rec (get_access : Soc.var_expr -> access list) =
+open Data
+let rec (get_access : Soc.var_expr -> Data.access list) =
fun ve ->
match ve with
| Var(id,_) -> []
@@ -55,55 +53,29 @@ let rec (get_access : Soc.var_expr -> access list) =
| Field(ve, n,_) -> (Fld n)::(get_access ve)
| Const(id,_) -> assert false
-(* Replace access(pre_v) by v in pre_v *)
-let rec (update_val : t -> t -> access list -> t) =
- fun pre_v v access ->
- match pre_v,access with
- | _,[] -> v
- | A a, (Idx i)::access ->
- let a_i = update_val a.(i) v access in
- a.(i) <- a_i;
- A a
- | S(fl), (Fld fn)::access ->
- S (List.map
- (fun (fn2,v2) -> if fn=fn2 then fn,update_val v2 v access else (fn2,v2))
- fl)
- | _,_ -> assert false (* finish me (field struct) *)
-
-let (update_leaf : var_expr -> t -> t -> substs) =
+
+let (update_leaf : var_expr -> v -> v -> substs) =
fun ve v pre_v ->
let access = get_access ve in
let new_v = update_val pre_v v access in
Leaf(new_v)
-(* The same as update in the case where no previous value exists *)
-let rec (create_val : Soc.var_type -> t -> access list -> t) =
- fun vt v access ->
- match vt,access with
- | _,[] -> v
- | Array(vt,size), (Idx i)::access ->
- let a = Array.make size U in
- let a_i = create_val vt v access in
- a.(i) <- a_i;
- A a
- | Struct(sn,fl), (Fld fn)::access ->
- S(List.map (fun (fn2,vt2) -> if fn=fn2 then fn,create_val vt2 v access else fn2,U) fl)
- | _,_ -> assert false
-
-let (create_leaf : var_expr -> t -> substs) =
+let (create_leaf : var_expr -> v -> substs) =
fun ve v ->
let access = get_access ve in
let top_vt = get_top_var_type ve in
let new_v = create_val top_vt v access in
Leaf(new_v)
+
+
let rec (get_top_id : Soc.var_expr -> ident) =
function
| Var(id,_) | Const(id,_) -> id
| Field(ve, _, _) | Index(ve,_,_) -> get_top_id ve
(* exported *)
-let (sadd_partial : substs -> var_expr -> path -> t -> substs) =
+let (sadd_partial : substs -> var_expr -> path -> Data.v -> substs) =
fun ct ve x v ->
let top_id = get_top_id ve in
let x = top_id::x in
@@ -130,7 +102,7 @@ let (sadd_partial : substs -> var_expr -> path -> t -> substs) =
(* (x,v)::(List.remove_assoc x ct) *)
(* exported *)
-let (sadd : substs -> path -> t -> substs) =
+let (sadd : substs -> path -> Data.v -> substs) =
fun ct x v ->
let rec aux ct (x,v) =
match ct,x with
@@ -161,7 +133,7 @@ let (sadd : substs -> path -> t -> substs) =
(* [] *)
(* s *)
-let (filter_top_subst : substs -> (Soc.ident * t) list) =
+let (filter_top_subst : substs -> (Soc.ident * Data.v) list) =
fun s ->
let rec aux acc (id, s) =
match s with
@@ -172,27 +144,13 @@ let (filter_top_subst : substs -> (Soc.ident * t) list) =
Node(l) -> List.fold_left aux [] l
| _ -> assert false
-let rec (to_string : t -> string) =
- function
- | I i -> string_of_int i
- | F f -> string_of_float f
- | B true -> "t"
- | B false -> "f"
- | E (e,_) -> e
- | S fl -> String.concat " " (List.map (fun (fn,fv) -> to_string fv) fl)
- | A a ->
- let str = ref "" in
- let f i a = str := !str ^ " " ^ (to_string a) in
- Array.iteri f a;
- !str
- | U -> "not initialised"
-
-let (string_of_subst_list : (path * t) list -> string) =
+
+let (string_of_subst_list : (path * Data.v) list -> string) =
fun s ->
- let values = List.map (fun (var,value) -> (path_to_string var)^"="^(to_string value)) s in
+ let values = List.map (fun (var,value) -> (path_to_string var)^"="^(Data.val_to_string value)) s in
((String.concat "\n\t" values) ^ "\n")
-let (dump_subst_list : (path * t) list -> unit) =
+let (dump_subst_list : (path * Data.v) list -> unit) =
fun s ->
print_string (string_of_subst_list s);
flush stdout
@@ -201,7 +159,7 @@ let (dump_subst_list : (path * t) list -> unit) =
(* let (substs_to_list: substs -> (path * t) list) = *)
(* fun s -> s *)
-let (substs_to_list: substs -> (path * t) list) =
+let (substs_to_list: substs -> (path * Data.v) list) =
fun s ->
let rec aux acc s p =
match s with
@@ -230,7 +188,7 @@ let rec pos_in_list i x l =
| e::l -> if e=x then i else pos_in_list (i+1) x l
| [] -> assert false (* should not occur *)
-let (read_value : var -> t) =
+let (read_value : var -> Data.v) =
fun (_,t) ->
match t with
| Bool -> print_string "Enter a bool (t/f):";flush stdout; B(read_line () = "t")
@@ -252,7 +210,7 @@ let (read_value : var -> t) =
(* print_string msg; flush stdout; *)
(* assert false *)
-let (get_val : ident -> ctx -> t) =
+let (get_val : ident -> ctx -> Data.v) =
fun id ctx ->
let rec find ct p =
match ct,p with
@@ -278,7 +236,7 @@ fun id ctx ->
| B false -> "false"
| o -> assert false (* should not fail *)
-let rec (get_value : ctx -> var_expr -> t) =
+let rec (get_value : ctx -> var_expr -> Data.v) =
fun ctx v ->
match v with
| Var(id,_) -> get_val id ctx
diff --git a/src/socExecValue.mli b/src/socExecValue.mli
index 2c67252b..d839f340 100644
--- a/src/socExecValue.mli
+++ b/src/socExecValue.mli
@@ -1,14 +1,9 @@
-(* Time-stamp: <modified the 29/03/2013 (at 16:55) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 14:46) by Erwan Jahier> *)
(** Manipulating data in the Soc interpreter *)
-type t = | I of int | F of float | B of bool | E of Soc.ident * int
- | A of t array
- | S of (Soc.ident * t) list
- | U (* to set uninitialized mem *)
-
type path = Soc.ident list
-type subst = (path * t)
+type subst = (path * Data.v)
(* Not really a good name anymore. Memory ? *)
type substs
@@ -20,7 +15,7 @@ type substs
[sadd ct x v] updates updates ct by associating x to v in ct
*)
-val sadd : substs -> path -> t -> substs
+val sadd : substs -> path -> Data.v -> substs
(* [sadd_partial ct ve path v] updates ct by associating ve::path to v in ct ;
@@ -29,7 +24,7 @@ val sadd : substs -> path -> t -> substs
or a struct field, whereas sadd only updates variable.
*)
-val sadd_partial : substs -> Soc.var_expr -> path -> t -> substs
+val sadd_partial : substs -> Soc.var_expr -> path -> Data.v -> substs
type ctx = {
@@ -41,18 +36,17 @@ type ctx = {
val create_ctx : Soc.tbl -> Soc.t -> ctx
-val get_val : Soc.ident -> ctx -> t
-val get_value : ctx -> Soc.var_expr -> t
+val get_val : Soc.ident -> ctx -> Data.v
+val get_value : ctx -> Soc.var_expr -> Data.v
val get_enum : Soc.ident -> ctx -> Soc.ident
(* Pretty-printers *)
-val to_string : t -> string
val string_of_substs :substs -> string
(* RIF I/O *)
val dump_substs : substs -> unit
val read_enum : Soc.ident list -> Soc.ident
-val read_value : Soc.var -> t
+val read_value : Soc.var -> Data.v
(* if
args = [Var("x",Int); Const("3.14",Real) ]
@@ -70,4 +64,4 @@ val substitute_args_and_params : Soc.var_expr list -> Soc.var list -> ctx -> sub
val substitute_params_and_args : Soc.var list -> Soc.var_expr list -> ctx -> substs
(* Returns the top-level variable substitutions in a RIF format *)
-val filter_top_subst : substs -> (Soc.ident * t) list
+val filter_top_subst : substs -> (Soc.ident * Data.v) list
diff --git a/src/socPredef.ml b/src/socPredef.ml
index 07541162..5e3f9d4d 100644
--- a/src/socPredef.ml
+++ b/src/socPredef.ml
@@ -1,17 +1,17 @@
-(* Time-stamp: <modified the 08/04/2013 (at 11:56) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 14:11) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
let finish_me lxm
= print_string ("\nsocPref.ml:"^(Lxm.details lxm)^" -> finish me!\n")
-
open Soc
+open Data
(* Some aliases *)
-let b = Soc.Bool
-let i = Soc.Int
-let r = Soc.Real
+let b = Data.Bool
+let i = Data.Int
+let r = Data.Real
let aa t1 t2 = ["x", t1], ["z", t2]
let aaa t1 t2 t3 = ["x", t1; "y",t2], ["z", t3]
@@ -20,7 +20,7 @@ let aab t1 t2 = ["x", t1; "y",t2], ["z", Bool]
(* if/then/else *)
let baaa t = ["c", b; "xt", t; "xe", t], ["z", t]
-let (soc_profile_of_types : Soc.var_type list -> var list * var list) =
+let (soc_profile_of_types : Data.t list -> var list * var list) =
function
| [t1; t2] -> aa t1 t2
| [t1;t2;t3] -> aaa t1 t2 t3
@@ -32,7 +32,7 @@ let (soc_profile_of_types : Soc.var_type list -> var list * var list) =
assert false
(* For diese and nor *)
-let (soc_profile_of_types_nary : Soc.var_type list -> var list * var list) =
+let (soc_profile_of_types_nary : Data.t list -> var list * var list) =
fun vl ->
["x", Array(Bool,List.length vl)], ["z",Bool]
@@ -65,7 +65,7 @@ let make_soc key profile steps = {
let first_instant = Var("first_instant", Bool)
-let (get_mem_name : Soc.key -> var_type -> string) =
+let (get_mem_name : Soc.key -> Data.t -> string) =
fun (k,tl,_) vt ->
match Str.split (Str.regexp "::") k with
| ["Lustre";op] -> (
@@ -281,7 +281,7 @@ let of_soc_key : Soc.key -> Soc.t =
(** Instancie un composant polymorphe avec un type concret. *)
-let instanciate_soc: Soc.t -> Soc.var_type -> Soc.t =
+let instanciate_soc: Soc.t -> Data.t -> Soc.t =
fun c concrete_type ->
let rec instanciate_type vt =
match vt with
@@ -331,14 +331,14 @@ let instanciate_soc: Soc.t -> Soc.var_type -> Soc.t =
idem pour "x^n" (Hat_n).
*)
-let make_slice_soc: Lic.slice_info -> Soc.var_type -> Soc.t =
+let make_slice_soc: Lic.slice_info -> Data.t -> Soc.t =
fun si t ->
let (f,l,step) = (si.Lic.se_first, si.Lic.se_last,si.Lic.se_step) in
let sub_array_type =
match t with
- | Soc.Array(t_elt,size) ->
+ | Data.Array(t_elt,size) ->
let slice_size = 1+abs( (l - f) / step) in
- Soc.Array(t_elt, slice_size)
+ Data.Array(t_elt, slice_size)
| _ -> assert false
in
{
@@ -383,7 +383,7 @@ let (make_merge_soc: Soc.key -> Soc.t) =
Soc.precedences = [];
}
-let make_array_soc: int -> Soc.var_type -> Soc.t =
+let make_array_soc: int -> Data.t -> Soc.t =
fun i t ->
let iprof =
let res = ref [] in
@@ -411,7 +411,7 @@ let make_array_soc: int -> Soc.var_type -> Soc.t =
have_mem = None;
}
-let make_array_concat_soc: int -> int -> Soc.var_type -> Soc.t =
+let make_array_concat_soc: int -> int -> Data.t -> Soc.t =
fun s1 s2 t ->
let iprof = (["x", Array(t,s1); "y", Array(t,s2)], ["z", Array(t,s1+s2)])in
let key_prof = [Array(t,s1); Array(t,s2); Array(t,s1+s2)] in
@@ -432,12 +432,12 @@ let make_array_concat_soc: int -> int -> Soc.var_type -> Soc.t =
have_mem = None;
}
-let make_hat_soc: int -> Soc.var_type -> Soc.t =
+let make_hat_soc: int -> Data.t -> Soc.t =
fun i t ->
let array_type =
match t with
- | Soc.Alpha _ -> assert false
- | t -> Soc.Array(t,i)
+ | Data.Alpha _ -> assert false
+ | t -> Data.Array(t,i)
in
{
key = ("Lustre::hat", [t;array_type], None);
@@ -473,7 +473,7 @@ let output_type_of_op op tl =
| _ -> List.hd tl
let (soc_interface_of_pos_op:
- Lxm.t -> Lic.by_pos_op -> Soc.var_type list -> Soc.var_expr option -> Soc.t) =
+ Lxm.t -> Lic.by_pos_op -> Data.t list -> Soc.var_expr option -> Soc.t) =
fun lxm op types fby_init_opt ->
match (op, types,fby_init_opt) with
| Lic.PREDEF_CALL ({Lxm.it=("Lustre","if"),[]}),_ ,_ ->
diff --git a/src/socPredef.mli b/src/socPredef.mli
index cff5cd17..7584bdfc 100644
--- a/src/socPredef.mli
+++ b/src/socPredef.mli
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 08/04/2013 (at 11:48) by Erwan Jahier> *)
+(* Time-stamp: <modified the 08/04/2013 (at 14:11) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -11,8 +11,8 @@ val of_soc_key : Soc.key -> Soc.t
Le type des opérandes permet de traiter les opérateurs surchargés.
*)
val soc_interface_of_pos_op:
- Lxm.t -> Lic.by_pos_op -> Soc.var_type list -> Soc.var_expr option -> Soc.t
+ Lxm.t -> Lic.by_pos_op -> Data.t list -> Soc.var_expr option -> Soc.t
-val get_mem_name : Soc.key -> Soc.var_type -> string
+val get_mem_name : Soc.key -> Data.t -> string
val make_merge_soc: Soc.key -> Soc.t
diff --git a/src/socUtils.ml b/src/socUtils.ml
index e2610b96..5680c924 100644
--- a/src/socUtils.ml
+++ b/src/socUtils.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 05/04/2013 (at 14:24) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2013 (at 14:10) by Erwan Jahier> *)
open Soc
@@ -33,31 +33,11 @@ let call_fun_ff: ((Format.formatter -> unit) -> string) = fun f ->
s
(* Type *)
-let rec string_of_type_ref_ff: (Soc.var_type -> Format.formatter -> unit) = fun v ff ->
- let str =
- match v with
- | Soc.Bool -> "bool"
- | Soc.Int -> "int"
- | Soc.Real-> "real"
- | Soc.Extern s -> s ^ "(*extern*)"
- | Soc.Enum (s, sl) -> "enum " ^ s ^ " {" ^ (String.concat ", " sl) ^ "}"
- | Soc.Struct (sid,_) -> sid ^ "(*struct*)"
- | Soc.Array (ty, sz) -> Printf.sprintf "%s^%d" (string_of_type_ref ty) sz
- | Soc.Alpha nb ->
- (* On génère des "types" à la Caml : 'a, 'b, 'c, etc. *)
- let a_value = Char.code('a') in
- let z_value = Char.code('z') in
- let str =
- if (nb >= 0 && nb <= (z_value - a_value)) then
- ("'" ^ (Char.escaped (Char.chr(a_value + nb))))
- else
- ("'a" ^ (string_of_int nb))
- in
- str
- in
+let rec string_of_type_ref_ff: (Data.t -> Format.formatter -> unit) = fun v ff ->
+ let str = Data.type_to_string v in
fprintf ff "%s" str
-and string_of_type_ref: (Soc.var_type -> string) = fun v ->
+and string_of_type_ref: (Data.t -> string) = fun v ->
call_fun_ff (string_of_type_ref_ff v)
diff --git a/src/socUtils.mli b/src/socUtils.mli
index 74c139d7..d0451de5 100644
--- a/src/socUtils.mli
+++ b/src/socUtils.mli
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 29/03/2013 (at 16:06) by Erwan Jahier> *)
+(** Time-stamp: <modified the 08/04/2013 (at 14:10) by Erwan Jahier> *)
(** Donne toute les méthodes d'un composant. *)
@@ -6,7 +6,7 @@ val get_all_methods: Soc.t -> Soc.step_method list
(** Fonctions de représentation des objets SOC. *)
-val string_of_type_ref : Soc.var_type -> string
+val string_of_type_ref : Data.t -> string
val string_of_soc_key : Soc.key -> string
val string_of_var : Soc.var -> string
val string_of_operation : Soc.atomic_operation -> string
@@ -20,7 +20,7 @@ val string_of_profile : Soc.var list * Soc.var list -> string
val string_interface_of_soc : Soc.t -> string
val string_of_soc : Soc.t -> string
-val string_of_type_ref_ff : Soc.var_type -> Format.formatter -> unit
+val string_of_type_ref_ff : Data.t -> Format.formatter -> unit
val string_of_soc_key_ff : Soc.key -> Format.formatter -> unit
val string_of_var_ff : Soc.var -> Format.formatter -> unit
val string_of_operation_ff : Soc.atomic_operation -> Format.formatter -> unit
diff --git a/test/Makefile.dist b/test/Makefile.dist
new file mode 100644
index 00000000..c3cff9b0
--- /dev/null
+++ b/test/Makefile.dist
@@ -0,0 +1,17 @@
+test: lus2lic ec2c runtest
+
+testdir=$(shell pwd)
+
+runtest:
+ runtest --all --tool lus2lic || true
+
+lus2lic:
+ ln -s ../bin/lus2lic
+
+# requires ec2c (distributed in the lv4 package)
+ec2c:
+ ln -s `which ec2c`
+
+
+
+
diff --git a/test/board_triglav.exp b/test/board_triglav.exp
new file mode 100644
index 00000000..aa77000c
--- /dev/null
+++ b/test/board_triglav.exp
@@ -0,0 +1,4 @@
+# load_generic_config "unix";
+
+set_board_info hostname triglav
+set_board_info username jahier
diff --git a/test/lus2lic.sum b/test/lus2lic.sum
index e3dec3af..f659e889 100644
--- a/test/lus2lic.sum
+++ b/test/lus2lic.sum
@@ -1,4 +1,4 @@
-Test Run By jahier on Mon Apr 8 12:00:19 2013
+Test Run By jahier on Mon Apr 8 14:52:24 2013
Native configuration is i686-pc-linux-gnu
=== lus2lic tests ===
diff --git a/test/should_fail/type/merge.lus b/test/should_fail/type/merge.lus
new file mode 100644
index 00000000..b5e27e08
--- /dev/null
+++ b/test/should_fail/type/merge.lus
@@ -0,0 +1,11 @@
+type trival = enum { Pile, Face, Tranche }; ---
+node merge_node(clk: trival; ---
+ i1 : int when Pile(clk) ; i2 : int when Face(clk);
+ i3: int when Tranche(clk))
+returns (y: int); ---
+let
+ y = merge clk
+ (Pile: i1)
+ (Face: i2)
+ (Tranche: i3);
+tel
\ No newline at end of file
diff --git a/todo.org b/todo.org
index 98afb72c..91b587d3 100644
--- a/todo.org
+++ b/todo.org
@@ -2,6 +2,8 @@
#+CATEGORY: lv6
* lus2lic -exec
+** TODO revoir l'intégration à rif_base et genlex
+ - State "TODO" from "" [2013-03-19 Tue 10:25]
** TODO Unifier les modules Data de Lustre V6 et Lutin
- State "TODO" from "" [2013-04-02 Tue 08:33]
@@ -30,9 +32,6 @@ que de lancer luciole
** TODO Écrire un test qui mette en jeu exhaustivement tous les operateurs
- State "TODO" from "" [2013-03-19 Tue 10:38]
-
-** TODO slice
- - State "TODO" from "" [2013-04-05 Fri 11:18]
** TODO fonctions externes
- State "TODO" from "" [2013-03-19 Tue 10:33]
** TODO Découper un peu les fonctions dans src/lic2soc.ml
@@ -40,8 +39,6 @@ que de lancer luciole
le role et le perimetre get_leaf en particulier n'est pas clair.
de plus son code est dupliqué.
file:src/lic2soc.ml
-** TODO revoir l'intégration à rif_base et genlex
- - State "TODO" from "" [2013-03-19 Tue 10:25]
* Packages, modeles, etc.
** STARTED Il ne detecte plus les erreurs de type lors d'instanciation de noeuds
--
GitLab