process: new composition syntax, misc fixes

Author: terencode

src/parsing/lexer.mll

@@ -89,8 +89,12 @@ rule read_token = parse
   | "with" { WITH }
   | "reads" { READS }
   | "writes" { WRITES }
-  | "Par" { PAR }
-  | "Seq" { SEQ }
+  (* | "Par" { PAR }
+  | "Seq" { SEQ } *)
+  | "{{" { LPARC }
+  | "}}" { RPARC }
+  | "[[" { LSEQC }
+  | "]]" { RSEQC }
   (* | "((" {P_LPAREN}
   | "))" {P_RPAREN} *)
   | "!" { NOT }

src/parsing/parser.mly

@@ -37,6 +37,7 @@
 %token <char> CHAR
 
 %token LPAREN "(" RPAREN ")" LBRACE "{" RBRACE "}" LSQBRACE "[" RSQBRACE "]" LANGLE "<" RANGLE ">" (* ARROW "->" *)
+%token LPARC RPARC LSEQC RSEQC 
 %token COMMA "," COLON ":" DCOLON "::" SEMICOLON ";" DOT "."
 %token ASSIGN "="
 %token IMPORT
@@ -50,7 +51,7 @@
 %token WRITES READS
 %token P_PROC_INIT
 // %token AWAIT EMIT WATCHING WHEN PAR "||"
-%token PAR SEQ
+// %token PAR SEQ
 %token P_INIT P_LOOP
 // %token P_LPAREN "((" P_RPAREN "))"
 %token WITH
@@ -152,8 +153,8 @@ let loop :=
     located(
         | ~ = statement ; ~ = pwhen ; <Statement>
         | ~ = located(UID) ; ~ = pwhen; <Run>
-        | PAR  ; cond = pwhen ; "{" ;  children = separated_list(WITH,loop) ; "}" ; { PGroup {p_ty=Parallel; cond ; children} }
-        | SEQ  ; cond = pwhen ; "{" ;  children = separated_list(WITH,loop) ; "}" ; { PGroup {p_ty=Sequence; cond ; children} }
+        | LPARC ;  children = separated_list(WITH,loop) ; RPARC ; cond = pwhen ; { PGroup {p_ty=Parallel; cond ; children} }
+        | LSEQC ;  children = separated_list(WITH,loop) ; RSEQC ; cond = pwhen ; { PGroup {p_ty=Sequence; cond ; children} }
     )
 
 let pwhen == midrule(WHEN ; LPAREN ; ~= expression ; RPAREN; <>)?

src/passes/process/process.ml

@@ -20,8 +20,8 @@ module Pass = Pass.Make(struct
       let rec compute_tree closed (l,pi:loc * _ proc_init)  : HirU.statement M.t = 
         let closed = FieldSet.add pi.proc closed in (* no cycle *)
 
-        let* p = find_process_source (mk_locatable l pi.proc) pi.mloc procs (*fixme : grammar to allow :: syntax *) in
-        let* p = M.throw_if_none Logging.(make_msg l @@ Fmt.str "process '%s' is unknown" pi.proc) p in
+        let* p = find_process_source (mk_locatable l pi.proc) pi.mloc procs (*fixme : grammar to allow :: syntax *) 
+                >>= M.throw_if_none Logging.(make_msg l @@ Fmt.str "process '%s' is unknown" pi.proc) in
         let* tag = M.fresh_prefix p.p_name in
         let prefix = (Fmt.str "%s_%s_" tag) in
         let read_params,write_params = p.p_interface.p_shared_vars in 
@@ -34,9 +34,11 @@ module Pass = Pass.Make(struct
         let* () = param_arg_mismatch "init" p.p_interface.p_params pi.params in
 
 
+        (* correspondence between shared variables names (given, original) *)
         let rename_l = List.map2 (fun subx x -> (fst x.value,subx.value) ) 
           (pi.read @ pi.write) 
           (fst p.p_interface.p_shared_vars @ snd p.p_interface.p_shared_vars) in
+        (* if the id corresponds to a shared variable, replace it by the name of the provided variable *)
         let rename = fun id -> match List.assoc_opt id rename_l with Some v -> v | None -> id in 
 
         (* add process local (but persistant) vars *)
@@ -68,10 +70,9 @@ module Pass = Pass.Make(struct
             return (process_cond cond s)
 
           | Run (id,cond) ->
-              M.throw_if Logging.(make_msg l "not allowed to call Main process explicitely") (id.value = Constants.main_process) >>= fun () ->
-              M.throw_if Logging.(make_msg l "not allowed to have recursive process") (FieldSet.mem id.value closed) >>= fun () ->
               let* pi = M.throw_if_none Logging.(make_msg l @@ Fmt.str "no proc init called '%s'" id.value) 
                           (List.find_opt (fun p -> p.value.id = id.value) p.p_body.proc_init) in
+              M.throw_if Logging.(make_msg l "not allowed to have recursive process") (FieldSet.mem pi.value.proc closed) >>= fun () ->
               let read = List.map (fun (id:l_str) -> mk_locatable id.loc @@ prefix id.value) pi.value.read in 
               let write = List.map (fun (id:l_str) -> mk_locatable id.loc @@ prefix id.value) pi.value.write in 
               let params = List.map (AstU.rename_var prefix) pi.value.params in