/ - Diff - LustreC

       "div", DIV;
       "const", CONST;
       "assert", ASSERT;
       "in", IN;
       "lib", LIB;
       "prototype", PROTOTYPE;
+    ]

         Lexing.pos_cnum = 0;
+      }
     let symbol_rloc () = {
       loc_start = Parsing.symbol_start_pos ();
       loc_end = Parsing.symbol_end_pos ()
+    }
     let symbol_rloc () =
+      {
         loc_start = Parsing.symbol_start_pos ();
         loc_end = Parsing.symbol_end_pos ()
+      }
     open Format

           try
     	let basename = (if local then s else Version.prefix ^ "/include/lustrec/" ^ s ) ^ ".lusi" in
     	report ~level:1 (fun fmt -> fprintf fmt "@[<v 0>Library %s@," basename);
     	let comp_dep, lusi_type_env, lusi_clock_env = check_lusi (load_lusi false basename) in
     	  let comp_dep, lusi_type_env, lusi_clock_env = check_lusi (load_lusi false basename) in
     	report ~level:1 (fun fmt -> fprintf fmt "@]@ ");
     	(s, local, comp_dep)::compilation_dep,
     	Env.overwrite type_env lusi_type_env,
     	Env.overwrite clock_env lusi_clock_env
     	  (s, local, comp_dep)::compilation_dep,
     	  Env.overwrite type_env lusi_type_env,
     	  Env.overwrite clock_env lusi_clock_env
           with Sys_error msg -> (
     	Format.eprintf "Failure: impossible to load library %s.@.%s@." s msg;
     	exit 1
-...
         )  ([], Basic_library.type_env, Basic_library.clock_env) dependencies
       in
       report ~level:1 (fun fmt -> fprintf fmt "@]@ ");
       (* Unfold consts *)
       (*let prog = Corelang.prog_unfold_consts prog in*)
-...
           let _ = open_in lusi_name in
           let header = load_lusi true lusi_name in
           let _, declared_types_env, declared_clocks_env = check_lusi header in
           (* checking type compatibility with computed types*)
           Typing.check_env_compat header declared_types_env computed_types_env;
           Typing.uneval_prog_generics prog;
           (* checking clocks compatibility with computed clocks*)
           Clock_calculus.check_env_compat header declared_clocks_env computed_clocks_env;
           Clock_calculus.uneval_prog_generics prog;
           (* checking stateless status compatibility *)
           Stateless.check_compat header
         with Sys_error _ -> (

     let mkdim_appl f args = mkdim_appl (Location.symbol_rloc ()) f args
     let mkdim_ite i t e = mkdim_ite (Location.symbol_rloc ()) i t e
     let add_node own msg hashtbl name value =
     let add_node loc own msg hashtbl name value =
       try
         match (Hashtbl.find hashtbl name).top_decl_desc, value.top_decl_desc with
         | Node _        , ImportedNode _ when own
                             -> ()
         | ImportedNode _, _ ->
            Hashtbl.add hashtbl name value
         | Node _        , _ ->
            raise (Corelang.Error (Location.symbol_rloc (), Corelang.Already_bound_symbol msg))
         | _                 -> assert false
         | Node _        , ImportedNode _ when own   -> ()
         | ImportedNode _, _                         -> Hashtbl.add hashtbl name value
         | Node _        , _                         -> raise (Corelang.Error (loc, Corelang.Already_bound_symbol msg))
         | _                                         -> assert false
       with
         Not_found ->
            Hashtbl.add hashtbl name value
         Not_found                                   -> Hashtbl.add hashtbl name value
     let add_symbol msg hashtbl name value =
     let add_symbol loc msg hashtbl name value =
      if Hashtbl.mem hashtbl name
      then raise (Corelang.Error (Location.symbol_rloc (), Corelang.Already_bound_symbol msg))
      then raise (Corelang.Error (loc, Corelang.Already_bound_symbol msg))
      else Hashtbl.add hashtbl name value
     let check_symbol msg hashtbl name =
     let check_symbol loc msg hashtbl name =
      if not (Hashtbl.mem hashtbl name)
      then raise (Corelang.Error (Location.symbol_rloc (), Corelang.Unbound_symbol msg))
      then raise (Corelang.Error (loc, Corelang.Unbound_symbol msg))
      else ()
     %}
-...
     %token MULT DIV MOD
     %token MINUS PLUS UMINUS
     %token PRE ARROW
     %token PROTOTYPE IN
     %token PROTOTYPE LIB
     %token EOF
     %nonassoc COMMA
-...
     | NODE { false }
     top_decl_header:
     | CONST cdecl_list { fun _ -> mktop_decl (Consts (List.rev $2)) }
     | CONST cdecl_list { let top = mktop_decl (Consts (List.rev $2)) in fun _ -> top }
     | nodespec_list state_annot IDENT LPAR vdecl_list SCOL_opt RPAR RETURNS LPAR vdecl_list SCOL_opt RPAR  prototype_opt in_lib_opt SCOL
         {let nd = mktop_decl (ImportedNode
                                 {nodei_id = $3;
-...
     			     nodei_prototype = $13;
     			     nodei_in_lib = $14;})
         in
         (fun own -> add_node own ("node " ^ $3) node_table $3 nd; nd) }
         (let loc = Location.symbol_rloc () in
          fun own -> add_node loc own ("node " ^ $3) node_table $3 nd; nd) }
     prototype_opt:
      { None }
-...
     in_lib_opt:
     { None }
     | IN IDENT {Some $2}
     | LIB IDENT {Some $2}
     top_decl:
     | CONST cdecl_list { mktop_decl (Consts (List.rev $2)) }
-...
     			     node_stateless = None;
     			     node_spec = $1;
     			     node_annot = match annots with [] -> None | _ -> Some annots})
         in
         add_node true ("node " ^ $3) node_table $3 nd; nd}
          in
          let loc = Location.symbol_rloc () in
          add_node loc true ("node " ^ $3) node_table $3 nd; nd}
     nodespec_list:
      { None }
-...
     typ_def:
       TYPE IDENT EQ typeconst {
         try
           add_symbol ("type " ^ $2) type_table (Tydec_const $2) (Corelang.get_repr_type $4)
           let loc = Location.symbol_rloc () in
           add_symbol loc ("type " ^ $2) type_table (Tydec_const $2) (Corelang.get_repr_type $4)
         with Not_found-> assert false }
     | TYPE IDENT EQ ENUM LCUR tag_list RCUR { Hashtbl.add type_table (Tydec_const $2) (Tydec_enum ($6 (Tydec_const $2))) }
     | TYPE IDENT EQ STRUCT LCUR field_list RCUR { Hashtbl.add type_table (Tydec_const $2) (Tydec_struct ($6 (Tydec_const $2))) }
-...
     | TBOOL array_typ_decl { $2 Tydec_bool  }
     | TREAL array_typ_decl { $2 Tydec_real  }
     | TFLOAT array_typ_decl { $2 Tydec_float }
     | IDENT array_typ_decl { check_symbol ("type " ^ $1) type_table (Tydec_const $1); $2 (Tydec_const $1) }
     | IDENT array_typ_decl {
             let loc = Location.symbol_rloc () in
     	check_symbol loc ("type " ^ $1) type_table (Tydec_const $1); $2 (Tydec_const $1) }
     | TBOOL TCLOCK  { Tydec_clock Tydec_bool }
     | IDENT TCLOCK  { Tydec_clock (Tydec_const $1) }
     tag_list:
       IDENT
       { (fun t -> add_symbol ("tag " ^ $1) tag_table $1 t; $1 :: []) }
       { let loc = Location.symbol_rloc () in
         (fun t ->
           add_symbol loc ("tag " ^ $1) tag_table $1 t; $1 :: []) }
     | tag_list COMMA IDENT
       { (fun t -> add_symbol ("tag " ^ $3)tag_table $3 t; $3 :: ($1 t)) }
+          {
     	let loc = Location.symbol_rloc () in
     	(fun t -> add_symbol loc ("tag " ^ $3)tag_table $3 t; $3 :: ($1 t))
+          }
     field_list:
       { (fun t -> []) }
     | field_list IDENT COL typeconst SCOL
       { (fun t -> add_symbol ("field " ^ $2) field_table $2 t; ($1 t) @ [ ($2, $4) ]) }
+          {
     	let loc = Location.symbol_rloc () in
     	(fun t -> add_symbol loc ("field " ^ $2) field_table $2 t; ($1 t) @ [ ($2, $4) ]) }
     eq_list:
       { [], [], [] }
     | eq eq_list {let eql, assertl, annotl = $2 in ($1::eql), assertl, annotl}

Project

General

Profile

CristalCaveGem » LustreC

Revision 3826f8cb

Added by Pierre-Loïc Garoche over 9 years ago