mTaskInterpret.icl

   1 implementation module mTaskInterpret
   2
   3 //import iTasks
   4 import gdynamic, gCons, GenEq, StdMisc, StdArray, GenBimap
   5 import GenPrint
   6 import StdEnum
   7 import mTask
   8
   9 import StdFile
  10 import StdString
  11
  12 from StdFunc import o, const
  13 import StdBool
  14 import StdTuple
  15 import Data.Tuple
  16 import Data.Monoid
  17 import Data.Functor
  18 import StdList
  19 from Data.Func import $
  20 from Text import class Text(concat,join,toUpperCase), instance Text String
  21
  22 toByteVal :: BC -> [Char]
  23 toByteVal b
  24 # bt = toChar $ consIndex{|*|} b + 1
  25 = [bt:case b of
  26                 (BCPush i) = i
  27                 (BCAnalogRead i) = [toChar i]
  28                 (BCAnalogWrite i) = [toChar i]
  29                 (BCDigitalRead i) = [toChar i]
  30                 (BCDigitalWrite i) = [toChar i]
  31                 (BCJmp i) = [toChar i]
  32                 (BCJmpT i) = [toChar i]
  33                 (BCJmpF i) = [toChar i]
  34                 _ = []]
  35
  36 instance Semigroup (ByteCode a p) where
  37         mappend m n = BC \s->let (b1, (b2, t)) = runBC m <$> runBC m s in (b1 ++ b2, t)
  38
  39 instance Monoid (ByteCode a p) where
  40         mempty = retrn []
  41
  42 (<++>) infixl 2 :: (ByteCode a p) (ByteCode b q) -> ByteCode c r
  43 (<++>) m n = BC \s->let (b1, (b2, t)) = runBC n <$> runBC m s in (b1 ++ b2, t)
  44
  45 (<+->) infixr 1
  46 (<+->) m n :== m <++> retrn n
  47
  48 runBC (BC m) = m
  49
  50 retrn :: ([BC] -> ByteCode a p)
  51 retrn = BC o tuple
  52
  53 instance toByteCode Bool where
  54         toByteCode True = [toChar 1]
  55         toByteCode False = [toChar 0]
  56 instance toByteCode Int where toByteCode n = map toChar [n/(2<<7),n rem 265]
  57 instance toByteCode Long where toByteCode (L n) = toByteCode n
  58 instance toByteCode Char where toByteCode c = [c]
  59 instance toByteCode String where toByteCode s = undef
  60 instance toByteCode Button where toByteCode s = [toChar $ consIndex{|*|} s]
  61
  62 instance toChar Pin where
  63         toChar (Digital p) = toChar $ consIndex{|*|} p + 1
  64         toChar (Analog p) = toChar $ consIndex{|*|} p + 1
  65
  66 derive gPrint BC, AnalogPin, Pin, DigitalPin, BCState
  67 derive consIndex BC, Pin, Button
  68 derive consName BC, Pin, Button
  69
  70 instance arith ByteCode where
  71         lit x = retrn [BCPush $ toByteCode x]
  72         (+.) x y = x <++> y <+-> [BCAdd]
  73         (-.) x y = x <++> y <+-> [BCSub]
  74         (*.) x y = x <++> y <+-> [BCMul]
  75         (/.) x y = x <++> y <+-> [BCDiv]
  76
  77 instance boolExpr ByteCode where
  78         (&.) x y = x <++> y <+-> [BCAnd]
  79         (|.) x y = x <++> y <+-> [BCOr]
  80         Not x = x <+-> [BCNot]
  81         (==.) x y = x <++> y <+-> [BCEq]
  82         (!=.) x y = x <++> y <+-> [BCNeq]
  83         (<.) x y = x <++> y <+-> [ BCLes]
  84         (>.)  x y = x <++> y <+-> [BCGre]
  85         (<=.) x y = x <++> y <+-> [BCLeq]
  86         (>=.) x y = x <++> y <+-> [BCGeq]
  87
  88 instance analogIO ByteCode where
  89         analogRead p = retrn [BCAnalogRead $ pin p]
  90         analogWrite p b = b <+-> [BCAnalogWrite $ pin p]
  91
  92 instance digitalIO ByteCode where
  93         digitalRead p = retrn [BCDigitalRead $ pin p]
  94         digitalWrite p b = b <+-> [BCDigitalWrite $ pin p]
  95
  96 instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e
  97 instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e
  98 instance If ByteCode Stmt Stmt e where If b t e = BCIfStmt b t e
  99 instance If ByteCode x y Expr where If b t e = BCIfStmt b t e
 100 instance IF ByteCode where
 101         IF b t e = BCIfStmt b t e
 102         (?) b t = BCIfStmt b t $ retrn []
 103 BCIfStmt b t e = withLabel \else->withLabel \endif->retrn [BCJmpF else] <++> t
 104         <++> retrn [BCJmp endif] <++> e <++> retrn [BCLab endif]
 105
 106 instance noOp ByteCode where noOp = mempty
 107
 108
 109 withLabel :: (Int -> (ByteCode b q)) -> ByteCode b q
 110 withLabel f = BC \s->let [fresh:fs] = s.freshl
 111         in runBC (f fresh) {s & freshl=fs}
 112
 113 withSDS :: (Int -> (ByteCode b q)) -> ByteCode b q
 114 withSDS f = BC \s->let [fresh:fs] = s.freshs
 115         in runBC (f fresh) {s & freshs=fs}
 116
 117 instance sds ByteCode where
 118         sds f = {main = withSDS \sds->
 119                         let (v In body) = f $ retrn [BCSdsStore sds]
 120                         in unMain body <++> retrn [BCSdsStore sds]
 121                 }
 122         con f = undef
 123
 124 instance assign ByteCode where
 125         (=.) v e = e <++> abort (printToString $ fst $ runBC v zero)
 126
 127 instance seq ByteCode where
 128         (>>=.) _ _ = abort "undef on >>=."
 129         (:.) x y = x <++> y
 130
 131 instance serial ByteCode where
 132         serialAvailable = retrn [BCSerialAvail]
 133         serialPrint s = retrn [BCSerialPrint]
 134         serialPrintln s = retrn [BCSerialPrintln]
 135         serialRead = retrn [BCSerialRead]
 136         serialParseInt = retrn [BCSerialParseInt]
 137
 138 instance zero BCState where
 139         zero = {freshl=[1..], freshs=[1..]}
 140
 141 toRealByteCode :: (ByteCode a Expr) -> String
 142 toRealByteCode x
 143 # (bc, st) = runBC x zero
 144 = concat $ map (toString o toByteVal) bc
 145
 146 toReadableByteCode :: (ByteCode a Expr) -> String
 147 toReadableByteCode x
 148 # (bc, st) = runBC x zero
 149 = join "\n" $ map printToString bc
 150
 151 toReadableByteVal :: BC -> String
 152 toReadableByteVal a = printToString a
 153
 154
 155 //Start :: String
 156 //Start = toReadableByteCode bc
 157 //      where
 158 //              bc :: ByteCode Int Expr
 159 //              bc = (lit 36 +. lit 42) +. lit 44
 160
 161 Start :: String
 162 Start = toReadableByteCode $ unMain bc
 163         where
 164                 bc :: Main (ByteCode Int Expr)
 165                 bc = sds \x=46 In
 166                         sds \y=46 In
 167                         {main = y =. x +. y}
 168
 169 //to16bit :: Int -> String
 170 //to16bit i = toString (toChar (i/265)) +++ toString (toChar (i rem 265))
 171 //
 172 ////Run test programma en pretty print
 173 ////Start :: String
 174 ////Start = "t" +++ to16bit (size b) +++ b
 175 //Start :: Main (ByteCode Int Expr)
 176 //Start = bc
 177 //      where
 178 //              bc = sds \x=43 In {main = If (x ==. lit 42) (analogRead A1) (analogRead A0)}
 179 //              b = toRealByteCode bc
 180 //Start :: ByteCode Int Expr
 181 //Start = If (lit True) (analogRead A1) (analogRead A0)
 182 //Start = If ((lit 36) ==. (lit 42)) (noOp) (noOp)