Created
July 29, 2016 08:02
-
-
Save harpocrates/e95ce275a2220dfbd50b102e1e533556 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Control.Arrow | |
| ============= | |
| "compose/arr" forall f g . | |
| (arr f) . (arr g) = arr (f . g) | |
| "first/arr" forall f . | |
| first (arr f) = arr (first f) | |
| "second/arr" forall f . | |
| second (arr f) = arr (second f) | |
| "product/arr" forall f g . | |
| arr f *** arr g = arr (f *** g) | |
| "fanout/arr" forall f g . | |
| arr f &&& arr g = arr (f &&& g) | |
| "compose/first" forall f g . | |
| (first f) . (first g) = first (f . g) | |
| "compose/second" forall f g . | |
| (second f) . (second g) = second (f . g) | |
| "left/arr" forall f . | |
| left (arr f) = arr (left f) | |
| "right/arr" forall f . | |
| right (arr f) = arr (right f) | |
| "sum/arr" forall f g . | |
| arr f +++ arr g = arr (f +++ g) | |
| "fanin/arr" forall f g . | |
| arr f ||| arr g = arr (f ||| g) | |
| "compose/left" forall f g . | |
| left f . left g = left (f . g) | |
| "compose/right" forall f g . | |
| right f . right g = right (f . g) | |
| Control.Category | |
| ================ | |
| "identity/left" forall p . | |
| id . p = p | |
| "identity/right" forall p . | |
| p . id = p | |
| "association" forall p q r . | |
| (p . q) . r = p . (q . r) | |
| Data.Maybe | |
| ========== | |
| "mapMaybe" [~1] forall f xs. | |
| mapMaybe f xs = build (\c n -> foldr (mapMaybeFB c f) n xs) | |
| "mapMaybeList" [1] forall f. | |
| foldr (mapMaybeFB (:) f) [] = mapMaybe f | |
| Data.OldList | |
| ============ | |
| "mapAccumL" [~1] forall f s xs . mapAccumL f s xs = foldr (mapAccumLF f) pairWithNil xs s | |
| "mapAccumLList" [1] forall f s xs . | |
| foldr (mapAccumLF f) pairWithNil xs s = mapAccumL f s xs | |
| "genericLengthInt" genericLength = (strictGenericLength :: [a] -> Int) | |
| "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer) | |
| "words" [~1] forall s . | |
| words s = build (\c n -> wordsFB c n s) | |
| "wordsList" [1] wordsFB (:) [] = words | |
| "unwords" [~1] forall ws . | |
| unwords ws = tailUnwords (foldr unwordsFB "" ws) | |
| "unwordsList" [1] forall ws . | |
| tailUnwords (foldr unwordsFB "" ws) = unwords ws | |
| Foreign.C.Types | |
| =============== | |
| "fromIntegral/a->CChar" fromIntegral = \x -> CChar (fromIntegral x) | |
| "fromIntegral/a->CSChar" fromIntegral = \x -> CSChar (fromIntegral x) | |
| "fromIntegral/a->CUChar" fromIntegral = \x -> CUChar (fromIntegral x) | |
| "fromIntegral/a->CShort" fromIntegral = \x -> CShort (fromIntegral x) | |
| "fromIntegral/a->CUShort" fromIntegral = \x -> CUShort (fromIntegral x) | |
| "fromIntegral/a->CInt" fromIntegral = \x -> CInt (fromIntegral x) | |
| "fromIntegral/a->CUInt" fromIntegral = \x -> CUInt (fromIntegral x) | |
| "fromIntegral/a->CLong" fromIntegral = \x -> CLong (fromIntegral x) | |
| "fromIntegral/a->CULong" fromIntegral = \x -> CULong (fromIntegral x) | |
| "fromIntegral/a->CLLong" fromIntegral = \x -> CLLong (fromIntegral x) | |
| "fromIntegral/a->CULLong" fromIntegral = \x -> CULLong (fromIntegral x) | |
| "fromIntegral/CChar->a" fromIntegral = \(CChar x) -> fromIntegral x | |
| "fromIntegral/CSChar->a" fromIntegral = \(CSChar x) -> fromIntegral x | |
| "fromIntegral/CUChar->a" fromIntegral = \(CUChar x) -> fromIntegral x | |
| "fromIntegral/CShort->a" fromIntegral = \(CShort x) -> fromIntegral x | |
| "fromIntegral/CUShort->a" fromIntegral = \(CUShort x) -> fromIntegral x | |
| "fromIntegral/CInt->a" fromIntegral = \(CInt x) -> fromIntegral x | |
| "fromIntegral/CUInt->a" fromIntegral = \(CUInt x) -> fromIntegral x | |
| "fromIntegral/CLong->a" fromIntegral = \(CLong x) -> fromIntegral x | |
| "fromIntegral/CULong->a" fromIntegral = \(CULong x) -> fromIntegral x | |
| "fromIntegral/CLLong->a" fromIntegral = \(CLLong x) -> fromIntegral x | |
| "fromIntegral/CULLong->a" fromIntegral = \(CULLong x) -> fromIntegral x | |
| "realToFrac/a->CFloat" realToFrac = \x -> CFloat (realToFrac x) | |
| "realToFrac/a->CDouble" realToFrac = \x -> CDouble (realToFrac x) | |
| "realToFrac/CFloat->a" realToFrac = \(CFloat x) -> realToFrac x | |
| "realToFrac/CDouble->a" realToFrac = \(CDouble x) -> realToFrac x | |
| "fromIntegral/a->CPtrdiff" fromIntegral = \x -> CPtrdiff (fromIntegral x) | |
| "fromIntegral/a->CSize" fromIntegral = \x -> CSize (fromIntegral x) | |
| "fromIntegral/a->CWchar" fromIntegral = \x -> CWchar (fromIntegral x) | |
| "fromIntegral/a->CSigAtomic" fromIntegral = \x -> CSigAtomic (fromIntegral x) | |
| "fromIntegral/CPtrdiff->a" fromIntegral = \(CPtrdiff x) -> fromIntegral x | |
| "fromIntegral/CSize->a" fromIntegral = \(CSize x) -> fromIntegral x | |
| "fromIntegral/CWchar->a" fromIntegral = \(CWchar x) -> fromIntegral x | |
| "fromIntegral/CSigAtomic->a" fromIntegral = \(CSigAtomic x) -> fromIntegral x | |
| "fromIntegral/a->CIntPtr" fromIntegral = \x -> CIntPtr (fromIntegral x) | |
| "fromIntegral/a->CUIntPtr" fromIntegral = \x -> CUIntPtr (fromIntegral x) | |
| "fromIntegral/a->CIntMax" fromIntegral = \x -> CIntMax (fromIntegral x) | |
| "fromIntegral/a->CUIntMax" fromIntegral = \x -> CUIntMax (fromIntegral x) | |
| GHC.Arr | |
| ======= | |
| "safeIndex/I" safeIndex = lessSafeIndex :: (Int,Int) -> Int -> Int -> Int | |
| "safeIndex/(I,I)" safeIndex = lessSafeIndex :: ((Int,Int),(Int,Int)) -> Int -> (Int,Int) -> Int | |
| "safeIndex/(I,I,I)" safeIndex = lessSafeIndex :: ((Int,Int,Int),(Int,Int,Int)) -> Int -> (Int,Int,Int) -> Int | |
| "amap/coerce" amap coerce = coerce -- See Note [amap] | |
| "amap/amap" forall f g a . amap f (amap g a) = amap (f . g) a | |
| "cmpArray/Int" cmpArray = cmpIntArray | |
| GHC.Base | |
| ======== | |
| "fold/build" forall k z (g::forall b. (a->b->b) -> b -> b) . | |
| foldr k z (build g) = g k z | |
| "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) . | |
| foldr k z (augment g xs) = g k (foldr k z xs) | |
| "foldr/id" foldr (:) [] = \x -> x | |
| "foldr/app" [1] forall ys. foldr (:) ys = \xs -> xs ++ ys | |
| -- Only activate this from phase 1, because that's | |
| -- when we disable the rule that expands (++) into foldr | |
| -- The foldr/cons rule looks nice, but it can give disastrously | |
| -- bloated code when commpiling | |
| -- array (a,b) [(1,2), (2,2), (3,2), ...very long list... ] | |
| -- i.e. when there are very very long literal lists | |
| -- So I've disabled it for now. We could have special cases | |
| -- for short lists, I suppose. | |
| -- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs) | |
| "foldr/single" forall k z x. foldr k z [x] = k x z | |
| "foldr/nil" forall k z. foldr k z [] = z | |
| "foldr/cons/build" forall k z x (g::forall b. (a->b->b) -> b -> b) . | |
| foldr k z (x:build g) = k x (g k z) | |
| "augment/build" forall (g::forall b. (a->b->b) -> b -> b) | |
| (h::forall b. (a->b->b) -> b -> b) . | |
| augment g (build h) = build (\c n -> g c (h c n)) | |
| "augment/nil" forall (g::forall b. (a->b->b) -> b -> b) . | |
| augment g [] = build g | |
| "map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs) | |
| "mapList" [1] forall f. foldr (mapFB (:) f) [] = map f | |
| "mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f.g) | |
| "map/coerce" [1] map coerce = coerce | |
| "++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys | |
| "eqString" (==) = eqString | |
| "unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a) | |
| "unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a | |
| "unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n | |
| -- There's a built-in rule (in PrelRules.lhs) for | |
| -- unpackFoldr "foo" c (unpackFoldr "baz" c n) = unpackFoldr "foobaz" c n | |
| GHC.Enum | |
| ======== | |
| "eftChar" [~1] forall x y. eftChar x y = build (\c n -> eftCharFB c n x y) | |
| "efdChar" [~1] forall x1 x2. efdChar x1 x2 = build (\ c n -> efdCharFB c n x1 x2) | |
| "efdtChar" [~1] forall x1 x2 l. efdtChar x1 x2 l = build (\ c n -> efdtCharFB c n x1 x2 l) | |
| "eftCharList" [1] eftCharFB (:) [] = eftChar | |
| "efdCharList" [1] efdCharFB (:) [] = efdChar | |
| "efdtCharList" [1] efdtCharFB (:) [] = efdtChar | |
| "eftInt" [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y) | |
| "eftIntList" [1] eftIntFB (:) [] = eftInt | |
| "efdtInt" [~1] forall x1 x2 y. | |
| efdtInt x1 x2 y = build (\ c n -> efdtIntFB c n x1 x2 y) | |
| "efdtIntUpList" [1] efdtIntFB (:) [] = efdtInt | |
| "eftWord" [~1] forall x y. eftWord x y = build (\ c n -> eftWordFB c n x y) | |
| "eftWordList" [1] eftWordFB (:) [] = eftWord | |
| "efdtWord" [~1] forall x1 x2 y. | |
| efdtWord x1 x2 y = build (\ c n -> efdtWordFB c n x1 x2 y) | |
| "efdtWordUpList" [1] efdtWordFB (:) [] = efdtWord | |
| "enumDeltaInteger" [~1] forall x y. enumDeltaInteger x y = build (\c _ -> enumDeltaIntegerFB c x y) | |
| "efdtInteger" [~1] forall x d l. enumDeltaToInteger x d l = build (\c n -> enumDeltaToIntegerFB c n x d l) | |
| "efdtInteger1" [~1] forall x l. enumDeltaToInteger x 1 l = build (\c n -> enumDeltaToInteger1FB c n x l) | |
| "enumDeltaToInteger1FB" [1] forall c n x. enumDeltaToIntegerFB c n x 1 = enumDeltaToInteger1FB c n x | |
| "enumDeltaInteger" [1] enumDeltaIntegerFB (:) = enumDeltaInteger | |
| "enumDeltaToInteger" [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger | |
| "enumDeltaToInteger1" [1] enumDeltaToInteger1FB (:) [] = enumDeltaToInteger1 | |
| GHC.Float | |
| ========= | |
| "properFraction/Float->Integer" properFraction = properFractionFloatInteger | |
| "truncate/Float->Integer" truncate = truncateFloatInteger | |
| "floor/Float->Integer" floor = floorFloatInteger | |
| "ceiling/Float->Integer" ceiling = ceilingFloatInteger | |
| "round/Float->Integer" round = roundFloatInteger | |
| "properFraction/Float->Int" properFraction = properFractionFloatInt | |
| "truncate/Float->Int" truncate = float2Int | |
| "floor/Float->Int" floor = floorFloatInt | |
| "ceiling/Float->Int" ceiling = ceilingFloatInt | |
| "round/Float->Int" round = roundFloatInt | |
| "properFraction/Double->Integer" properFraction = properFractionDoubleInteger | |
| "truncate/Double->Integer" truncate = truncateDoubleInteger | |
| "floor/Double->Integer" floor = floorDoubleInteger | |
| "ceiling/Double->Integer" ceiling = ceilingDoubleInteger | |
| "round/Double->Integer" round = roundDoubleInteger | |
| "properFraction/Double->Int" properFraction = properFractionDoubleInt | |
| "truncate/Double->Int" truncate = double2Int | |
| "floor/Double->Int" floor = floorDoubleInt | |
| "ceiling/Double->Int" ceiling = ceilingDoubleInt | |
| "round/Double->Int" round = roundDoubleInt | |
| "fromRat/Float" fromRat = (fromRational :: Rational -> Float) | |
| "fromRat/Double" fromRat = (fromRational :: Rational -> Double) | |
| "fromIntegral/Int->Float" fromIntegral = int2Float | |
| "fromIntegral/Int->Double" fromIntegral = int2Double | |
| "fromIntegral/Word->Float" fromIntegral = word2Float | |
| "fromIntegral/Word->Double" fromIntegral = word2Double | |
| "realToFrac/Float->Float" realToFrac = id :: Float -> Float | |
| "realToFrac/Float->Double" realToFrac = float2Double | |
| "realToFrac/Double->Float" realToFrac = double2Float | |
| "realToFrac/Double->Double" realToFrac = id :: Double -> Double | |
| "realToFrac/Int->Double" realToFrac = int2Double -- See Note [realToFrac int-to-float] | |
| "realToFrac/Int->Float" realToFrac = int2Float -- ..ditto | |
| GHC.Int | |
| ======= | |
| "fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8 | |
| "fromIntegral/a->Int8" fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#) | |
| "fromIntegral/Int8->a" fromIntegral = \(I8# x#) -> fromIntegral (I# x#) | |
| "properFraction/Float->(Int8,Float)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Int8) n, y :: Float) } | |
| "truncate/Float->Int8" | |
| truncate = (fromIntegral :: Int -> Int8) . (truncate :: Float -> Int) | |
| "floor/Float->Int8" | |
| floor = (fromIntegral :: Int -> Int8) . (floor :: Float -> Int) | |
| "ceiling/Float->Int8" | |
| ceiling = (fromIntegral :: Int -> Int8) . (ceiling :: Float -> Int) | |
| "round/Float->Int8" | |
| round = (fromIntegral :: Int -> Int8) . (round :: Float -> Int) | |
| "properFraction/Double->(Int8,Double)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Int8) n, y :: Double) } | |
| "truncate/Double->Int8" | |
| truncate = (fromIntegral :: Int -> Int8) . (truncate :: Double -> Int) | |
| "floor/Double->Int8" | |
| floor = (fromIntegral :: Int -> Int8) . (floor :: Double -> Int) | |
| "ceiling/Double->Int8" | |
| ceiling = (fromIntegral :: Int -> Int8) . (ceiling :: Double -> Int) | |
| "round/Double->Int8" | |
| round = (fromIntegral :: Int -> Int8) . (round :: Double -> Int) | |
| "fromIntegral/Word8->Int16" fromIntegral = \(W8# x#) -> I16# (word2Int# x#) | |
| "fromIntegral/Int8->Int16" fromIntegral = \(I8# x#) -> I16# x# | |
| "fromIntegral/Int16->Int16" fromIntegral = id :: Int16 -> Int16 | |
| "fromIntegral/a->Int16" fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (narrow16Int# x#) | |
| "fromIntegral/Int16->a" fromIntegral = \(I16# x#) -> fromIntegral (I# x#) | |
| "properFraction/Float->(Int16,Float)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Int16) n, y :: Float) } | |
| "truncate/Float->Int16" | |
| truncate = (fromIntegral :: Int -> Int16) . (truncate :: Float -> Int) | |
| "floor/Float->Int16" | |
| floor = (fromIntegral :: Int -> Int16) . (floor :: Float -> Int) | |
| "ceiling/Float->Int16" | |
| ceiling = (fromIntegral :: Int -> Int16) . (ceiling :: Float -> Int) | |
| "round/Float->Int16" | |
| round = (fromIntegral :: Int -> Int16) . (round :: Float -> Int) | |
| "properFraction/Double->(Int16,Double)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Int16) n, y :: Double) } | |
| "truncate/Double->Int16" | |
| truncate = (fromIntegral :: Int -> Int16) . (truncate :: Double -> Int) | |
| "floor/Double->Int16" | |
| floor = (fromIntegral :: Int -> Int16) . (floor :: Double -> Int) | |
| "ceiling/Double->Int16" | |
| ceiling = (fromIntegral :: Int -> Int16) . (ceiling :: Double -> Int) | |
| "round/Double->Int16" | |
| round = (fromIntegral :: Int -> Int16) . (round :: Double -> Int) | |
| "fromIntegral/Word8->Int32" fromIntegral = \(W8# x#) -> I32# (word2Int# x#) | |
| "fromIntegral/Word16->Int32" fromIntegral = \(W16# x#) -> I32# (word2Int# x#) | |
| "fromIntegral/Int8->Int32" fromIntegral = \(I8# x#) -> I32# x# | |
| "fromIntegral/Int16->Int32" fromIntegral = \(I16# x#) -> I32# x# | |
| "fromIntegral/Int32->Int32" fromIntegral = id :: Int32 -> Int32 | |
| "fromIntegral/a->Int32" fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (narrow32Int# x#) | |
| "fromIntegral/Int32->a" fromIntegral = \(I32# x#) -> fromIntegral (I# x#) | |
| "properFraction/Float->(Int32,Float)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Int32) n, y :: Float) } | |
| "truncate/Float->Int32" | |
| truncate = (fromIntegral :: Int -> Int32) . (truncate :: Float -> Int) | |
| "floor/Float->Int32" | |
| floor = (fromIntegral :: Int -> Int32) . (floor :: Float -> Int) | |
| "ceiling/Float->Int32" | |
| ceiling = (fromIntegral :: Int -> Int32) . (ceiling :: Float -> Int) | |
| "round/Float->Int32" | |
| round = (fromIntegral :: Int -> Int32) . (round :: Float -> Int) | |
| "properFraction/Double->(Int32,Double)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Int32) n, y :: Double) } | |
| "truncate/Double->Int32" | |
| truncate = (fromIntegral :: Int -> Int32) . (truncate :: Double -> Int) | |
| "floor/Double->Int32" | |
| floor = (fromIntegral :: Int -> Int32) . (floor :: Double -> Int) | |
| "ceiling/Double->Int32" | |
| ceiling = (fromIntegral :: Int -> Int32) . (ceiling :: Double -> Int) | |
| "round/Double->Int32" | |
| round = (fromIntegral :: Int -> Int32) . (round :: Double -> Int) | |
| "fromIntegral/Int->Int64" fromIntegral = \(I# x#) -> I64# (intToInt64# x#) | |
| "fromIntegral/Word->Int64" fromIntegral = \(W# x#) -> I64# (word64ToInt64# (wordToWord64# x#)) | |
| "fromIntegral/Word64->Int64" fromIntegral = \(W64# x#) -> I64# (word64ToInt64# x#) | |
| "fromIntegral/Int64->Int" fromIntegral = \(I64# x#) -> I# (int64ToInt# x#) | |
| "fromIntegral/Int64->Word" fromIntegral = \(I64# x#) -> W# (int2Word# (int64ToInt# x#)) | |
| "fromIntegral/Int64->Word64" fromIntegral = \(I64# x#) -> W64# (int64ToWord64# x#) | |
| "fromIntegral/Int64->Int64" fromIntegral = id :: Int64 -> Int64 | |
| "fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# x# | |
| "fromIntegral/Int64->a" fromIntegral = \(I64# x#) -> fromIntegral (I# x#) | |
| "properFraction/Float->(Int64,Float)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Float) } | |
| "truncate/Float->Int64" | |
| truncate = (fromIntegral :: Int -> Int64) . (truncate :: Float -> Int) | |
| "floor/Float->Int64" | |
| floor = (fromIntegral :: Int -> Int64) . (floor :: Float -> Int) | |
| "ceiling/Float->Int64" | |
| ceiling = (fromIntegral :: Int -> Int64) . (ceiling :: Float -> Int) | |
| "round/Float->Int64" | |
| round = (fromIntegral :: Int -> Int64) . (round :: Float -> Int) | |
| "properFraction/Double->(Int64,Double)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Double) } | |
| "truncate/Double->Int64" | |
| truncate = (fromIntegral :: Int -> Int64) . (truncate :: Double -> Int) | |
| "floor/Double->Int64" | |
| floor = (fromIntegral :: Int -> Int64) . (floor :: Double -> Int) | |
| "ceiling/Double->Int64" | |
| ceiling = (fromIntegral :: Int -> Int64) . (ceiling :: Double -> Int) | |
| "round/Double->Int64" | |
| round = (fromIntegral :: Int -> Int64) . (round :: Double -> Int) | |
| GHC.List | |
| ======== | |
| "head/build" forall (g::forall b.(a->b->b)->b->b) . | |
| head (build g) = g (\x _ -> x) badHead | |
| "head/augment" forall xs (g::forall b. (a->b->b) -> b -> b) . | |
| head (augment g xs) = g (\x _ -> x) (head xs) | |
| "length" [~1] forall xs . length xs = foldr lengthFB idLength xs 0 | |
| "lengthList" [1] foldr lengthFB idLength = lenAcc | |
| "filter" [~1] forall p xs. filter p xs = build (\c n -> foldr (filterFB c p) n xs) | |
| "filterList" [1] forall p. foldr (filterFB (:) p) [] = filter p | |
| "filterFB" forall c p q. filterFB (filterFB c p) q = filterFB c (\x -> q x && p x) | |
| "scanl" [~1] forall f a bs . scanl f a bs = | |
| build (\c n -> a `c` foldr (scanlFB f c) (constScanl n) bs a) | |
| "scanlList" [1] forall f (a::a) bs . | |
| foldr (scanlFB f (:)) (constScanl []) bs a = tail (scanl f a bs) | |
| "scanl'" [~1] forall f a bs . scanl' f a bs = | |
| build (\c n -> a `c` foldr (scanlFB' f c) (flipSeqScanl' n) bs a) | |
| "scanlList'" [1] forall f a bs . | |
| foldr (scanlFB' f (:)) (flipSeqScanl' []) bs a = tail (scanl' f a bs) | |
| "scanr" [~1] forall f q0 ls . scanr f q0 ls = | |
| build (\c n -> strictUncurryScanr c (foldr (scanrFB f c) (q0,n) ls)) | |
| "scanrList" [1] forall f q0 ls . | |
| strictUncurryScanr (:) (foldr (scanrFB f (:)) (q0,[]) ls) = | |
| scanr f q0 ls | |
| "iterate" [~1] forall f x. iterate f x = build (\c _n -> iterateFB c f x) | |
| "iterateFB" [1] iterateFB (:) = iterate | |
| "repeat" [~1] forall x. repeat x = build (\c _n -> repeatFB c x) | |
| "repeatFB" [1] repeatFB (:) = repeat | |
| "takeWhile" [~1] forall p xs. takeWhile p xs = | |
| build (\c n -> foldr (takeWhileFB p c n) n xs) | |
| "takeWhileList" [1] forall p. foldr (takeWhileFB p (:) []) [] = takeWhile p | |
| "takeWhileFB" forall c n p q. takeWhileFB q (takeWhileFB p c n) n = | |
| takeWhileFB (\x -> q x && p x) c n | |
| "take" [~1] forall n xs . take n xs = | |
| build (\c nil -> if 0 < n | |
| then foldr (takeFB c nil) (flipSeqTake nil) xs n | |
| else nil) | |
| "unsafeTakeList" [1] forall n xs . foldr (takeFB (:) []) (flipSeqTake []) xs n | |
| = unsafeTake n xs | |
| "and/build" forall (g::forall b.(Bool->b->b)->b->b) . | |
| and (build g) = g (&&) True | |
| "or/build" forall (g::forall b.(Bool->b->b)->b->b) . | |
| or (build g) = g (||) False | |
| "any/build" forall p (g::forall b.(a->b->b)->b->b) . | |
| any p (build g) = g ((||) . p) False | |
| "all/build" forall p (g::forall b.(a->b->b)->b->b) . | |
| all p (build g) = g ((&&) . p) True | |
| "elem/build" forall x (g :: forall b . Eq a => (a -> b -> b) -> b -> b) | |
| . elem x (build g) = g (\ y r -> (x == y) || r) False | |
| "notElem/build" forall x (g :: forall b . Eq a => (a -> b -> b) -> b -> b) | |
| . notElem x (build g) = g (\ y r -> (x /= y) && r) True | |
| "concatMap" forall f xs . concatMap f xs = | |
| build (\c n -> foldr (\x b -> foldr c b (f x)) n xs) | |
| "concat" forall xs. concat xs = | |
| build (\c n -> foldr (\x y -> foldr c y x) n xs) | |
| -- We don't bother to turn non-fusible applications of concat back into concat | |
| "foldr2/left" forall k z ys (g::forall b.(a->b->b)->b->b) . | |
| foldr2 k z (build g) ys = g (foldr2_left k z) (\_ -> z) ys | |
| "zip" [~1] forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys) | |
| "zipList" [1] foldr2 (zipFB (:)) [] = zip | |
| "zipWith" [~1] forall f xs ys. zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys) | |
| "zipWithList" [1] forall f. foldr2 (zipWithFB (:) f) [] = zipWith f | |
| GHC.Natural | |
| =========== | |
| "fromIntegral/Natural->Natural" fromIntegral = id :: Natural -> Natural | |
| "fromIntegral/Natural->Integer" fromIntegral = toInteger :: Natural->Integer | |
| "fromIntegral/Natural->Word" fromIntegral = naturalToWord | |
| "fromIntegral/Natural->Word8" | |
| fromIntegral = (fromIntegral :: Word -> Word8) . naturalToWord | |
| "fromIntegral/Natural->Word16" | |
| fromIntegral = (fromIntegral :: Word -> Word16) . naturalToWord | |
| "fromIntegral/Natural->Word32" | |
| fromIntegral = (fromIntegral :: Word -> Word32) . naturalToWord | |
| "fromIntegral/Natural->Int8" | |
| fromIntegral = (fromIntegral :: Int -> Int8) . naturalToInt | |
| "fromIntegral/Natural->Int16" | |
| fromIntegral = (fromIntegral :: Int -> Int16) . naturalToInt | |
| "fromIntegral/Natural->Int32" | |
| fromIntegral = (fromIntegral :: Int -> Int32) . naturalToInt | |
| "fromIntegral/Word->Natural" fromIntegral = wordToNatural | |
| "fromIntegral/Word8->Natural" | |
| fromIntegral = wordToNatural . (fromIntegral :: Word8 -> Word) | |
| "fromIntegral/Word16->Natural" | |
| fromIntegral = wordToNatural . (fromIntegral :: Word16 -> Word) | |
| "fromIntegral/Word32->Natural" | |
| fromIntegral = wordToNatural . (fromIntegral :: Word32 -> Word) | |
| "fromIntegral/Int->Natural" fromIntegral = intToNatural | |
| "fromIntegral/Int8->Natural" | |
| fromIntegral = intToNatural . (fromIntegral :: Int8 -> Int) | |
| "fromIntegral/Int16->Natural" | |
| fromIntegral = intToNatural . (fromIntegral :: Int16 -> Int) | |
| "fromIntegral/Int32->Natural" | |
| fromIntegral = intToNatural . (fromIntegral :: Int32 -> Int) | |
| "fromIntegral/Natural->Word64" | |
| fromIntegral = (fromIntegral :: Word -> Word64) . naturalToWord | |
| "fromIntegral/Natural->Int64" | |
| fromIntegral = (fromIntegral :: Int -> Int64) . naturalToInt | |
| "fromIntegral/Word64->Natural" | |
| fromIntegral = wordToNatural . (fromIntegral :: Word64 -> Word) | |
| "fromIntegral/Int64->Natural" | |
| fromIntegral = intToNatural . (fromIntegral :: Int64 -> Int) | |
| "gcd/Natural->Natural->Natural" gcd = gcdNatural | |
| "lcm/Natural->Natural->Natural" lcm = lcmNatural | |
| GHC.Real | |
| ======== | |
| "fromRational/id" fromRational = id :: Rational -> Rational | |
| "fromIntegral/Int->Int" fromIntegral = id :: Int -> Int | |
| "fromIntegral/Int->Word" fromIntegral = \(I# x#) -> W# (int2Word# x#) | |
| "fromIntegral/Word->Int" fromIntegral = \(W# x#) -> I# (word2Int# x#) | |
| "fromIntegral/Word->Word" fromIntegral = id :: Word -> Word | |
| "^2/Int" forall x. x ^ (2 :: Int) = let u = x in u*u | |
| "^3/Int" forall x. x ^ (3 :: Int) = let u = x in u*u*u | |
| "^4/Int" forall x. x ^ (4 :: Int) = let u = x in u*u*u*u | |
| "^5/Int" forall x. x ^ (5 :: Int) = let u = x in u*u*u*u*u | |
| "^2/Integer" forall x. x ^ (2 :: Integer) = let u = x in u*u | |
| "^3/Integer" forall x. x ^ (3 :: Integer) = let u = x in u*u*u | |
| "^4/Integer" forall x. x ^ (4 :: Integer) = let u = x in u*u*u*u | |
| "^5/Integer" forall x. x ^ (5 :: Integer) = let u = x in u*u*u*u*u | |
| "(^)/Rational" (^) = (^%^) | |
| "(^^)/Rational" (^^) = (^^%^^) | |
| "gcd/Int->Int->Int" gcd = gcdInt' | |
| "gcd/Integer->Integer->Integer" gcd = gcdInteger | |
| "lcm/Integer->Integer->Integer" lcm = lcmInteger | |
| "gcd/Word->Word->Word" gcd = gcdWord' | |
| GHC.Word | |
| ======== | |
| "fromIntegral/Word8->Word8" fromIntegral = id :: Word8 -> Word8 | |
| "fromIntegral/Word8->Integer" fromIntegral = toInteger :: Word8 -> Integer | |
| "fromIntegral/a->Word8" fromIntegral = \x -> case fromIntegral x of W# x# -> W8# (narrow8Word# x#) | |
| "fromIntegral/Word8->a" fromIntegral = \(W8# x#) -> fromIntegral (W# x#) | |
| "properFraction/Float->(Word8,Float)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Word8) n, y :: Float) } | |
| "truncate/Float->Word8" | |
| truncate = (fromIntegral :: Int -> Word8) . (truncate :: Float -> Int) | |
| "floor/Float->Word8" | |
| floor = (fromIntegral :: Int -> Word8) . (floor :: Float -> Int) | |
| "ceiling/Float->Word8" | |
| ceiling = (fromIntegral :: Int -> Word8) . (ceiling :: Float -> Int) | |
| "round/Float->Word8" | |
| round = (fromIntegral :: Int -> Word8) . (round :: Float -> Int) | |
| "properFraction/Double->(Word8,Double)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Word8) n, y :: Double) } | |
| "truncate/Double->Word8" | |
| truncate = (fromIntegral :: Int -> Word8) . (truncate :: Double -> Int) | |
| "floor/Double->Word8" | |
| floor = (fromIntegral :: Int -> Word8) . (floor :: Double -> Int) | |
| "ceiling/Double->Word8" | |
| ceiling = (fromIntegral :: Int -> Word8) . (ceiling :: Double -> Int) | |
| "round/Double->Word8" | |
| round = (fromIntegral :: Int -> Word8) . (round :: Double -> Int) | |
| "fromIntegral/Word8->Word16" fromIntegral = \(W8# x#) -> W16# x# | |
| "fromIntegral/Word16->Word16" fromIntegral = id :: Word16 -> Word16 | |
| "fromIntegral/Word16->Integer" fromIntegral = toInteger :: Word16 -> Integer | |
| "fromIntegral/a->Word16" fromIntegral = \x -> case fromIntegral x of W# x# -> W16# (narrow16Word# x#) | |
| "fromIntegral/Word16->a" fromIntegral = \(W16# x#) -> fromIntegral (W# x#) | |
| "properFraction/Float->(Word16,Float)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Word16) n, y :: Float) } | |
| "truncate/Float->Word16" | |
| truncate = (fromIntegral :: Int -> Word16) . (truncate :: Float -> Int) | |
| "floor/Float->Word16" | |
| floor = (fromIntegral :: Int -> Word16) . (floor :: Float -> Int) | |
| "ceiling/Float->Word16" | |
| ceiling = (fromIntegral :: Int -> Word16) . (ceiling :: Float -> Int) | |
| "round/Float->Word16" | |
| round = (fromIntegral :: Int -> Word16) . (round :: Float -> Int) | |
| "properFraction/Double->(Word16,Double)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Word16) n, y :: Double) } | |
| "truncate/Double->Word16" | |
| truncate = (fromIntegral :: Int -> Word16) . (truncate :: Double -> Int) | |
| "floor/Double->Word16" | |
| floor = (fromIntegral :: Int -> Word16) . (floor :: Double -> Int) | |
| "ceiling/Double->Word16" | |
| ceiling = (fromIntegral :: Int -> Word16) . (ceiling :: Double -> Int) | |
| "round/Double->Word16" | |
| round = (fromIntegral :: Int -> Word16) . (round :: Double -> Int) | |
| "properFraction/Float->(Word32,Float)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Word32) n, y :: Float) } | |
| "truncate/Float->Word32" | |
| truncate = (fromIntegral :: Int -> Word32) . (truncate :: Float -> Int) | |
| "floor/Float->Word32" | |
| floor = (fromIntegral :: Int -> Word32) . (floor :: Float -> Int) | |
| "ceiling/Float->Word32" | |
| ceiling = (fromIntegral :: Int -> Word32) . (ceiling :: Float -> Int) | |
| "round/Float->Word32" | |
| round = (fromIntegral :: Int -> Word32) . (round :: Float -> Int) | |
| "properFraction/Double->(Word32,Double)" | |
| properFraction = \x -> | |
| case properFraction x of { | |
| (n, y) -> ((fromIntegral :: Int -> Word32) n, y :: Double) } | |
| "truncate/Double->Word32" | |
| truncate = (fromIntegral :: Int -> Word32) . (truncate :: Double -> Int) | |
| "floor/Double->Word32" | |
| floor = (fromIntegral :: Int -> Word32) . (floor :: Double -> Int) | |
| "ceiling/Double->Word32" | |
| ceiling = (fromIntegral :: Int -> Word32) . (ceiling :: Double -> Int) | |
| "round/Double->Word32" | |
| round = (fromIntegral :: Int -> Word32) . (round :: Double -> Int) | |
| "fromIntegral/Word8->Word32" fromIntegral = \(W8# x#) -> W32# x# | |
| "fromIntegral/Word16->Word32" fromIntegral = \(W16# x#) -> W32# x# | |
| "fromIntegral/Word32->Word32" fromIntegral = id :: Word32 -> Word32 | |
| "fromIntegral/Word32->Integer" fromIntegral = toInteger :: Word32 -> Integer | |
| "fromIntegral/a->Word32" fromIntegral = \x -> case fromIntegral x of W# x# -> W32# (narrow32Word# x#) | |
| "fromIntegral/Word32->a" fromIntegral = \(W32# x#) -> fromIntegral (W# x#) | |
| "fromIntegral/Int->Word64" fromIntegral = \(I# x#) -> W64# (int64ToWord64# (intToInt64# x#)) | |
| "fromIntegral/Word->Word64" fromIntegral = \(W# x#) -> W64# (wordToWord64# x#) | |
| "fromIntegral/Word64->Int" fromIntegral = \(W64# x#) -> I# (word2Int# (word64ToWord# x#)) | |
| "fromIntegral/Word64->Word" fromIntegral = \(W64# x#) -> W# (word64ToWord# x#) | |
| "fromIntegral/Word64->Word64" fromIntegral = id :: Word64 -> Word64 | |
| "fromIntegral/a->Word64" fromIntegral = \x -> case fromIntegral x of W# x# -> W64# x# | |
| "fromIntegral/Word64->a" fromIntegral = \(W64# x#) -> fromIntegral (W# x#) | |
| Text.Read.Lex | |
| ============= | |
| "val/Integer" val = valInteger |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment