From c497bef0d49ec32afae584c63a0cee0730cb90b1 Mon Sep 17 00:00:00 2001
From: Brian Campbell
Date: Tue, 5 Dec 2017 11:31:02 +0000
Subject: Add top-level pattern match guards internally Also fix bug in mono
 analysis with generated variables Breaks lots of typechecking tests because
 it generates unnecessary equality tests on units (and the tests don't have
 generic equality), which I'll fix next.

---
 src/lem_interp/instruction_extractor.lem | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

(limited to 'src/lem_interp/instruction_extractor.lem')

diff --git a/src/lem_interp/instruction_extractor.lem b/src/lem_interp/instruction_extractor.lem
index b49646ea..11947c17 100644
--- a/src/lem_interp/instruction_extractor.lem
+++ b/src/lem_interp/instruction_extractor.lem
@@ -103,7 +103,8 @@ end
 let rec extract_from_decode decoder = 
   match decoder with
     | [] -> []
-    | (FCL_aux (FCL_Funcl _ pat exp) _)::decoder ->
+    | (FCL_aux (FCL_Funcl _ (Pat_aux pexp _)) _)::decoder ->
+      let exp = match pexp with Pat_exp _ exp -> exp | Pat_when _ _ exp -> exp end in
       (match exp with
 	| E_aux (E_app (Id_aux(Id id) _) parms) (_,(Just (_,Tag_ctor,_,_,_))) ->
 	  Instr_form id (List.map extract_parm parms) []
@@ -112,7 +113,7 @@ end
 
 let rec extract_effects_of_fcl id execute = match execute with
   | [] -> []
-  | FCL_aux (FCL_Funcl _ (P_aux (P_app (Id_aux (Id i) _) _) _) _) (_,(Just(_,_,_,Effect_aux(Effect_set efs) _,_))) :: executes ->
+  | FCL_aux (FCL_Funcl _ (Pat_aux (Pat_exp (P_aux (P_app (Id_aux (Id i) _) _) _) _) _)) (_,(Just(_,_,_,Effect_aux(Effect_set efs) _,_))) :: executes ->
     if i = id 
     then efs
     else extract_effects_of_fcl id executes
@@ -134,7 +135,7 @@ let rec extract_patt_parm (P_aux p (_,tannot)) =
 
 let rec extract_from_execute fcls = match fcls with
   | [] -> []
-  | FCL_aux (FCL_Funcl _ (P_aux (P_app (Id_aux (Id i) _) parms) _) _) (_,Just(_,_,_,Effect_aux(Effect_set efs) _,_))::fcls ->
+  | FCL_aux (FCL_Funcl _ (Pat_aux (Pat_exp (P_aux (P_app (Id_aux (Id i) _) parms) _) _) _)) (_,Just(_,_,_,Effect_aux(Effect_set efs) _,_))::fcls ->
      (Instr_form i (List.map extract_patt_parm parms) efs)::extract_from_execute fcls
   | _ :: fcls ->
      (* AA: Find out what breaks this *)
-- 
cgit v1.2.3