BCValue is existential now
authorMart Lubbers <mart@martlubbers.net>
Mon, 13 Mar 2017 12:01:32 +0000 (13:01 +0100)
committerMart Lubbers <mart@martlubbers.net>
Mon, 13 Mar 2017 12:01:32 +0000 (13:01 +0100)
13 files changed:
Shares/mTaskShare.dcl
Shares/mTaskShare.icl
Tasks/mTaskTask.dcl
Tasks/mTaskTask.icl
Utils/SDS.dcl
Utils/SDS.icl
mTask.dcl
mTask.icl
mTaskCode.icl
mTaskInterpret.dcl
mTaskInterpret.icl
mTaskSimulation.dcl
mTaskSimulation.icl

index a6967af..df4a2f1 100644 (file)
@@ -4,12 +4,21 @@ import iTasks
 import iTasks._Framework.Serialization
 
 derive class iTask MTaskShareType
 import iTasks._Framework.Serialization
 
 derive class iTask MTaskShareType
+
+derive gEditor MTaskShare
+derive gText MTaskShare
+derive JSONEncode MTaskShare
+derive JSONDecode MTaskShare
+derive gDefault MTaskShare
+derive gEq MTaskShare
+
 :: MTaskShareType = MTaskWithShare String | MTaskLens String
 :: MTaskShare =
                {withTask :: String
                ,identifier :: Int
                ,realShare :: MTaskShareType
                ,value :: String
 :: MTaskShareType = MTaskWithShare String | MTaskLens String
 :: MTaskShare =
                {withTask :: String
                ,identifier :: Int
                ,realShare :: MTaskShareType
                ,value :: String
+               ,dynvalue :: Dynamic
                }
 
 manageShares :: [MTaskShare] -> Task ()
                }
 
 manageShares :: [MTaskShare] -> Task ()
index 8eb7dc0..7f9a2f4 100644 (file)
@@ -8,6 +8,14 @@ import mTask
 from Data.Func import $
 
 derive class iTask MTaskShareType
 from Data.Func import $
 
 derive class iTask MTaskShareType
+
+derive gEditor MTaskShare
+derive gText MTaskShare
+derive JSONEncode MTaskShare
+derive JSONDecode MTaskShare
+derive gDefault MTaskShare
+gEq{|MTaskShare|} m1 m2 = m1.identifier == m2.identifier
+
 manageShares :: [MTaskShare] -> Task ()
 manageShares shares =
        forever (enterChoice "Choose share to update" [ChooseFromGrid id] shares
 manageShares :: [MTaskShare] -> Task ()
 manageShares shares =
        forever (enterChoice "Choose share to update" [ChooseFromGrid id] shares
@@ -45,5 +53,6 @@ makeShare withTask identifier value = treturn
                |withTask=withTask
                ,identifier=identifier
                ,value=value
                |withTask=withTask
                ,identifier=identifier
                ,value=value
+               ,dynvalue=dynamic value
                ,realShare=MTaskWithShare $ "mTaskSDS-" +++ toString identifier
                } >>= \sh->set value (getSDSShare sh) >>| treturn sh
                ,realShare=MTaskWithShare $ "mTaskSDS-" +++ toString identifier
                } >>= \sh->set value (getSDSShare sh) >>| treturn sh
index b27bb73..19a3db0 100644 (file)
@@ -4,7 +4,7 @@ import Devices.mTaskDevice
 import mTask
 import iTasks
 
 import mTask
 import iTasks
 
-derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState, UserLED, RWST
+derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState, RWST
 
 :: MTaskTask = {
                name :: String,
 
 :: MTaskTask = {
                name :: String,
index 9cc5a98..1cd45f8 100644 (file)
@@ -5,7 +5,7 @@ import iTasks
 
 import iTasks._Framework.Serialization
 
 
 import iTasks._Framework.Serialization
 
-derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState, UserLED, RWST, Identity
+derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState, RWST, Identity
 
 makeTask :: String Int -> Task MTaskTask
 makeTask name ident = get currentDateTime 
 
 makeTask :: String Int -> Task MTaskTask
 makeTask name ident = get currentDateTime 
index 47e6647..785af5d 100644 (file)
@@ -4,8 +4,6 @@ import Shares.mTaskShare
 import Devices.mTaskDevice
 import iTasks
 
 import Devices.mTaskDevice
 import iTasks
 
-derive class iTask MTaskShare
-
 memoryShare :: String a -> Shared a | iTask a
 
 deviceStore :: Shared [MTaskDevice]
 memoryShare :: String a -> Shared a | iTask a
 
 deviceStore :: Shared [MTaskDevice]
index 9c6b46a..920c7a6 100644 (file)
@@ -8,8 +8,6 @@ import Tasks.Examples
 import qualified Data.Map as DM
 from Data.Func import $
 
 import qualified Data.Map as DM
 from Data.Func import $
 
-derive class iTask MTaskShare
-
 memoryShare :: String a -> Shared a | iTask a
 memoryShare s d = sdsFocus s $ memoryStore "" $ Just d
 
 memoryShare :: String a -> Shared a | iTask a
 memoryShare s d = sdsFocus s $ memoryStore "" $ Just d
 
index 9b82478..b1510af 100644 (file)
--- a/mTask.dcl
+++ b/mTask.dcl
@@ -14,10 +14,6 @@ todo:
        imporove setp: >>*.
 */
 
        imporove setp: >>*.
 */
 
-import GenPrint
-import Generics.gCons
-import Generics.gdynamic
-
 //import iTasks
 //
 //import iTasks._Framework.Generic
 //import iTasks
 //
 //import iTasks._Framework.Generic
@@ -26,6 +22,7 @@ import StdClass
 import GenEq, StdMisc, StdArray
 
 import mTaskCode, mTaskSimulation, mTaskInterpret
 import GenEq, StdMisc, StdArray
 
 import mTaskCode, mTaskSimulation, mTaskInterpret
+//import mTaskCode, mTaskInterpret
 import mTaskSerial, mTaskLCD
 
 // =================== mTask ===================
 import mTaskSerial, mTaskLCD
 
 // =================== mTask ===================
@@ -66,7 +63,7 @@ instance == MTask
 unMain :: (Main x) -> x
 
 class arith v where
 unMain :: (Main x) -> x
 
 class arith v where
-  lit :: t -> v t Expr | toCode t & toByteCode t
+  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 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
@@ -214,9 +211,6 @@ instance long Eval Long
 
 // ----- tools ----- //
 
 
 // ----- tools ----- //
 
-derive gPrint Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
-derive class gCons Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
-
 instance == DigitalPin
 instance == AnalogPin
 instance == UserLED
 instance == DigitalPin
 instance == AnalogPin
 instance == UserLED
index b92b1fc..2bbcc30 100644 (file)
--- a/mTask.icl
+++ b/mTask.icl
@@ -123,9 +123,8 @@ instance == DigitalPin where (==) x y = x === y
 instance == AnalogPin   where (==) x y = x === y
 instance == UserLED where (==) x y = x === y
 
 instance == AnalogPin   where (==) x y = x === y
 instance == UserLED where (==) x y = x === y
 
-derive gEq UserLED
-derive gPrint Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
-derive class gCons Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
+//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
 
 tab =: toString (repeatn tabSize ' ')
 tabSize :== 2
index 7ac8aa6..cca5a67 100644 (file)
@@ -2,8 +2,9 @@ implementation module mTaskCode
 
 import Generics.gdynamic
 import Generics.gCons
 
 import Generics.gdynamic
 import Generics.gCons
+import StdEnv
 
 
-import iTasks
+//import iTasks
 import GenEq, StdMisc, StdArray
 import mTask
 
 import GenEq, StdMisc, StdArray
 import mTask
 
index 999d734..d104b02 100644 (file)
@@ -1,10 +1,14 @@
 definition module mTaskInterpret
 
 definition module mTaskInterpret
 
+import mTask
+
 from Data.Functor.Identity import :: Identity
 from Control.Monad.State import :: State, :: StateT
 from Control.Monad.RWST import :: RWST, :: RWS
 from Data.Either import :: Either
 from Data.Functor.Identity import :: Identity
 from Control.Monad.State import :: State, :: StateT
 from Control.Monad.RWST import :: RWST, :: RWS
 from Data.Either import :: Either
-import mTask
+from iTasks._Framework.Generic.Defaults import generic gDefault
+from GenPrint import generic gPrint
+from Generics.gCons import class gCons, generic conses, generic consName, generic consIndex, generic consNum
 
 :: MTaskMSGRecv
        = MTTaskAck Int
 
 :: MTaskMSGRecv
        = MTTaskAck Int
@@ -26,6 +30,8 @@ import mTask
        | OnInterval Int
        | OnInterrupt Int
 
        | OnInterval Int
        | OnInterrupt Int
 
+:: BCValue = E.e: BCValue e & mTaskType e
+
 instance toString MTaskInterval
 instance toString MTaskMSGRecv
 instance toString MTaskMSGSend
 instance toString MTaskInterval
 instance toString MTaskMSGRecv
 instance toString MTaskMSGSend
@@ -35,8 +41,8 @@ decode :: String -> MTaskMSGRecv
 :: BC
        = BCNop
        | BCLab Int
 :: BC
        = BCNop
        | BCLab Int
-//     | E.e: BCPush e & toByteCode e
-       | BCPush String
+       | BCPush BCValue
+//     | BCPush String
        | BCPop
        //SDS functions
        | BCSdsStore Int
        | BCPop
        //SDS functions
        | BCSdsStore Int
@@ -78,7 +84,20 @@ decode :: String -> MTaskMSGRecv
        | BCDigitalWrite Pin
        | BCTest AnalogPin
 
        | BCDigitalWrite Pin
        | BCTest AnalogPin
 
-derive class gCons BC
+derive gPrint BCValue
+derive consIndex BCValue
+derive consName BCValue
+derive conses BCValue
+derive consNum BCValue
+
+derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin
+derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode
+derive gEditor BCValue
+derive gText BCValue
+derive JSONEncode BCValue
+derive JSONDecode BCValue
+derive gDefault BCValue
+derive gEq BCValue
 
 :: ByteCode a p = BC (RWS () [BC] BCState ())
 
 
 :: ByteCode a p = BC (RWS () [BC] BCState ())
 
@@ -98,9 +117,9 @@ instance zero BCState
 
 class toByteCode a :: a -> String
 class fromByteCode a :: String -> a
 
 class toByteCode a :: a -> String
 class fromByteCode a :: String -> a
-class mTaskType a | toByteCode, fromByteCode, TC a
+class mTaskType a | toByteCode, fromByteCode, iTask, TC a
 
 
-instance toByteCode Int, Bool, Char, Long, String, Button, UserLED
+instance toByteCode Int, Bool, Char, Long, String, Button, UserLED, BCValue
 instance fromByteCode Int, Bool, Char, Long, String, Button, UserLED
 instance toByteCode MTaskInterval
 instance fromByteCode MTaskInterval
 instance fromByteCode Int, Bool, Char, Long, String, Button, UserLED
 instance toByteCode MTaskInterval
 instance fromByteCode MTaskInterval
index 71555a5..c6a3e53 100644 (file)
@@ -19,7 +19,7 @@ import Data.Monoid
 import Data.Functor
 import StdList
 from Data.Func import $
 import Data.Functor
 import StdList
 from Data.Func import $
-from Text import class Text(lpad,concat,toUpperCase), instance Text String
+from Text import class Text(subString,lpad,concat,toUpperCase), instance Text String
 import qualified Text
 import Text.JSON
 
 import qualified Text
 import Text.JSON
 
@@ -91,7 +91,7 @@ instance toString MTaskMSGRecv where
 toByteVal :: BC -> String
 toByteVal b = {toChar $ consIndex{|*|} b} +++
        case b of
 toByteVal :: BC -> String
 toByteVal b = {toChar $ consIndex{|*|} b} +++
        case b of
-               (BCPush i) = i
+               (BCPush i) = toByteCode i
                (BCLab i) = {toChar i}
                (BCSdsStore i) = to16bit i
                (BCSdsFetch i) = to16bit i
                (BCLab i) = {toChar i}
                (BCSdsStore i) = to16bit i
                (BCSdsFetch i) = to16bit i
@@ -105,6 +105,7 @@ toByteVal b = {toChar $ consIndex{|*|} b} +++
                (BCJmpF i) = {toChar i}
                _ = ""
 
                (BCJmpF i) = {toChar i}
                _ = ""
 
+instance toByteCode BCValue where toByteCode (BCValue v) = toByteCode v
 instance toByteCode Bool where toByteCode b = toByteCode $ if b 1 0
 instance toByteCode Int where toByteCode n = {toChar $ n/256,toChar $ n rem 256}
 instance toByteCode Long where toByteCode (L n) = toByteCode n
 instance toByteCode Bool where toByteCode b = toByteCode $ if b 1 0
 instance toByteCode Int where toByteCode n = {toChar $ n/256,toChar $ n rem 256}
 instance toByteCode Long where toByteCode (L n) = toByteCode n
@@ -119,6 +120,10 @@ instance toByteCode MTaskInterval where
        //Intervals have the first bit 1 and the rest is a 15 bit unsigned int
        toByteCode (OnInterrupt i) = {toChar $ i/256 bitor 127, toChar $ i rem 256}
 
        //Intervals have the first bit 1 and the rest is a 15 bit unsigned int
        toByteCode (OnInterrupt i) = {toChar $ i/256 bitor 127, toChar $ i rem 256}
 
+//parseByteCode :: String -> BCValue
+//parseByteCode "b" = BCValue True
+//parseByteCode "i" = BCValue 0
+
 instance fromByteCode Bool where fromByteCode s = fromByteCode s == 1
 instance fromByteCode Int where fromByteCode s = (toInt s.[0])*256 + toInt s.[1]
 instance fromByteCode Long where fromByteCode s = L $ fromByteCode s
 instance fromByteCode Bool where fromByteCode s = fromByteCode s == 1
 instance fromByteCode Int where fromByteCode s = (toInt s.[0])*256 + toInt s.[1]
 instance fromByteCode Long where fromByteCode s = L $ fromByteCode s
@@ -126,6 +131,19 @@ instance fromByteCode Char where fromByteCode s = fromInt $ fromByteCode s
 instance fromByteCode String where fromByteCode s = abort $ "Undef on fromBytecode String" +++ s
 instance fromByteCode Button where fromByteCode s = conses{|*|} !! fromByteCode s
 instance fromByteCode UserLED where fromByteCode s = conses{|*|} !! fromByteCode s
 instance fromByteCode String where fromByteCode s = abort $ "Undef on fromBytecode String" +++ s
 instance fromByteCode Button where fromByteCode s = conses{|*|} !! fromByteCode s
 instance fromByteCode UserLED where fromByteCode s = conses{|*|} !! fromByteCode s
+instance fromByteCode BCValue
+       where
+               fromByteCode s = let tail = subString 1 (size s) s in case s.[0] of
+                       'b' = BCValue $ castfbc True tail
+                       'i' = BCValue $ castfbc 0 tail
+                       'l' = BCValue $ castfbc (L 0) tail
+                       'c' = BCValue $ castfbc ('0') tail
+                       'B' = BCValue $ castfbc (NoButton) tail
+                       'L' = BCValue $ castfbc (LED1) tail
+               where
+                       castfbc :: a -> (String -> a) | mTaskType a
+                       castfbc _ = fromByteCode
+               
 instance fromByteCode MTaskInterval
        where
                fromByteCode s
 instance fromByteCode MTaskInterval
        where
                fromByteCode s
@@ -139,9 +157,29 @@ instance toChar Pin where
        toChar (Digital p) = toChar $ consIndex{|*|} p
        toChar (Analog p) = toChar $ consIndex{|*|} p
 
        toChar (Digital p) = toChar $ consIndex{|*|} p
        toChar (Analog p) = toChar $ consIndex{|*|} p
 
-derive gPrint BC
+derive gPrint Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin, BC
 derive class gCons BC
 
 derive class gCons BC
 
+consIndex{|BCValue|} _ = 0
+consName{|BCValue|} _ = "BCValue"
+conses{|BCValue|} = [BCValue 0]
+consNum{|BCValue|} _ = 1
+gPrint{|BCValue|} v ps = gPrint{|*|} (readable $ BCPush v) ps
+
+gEditor{|BCValue|} = undef
+gText{|BCValue|} fm Nothing = []
+gText{|BCValue|} fm (Just (BCValue e)) = gText{|*|} fm (Just e)
+JSONEncode{|BCValue|} b (BCValue e) = JSONEncode{|*|} b (toByteCode e)
+JSONDecode{|BCValue|} b n = appFst (fmap fromByteCode) $ JSS b n
+       where
+               JSS :: (Bool [JSONNode] -> (Maybe String, [JSONNode]))
+               JSS = JSONDecode{|*|}
+gDefault{|BCValue|} = BCValue 0
+gEq{|BCValue|} (BCValue e) (BCValue f) = False
+
+derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin
+derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode
+
 op2 :: (ByteCode a p1) (ByteCode a p2) BC -> ByteCode b Expr
 op2 (BC x) (BC y) bc = BC $ x >>| y >>| tell [bc]
 
 op2 :: (ByteCode a p1) (ByteCode a p2) BC -> ByteCode b Expr
 op2 (BC x) (BC y) bc = BC $ x >>| y >>| tell [bc]
 
@@ -150,10 +188,8 @@ op (BC x) bc = BC $ x >>| tell [bc]
 
 tell` x = BC $ tell x
 
 
 tell` x = BC $ tell x
 
-instance zero Bool where zero = False
-
 instance arith ByteCode where
 instance arith ByteCode where
-       lit x = tell` [BCPush $ toByteCode x]
+       lit x = tell` [BCPush $ BCValue x]
        (+.) x y = op2 x y BCAdd
        (-.) x y = op2 x y BCSub
        (*.) x y = op2 x y BCMul
        (+.) x y = op2 x y BCAdd
        (-.) x y = op2 x y BCSub
        (*.) x y = op2 x y BCMul
@@ -252,7 +288,7 @@ implGotos _ i = i
 
 import StdDebug
 bclength :: BC -> Int
 
 import StdDebug
 bclength :: BC -> Int
-bclength (BCPush s) = 1 + size s
+bclength (BCPush s) = 1 + size (toByteCode s)
 bclength (BCSdsStore _) = 3
 bclength (BCSdsFetch _) = 3
 bclength (BCSdsPublish _) = 3
 bclength (BCSdsStore _) = 3
 bclength (BCSdsFetch _) = 3
 bclength (BCSdsPublish _) = 3
@@ -264,7 +300,7 @@ computeGotos [BCLab l:xs] i = appSnd ('DM'.put l i) (computeGotos xs i)
 computeGotos [x:xs] i = appFst (\bc->[x:bc]) (computeGotos xs $ i + bclength x)
 
 readable :: BC -> String
 computeGotos [x:xs] i = appFst (\bc->[x:bc]) (computeGotos xs $ i + bclength x)
 
 readable :: BC -> String
-readable (BCPush d) = "BCPush " +++ concat [safe c\\c<-:d]
+readable (BCPush d) = "BCPush " +++ concat [safe c\\c<-:toByteCode d]
        where
                safe c = if (isControl c) ("\\d" +++ toString (toInt c)) (toString c)
 readable b = printToString b
        where
                safe c = if (isControl c) ("\\d" +++ toString (toInt c)) (toString c)
 readable b = printToString b
@@ -308,3 +344,5 @@ to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))
 
 from16bit :: String -> Int
 from16bit s = toInt s.[0] * 256 + toInt s.[1]
 
 from16bit :: String -> Int
 from16bit s = toInt s.[0] * 256 + toInt s.[1]
+
+//derive class gCons UserLED, Long, Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode
index ed86068..b3870cf 100644 (file)
@@ -1,8 +1,12 @@
 definition module mTaskSimulation
 
 definition module mTaskSimulation
 
-from iTasks.API.Core.Types import class iTask, :: Task, generic gEditor, generic gText, generic JSONEncode, generic JSONDecode, generic gDefault, :: Editor, :: TextFormat, :: JSONNode
 import mTask
 
 import mTask
 
+from Generics.gdynamic import :: Dyn, class dyn, generic toGenDynamic, generic fromGenDynamic
+from GenPrint import class PrintOutput, :: PrintState
+from Data.Maybe import :: Maybe
+from iTasks import class iTask, generic gEditor, generic gDefault, generic gText, generic JSONEncode, generic JSONDecode, :: Task, :: Editor, :: JSONNode, :: TextFormat
+
 :: Display a = Display a
 
 derive class iTask Display
 :: Display a = Display a
 
 derive class iTask Display
@@ -81,8 +85,6 @@ instance writePinD AnalogPin
 
 // ----- Interactive Simulation ----- //
 
 
 // ----- Interactive Simulation ----- //
 
-derive class iTask DigitalPin, AnalogPin, Dyn, StateInterface, DisplayVar, Pin
-
 simulate :: (Main (Eval a p)) -> Task ()
 toView :: State` -> StateInterface
 mergeView :: State` StateInterface -> State`
 simulate :: (Main (Eval a p)) -> Task ()
 toView :: State` -> StateInterface
 mergeView :: State` StateInterface -> State`
index f4835be..801235e 100644 (file)
@@ -155,7 +155,7 @@ instance writePinD AnalogPin where
 
 // ----- Interactive Simulation ----- //
 
 
 // ----- Interactive Simulation ----- //
 
-derive class iTask DigitalPin, AnalogPin, Dyn, StateInterface, DisplayVar, Pin
+derive class iTask StateInterface, DisplayVar
 
 simulate :: (Main (Eval a p)) -> Task ()
 simulate {main=(E f)} = setup zero where
 
 simulate :: (Main (Eval a p)) -> Task ()
 simulate {main=(E f)} = setup zero where