diff options
Diffstat (limited to 'hypsrc-test/src')
-rw-r--r-- | hypsrc-test/src/Classes.hs | 38 | ||||
-rw-r--r-- | hypsrc-test/src/Constructors.hs | 35 | ||||
-rw-r--r-- | hypsrc-test/src/Identifiers.hs | 28 | ||||
-rw-r--r-- | hypsrc-test/src/Literals.hs | 17 | ||||
-rw-r--r-- | hypsrc-test/src/Operators.hs | 22 | ||||
-rw-r--r-- | hypsrc-test/src/Polymorphism.hs | 66 | ||||
-rw-r--r-- | hypsrc-test/src/Records.hs | 34 | ||||
-rw-r--r-- | hypsrc-test/src/Types.hs | 42 |
8 files changed, 282 insertions, 0 deletions
diff --git a/hypsrc-test/src/Classes.hs b/hypsrc-test/src/Classes.hs new file mode 100644 index 00000000..b3c3f785 --- /dev/null +++ b/hypsrc-test/src/Classes.hs @@ -0,0 +1,38 @@ +module Classes where + + +class Foo a where + bar :: a -> Int + baz :: Int -> (a, a) + +instance Foo Int where + bar = id + baz x = (x, x) + +instance Foo [a] where + bar = length + baz _ = ([], []) + + +class Foo a => Foo' a where + quux :: (a, a) -> a + quux (x, y) = norf [x, y] + + norf :: [a] -> a + norf = quux . baz . sum . map bar + +instance Foo' Int where + norf = sum + +instance Foo' [a] where + quux = uncurry (++) + + +class Plugh p where + plugh :: p a a -> p b b -> p (a -> b) (b -> a) + +instance Plugh Either where + plugh (Left a) _ = Right $ const a + plugh (Right a) _ = Right $ const a + plugh _ (Left b) = Left $ const b + plugh _ (Right b) = Left $ const b diff --git a/hypsrc-test/src/Constructors.hs b/hypsrc-test/src/Constructors.hs new file mode 100644 index 00000000..8cb46535 --- /dev/null +++ b/hypsrc-test/src/Constructors.hs @@ -0,0 +1,35 @@ +module Constructors where + + +data Foo + = Bar + | Baz + | Quux Foo Int + +newtype Norf = Norf (Foo, [Foo], Foo) + + +bar, baz, quux :: Foo +bar = Bar +baz = Baz +quux = Quux quux 0 + + +unfoo :: Foo -> Int +unfoo Bar = 0 +unfoo Baz = 0 +unfoo (Quux foo n) = 42 * n + unfoo foo + + +unnorf :: Norf -> [Foo] +unnorf (Norf (Bar, xs, Bar)) = xs +unnorf (Norf (Baz, xs, Baz)) = reverse xs +unnorf _ = undefined + + +unnorf' :: Norf -> Int +unnorf' x@(Norf (f1@(Quux _ n), _, f2@(Quux f3 _))) = + x' + n * unfoo f1 + aux f3 + where + aux fx = unfoo f2 * unfoo fx * unfoo f3 + x' = sum . map unfoo . unnorf $ x diff --git a/hypsrc-test/src/Identifiers.hs b/hypsrc-test/src/Identifiers.hs new file mode 100644 index 00000000..173c3ba7 --- /dev/null +++ b/hypsrc-test/src/Identifiers.hs @@ -0,0 +1,28 @@ +module Identifiers where + + +foo, bar, baz :: Int -> Int -> Int +foo x y = x + x * bar y x * y + y +bar x y = y + x - baz x y - x + y +baz x y = x * y * y * y * x + +quux :: Int -> Int +quux x = foo (bar x x) (bar x x) + +norf :: Int -> Int -> Int -> Int +norf x y z + | x < 0 = quux x + | y < 0 = quux y + | z < 0 = quux z + | otherwise = norf (-x) (-y) (-z) + + +main :: IO () +main = do + putStrLn . show $ foo x y + putStrLn . show $ quux z + putStrLn . show $ Identifiers.norf x y z + where + x = 10 + y = 20 + z = 30 diff --git a/hypsrc-test/src/Literals.hs b/hypsrc-test/src/Literals.hs new file mode 100644 index 00000000..997b6615 --- /dev/null +++ b/hypsrc-test/src/Literals.hs @@ -0,0 +1,17 @@ +module Literals where + + +str :: String +str = "str literal" + +num :: Num a => a +num = 0 + 1 + 1010011 * 41231 + 12131 + +frac :: Fractional a => a +frac = 42.0000001 + +list :: [[[[a]]]] +list = [[], [[]], [[[]]]] + +pair :: ((), ((), (), ()), ()) +pair = ((), ((), (), ()), ()) diff --git a/hypsrc-test/src/Operators.hs b/hypsrc-test/src/Operators.hs new file mode 100644 index 00000000..8e86ab0b --- /dev/null +++ b/hypsrc-test/src/Operators.hs @@ -0,0 +1,22 @@ +module Operators where + + +(+++) :: [a] -> [a] -> [a] +a +++ b = a ++ b ++ a + +($$$) :: [a] -> [a] -> [a] +a $$$ b = b +++ a + +(***) :: [a] -> [a] -> [a] +(***) a [] = a +(***) a (_:b) = a +++ (a *** b) + +(*/\*) :: [[a]] -> [a] -> [a] +a */\* b = concatMap (*** b) a + +(**/\**) :: [[a]] -> [[a]] -> [[a]] +a **/\** b = zipWith (*/\*) [a +++ b] (a $$$ b) + + +(#.#) :: a -> b -> (c -> (a, b)) +a #.# b = const $ (a, b) diff --git a/hypsrc-test/src/Polymorphism.hs b/hypsrc-test/src/Polymorphism.hs new file mode 100644 index 00000000..a74ac492 --- /dev/null +++ b/hypsrc-test/src/Polymorphism.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + + +module Polymorphism where + + +foo :: a -> a -> a +foo = undefined + +foo' :: forall a. a -> a -> a +foo' = undefined + +bar :: a -> b -> (a, b) +bar = undefined + +bar' :: forall a b. a -> b -> (a, b) +bar' = undefined + +baz :: a -> (a -> [a -> a] -> b) -> b +baz = undefined + +baz' :: forall a b. a -> (a -> [a -> a] -> b) -> b +baz' = undefined + +quux :: a -> (forall a. a -> a) -> a +quux = undefined + +quux' :: forall a. a -> (forall a. a -> a) -> a +quux' = undefined + + +num :: Num a => a -> a -> a +num = undefined + +num' :: forall a. Num a => a -> a -> a +num' = undefined + +eq :: (Eq a, Eq b) => [a] -> [b] -> (a, b) +eq = undefined + +eq' :: forall a b. (Eq a, Eq b) => [a] -> [b] -> (a, b) +eq' = undefined + +mon :: Monad m => (a -> m a) -> m a +mon = undefined + +mon' :: forall m a. Monad m => (a -> m a) -> m a +mon' = undefined + + +norf :: a -> (forall a. Ord a => a -> a) -> a +norf = undefined + +norf' :: forall a. a -> (forall a. Ord a => a -> a) -> a +norf' = undefined + + +plugh :: forall a. a -> a +plugh x = x :: a + +thud :: forall a b. (a -> b) -> a -> (a, b) +thud f x = + (x :: a, y) :: (a, b) + where + y = (f :: a -> b) x :: b diff --git a/hypsrc-test/src/Records.hs b/hypsrc-test/src/Records.hs new file mode 100644 index 00000000..40a01121 --- /dev/null +++ b/hypsrc-test/src/Records.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} + + +module Records where + + +data Point = Point + { x :: !Int + , y :: !Int + } + + +point :: Int -> Int -> Point +point x y = Point { x = x, y = y } + + +lengthSqr :: Point -> Int +lengthSqr (Point { x = x, y = y }) = x * x + y * y + +lengthSqr' :: Point -> Int +lengthSqr' (Point { x, y }) = y * y + x * x + + +translateX, translateY :: Point -> Int -> Point +translateX p d = p { x = x p + d } +translateY p d = p { y = y p + d } + +translate :: Int -> Int -> Point -> Point +translate x y p = + aux p + where + (dx, dy) = (x, y) + aux Point{..} = p { x = x + dx, y = y + dy } diff --git a/hypsrc-test/src/Types.hs b/hypsrc-test/src/Types.hs new file mode 100644 index 00000000..b63a825b --- /dev/null +++ b/hypsrc-test/src/Types.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE TypeFamilies #-} + + +module Types where + + +data Quux = Bar | Baz + +newtype Foo = Foo () + +type FooQuux = (Foo, Quux) +type QuuxFoo = (Quux, Foo) + + +data family Norf a b + +data instance Norf Foo Quux = NFQ Foo Quux +data instance Norf Quux Foo = NQF Quux Foo + + +type family Norf' a b + +type instance Norf' Foo Quux = (Foo, Quux) +type instance Norf' Quux Foo = (Quux, Foo) + + +norf1 :: Norf Foo Quux -> Int +norf1 (NFQ (Foo ()) Bar) = 0 +norf1 (NFQ (Foo ()) Baz) = 1 + +norf2 :: Norf Quux Foo -> Int +norf2 (NQF Bar (Foo ())) = 0 +norf2 (NQF Baz (Foo ())) = 1 + + +norf1' :: Norf' Foo Quux -> Int +norf1' (Foo (), Bar) = 0 +norf1' (Foo (), Baz) = 1 + +norf2' :: Norf' Quux Foo -> Int +norf2' (Bar, Foo ()) = 0 +norf2' (Baz, Foo ()) = 1 |