imporove setp: >>*.
*/
-//import iTasks
+import Generics.gCons
+import Generics.gdynamic
+
+import iTasks
+
import iTasks._Framework.Generic
-import iTasks._Framework.Task
+from iTasks._Framework.Task import :: Task
import StdClass
-from iTasks.API.Core.Types import :: Display
-import gdynamic, gCons, GenEq, StdMisc, StdArray
+import GenEq, StdMisc, StdArray
+import mTaskCode, mTaskSimulation, mTaskInterpret
import mTaskSerial, mTaskLCD
// =================== mTask ===================
:: 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
-instance toCode Pin
class pin p | type, == p where
pin :: p -> Pin
instance isStmt Stmt
instance == MTask
-instance toCode MTask
:: Main a = {main :: a}
unMain :: (Main x) -> x
class arith v where
- lit :: t -> v t Expr | toCode t
+ lit :: t -> v t Expr | toCode t & toByteCode 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
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, toCode t
+ sds :: ((v t Upd)->In t (Main (v c s))) -> (Main (v c s)) | type, toByteCode, toCode t
con :: ((v t Expr) ->In t (Main (v c s))) -> (Main (v c s)) | type t
+ 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
delay :: (v Long p) -> (v Long Expr)
millis :: (v Long Expr)
+class userLed v where
+ ledOn :: UserLED -> (v () Stmt)
+ ledOff :: UserLED -> (v () Stmt)
+
class pio p t where pio :: p -> v t Upd | aIO v & dIO v
instance pio AnalogPin Int
instance pio AnalogPin Bool
class dsl t | arith, boolExpr, sds, assign, seq t
-argType :: (((Code a p)->Code b q)->In ((Code a p)->Code b q) (Code c s)) -> a | type a
-
-class argTypes t :: ((t->Code b Expr)->In (t->Code b2 q) (Main (Code c s))) -> t
-instance argTypes (Code a p) | showType a
-instance argTypes (Code a p, Code b q) | showType a & showType b
-instance argTypes (Code a p, Code b q, Code c r) | showType a & showType b & showType c
-
-resType :: ((t->Code b Expr)->In (t->Code b q) (Main (Code c s))) -> Code b q | showType b
-
-var2Type :: (Code t p) -> Code t p | showType t
-
-resType2 :: ((t->Code b Expr)->In (t->Code b q) (Main (Code c s))) -> SV b | showType2 b
-
:: SV t = SV String
-instance toCode (SV t)
class showType2 t :: SV t
instance showType2 ()
:: In a b = In infix 0 a b
-read` :: Int (ReadWrite a) State -> (a,State) | dyn a
-
-// ----- code generation ----- //
-
-instance arith Code
-instance boolExpr Code
-instance If Code Stmt Stmt Stmt
-instance If Code e Stmt Stmt
-instance If Code Stmt e Stmt
-instance If Code x y Expr
-instance IF Code
-instance sds Code
-
-defCode :: ((Code t p) -> In t (Main (Code u q))) -> Main (Code u r) | type t
-
-var :: String (ReadWrite (Code v q)) CODE -> CODE
-
-instance assign Code
-instance seq Code
-instance step` Code
-codeSteps :: [Step Code t] -> Code u p
-optBreak :: Mode -> Code u p
-
-instance setDelay Code
-instance mtask Code a | taskImp2 a & types a
-instance mtasks Code a b | taskImp2 a & types a & taskImp2 b & types b
-
-loopCode :: Int (Code a b) -> Code c d
-
-class taskImp2 a :: Int a -> ((Code Long p) a->Code MTask Expr, a) | /*long Code delay &*/ isExpr p
-instance taskImp2 ()
-instance taskImp2 (Code t p)
-instance taskImp2 (Code a p, Code b q)
-instance taskImp2 (Code a p, Code b q, Code c r)
-instance taskImp2 (Code a p, Code b q, Code c r, Code d s)
-
-class taskImp a :: Int a -> (Int a->Code MTask Expr, a)
-instance taskImp ()
-instance taskImp (Code t p)
-instance taskImp (Code a p, Code b q)
-instance taskImp (Code a p, Code b q, Code c r)
-instance taskImp (Code a p, Code b q, Code c r, Code d s)
-
-tasksMain :: Int Int ((a->Code MTask Expr,b->Code MTask Expr) -> In (a->Code c d,b->Code e f) (Main (Code g h))) -> Main (Code i j) | taskImp a & types a & taskImp b & types b
-class types a :: a
-instance types ()
-instance types (Code a p) | typeSelector a & isExpr p
-instance types (Code a p, Code b q) | typeSelector a & isExpr p & typeSelector b & isExpr q
-instance types (Code a p, Code b q, Code c r) | typeSelector a & isExpr p & typeSelector b & isExpr q & typeSelector c & isExpr r
-instance types (Code a p, Code b q, Code c r, Code d s) | typeSelector a & isExpr p & typeSelector b & isExpr q & typeSelector c & isExpr r & typeSelector d & isExpr s
-
-codeMTaskBody :: (Code v w) (Code c d) -> Code e f
-instance fun Code ()
-instance fun Code (Code t p) | type, showType t & isExpr p
-instance fun Code (Code a p, Code b q) | showType a & showType b
-instance fun Code (Code a p, Code b q, Code c r) | showType a & showType b & showType c
-instance output Code
-instance pinMode Code
-instance digitalIO Code
-instance dIO Code
-instance aIO Code
-instance analogIO Code
-instance noOp Code
-
-:: Code a p = C ((ReadWrite (Code a Expr)) CODE -> CODE)
-:: CODE =
- { fresh :: Int
- , freshMTask :: Int
- , funs :: [String]
- , ifuns :: Int
- , vars :: [String]
- , ivars :: Int
- , setup :: [String]
- , isetup :: Int
- , loop :: [String]
- , iloop :: Int
- , includes :: [String]
- , def :: Def
- , mode :: Mode
- , binds :: [String]
- }
-
-unC :: (Code a p) -> ((ReadWrite (Code a Expr)) CODE -> CODE)
-
-:: Def = Var | Fun | Setup | Loop
-:: Mode = /*MainMode |*/ NoReturn | Return String | SubExp | Assign String
-
-setMode :: Mode -> Code a p
-getMode :: (Mode -> Code a p) -> Code a p
-embed :: (Code a p) -> Code a p
-(+.+) infixl 5 :: (Code a p) (Code b q) -> Code c r
-fresh :: (Int -> (Code a p)) -> (Code a p)
-freshMTask :: (Int -> (Code a p)) -> (Code a p)
-setCode :: Def -> (Code a p)
-getCode :: (Def -> Code a p) -> (Code a p)
-brac :: (Code a p) -> Code b q
-funBody :: (Code a p) -> Code b q
-codeOp2 :: (Code a p) String (Code b q) -> Code c r
-include :: String -> Code a b
-argList :: [a] -> String | toCode a
-c :: a -> Code b p | toCode a
-indent :: Code a p
-unindent :: Code a p
-nl :: Code a p
-setBinds :: [String] -> Code a p
-addBinds :: String -> Code a p
-getBinds :: ([String] -> Code a p) -> (Code a p)
-
-// ----- driver ----- //
-
-compile :: (Main (Code a p)) -> [String]
-mkset :: [a] -> [a] | Eq a
-newCode :: CODE
-
-// ----- simulation ----- //
-
-eval :: (Main (Eval t p)) -> [String] | toString t
-:: State =
- { tasks :: [(Int, State->State)]
- , store :: [Dyn]
- , dpins :: [(DigitalPin, Bool)]
- , apins :: [(AnalogPin, Int)]
- , serial:: [String]
- , millis:: Int
- }
-
-state0 :: State
-
-//:: TaskSim :== (Int, State->State)
-:: Eval t p = E ((ReadWrite t) State -> (t, State))
-toS2S :: (Eval t p) -> (State->State)
-
-unEval :: (Eval t p) -> ((ReadWrite t) State -> (t, State))
-
-:: ReadWrite t = Rd | Wrt t | Updt (t->t)
-
-(>>==) infixl 1 :: (Eval a p) (a -> Eval b q) -> Eval b r
-//(>>== ) (E f) g = E \r s. let (a, s2) = f Rd s; (E h) = g a in h Rd s2
-
-rtrn :: t -> Eval t p
-
-yield :: t (Eval s p) -> Eval t Expr
-//yield a (E f) = E (\r s.(\(_,t).(a,t)) (f r s))
-
-instance arith Eval
-instance boolExpr Eval
-instance If Eval p q Expr
-instance IF Eval
-instance var2 Eval
-
-defEval2 :: t ((Eval t p)->Main (Eval u q)) -> (Main (Eval u q)) | dyn t
-instance sds Eval
-
-defEval :: ((Eval t p)->In t (Main (Eval u q))) -> (Main (Eval u q)) | dyn t
-instance fun Eval x | arg x
-instance mtask Eval x | arg x
-instance mtasks Eval x y | arg x & arg y
-instance setDelay Eval
-
-class toExpr v where toExpr :: (v t p) -> v t Expr
-instance toExpr Eval
-instance toExpr Code
-instance seq Eval
-instance assign Eval
-instance output Eval
-instance pinMode Eval
-instance digitalIO Eval
-instance analogIO Eval
-instance noOp Eval
-
-class arg x :: x -> Int
-instance arg ()
-instance arg (Eval t p) | type t
-instance arg (Eval t p, Eval u q) | type t & type u
-instance arg (Eval t p, Eval u q, Eval v r) | type t & type u & type v
-instance arg (Eval t p, Eval u q, Eval v r, Eval w s) | type t & type u & type v
-
-instance + String
-
-readPinA :: AnalogPin [(AnalogPin, Int)] -> Int
-writePinA :: AnalogPin Int State -> State
-
-class readPinD p :: p [(DigitalPin,Bool)] [(AnalogPin,Int)] -> Bool
-instance readPinD DigitalPin
-instance readPinD AnalogPin
-
-class writePinD p :: p Bool State -> State
-instance writePinD DigitalPin
-instance writePinD AnalogPin
-
-// ----- Interactive Simulation ----- //
-
-derive class iTask DigitalPin, AnalogPin, Dyn, StateInterface, DisplayVar, Pin
-
-simulate :: (Main (Eval a p)) -> Task ()
-toView :: State -> StateInterface
-mergeView :: State StateInterface -> State
-:: StateInterface =
- { serialOut :: Display [String]
- , analogPins :: [(AnalogPin, Int)]
- , digitalPins :: [(DigitalPin, Bool)]
- , var2iables :: [DisplayVar]
- , timer :: Int
- , taskCount :: Display Int
- }
-
-toDisplayVar :: Dyn -> DisplayVar
-fromDisplayVar :: DisplayVar Dyn -> Dyn
-:: DisplayVar
- = Variable String
- | INT Int
- | LONG Int
- | Servo Pin Int
- | LCD16x2 String String
- | DisplayVar [String]
-
-step` :: State -> State
-
-class stringQuotes t | type t :: (Code t p) -> Code t p
-instance stringQuotes String
-instance stringQuotes t
-
-derive toGenDynamic (), MTask, DigitalPin, AnalogPin, Pin, [], Long //, Servo
-derive fromGenDynamic (), MTask, DigitalPin, AnalogPin, Pin, [], Long //, Servo
-instance toCode ()
-instance == ()
+read` :: Int (ReadWrite a) State` -> (a,State`) | dyn a
// ----- long ----- //
:: Long = L Int // 32 bit on Arduino
-instance toCode Long
instance + Long
instance - Long
instance * Long
// ----- tools ----- //
-class toCode a :: a -> String
-instance toCode Bool
-instance toCode Int
-instance toCode Real
-instance toCode Char
-instance toCode String
-instance toCode DigitalPin
-instance toCode AnalogPin
derive consName DigitalPin, AnalogPin, PinMode
instance == DigitalPin
repositories / mTask.git / blobdiff