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
#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 };
......
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])
definition module mTask.AST
import mTask.AST.monad
import mTask.AST.DSL
import mTask.AST.basic
implementation module mTask.AST
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
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
*/