content: {-# OPTIONS_GHC -fno-warn-orphans #-}
  {-# LANGUAGE DataKinds         #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE QuasiQuotes       #-}
  {-# LANGUAGE TypeOperators     #-}
  
  module Alloc where
  
  import           Ivory.Compile.C.CmdlineFrontend
  import           Ivory.Compile.C.Modules
  import           Ivory.Language
  
  
  [ivory|
  
  struct Foo
    { i :: Stored Uint32
    ; p :: Array 10 (Stored Uint32)
    ; d :: Stored Uint32
    }
  
  struct Str {
    name :: Array 32 (Stored IChar)
    }
  
  |]
  
  test :: Def ('[Ref s ('Struct "Foo")] ':-> Ref s ('Stored Uint32))
  test  = proc "alloc_test" (\ pid -> body (ret (pid ~> i)))
  
  get_p :: Def ('[] ':-> Uint32)
  get_p  = proc "get_p" $ body $ do
    pid <- local (istruct [])
    ret =<< deref (pid ~> d)
  
  memcpy1 :: Def ('[ Ref a ('Struct "Foo"), Ref a ('Struct "Foo") ] ':-> Uint32)
  memcpy1 = proc "memcpy1" $ \a b -> body $ do
    refCopy b a
    ret =<< deref (b ~> i)
  
  memcpy2 :: Def ('[ Ref a ('Array 10 ('Stored Uint32))
                   , Ref a ('Array 10 ('Stored Uint32)) ] ':-> ())
  memcpy2 = proc "memcpy2" $ \a b -> body $ do
    refCopy b a
    arrayMap (\ix -> store (a ! (ix :: Ix 10)) 1)
    retVoid
  
  memcpy3 :: Def ('[ Ref 'Global ('Array 10 ('Stored Uint32))] ':-> ())
  memcpy3 = proc "memcpy3" $ \a -> body $ do
    b <- local (iarray $ replicate 10 (ival $ 0))
    refCopy b a
    arrayMap (\ix -> store (a ! (ix :: Ix 10)) 1)
    retVoid
  
  {-
  -- Can't do this! (Which is good.)
  memcpy4 :: Def ('[ Ref Global (Array 1 (Stored (Ref (Stack s) (Stored Uint32))))] :-> ())
  memcpy4 = proc "memcpy3" $ \a -> body $ do
    val  <- local (ival 2)
    larr <- local (iarray [ival val])
    refCopy a larr
    arrayMap (\ix -> store (a ! (ix :: Ix 1)) 1)
    retVoid
  
  -- The type system prevents this.
  bad_alloc :: Def ('[] :-> Ref s (Stored Uint32))
  bad_alloc = proc "bad_alloc" $ body $ do
    pid <- local (istruct [])
    ret (pid~>i)
  -}
  
  arrMap :: Def ('[Ref s ('Array 15 ('Stored Sint32))] ':-> ())
  arrMap = proc "arrMap" $ \ arr -> body $ do
    arrayMap (\ix -> store (arr ! (ix :: Ix 15)) 1)
    retVoid
  
  -- String copy test -------------------------
  ptrstrcpy :: Def ('[ Ref s ('CArray ('Stored IChar))
                     , IString
                     , Uint32] ':-> ())
  ptrstrcpy = proc "ptrstrcpy" $ \ _ _ _ ->  body $ do
    retVoid
  
  callstrcpy :: Def ('[] ':-> ())
  callstrcpy  = proc "callstrcpy" $ body $ do
    buf' <- local (iarray [])
    call_ mystrcpy buf' "hello"
    retVoid
  
  -- | Safely copy a string literal into a character array.
  mystrcpy :: Def ('[Ref s ('Array 10 ('Stored IChar)), IString] ':-> ())
  mystrcpy = proc "mystrcpy" $ \ buf s -> body $ do
    buf' <- assign $ toCArray buf
    call_ ptrstrcpy buf' s (arrayLen buf)
    retVoid
  
  assign_test :: Def ('[] ':-> ())
  assign_test  = proc "assign_test" $ body $ do
    val <- local (istruct [])
    _ <- assign (val ~> p)
    retVoid
  
  bar :: Def ('[] ':-> ())
  bar = proc "bar" $ body $ do
    pid <- local $ istruct [i .= ival 3]
    arr <- local $ iarray [ ival c | c <- replicate 10 (char 'a') ]
    call_ mystrcpy arr "hello"
    store (pid~>i) 4
  
  castIx :: Def ('[Ix 253] ':-> Uint8)
  castIx = proc "castIx" $ \ix -> body $ do
    ret $ safeCast (ix :: Ix 253)
  
  loopTest :: Def ('[Ref s ('Array 15 ('Stored Sint32))] ':-> ())
  loopTest = proc "loopTest" $ \ arr -> body $ do
    arrayMap       (\ix -> store (arr ! (ix :: Ix 15)) 1)
    2 `downTo` 0 $ (\ix -> store (arr ! (ix :: Ix 15)) 1)
    0 `upTo`   2 $ (\ix -> store (arr ! (ix :: Ix 15)) 1)
    retVoid
  
  testToIx :: Def ('[Sint32, Ref s ('Array 10 ('Stored Uint32))] ':-> Ref s ('Stored Uint32))
  testToIx = proc "testToIx" $ \ ind arr -> body $ do
    let idx = toIx ind :: Ix 10
    ret (arr ! idx)
  
  arrayTest :: MemArea ('Array 10 ('Struct "Foo"))
  arrayTest  = area "arrayTest" $ Just $ iarray
    [ istruct [ i .= ival 10 ]
    ]
  
  -- uint32_t n_deref0 = *&n_var0->i;
  foo :: Def ('[Ref s ('Struct "Foo")] ':-> Uint32)
  foo = proc "foo" $ \str -> body $ do
    ret =<< deref (str ~> i)
  
  -- uint32_t n_deref0 = *&n_var0->p[0 % 10];
  foo2 :: Def ('[Ref s ('Struct "Foo")] ':-> Uint32)
  foo2 = proc "foo2" $ \str -> body $ do
    let arr = (str ~> p)
    let x = arr ! (0 :: Ix 10)
    ret =<< deref x --deref (arr ! 0)
  
  ---------------------------------------------
  
  -- Testing matrices
  mat1 :: Def ('[ConstRef s ('Array 1 ('Array 2 ('Stored Uint32)))] ':-> Uint32)
  mat1 = proc "mat1" $ \arr -> body $ do
    v <- deref (arr ! 1 ! 0)
    ret v
  
  mat2 :: Def ('[] ':-> Uint32)
  mat2 = proc "mat2" $ body $ do
    arr <- local ((iarray [iarray [ival 0, ival 1]]) :: Init ('Array 1 ('Array 2 ('Stored Uint32))))
    arr2 <- local ((iarray [iarray [ival 3, ival 3]]) :: Init ('Array 1 ('Array 2 ('Stored Uint32))))
    v' <- assign arr
    refCopy arr2 v'
    refZero arr2
    v  <- call mat1 (constRef arr)
    ret v
  
  cmodule :: Module
  cmodule = package "Alloc" $ do
    defStruct (Proxy :: Proxy "Foo")
    defStruct (Proxy :: Proxy "Str")
    incl test
    incl get_p
    incl arrMap
    incl ptrstrcpy
    incl mystrcpy
    incl callstrcpy
    incl assign_test
    incl bar
    incl castIx
    incl loopTest
    incl memcpy1
    incl memcpy2
    incl testToIx
    incl memcpy3
    defMemArea arrayTest
    incl mat1
    incl mat2
  
  runAlloc :: IO ()
  runAlloc = runCompiler [cmodule] [] initialOpts { outDir = Nothing }
  
  test2 :: String
  test2 = showModule (compileModule Nothing cmodule)
  