Move

Makefile

@@ -1,15 +1,24 @@
-## Build the compiler and libraries
 all: zeluc.exe
 
+## Build the compiler and libraries
+## dune build src lib
+
 zeluc.exe:
-	(cd src; dune build -- zeluc.exe; dune build lib)
+	(cd src; dune build -- zeluc.exe);
+	dune build lib
 
 tests:
-	(cd tests; dune test)
+	dune test
 
 debug:
 	(cd src; dune build --debug-backtraces --debug-dependency-path -- zeluc.bc)
 
+opam-install: ## Install as an opam development package pinned to this directory
+	opam pin -k path .
+
+opam-uninstall: ## Remove opam pin
+	opam pin remove zelus zelus-gtk
+
 clean:
 	dune clean;
 	(cd tests/good/; rm -f *.zlo);
@@ -29,3 +38,12 @@ wc:
 	compiler/main/*.ml)
 
 .PHONY: zeluc.exe zeluc.exe zrun.exe zwrite.exe zrun.exe.verbose tests debug clean wc
+
+# Doc (for opam):
+# opam pin -k path .              : install the current version of the compiler
+#                                   as an opam package
+# opam pin --help
+
+# opam pin remove zelus zelus-gtk : removes the opam package
+# opam install zelus zelus-gtk : install the (public) opam package
+

dune

@@ -2,6 +2,6 @@
  (dev
   (flags (:standard -w -9-27-32-33-35 -warn-error -A))))
 
-; compile only zrunthe compiler; exclude examples
+; compile only the compiler; exclude examples
 ; (dirs :standard \ examples)
 

src/Makefile

@@ -1,6 +1,5 @@
 all:
 	dune build -- zeluc.exe
-	dune build lib
 
 debug:
 	dune build --debug-backtraces --debug-dependency-path -- zeluc.bc

src/compiler/rewrite/rewrite.ml

@@ -92,7 +92,7 @@ let set_steps w =
   List.iter
     (fun l -> set true (List.hd l); List.iter (fun s -> set false s) (List.tl l))
     l_l
-let rewrite_list =
+let rewrite_list () =
   List.filter (fun (w, _, _) -> S.mem w !s_set) default_list
 
 let compare name n_steps genv0 p p' =
@@ -114,4 +114,4 @@ let main print_message genv0 p n_steps =
 
   let iter genv p l = List.fold_left (rewrite_and_compare genv) p l in
 
-  iter genv0 p rewrite_list
+  iter genv0 p (rewrite_list ())

src/dune

@@ -211,7 +211,7 @@
 	simulator; the generation of the main function
 	zeluc; the main function
   )
-  (libraries zelus.parser_lib zelus.global_lib zelus.zrun_lib
+  (libraries unix zelus.parser_lib zelus.global_lib zelus.zrun_lib
   zelus.typing_lib zelus.causality_lib zelus.initialization_lib
   zelus.rewrite_lib zelus.seqcode_lib)
   (preprocess (pps ppx_deriving.show))

src/global/printer.ml

@@ -233,7 +233,7 @@ let is_empty_block { b_vars; b_body = { eq_desc } } =
   (b_vars = []) && (eq_desc = EQempty)
 
 let automaton_handler_list
-      is_weak leqs body body_in_escape expression ff s_h_list e_opt =
+      is_weak leqs body body_in_escape expression ff (s_h_list, e_opt) =
   let statepat ff { desc } = match desc with
     | Estate0pat(n) -> name ff n
     | Estate1pat(n, n_list) ->
@@ -244,7 +244,7 @@ let automaton_handler_list
     | Estate1(n, e_list) ->
        fprintf ff "%a%a" name n (print_list_r expression "("","")") e_list
     | Estateif(e, se1, se2) ->
-       fprintf ff "@[if %a@,then %a@,else %a@]"
+       fprintf ff "@[<hov0>if %a@ then %a@ else %a@]"
          expression e state se1 state se2 in
 
   let automaton_handler is_weak body body_in_escape expression ff
@@ -270,7 +270,7 @@ let automaton_handler_list
     let escape_list ff t_list =
       if t_list = [] then fprintf ff "done"
       else
-        print_list_r escape
+        Pp_tools.print_list_r escape
 	  (if is_weak then "until " else "unless ") "" "" ff t_list in
     fprintf ff "@[<v 4>| %a ->@ @[<v0>%a%a@,%a@]@]"
       statepat s_state
@@ -282,89 +282,87 @@ let automaton_handler_list
       """"""
       ff s_h_list in
 
-    fprintf ff "@[<hov0>automaton%s@ @[%a@]@,%a@]"
+    fprintf ff "@[<hov0>@[automaton%s@ %a@]@ %a@ end@]"
 	 (if is_weak then "(* weak *)" else "(* strong *)")
 	 automaton_handler_list s_h_list
-	 (print_opt (print_with_braces state " init" "")) e_opt
-
-let rec expression ff e =
-  let exp ff { e_desc } =
-    match e_desc with
-    | Evar n -> name ff n
-    | Eglobal { lname } -> longname ff lname
-    | Eop(op, e_list) -> 
-        fprintf ff "@[(";
-        operator ff op e_list;
-        fprintf ff ")@]"
-    | Elast { copy; id } ->
-       fprintf ff "last%s %a" (if copy then "" else "*") name id
-    | Econstr0 { lname } -> longname ff lname
-    | Econst c -> immediate ff c
-    | Eapp { is_inline; f; arg_list } ->
-       fprintf ff "@[(";
-       let s = if is_inline then "inline " else "" in
-       fprintf ff "@[%s%a %a@]"
-         s expression f (print_list_r expression "" "" "") arg_list;
-       fprintf ff ")@]"
-    | Esizeapp { f; size_list } ->
-       fprintf ff "@[(%a %a)@]" expression f
+	 (Pp_tools.print_opt (Pp_tools.print_with_braces state "init " "")) e_opt
+
+let rec expression ff { e_desc } =
+  match e_desc with
+  | Evar n -> name ff n
+  | Eglobal { lname } -> longname ff lname
+  | Eop(op, e_list) -> 
+     fprintf ff "@[(";
+     operator ff op e_list;
+     fprintf ff ")@]"
+  | Elast { copy; id } ->
+     fprintf ff "last%s %a" (if copy then "" else "*") name id
+  | Econstr0 { lname } -> longname ff lname
+  | Econst c -> immediate ff c
+  | Eapp { is_inline; f; arg_list } ->
+     fprintf ff "@[(";
+     let s = if is_inline then "inline " else "" in
+     fprintf ff "@[%s%a %a@]"
+       s expression f (print_list_r expression "" "" "") arg_list;
+     fprintf ff ")@]"
+  | Esizeapp { f; size_list } ->
+     fprintf ff "@[(%a %a)@]" expression f
        (print_list_l size "<<" "," ">>") size_list 
-    | Econstr1 { lname; arg_list } ->
-       fprintf ff "@[(%a%a)@]"
-         longname lname (print_list_r expression "(" "," ")") arg_list
-    | Etuple(e_list) ->
-       fprintf ff "@[%a@]" (print_list_r expression "(tuple " "" ")") e_list
-    | Erecord_access { label; arg } ->
-       fprintf ff "@[%a.%a@]" expression arg longname label
-    | Erecord(ln_e_list) ->
-       print_list_r
-         (print_record longname expression "" " =" "") "{" ";" "}" ff ln_e_list
-    | Erecord_with(e, ln_e_list) ->
-       fprintf ff "@[{ %a with %a }@]"
-         expression e
-         (print_list_r
-	    (print_record longname expression """ =""") "" ";" "")
-         ln_e_list
-    | Elet(l, e) ->
-       fprintf ff "@[<v0>(%ain @,%a)@]" leq l expression e
-    | Elocal(b_eq, e) ->
-        fprintf ff "@[<v0>(%a in @,%a)@]"
-          block_of_equation b_eq expression e
-    | Etypeconstraint(e, typ) ->
-       fprintf ff "@[(%a: %a)@]" expression e ptype typ
-    | Ematch { is_total; e; handlers } ->
-       fprintf ff "@[<v>@[<hov 2>%smatch %a with@ @[%a@]@]@]"
-         (if is_total then "total " else "")
-         expression e (print_list_l (match_handler expression) """""")
-         handlers
-    | Epresent { handlers; default_opt } ->
-       fprintf ff "@[<v>@[<hov 2>present@ @[%a@]@]@ @[%a@]@]"
-         (print_list_l (present_handler (scondpat expression) expression)
-	    """""") handlers
-         (with_default expression) default_opt
-    | Ereset(e_body, e) ->
-       fprintf ff "@[<hov>reset@ %a@ every %a@]" expression e_body expression e
-    | Efun(fe) ->
-       fprintf ff "@[(%a)@]" funexp fe
-    | Eassert(e_body) ->
-       fprintf ff "@[<hov 2>assert@ %a@]" expression e_body
-    | Eforloop({ for_size; for_kind; for_index; for_input; for_body;
+  | Econstr1 { lname; arg_list } ->
+     fprintf ff "@[(%a%a)@]"
+       longname lname (print_list_r expression "(" "," ")") arg_list
+  | Etuple(e_list) ->
+     fprintf ff "@[%a@]" (print_list_r expression "(tuple " "" ")") e_list
+  | Erecord_access { label; arg } ->
+     fprintf ff "@[%a.%a@]" expression arg longname label
+  | Erecord(ln_e_list) ->
+     print_list_r
+       (print_record longname expression "" " =" "") "{" ";" "}" ff ln_e_list
+  | Erecord_with(e, ln_e_list) ->
+     fprintf ff "@[{ %a with %a }@]"
+       expression e
+       (print_list_r
+	  (print_record longname expression """ =""") "" ";" "")
+       ln_e_list
+  | Elet(l, e) ->
+     fprintf ff "@[<v0>(%ain @,%a)@]" leq l expression e
+  | Elocal(b_eq, e) ->
+     fprintf ff "@[<v0>(%a in @,%a)@]"
+       block_of_equation b_eq expression e
+  | Etypeconstraint(e, typ) ->
+     fprintf ff "@[(%a: %a)@]" expression e ptype typ
+  | Ematch { is_total; e; handlers } ->
+     fprintf ff "@[<v>@[<hov 2>%smatch %a with@ @[%a@]@]@]"
+       (if is_total then "total " else "")
+       expression e (print_list_l (match_handler expression) """""")
+       handlers
+  | Epresent { handlers; default_opt } ->
+     fprintf ff "@[<v>@[<hov 2>present@ @[%a@]@]@ @[%a@]@]"
+       (print_list_l (present_handler (scondpat expression) expression)
+	  """""") handlers
+       (with_default expression) default_opt
+  | Ereset(e_body, e) ->
+     fprintf ff "@[<hov>reset@ %a@ every %a@]" expression e_body expression e
+  | Efun(fe) ->
+     fprintf ff "@[(%a)@]" funexp fe
+  | Eassert(e_body) ->
+     fprintf ff "@[<hov 2>assert@ %a@]" expression e_body
+  | Eforloop({ for_size; for_kind; for_index; for_input; for_body;
                for_env; for_resume }) ->
-       let size ff for_size =
-         Util.optional_unit (fun ff e -> fprintf ff "(%a)@ " expression e)
-           ff for_size in
-       fprintf ff
-         "@[<hov 2>%a%a@,%a%a(%a) %a@ %a@ @[%a@]@ @]"
-         kind_of_forloop for_kind
-         for_resume_or_restart for_resume
-         size for_size
-         index_opt for_index
-         input_list for_input
-         print_env_names for_env
-         for_exp for_body 
-         for_exit_condition for_kind in
-  exp ff e
-
+     let size ff for_size =
+       Util.optional_unit (fun ff e -> fprintf ff "(%a)@ " expression e)
+         ff for_size in
+     fprintf ff
+       "@[<hov 2>%a%a@,%a%a(%a) %a@ %a@ @[%a@]@ @]"
+       kind_of_forloop for_kind
+       for_resume_or_restart for_resume
+       size for_size
+       index_opt for_index
+       input_list for_input
+       print_env_names for_env
+       for_exp for_body 
+       for_exit_condition for_kind
+
 and result ff { r_desc } =
   match r_desc with
   | Exp(e) -> fprintf ff "@[<hov 2>->@ %a@]" expression e
@@ -483,7 +481,7 @@ and equation ff ({ eq_desc = desc } as eq) =
   | EQautomaton { is_weak; handlers; state_opt } ->
      automaton_handler_list
        is_weak leqs block_of_equation block_of_equation expression
-       ff handlers state_opt
+       ff (handlers, state_opt)
   | EQmatch { is_total; e; handlers } ->
      fprintf ff "@[<hov0>%smatch %a with@ @[%a@]@]"
        (if is_total then "total " else "")

tests/dune

@@ -6,17 +6,5 @@
  (deps (glob_files good/*.zls) (glob_files bad/*.zls))
  ; files dependencies
  (libraries
-   zrun.global_lib zrun.zrun_lib alcotest))
- ; libraries dependencies
-
-(test
- (name zwritetest)
- ; name of the test
- (modules zwritetest)
- ; ml file test runner
- (deps (glob_files good/*.zls) (glob_files bad/*.zls))
- ; files dependencies
- (libraries
-   zrun.global_lib zrun.zrun_lib zrun.typdefs_lib
-   zrun.rewrite_lib alcotest))
+   zelus.global_lib zelus.zrun_lib alcotest))
  ; libraries dependencies

tests/good/a.zls

@@ -1,6 +1,6 @@
 let node f(g)() = run g (1)
 
-let node main___() = let y = 1 in run (f (node x -> x + 2 + y)) ()
+let node main___() = let y = 1 in run (f (node x -> x + 2 + 1)) ()
 
 type t  = A |B |C |D