Updated flake

.github/workflows/ci.yml

@@ -0,0 +1,35 @@
+name: concat
+on:
+  push:
+    branches:
+      - master
+  pull_request:
+    types:
+      - opened
+      - synchronize
+jobs:
+  build:
+    runs-on: ubuntu-latest
+    strategy:
+      matrix:
+        ghc:
+          - "8.10.7"
+          - "9.0.2"
+          - "9.2.4"
+    steps:
+      - uses: actions/checkout@v2
+      - uses: haskell/actions/setup@v1
+        id: setup-haskell-cabal
+        with:
+          ghc-version: ${{ matrix.ghc }}
+          cabal-version: "3.6.0.0"
+      - run: cabal v2-update
+      - run: cabal v2-freeze $CONFIG
+      - uses: actions/cache@v2
+        with:
+          path: |
+            ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
+            dist-newstyle
+          key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
+      - run: cabal new-build all
+      - run: cabal new-test gold-tests

cabal.project

@@ -16,11 +16,6 @@ source-repository-package
   tag: master
   subdir: verilog
 
-source-repository-package
-  type: git
-  location: https://github.com/expipiplus1/vector-sized.git
-  tag: master
-
 packages:
           ./inline/concat-inline.cabal
           ./plugin/concat-plugin.cabal

classes/concat-classes.cabal

@@ -48,6 +48,7 @@ library
                        ConCat.MinMax
                        ConCat.Category
                        ConCat.AltCat
+                       ConCat.Oops
   ghc-options:      -O2
                     -- -fobject-code here avoids error "mkPluginUsage: file not found"
                     -- with GHCi. See https://gitlab.haskell.org/ghc/ghc/issues/16093.

classes/src/ConCat/Additive.hs

@@ -26,6 +26,8 @@ import Data.Monoid (Monoid(..), Sum(..), Product(..))
 import Data.Semigroup (Semigroup(..))
 import Data.Complex hiding (magnitude)
 import Data.Ratio
+import Data.Int
+import Data.Word
 import Foreign.C.Types (CSChar, CInt, CShort, CLong, CLLong, CIntMax, CFloat, CDouble)
 import GHC.Generics (U1(..),Par1(..),(:*:)(..),(:.:)(..))
 import GHC.TypeLits (KnownNat)
@@ -73,6 +75,10 @@ instance Additive () where
   {-# INLINE (^+^) #-} }
 
 ScalarType(Int)
+ScalarType(Int16)
+ScalarType(Int32)
+ScalarType(Int64)
+ScalarType(Int8)
 ScalarType(Integer)
 ScalarType(Float)
 ScalarType(Double)
@@ -84,6 +90,11 @@ ScalarType(CLLong)
 ScalarType(CIntMax)
 ScalarType(CDouble)
 ScalarType(CFloat)
+ScalarType(Word)
+ScalarType(Word16)
+ScalarType(Word32)
+ScalarType(Word64)
+ScalarType(Word8)
 
 instance Integral a => Additive (Ratio a) where
   zero  = 0

classes/src/ConCat/AltCat.hs

@@ -23,9 +23,7 @@
 {-# LANGUAGE DefaultSignatures     #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
 {-# LANGUAGE NoStarIsType #-}
-#endif
 
 {-# OPTIONS_GHC -Wall #-}
 {-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
@@ -381,6 +379,7 @@ Op0(logC,FloatingCat k a => a `k` a)
 Op0(cosC,FloatingCat k a => a `k` a)
 Op0(sinC,FloatingCat k a => a `k` a)
 Op0(sqrtC,FloatingCat k a => a `k` a)
+Op0(tanhC,FloatingCat k a => a `k` a)
 -- Op0(powC,FloatingCat k a => a `k` a)
 
 Op0(fromIntegralC,FromIntegralCat k a b => a `k` b)
@@ -1064,9 +1063,24 @@ Catify(distribute, distributeC)
 Catify(tabulate  , tabulateC)
 Catify(index     , indexC)
 
-traverseC :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)
-traverseC f = sequenceA . fmap f
--- traverseC f = sequenceAC . fmapC f
+traverseC ::
+  forall k t f a b.
+  ( Category k,
+    FunctorCat k t,
+    OkFunctor k f,
+    TraversableCat k t f,
+    Ok k a,
+    Ok k b
+  ) =>
+  a `k` f b ->
+  t a `k` f (t b)
+traverseC f =
+  sequenceAC . fmapC f
+    <+ okFunctor @k @t @(f b)
+    <+ okFunctor @k @f @(t b)
+    <+ okFunctor @k @t @a
+    <+ okFunctor @k @t @b
+    <+ okFunctor @k @f @b
 {-# INLINE traverseC #-}
 
 Catify(traverse, traverseC)
@@ -1141,6 +1155,12 @@ separateProd (unFinite \\ knownMul @m @n -> x) =
 
  #-}
 
+{-# RULES
+
+"uncurry (,)" uncurry (,) = id
+
+#-}
+
 -- type Strong k h a = (ProductCat k, ZipCat k h, PointedCat k h a)
 
 -- -- Functorial strength

classes/src/ConCat/Category.hs

@@ -25,10 +25,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RecursiveDo #-}
-
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
 {-# LANGUAGE NoStarIsType #-}
-#endif
 
 {-# OPTIONS_GHC -Wall #-}
 
@@ -1368,6 +1365,7 @@ instance (FloatingCat k a, con a) => FloatingCat (Constrained con k) a where
   cosC = Constrained cosC
   sinC = Constrained sinC
   sqrtC = Constrained sqrtC
+  tanhC = Constrained tanhC
 
 instance (RealFracCat k a b, con a, con b) => RealFracCat (Constrained con k) a b where
   floorC = Constrained floorC
@@ -1698,7 +1696,7 @@ instance (FractionalCat k a, FractionalCat k' a) => FractionalCat (k :**: k') a
   PINLINER(divideC)
 
 class Ok k a => FloatingCat k a where
-  expC, logC, cosC, sinC, sqrtC :: a `k` a
+  expC, logC, cosC, sinC, sqrtC, tanhC :: a `k` a
   -- powC :: (a :* a) `k` a
 
 -- ln :: Floating a => a -> a
@@ -1710,12 +1708,14 @@ instance Floating a => FloatingCat (->) a where
   cosC = IC.inline cos
   sinC = IC.inline sin
   sqrtC = IC.inline sqrt
+  tanhC = IC.inline tanh
   -- powC = IC.inline (**)
   {-# OPINLINE expC #-}
   {-# OPINLINE logC #-}
   {-# OPINLINE cosC #-}
   {-# OPINLINE sinC #-}
   {-# OPINLINE sqrtC #-}
+  {-# OPINLINE tanhC #-}
 
 #ifdef KleisliInstances
 instance (Monad m, Floating a) => FloatingCat (Kleisli m) a where
@@ -1724,6 +1724,7 @@ instance (Monad m, Floating a) => FloatingCat (Kleisli m) a where
   cosC = arr cosC
   sinC = arr sinC
   sqrtC = arr sqrtC
+  tanhC = arr tanh
   -- powC = arr powC
 #endif
 
@@ -1733,6 +1734,7 @@ instance FloatingCat U2 a where
   cosC = U2
   sinC = U2
   sqrtC = U2
+  tanhC = U2
   -- powC = U2
 
 instance (FloatingCat k a, FloatingCat k' a) => FloatingCat (k :**: k') a where
@@ -1741,11 +1743,13 @@ instance (FloatingCat k a, FloatingCat k' a) => FloatingCat (k :**: k') a where
   cosC = cosC :**: cosC
   sinC = sinC :**: sinC
   sqrtC = sqrtC :**: sqrtC
+  tanhC = tanhC :**: tanhC
   PINLINER(expC)
   PINLINER(logC)
   PINLINER(cosC)
   PINLINER(sinC)
   PINLINER(sqrtC)
+  PINLINER(tanhC)
   -- powC = powC :**: powC
   -- PINLINER(powC)
 
@@ -1815,7 +1819,7 @@ class BottomCat k a b where
 --   bottomC = bottomC &&& bottomC
 
 instance (BottomCat k a b, ClosedCat k, Ok4 k z b a (z -> b)) => BottomCat k a (z -> b) where
-  bottomC = curry (bottomC . exl) <+ okProd @k @a @ z
+  bottomC = curry (bottomC . exl) <+ okProd @k @a @z
 
 instance BottomCat (->) a b where bottomC = error "bottomC for (->) evaluated"
 
@@ -2075,7 +2079,7 @@ class ({- Pointed h, -} OkFunctor k h, Ok k a) => PointedCat k h a where
 -- class (Ok k a, Num a) => SumCat k h a where
 --   sumC :: h a `k` a
 
-class (Ok k a, Additive a) => AddCat k h a where
+class Ok k a => AddCat k h a where
   sumAC :: h a `k` a
 
 -- class IxSummable n => IxSummableCat k n where
@@ -2330,7 +2334,7 @@ instance OkIxProd (->) h where okIxProd = Entail (Sub Dict)
 
 instance Zip h => IxMonoidalPCat (->) h where
   crossF = zipWith id -- 2018-02-07 notes
-  {-# OPINLINE crossF #-}
+  {-# INLINE crossF #-}
 
 instance (Representable h, Zip h, Pointed h) => IxProductCat (->) h where
   exF    = tabulate (flip index)

classes/src/ConCat/Experimental/A.hs

@@ -56,7 +56,7 @@ import Data.Constraint (Dict(..),(:-)(..),refl,trans,(\\))
 -- import Data.Key
 -- import Data.IntMap ()
 
-import ConCat.Misc (Yes1,type (&+&),inNew,inNew2,oops,type (+->)(..))
+import ConCat.Misc (Yes1,type (&+&),inNew,inNew2,type (+->)(..))
 -- import ConCat.Free.VectorSpace
 -- import ConCat.Free.LinearRow (lapplyL,OkLF,idL,compL,exlL,exrL,forkL,inlL,inrL,joinL,HasL(..))
 -- import ConCat.Rep

classes/src/ConCat/Misc.hs

@@ -21,7 +21,7 @@
 
 -- | Miscellany
 
-module ConCat.Misc where
+module ConCat.Misc(module ConCat.Misc, oops) where
 
 import GHC.Types (Constraint)
 
@@ -34,12 +34,12 @@ import Data.Monoid (Endo(..))
 import Data.Semigroup (Semigroup(..))
 import Data.Complex (Complex)
 import GHC.Generics hiding (R)
--- import Unsafe.Coerce (unsafeCoerce)  -- for oops
-import GHC.Stack (errorWithStackTrace)  -- for oops
 import GHC.TypeLits
 
 import Control.Newtype.Generics
 
+import ConCat.Oops
+
 {--------------------------------------------------------------------
     Type abbreviations
 -------------------------------------------------------------------
@@ -257,11 +257,6 @@ data PseudoFun = PseudoFun { pseudoArgs :: Int } deriving (Typeable,Data)
 -- pseudoFun :: Int -> PseudoFun
 -- pseudoFun = PseudoFun
 
--- | Pseudo function to fool GHC's divergence checker.
-oops :: String -> b
-oops str = errorWithStackTrace ("Oops: "++str)
-{-# NOINLINE oops #-}
-
 --     In the use of ‘errorWithStackTrace’ (imported from GHC.Stack):
 --     Deprecated: "'error' appends the call stack now"
 

classes/src/ConCat/Oops.hs

@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -O0 -fno-strictness #-}
+module ConCat.Oops(oops) where
+
+-- Both -O0 -fno-strictness are necessary to keep ghc 9 from
+-- discovering that this bombs.
+
+-- | Pseudo function to fool GHC's divergence checker.
+oops :: String -> b
+oops str = error ("Oops: "++str)
+{-# NOINLINE oops #-}
+