From e37402e7672352aa3642df4c1183417a72f59641 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 13 Mar 2017 09:41:09 +0100 Subject: [PATCH] make all literals 2 again --- Makefile | 2 +- mTaskInterpret.icl | 61 +++++++++++++++++++++++----------------------- 2 files changed, 32 insertions(+), 31 deletions(-) diff --git a/Makefile b/Makefile index cbca7ae..1afaa77 100644 --- a/Makefile +++ b/Makefile @@ -19,7 +19,7 @@ CLMLIBS:=\ -I $(CLEAN_HOME)/lib/TCPIP\ -I ./CleanSerial -BINARIES:= testi mTaskInterpret miTask # mTaskExamples +BINARIES:= mTaskInterpret miTask # mTaskExamples all: CleanSerial/Clean\ System\ Files/TTY.o $(BINARIES) #client/mTaskSymbols.h mkdir -p miTask-www diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 3606e66..71555a5 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -19,7 +19,7 @@ import Data.Monoid import Data.Functor import StdList from Data.Func import $ -from Text import class Text(concat,toUpperCase), instance Text String +from Text import class Text(lpad,concat,toUpperCase), instance Text String import qualified Text import Text.JSON @@ -35,6 +35,8 @@ import qualified Data.Map as DM import qualified Data.List as DL import Text.Encodings.Base64 +import Tasks.Examples + encode :: MTaskMSGSend -> String encode (MTTask to data) = "t" +++ tob +++ to16bit (size data) +++ data +++ "\n" where @@ -103,29 +105,13 @@ toByteVal b = {toChar $ consIndex{|*|} b} +++ (BCJmpF i) = {toChar i} _ = "" -//(>>) infixl 2 :: (ByteCode a p) (ByteCode b q) -> ByteCode b q -//(>>) m n = BC \s->(let (_, s1) = runBC m s in -// let (a, s2) = runBC n s1 -// in (a, {s2 & bytecode=(s2.BCState.bytecode ++ s1.BCState.bytecode)})) -// -//(<+->) infixr 1 -//(<+->) m n :== m >> tell n -// -//runBC (BC m) = m -// -//tell :: [BC] -> ByteCode a p | mTaskType a -//tell b = BC \s->(zero, {s & bytecode=b++s.bytecode}) -// -//fmp :: (a -> BC) (ByteCode a p) -> ByteCode a q -//fmp f b = BC \s->let (a, s`) = runBC b s in (a, {s` & code=[f a:s`.code]}) - -instance toByteCode Bool where toByteCode b = if b "\x01" "\x00" +instance toByteCode Bool where toByteCode b = toByteCode $ if b 1 0 instance toByteCode Int where toByteCode n = {toChar $ n/256,toChar $ n rem 256} instance toByteCode Long where toByteCode (L n) = toByteCode n -instance toByteCode Char where toByteCode s = toString s +instance toByteCode Char where toByteCode c = toByteCode $ toInt c instance toByteCode String where toByteCode s = abort $ "Undef on toBytecode String" +++ s -instance toByteCode Button where toByteCode s = {toChar $ consIndex{|*|} s} -instance toByteCode UserLED where toByteCode s = {toChar $ consIndex{|*|} s} +instance toByteCode Button where toByteCode s = toByteCode $ consIndex{|*|} s +instance toByteCode UserLED where toByteCode s = toByteCode $ consIndex{|*|} s instance toByteCode MTaskInterval where toByteCode OneShot = toByteCode 0 //Intervals have the first bit 0 and the rest is a 15 bit unsigned int @@ -133,13 +119,13 @@ instance toByteCode MTaskInterval where //Intervals have the first bit 1 and the rest is a 15 bit unsigned int toByteCode (OnInterrupt i) = {toChar $ i/256 bitor 127, toChar $ i rem 256} -instance fromByteCode Bool where fromByteCode s = s == "\x01" +instance fromByteCode Bool where fromByteCode s = fromByteCode s == 1 instance fromByteCode Int where fromByteCode s = (toInt s.[0])*256 + toInt s.[1] instance fromByteCode Long where fromByteCode s = L $ fromByteCode s -instance fromByteCode Char where fromByteCode s = toChar s.[0] +instance fromByteCode Char where fromByteCode s = fromInt $ fromByteCode s instance fromByteCode String where fromByteCode s = abort $ "Undef on fromBytecode String" +++ s -instance fromByteCode Button where fromByteCode s = conses{|*|} !! toInt s.[0] -instance fromByteCode UserLED where fromByteCode s = conses{|*|} !! toInt s.[0] +instance fromByteCode Button where fromByteCode s = conses{|*|} !! fromByteCode s +instance fromByteCode UserLED where fromByteCode s = conses{|*|} !! fromByteCode s instance fromByteCode MTaskInterval where fromByteCode s @@ -264,11 +250,18 @@ 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 + 1 + consNum{|*|} x) +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] @@ -282,8 +275,15 @@ 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" $ map readable (map (implGotos gtmap) bc), s) += ('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}) = ( @@ -294,8 +294,9 @@ toSDSUpdate :: Int Int -> [MTaskMSGSend] toSDSUpdate i v = [MTUpd i (to16bit v)] //Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero -Start = let (bcs, st) = toReadableByteCode (unMain bc) zero - in (bcs, st.sdss) +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 -- 2.20.1