module Kempe.Check.Lint ( lint
                        ) where

import           Data.Foldable.Ext
import           Kempe.AST
import           Kempe.Error.Warning

lint :: Declarations a b b -> Maybe (Warning b)
lint :: Declarations a b b -> Maybe (Warning b)
lint = (KempeDecl a b b -> Maybe (Warning b))
-> Declarations a b b -> Maybe (Warning b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldMapAlternative KempeDecl a b b -> Maybe (Warning b)
forall a b. KempeDecl a b b -> Maybe (Warning b)
lintDecl

-- TODO: lint for something like dip(0) -> replace with 0 swap

lintDecl :: KempeDecl a b b -> Maybe (Warning b)
lintDecl :: KempeDecl a b b -> Maybe (Warning b)
lintDecl Export{}             = Maybe (Warning b)
forall a. Maybe a
Nothing
lintDecl TyDecl{}             = Maybe (Warning b)
forall a. Maybe a
Nothing
lintDecl ExtFnDecl{}          = Maybe (Warning b)
forall a. Maybe a
Nothing
lintDecl (FunDecl b
_ Name b
_ [KempeTy a]
_ [KempeTy a]
_ [Atom b b]
as) = [Atom b b] -> Maybe (Warning b)
forall b. [Atom b b] -> Maybe (Warning b)
lintAtoms [Atom b b]
as

-- TODO: swap drop drop -> drop drop
-- TODO: dup - -> 0

-- a bunch of this is from http://joy-lang.org/papers-on-joy/the-algebra-of-joy/
lintAtoms :: [Atom b b] -> Maybe (Warning b)
lintAtoms :: [Atom b b] -> Maybe (Warning b)
lintAtoms []                                                            = Maybe (Warning b)
forall a. Maybe a
Nothing
lintAtoms (a :: Atom b b
a@(Dip b
l [Atom b b]
_):a' :: Atom b b
a'@Dip{}:[Atom b b]
_)                                      = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
DoubleDip b
l Atom b b
a Atom b b
a')
lintAtoms (a :: Atom b b
a@(IntLit b
l Integer
_):(AtBuiltin b
_ BuiltinFn
Drop):[Atom b b]
_)                         = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
PushDrop b
l Atom b b
a)
lintAtoms (a :: Atom b b
a@(WordLit b
l Natural
_):(AtBuiltin b
_ BuiltinFn
Drop):[Atom b b]
_)                        = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
PushDrop b
l Atom b b
a)
lintAtoms (a :: Atom b b
a@(BoolLit b
l Bool
_):(AtBuiltin b
_ BuiltinFn
Drop):[Atom b b]
_)                        = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
PushDrop b
l Atom b b
a)
lintAtoms (a :: Atom b b
a@(Int8Lit b
l Int8
_):(AtBuiltin b
_ BuiltinFn
Drop):[Atom b b]
_)                        = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
PushDrop b
l Atom b b
a)
lintAtoms ((Dip b
l [AtBuiltin b
_ BuiltinFn
IntPlus]):a :: Atom b b
a@(AtBuiltin b
_ BuiltinFn
IntPlus):[Atom b b]
_)     = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
DipAssoc b
l Atom b b
a)
lintAtoms ((Dip b
l [AtBuiltin b
_ BuiltinFn
IntTimes]):a :: Atom b b
a@(AtBuiltin b
_ BuiltinFn
IntTimes):[Atom b b]
_)   = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
DipAssoc b
l Atom b b
a)
lintAtoms ((Dip b
l [AtBuiltin b
_ BuiltinFn
WordPlus]):a :: Atom b b
a@(AtBuiltin b
_ BuiltinFn
WordPlus):[Atom b b]
_)   = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
DipAssoc b
l Atom b b
a)
lintAtoms ((Dip b
l [AtBuiltin b
_ BuiltinFn
WordTimes]):a :: Atom b b
a@(AtBuiltin b
_ BuiltinFn
WordTimes):[Atom b b]
_) = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
DipAssoc b
l Atom b b
a)
lintAtoms ((Dip b
l [AtBuiltin b
_ BuiltinFn
And]):a :: Atom b b
a@(AtBuiltin b
_ BuiltinFn
And):[Atom b b]
_)             = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
DipAssoc b
l Atom b b
a)
lintAtoms ((Dip b
l [AtBuiltin b
_ BuiltinFn
Or]):a :: Atom b b
a@(AtBuiltin b
_ BuiltinFn
Or):[Atom b b]
_)               = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
DipAssoc b
l Atom b b
a)
lintAtoms ((Dip b
l [AtBuiltin b
_ BuiltinFn
IntEq]):a :: Atom b b
a@(AtBuiltin b
_ BuiltinFn
IntEq):[Atom b b]
_)         = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
DipAssoc b
l Atom b b
a)
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):(AtBuiltin b
_ BuiltinFn
Swap):[Atom b b]
_)                     = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Warning b
forall a. a -> Warning a
DoubleSwap b
l)
lintAtoms ((AtBuiltin b
l BuiltinFn
Dup):a :: Atom b b
a@(AtBuiltin b
_ BuiltinFn
And):[Atom b b]
_)                     = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
Identity b
l Atom b b
a)
lintAtoms ((AtBuiltin b
l BuiltinFn
Dup):a :: Atom b b
a@(AtBuiltin b
_ BuiltinFn
Or):[Atom b b]
_)                      = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Warning a
Identity b
l Atom b b
a)
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
_ BuiltinFn
IntEq):[Atom b b]
_)                 = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' Atom b b
a')
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
_ BuiltinFn
IntNeq):[Atom b b]
_)                = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' Atom b b
a')
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
_ BuiltinFn
And):[Atom b b]
_)                   = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' Atom b b
a')
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
_ BuiltinFn
Or):[Atom b b]
_)                    = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' Atom b b
a')
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
_ BuiltinFn
Xor):[Atom b b]
_)                   = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' Atom b b
a')
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
_ BuiltinFn
WordXor):[Atom b b]
_)               = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' Atom b b
a')
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
_ BuiltinFn
IntTimes):[Atom b b]
_)              = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' Atom b b
a')
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
_ BuiltinFn
IntPlus):[Atom b b]
_)               = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' Atom b b
a')
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
_ BuiltinFn
WordPlus):[Atom b b]
_)              = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' Atom b b
a')
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
_ BuiltinFn
WordTimes):[Atom b b]
_)             = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' Atom b b
a')
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
_ BuiltinFn
IntXor):[Atom b b]
_)                = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' Atom b b
a')
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
l' BuiltinFn
IntGt):[Atom b b]
_)                = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' (b -> BuiltinFn -> Atom b b
forall c b. b -> BuiltinFn -> Atom c b
AtBuiltin b
l' BuiltinFn
IntLt))
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
l' BuiltinFn
IntGeq):[Atom b b]
_)               = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' (b -> BuiltinFn -> Atom b b
forall c b. b -> BuiltinFn -> Atom c b
AtBuiltin b
l' BuiltinFn
IntLeq))
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
l' BuiltinFn
IntLt):[Atom b b]
_)                = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' (b -> BuiltinFn -> Atom b b
forall c b. b -> BuiltinFn -> Atom c b
AtBuiltin b
l' BuiltinFn
IntGt))
lintAtoms ((AtBuiltin b
l BuiltinFn
Swap):a' :: Atom b b
a'@(AtBuiltin b
l' BuiltinFn
IntLeq):[Atom b b]
_)               = Warning b -> Maybe (Warning b)
forall a. a -> Maybe a
Just (b -> Atom b b -> Atom b b -> Warning b
forall a. a -> Atom a a -> Atom a a -> Warning a
SwapBinary b
l Atom b b
a' (b -> BuiltinFn -> Atom b b
forall c b. b -> BuiltinFn -> Atom c b
AtBuiltin b
l' BuiltinFn
IntGeq))
lintAtoms (Atom b b
_:[Atom b b]
as)                                                        = [Atom b b] -> Maybe (Warning b)
forall b. [Atom b b] -> Maybe (Warning b)
lintAtoms [Atom b b]
as