diff options
Diffstat (limited to 'src/AST')
-rw-r--r-- | src/AST/Count.hs | 10 | ||||
-rw-r--r-- | src/AST/Pretty.hs | 12 | ||||
-rw-r--r-- | src/AST/UnMonoid.hs | 26 |
3 files changed, 24 insertions, 24 deletions
diff --git a/src/AST/Count.hs b/src/AST/Count.hs index 22a4da6..b7079ff 100644 --- a/src/AST/Count.hs +++ b/src/AST/Count.hs @@ -128,11 +128,11 @@ occCountGeneral onehot unpush alter many = go WId EShape _ e -> re e EOp _ _ e -> re e ECustom _ _ _ _ _ _ _ a b -> re a <> re b - EWith a b -> re a <> re1 b - EAccum _ a b e -> re a <> re b <> re e - EZero _ -> mempty - EPlus _ a b -> re a <> re b - EOneHot _ _ a b -> re a <> re b + EWith _ a b -> re a <> re1 b + EAccum _ _ a b e -> re a <> re b <> re e + EZero _ _ -> mempty + EPlus _ _ a b -> re a <> re b + EOneHot _ _ _ a b -> re a <> re b EError{} -> mempty where re :: Monoid (r env') => Expr x env' t'' -> r env' diff --git a/src/AST/Pretty.hs b/src/AST/Pretty.hs index 663e9b0..24bacdb 100644 --- a/src/AST/Pretty.hs +++ b/src/AST/Pretty.hs @@ -203,7 +203,7 @@ ppExpr' d val = \case . e1' . showString " " . e2' - EWith e1 e2 -> do + EWith _ e1 e2 -> do e1' <- ppExpr' 11 val e1 name <- genNameIfUsedIn' "ac" (STAccum (typeOf e1)) IZ e2 e2' <- ppExpr' 0 (Const name `SCons` val) e2 @@ -211,27 +211,27 @@ ppExpr' d val = \case showString "with " . e1' . showString (" (\\" ++ name ++ " -> ") . e2' . showString ")" - EAccum i e1 e2 e3 -> do + EAccum _ i e1 e2 e3 -> do e1' <- ppExpr' 11 val e1 e2' <- ppExpr' 11 val e2 e3' <- ppExpr' 11 val e3 return $ showParen (d > 10) $ showString ("accum " ++ show (fromSNat i) ++ " ") . e1' . showString " " . e2' . showString " " . e3' - EZero t -> return $ showString ("(zero :: " ++ ppTy 0 t ++ ")") + EZero _ t -> return $ showString ("(zero :: " ++ ppTy 0 t ++ ")") - EPlus _ a b -> do + EPlus _ _ a b -> do a' <- ppExpr' 11 val a b' <- ppExpr' 11 val b return $ showParen (d > 10) $ showString "plus " . a' . showString " " . b' - EOneHot _ i a b -> do + EOneHot _ _ i a b -> do a' <- ppExpr' 11 val a b' <- ppExpr' 11 val b return $ showParen (d > 10) $ showString ("onehot " ++ show (fromSNat i) ++ " ") . a' . showString " " . b' - EError _ s -> return $ showParen (d > 10) $ showString ("error " ++ show s) + EError _ _ s -> return $ showParen (d > 10) $ showString ("error " ++ show s) ppExprLet :: Int -> SVal env -> Expr x env t -> M ShowS ppExprLet d val etop = do diff --git a/src/AST/UnMonoid.hs b/src/AST/UnMonoid.hs index 8da1e32..c87bed1 100644 --- a/src/AST/UnMonoid.hs +++ b/src/AST/UnMonoid.hs @@ -11,9 +11,9 @@ import Data unMonoid :: Ex env t -> Ex env t unMonoid = \case - EZero t -> zero t - EPlus t a b -> plus t a b - EOneHot t i a b -> onehot t i a b + EZero _ t -> zero t + EPlus _ t a b -> plus t a b + EOneHot _ t i a b -> onehot t i a b EVar _ t i -> EVar ext t i ELet _ rhs body -> ELet ext (unMonoid rhs) (unMonoid body) @@ -42,9 +42,9 @@ unMonoid = \case EShape _ e -> EShape ext (unMonoid e) EOp _ op e -> EOp ext op (unMonoid e) ECustom _ t1 t2 t3 a b c e1 e2 -> ECustom ext t1 t2 t3 (unMonoid a) (unMonoid b) (unMonoid c) (unMonoid e1) (unMonoid e2) - EWith a b -> EWith (unMonoid a) (unMonoid b) - EAccum n a b e -> EAccum n (unMonoid a) (unMonoid b) (unMonoid e) - EError t s -> EError t s + EWith _ a b -> EWith ext (unMonoid a) (unMonoid b) + EAccum _ n a b e -> EAccum ext n (unMonoid a) (unMonoid b) (unMonoid e) + EError _ t s -> EError ext t s zero :: STy t -> Ex env (D2 t) zero STNil = ENil ext @@ -52,7 +52,7 @@ zero (STPair t1 t2) = ENothing ext (STPair (d2 t1) (d2 t2)) zero (STEither t1 t2) = ENothing ext (STEither (d2 t1) (d2 t2)) zero (STMaybe t) = ENothing ext (d2 t) zero (STArr SZ t) = EUnit ext (zero t) -zero (STArr n t) = EBuild ext n (eTup (sreplicate n (EConst ext STI64 0))) (EError (d2 t) "empty") +zero (STArr n t) = EBuild ext n (eTup (sreplicate n (EConst ext STI64 0))) (EError ext (d2 t) "empty") zero (STScal t) = case t of STI32 -> ENil ext STI64 -> ENil ext @@ -76,9 +76,9 @@ plus (STEither t1 t2) a b = ECase ext (EVar ext t (IS IZ)) (ECase ext (EVar ext t (IS IZ)) (EInl ext (d2 t2) (plus t1 (EVar ext (d2 t1) (IS IZ)) (EVar ext (d2 t1) IZ))) - (EError t "plus l+r")) + (EError ext t "plus l+r")) (ECase ext (EVar ext t (IS IZ)) - (EError t "plus r+l") + (EError ext t "plus r+l") (EInr ext (d2 t1) (plus t2 (EVar ext (d2 t2) (IS IZ)) (EVar ext (d2 t2) IZ)))) plus (STMaybe t) a b = plusSparse (d2 t) a b $ @@ -130,9 +130,9 @@ onehot t (SS dep) idx val = case t of (ECase ext (weakenExpr WSink val) (EPair ext (onehot t1 dep' (EVar ext tidx1 (IS IZ)) (EVar ext tval1 IZ)) (zero t2)) - (EError (STPair (d2 t1) (d2 t2)) "onehot pair l/r")) + (EError ext (STPair (d2 t1) (d2 t2)) "onehot pair l/r")) (ECase ext (weakenExpr WSink val) - (EError (STPair (d2 t1) (d2 t2)) "onehot pair r/l") + (EError ext (STPair (d2 t1) (d2 t2)) "onehot pair r/l") (EPair ext (zero t1) (onehot t2 dep' (EVar ext tidx2 (IS IZ)) (EVar ext tval2 IZ)))) @@ -146,9 +146,9 @@ onehot t (SS dep) idx val = case t of ECase ext idx (ECase ext (weakenExpr WSink val) (EInl ext (d2 t2) (onehot t1 dep' (EVar ext tidx1 (IS IZ)) (EVar ext tval1 IZ))) - (EError (STEither (d2 t1) (d2 t2)) "onehot either l/r")) + (EError ext (STEither (d2 t1) (d2 t2)) "onehot either l/r")) (ECase ext (weakenExpr WSink val) - (EError (STEither (d2 t1) (d2 t2)) "onehot either r/l") + (EError ext (STEither (d2 t1) (d2 t2)) "onehot either r/l") (EInr ext (d2 t1) (onehot t2 dep' (EVar ext tidx2 (IS IZ)) (EVar ext tval2 IZ)))) STMaybe t1 -> EJust ext (onehot t1 dep idx val) |