{-# OPTIONS_GHC -fglasgow-exts #-}

module PIL.Native.Prims where
import PIL.Native.Types
import PIL.Native.Coerce
import qualified Data.Map as NMap

{-| 

PIL.Native.Prims

This module defines the methods available for our Native types. 

NOTE: All types respond to the methods of Any

Any
  as_bit  ()        -> Bit
  as_int  ()        -> Int
  as_num  ()        -> Num    
  as_str  ()        -> Str
  is_nil  ()        -> Bit  
  not_nil ()        -> Bit
  eq      ()        -> Bit
  lt      ()        -> Bit      
  le      ()        -> Bit  
  gt      ()        -> Bit  
  ge      ()        -> Bit  
  
Bit
  not ()            -> Bit
  and (Block)       -> Bit
  or  (Block)       -> Bit

Int 
  increment ()      -> Int
  decrement ()      -> Int   
  add       (Int)   -> Int
  subtract  (Int)   -> Int      
  multiply  (Int)   -> Int         
  divide    (Int)   -> Int    
                    
Num                 
  increment ()      -> Num
  decrement ()      -> Num   
  add       (Num)   -> Num
  subtract  (Num)   -> Num      
  multiply  (Num)   -> Num         
  divide    (Num)   -> Num         

Str 
  length ()         -> Num
  concat (Str)      -> Str
  fetch  ()         -> Str
  store  (Str)      -> Nil
  
List 
  length ()         -> Num
  concat (Any)      -> Nil
  fetch  (Num)      -> Any
  store  (Num, Any) -> Nil 
  push   (List)     -> Nil

Hash 
  length ()         -> Num
  keys   ()         -> List
  values ()         -> List
  concat (Any)      -> Nil
  fetch  (Any)      -> Any
  exists (Any)      -> Any
  store  (Any, Any) -> Nil
  push   (Hash)     -> Nil  

See Also:

  PIL.Native.Types
  PIL.Native.Coerce

-}

type Prims = MapOf (Native -> Native)

anyPrims :: MapOf (Native -> SeqOf Native -> Native)
anyPrims = mkMap
    [ prim0 "as_bit"    (fromNative :: Native -> NativeBit)
    , prim0 "as_int"    (fromNative :: Native -> NativeInt)
    , prim0 "as_num"    (fromNative :: Native -> NativeNum)
    , prim0 "as_str"    (fromNative :: Native -> NativeStr)
    , prim0 "is_nil"    is_nil
    , prim0 "not_nil"   (not . is_nil)
    , prim1 "eq"        (==)
    , prim1 "lt"        (<)
    , prim1 "le"        (<=)
    , prim1 "gt"        (>)
    , prim1 "ge"        (>=)
    ]

bitPrims :: MapOf (NativeBit -> SeqOf Native -> Native)
bitPrims = mkMap
    [ prim0 "not"  not
    , prim1 "and"  (&&)
    , prim1 "or"   (||)
    ]

intPrims :: MapOf (NativeInt -> SeqOf Native -> Native)
intPrims = mkMap
    [ prim0 "increment"  succ
    , prim0 "decrement"  pred
    , prim1 "add"        (+)
    , prim1 "subtract"   (-)
    , prim1 "multiply"   (*)
    , prim1 "divide"     div
    ]

numPrims :: MapOf (NativeNum -> SeqOf Native -> Native)
numPrims = mkMap
    [ prim0 "increment"  succ
    , prim0 "decrement"  pred
    , prim1 "add"        (+)
    , prim1 "subtract"   (-)
    , prim1 "multiply"   (*)
    , prim1 "divide"     (/)
    ]

strPrims :: MapOf (NativeStr -> SeqOf Native -> Native)
strPrims = mkMap
    [ prim0 "length"     (size)
    , prim0 "reverse"    (reversed)
    , prim0 "is_empty"   (isEmpty)
    , prim1 "concat"     (append)
    , prim1 "fetch"      (fetch)
    , prim1 "splice"     (splice)
    , prim2 "store"      (insert)
    ]

seqPrims :: MapOf (NativeSeq -> SeqOf Native -> Native)
seqPrims = mkMap
    [ prim0 "length"     (size)
    , prim0 "reverse"    (reversed)
    , prim0 "is_empty"   (isEmpty)
    , prim1 "concat"     (append)
    , prim1 "fetch"      (fetch)
    , prim1 "splice"     (splice)
    , prim2 "store"      (insert)
    , primX "push"       (push)
    ]

mapPrims :: MapOf (NativeMap -> SeqOf Native -> Native)
mapPrims = mkMap
    [ prim0 "length"     (size)
    , prim0 "keys"       (indices)
    , prim0 "is_empty"   (isEmpty)
    , prim0 "values"     (elems)
    , prim1 "concat"     (append)
    , prim1 "fetch"      (fetch)
    , prim1 "exists"     (exists)
    , prim1 "delete"     (delete)    
    , prim2 "store"      (insert)
    , primX "push"       (pushHash)
    ]
    where
    pushHash :: NativeMap -> SeqOf Native -> NativeMap
    pushHash obj args = obj `NMap.union` (NMap.fromList $ listHash $ elems args)
    listHash [] = []
    listHash (k:v:xs) = (fromNative k, v):(listHash xs)
    listHash _ = error "odd number of elements for hash"

prim0 :: (IsNative inv, IsNative ret)
    => String
    -> (inv -> ret)
    -> (String, inv -> SeqOf Native -> Native)
prim0 str f = (str, f')
    where
    f' obj args | isEmpty args = toNative (f obj)
    f' _   _    = errArgs

prim1 :: (IsNative inv, IsNative a, IsNative ret)
    => String
    -> (inv -> a -> ret)
    -> (String, inv -> SeqOf Native -> Native)
prim1 str f = (str, f')
    where
    f' obj args | size args == 1 =
        toNative $ f obj (fromNative $ args ! 0)
    f' _   _    = errArgs

prim2 :: (IsNative inv, IsNative a, IsNative b, IsNative ret)
    => String
    -> (inv -> a -> b -> ret)
    -> (String, inv -> SeqOf Native -> Native)
prim2 str f = (str, f')
    where
    f' obj args | size args == 2 =
        toNative $ f obj (fromNative $ args ! 0) (fromNative $ args ! 1)
    f' _   _    = errArgs

primX :: (IsNative inv, IsNative ret)
    => String
    -> (inv -> SeqOf Native -> ret)
    -> (String, inv -> SeqOf Native -> Native)
primX str f = (str, f')
    where
    f' obj args = toNative $ f obj args

errArgs :: forall a. a
errArgs = error "Invalid number of arguments"