Interpreter interface now supports option<ast> result from decode and etc instead of looking for exit calls

1 files changed, 18 insertions, 9 deletions

diff --git a/src/lem_interp/interp_inter_imp.lem b/src/lem_interp/interp_inter_imp.lem
index 0f7d71c7..714f4c4c 100644
--- a/src/lem_interp/interp_inter_imp.lem
+++ b/src/lem_interp/interp_inter_imp.lem
@@ -241,22 +241,31 @@ let initial_instruction_state top_level main args =
   Interp.Thunk_frame (E_aux (E_app (Id_aux (Id main) Interp_ast.Unknown) e_args) (Interp_ast.Unknown, Nothing)) 
     top_level Interp.eenv (Interp.emem "istate top level") Interp.Top
 
+type interp_value_helper_mode = Ivh_decode | Ivh_unsupported | Ivh_illegal
 
-let rec interp_to_value_helper arg err_str instr direction thunk = 
+let rec interp_to_value_helper arg ivh_mode err_str instr direction thunk = 
   match thunk() with
-    | (Interp.Value value,_,_) -> (Just value,Nothing)
-    | (Interp.Error l msg,_,_) -> (Nothing, Just (Internal_error msg))
+  | (Interp.Value value,_,_) ->
+    (match value with
+     | Interp.V_ctor (Id_aux (Id "Some") _) _ _ vinstr -> (Just vinstr,Nothing)
+     | Interp.V_ctor (Id_aux (Id "None") _) _ _ _ ->
+       match ivh_mode with
+       | Ivh_decode -> (Nothing, Just (Not_an_instruction_error arg))
+       | Ivh_illegal -> (Nothing, Just (Not_an_instruction_error arg))
+       | Ivh_unsupported -> (Nothing, Just (Unsupported_instruction_error instr))
+      end end)
+  | (Interp.Error l msg,_,_) -> (Nothing, Just (Internal_error msg))
     | (Interp.Action (Interp.Call_extern i value) stack,_,_) ->
       match List.lookup i (Interp_lib.library_functions direction) with
 	| Nothing -> (Nothing, Just (Internal_error ("External function not available " ^ i)))
 	| Just f  -> 
-          interp_to_value_helper arg err_str instr direction 
+          interp_to_value_helper arg ivh_mode err_str instr direction 
 	    (fun _ -> Interp.resume (make_interp_mode true false) stack (Just (f value)))
       end 
     | (Interp.Action (Interp.Exit ((E_aux e _) as exp)) stack,_,_) ->
       match e with
-	| E_id (Id_aux (Id "unsupported_instruction") _) -> (Nothing,Just (Unsupported_instruction_error instr))
-	| E_id (Id_aux (Id "no_matching_pattern") _) -> (Nothing,Just (Not_an_instruction_error arg))
+	(*| E_id (Id_aux (Id "unsupported_instruction") _) -> (Nothing,Just (Unsupported_instruction_error instr))
+	| E_id (Id_aux (Id "no_matching_pattern") _) -> (Nothing,Just (Not_an_instruction_error arg))*)
 	| E_lit (L_aux (L_string str) _) -> (Nothing, Just (Internal_error ("Exit called with message: " ^ str)))
 	| E_id (Id_aux (Id i) _) -> 
 	  (match (Interp.resume (make_interp_mode true false) (Interp.set_in_context stack exp) Nothing) with
@@ -322,7 +331,7 @@ let decode_to_istate top_level value =
   let val_str = Interp.string_of_value intern_val in
   let (arg,_) = Interp.to_exp mode Interp.eenv intern_val in
   let internal_direction = if direction = D_increasing then Interp.IInc else Interp.IDec in
-  let (instr_decoded,error) = interp_to_value_helper value val_str ("",[],[]) internal_direction
+  let (instr_decoded,error) = interp_to_value_helper value Ivh_decode val_str ("",[],[]) internal_direction
     (fun _ -> Interp.resume 
       mode 
       (Interp.Thunk_frame 
@@ -331,7 +340,7 @@ let decode_to_istate top_level value =
   match (instr_decoded,error) with
     | (Just instr, _) -> 
       let instr_external = match instr with
-	| Interp.V_ctor (Id_aux (Id i) _) _ _ parm ->
+	| Interp.V_ctor (Id_aux (Id "Some") _) _ _ (Interp.V_ctor (Id_aux (Id i) _) _ _ parm) ->
 	  match (find_instruction i instructions) with
 	    | Just(Instruction_extractor.Instr_form name parms effects) -> 
 	      match (parm,parms) with
@@ -346,7 +355,7 @@ let decode_to_istate top_level value =
 		     (p_name,t,(extern_ifield_value name p_name value t))) vals parms), effects)
           end end end in 
       let (arg,_) = Interp.to_exp mode Interp.eenv instr in
-      let (instr_decoded,error) = interp_to_value_helper value val_str instr_external internal_direction
+      let (instr_decoded,error) = interp_to_value_helper value Ivh_unsupported val_str instr_external internal_direction
 	(fun _ -> Interp.resume 
 	 mode
 	  (Interp.Thunk_frame