Validate CaseE with evalctx id

Wasm-DSL · Sep 25, 2024 · e2c4894 · e2c4894
1 parent 256d798
commit e2c4894
Show file tree

Hide file tree

Showing 2 changed files with 21 additions and 7 deletions.
diff --git a/spectec/src/al/valid.ml b/spectec/src/al/valid.ml
@@ -553,10 +553,25 @@ and valid_expr env (expr: expr) : unit =
     List.iter (valid_expr env) exprs;
     check_tuple source exprs expr.note;
   | CaseE (op, exprs) ->
+    let is_evalctx_id id =
+      let source = "" $ no_region in
+      let evalctx_ids = List.filter_map (fun (mixop, _, _) ->
+        let atom = mixop |> List.hd |> List.hd in
+        match atom.it with
+        | El.Atom.Atom s -> Some s
+        | _ -> None
+      ) (get_typcases source evalctxT) in
+      List.mem id evalctx_ids
+    in
+    (match op with
+    | [[{ it=Atom id; _ }]] when is_evalctx_id id ->
+      check_case source exprs (TupT [] $ no_region)
+    | _ -> 
     List.iter (valid_expr env) exprs;
     let tcs = get_typcases source expr.note in
     let _binds, typ, _prems = find_case source tcs op in
     check_case source exprs typ;
+)
   | CallE (id, args) ->
     List.iter (valid_arg env) args;
     check_call source id args expr.note;
@@ -632,7 +647,7 @@ let rec valid_instr (env: Env.t) (instr: instr) : Env.t =
   | EnterI (expr1, expr2, il) ->
     valid_expr env expr1;
     valid_expr env expr2;
-    check_context source expr1.note;
+    check_evalctx source expr1.note;
     check_instr source expr2.note;
     valid_instrs env il
   | AssertI expr ->

diff --git a/spectec/src/il2al/translate.ml b/spectec/src/il2al/translate.ml
@@ -471,26 +471,25 @@ and translate_context_instrs e' =
   | { it = Il.ListE [ctx]; _ } when is_context ctx ->
     (e'', translate_context_rhs ctx)
   | { it = Il.CatE (ve, ie); _ } ->
-    (catE (translate_exp ie, e'') ~note:ie.note, [pushI (translate_exp ve)])
+    (catE (translate_exp ie, e'') ~note:ie.note, [pushI (translate_exp ve |> subst_instr_typ)])
   | { it = Il.ListE [ve; ie]; _ } ->
-    (listE [translate_exp ie; e'] ~note:ie.note, [pushI (translate_exp ve)])
+    (listE [translate_exp ie; e'] ~note:ie.note, [pushI (translate_exp ve |> subst_instr_typ)])
   | instrs ->
     (catE (translate_exp instrs, e'') ~note:instrs.note, [])
 
 and translate_context_rhs exp =
   let at = exp.at in
-  let note = exp.note in
 
   let case = case_of_case exp in
   let atom = case |> List.hd |> List.hd in
   let args = args_of_case exp in
   let case', _ = Lib.List.split_last case in
   let args, instrs = Lib.List.split_last args in
-
   let args' = List.map translate_exp args in
-  let e' = caseE ([[atom]], []) ~at:instrs.at ~note:instrs.note in
+
+  let e' = caseE ([[atom]], []) ~at:instrs.at ~note:instrT in
   let instrs', al = translate_context_instrs e' instrs in
-  let ectx = caseE (case', args') ~at:at ~note:note in
+  let ectx = caseE (case', args') ~at:at ~note:evalctxT in
   [
     enterI (ectx, instrs', al) ~at:at;
   ]