- zero = {a=()}
-
-//Start :: ByteCode Int Expr
-//Start = (lit 36 +. lit 42) +. lit 84
-
-(<+) infixr 5 :: a b -> String | toString a & toString b
-(<+) a b = toString a +++ toString b
-
-//Run test programma en pretty print
-Start :: ByteCode Int Expr
-Start = analogRead A0
-//Start = If ((lit 36) ==. (lit 42)) (noOp) (noOp)
-
-//Generate header file
-//Start w
-//# (io, w) = stdio w
-//# io = io <<< "#ifndef MTASK_H\n#define MTASK_H\n"
-//# io = io <<< join "\n" ["#define " <+ toUpperCase (consName{|*|} x) <+ " " <+ consIndex{|*|} x\\x<-allBC]
-// with
-// allBC :: [BC]
-// allBC = conses{|*|}
-//# (ok, w) = fclose (io <<< "\n#endif\n") w
-//| not ok = abort "Couldn't close stdio"
-//= w
+ 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
+
+import StdDebug
+bclength :: BC -> Int
+bclength (BCPush s) = 1 + size 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<-: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
+| not (trace_tn $ ('Text'.join "\n" $ lineNumbers numbers bc) +++ "\n") = undef
+# (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
+
+toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState)
+toMessages interval (bytes, st=:{sdss}) = (
+ [MTSds s.sdsi s.sdsbc\\s<-sdss] ++
+ [MTTask interval bytes], st)
+
+toSDSUpdate :: Int Int -> [MTaskMSGSend]
+toSDSUpdate i v = [MTUpd i (to16bit v)]
+
+//Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero
+Start = fst $ toReadableByteCode (unMain $ blink LED1) zero
+//Start = let (bcs, st) = toReadableByteCode (unMain bc) zero
+// in (bcs, st.sdss)
+ where
+// bc = {main = ledOn (lit LED1)}
+ bc = sds \x=5 In
+ sds \y=4 In
+ {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)}
+
+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]