implementation module mTask

/*
    Pieter Koopman pieter@cs.ru.nl
    Final version for TFP2016
    
    -2: assignment =. suited for digital and analog input and output
    -3: ad hoc tasks
    
todo:
	move task-loop ti setup()
	adhoc tasks
	task combinators
	imporove setp: >>*.
*/

import Generics.gCons
import Generics.gdynamic

import iTasks
import GenEq, StdMisc, StdArray, GenBimap
import mTaskCode
import mTaskSerial, mTaskLCD

instance pin DigitalPin where
	pin p = Digital p

instance pin AnalogPin  where
  pin p = Analog  p

instance isExpr Upd  where isExpr _ = 0
instance isExpr Expr where isExpr _ = 1

instance isStmt Upd where isStmt _ = 10
instance isStmt Expr   where isStmt _ = 11
instance isStmt Stmt   where isStmt _ = 12

instance == MTask where (==) (MTask x) (MTask y) = x == y

unMain :: (Main x) -> x
unMain m = m.main //{main=x} = x

instance pio AnalogPin Int where pio p = aIO p
instance pio AnalogPin Bool where pio p = dIO p
instance pio DigitalPin Bool where pio p = dIO p

int :: (v Int p) -> (v Int p)
int x = x
bool :: (v Bool p) -> (v Bool p)
bool x = x
char :: (v Char p) -> (v Char p)
char x = x

instance type2string Int        where type2string _ = "int"
instance type2string Long       where type2string _ = "long"
instance type2string Real       where type2string _ = "float"
instance type2string Bool       where type2string _ = "bool" //"boolean"
instance type2string Char       where type2string _ = "char"
instance type2string MTask      where type2string _ = "task"
instance type2string DigitalPin where type2string _ = "int"
instance type2string AnalogPin  where type2string _ = "int"
instance type2string UserLED    where type2string _ = "int"
instance type2string String     where type2string _ = "Char []"
instance type2string ()         where type2string _ = ""

instance varName Int    where varName _ = "vInt"
instance varName Long   where varName _ = "vLong"
instance varName Bool   where varName _ = "vBool"
instance varName Char   where varName _ = "vChar"
instance varName Real   where varName _ = "vFloat"
instance varName x      where varName _ = ""

instance showType2 ()   where showType2 = SV "void "
instance showType2 Int  where showType2 = SV "int "
instance showType2 Char where showType2 = SV "char "
instance showType2 Bool where showType2 = SV "bool "
instance showType2 a    where showType2 = SV "word /* default */"

instance showType ()   where showType = c "void "
instance showType Int  where showType = c "int "
instance showType Long where showType = c "long "
instance showType Char where showType = c "char "
instance showType Bool where showType = c "bool "
instance showType a    where showType = c "word /* default */ "

instance typeSelector Int  where typeSelector = c ".i"
instance typeSelector Char where typeSelector = c ".c"
instance typeSelector Bool where typeSelector = c ".b"
instance typeSelector a    where typeSelector = c ".w"

read` :: Int (ReadWrite a) State` -> (a,State`) | dyn a
read` n Rd       s = (fromJust (fromDyn (s.store !! n)), s)
read` n (Wrt a)  s = (a,{s&store=updateAt n (toDyn a) s.store})
read` n (Updt f) s=:{store}
  # obj = f (fromJust (fromDyn (store !! n)))
  = (obj, {s & store = updateAt n (toDyn obj) store})

// ----- long ----- //

:: Long = L Int // 32 bit on Arduino
instance + Long where (+) (L x) (L y) = L (x + y)
instance - Long where (-) (L x) (L y) = L (x + y)
instance * Long where (*) (L x) (L y) = L (x + y)
instance / Long where (/) (L x) (L y) = L (x + y)
instance == Long where (==) (L x) (L y) = x == y
instance one Long where one = L one
instance zero Long where zero = L zero
now = lit (L 0)

class long v t :: (v t p) -> v Long Expr | isExpr p
instance long Code Int where
  long x = embed (c "long" +.+ brac x)
instance long Code Long where
  long x = embed (c "long" +.+ brac x)
instance long Eval Int where
  long x = x >>== rtrn o L
instance long Eval Long where
  long (E x) = E x

// ----- tools ----- //

instance == DigitalPin where (==) x y = x === y
instance == AnalogPin   where (==) x y = x === y
instance == UserLED where (==) x y = x === y

//derive class gCons UserLED, Long, Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
//derive class iTask UserLED, Long, Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode

tab =: toString (repeatn tabSize ' ')
tabSize :== 2

instance toString () where toString _ = "()"