Added semigroupOrdering instance

Added semigroupOrdering instance

module Prelude
  ( otherwise
  , flip
  , const
  , asTypeOf
  , Semigroupoid, (<<<), (>>>)
  , Category, id
  , ($), (#)
  , (:), cons
  , Show, show
  , Functor, (<$>), (<#>), void
  , Apply, (<*>)
  , Applicative, pure, liftA1
  , Bind, (>>=)
  , Monad, return, liftM1, ap
  , Semiring, (+), zero, (*), one
  , ModuloSemiring, (/), mod
  , Ring, (-)
  , (%)
  , negate
  , DivisionRing
  , Num
  , Eq, (==), (/=), refEq, refIneq
  , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
  , Bits, (.&.), (.|.), (.^.), shl, shr, zshr, complement
  , BoolLike, (&&), (||)
  , not
  , Semigroup, (<>), (++)
  , Unit(..), unit
  ) where

  -- | An alias for `true`, which can be useful in guard clauses:
  -- |
  -- | E.g.
  -- |
  -- |     max x y | x >= y = x
  -- |             | otherwise = y
  otherwise :: Boolean
  otherwise = true

  -- | Flips the order of the arguments to a function of two arguments.
  flip :: forall a b c. (a -> b -> c) -> b -> a -> c
  flip f b a = f a b

  -- | Returns its first argument and ignores its second.
  const :: forall a b. a -> b -> a
  const a _ = a

  -- | This function returns its first argument, and can be used to assert type equalities.
  -- | This can be useful when types are otherwise ambiguous.
  -- |
  -- | E.g.
  -- |
  -- |     main = print $ [] `asTypeOf` [0]
  -- |
  -- | If instead, we had written `main = print []`, the type of the argument `[]` would have
  -- | been ambiguous, resulting in a compile-time error.
  asTypeOf :: forall a. a -> a -> a
  asTypeOf x _ = x

  infixr 9 >>>
  infixr 9 <<<

  class Semigroupoid a where
    (<<<) :: forall b c d. a c d -> a b c -> a b d

  instance semigroupoidArr :: Semigroupoid (->) where
    (<<<) f g x = f (g x)

  (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
  (>>>) f g = g <<< f

  class (Semigroupoid a) <= Category a where
    id :: forall t. a t t

  instance categoryArr :: Category (->) where
    id x = x

  infixr 0 $
  infixl 0 #

  ($) :: forall a b. (a -> b) -> a -> b
  ($) f x = f x

  (#) :: forall a b. a -> (a -> b) -> b
  (#) x f = f x

  infixr 6 :

  (:) :: forall a. a -> [a] -> [a]
  (:) = cons

  foreign import cons
    """
    function cons(e) {
      return function(l) {
        return [e].concat(l);
      };
    }
    """ :: forall a. a -> [a] -> [a]

  class Show a where
    show :: a -> String

  foreign import showStringImpl
    """
    function showStringImpl(s) {
      return JSON.stringify(s);
    }
    """ :: String -> String

  instance showUnit :: Show Unit where
    show (Unit {}) = "Unit {}"

  instance showString :: Show String where
    show = showStringImpl

  instance showBoolean :: Show Boolean where
    show true = "true"
    show false = "false"

  foreign import showNumberImpl
    """
    function showNumberImpl(n) {
      return n.toString();
    }
    """ :: Number -> String

  instance showNumber :: Show Number where
    show = showNumberImpl

  foreign import showArrayImpl
    """
    function showArrayImpl(f) {
      return function(xs) {
        var ss = [];
        for (var i = 0, l = xs.length; i < l; i++) {
          ss[i] = f(xs[i]);
        }
        return '[' + ss.join(',') + ']';
      };
    }
    """ :: forall a. (a -> String) -> [a] -> String

  instance showArray :: (Show a) => Show [a] where
    show = showArrayImpl show

  infixl 4 <$>
  infixl 1 <#>

  class Functor f where
    (<$>) :: forall a b. (a -> b) -> f a -> f b

  (<#>) :: forall f a b. (Functor f) => f a -> (a -> b) -> f b
  (<#>) fa f = f <$> fa

  void :: forall f a. (Functor f) => f a -> f Unit
  void fa = const unit <$> fa

  infixl 4 <*>

  class (Functor f) <= Apply f where
    (<*>) :: forall a b. f (a -> b) -> f a -> f b

  class (Apply f) <= Applicative f where
    pure :: forall a. a -> f a

  liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
  liftA1 f a = pure f <*> a

  infixl 1 >>=

  class (Apply m) <= Bind m where
    (>>=) :: forall a b. m a -> (a -> m b) -> m b

  class (Applicative m, Bind m) <= Monad m

  return :: forall m a. (Monad m) => a -> m a
  return = pure

  liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
  liftM1 f a = do
    a' <- a
    return (f a')

  ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
  ap f a = do
    f' <- f
    a' <- a
    return (f' a')

  instance functorArr :: Functor ((->) r) where
    (<$>) = (<<<)

  instance applyArr :: Apply ((->) r) where
    (<*>) f g x = f x (g x)

  instance applicativeArr :: Applicative ((->) r) where
    pure = const

  instance bindArr :: Bind ((->) r) where
    (>>=) m f x = f (m x) x

  instance monadArr :: Monad ((->) r)

  infixl 7 *
  infixl 7 /
  infixl 7 %

  infixl 6 -
  infixl 6 +

  -- | Addition and multiplication
  class Semiring a where
    (+)  :: a -> a -> a
    zero :: a
    (*)  :: a -> a -> a
    one  :: a

  -- | Semiring with modulo operation and division where
  -- | ```a / b * b + (a `mod` b) = a```
  class (Semiring a) <= ModuloSemiring a where
    (/) :: a -> a -> a
    mod :: a -> a -> a

  -- | Addition, multiplication, and subtraction
  class (Semiring a) <= Ring a where
    (-) :: a -> a -> a

  negate :: forall a. (Ring a) => a -> a
  negate a = zero - a

  -- | Ring where every nonzero element has a multiplicative inverse (possibly
  -- | a non-commutative field) so that ```a `mod` b = zero```
  class (Ring a, ModuloSemiring a) <= DivisionRing a

  -- | A commutative field
  class (DivisionRing a) <= Num a

  foreign import numAdd
    """
    function numAdd(n1) {
      return function(n2) {
        return n1 + n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numSub
    """
    function numSub(n1) {
      return function(n2) {
        return n1 - n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numMul
    """
    function numMul(n1) {
      return function(n2) {
        return n1 * n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numDiv
    """
    function numDiv(n1) {
      return function(n2) {
        return n1 / n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numMod
    """
    function numMod(n1) {
      return function(n2) {
        return n1 % n2;
      };
    }
    """ :: Number -> Number -> Number

  (%) = numMod

  instance semiringNumber :: Semiring Number where
    (+) = numAdd
    zero = 0
    (*) = numMul
    one = 1

  instance ringNumber :: Ring Number where
    (-) = numSub

  instance moduloSemiringNumber :: ModuloSemiring Number where
    (/) = numDiv
    mod _ _ = 0

  instance divisionRingNumber :: DivisionRing Number

  instance numNumber :: Num Number

  newtype Unit = Unit {}

  unit :: Unit
  unit = Unit {}

  infix 4 ==
  infix 4 /=

  class Eq a where
    (==) :: a -> a -> Boolean
    (/=) :: a -> a -> Boolean

  foreign import refEq
    """
    function refEq(r1) {
      return function(r2) {
        return r1 === r2;
      };
    }
    """ :: forall a. a -> a -> Boolean

  foreign import refIneq
    """
    function refIneq(r1) {
      return function(r2) {
        return r1 !== r2;
      };
    }
    """ :: forall a. a -> a -> Boolean

  instance eqUnit :: Eq Unit where
    (==) (Unit {}) (Unit {}) = true
    (/=) (Unit {}) (Unit {}) = false

  instance eqString :: Eq String where
    (==) = refEq
    (/=) = refIneq

  instance eqNumber :: Eq Number where
    (==) = refEq
    (/=) = refIneq

  instance eqBoolean :: Eq Boolean where
    (==) = refEq
    (/=) = refIneq

  foreign import eqArrayImpl
    """
    function eqArrayImpl(f) {
      return function(xs) {
        return function(ys) {
          if (xs.length !== ys.length) return false;
          for (var i = 0; i < xs.length; i++) {
            if (!f(xs[i])(ys[i])) return false;
          }
          return true;
        };
      };
    }
    """ :: forall a. (a -> a -> Boolean) -> [a] -> [a] -> Boolean

  instance eqArray :: (Eq a) => Eq [a] where
    (==) xs ys = eqArrayImpl (==) xs ys
    (/=) xs ys = not (xs == ys)

  data Ordering = LT | GT | EQ

  instance eqOrdering :: Eq Ordering where
    (==) LT LT = true
    (==) GT GT = true
    (==) EQ EQ = true
    (==) _  _  = false
    (/=) x y = not (x == y)

  instance showOrdering :: Show Ordering where
    show LT = "LT"
    show GT = "GT"
    show EQ = "EQ"

  instance semigroupOrdening :: Semigroup Ordering where
    (<>) LT _ = LT
    (<>) GT _ = GT
    (<>) EQ y = y

  class (Eq a) <= Ord a where
    compare :: a -> a -> Ordering

  infixl 4 <

  (<) :: forall a. (Ord a) => a -> a -> Boolean
  (<) a1 a2 = case a1 `compare` a2 of
    LT -> true
    _ -> false

  infixl 4 >

  (>) :: forall a. (Ord a) => a -> a -> Boolean
  (>) a1 a2 = case a1 `compare` a2 of
    GT -> true
    _ -> false

  infixl 4 <=

  (<=) :: forall a. (Ord a) => a -> a -> Boolean
  (<=) a1 a2 = case a1 `compare` a2 of
    GT -> false
    _ -> true

  infixl 4 >=

  (>=) :: forall a. (Ord a) => a -> a -> Boolean
  (>=) a1 a2 = case a1 `compare` a2 of
    LT -> false
    _ -> true

  foreign import unsafeCompareImpl
    """
    function unsafeCompareImpl(lt) {
      return function(eq) {
        return function(gt) {
          return function(x) {
            return function(y) {
              return x < y ? lt : x > y ? gt : eq;
            };
          };
        };
      };
    }
    """ :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering

  unsafeCompare :: forall a. a -> a -> Ordering
  unsafeCompare = unsafeCompareImpl LT EQ GT

  instance ordUnit :: Ord Unit where
    compare (Unit {}) (Unit {}) = EQ

  instance ordBoolean :: Ord Boolean where
    compare false false = EQ
    compare false true  = LT
    compare true  true  = EQ
    compare true  false = GT

  instance ordNumber :: Ord Number where
    compare = unsafeCompare

  instance ordString :: Ord String where
    compare = unsafeCompare

  instance ordArray :: (Ord a) => Ord [a] where
    compare [] [] = EQ
    compare [] _ = LT
    compare _ [] = GT
    compare (x:xs) (y:ys) = case compare x y of
      EQ -> compare xs ys
      other -> other

  infixl 10 .&.
  infixl 10 .|.
  infixl 10 .^.

  class Bits b where
    (.&.) :: b -> b -> b
    (.|.) :: b -> b -> b
    (.^.) :: b -> b -> b
    shl :: b -> Number -> b
    shr :: b -> Number -> b
    zshr :: b -> Number -> b
    complement :: b -> b

  foreign import numShl
    """
    function numShl(n1) {
      return function(n2) {
        return n1 << n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numShr
    """
    function numShr(n1) {
      return function(n2) {
        return n1 >> n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numZshr
    """
    function numZshr(n1) {
      return function(n2) {
        return n1 >>> n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numAnd
    """
    function numAnd(n1) {
      return function(n2) {
        return n1 & n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numOr
    """
    function numOr(n1) {
      return function(n2) {
        return n1 | n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numXor
    """
    function numXor(n1) {
      return function(n2) {
        return n1 ^ n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numComplement
    """
    function numComplement(n) {
      return ~n;
    }
    """ :: Number -> Number

  instance bitsNumber :: Bits Number where
    (.&.) = numAnd
    (.|.) = numOr
    (.^.) = numXor
    shl = numShl
    shr = numShr
    zshr = numZshr
    complement = numComplement

  infixr 2 ||
  infixr 3 &&

  class BoolLike b where
    (&&) :: b -> b -> b
    (||) :: b -> b -> b
    not :: b -> b

  foreign import boolAnd
    """
    function boolAnd(b1) {
      return function(b2) {
        return b1 && b2;
      };
    }
    """  :: Boolean -> Boolean -> Boolean

  foreign import boolOr
    """
    function boolOr(b1) {
      return function(b2) {
        return b1 || b2;
      };
    }
    """ :: Boolean -> Boolean -> Boolean

  foreign import boolNot
    """
    function boolNot(b) {
      return !b;
    }
    """ :: Boolean -> Boolean

  instance boolLikeBoolean :: BoolLike Boolean where
    (&&) = boolAnd
    (||) = boolOr
    not = boolNot

  infixr 5 <>

  class Semigroup a where
    (<>) :: a -> a -> a

  foreign import concatString
    """
    function concatString(s1) {
      return function(s2) {
        return s1 + s2;
      };
    }
    """ :: String -> String -> String

  instance semigroupUnit :: Semigroup Unit where
    (<>) (Unit {}) (Unit {}) = Unit {}

  instance semigroupString :: Semigroup String where
    (<>) = concatString

  instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where
    (<>) f g = \x -> f x <> g x

  infixr 5 ++

  (++) :: forall s. (Semigroup s) => s -> s -> s
  (++) = (<>)

module Data.Function where

  on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
  on f g x y = g x `f` g y

  foreign import data Fn0 :: * -> *
  foreign import data Fn1 :: * -> * -> *
  foreign import data Fn2 :: * -> * -> * -> *
  foreign import data Fn3 :: * -> * -> * -> * -> *
  foreign import data Fn4 :: * -> * -> * -> * -> * -> *
  foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *
  foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *

  foreign import mkFn0
    """
    function mkFn0(fn) {
      return function() {
        return fn({});
      };
    }
    """ :: forall a. (Unit -> a) -> Fn0 a

  foreign import mkFn1
    """
    function mkFn1(fn) {
      return function(a) {
        return fn(a);
      };
    }
    """ :: forall a b. (a -> b) -> Fn1 a b

  foreign import mkFn2
    """
    function mkFn2(fn) {
      return function(a, b) {
        return fn(a)(b);
      };
    }
    """ :: forall a b c. (a -> b -> c) -> Fn2 a b c

  foreign import mkFn3
    """
    function mkFn3(fn) {
      return function(a, b, c) {
        return fn(a)(b)(c);
      };
    }
    """ :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d

  foreign import mkFn4
    """
    function mkFn4(fn) {
      return function(a, b, c, d) {
        return fn(a)(b)(c)(d);
      };
    }
    """ :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e

  foreign import mkFn5
    """
    function mkFn5(fn) {
      return function(a, b, c, d, e) {
        return fn(a)(b)(c)(d)(e);
      };
    }
    """ :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f

  foreign import mkFn6
    """
    function mkFn6(fn) {
      return function(a, b, c, d, e, f) {
        return fn(a)(b)(c)(d)(e)(f);
      };
    }
    """ :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g

  foreign import mkFn7
    """
    function mkFn7(fn) {
      return function(a, b, c, d, e, f, g) {
        return fn(a)(b)(c)(d)(e)(f)(g);
      };
    }
    """ :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h

  foreign import mkFn8
    """
    function mkFn8(fn) {
      return function(a, b, c, d, e, f, g, h) {
        return fn(a)(b)(c)(d)(e)(f)(g)(h);
      };
    }
    """ :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i

  foreign import mkFn9
    """
    function mkFn9(fn) {
      return function(a, b, c, d, e, f, g, h, i) {
        return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);
      };
    }
    """ :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j

  foreign import mkFn10
    """
    function mkFn10(fn) {
      return function(a, b, c, d, e, f, g, h, i, j) {
        return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);
      };
    }
    """ :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k

  foreign import runFn0
    """
    function runFn0(fn) {
      return fn();
    }
    """ :: forall a. Fn0 a -> a

  foreign import runFn1
    """
    function runFn1(fn) {
      return function(a) {
        return fn(a);
      };
    }
    """ :: forall a b. Fn1 a b -> a -> b

  foreign import runFn2
    """
    function runFn2(fn) {
      return function(a) {
        return function(b) {
          return fn(a, b);
        };
      };
    }
    """ :: forall a b c. Fn2 a b c -> a -> b -> c

  foreign import runFn3
    """
    function runFn3(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return fn(a, b, c);
          };
        };
      };
    }
    """ :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d

  foreign import runFn4
    """
    function runFn4(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return fn(a, b, c, d);
            };
          };
        };
      };
    }
    """ :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e

  foreign import runFn5
    """
    function runFn5(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return fn(a, b, c, d, e);
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f

  foreign import runFn6
    """
    function runFn6(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return function(f) {
                  return fn(a, b, c, d, e, f);
                };
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g

  foreign import runFn7
    """
    function runFn7(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return function(f) {
                  return function(g) {
                    return fn(a, b, c, d, e, f, g);
                  };
                };
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h

  foreign import runFn8
    """
    function runFn8(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return function(f) {
                  return function(g) {
                    return function(h) {
                      return fn(a, b, c, d, e, f, g, h);
                    };
                  };
                };
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i

  foreign import runFn9
    """
    function runFn9(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return function(f) {
                  return function(g) {
                    return function(h) {
                      return function(i) {
                        return fn(a, b, c, d, e, f, g, h, i);
                      };
                    };
                  };
                };
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j

  foreign import runFn10
    """
    function runFn10(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return function(f) {
                  return function(g) {
                    return function(h) {
                      return function(i) {
                        return function(j) {
                          return fn(a, b, c, d, e, f, g, h, i, j);
                        };
                      };
                    };
                  };
                };
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k

module Prelude.Unsafe where

  foreign import unsafeIndex
    """
    function unsafeIndex(xs) {
      return function(n) {
        return xs[n];
      };
    }
    """ :: forall a. [a] -> Number -> a

module Control.Monad.Eff where

  foreign import data Eff :: # ! -> * -> *

  foreign import returnE
    """
    function returnE(a) {
      return function() {
        return a;
      };
    }
    """ :: forall e a. a -> Eff e a

  foreign import bindE
    """
    function bindE(a) {
      return function(f) {
        return function() {
          return f(a())();
        };
      };
    }
    """ :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b

  type Pure a = forall e. Eff e a

  foreign import runPure
    """
    function runPure(f) {
      return f();
    }
    """ :: forall a. Pure a -> a

  instance functorEff :: Functor (Eff e) where
    (<$>) = liftA1

  instance applyEff :: Apply (Eff e) where
    (<*>) = ap

  instance applicativeEff :: Applicative (Eff e) where
    pure = returnE

  instance bindEff :: Bind (Eff e) where
    (>>=) = bindE

  instance monadEff :: Monad (Eff e)

  foreign import untilE
    """
    function untilE(f) {
      return function() {
        while (!f());
        return {};
      };
    }
    """ :: forall e. Eff e Boolean -> Eff e Unit

  foreign import whileE
    """
    function whileE(f) {
      return function(a) {
        return function() {
          while (f()) {
            a();
          }
          return {};
        };
      };
    }
    """ :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit

  foreign import forE
    """
    function forE(lo) {
      return function(hi) {
        return function(f) {
          return function() {
            for (var i = lo; i < hi; i++) {
              f(i)();
            }
          };
        };
      };
    }
    """ :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit

  foreign import foreachE
    """
    function foreachE(as) {
      return function(f) {
        return function() {
          for (var i = 0; i < as.length; i++) {
            f(as[i])();
          }
        };
      };
    }
    """ :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit

module Control.Monad.Eff.Unsafe where

  import Control.Monad.Eff

  foreign import unsafeInterleaveEff
    """
    function unsafeInterleaveEff(f) {
      return f;
    }
    """ :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a

module Debug.Trace where

  import Control.Monad.Eff

  foreign import data Trace :: !

  foreign import trace
    """
    function trace(s) {
      return function() {
        console.log(s);
        return {};
      };
    }
    """ :: forall r. String -> Eff (trace :: Trace | r) Unit

  print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
  print o = trace (show o)

module Control.Monad.ST where

  import Control.Monad.Eff

  foreign import data ST :: * -> !

  foreign import data STRef :: * -> * -> *

  foreign import newSTRef
    """
    function newSTRef(val) {
      return function() {
        return { value: val };
      };
    }
    """ :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)

  foreign import readSTRef
    """
    function readSTRef(ref) {
      return function() {
        return ref.value;
      };
    }
    """ :: forall a h r. STRef h a -> Eff (st :: ST h | r) a

  foreign import modifySTRef
    """
    function modifySTRef(ref) {
      return function(f) {
        return function() {
          return ref.value = f(ref.value);
        };
      };
    }
    """ :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a

  foreign import writeSTRef
    """
    function writeSTRef(ref) {
      return function(a) {
        return function() {
          return ref.value = a;
        };
      };
    }
    """ :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a

  foreign import runST
    """
    function runST(f) {
      return f;
    }
    """ :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a

  pureST :: forall a. (forall h r. Eff (st :: ST h | r) a) -> a
  pureST st = runPure (runST st)

module Prelude
  ( otherwise
  , flip
  , const
  , asTypeOf
  , Semigroupoid, (<<<), (>>>)
  , Category, id
  , ($), (#)
  , (:), cons
  , Show, show
  , Functor, (<$>), (<#>), void
  , Apply, (<*>)
  , Applicative, pure, liftA1
  , Bind, (>>=)
  , Monad, return, liftM1, ap
  , Semiring, (+), zero, (*), one
  , ModuloSemiring, (/), mod
  , Ring, (-)
  , (%)
  , negate
  , DivisionRing
  , Num
  , Eq, (==), (/=), refEq, refIneq
  , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
  , Bits, (.&.), (.|.), (.^.), shl, shr, zshr, complement
  , BoolLike, (&&), (||)
  , not
  , Semigroup, (<>), (++)
  , Unit(..), unit
  ) where

  -- | An alias for `true`, which can be useful in guard clauses:
  -- |
  -- | E.g.
  -- |
  -- |     max x y | x >= y = x
  -- |             | otherwise = y
  otherwise :: Boolean
  otherwise = true

  -- | Flips the order of the arguments to a function of two arguments.
  flip :: forall a b c. (a -> b -> c) -> b -> a -> c
  flip f b a = f a b

  -- | Returns its first argument and ignores its second.
  const :: forall a b. a -> b -> a
  const a _ = a

  -- | This function returns its first argument, and can be used to assert type equalities.
  -- | This can be useful when types are otherwise ambiguous.
  -- |
  -- | E.g.
  -- |
  -- |     main = print $ [] `asTypeOf` [0]
  -- |
  -- | If instead, we had written `main = print []`, the type of the argument `[]` would have
  -- | been ambiguous, resulting in a compile-time error.
  asTypeOf :: forall a. a -> a -> a
  asTypeOf x _ = x

  infixr 9 >>>
  infixr 9 <<<

  class Semigroupoid a where
    (<<<) :: forall b c d. a c d -> a b c -> a b d

  instance semigroupoidArr :: Semigroupoid (->) where
    (<<<) f g x = f (g x)

  (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
  (>>>) f g = g <<< f

  class (Semigroupoid a) <= Category a where
    id :: forall t. a t t

  instance categoryArr :: Category (->) where
    id x = x

  infixr 0 $
  infixl 0 #

  ($) :: forall a b. (a -> b) -> a -> b
  ($) f x = f x

  (#) :: forall a b. a -> (a -> b) -> b
  (#) x f = f x

  infixr 6 :

  (:) :: forall a. a -> [a] -> [a]
  (:) = cons

  foreign import cons
    """
    function cons(e) {
      return function(l) {
        return [e].concat(l);
      };
    }
    """ :: forall a. a -> [a] -> [a]

  class Show a where
    show :: a -> String

  foreign import showStringImpl
    """
    function showStringImpl(s) {
      return JSON.stringify(s);
    }
    """ :: String -> String

  instance showUnit :: Show Unit where
    show (Unit {}) = "Unit {}"

  instance showString :: Show String where
    show = showStringImpl

  instance showBoolean :: Show Boolean where
    show true = "true"
    show false = "false"

  foreign import showNumberImpl
    """
    function showNumberImpl(n) {
      return n.toString();
    }
    """ :: Number -> String

  instance showNumber :: Show Number where
    show = showNumberImpl

  foreign import showArrayImpl
    """
    function showArrayImpl(f) {
      return function(xs) {
        var ss = [];
        for (var i = 0, l = xs.length; i < l; i++) {
          ss[i] = f(xs[i]);
        }
        return '[' + ss.join(',') + ']';
      };
    }
    """ :: forall a. (a -> String) -> [a] -> String

  instance showArray :: (Show a) => Show [a] where
    show = showArrayImpl show

  infixl 4 <$>
  infixl 1 <#>

  class Functor f where
    (<$>) :: forall a b. (a -> b) -> f a -> f b

  (<#>) :: forall f a b. (Functor f) => f a -> (a -> b) -> f b
  (<#>) fa f = f <$> fa

  void :: forall f a. (Functor f) => f a -> f Unit
  void fa = const unit <$> fa

  infixl 4 <*>

  class (Functor f) <= Apply f where
    (<*>) :: forall a b. f (a -> b) -> f a -> f b

  class (Apply f) <= Applicative f where
    pure :: forall a. a -> f a

  liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
  liftA1 f a = pure f <*> a

  infixl 1 >>=

  class (Apply m) <= Bind m where
    (>>=) :: forall a b. m a -> (a -> m b) -> m b

  class (Applicative m, Bind m) <= Monad m

  return :: forall m a. (Monad m) => a -> m a
  return = pure

  liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
  liftM1 f a = do
    a' <- a
    return (f a')

  ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
  ap f a = do
    f' <- f
    a' <- a
    return (f' a')

  instance functorArr :: Functor ((->) r) where
    (<$>) = (<<<)

  instance applyArr :: Apply ((->) r) where
    (<*>) f g x = f x (g x)

  instance applicativeArr :: Applicative ((->) r) where
    pure = const

  instance bindArr :: Bind ((->) r) where
    (>>=) m f x = f (m x) x

  instance monadArr :: Monad ((->) r)

  infixl 7 *
  infixl 7 /
  infixl 7 %

  infixl 6 -
  infixl 6 +

  -- | Addition and multiplication
  class Semiring a where
    (+)  :: a -> a -> a
    zero :: a
    (*)  :: a -> a -> a
    one  :: a

  -- | Semiring with modulo operation and division where
  -- | ```a / b * b + (a `mod` b) = a```
  class (Semiring a) <= ModuloSemiring a where
    (/) :: a -> a -> a
    mod :: a -> a -> a

  -- | Addition, multiplication, and subtraction
  class (Semiring a) <= Ring a where
    (-) :: a -> a -> a

  negate :: forall a. (Ring a) => a -> a
  negate a = zero - a

  -- | Ring where every nonzero element has a multiplicative inverse (possibly
  -- | a non-commutative field) so that ```a `mod` b = zero```
  class (Ring a, ModuloSemiring a) <= DivisionRing a

  -- | A commutative field
  class (DivisionRing a) <= Num a

  foreign import numAdd
    """
    function numAdd(n1) {
      return function(n2) {
        return n1 + n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numSub
    """
    function numSub(n1) {
      return function(n2) {
        return n1 - n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numMul
    """
    function numMul(n1) {
      return function(n2) {
        return n1 * n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numDiv
    """
    function numDiv(n1) {
      return function(n2) {
        return n1 / n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numMod
    """
    function numMod(n1) {
      return function(n2) {
        return n1 % n2;
      };
    }
    """ :: Number -> Number -> Number

  (%) = numMod

  instance semiringNumber :: Semiring Number where
    (+) = numAdd
    zero = 0
    (*) = numMul
    one = 1

  instance ringNumber :: Ring Number where
    (-) = numSub

  instance moduloSemiringNumber :: ModuloSemiring Number where
    (/) = numDiv
    mod _ _ = 0

  instance divisionRingNumber :: DivisionRing Number

  instance numNumber :: Num Number

  newtype Unit = Unit {}

  unit :: Unit
  unit = Unit {}

  infix 4 ==
  infix 4 /=

  class Eq a where
    (==) :: a -> a -> Boolean
    (/=) :: a -> a -> Boolean

  foreign import refEq
    """
    function refEq(r1) {
      return function(r2) {
        return r1 === r2;
      };
    }
    """ :: forall a. a -> a -> Boolean

  foreign import refIneq
    """
    function refIneq(r1) {
      return function(r2) {
        return r1 !== r2;
      };
    }
    """ :: forall a. a -> a -> Boolean

  instance eqUnit :: Eq Unit where
    (==) (Unit {}) (Unit {}) = true
    (/=) (Unit {}) (Unit {}) = false

  instance eqString :: Eq String where
    (==) = refEq
    (/=) = refIneq

  instance eqNumber :: Eq Number where
    (==) = refEq
    (/=) = refIneq

  instance eqBoolean :: Eq Boolean where
    (==) = refEq
    (/=) = refIneq

  foreign import eqArrayImpl
    """
    function eqArrayImpl(f) {
      return function(xs) {
        return function(ys) {
          if (xs.length !== ys.length) return false;
          for (var i = 0; i < xs.length; i++) {
            if (!f(xs[i])(ys[i])) return false;
          }
          return true;
        };
      };
    }
    """ :: forall a. (a -> a -> Boolean) -> [a] -> [a] -> Boolean

  instance eqArray :: (Eq a) => Eq [a] where
    (==) xs ys = eqArrayImpl (==) xs ys
    (/=) xs ys = not (xs == ys)

  data Ordering = LT | GT | EQ

  instance eqOrdering :: Eq Ordering where
    (==) LT LT = true
    (==) GT GT = true
    (==) EQ EQ = true
    (==) _  _  = false
    (/=) x y = not (x == y)

  instance showOrdering :: Show Ordering where
    show LT = "LT"
    show GT = "GT"
    show EQ = "EQ"

  class (Eq a) <= Ord a where
    compare :: a -> a -> Ordering

  infixl 4 <

  (<) :: forall a. (Ord a) => a -> a -> Boolean
  (<) a1 a2 = case a1 `compare` a2 of
    LT -> true
    _ -> false

  infixl 4 >

  (>) :: forall a. (Ord a) => a -> a -> Boolean
  (>) a1 a2 = case a1 `compare` a2 of
    GT -> true
    _ -> false

  infixl 4 <=

  (<=) :: forall a. (Ord a) => a -> a -> Boolean
  (<=) a1 a2 = case a1 `compare` a2 of
    GT -> false
    _ -> true

  infixl 4 >=

  (>=) :: forall a. (Ord a) => a -> a -> Boolean
  (>=) a1 a2 = case a1 `compare` a2 of
    LT -> false
    _ -> true

  foreign import unsafeCompareImpl
    """
    function unsafeCompareImpl(lt) {
      return function(eq) {
        return function(gt) {
          return function(x) {
            return function(y) {
              return x < y ? lt : x > y ? gt : eq;
            };
          };
        };
      };
    }
    """ :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering

  unsafeCompare :: forall a. a -> a -> Ordering
  unsafeCompare = unsafeCompareImpl LT EQ GT

  instance ordUnit :: Ord Unit where
    compare (Unit {}) (Unit {}) = EQ

  instance ordBoolean :: Ord Boolean where
    compare false false = EQ
    compare false true  = LT
    compare true  true  = EQ
    compare true  false = GT

  instance ordNumber :: Ord Number where
    compare = unsafeCompare

  instance ordString :: Ord String where
    compare = unsafeCompare

  instance ordArray :: (Ord a) => Ord [a] where
    compare [] [] = EQ
    compare [] _ = LT
    compare _ [] = GT
    compare (x:xs) (y:ys) = case compare x y of
      EQ -> compare xs ys
      other -> other

  infixl 10 .&.
  infixl 10 .|.
  infixl 10 .^.

  class Bits b where
    (.&.) :: b -> b -> b
    (.|.) :: b -> b -> b
    (.^.) :: b -> b -> b
    shl :: b -> Number -> b
    shr :: b -> Number -> b
    zshr :: b -> Number -> b
    complement :: b -> b

  foreign import numShl
    """
    function numShl(n1) {
      return function(n2) {
        return n1 << n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numShr
    """
    function numShr(n1) {
      return function(n2) {
        return n1 >> n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numZshr
    """
    function numZshr(n1) {
      return function(n2) {
        return n1 >>> n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numAnd
    """
    function numAnd(n1) {
      return function(n2) {
        return n1 & n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numOr
    """
    function numOr(n1) {
      return function(n2) {
        return n1 | n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numXor
    """
    function numXor(n1) {
      return function(n2) {
        return n1 ^ n2;
      };
    }
    """ :: Number -> Number -> Number

  foreign import numComplement
    """
    function numComplement(n) {
      return ~n;
    }
    """ :: Number -> Number

  instance bitsNumber :: Bits Number where
    (.&.) = numAnd
    (.|.) = numOr
    (.^.) = numXor
    shl = numShl
    shr = numShr
    zshr = numZshr
    complement = numComplement

  infixr 2 ||
  infixr 3 &&

  class BoolLike b where
    (&&) :: b -> b -> b
    (||) :: b -> b -> b
    not :: b -> b

  foreign import boolAnd
    """
    function boolAnd(b1) {
      return function(b2) {
        return b1 && b2;
      };
    }
    """  :: Boolean -> Boolean -> Boolean

  foreign import boolOr
    """
    function boolOr(b1) {
      return function(b2) {
        return b1 || b2;
      };
    }
    """ :: Boolean -> Boolean -> Boolean

  foreign import boolNot
    """
    function boolNot(b) {
      return !b;
    }
    """ :: Boolean -> Boolean

  instance boolLikeBoolean :: BoolLike Boolean where
    (&&) = boolAnd
    (||) = boolOr
    not = boolNot

  infixr 5 <>

  class Semigroup a where
    (<>) :: a -> a -> a

  foreign import concatString
    """
    function concatString(s1) {
      return function(s2) {
        return s1 + s2;
      };
    }
    """ :: String -> String -> String

  instance semigroupUnit :: Semigroup Unit where
    (<>) (Unit {}) (Unit {}) = Unit {}

  instance semigroupString :: Semigroup String where
    (<>) = concatString

  instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where
    (<>) f g = \x -> f x <> g x

  infixr 5 ++

  (++) :: forall s. (Semigroup s) => s -> s -> s
  (++) = (<>)

module Data.Function where

  on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
  on f g x y = g x `f` g y

  foreign import data Fn0 :: * -> *
  foreign import data Fn1 :: * -> * -> *
  foreign import data Fn2 :: * -> * -> * -> *
  foreign import data Fn3 :: * -> * -> * -> * -> *
  foreign import data Fn4 :: * -> * -> * -> * -> * -> *
  foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *
  foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *

  foreign import mkFn0
    """
    function mkFn0(fn) {
      return function() {
        return fn({});
      };
    }
    """ :: forall a. (Unit -> a) -> Fn0 a

  foreign import mkFn1
    """
    function mkFn1(fn) {
      return function(a) {
        return fn(a);
      };
    }
    """ :: forall a b. (a -> b) -> Fn1 a b

  foreign import mkFn2
    """
    function mkFn2(fn) {
      return function(a, b) {
        return fn(a)(b);
      };
    }
    """ :: forall a b c. (a -> b -> c) -> Fn2 a b c

  foreign import mkFn3
    """
    function mkFn3(fn) {
      return function(a, b, c) {
        return fn(a)(b)(c);
      };
    }
    """ :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d

  foreign import mkFn4
    """
    function mkFn4(fn) {
      return function(a, b, c, d) {
        return fn(a)(b)(c)(d);
      };
    }
    """ :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e

  foreign import mkFn5
    """
    function mkFn5(fn) {
      return function(a, b, c, d, e) {
        return fn(a)(b)(c)(d)(e);
      };
    }
    """ :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f

  foreign import mkFn6
    """
    function mkFn6(fn) {
      return function(a, b, c, d, e, f) {
        return fn(a)(b)(c)(d)(e)(f);
      };
    }
    """ :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g

  foreign import mkFn7
    """
    function mkFn7(fn) {
      return function(a, b, c, d, e, f, g) {
        return fn(a)(b)(c)(d)(e)(f)(g);
      };
    }
    """ :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h

  foreign import mkFn8
    """
    function mkFn8(fn) {
      return function(a, b, c, d, e, f, g, h) {
        return fn(a)(b)(c)(d)(e)(f)(g)(h);
      };
    }
    """ :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i

  foreign import mkFn9
    """
    function mkFn9(fn) {
      return function(a, b, c, d, e, f, g, h, i) {
        return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);
      };
    }
    """ :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j

  foreign import mkFn10
    """
    function mkFn10(fn) {
      return function(a, b, c, d, e, f, g, h, i, j) {
        return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);
      };
    }
    """ :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k

  foreign import runFn0
    """
    function runFn0(fn) {
      return fn();
    }
    """ :: forall a. Fn0 a -> a

  foreign import runFn1
    """
    function runFn1(fn) {
      return function(a) {
        return fn(a);
      };
    }
    """ :: forall a b. Fn1 a b -> a -> b

  foreign import runFn2
    """
    function runFn2(fn) {
      return function(a) {
        return function(b) {
          return fn(a, b);
        };
      };
    }
    """ :: forall a b c. Fn2 a b c -> a -> b -> c

  foreign import runFn3
    """
    function runFn3(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return fn(a, b, c);
          };
        };
      };
    }
    """ :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d

  foreign import runFn4
    """
    function runFn4(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return fn(a, b, c, d);
            };
          };
        };
      };
    }
    """ :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e

  foreign import runFn5
    """
    function runFn5(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return fn(a, b, c, d, e);
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f

  foreign import runFn6
    """
    function runFn6(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return function(f) {
                  return fn(a, b, c, d, e, f);
                };
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g

  foreign import runFn7
    """
    function runFn7(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return function(f) {
                  return function(g) {
                    return fn(a, b, c, d, e, f, g);
                  };
                };
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h

  foreign import runFn8
    """
    function runFn8(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return function(f) {
                  return function(g) {
                    return function(h) {
                      return fn(a, b, c, d, e, f, g, h);
                    };
                  };
                };
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i

  foreign import runFn9
    """
    function runFn9(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return function(f) {
                  return function(g) {
                    return function(h) {
                      return function(i) {
                        return fn(a, b, c, d, e, f, g, h, i);
                      };
                    };
                  };
                };
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j

  foreign import runFn10
    """
    function runFn10(fn) {
      return function(a) {
        return function(b) {
          return function(c) {
            return function(d) {
              return function(e) {
                return function(f) {
                  return function(g) {
                    return function(h) {
                      return function(i) {
                        return function(j) {
                          return fn(a, b, c, d, e, f, g, h, i, j);
                        };
                      };
                    };
                  };
                };
              };
            };
          };
        };
      };
    }
    """ :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k

module Prelude.Unsafe where

  foreign import unsafeIndex
    """
    function unsafeIndex(xs) {
      return function(n) {
        return xs[n];
      };
    }
    """ :: forall a. [a] -> Number -> a

module Control.Monad.Eff where

  foreign import data Eff :: # ! -> * -> *

  foreign import returnE
    """
    function returnE(a) {
      return function() {
        return a;
      };
    }
    """ :: forall e a. a -> Eff e a

  foreign import bindE
    """
    function bindE(a) {
      return function(f) {
        return function() {
          return f(a())();
        };
      };
    }
    """ :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b

  type Pure a = forall e. Eff e a

  foreign import runPure
    """
    function runPure(f) {
      return f();
    }
    """ :: forall a. Pure a -> a

  instance functorEff :: Functor (Eff e) where
    (<$>) = liftA1

  instance applyEff :: Apply (Eff e) where
    (<*>) = ap

  instance applicativeEff :: Applicative (Eff e) where
    pure = returnE

  instance bindEff :: Bind (Eff e) where
    (>>=) = bindE

  instance monadEff :: Monad (Eff e)

  foreign import untilE
    """
    function untilE(f) {
      return function() {
        while (!f());
        return {};
      };
    }
    """ :: forall e. Eff e Boolean -> Eff e Unit

  foreign import whileE
    """
    function whileE(f) {
      return function(a) {
        return function() {
          while (f()) {
            a();
          }
          return {};
        };
      };
    }
    """ :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit

  foreign import forE
    """
    function forE(lo) {
      return function(hi) {
        return function(f) {
          return function() {
            for (var i = lo; i < hi; i++) {
              f(i)();
            }
          };
        };
      };
    }
    """ :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit

  foreign import foreachE
    """
    function foreachE(as) {
      return function(f) {
        return function() {
          for (var i = 0; i < as.length; i++) {
            f(as[i])();
          }
        };
      };
    }
    """ :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit

module Control.Monad.Eff.Unsafe where

  import Control.Monad.Eff

  foreign import unsafeInterleaveEff
    """
    function unsafeInterleaveEff(f) {
      return f;
    }
    """ :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a

module Debug.Trace where

  import Control.Monad.Eff

  foreign import data Trace :: !

  foreign import trace
    """
    function trace(s) {
      return function() {
        console.log(s);
        return {};
      };
    }
    """ :: forall r. String -> Eff (trace :: Trace | r) Unit

  print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
  print o = trace (show o)

module Control.Monad.ST where

  import Control.Monad.Eff

  foreign import data ST :: * -> !

  foreign import data STRef :: * -> * -> *

  foreign import newSTRef
    """
    function newSTRef(val) {
      return function() {
        return { value: val };
      };
    }
    """ :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)

  foreign import readSTRef
    """
    function readSTRef(ref) {
      return function() {
        return ref.value;
      };
    }
    """ :: forall a h r. STRef h a -> Eff (st :: ST h | r) a

  foreign import modifySTRef
    """
    function modifySTRef(ref) {
      return function(f) {
        return function() {
          return ref.value = f(ref.value);
        };
      };
    }
    """ :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a

  foreign import writeSTRef
    """
    function writeSTRef(ref) {
      return function(a) {
        return function() {
          return ref.value = a;
        };
      };
    }
    """ :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a

  foreign import runST
    """
    function runST(f) {
      return f;
    }
    """ :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a

  pureST :: forall a. (forall h r. Eff (st :: ST h | r) a) -> a
  pureST st = runPure (runST st)


Fixed a mistake in the basic operations map

module OpCodeMap where

import Prelude

import Types
import Ops

--Tried to use typeclasses, but was forced to turn all my type synonyms
--to 'newtypes' which will require writing a specialised function for each
--case to convert from the type synonyms to the newtypes which will beat
--the purpose of using a typeclass in the first place (lets me have function
--overload in this case).
rr2op :: (Regs -> Regs) -> Z80State -> Z80State
rr2op rr state@{mem=mem@{regs}} = state { mem = mem { regs = rr regs } }

mr2op :: (Mem -> Regs) -> Z80State -> Z80State
mr2op mr state@{mem=mem@{regs}} = state { mem = mem { regs = mr mem } }

mm2op :: (Mem -> Mem) -> Z80State -> Z80State
mm2op mm state@{mem=mem@{regs}} = state { mem = mm mem }

basicOps :: Array (Z80State -> Z80State)
basicOps =
                                            -- 0x
  [ rr2op $ nop                             -- NOP
  , mr2op $ ldTwoRegsFromImm setB setC      -- LD BC,nn
  , mm2op $ ldMem2RFromReg b c a            -- LD (BC),A
  , rr2op $ incRegWithCarry b c setB setC   -- INC BC

  , rr2op $ incReg b setB                   -- INC B
  , rr2op $ decReg b setB                   -- DEC B
  , mr2op $ ldRegFromImm setB               -- LD B,n
  , rr2op $ rotA Left true                  -- RLC A

  , mm2op $ ldMemImmFromSP                  -- LD (nn),SP
  , rr2op $ add2RegsToHL b c                -- ADD HL,BC
  , mr2op $ ldRegFromMem2R setA b c         -- LD A,(BC)
  , rr2op $ decRegWithCarry b c setB setC   -- DEC BC

  , rr2op $ incReg c setC                   -- INC C
  , rr2op $ decReg c setC                   -- DEC C
  , mr2op $ ldRegFromImm setC               -- LD C,n
  , rr2op $ rotA Right true                 -- RRC A

                                            -- 1x
  , stop                                    -- STOP
  , mr2op $ ldTwoRegsFromImm setD setE      -- LD DE,nn
  , mm2op $ ldMem2RFromReg d e a            -- LD (DE),A
  , rr2op $ incRegWithCarry d e setD setE   -- INC DE

  , rr2op $ incReg d setD                   -- INC D
  , rr2op $ decReg d setD                   -- DEC D
  , mr2op $ ldRegFromImm setD               -- LD D,n
  , rr2op $ rotA Left false                 -- RL A

  , mr2op $ jumpRelImm                      -- JR n
  , rr2op $ add2RegsToHL d e                -- ADD HL,DE
  , mr2op $ ldRegFromMem2R setA d e         -- LD A,(DE)
  , rr2op $ decRegWithCarry d e setD setE   -- DEC DE

  , rr2op $ incReg e setE                   -- INC E
  , rr2op $ decReg e setE                   -- DEC E
  , mr2op $ ldRegFromImm setE               -- LD E,n
  , rr2op $ rotA Right false                -- RR A

                                            -- 2x
  , mr2op $ jumpRelImmFlag true zeroFlag    -- JR NZ,n
  , mr2op $ ldTwoRegsFromImm setH setL      -- LD HL,nn
  , mm2op $ ldMemHLFromRegInc a             -- LDI (HL),A
  , rr2op $ incRegWithCarry h l setH setL   -- INC HL

  , rr2op $ incReg h setH                   -- INC H
  , rr2op $ decReg h setH                   -- DEC H
  , mr2op $ ldRegFromImm setH               -- LD H,n
  , rr2op $ adjAForBCDAdd                   -- DAA

  , mr2op $ jumpRelImmFlag false zeroFlag   -- JR Z,n
  , rr2op $ add2RegsToHL h l                -- ADD HL,HL
  , mr2op $ ldRegFromMemHLInc setA          -- LDI A,(HL)
  , rr2op $ decRegWithCarry h l setH setL   -- DEC HL

  , rr2op $ incReg l setL                   -- INC L
  , rr2op $ decReg l setL                   -- DEC L
  , mr2op $ ldRegFromImm setL               -- LD L,n
  , rr2op $ cmplA                           -- CPL

                                            -- 3x
  , mr2op $ jumpRelImmFlag true carryFlag   -- JR NC,n
  , mr2op $ ldSPFromImm                     -- LD SP,nn
  , mm2op $ ldMemHLFromRegDec a             -- LDD (HL),A
  , rr2op $ incSP                           -- INC SP

  , mm2op $ incHLMem                        -- INC (HL)
  , mm2op $ decHLMem                        -- DEC (HL)
  , mm2op $ ldMemHLFromImm                  -- LD (HL),n
  , rr2op $ setCarryFlag                    -- SCF

  , mr2op $ jumpRelImmFlag false carryFlag  -- JR C,n
  , rr2op $ addSPToHL                       -- ADD HL,SP
  , mr2op $ ldRegFromMemHLDec setA          -- LDD A,(HL)
  , rr2op $ decSP                           -- DEC SP

  , rr2op $ incReg a setA                   -- INC A
  , rr2op $ decReg a setA                   -- DEC A
  , mr2op $ ldRegFromImm setA               -- LD A,n
  , rr2op $ clearCarryFlag                  -- CCF

                                            -- 4x
  , rr2op $ ldRegFromReg setB b             -- LD B,B
  , rr2op $ ldRegFromReg setB c             -- LD B,C
  , rr2op $ ldRegFromReg setB d             -- LD B,D
  , rr2op $ ldRegFromReg setB e             -- LD B,E

  , rr2op $ ldRegFromReg setB h             -- LD B,H
  , rr2op $ ldRegFromReg setB l             -- LD B,L
  , mr2op $ ldRegFromMem2R setB h l         -- LD B,(HL)
  , rr2op $ ldRegFromReg setB a             -- LD B,A

  , rr2op $ ldRegFromReg setC b             -- LD C,B
  , rr2op $ ldRegFromReg setC c             -- LD C,C
  , rr2op $ ldRegFromReg setC d             -- LD C,D
  , rr2op $ ldRegFromReg setC e             -- LD C,E

  , rr2op $ ldRegFromReg setC h             -- LD C,H
  , rr2op $ ldRegFromReg setC l             -- LD C,L
  , mr2op $ ldRegFromMem2R setC h l         -- LD C,(HL)
  , rr2op $ ldRegFromReg setC a             -- LD C,A

                                            -- 5x
  , rr2op $ ldRegFromReg setD b             -- LD D,B
  , rr2op $ ldRegFromReg setD c             -- LD D,C
  , rr2op $ ldRegFromReg setD d             -- LD D,D
  , rr2op $ ldRegFromReg setD e             -- LD D,E

  , rr2op $ ldRegFromReg setD h             -- LD D,H
  , rr2op $ ldRegFromReg setD l             -- LD D,L
  , mr2op $ ldRegFromMem2R setD h l         -- LD D,(HL)
  , rr2op $ ldRegFromReg setD a             -- LD D,A

  , rr2op $ ldRegFromReg setE b             -- LD E,B
  , rr2op $ ldRegFromReg setE c             -- LD E,C
  , rr2op $ ldRegFromReg setE d             -- LD E,D
  , rr2op $ ldRegFromReg setE e             -- LD E,E

  , rr2op $ ldRegFromReg setE h             -- LD E,H
  , rr2op $ ldRegFromReg setE l             -- LD E,L
  , mr2op $ ldRegFromMem2R setE h l         -- LD E,(HL)
  , rr2op $ ldRegFromReg setE a             -- LD E,A

                                            -- 6x
  , rr2op $ ldRegFromReg setH b             -- LD H,B
  , rr2op $ ldRegFromReg setH c             -- LD H,C
  , rr2op $ ldRegFromReg setH d             -- LD H,D
  , rr2op $ ldRegFromReg setH e             -- LD H,E

  , rr2op $ ldRegFromReg setH h             -- LD H,H
  , rr2op $ ldRegFromReg setH l             -- LD H,L
  , mr2op $ ldRegFromMem2R setH h l         -- LD H,(HL)
  , rr2op $ ldRegFromReg setH a             -- LD H,A

  , rr2op $ ldRegFromReg setL b             -- LD L,B
  , rr2op $ ldRegFromReg setL c             -- LD L,C
  , rr2op $ ldRegFromReg setL d             -- LD L,D
  , rr2op $ ldRegFromReg setL e             -- LD L,E

  , rr2op $ ldRegFromReg setL h             -- LD L,H
  , rr2op $ ldRegFromReg setL l             -- LD L,L
  , mr2op $ ldRegFromMem2R setL h l         -- LD L,(HL)
  , rr2op $ ldRegFromReg setL a             -- LD L,A

                                            -- 7x
  , mm2op $ ldMem2RFromReg h l b            -- LD (HL),B
  , mm2op $ ldMem2RFromReg h l c            -- LD (HL),C
  , mm2op $ ldMem2RFromReg h l d            -- LD (HL),D
  , mm2op $ ldMem2RFromReg h l e            -- LD (HL),E

  , mm2op $ ldMem2RFromReg h l h            -- LD (HL),H
  , mm2op $ ldMem2RFromReg h l l            -- LD (HL),L
  , halt                                    -- HALT
  , mm2op $ ldMem2RFromReg h l a            -- LD (HL),A

  , rr2op $ ldRegFromReg setA b             -- LD A,B
  , rr2op $ ldRegFromReg setA c             -- LD A,C
  , rr2op $ ldRegFromReg setA d             -- LD A,D
  , rr2op $ ldRegFromReg setA e             -- LD A,E

  , rr2op $ ldRegFromReg setA h             -- LD A,H
  , rr2op $ ldRegFromReg setA l             -- LD A,L
  , mr2op $ ldRegFromMem2R setA h l         -- LD A,(HL)
  , rr2op $ ldRegFromReg setA a             -- LD A,A

                                            -- 8x
  , rr2op $ addRegToA b                     -- ADD A,B
  , rr2op $ addRegToA c                     -- ADD A,C
  , rr2op $ addRegToA d                     -- ADD A,D
  , rr2op $ addRegToA e                     -- ADD A,E

  , rr2op $ addRegToA h                     -- ADD A,H
  , rr2op $ addRegToA l                     -- ADD A,L
  , mr2op $ addHLMemToA                     -- ADD A,(HL)
  , rr2op $ addRegToA a                     -- ADD A,A

  , rr2op $ addRegCarryToA b                -- ADC A,B
  , rr2op $ addRegCarryToA c                -- ADC A,C
  , rr2op $ addRegCarryToA d                -- ADC A,D
  , rr2op $ addRegCarryToA e                -- ADC A,E

  , rr2op $ addRegCarryToA h                -- ADC A,H
  , rr2op $ addRegCarryToA l                -- ADC A,L
  , mr2op $ addHLMemCarryToA                -- ADC A,(HL)
  , rr2op $ addRegCarryToA a                -- ADC A,A

                                            -- 9x
  , rr2op $ subRegFromA b                   -- SUB A,B
  , rr2op $ subRegFromA c                   -- SUB A,C
  , rr2op $ subRegFromA d                   -- SUB A,D
  , rr2op $ subRegFromA e                   -- SUB A,E

  , rr2op $ subRegFromA h                   -- SUB A,H
  , rr2op $ subRegFromA l                   -- SUB A,L
  , mr2op $ subHLMemFromA                   -- SUB A,(HL)
  , rr2op $ subRegFromA a                   -- SUB A,A

  , rr2op $ subRegCarryFromA b              -- SBC A,B
  , rr2op $ subRegCarryFromA c              -- SBC A,C
  , rr2op $ subRegCarryFromA d              -- SBC A,D
  , rr2op $ subRegCarryFromA e              -- SBC A,E

  , rr2op $ subRegCarryFromA h              -- SBC A,H
  , rr2op $ subRegCarryFromA l              -- SBC A,L
  , mr2op $ subHLMemCarryFromA              -- SBC A,(HL)
  , rr2op $ subRegCarryFromA a              -- SBC A,A

                                            -- Ax
  , rr2op $ andOpRegIntoA b                 -- AND B
  , rr2op $ andOpRegIntoA c                 -- AND C
  , rr2op $ andOpRegIntoA d                 -- AND D
  , rr2op $ andOpRegIntoA e                 -- AND E

  , rr2op $ andOpRegIntoA h                 -- AND H
  , rr2op $ andOpRegIntoA l                 -- AND L
  , mr2op $ andOpHLMemIntoA                 -- AND (HL)
  , rr2op $ andOpRegIntoA a                 -- AND A

  , rr2op $ xorOpRegIntoA b                 -- XOR B
  , rr2op $ xorOpRegIntoA c                 -- XOR C
  , rr2op $ xorOpRegIntoA d                 -- XOR D
  , rr2op $ xorOpRegIntoA e                 -- XOR E

  , rr2op $ xorOpRegIntoA h                 -- XOR H
  , rr2op $ xorOpRegIntoA l                 -- XOR L
  , mr2op $ xorOpHLMemIntoA                 -- XOR (HL)
  , rr2op $ xorOpRegIntoA a                 -- XOR A

                                            -- Bx
  , rr2op $ orOpRegIntoA b                  -- OR B
  , rr2op $ orOpRegIntoA c                  -- OR C
  , rr2op $ orOpRegIntoA d                  -- OR D
  , rr2op $ orOpRegIntoA e                  -- OR E

  , rr2op $ orOpRegIntoA h                  -- OR H
  , rr2op $ orOpRegIntoA l                  -- OR L
  , mr2op $ orOpHLMemIntoA                  -- OR (HL)
  , rr2op $ orOpRegIntoA a                  -- OR A

  , rr2op $ compAToReg b                    -- CP B
  , rr2op $ compAToReg c                    -- CP C
  , rr2op $ compAToReg d                    -- CP D
  , rr2op $ compAToReg e                    -- CP E

  , rr2op $ compAToReg h                    -- CP H
  , rr2op $ compAToReg l                    -- CP L
  , mr2op $ compAToMemHL                    -- CP(HL)
  , rr2op $ compAToReg a                    -- CP A

                                            -- Cx
  , mr2op $ retFlag true zeroFlag           -- RET NZ
  , mr2op $ popReg setB setC                -- POP BC
  , mr2op $ jumpImmFlag true zeroFlag       -- JP NZ,nn
  , mr2op $ jumpImm                         -- JP nn

  , mm2op $ callImmFlag true zeroFlag       -- CALL NZ,nn
  , mm2op $ pushReg b c                     -- PUSH BC
  , mr2op $ addImmToA                       -- ADD A,n
  , mm2op $ callRoutine 0x00                -- RST 0

  , mr2op $ retFlag false zeroFlag          -- RET Z
  , mr2op $ ret                             -- RET
  , mr2op $ jumpImmFlag false zeroFlag      -- JP Z,nn
  , execExtOps extOps                       -- CB OpCode map

  , mm2op $ callImmFlag false zeroFlag      -- CALL Z,nn
  , mm2op $ callImm                         -- CALL nn
  , mr2op $ addImmCarryToA                  -- ADC A,n
  , mm2op $ callRoutine 0x08                -- RST 8

                                            -- Dx
  , mr2op $ retFlag true carryFlag          -- RET NC
  , mr2op $ popReg setD setE                -- POP DE
  , mr2op $ jumpImmFlag true carryFlag      -- JP NC,nn
  , invalidOpCode

  , mm2op $ callImmFlag true carryFlag      -- CALL NC,nn
  , mm2op $ pushReg d e                     -- PUSH DE
  , mr2op $ subImmFromA                     -- SUB A,n
  , mm2op $ callRoutine 0x10                -- RST 10

  , mr2op $ retFlag false carryFlag         -- RET C
  , mr2op $ retEnableInterrupt              -- RETI
  , mr2op $ jumpImmFlag false carryFlag     -- JP C,nn
  , invalidOpCode

  , mm2op $ callImmFlag true carryFlag      -- CALL C,nn
  , invalidOpCode
  , mr2op subImmCarryToA                    -- SBC A,n
  , mm2op $ callRoutine 0x18                -- RST 18

                                            -- Ex
  , mm2op $ ldFF00ImmMemFromReg a           -- LDH (n),A
  , mr2op $ popReg setH setL                -- POP HL
  , mm2op $ ldFF00CMemFromReg a             -- LDH (C),A
  , invalidOpCode

  , invalidOpCode
  , mm2op $ pushReg h l                     -- PUSH HL
  , mr2op andOpImmIntoA                     -- AND n
  , mm2op $ callRoutine 0x20                -- RST 20

  , mr2op addImmToSP                        -- ADD SP,d
  , rr2op jumpHL                            -- JP (HL)
  , mm2op ldMemImmFromRegA                  -- LD (nn),A
  , invalidOpCode

  , invalidOpCode
  , invalidOpCode
  , mr2op xorOpImmIntoA                     -- XOR n
  , mm2op $ callRoutine 0x28                -- RST 28

                                            -- Fx
  , mr2op $ ldRegFromFF00ImmMem setA        -- LDH A,(n)
  , mr2op $ popReg setA setF                -- POP AF
  , mr2op $ ldRegFromFF00CMem setA          -- LD A,(IOC)
  , rr2op $ setInterrupts false             -- DI

  , invalidOpCode
  , mm2op $ pushReg a f                     -- PUSH AF
  , mr2op orOpImmIntoA                      -- OR n
  , mm2op $ callRoutine 0x30                -- RST 30

  , mr2op ldHLFromSPImm                     -- LDHL SP,d
  , rr2op ldSPFromHL                        -- LD SP,HL
  , mr2op ldRegAFromMemImm                  -- LD A,(nn)
  , rr2op $ setInterrupts true              -- EI

  , invalidOpCode
  , invalidOpCode
  , mr2op compAToImm                        -- CP n
  , mm2op $ callRoutine 0x38                -- RST 38
]

module OpCodeMap where

import Prelude

import Types
import Ops

--Tried to use typeclasses, but was forced to turn all my type synonyms
--to 'newtypes' which will require writing a specialised function for each
--case to convert from the type synonyms to the newtypes which will beat
--the purpose of using a typeclass in the first place (lets me have function
--overload in this case).
rr2op :: (Regs -> Regs) -> Z80State -> Z80State
rr2op rr state@{mem=mem@{regs}} = state { mem = mem { regs = rr regs } }

mr2op :: (Mem -> Regs) -> Z80State -> Z80State
mr2op mr state@{mem=mem@{regs}} = state { mem = mem { regs = mr mem } }

mm2op :: (Mem -> Mem) -> Z80State -> Z80State
mm2op mm state@{mem=mem@{regs}} = state { mem = mm mem }

basicOps :: Array (Z80State -> Z80State)
basicOps =
                                            -- 0x
  [ rr2op $ nop                             -- NOP
  , mr2op $ ldTwoRegsFromImm setB setC      -- LD BC,nn
  , mm2op $ ldMem2RFromReg b c a            -- LD (BC),A
  , rr2op $ incRegWithCarry b c setB setC   -- INC BC

  , rr2op $ incReg b setB                   -- INC B
  , rr2op $ decReg b setB                   -- DEC B
  , mr2op $ ldRegFromImm setB               -- LD B,n
  , rr2op $ rotA Left true                  -- RLC A

  , mm2op $ ldMemImmFromSP                  -- LD (nn),SP
  , rr2op $ add2RegsToHL b c                -- ADD HL,BC
  , mr2op $ ldRegFromMem2R setA b c         -- LD A,(BC)
  , rr2op $ decRegWithCarry b c setB setC   -- DEC BC

  , rr2op $ incReg c setC                   -- INC C
  , rr2op $ decReg c setC                   -- DEC C
  , mr2op $ ldRegFromImm setC               -- LD C,n
  , rr2op $ rotA Right true                 -- RRC A

                                            -- 1x
  , stop                                    -- STOP
  , mr2op $ ldTwoRegsFromImm setD setE      -- LD DE,nn
  , mm2op $ ldMem2RFromReg d e a            -- LD (DE),A
  , rr2op $ incRegWithCarry d e setD setE   -- INC DE

  , rr2op $ incReg d setD                   -- INC D
  , rr2op $ decReg d setD                   -- DEC D
  , mr2op $ ldRegFromImm setD               -- LD D,n
  , rr2op $ rotA Left false                 -- RL A

  , mr2op $ jumpRelImm                      -- JR n
  , rr2op $ add2RegsToHL d e                -- ADD HL,DE
  , mr2op $ ldRegFromMem2R setA d e         -- LD A,(DE)
  , rr2op $ decRegWithCarry d e setD setE   -- DEC DE

  , rr2op $ incReg e setE                   -- INC E
  , rr2op $ decReg e setE                   -- DEC E
  , mr2op $ ldRegFromImm setE               -- LD E,n
  , rr2op $ rotA Right false                -- RR A

  , rr2op $ incReg e setE                   -- INC E
  , rr2op $ decReg e setE                   -- DEC E
  , mr2op $ ldRegFromImm setE               -- LD E,n
  , rr2op $ rotA Right false                -- RR A

                                            -- 2x
  , mr2op $ jumpRelImmFlag true zeroFlag    -- JR NZ,n
  , mr2op $ ldTwoRegsFromImm setH setL      -- LD HL,nn
  , mm2op $ ldMemHLFromRegInc a             -- LDI (HL),A
  , rr2op $ incRegWithCarry h l setH setL   -- INC HL

  , rr2op $ incReg h setH                   -- INC H
  , rr2op $ decReg h setH                   -- DEC H
  , mr2op $ ldRegFromImm setH               -- LD H,n
  , rr2op $ adjAForBCDAdd                   -- DAA

  , mr2op $ jumpRelImmFlag false zeroFlag   -- JR Z,n
  , rr2op $ add2RegsToHL h l                -- ADD HL,HL
  , mr2op $ ldRegFromMemHLInc setA          -- LDI A,(HL)
  , rr2op $ decRegWithCarry h l setH setL   -- DEC HL

  , rr2op $ incReg l setL                   -- INC L
  , rr2op $ decReg l setL                   -- DEC L
  , mr2op $ ldRegFromImm setL               -- LD L,n
  , rr2op $ cmplA                           -- CPL

                                            -- 3x
  , mr2op $ jumpRelImmFlag true carryFlag   -- JR NC,n
  , mr2op $ ldSPFromImm                     -- LD SP,nn
  , mm2op $ ldMemHLFromRegDec a             -- LDD (HL),A
  , rr2op $ incSP                           -- INC SP

  , mm2op $ incHLMem                        -- INC (HL)
  , mm2op $ decHLMem                        -- DEC (HL)
  , mm2op $ ldMemHLFromImm                  -- LD (HL),n
  , rr2op $ setCarryFlag                    -- SCF

  , mr2op $ jumpRelImmFlag false carryFlag  -- JR C,n
  , rr2op $ addSPToHL                       -- ADD HL,SP
  , mr2op $ ldRegFromMemHLDec setA          -- LDD A,(HL)
  , rr2op $ decSP                           -- DEC SP

  , rr2op $ incReg a setA                   -- INC A
  , rr2op $ decReg a setA                   -- DEC A
  , mr2op $ ldRegFromImm setA               -- LD A,n
  , rr2op $ clearCarryFlag                  -- CCF

                                            -- 4x
  , rr2op $ ldRegFromReg setB b             -- LD B,B
  , rr2op $ ldRegFromReg setB c             -- LD B,C
  , rr2op $ ldRegFromReg setB d             -- LD B,D
  , rr2op $ ldRegFromReg setB e             -- LD B,E

  , rr2op $ ldRegFromReg setB h             -- LD B,H
  , rr2op $ ldRegFromReg setB l             -- LD B,L
  , mr2op $ ldRegFromMem2R setB h l         -- LD B,(HL)
  , rr2op $ ldRegFromReg setB a             -- LD B,A

  , rr2op $ ldRegFromReg setC b             -- LD C,B
  , rr2op $ ldRegFromReg setC c             -- LD C,C
  , rr2op $ ldRegFromReg setC d             -- LD C,D
  , rr2op $ ldRegFromReg setC e             -- LD C,E

  , rr2op $ ldRegFromReg setC h             -- LD C,H
  , rr2op $ ldRegFromReg setC l             -- LD C,L
  , mr2op $ ldRegFromMem2R setC h l         -- LD C,(HL)
  , rr2op $ ldRegFromReg setC a             -- LD C,A

                                            -- 5x
  , rr2op $ ldRegFromReg setD b             -- LD D,B
  , rr2op $ ldRegFromReg setD c             -- LD D,C
  , rr2op $ ldRegFromReg setD d             -- LD D,D
  , rr2op $ ldRegFromReg setD e             -- LD D,E

  , rr2op $ ldRegFromReg setD h             -- LD D,H
  , rr2op $ ldRegFromReg setD l             -- LD D,L
  , mr2op $ ldRegFromMem2R setD h l         -- LD D,(HL)
  , rr2op $ ldRegFromReg setD a             -- LD D,A

  , rr2op $ ldRegFromReg setE b             -- LD E,B
  , rr2op $ ldRegFromReg setE c             -- LD E,C
  , rr2op $ ldRegFromReg setE d             -- LD E,D
  , rr2op $ ldRegFromReg setE e             -- LD E,E

  , rr2op $ ldRegFromReg setE h             -- LD E,H
  , rr2op $ ldRegFromReg setE l             -- LD E,L
  , mr2op $ ldRegFromMem2R setE h l         -- LD E,(HL)
  , rr2op $ ldRegFromReg setE a             -- LD E,A

                                            -- 6x
  , rr2op $ ldRegFromReg setH b             -- LD H,B
  , rr2op $ ldRegFromReg setH c             -- LD H,C
  , rr2op $ ldRegFromReg setH d             -- LD H,D
  , rr2op $ ldRegFromReg setH e             -- LD H,E

  , rr2op $ ldRegFromReg setH h             -- LD H,H
  , rr2op $ ldRegFromReg setH l             -- LD H,L
  , mr2op $ ldRegFromMem2R setH h l         -- LD H,(HL)
  , rr2op $ ldRegFromReg setH a             -- LD H,A

  , rr2op $ ldRegFromReg setL b             -- LD L,B
  , rr2op $ ldRegFromReg setL c             -- LD L,C
  , rr2op $ ldRegFromReg setL d             -- LD L,D
  , rr2op $ ldRegFromReg setL e             -- LD L,E

  , rr2op $ ldRegFromReg setL h             -- LD L,H
  , rr2op $ ldRegFromReg setL l             -- LD L,L
  , mr2op $ ldRegFromMem2R setL h l         -- LD L,(HL)
  , rr2op $ ldRegFromReg setL a             -- LD L,A

                                            -- 7x
  , mm2op $ ldMem2RFromReg h l b            -- LD (HL),B
  , mm2op $ ldMem2RFromReg h l c            -- LD (HL),C
  , mm2op $ ldMem2RFromReg h l d            -- LD (HL),D
  , mm2op $ ldMem2RFromReg h l e            -- LD (HL),E

  , mm2op $ ldMem2RFromReg h l h            -- LD (HL),H
  , mm2op $ ldMem2RFromReg h l l            -- LD (HL),L
  , halt                                    -- HALT
  , mm2op $ ldMem2RFromReg h l a            -- LD (HL),A

  , rr2op $ ldRegFromReg setA b             -- LD A,B
  , rr2op $ ldRegFromReg setA c             -- LD A,C
  , rr2op $ ldRegFromReg setA d             -- LD A,D
  , rr2op $ ldRegFromReg setA e             -- LD A,E

  , rr2op $ ldRegFromReg setA h             -- LD A,H
  , rr2op $ ldRegFromReg setA l             -- LD A,L
  , mr2op $ ldRegFromMem2R setA h l         -- LD A,(HL)
  , rr2op $ ldRegFromReg setA a             -- LD A,A

                                            -- 8x
  , rr2op $ addRegToA b                     -- ADD A,B
  , rr2op $ addRegToA c                     -- ADD A,C
  , rr2op $ addRegToA d                     -- ADD A,D
  , rr2op $ addRegToA e                     -- ADD A,E

  , rr2op $ addRegToA h                     -- ADD A,H
  , rr2op $ addRegToA l                     -- ADD A,L
  , mr2op $ addHLMemToA                     -- ADD A,(HL)
  , rr2op $ addRegToA a                     -- ADD A,A

  , rr2op $ addRegCarryToA b                -- ADC A,B
  , rr2op $ addRegCarryToA c                -- ADC A,C
  , rr2op $ addRegCarryToA d                -- ADC A,D
  , rr2op $ addRegCarryToA e                -- ADC A,E

  , rr2op $ addRegCarryToA h                -- ADC A,H
  , rr2op $ addRegCarryToA l                -- ADC A,L
  , mr2op $ addHLMemCarryToA                -- ADC A,(HL)
  , rr2op $ addRegCarryToA a                -- ADC A,A

                                            -- 9x
  , rr2op $ subRegFromA b                   -- SUB A,B
  , rr2op $ subRegFromA c                   -- SUB A,C
  , rr2op $ subRegFromA d                   -- SUB A,D
  , rr2op $ subRegFromA e                   -- SUB A,E

  , rr2op $ subRegFromA h                   -- SUB A,H
  , rr2op $ subRegFromA l                   -- SUB A,L
  , mr2op $ subHLMemFromA                   -- SUB A,(HL)
  , rr2op $ subRegFromA a                   -- SUB A,A

  , rr2op $ subRegCarryFromA b              -- SBC A,B
  , rr2op $ subRegCarryFromA c              -- SBC A,C
  , rr2op $ subRegCarryFromA d              -- SBC A,D
  , rr2op $ subRegCarryFromA e              -- SBC A,E

  , rr2op $ subRegCarryFromA h              -- SBC A,H
  , rr2op $ subRegCarryFromA l              -- SBC A,L
  , mr2op $ subHLMemCarryFromA              -- SBC A,(HL)
  , rr2op $ subRegCarryFromA a              -- SBC A,A

                                            -- Ax
  , rr2op $ andOpRegIntoA b                 -- AND B
  , rr2op $ andOpRegIntoA c                 -- AND C
  , rr2op $ andOpRegIntoA d                 -- AND D
  , rr2op $ andOpRegIntoA e                 -- AND E

  , rr2op $ andOpRegIntoA h                 -- AND H
  , rr2op $ andOpRegIntoA l                 -- AND L
  , mr2op $ andOpHLMemIntoA                 -- AND (HL)
  , rr2op $ andOpRegIntoA a                 -- AND A

  , rr2op $ xorOpRegIntoA b                 -- XOR B
  , rr2op $ xorOpRegIntoA c                 -- XOR C
  , rr2op $ xorOpRegIntoA d                 -- XOR D
  , rr2op $ xorOpRegIntoA e                 -- XOR E

  , rr2op $ xorOpRegIntoA h                 -- XOR H
  , rr2op $ xorOpRegIntoA l                 -- XOR L
  , mr2op $ xorOpHLMemIntoA                 -- XOR (HL)
  , rr2op $ xorOpRegIntoA a                 -- XOR A

                                            -- Bx
  , rr2op $ orOpRegIntoA b                  -- OR B
  , rr2op $ orOpRegIntoA c                  -- OR C
  , rr2op $ orOpRegIntoA d                  -- OR D
  , rr2op $ orOpRegIntoA e                  -- OR E

  , rr2op $ orOpRegIntoA h                  -- OR H
  , rr2op $ orOpRegIntoA l                  -- OR L
  , mr2op $ orOpHLMemIntoA                  -- OR (HL)
  , rr2op $ orOpRegIntoA a                  -- OR A

  , rr2op $ compAToReg b                    -- CP B
  , rr2op $ compAToReg c                    -- CP C
  , rr2op $ compAToReg d                    -- CP D
  , rr2op $ compAToReg e                    -- CP E

  , rr2op $ compAToReg h                    -- CP H
  , rr2op $ compAToReg l                    -- CP L
  , mr2op $ compAToMemHL                    -- CP(HL)
  , rr2op $ compAToReg a                    -- CP A

                                            -- Cx
  , mr2op $ retFlag true zeroFlag           -- RET NZ
  , mr2op $ popReg setB setC                -- POP BC
  , mr2op $ jumpImmFlag true zeroFlag       -- JP NZ,nn
  , mr2op $ jumpImm                         -- JP nn

  , mm2op $ callImmFlag true zeroFlag       -- CALL NZ,nn
  , mm2op $ pushReg b c                     -- PUSH BC
  , mr2op $ addImmToA                       -- ADD A,n
  , mm2op $ callRoutine 0x00                -- RST 0

  , mr2op $ retFlag false zeroFlag          -- RET Z
  , mr2op $ ret                             -- RET
  , mr2op $ jumpImmFlag false zeroFlag      -- JP Z,nn
  , execExtOps extOps                       -- CB OpCode map

  , mm2op $ callImmFlag false zeroFlag      -- CALL Z,nn
  , mm2op $ callImm                         -- CALL nn
  , mr2op $ addImmCarryToA                  -- ADC A,n
  , mm2op $ callRoutine 0x08                -- RST 8

                                            -- Dx
  , mr2op $ retFlag true carryFlag          -- RET NC
  , mr2op $ popReg setD setE                -- POP DE
  , mr2op $ jumpImmFlag true carryFlag      -- JP NC,nn
  , invalidOpCode

  , mm2op $ callImmFlag true carryFlag      -- CALL NC,nn
  , mm2op $ pushReg d e                     -- PUSH DE
  , mr2op $ subImmFromA                     -- SUB A,n
  , mm2op $ callRoutine 0x10                -- RST 10

  , mr2op $ retFlag false carryFlag         -- RET C
  , mr2op $ retEnableInterrupt              -- RETI
  , mr2op $ jumpImmFlag false carryFlag     -- JP C,nn
  , invalidOpCode

  , mm2op $ callImmFlag true carryFlag      -- CALL C,nn
  , invalidOpCode
  , mr2op subImmCarryToA                    -- SBC A,n
  , mm2op $ callRoutine 0x18                -- RST 18

                                            -- Ex
  , mm2op $ ldFF00ImmMemFromReg a           -- LDH (n),A
  , mr2op $ popReg setH setL                -- POP HL
  , mm2op $ ldFF00CMemFromReg a             -- LDH (C),A
  , invalidOpCode

  , invalidOpCode
  , mm2op $ pushReg h l                     -- PUSH HL
  , mr2op andOpImmIntoA                     -- AND n
  , mm2op $ callRoutine 0x20                -- RST 20

  , mr2op addImmToSP                        -- ADD SP,d
  , rr2op jumpHL                            -- JP (HL)
  , mm2op ldMemImmFromRegA                  -- LD (nn),A
  , invalidOpCode

  , invalidOpCode
  , invalidOpCode
  , mr2op xorOpImmIntoA                     -- XOR n
  , mm2op $ callRoutine 0x28                -- RST 28

                                            -- Fx
  , mr2op $ ldRegFromFF00ImmMem setA        -- LDH A,(n)
  , mr2op $ popReg setA setF                -- POP AF
  , mr2op $ ldRegFromFF00CMem setA          -- LD A,(IOC)
  , rr2op $ setInterrupts false             -- DI

  , invalidOpCode
  , mm2op $ pushReg a f                     -- PUSH AF
  , mr2op orOpImmIntoA                      -- OR n
  , mm2op $ callRoutine 0x30                -- RST 30

  , mr2op ldHLFromSPImm                     -- LDHL SP,d
  , rr2op ldSPFromHL                        -- LD SP,HL
  , mr2op ldRegAFromMemImm                  -- LD A,(nn)
  , rr2op $ setInterrupts true              -- EI

  , invalidOpCode
  , invalidOpCode
  , mr2op compAToImm                        -- CP n
  , mm2op $ callRoutine 0x38                -- RST 38
]