{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts,
    UndecidableInstances, ScopedTypeVariables, RankNTypes, 
    NoMonomorphismRestriction#-}

{- Wrap state space models in Pd-like objects with state struct and
   input / output float arrays. -}

module Pd(pdInit, pdUpdate, pdModule) where

import Data
import Control
import Struct
import Lib
  
import Array
import SArray


-- import Sys
-- import Array
-- import SArray



-- State initializer
pdInit mv = lam $ \(L s) -> do
  v <- mv
  pv <- pack v
  setp s pv
  exit 0


-- Update function
pdUpdate update = lam funBody where
  funBody (s, ((L pi, L po),n)) = do
    i <- getp pi
    o <- getp po
    letrec (loopExpr (s,((L i, L o),n)) update)
            (initExpr s) 
      
loopExpr (L refs, ((L arri, L arro), L arrn)) update loop = lam loopBody
  where
    loopBody (s, L n) = do
      i <- gett arri n
      (s', o) <- update (s, i)
      sett arro n o
      more <- lt n arrn
      ifte more 
        (do
            l1 <- lit 1
            n' <- add n l1
            app loop (s', L n'))
        (do
            spacked <- pack s'
            setp refs spacked
            exit 0)

initExpr (L refs) loop = do
  spacked <- getp refs
  s <- unpack spacked
  l0 <- lit 0
  app loop (s, L l0)





pdModule
  (update :: (s,i) -> m (s,o)) 
  (init   :: m s) 
  = do
    def "sm_state_size" $ pdInt (4 * ns)
    def "sm_nb_init"    $ pdInt ns
    def "sm_nb_in"      $ pdInt ni
    def "sm_nb_out"     $ pdInt no
    def "sm_blocksize"  $ pdInt 64
    def "sm_init"       $ pdInit init
    def "sm_tick"       $ pdUpdate update
      where
        pdInt n = lam $ \() -> exit (n :: Tint)
        -- Type-indexed info.
        ns = structSize (undefined :: s)
        ni = structSize (undefined :: i)
        no = structSize (undefined :: o)