conditional store fix

Author: kmill

examples/condstore.plv

@@ -0,0 +1,8 @@
+condstore1 (inout v :: double) (w :: double) (b :: bool) :: () :=
+  v[b] <- w;
+
+condstore2 {n} (inout A :: double[n]) (w :: double) (b :: bool) :: () :=
+  A[b] <- w;
+
+condstore3 {n} (inout A :: double[n]) (w :: double) :: () :=
+  A[A < w] <- w;

src/Language/Plover/CodeGen.hs

@@ -1705,6 +1705,9 @@ compileLoc loc@(Index a idxs) = do aloc <- asLoc $ compileStat a
           vty@(VecType {}) -> do
             idxloc <- asLoc $ compileStat idx
             return $ Left (length $ getIndices vty, vecBaseType vty, idxloc)
+          BoolType -> do
+            idxloc <- asLoc $ compileStat idx
+            return $ Left (0, BoolType, idxloc)
           ty -> do
             idxex <- asExp $ compileStat idx
             return $ Right idxex

src/Language/Plover/Types.hs

@@ -942,9 +942,9 @@ getLocType :: Location CExpr -> Type
 getLocType (Ref ty v) = ty
 getLocType (Index a idxs) = normalizeTypes $ getTypeIdx idxs (normalizeTypes $ getType a)
   where getTypeIdx [] aty = aty
-        getTypeIdx (idx:idxs) aty@(VecType {}) = getTypeIdxty [] (getType idx) idxs aty
+        getTypeIdx (idx:idxs) aty = getTypeIdxty [] (getType idx) idxs aty
 
-        getTypeIdxty acc idxty idxs vty@(VecType {}) =
+        getTypeIdxty acc idxty idxs vty =
           case normalizeTypes idxty of
             VecType st' idxs' idxtybase -> VecType st' idxs' $
                                            getTypeIdxty (acc ++ idxs') idxtybase idxs vty

src/Language/Plover/Unify.hs

@@ -968,11 +968,15 @@ typeCheckLoc pos (Index a idxs) = do -- see note [indexing rules] and see `getLo
           idxty <- typeCheck idx
           typeCheckIdxty oty [] idxty idxs aty
         typeCheckIdx oty (idx:idxs) ty = do
-          addUError $ UGenTyError pos oty "Too many indices on expression of type"
-          return ty
+          idxty <- typeCheck idx
+          case idxty of
+            BoolType -> typeCheckIdxty oty [] idxty idxs ty
+            _ -> do addUError $ UGenTyError pos oty
+                      "Too many indices on expression of type"
+                    return ty
 
         typeCheckIdxty :: Type -> [CExpr] -> Type -> [CExpr] -> Type -> UM Type
-        typeCheckIdxty oty acc idxty idxs vty@(VecType {}) =
+        typeCheckIdxty oty acc idxty idxs vty =
           case normalizeTypes idxty of
            VecType st' idxs' idxtybase -> -- result shape equals shape of index
              VecType st' idxs' <$> (typeCheckIdxty oty (acc ++ idxs') idxtybase idxs vty)