Commit bc7e99fb authored by Mart Lubbers's avatar Mart Lubbers
Browse files

fix peripheral and share duplication bug q&d

parent d1776967
Pipeline #56302 passed with stage
in 1 minute and 42 seconds
......@@ -29,6 +29,8 @@ from iTasks.Internal.SDS import
instance zero CompileOpts where zero = {tailcallopt=True,labelresolve=True,shorthands=True}
import StdDebug
compileOpts :: CompileOpts (Main (BCInterpret (TaskValue v))) -> (String255, [(? MTLens, Task BCShareSpec)], {BCPeripheral}, [BCInstr]) | type v
compileOpts opts task
# st = mainBC task zero
......@@ -41,10 +43,12 @@ compileOpts opts task
++ [BCLabel st.bcs_freshlabel:st.bcs_mainexpr]
++ [BCReturn (UInt8 1) (UInt8 0)]
# labelmap = makeLabelmap zero instr 'DM'.newMap
| not (trace_tn (toString (length st.bcs_hardware) +++ " peripherals: " +++ toSingleLineText (st.bcs_hardware))) = undef
| not (trace_tn (toString ('DM'.mapSize st.bcs_sdses) +++ " shares")) = undef
= //Return width
( String255 (createArray (2*(toByteWidth $ unpack $ unpack $ unpack task)) '\0')
//Shares
, map toShareSpec $ zip2 [0..] st.bcs_sdses
, map toShareSpec $ 'DM'.toList st.bcs_sdses
, {a\\a<-st.bcs_hardware}
//Bytecode
//Resolve labels
......
......@@ -23,6 +23,7 @@ MT_REMOVE :== UInt8 ((2^8) - 1)
tell` :: [BCInstr] -> BCInterpret a
setRate :: Bool (TimingInterval (StateT BCState (WriterT [BCInstr] Identity))) -> BCInterpret a
addMapIfNotExist :: k v (Map k v) -> Map k v | < k
:: BCState =
{ bcs_infun :: JumpLabel
......@@ -30,7 +31,7 @@ setRate :: Bool (TimingInterval (StateT BCState (WriterT [BCInstr] Identity))) -
, bcs_context :: [BCInstr]
, bcs_functions :: Map JumpLabel BCFunction
, bcs_freshlabel :: JumpLabel
, bcs_sdses :: [Either String255 MTLens]
, bcs_sdses :: Map Int (Either String255 MTLens)
, bcs_hardware :: [BCPeripheral]
}
:: MTLens :== SDSLens () String255 String255
......
......@@ -52,7 +52,7 @@ where
, bcs_context = []
, bcs_functions = 'DM'.newMap
, bcs_freshlabel = (JL one)
, bcs_sdses = []
, bcs_sdses = 'DM'.newMap
, bcs_hardware = []
}
......@@ -73,7 +73,7 @@ freshlabel = getState >>= \s=:{bcs_freshlabel=(JL i)}->
put {s & bcs_freshlabel=JL (i+one)} >>| pure (JL i)
freshsds :: BCInterpret Int
freshsds = gets \s->length s.bcs_sdses
freshsds = gets \s->'DM'.mapSize s.bcs_sdses
setRate :: Bool (TimingInterval (StateT BCState (WriterT [BCInstr] Identity))) -> BCInterpret a
setRate rl Default = pure undef
......@@ -151,7 +151,7 @@ instance sds (StateT BCState (WriterT [BCInstr] Identity))
where
sds def = {main = freshsds
>>= \sdsi->
let sds = modify (\s->{s & bcs_sdses=s.bcs_sdses ++ [Left $ String255 (toByteCode{|*|} t)]})
let sds = modify (addSdsIfNotExist sdsi (Left $ String255 (toByteCode{|*|} t)))
>>| pure (Sds sdsi)
(t In e) = def sds
in e.main
......@@ -189,7 +189,7 @@ instance liftsds (StateT BCState (WriterT [BCInstr] Identity))
where
liftsds def = {main = freshsds
>>= \sdsi->
let sds = modify (\s->{s & bcs_sdses=s.bcs_sdses ++ [Right $ lens t]})
let sds = modify (addSdsIfNotExist sdsi (Right $ lens t))
>>| pure (Sds sdsi)
(t In e) = def sds
in e.main
......@@ -201,6 +201,12 @@ where
, \w r-> ?Just <$> iTasksDecode (toString w)
) ?None
addSdsIfNotExist :: Int (Either String255 MTLens) BCState -> BCState
addSdsIfNotExist sdsid sds s = {s & bcs_sdses=addMapIfNotExist sdsid sds s.bcs_sdses}
addMapIfNotExist :: k v ('DM'.Map k v) -> 'DM'.Map k v | < k
addMapIfNotExist k v m = if ('DM'.member k m) m ('DM'.put k v m)
import StdDebug, Text.GenPrint
derive gPrint BCInstr, UInt8, UInt16, BCTaskType, JumpLabel, String255, PinMode, InterruptMode
......
......@@ -12,6 +12,7 @@ import Control.Monad
import Control.Monad.State
import Control.Monad.Writer
import Control.Applicative
import qualified Data.Map as DM
import Text => qualified join
......@@ -28,11 +29,18 @@ derive gCDeserialise BCPeripheral, DHTtype, DHTInfo, Pin, APin, DPin, LEDMatrixI
nextPeripheral st = length st.bcs_hardware
instance == BCPeripheral where (==) l r = l === r
addPerIfNotExist :: BCPeripheral -> BCInterpret Int
addPerIfNotExist per = getState
>>= \s=:{bcs_hardware}->case findIndex ((==)per) bcs_hardware of
?None = put {s & bcs_hardware=bcs_hardware ++ [per]} >>| pure (length bcs_hardware)
?Just i = pure i
instance dht (StateT BCState (WriterT [BCInstr] Identity)) where
DHT dhtinfo def = {main
= Dht <$> gets nextPeripheral
<* modify (\s->{s & bcs_hardware=s.bcs_hardware ++ [BCDHT dhtinfo]})
>>= unmain o def o pure
= addPerIfNotExist (BCDHT dhtinfo)
>>= \pid->unmain (def (pure (Dht pid)))
}
temperature` ti dht
= dht
......@@ -45,9 +53,8 @@ instance dht (StateT BCState (WriterT [BCInstr] Identity)) where
instance LEDMatrix (StateT BCState (WriterT [BCInstr] Identity)) where
ledmatrix i def = {main
= LEDMatrix <$> gets nextPeripheral
<* modify (\s->{s & bcs_hardware=s.bcs_hardware ++ [BCLEDMatrix i]})
>>= unmain o def o pure
= addPerIfNotExist (BCLEDMatrix i)
>>= \pid->unmain (def (pure (LEDMatrix pid)))
}
LMDot m x y s = m >>= \(LEDMatrix i)->x >>| y >>| s >>| tell` [BCMkTask $ BCLEDMatrixDot $ fromInt i]
LMIntensity m x = m >>= \(LEDMatrix i)->x >>| tell` [BCMkTask $ BCLEDMatrixIntensity $ fromInt i]
......@@ -56,9 +63,8 @@ instance LEDMatrix (StateT BCState (WriterT [BCInstr] Identity)) where
instance i2cbutton (StateT BCState (WriterT [BCInstr] Identity)) where
i2cbutton addr def = {main
= (\x->I2CButton x) <$> gets nextPeripheral
<* modify (\s->{s & bcs_hardware=s.bcs_hardware ++ [BCI2CButton addr]})
>>= unmain o def o pure
= addPerIfNotExist (BCI2CButton addr)
>>= \pid->unmain (def (pure (I2CButton pid)))
}
AButton` ti m
= m
......@@ -72,9 +78,8 @@ instance i2cbutton (StateT BCState (WriterT [BCInstr] Identity)) where
instance LightSensor (StateT BCState (WriterT [BCInstr] Identity))
where
lightsensor addr def = {main
= LightSensor <$> gets nextPeripheral
<* modify (\s -> {s & bcs_hardware=s.bcs_hardware ++ [BCLightSensor addr]})
>>= unmain o def o pure
= addPerIfNotExist (BCLightSensor addr)
>>= \pid->unmain (def (pure (LightSensor pid)))
}
light` ti ls
= ls
......@@ -84,9 +89,8 @@ where
instance AirQualitySensor (StateT BCState (WriterT [BCInstr] Identity))
where
airqualitysensor addr def = {main
= AirQualitySensor <$> gets nextPeripheral
<* modify (\s -> {s & bcs_hardware=s.bcs_hardware ++ [BCAirQualitySensor addr]})
>>= unmain o def o pure
= addPerIfNotExist (BCAirQualitySensor addr)
>>= \pid->unmain (def (pure (AirQualitySensor pid)))
}
setEnvironmentalData aqs humid temp = humid >>| temp >>| aqs >>= \(AirQualitySensor i)->tell` [BCMkTask (BCSetEnvironmentalData (fromInt i))]
tvoc` i aqs
......@@ -101,9 +105,8 @@ where
instance GestureSensor (StateT BCState (WriterT [BCInstr] Identity))
where
gestureSensor addr def = {main
= GestureSensor <$> gets nextPeripheral
<* modify (\s -> {s & bcs_hardware=s.bcs_hardware ++ [BCGestureSensor addr]})
>>= unmain o def o pure
= addPerIfNotExist (BCGestureSensor addr)
>>= \pid->unmain (def (pure (GestureSensor pid)))
}
gesture` i ges
= ges
......
definition module mTask.Interpret.Peripherals.DHT
from Data.UInt import :: UInt8
import mTask.Interpret.DSL
import mTask.Language
instance dht (StateT BCState (WriterT [BCInstr] Identity))
implementation module mTask.Interpret.Peripherals.DHT
import StdEnv
import Data.Func
import Data.List
import Data.Functor
import Data.Functor.Identity
import Data.Monoid
import Control.Monad
import Control.Monad.State
import Control.Monad.Writer
import Control.Applicative
import mTask.Interpret.DSL
import Data.UInt
import mTask.Language
instance dht (StateT BCState (WriterT [BCInstr] Identity))
where
DHT pin type def = {main
= gets nextDHT
<* modify (\s->{s & bcs_hardware=s.bcs_hardware ++ [BCDHT pin type]})
>>= unmain o def o pure
}
temperature` ti dht
= dht
>>= \(Dht i)->tell` [BCMkTask $ BCDHTTemp $ fromInt i]
>>| setRate True ti
humidity` ti dht
= dht
>>= \(Dht i)->tell` [BCMkTask $ BCDHTTemp $ fromInt i]
>>| setRate True ti
nextDHT :: BCState -> DHT
nextDHT st=:{bcs_hardware=p} = Dht $ fromInt $ length [()\\(BCDHT _)<-p]
......@@ -6,4 +6,4 @@ instance toString InterruptMode where
toString mode = toSingleLineText mode
derive class iTask InterruptMode
derive gDefault InterruptMode
\ No newline at end of file
derive gDefault InterruptMode
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment