Skip to content
GitLab
Commit e16d1285 authored by Mart Lubbers's avatar Mart Lubbers
Browse files

add documentation to the rest of the code as well and cleanup

parent f1fb4f46
Pipeline #56506 passed with stage
in 1 minute and 49 seconds
Hide whitespace changes
Inline Side-by-side
csrc/convert_real_to_float_in_int.c
View file @ e16d1285
#include <stdint.h>
/**
* Union for interchanging floats and 32-bit integers without translation
* This requires that floats are exactly 32-bit of size
*/
union floatint {
/** float representation */
float f;
/** unsigned 32-bit int representation */
uint32_t i;
};
//** Pack a real into a 32-bit integer as a float
uint32_t convert_real_to_float_in_int_32(double r)
{
union floatint fi = { .f=(float) r };
return fi.i;
}
//** Pack a real into a 64-bit integer as a float
uint64_t convert_real_to_float_in_int_64(double r)
{
union floatint fi = { .f=(float) r };
return (uint64_t) fi.i;
}
//** Unpack a float packed into a 32-bit integer as a real
double convert_float_in_int_to_real_32(uint32_t r)
{
union floatint fi = { .i=(uint32_t) r };
return (double) fi.f;
}
//** Unpack a float packed into a 34-bit integer as a real
double convert_float_in_int_to_real_64(uint64_t r)
{
union floatint fi = { .i=(uint32_t) r };
......
lib/mTask/Data/UInt.dcl
View file @ e16d1285
definition module Data.UInt
/**
* Bounded integers, signed and unsigned
*
* Note that the ints do not overflow but are capped
*/
from Data.GenHash import generic gHash
from Data.GenDefault import generic gDefault
from iTasks.UI.Editor.Generic import generic gEditor, :: Editor, :: EditorPurpose, :: EditorReport
......@@ -10,28 +16,82 @@ from StdOverloaded import class zero, class one, class -, class +, class *, clas
from GenType import generic gType, :: Box, :: GType
from GenType.CSerialise import generic gCSerialise, generic gCDeserialise, :: Either, :: CDeserialiseError
//** Unsigned 32-bit integer
:: UInt32 =: UInt32 Int
/**
* Note that the ints do not overflow but are capped
* The maximal value for an unsigned 32-bit integer
* @type UInt32
*/
:: UInt32 =: UInt32 Int
UINT32_MAX :== UInt32 0xffffffff
/**
* The minimal value for an unsigned 32-bit integer
* @type UInt32
*/
UINT32_MIN :== UInt32 0x00000000
//** Unsigned 16-bit integer
:: UInt16 =: UInt16 Int
/**
* The maximal value for an unsigned 16-bit integer
* @type UInt16
*/
UINT16_MAX :== UInt16 0xffff
/**
* The minimal value for an unsigned 16-bit integer
* @type UInt16
*/
UINT16_MIN :== UInt16 0x0000
//** Unsigned 8-bit integer
:: UInt8 =: UInt8 Int
/**
* The minimal value for an unsigned 8-bit integer
* @type UInt8
*/
UINT8_MAX :== UInt8 0xff
/**
* The minimal value for an unsigned 8-bit integer
* @type UInt8
*/
UINT8_MIN :== UInt8 0x00
//** Signed 32-bit integer
:: Int32 =: Int32 Int
/**
* The maximal value for a signed 32-bit integer
* @type Int32
*/
INT32_MAX :== Int32 0x7fffffff
/**
* The minimal value for a signed 32-bit integer
* @type Int32
*/
INT32_MIN :== Int32 -0x80000000
//** Signed 16-bit integer
:: Int16 =: Int16 Int
/**
* The maximal value for a signed 16-bit integer
* @type Int16
*/
INT16_MAX :== Int16 0x7fff
/**
* The minimal value for a signed 16-bit integer
* @type Int16
*/
INT16_MIN :== Int16 -0x8000
//** Signed 8-bit integer
:: Int8 =: Int8 Int
/**
* The maximal value for a signed 8-bit integer
* @type Int8
*/
INT8_MAX :== Int8 0x7f
/**
* The minimal value for a signed 8-bit integer
* @type Int8
*/
INT8_MIN :== Int8 -0x80
instance ~ UInt8, UInt16, UInt32, Int8, Int16, Int32
......@@ -63,9 +123,16 @@ derive gDefault UInt8, UInt16, UInt32, Int8, Int16, Int32
//gType
derive gType UInt8, UInt16, UInt32, Int8, Int16, Int32
//* Helper function for C-code generation of unsigned 8-bit integers (see {{gCSerialise}})
uint8gType :: (String, [String], String -> [String], String -> [String])
//* Helper function for C-code generation of unsigned 16-bit integers (see {{gCSerialise}})
uint16gType :: (String, [String], String -> [String], String -> [String])
//* Helper function for C-code generation of unsigned 32-bit integers (see {{gCSerialise}})
uint32gType :: (String, [String], String -> [String], String -> [String])
//* Helper function for C-code generation of signed 8-bit integers (see {{gCSerialise}})
int8gType :: (String, [String], String -> [String], String -> [String])
//* Helper function for C-code generation of signed 16-bit integers (see {{gCSerialise}})
int16gType :: (String, [String], String -> [String], String -> [String])
//* Helper function for C-code generation of signed 32-bit integers (see {{gCSerialise}})
int32gType :: (String, [String], String -> [String], String -> [String])
lib/mTask/mTask/AST.dcl deleted 100644 → 0
View file @ f1fb4f46
definition module mTask.AST
import mTask.AST.monad
import mTask.AST.DSL
import mTask.AST.basic
lib/mTask/mTask/AST.icl deleted 100644 → 0
View file @ f1fb4f46
implementation module mTask.AST
lib/mTask/mTask/AST/DSL.dcl deleted 100644 → 0
View file @ f1fb4f46
definition module mTask.AST.DSL
/*
Pieter Koopman
Radboud University NIjmegen, The Netherlands
pieter@cs.ru.nl
*/
import mTask.Language
instance aio AST
instance arith AST
instance cond AST
instance delay AST
instance dht AST
instance dio p AST
instance double Int AST
instance double Real AST
instance rpeat AST
instance fun () AST
instance fun (AST a) AST | basicType a
instance fun (AST a, AST b) AST | basicType a & basicType b
instance fun (AST a, AST b, AST c) AST | basicType a & basicType b & basicType c
instance lcd AST
instance rtrn AST
instance sds AST
instance step AST
instance unstable AST
instance .&&. AST
instance .||. AST
instance typeOf Button
instance typeOf DHT
instance value DHT
instance typeOf DHTtype
instance value DHTtype
instance typeOf LCD
instance value LCD
instance typeOf ButtonStatus
instance value ButtonStatus
lib/mTask/mTask/AST/DSL.icl deleted 100644 → 0
View file @ f1fb4f46
implementation module mTask.AST.DSL
/*
Pieter Koopman
Radboud University NIjmegen, The Netherlands
pieter@cs.ru.nl
*/
import mTask.Language
import StdMisc
import mTask.AST.monad
import Control.Monad, Control.Applicative
import Data.Functor
import StdString, StdList
import mTask.Show.monad
import mTask.Interpret.ByteCodeEncoding
return = pure
(>>|=) infixl 1 :: (AST x) (Expr -> AST y) -> AST y
(>>|=) x f = x >>| getExpr >>= f
instance arith AST where
lit x = setExpr (Lit (typeOf x) (toString x))
(+.) x y = x >>|= \xt. y >>|= \yt. setExpr (App (typeOf xt) "+" [xt, yt])
(-.) x y = x >>|= \xt. y >>|= \yt. setExpr (App (typeOf xt) "-" [xt, yt])
(*.) x y = x >>|= \xt. y >>|= \yt. setExpr (App (typeOf xt) "*" [xt, yt])
(/.) x y = x >>|= \xt. y >>|= \yt. setExpr (App (typeOf xt) "/" [xt, yt])
(&.) x y = x >>|= \xt. y >>|= \yt. setExpr (App BoolType "&&" [xt, yt])
(|.) x y = x >>|= \xt. y >>|= \yt. setExpr (App BoolType "||" [xt, yt])
Not x = x >>|= \xt. setExpr (App BoolType "not" [xt])
(==.) x y = x >>|= \xt. y >>|= \yt. setExpr (App BoolType "==" [xt, yt])
(!=.) x y = x >>|= \xt. y >>|= \yt. setExpr (App BoolType "!=" [xt, yt])
(<.) x y = x >>|= \xt. y >>|= \yt. setExpr (App BoolType "<" [xt, yt])
(>.) x y = x >>|= \xt. y >>|= \yt. setExpr (App BoolType ">" [xt, yt])
(<=.) x y = x >>|= \xt. y >>|= \yt. setExpr (App BoolType "<=" [xt, yt])
(>=.) x y = x >>|= \xt. y >>|= \yt. setExpr (App BoolType ">=" [xt, yt])
instance aio AST where
readA p = p >>|= \pt. setExpr (App (MTaskType IntType) "readAnalog" [pt])
writeA p v = p >>|= \pt. v >>|= \vt. setExpr (App (MTaskType IntType) "writeAnalog" [pt, vt])
instance dio p AST where
readD p = p >>|= \pt. setExpr (App (MTaskType BoolType) "readDigital" [pt])
writeD p v = p >>|= \pt. v >>|= \vt. setExpr (App (MTaskType BoolType) "writeDigital" [pt, vt])
instance cond AST where
If :: (AST Bool) (AST t) (AST t) -> AST t | type t
If c t e =
c >>|= \ct.
t >>|= \tt.
e >>|= \et.
setExpr (App (typeOf tt) "if" [ct, tt, et]) // must be lazy!
instance rtrn AST where rtrn x = x >>|= \xt.setExpr (App (MTaskType (typeOf xt)) "return" [xt])
instance unstable AST where unstable x = x >>|= \xt.setExpr (App (MTaskType (typeOf xt)) "unstable" [xt])
deTask :: Expr -> Type
deTask e =
case typeOf e of
MTaskType t = t
t = abort ("MTaskType expected instead of " + toString t)
collectVars :: Name Expr -> [Expr]
collectVars new expr = [v \\ v=:(Var t n) <- removeDup (vars expr) | n <> new]
instance step AST
where
(>>*.) e l
= e >>|= \et.
((\n."v"+n) <$> freshId) >>= \name1.
return (Var (deTask et) name1) >>= \var.
astSteps et (setExpr var) l >>= \lt.
return (BindExpr et lt) >>= \body.
return (collectVars name1 body) >>= \addedArgs.
((\n."f"+n) <$> freshId) >>= \name2.
return (App (typeOf body) name2 addedArgs) >>= \fun.
return (addAlways body fun) >>= \body2.
storeDEF (FunDef (typeOf body) name2 (addedArgs ++ [var]) body2) >>|
setExpr (App (MTaskType (typeOf body)) "step" [et,fun])
addAlways (BindExpr e l) fun = BindExpr e (addAlwaysL l fun)
addAlwaysL [step=:(AlwaysExpr e): r] fun = [step]
addAlwaysL [step:r] fun = [step: addAlwaysL r fun]
addAlwaysL [] fun = [AlwaysExpr fun]
astSteps :: Expr (AST a) [Step AST a b] -> AST [StepExpr]
astSteps et var [s:r] =
case s of
IfValue f e =
f var >>|= \ft.
e var >>|= \et2.
astSteps et var r >>= \lr.
return [ValueExpr ft et2: lr]
IfStable f e =
f var >>|= \ft.
e var >>|= \et2.
astSteps et var r >>= \lr.
return [StableExpr ft et2: lr]
IfUnstable f e =
f var >>|= \ft.
e var >>|= \et2.
astSteps et var r >>= \lr.
return [UnstableExpr ft et2: lr]
IfNoValue e =
e >>|= \et2.
astSteps et var r >>= \lr.
return [NoValueExpr et2: lr]
Always e =
e >>|= \et2.
return [AlwaysExpr et2]
astSteps et var [] = return []
/*
Type error [ASTDSL.icl,38,>>=.]:"lifted argument f of \;39;13" cannot unify demanded type with offered type:
Expr -> AST (MTaskVal v1) // offered
(AST v0) -> MTask AST v1 // demanded
*/
instance rpeat AST where
rpeat t =
t >>|= \tt.
setExpr (App (MTaskType VoidType) "rpeat" [tt])
instance double Int AST where
double i =
i >>|= \it.
setExpr (App RealType "(double)" [it])
>>| return 0.0 // to fix the type
instance double Real AST where double r = r
instance fun () AST
where
fun def =
{main =
((\n."f"+n) <$> freshId) >>= \f.
let (g In {main = m}) = def (\().setExpr (App (typeOf (g ())) f [Lit VoidType "()"])) in
g () >>|= \body.
((\n."v"+n) <$> freshId) >>= \v.
storeDEF (FunDef (typeOf body) f [Lit VoidType v] body) >>|
m
}
instance fun (AST a) AST | basicType a
where
fun def =
{main =
((\n."f"+n) <$> freshId) >>= \f.
((\n."v"+n) <$> freshId) >>= \v.
return (let f = value in K (typeOf f) (def f)) >>= \(FunType [argType] bodyType).
return (Var argType v) >>= \arg.
let (g In {main = m}) = def (\x.x >>|= \xt.setExpr (App bodyType f [xt])) in
g (setExpr arg) >>|= \body.
storeDEF (FunDef (typeOf body) f [arg] body) >>|
m
}
K a b = a
instance fun (AST a, AST b) AST | basicType a & basicType b
where
fun def =
{main =
((\n."f"+n) <$> freshId) >>= \f.
((\n."v"+n) <$> freshId) >>= \v1.
((\n."v"+n) <$> freshId) >>= \v2.
return (let f = value in K (typeOf f) (def f)) >>= \(FunType [PairType [arg1Type, arg2Type]] bodyType).
return (Var arg1Type v1) >>= \arg1.
return (Var arg2Type v2) >>= \arg2.
let (g In {main = m}) = def (\(x,y).x >>|= \xt. y >>|= \yt. setExpr (App bodyType f [xt,yt])) in
g (setExpr arg1, setExpr arg2) >>|= \body.
storeDEF (FunDef (typeOf body) f [arg1, arg2] body) >>|
m
}
instance fun (AST a, AST b, AST c) AST | basicType a & basicType b & basicType c
where
fun def =
{main =
((\n."f"+n) <$> freshId) >>= \f1.
((\n."v"+n) <$> freshId) >>= \v1.
((\n."v"+n) <$> freshId) >>= \v2.
((\n."v"+n) <$> freshId) >>= \v3.
return (let f = value in K (typeOf f) (def f)) >>= \(FunType [PairType [arg1Type, arg2Type, arg3Type]] bodyType).
return (Var arg1Type v1) >>= \arg1.
return (Var arg2Type v2) >>= \arg2.
return (Var arg2Type v3) >>= \arg3.
let (g In {main = m}) = def (\(x,y,z).x >>|= \xt. y >>|= \yt. z >>|= \zt. setExpr (App bodyType f1 [xt,yt, zt])) in
g (setExpr arg1, setExpr arg2, setExpr arg3) >>|= \body.
storeDEF (FunDef (typeOf body) f1 [arg1, arg2, arg3] body) >>|
m
}
instance sds AST
where
sds def =
{main =
((+)"s" <$> freshId) >>= \sName.
return (typeOf (cast def value)) >>= \sType.
return (SdsExpr sType sName) >>= \s.
let (g In {main = m}) = def (setExpr s) in
storeSDS (SDSDef sType sName (Lit sType (toString g))) >>|
m
}
where
cast :: ((v (Sds t))->In t (Main (MTask v u))) t -> t
cast x y = y
setSds sds val =
sds >>|= \e=:(SdsExpr type name).
val >>|= \newVal.
setExpr (App (MTaskType type) "setSds" [e, newVal])
getSds sds =
sds >>|= \e=:(SdsExpr type name). //(SdsExpr f).
setExpr (App (MTaskType type) "getSds" [e])
instance dht AST where
DHT p dhtType def =
{main =
((\n."dht"+n) <$> freshId) >>= \dhtName.
return (MTaskType (ObjectType "DHT")) >>= \type.
return (Object type dhtName) >>= \object.
let {main = m} = def (setExpr object) in
storeObject (ObjectDef type dhtName [toString p] ["DHT_U.h", "dht.h"]) >>|
m
}
temperature dht =
dht >>|= \d.
setExpr (App (MTaskType RealType) "temperature" [d])
humidity dht =
dht >>|= \d.
setExpr (App (MTaskType RealType) "humidity" [d])
instance lcd AST where
LCD x y pins def =
{main =
((\n."lcd"+n) <$> freshId) >>= \lcdName.
return (MTaskType (ObjectType "LCD")) >>= \type.
return (Object type lcdName) >>= \object.
let {main = m} = def (setExpr object) in
storeObject (ObjectDef type lcdName [toString x, toString y: map toString pins] ["liquidCrystal"]) >>|
m
}
print lcd x =
lcd >>|= \lcdt.
x >>|= \xt.
setExpr (App (MTaskType IntType) "print" [lcdt, xt])
setCursor lcd x y =
lcd >>|= \lcdt.
x >>|= \xt.
y >>|= \yt.
setExpr (App (MTaskType VoidType) "setCursor" [lcdt, xt, yt])
scrollLeft lcd =
lcd >>|= \lcdt.
setExpr (App (MTaskType VoidType) "scrollLeft" [lcdt])
scrollRight lcd =
lcd >>|= \lcdt.
setExpr (App (MTaskType VoidType) "scrollRight" [lcdt])
pressed b =
b >>|= \bt.
setExpr (App (MTaskType BoolType) "pressed" [bt])
instance delay AST where
delay i =
i >>|= \it.
setExpr (App (MTaskType (typeOf i)) "delay" [it])
instance toString (Sds a) | toString a where toString (Sds i) = "SDS " +++ toString i
instance .||. AST where // must this be lazy in the second argument?
.||. x y =
x >>|= \xt.
y >>|= \yt.
setExpr (App (typeOf xt) "or" [xt, yt])
instance .&&. AST where
.&&. x y =
x >>|= \xt.
y >>|= \yt.
setExpr (App (PairType [typeOf xt, typeOf yt]) "and" [xt, yt])
/*
instance .||. AST where
.||. x y =
x >>*. [Stable (\a.lit True) rtrn
,Always (y >>*. [Stable (\b.lit True) rtrn
,Always (x .||. y)
]
)
]
// x >>*. [Stable (\a.lit True) rtrn]
*/
instance typeOf Button where typeOf b = IntType
instance typeOf DHT where typeOf b = MTaskType (ObjectType "DHT")
instance value DHT where value = abort "value DHT"
instance typeOf DHTtype where typeOf b = ObjectType "DHTtype"
instance value DHTtype where value = DHT11
instance typeOf LCD where typeOf b = MTaskType (ObjectType "LCD")
instance value LCD where value = abort "value LCD"
instance typeOf ButtonStatus where typeOf b = MTaskType (ObjectType "ButtonStatus")
instance value ButtonStatus where value = ButtonNone
instance typeOf (In (a->AST f) (Main x)) | typeOf f & typeOf, value a where
typeOf (g In m) = typeOf g
// typeOf (g In m) = FunType [typeOf a] (typeOf (g a)) where a = abort "\nundef: a in typeOf (In (a->AST f) (Main x))"
// ====
/*
instance arith (AST1 Expr) where
lit x = return2 (Lit (typeOf x) (toString x))
(+.) x y = x >>== \xt. y >>== \yt. return2 (App (typeOf xt) "+" [xt, yt])
(-.) x y = x >>== \xt. y >>== \yt. return2 (App (typeOf xt) "-" [xt, yt])
(*.) x y = x >>== \xt. y >>== \yt. return2 (App (typeOf xt) "*" [xt, yt])
(/.) x y = x >>== \xt. y >>== \yt. return2 (App (typeOf xt) "/" [xt, yt])
(&.) x y = x >>== \xt. y >>== \yt. return2 (App BoolType "&&" [xt, yt])
(|.) x y = x >>== \xt. y >>== \yt. return2 (App BoolType "||" [xt, yt])
Not x = x >>== \xt. return2 (App (typeOf xt) "not" [xt])
(==.) x y = x >>== \xt. y >>== \yt. return2 (App BoolType "==" [xt, yt])
(!=.) x y = x >>== \xt. y >>== \yt. return2 (App BoolType "!=" [xt, yt])
(<.) x y = x >>== \xt. y >>== \yt. return2 (App BoolType "<" [xt, yt])
(>.) x y = x >>== \xt. y >>== \yt. return2 (App BoolType ">" [xt, yt])
(<=.) x y = x >>== \xt. y >>== \yt. return2 (App BoolType "<=" [xt, yt])
(>=.) x y = x >>== \xt. y >>== \yt. return2 (App BoolType ">=" [xt, yt])
instance aio (AST1 Expr) where
readA p = p >>== \pt. return2 (App IntType "readAnalog" [pt])
writeA p v = p >>== \pt. v >>== \vt.return2 (App IntType "writeAnalog" [pt,vt])
instance dio p (AST1 Expr) where
readD p = p >>== \pt. return2 (App BoolType "readAnalog" [pt])
writeD p v = p >>== \pt. v >>== \vt.return2 (App BoolType "writeAnalog" [pt,vt])
instance rtrn (AST1 Expr) where rtrn x = (\y.Val y True) <$> x
//instance rtrn (AST1 Expr) where rtrn x = Stab <$> x
*/
//from ShowBasic import class freshId
//import ShowBasic // why is this needed?
/*
binddd :: (AST1 Expr a) (Expr -> (AST1 Expr b)) -> AST1 Expr c
binddd x f
= x >>== \xt.
((\n."v"+n) <$> freshId) >>= \name1.
return (Var (typeOf xt) name1) >>= \var.
((\n."f"+n) <$> freshId) >>= \name2.
return (App (typeOf xt) name2 []) >>= \fun.
(f var) >>== \body.
storeDef (FunDef (typeOf body) name2 [var] body) >>|
return2 (App (typeOf body) "bind" [xt,fun])
*/
instance + String where + x y = x +++ y
/*
instance seq (AST1 Expr) where
(>>=.) x f
= x >>== \xt.
((\n."v"+n) <$> freshId) >>= \name1.
return (Var (typeOf xt) name1) >>= \var.
((\n."f"+n) <$> freshId) >>= \name2.
return (App (typeOf xt) name2 []) >>= \fun.
(f var) >>== \body.
storeDef (FunDef (typeOf body) name2 [name1] body) >>|
return2 (App undef "bind" [xt,fun])
(>>|.) x y = undef
(>>~.) x f = undef
(>>..) x y = undef
*/
/*
class seq v where
(>>=.) infixr 0 :: (MTask v t) ((v t)->(MTask v u)) -> MTask v u | type t & type u
(>>|.) infixr 0 :: (MTask v t) (MTask v u) -> MTask v u | type t & type u
(>>~.) infixr 0 :: (MTask v t) ((v t)->(MTask v u)) -> MTask v u | type t & type u
(>>..) infixr 0 :: (MTask v t) (MTask v u) -> MTask v u | type t & type u
*/