X-Git-Url: http://git.megacz.com/?p=coq-hetmet.git;a=blobdiff_plain;f=examples%2FGArrowPortShape.hs;h=e746b5fc9985edbfff0c98697ca508b070356103;hp=34f14c876e11f5a4b4be2ffaf6d3db135fe6b596;hb=bc93ead06902db52dfcc229084a42152d4166bdf;hpb=3282a2b78028238987a5a49e59d8e8d495aea0e1

diff --git a/examples/GArrowPortShape.hs b/examples/GArrowPortShape.hs
index 34f14c8..e746b5f 100644
--- a/examples/GArrowPortShape.hs
+++ b/examples/GArrowPortShape.hs
@@ -186,8 +186,24 @@ detect (GAS_const i)  = do { x <- freshM; return $ GASPortShapeWrapper PortUnit
 detect GAS_merge      = do { x <- freshM
                            ; y <- freshM
                            ; return $ GASPortShapeWrapper (PortTensor (PortFree x) (PortFree y)) (PortFree x) GAS_merge }
-detect (GAS_loopl f)  = error "not implemented"
-detect (GAS_loopr f)  = error "not implemented"
+detect (GAS_loopl f)  = do { x <- freshM
+                           ; y <- freshM
+                           ; z <- freshM
+                           ; z' <- freshM    -- remove once I fix the occurs check
+                           ; f' <- detect f
+                           ; unifyM (fst $ shapes f') (PortTensor (PortFree z) (PortFree x))
+                           ; unifyM (snd $ shapes f') (PortTensor (PortFree z') (PortFree y))
+                           ; return $ GASPortShapeWrapper (PortFree x) (PortFree y) (GAS_loopl (GAS_misc f'))
+                           }
+detect (GAS_loopr f)  = do { x <- freshM
+                           ; y <- freshM
+                           ; z <- freshM
+                           ; z' <- freshM    -- remove once I fix the occurs check
+                           ; f' <- detect f
+                           ; unifyM (fst $ shapes f') (PortTensor (PortFree x) (PortFree z))
+                           ; unifyM (snd $ shapes f') (PortTensor (PortFree y) (PortFree z'))
+                           ; return $ GASPortShapeWrapper (PortFree x) (PortFree y) (GAS_loopr (GAS_misc f'))
+                           }
 
-detect (GAS_misc f)   = error "not implemented"
+detect (GAS_misc f)   = error "GAS_misc: not implemented"