+ serialAvailable = tell` [BCSerialAvail]
+ serialPrint s = tell` [BCSerialPrint]
+ serialPrintln s = tell` [BCSerialPrintln]
+ serialRead = tell` [BCSerialRead]
+ serialParseInt = tell` [BCSerialParseInt]
+
+instance userLed ByteCode where
+ ledOn l = op l BCLedOn
+ ledOff l = op l BCLedOff
+
+instance retrn ByteCode where
+ retrn = tell` [BCReturn]
+
+instance zero BCState where
+ zero = {freshl=1, freshs=1, sdss=[]}
+
+toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)
+toRealByteCode x s
+# (s, bc) = runBC x s
+# (bc, gtmap) = computeGotos bc 1
+= (concat $ map (toString o toByteVal) (map (implGotos gtmap) bc), s)
+
+implGotos map (BCJmp t) = BCJmp $ fromJust ('DM'.get t map)
+implGotos map (BCJmpT t) = BCJmpT $ fromJust ('DM'.get t map)
+implGotos map (BCJmpF t) = BCJmpF $ fromJust ('DM'.get t map)
+implGotos _ i = i
+
+bclength :: BC -> Int
+bclength (BCPush s) = 1 + size (toByteCode s)
+bclength (BCSdsStore _) = 3
+bclength (BCSdsFetch _) = 3
+bclength (BCSdsPublish _) = 3
+bclength x = 1 + consNum{|*|} x
+
+computeGotos :: [BC] Int -> ([BC], 'DM'.Map Int Int)
+computeGotos [] _ = ([], 'DM'.newMap)
+computeGotos [BCLab l:xs] i = appSnd ('DM'.put l i) (computeGotos xs i)
+computeGotos [x:xs] i = appFst (\bc->[x:bc]) (computeGotos xs $ i + bclength x)
+
+readable :: BC -> String
+readable (BCPush d) = "BCPush " +++ concat [safe c\\c<-:toByteCode d]
+ where
+ safe c = if (isControl c) ("\\d" +++ toString (toInt c)) (toString c)
+readable b = printToString b
+
+runBC :: (ByteCode a b) -> (BCState -> (BCState, [BC]))
+runBC (BC x) = execRWS x ()
+
+toReadableByteCode :: (ByteCode a b) BCState -> (String, BCState)
+toReadableByteCode x s
+# (s, bc) = runBC x s
+# (bc, gtmap) = computeGotos bc 0
+= ('Text'.join "\n" $ lineNumbers numbers (map (implGotos gtmap) bc), s)
+ where
+ numbers = map (\n->lpad (toString n) 3 ' ' +++ ". ") [0..]
+ lineNumbers ls [] = []
+ lineNumbers [l:ls] [b:bc] = [l +++ readable b:ex ++ lineNumbers newls bc]
+ where
+ (ex, newls) = splitAt (bclength b - 1) ls
+
+derive gPrint BCShare
+
+toMessages :: MTaskInterval (Main (ByteCode a b)) BCState -> ([MTaskMSGSend], BCState)
+toMessages interval x s
+# (bc, newstate) = toRealByteCode (unMain x) s
+# newsdss = 'DL'.difference newstate.sdss s.sdss
+| not (trace_tn $ printToString s.sdss) = undef
+| not (trace_tn $ printToString newstate.sdss) = undef
+| not (trace_tn $ printToString newsdss) = undef
+= ([MTSds sdsi e\\{sdsi,sdsval=e}<-newsdss] ++
+ [MTTask interval bc], newstate)
+
+instance == BCShare where (==) a b = a.sdsi == b.sdsi
+
+//Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero
+//Start = [fst $ toReadableByteCode (unMain $ p0) zero
+// ,'Text'.concat $ compile p0
+// ]
+Start = toReadableByteCode (unMain $ p0) zero
+ where
+ p0 :: (Main (a Int Expr)) | assign, namedsds, sds, arith a
+// p0 = sds \x = 6 In {main = x =. x *. lit 7}
+ p0 = namedsds \x = 6 Named "x" In {main = x =. x *. lit 7}
+
+ bc = {main =
+ IF (analogRead A0 >. lit 50)
+ ( digitalWrite D0 (lit True) )
+ ( digitalWrite D0 (lit False) )
+ }
+
+
+to16bit :: Int -> String
+to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))
+
+from16bit :: String -> Int
+from16bit s = toInt s.[0] * 256 + toInt s.[1]
+
+//derive class gCons UserLED, Long, Pin, Button, UserLED, AnalogPin, DigitalPin, PinMode