adding instances to ordlist to support improving ghc asymptotics when doingwip/carter/ordlist-it-all

recursive tree structured list concatenation

1 files changed, 22 insertions, 0 deletions

diff --git a/compiler/utils/OrdList.hs b/compiler/utils/OrdList.hs
index 8da5038b2c..a764ce69d1 100644
--- a/compiler/utils/OrdList.hs
+++ b/compiler/utils/OrdList.hs
@@ -11,6 +11,7 @@ can be appended in linear time.
 {-# LANGUAGE DeriveFunctor #-}
 
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module OrdList (
         OrdList,
@@ -20,6 +21,9 @@ module OrdList (
         strictlyEqOL, strictlyOrdOL
 ) where
 
+import qualified GHC.Exts as GE (IsList(..))
+import qualified Control.Monad.Zip as CMZ
+
 import GhcPrelude
 import Data.Foldable
 
@@ -44,6 +48,24 @@ data OrdList a
 instance Outputable a => Outputable (OrdList a) where
   ppr ol = ppr (fromOL ol)  -- Convert to list and print that
 
+instance GE.IsList (OrdList a) where
+  type instance Item (OrdList a) = a
+  fromList = toOL
+  toList   = fromOL
+
+
+instance Applicative OrdList where
+  pure = One
+  (<*>) = \ fs as ->  GE.fromList $ (GE.toList fs) <*> (GE.toList as)
+
+instance Monad OrdList where
+  (>>=) = \ ms fa ->  GE.fromList $ (GE.toList ms >>= ( GE.toList  . fa ) )
+
+instance CMZ.MonadZip OrdList where
+    mzip     = \ a b ->  GE.fromList $ zip  (GE.toList  a) (GE.toList b)
+    mzipWith = \ f a b -> GE.fromList $ zipWith f (GE.toList a) (GE.toList b)
+    munzip   =  \ls ->  case unzip $ GE.toList ls of (la,lb) -> (GE.fromList la, GE.fromList lb)
+
 instance Semigroup (OrdList a) where
   (<>) = appOL