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

nitrile and fix some imports

parent 66e3f085
......@@ -14,3 +14,4 @@ Clean System Files
*.o
mtask-server
nitrile-packages
[submodule "dependencies/CleanSerial"]
path = dependencies/CleanSerial
url = https://gitlab.science.ru.nl/mlubbers/CleanSerial
[submodule "dependencies/gentype"]
path = dependencies/gentype
url = https://gitlab.science.ru.nl/mlubbers/gentype
[submodule "dependencies/MQTTClient"]
path = dependencies/MQTTClient
url = https://gitlab.science.ru.nl/mtask/mqttclient.git
Copyright (c) 2022 Mart Lubbers.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
CFLAGS+=-Wall -Wextra -Werror
all: convert_real_to_float_in_int.o
install: convert_real_to_float_in_int.o
mkdir -p ../lib/mTask/mTask/Interpret/Clean\ System\ Files
cp $< ../lib/mTask/mTask/Interpret/Clean\ System\ Files/
Subproject commit b2a59c3c8842278534aeb084465292caf072799b
Subproject commit fa30898465f2e1376a1cd0326e9b0a77a0daae94
Subproject commit b801ec9582f222f212de31cb22ae8d1a7005f6e2
definition module mTask.Interpret.Device.Simulator
/**
* Communication specification for the iTask mTask RTS simulator.
*
* This is deprecated
*/
import iTasks
from mTask.Interpret.Compile import :: BCShareSpec
import mTask.Interpret.Device
import mTask.Interpret.Device.Simulator.Energy
import mTask.Interpret.Device.Simulator.Interpret
import mTask.Interpret.Device.Simulator.Rewrite
import mTask.Interpret.Device.Simulator.Stack
import mTask.Interpret.Device.Simulator.State
import mTask.Interpret.Instructions
import Data.UInt
:: SimChannels sds :== sds () Channels Channels
/**
* Settings that are passed to the Interpreter
*/
:: SimSettings =
{ sim_spec :: !MTDeviceSpec //* The Device Spec
, humidities :: ![(UInt8, UInt16)] //* Environment humidity
, temps :: ![(UInt8, UInt16)] //* Environment humidity
, d_vals :: ![(UInt8, DigitalPeripheral)] //* List of Digital pins, with their values
, a_vals :: ![(UInt8, AnaloguePeripheral)] //* List of Analoge pins, with their values
, timeStep :: !Int //* Amount of time that elapses every loop
}
instance zero SimSettings
derive class iTask SimSettings
/**
* The main loop of the simulator as in client.c
*/
loop :: !SimSettings !(SimChannels sds) !(Shared sds` BCSimState) -> Task BCSimState | RWShared sds & RWShared sds`
implementation module mTask.Interpret.Device.Simulator
import iTasks
import Data.Tuple
import Data.List
from StdFunctions import flip, o
from StdTuple import uncurry
from mTask.Interpret.Compile import :: BCShareSpec
from mTask.Interpret.Instructions import :: BCInstr
from iTasks.Extensions.DateTime import waitForTimer
import mTask.Interpret.ByteCodeEncoding
import mTask.Interpret.Device
import mTask.Interpret.Device.Simulator.Energy
import mTask.Interpret.Device.Simulator.Interface
import mTask.Interpret.Device.Simulator.Interpret
import mTask.Interpret.Device.Simulator.Rewrite
import mTask.Interpret.Device.Simulator.Stack
import mTask.Interpret.Device.Simulator.State
import mTask.Interpret.Device.Simulator.Symbols
import mTask.Interpret.Instructions
import mTask.Interpret.Message
import Data.UInt
import mTask.Interpret.Device.Simulator.Mem
import StdOverloaded
import StdDebug
from StdMisc import abort
instance zero SimSettings
where
zero = { SimSettings
| sim_spec = { zero
& aPins = zero
, dPins = zero
, memory = UInt16 50
}
, humidities = []
, temps = []
, d_vals = []
, a_vals = []
, timeStep = 1000 // 1 second
}
derive class iTask SimSettings
to16Int :: !Char !Char -> UInt16
to16Int h l = UInt16 (((toInt h) << 16) + toInt l)
to32Int :: !UInt16 !UInt16 -> Int
to32Int h l = ((toInt h) << 16) + toInt l
loop :: !SimSettings !(SimChannels sds) !(Shared sds` BCSimState) -> Task BCSimState | RWShared sds & RWShared sds`
loop settings=:{timeStep} channels stateShare = forever (
waitForTimer False 1 <<@ NoUserInterface
>?| get stateShare
>>? \s -> return {s & sp = zero, stack = map (const zero) s.stack}
>>? trace_n "Handling Messages" handleMessages settings channels
// Garbage collect
>>? \s -> return (memGC s)
>>? memTaskHead
>>? trace_n "Handling Tasks:" handleTasks stateShare channels
// Time and Energy
>>? \s -> return {s & time = s.time + timeStep}
>>? \s ->
let ns = addCurrentEnergy timeStep s in
set ns stateShare
)
memTaskHead :: !BCSimState -> Task BCSimState
memTaskHead s=:{tasks=[]} = return {s & current_task = BCMT_NULL}
memTaskHead s = return {s & current_task = zero}
memTaskNext :: !BCSimState -> Task BCSimState
memTaskNext s=:{tasks, current_task}
| trace_n "Simulator.memTaskNext" toInt (inc current_task) >= length tasks = return {s & current_task = BCMT_NULL}
| otherwise = return {s & current_task = inc current_task}
handleTasks :: !(Shared sds` BCSimState) !(SimChannels sds) !BCSimState -> Task BCSimState | RWShared sds & RWShared sds`
// TODO: Replace with BCMT_NULL
handleTasks sShare _ s=:{current_task = UInt16 65535} = return s
handleTasks sShare chShare s=:{current_task, tasks} =
handleTask sShare chShare (tasks!!(toInt current_task)) s
>>? memTaskNext
where
// TODO type
// handleTask :: !(Shared sds BCSimState) !(SimChannels sds`) !MTTask !BCSimState -> Task BCSimState | RWShared sds & RWShared sds`
// TODO: BCMT_NULL
handleTask sShare _ t=:{tree = UInt16 65535} s
#! s = trace "Handling Task (NULL) " trace_n t.MTTask.id {s & sp = zero, pc = zero} >>> initStackMain
#! t = s.tasks!!(toInt current_task)
= interpret t.bc s >>? \s=:{stack} = updateCurrentTask {t & tree = stack!$0} s >>> return
// TODO: BCMT_REMOVE
handleTask sShare _ t=:{tree = UInt16 255} s = abort "Huh, this should've been garbage collected\n"
handleTask sShare chShare t=:{tree, bc, sds} s =
trace "Handling Task (NotNULL) " trace_n t.MTTask.id rewrite sShare tree bc sds s
>>? \(sds, s=:{stack}) =
let t` = {t & sds = sds} in
let t`` = if ((stack !$ 0) == BCMT_STABLE) {t` & tree = BCMT_REMOVE} t` in
taskComplete (take (t``.returnwidth + 1) stack) t`` chShare s
>>? return o updateCurrentTask t``
updateCurrentTask :: !MTTask !BCSimState -> BCSimState
updateCurrentTask t s=:{current_task, tasks} = trace_n "Simulator.updateCurrentTask" {s & tasks = updateAt (toInt current_task) t tasks}
/**
* Folds over the messages, parses and then performs actions based on the Message
*
* @param The Simulator Settings, includes the memory and sensors/actuators
* @param The Shared Channels with which to communicate
* @param The State of the Simulator
*
* @result And updated state
*/
handleMessages :: !SimSettings !(SimChannels sds) !BCSimState -> Task BCSimState | RWShared sds
handleMessages settings chShare state =
trace_n "Handling Messages" get chShare
>>? \ch=:(outq, inq, stop) -> foldT evalToMessage (settings, ch, state) inq
>>? \(_, ch, s) -> set ch chShare
>?| return s
where
foldT :: !((SimSettings, Channels, BCSimState) -> MTMessageTo -> Task (SimSettings, Channels, BCSimState)) !(SimSettings, Channels, BCSimState) ![MTMessageTo] -> Task (SimSettings, Channels, BCSimState)
foldT _ (set, (outq, _, stop), st) [] = return (set, (outq, [], stop), st)
foldT f (set, (outq, _, stop), st) inq=:[x:xs] = f (set, (outq, inq, stop), st) x >>? flip (foldT f) xs
evalToMessage :: !(SimSettings, Channels, BCSimState) !MTMessageTo -> Task (SimSettings, Channels, BCSimState)
//TODO: MTTTask now also has a list of perpherals
evalToMessage (set, (outq, inq, stop), state=:{tasks}) (MTTTask d) = trace_n "Recieved Task" buildTask d.mtttd_taskid d.mtttd_returnwidth d.mtttd_shares d.mtttd_instructions >>? \t = return (set, ([MTFTaskAck d.mtttd_taskid : outq], inq, stop), {state & tasks = [t : tasks]})
evalToMessage (set, (outq, inq, stop), state) (MTTTaskPrep id) = trace_n "Handling MTTTaskPrep" return (set, ([MTFTaskPrepAck id : outq], inq, stop), state)
evalToMessage state (MTTTaskDel tid) = trace_n "Handling MTTaskDel" return state
evalToMessage (set, (outq, inq, stop), st) MTTSpecRequest = trace_n "Handling MTSpecRequest" return (set, (outq ++ [MTFSpec set.sim_spec], inq, stop), st) // Add MTFSpec message to end of queue
evalToMessage state MTTShutdown = trace_n "Handling MTShutdown" return state
//* taskid sdsid value
// MTTSdsUpdate UInt8 UInt8 String255
evalToMessage state (MTTSdsUpdate tid sid val) = trace_n "Handling MTTSdsUpdate" return state
buildTask :: !UInt8 !UInt8 ![BCShareSpec] ![BCInstr] -> Task MTTask
buildTask id width shares instr = enterMultipleChoice [ChooseFromCheckGroup snd] (zip2 [0 ..] instr) <<@ Title "Select breakpoints" >>? \bps -> return
{MTTask |
id = id
,stability = BCMT_NOVALUE
,returnwidth = toInt width
,returnvalue = repeatn (toInt width) zero
,bc = toInstr 0 instr (map fst bps)
,sds = shares
,tree = BCMT_NULL
}
where
toInstr :: Int [BCInstr] [Int] -> [(Bool, BCInstr)]
toInstr _ is [] = map (\i -> (False, i)) is
toInstr n [i:is] [b:bs]
| n == b = [(True, i) : toInstr (inc n) is bs]
| otherwise = [(False, i) : toInstr (inc n) is [b:bs]]
definition module mTask.Interpret.Device.Simulator.Energy
import Data.UInt
import mTask.Interpret.Device.Simulator.State
import iTasks
// To allow the user to pick the type of peripherals
:: DigitalPeripheral = Led LedState | Button ButtonState
:: AnaloguePeripheral = Humid HumidState
:: Energy :== Real
derive class iTask AnaloguePeripheral, DigitalPeripheral
:: LedState :== Bool
:: ButtonState :== Bool
:: HumidState :== UInt8
class Peripheral a r where
setVal :: a r -> (Energy, a)
getVal :: a -> (Energy, r, a)
class EnergyOT a where
getEnergyOT :: a -> Energy
instance Peripheral DigitalPeripheral Bool
instance Peripheral AnaloguePeripheral UInt8
instance EnergyOT DigitalPeripheral
instance EnergyOT AnaloguePeripheral
getTotalEnergyOT :: !BCSimState -> Energy
addCurrentEnergy :: !Int !BCSimState -> BCSimState
implementation module mTask.Interpret.Device.Simulator.Energy
import Data.Maybe
import Data.UInt
import mTask.Interpret.Device.Simulator.State
from StdList import sum, map
from StdFunctions import o
from Data.Func import $
import StdInt
import StdReal
from Data.Map import toList, toAscList, foldrWithKey
import iTasks
import iTasks.UI.Editor.Common
from StdMisc import abort
/**
* After struggling for very long with compiler bugs and overloading errors
* I made the decision to go for this (less elegant approach).
* Ideally a state with existential quantifier should be implemented.
* Old idea:
* Peripheral a = E.s: { state :: s, getEnergyOT :: s -> Energy, setVal :: s a -> (s, Energy), getVal :: s -> (a, s, Energy)} | iTask s & iTask a
*/
derive class iTask AnaloguePeripheral, DigitalPeripheral
instance Peripheral DigitalPeripheral Bool
where
setVal :: DigitalPeripheral Bool -> (Energy, DigitalPeripheral)
setVal (Led s) v = (if (s == v) 0.0 1.0, Led v)
setVal (Button _) _ = abort "Cannot set value of Button"
getVal :: DigitalPeripheral -> (Energy, Bool, DigitalPeripheral)
getVal (Led s) = (0.0, s, Led s)
getVal (Button s) = (0.0, s, Button s)
instance Peripheral AnaloguePeripheral UInt8
where
setVal :: AnaloguePeripheral UInt8 -> (Energy, AnaloguePeripheral)
setVal (Humid _) _ = abort "Cannot set value on humidity sensor"
getVal :: AnaloguePeripheral -> (Energy, UInt8, AnaloguePeripheral)
getVal (Humid i) = (0.5, i, Humid i)
instance EnergyOT DigitalPeripheral
where
getEnergyOT :: DigitalPeripheral -> Energy
getEnergyOT (Led True) = 1.0
getEnergyOT (Led False) = 0.0
getEnergyOT (Button _) = 0.0
instance EnergyOT AnaloguePeripheral
where
getEnergyOT :: AnaloguePeripheral -> Energy
getEnergyOT (Humid _) = 1.0
getTotalEnergyOT :: !BCSimState -> Energy
getTotalEnergyOT {a_pins, d_pins} = (sum o map getEnergyOT $ dp) + (sum o map getEnergyOT $ ap)
where
ap = map snd o toList $ a_pins
dp = map snd o toList $ d_pins
addCurrentEnergy :: !Int !BCSimState -> BCSimState
addCurrentEnergy time ss=:{consumed_energy}
#! eot = (fromInt time) * (getTotalEnergyOT ss)
= {ss & consumed_energy = consumed_energy + eot}
definition module mTask.Interpret.Device.Simulator.Heap
import StdList
from StdOverloaded import class zero
import Data.UInt
:: Offset :== UInt16
// Nothing -> Unallocated
:: Heap a :== [? a]
/**
* Create a Heap
*
* @param Size of the Heap
*/
newHeap :: !Int -> Heap a
/**
* Allocate and place someting on the Heap
*
* @param The item to be placed on the Heap
*
* @result The offset on the Heap
*/
alloc :: !a !(Heap a) -> (!Offset, !Heap a)
/**
* Free a location on the Heap
*
* @param The Offset on the Heap
*/
free :: !Offset !(Heap a) -> Heap a
/**
* Dereference a Offset
*
* @param The Offset
*
* @result The element of the heap
*/
deref :: !Offset !(Heap a) -> a
/**
* Update an element on the Heap
* Throws error on update of unallocated space
*
* @param The new element
* @param The offset on the Heap
*/
update :: !a !Offset !(Heap a) -> Heap a
implementation module mTask.Interpret.Device.Simulator.Heap
from StdDebug import trace_n
from StdMisc import abort
from StdOverloaded import class zero
import Data.UInt
import StdList
import StdTuple
import Data.Maybe
import mTask.Interpret.Device.Simulator.Task
newHeap :: !Int -> Heap a
newHeap n = repeatn n ?None
alloc :: !a !(Heap a) -> (!Offset, !Heap a)
alloc e h = alloc` zero e h
where
alloc` :: !Offset !a !(Heap a) -> (!Offset, !Heap a)
alloc` _ _ [] = abort "Heap.alloc.alloc`: Heap full"
alloc` i e [?Just x : xs]
# (index, xs) = alloc` (i + (fromInt 1)) e xs
= (index, [?Just x : xs])
alloc` i e [?None : xs] = (i, [?Just e : xs])
free :: !Offset !(Heap a) -> Heap a
free (UInt16 0) h=:[?None : _] = trace_n "Heap.free: Double free" h
free (UInt16 0) [?Just _ : xs] = [?None : xs]
free n [x : xs] = [x : free (n - (fromInt 1)) xs]
deref :: !Offset !(Heap a) -> a
deref (UInt16 n) h
# e = h!!n
= fromMaybe (abort "Heap.deref: Segmentation fault") e
update :: !a !Offset !(Heap a) -> Heap a
update _ (UInt16 0) [?None : _] = abort "Heap.update: Segmentation fault"
update e (UInt16 0) [_ : xs] = [?Just e : xs]
update e n [x : xs] = [x : update e (n - (fromInt 1)) xs]
definition module mTask.Interpret.Device.Simulator.Interface
import mTask.Interpret.Device.Simulator.State
import Data.UInt
/**
* @result The amount of milliseconds since unix epoch
*/
getMillies :: !*World -> (!Int, !*World)
/**
* Read Digital Pin value
*/
readDPin :: !UInt8 !BCSimState -> (!Bool, !BCSimState)
/**
* Write new Digital Pin value
* @param ID of the pin
* @param Value to write
* @param Simulator State
*/
writeDPin :: !UInt8 !Bool !BCSimState -> BCSimState
/**
* Read Analogue Pin value
*/
readAPin :: !UInt8 !BCSimState -> (!UInt8, !BCSimState)
/**
* Write new Analogue Pin value
* @param ID of the pin
* @param Value to write
* @param Simulator State
*/
writeAPin :: !UInt8 !UInt8 !BCSimState -> BCSimState
/**
* Read the temperature from Pin
*/
getDhtTemp :: !BCSimState !UInt8 -> UInt16
/**
* Read the humidity from Pin
*/
getDhtHumid :: !BCSimState !UInt8 -> UInt16
implementation module mTask.Interpret.Device.Simulator.Interface
import StdInt
import System.Time
import qualified Data.Map as M
import StdMisc
import Data.Maybe
import mTask.Interpret.Device.Simulator.Energy
import mTask.Interpret.Device.Simulator.State
import Data.UInt
import iTasks
getMillies :: !*World -> (!Int, !*World)
getMillies w
#! ({tv_sec, tv_nsec}, w) = nsTime w
= (tv_sec * 1000 + tv_nsec / 1000, w)
readPin :: UInt8 (Map UInt8 a) BCSimState -> (r, Map UInt8 a, BCSimState) | Peripheral a r
readPin i pins s=:{consumed_energy}
#! per = fromMaybe (abort ("Interface.readPin: Could not get pin with id: " +++ toString i)) ('M'.get i pins)
#! (e, val, per) = getVal per
#! s = {s & consumed_energy = consumed_energy + e}
#! pins = 'M'.put i per pins
= (val, pins, s)
writePin :: UInt8 (Map UInt8 a) r BCSimState -> (Map UInt8 a, BCSimState) | Peripheral a r
writePin i pins val s=:{consumed_energy}
#! per = fromMaybe (abort ("Interface.writePin: Could not get pin with id: " +++ toString i)) ('M'.get i pins)
#! (e, per) = setVal per val
#! s = {s & consumed_energy = consumed_energy + e}
#! pins = 'M'.put i per pins
= (pins, s)
readDPin :: !UInt8 !BCSimState -> (!Bool, !BCSimState)
readDPin i s=:{d_pins}
#! (val, d_pins, s) = readPin i d_pins s
#! s = {s & d_pins = d_pins}
= (val, s)
writeDPin :: !UInt8 !Bool !BCSimState -> BCSimState
writeDPin i b s=:{d_pins}
#! (d_pins, s) = writePin i d_pins b s
#! s = {s & d_pins = d_pins}
= s
readAPin :: !UInt8 !BCSimState -> (!UInt8, !BCSimState)
readAPin i s=:{a_pins}
#! (val, a_pins, s) = readPin i a_pins s
#! s = {s & a_pins = a_pins}
= (val, s)
writeAPin :: !UInt8 !UInt8 !BCSimState -> BCSimState
writeAPin i b s=:{a_pins}
#! (a_pins, s) = writePin i a_pins b s
#! s = {s & a_pins = a_pins}
= s
getDhtTemp :: !BCSimState !UInt8 -> UInt16