definition 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 iTasks
//
//import iTasks._Framework.Generic
//from iTasks._Framework.Task import :: Task
import StdClass
import GenEq, StdMisc, StdArray

import mTaskCode, mTaskSimulation, mTaskInterpret
//import mTaskCode, mTaskInterpret
import mTaskSerial, mTaskLCD

// =================== mTask ===================


// ----- dsl definition ----- //

:: DigitalPin 
   = D0 | D1 | D2 | D3 | D4 | D5 |D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13
:: AnalogPin = A0 | A1 | A2 | A3 | A4 | A5
:: UserLED = LED1 | LED2 | LED3
:: PinMode   = INPUT | OUTPUT | INPUT_PULLUP
:: Pin     = Digital DigitalPin | Analog AnalogPin

class pin p | type, == p where
  pin :: p -> Pin
instance pin DigitalPin
instance pin AnalogPin

:: Upd   = Upd
:: Expr  = Expr
:: Stmt  = Stmt
:: MTask = MTask Int // String

class isExpr a :: a -> Int
instance isExpr Upd
instance isExpr Expr

class isStmt a :: a -> Int
instance isStmt Upd
instance isStmt Expr
instance isStmt Stmt

instance == MTask

:: Main a = {main :: a}

unMain :: (Main x) -> x

class arith v where
  lit :: t -> v t Expr | toCode t & mTaskType t
  (+.) infixl 6 :: (v t p) (v t q) -> v t Expr | type, +, zero t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  (-.) infixl 6 :: (v t p) (v t q) -> v t Expr | type, -, zero t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  (*.) infixl 7 :: (v t p) (v t q) -> v t Expr | type, *, zero, one t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  (/.) infixl 7 :: (v t p) (v t q) -> v t Expr | type, /, zero t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
class boolExpr v where
  (&.) infixr 3 :: (v Bool p) (v Bool q) -> v Bool Expr | isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  (|.) infixr 2 :: (v Bool p) (v Bool q) -> v Bool Expr | isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  Not           :: (v Bool p) -> v Bool Expr | isExpr p //& toExpr2 p
  (==.) infix 4 :: (v a p) (v a q) -> v Bool Expr | ==, toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  (!=.) infix 4 :: (v a p) (v a q) -> v Bool Expr | ==, toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  (<.)  infix 4 :: (v a p) (v a q) -> v Bool Expr | <, Ord,  toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  (>.)  infix 4 :: (v a p) (v a q) -> v Bool Expr | <, Ord,  toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  (<=.) infix 4 :: (v a p) (v a q) -> v Bool Expr | <, Ord,  toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
  (>=.) infix 4 :: (v a p) (v a q) -> v Bool Expr | <, Ord,  toCode a & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
// using functional dependencies
class If v q r ~s where
  If :: (v Bool p) (v t q) (v t r) -> v t s | isExpr p & type t
class IF v where
  IF :: (v Bool p) (v t q) (v s r) -> v () Stmt | isExpr p
  (?) infix 1 :: (v Bool p) (v t q) -> v () Stmt | isExpr p
class var2 v where
  var2 :: t ((v t Upd)->(Main (v c s))) -> (Main (v c s)) | type, toCode t
  con2 :: t ((v t Expr)  ->(Main (v c s))) -> (Main (v c s)) | type t
class sds v where
  sds :: ((v t Upd)->In t (Main (v c s))) -> (Main (v c s)) | type, mTaskType, toCode t
  con :: ((v t Expr)  ->In t (Main (v c s))) -> (Main (v c s)) | type t
class namedsds v where
  namedsds :: ((v t Upd)->In (Named t String) (Main (v c s))) -> (Main (v c s)) | type, mTaskType, toCode t
class sdspub v where
  pub :: (v t Upd) -> v t Expr | type t
class seq v where
  (>>=.) infixr 0 :: (v t p) ((v t Expr) -> (v u q)) -> (v u Stmt) | type t & type u
  (:.) infixr 0 :: (v t p) (v u q) -> v u Stmt | type t & type u
class retrn v where
  retrn :: v () Expr
class step` v where
    (>>*.) infixl 1 :: (v t p) ((v t Expr) -> [Step v u]) -> v u Stmt | type t & type u
:: Step v t = E.p.q: Cond (v Bool q) (v t p) | E.p: Ever (v t p)
class assign v where
  (=.) infixr 2 :: (v t Upd) (v t p) -> v t Expr | type t & isExpr p
class fun v t where
  fun :: ((t->v s Expr)->In (t->v s p) (Main (v u q))) -> Main (v u q) | type s
class mtask v a where
  task :: (((v delay r) a->v MTask Expr)->In (a->v u p) (Main (v t q))) -> Main (v t q) | type t & type u & isExpr r & long v delay
class lag v where
  lag :: (v delay r) (v t p) -> v MTask Expr | type t & long v delay
class setDelay v where
  setDelay :: (v Long p) (v MTask Expr) -> (v MTask Expr) | isExpr p
class mtasks v a b where
  tasks :: (((v delay r1) a->v MTask Expr, (v delay r2) b->v MTask Expr)->In (a->v t p, b->v u p) (Main (v s q))) -> Main (v s q) | type s & isExpr r1 & isExpr r2 & long v delay
class output v where
  output :: (v t p) -> v () Expr | type t & isExpr p
class noOp v where noOp :: v t p

class pinMode v where
  pinmode :: p PinMode -> v () Expr | pin p
class digitalIO v where
  digitalRead  :: p -> v Bool Expr | pin, readPinD p
  digitalWrite :: p (v Bool q) -> v Bool Expr | pin, writePinD  p
class analogIO v where
  analogRead  :: AnalogPin -> v Int Expr 
  analogWrite :: AnalogPin (v Int p) -> v Int Expr 
class dIO v where
    dIO :: p -> v Bool Upd | pin, readPinD p
class aIO v where
    aIO :: AnalogPin -> v Int Upd
class time v where
  delay  :: (v Long p) -> (v Long Expr)
  millis ::         (v Long Expr)

class userLed v where
  ledOn :: (v UserLED q) -> (v () Stmt)
  ledOff :: (v UserLED q) -> (v () Stmt)

class pio p t where pio :: p -> v t Upd | aIO v & dIO v
instance pio AnalogPin Int
instance pio AnalogPin Bool
instance pio DigitalPin Bool

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

class type t | showType, dyn, toCode, ==, type2string, varName t
class type2string t :: t -> String
instance type2string Int
instance type2string Long
instance type2string Real
instance type2string Bool
instance type2string Char
instance type2string MTask
instance type2string DigitalPin
instance type2string AnalogPin
instance type2string UserLED
instance type2string String
instance type2string ()
class varName a :: a -> String
instance varName Int
instance varName Long
instance varName Bool
instance varName Char
instance varName Real
instance varName x

class dsl t | arith, boolExpr, sds, assign, seq t 

:: SV t = SV String

class showType2 t :: SV t
instance showType2 ()
instance showType2 Int
instance showType2 Char
instance showType2 Bool
instance showType2 a

class showType t | showType2 /*, type*/ t :: (Code t p)
instance showType ()
instance showType Int
instance showType Long
instance showType Char
instance showType Bool
instance showType a

class typeSelector t | showType2, type t :: (Code t p)
instance typeSelector Int
instance typeSelector Char
instance typeSelector Bool
instance typeSelector a

:: In a b = In infix 0 a b
:: Named a b = Named infix 1 a b

read` :: Int (ReadWrite a) State` -> (a,State`) | dyn a

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

:: Long = L Int // 32 bit on Arduino
instance + Long
instance - Long
instance * Long
instance / Long
instance == Long
instance one Long
instance zero Long

class long v t :: (v t p) -> v Long Expr | isExpr p
instance long Code Int
instance long Code Long
instance long Eval Int
instance long Eval Long

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

instance == DigitalPin
instance == AnalogPin
instance == UserLED

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

instance toString ()

a0 :== pio A0
a1 :== pio A1
a2 :== pio A2
a3 :== pio A3
a4 :== pio A4
a5 :== pio A5

d0 :== pio D0
d1 :== pio D1
d2 :== pio D2
d3 :== pio D3
d4 :== pio D4
d5 :== pio D5
d6 :== pio D6
d7 :== pio D7
d8 :== pio D8
d9 :== pio D9
d10 :== pio D10
d11 :== pio D11
d12 :== pio D12
d13 :== pio D13