From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 15 Dec 2016 14:07:06 +0000 (+0100)
Subject: started with bytecode compilation of sds
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=884b2d1f25a3839851a7257d0eae929999f512c0;p=mTask.git

started with bytecode compilation of sds
---

diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index b8e7d75..667f26b 100644
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -50,7 +50,8 @@ import mTask
 //:: ByteCode a p = BC [BC]
 //:: ByteCode a p = BC ((ReadWrite (ByteCode a Expr)) BCState -> ([BC], BCState))
 :: BCState = {
-		freshl :: [Int]
+		freshl :: [Int],
+		freshs :: [Int]
 	}
 
 class toByteCode a :: a -> [Char]
@@ -62,137 +63,3 @@ instance toByteCode Long
 instance toByteCode Button
 
 toByteVal :: BC -> [Char]
-//toReadableByteVal :: BC -> String
-
-//instance toCode Pin
-//instance toCode MTask
-//instance toCode ()
-//instance toCode Long
-//
-//class toCode a :: a -> String
-//instance toCode Bool
-//instance toCode Int
-//instance toCode Real
-//instance toCode Char
-//instance toCode String
-//instance toCode DigitalPin
-//instance toCode AnalogPin
-//
-//argType :: (((Code a p)->Code b q)->In ((Code a p)->Code b q) (Code c s)) -> a | type a
-//
-//class argTypes t :: ((t->Code b Expr)->In (t->Code b2 q) (Main (Code c s))) -> t
-//instance argTypes (Code a p) | showType a
-//instance argTypes (Code a p, Code b q) | showType a & showType b
-//instance argTypes (Code a p, Code b q, Code c r) | showType a & showType b & showType c
-//
-//instance toCode (SV t)
-//
-//instance arith Code
-//instance boolExpr Code
-//instance If Code Stmt Stmt Stmt
-//instance If Code e    Stmt Stmt
-//instance If Code Stmt e    Stmt
-//instance If Code x    y    Expr
-//instance IF Code
-//instance sds Code
-//
-//defCode :: ((Code t p) -> In t (Main (Code u q))) -> Main (Code u r) | type t
-//
-//var :: String (ReadWrite (Code v q)) CODE -> CODE
-//
-//instance assign Code
-//instance seq Code
-//instance step` Code
-//codeSteps :: [Step Code t] -> Code u p
-//optBreak :: Mode -> Code u p
-//
-//instance setDelay Code
-//instance mtask Code a | taskImp2 a & types a
-//instance mtasks Code a b | taskImp2 a & types a  & taskImp2 b & types b
-//
-//loopCode :: Int (Code a b) -> Code c d
-//
-//class taskImp2 a :: Int a -> ((Code Long p) a->Code MTask Expr, a) | /*long Code delay &*/ isExpr p
-//instance taskImp2 ()
-//instance taskImp2 (Code t p)
-//instance taskImp2 (Code a p, Code b q)
-//instance taskImp2 (Code a p, Code b q, Code c r)
-//instance taskImp2 (Code a p, Code b q, Code c r, Code d s)
-//
-//class taskImp a :: Int a -> (Int a->Code MTask Expr, a)
-//instance taskImp ()
-//instance taskImp (Code t p)
-//instance taskImp (Code a p, Code b q)
-//instance taskImp (Code a p, Code b q, Code c r)
-//instance taskImp (Code a p, Code b q, Code c r, Code d s)
-//
-//tasksMain :: Int Int ((a->Code MTask Expr,b->Code MTask Expr) -> In (a->Code c d,b->Code e f) (Main (Code g h))) -> Main (Code i j) | taskImp a & types a & taskImp b & types b
-//class types a :: a
-//instance types ()
-//instance types (Code a p) | typeSelector a & isExpr p
-//instance types (Code a p, Code b q) | typeSelector a & isExpr p & typeSelector b & isExpr q 
-//instance types (Code a p, Code b q, Code c r) | typeSelector a & isExpr p & typeSelector b & isExpr q & typeSelector c & isExpr r 
-//instance types (Code a p, Code b q, Code c r, Code d s) | typeSelector a & isExpr p & typeSelector b & isExpr q & typeSelector c & isExpr r & typeSelector d & isExpr s 
-//
-//codeMTaskBody :: (Code v w) (Code c d) -> Code e f
-//instance fun Code ()
-//instance fun Code (Code t p) | type, showType t & isExpr p
-//instance fun Code (Code a p, Code b q) | showType a & showType b
-//instance fun Code (Code a p, Code b q, Code c r) | showType a & showType b & showType c
-//instance output Code
-//instance pinMode Code
-//instance digitalIO Code
-//instance dIO Code
-//instance aIO Code
-//instance analogIO Code
-//instance noOp Code
-//
-//:: Code a p = C ((ReadWrite (Code a Expr)) CODE -> CODE)
-//:: CODE =
-//  { fresh   	:: Int
-//  , freshMTask :: Int
-//  , funs    	:: [String]
-//  , ifuns			:: Int
-//  , vars  	  :: [String]
-//  , ivars			:: Int
-//  , setup			:: [String]
-//  , isetup	  :: Int
-//  , loop  	  :: [String]
-//  , iloop			:: Int
-//  , includes  :: [String]
-//  , def   	  :: Def
-//  , mode  	  :: Mode
-//  , binds			:: [String]
-//  }
-//
-//unC :: (Code a p) -> ((ReadWrite (Code a Expr)) CODE -> CODE)
-//
-//:: Def = Var | Fun | Setup | Loop
-//:: Mode = /*MainMode |*/ NoReturn | Return String | SubExp | Assign String
-//
-//setMode :: Mode -> Code a p
-//getMode :: (Mode -> Code a p) -> Code a p
-//embed :: (Code a p) -> Code a p
-//(+.+) infixl 5 :: (Code a p) (Code b q) -> Code c r
-//fresh :: (Int -> (Code a p)) -> (Code a p)
-//freshMTask :: (Int -> (Code a p)) -> (Code a p)
-//setCode :: Def -> (Code a p)
-//getCode :: (Def -> Code a p) -> (Code a p)
-//brac :: (Code a p) -> Code b q
-//funBody :: (Code a p) -> Code b q
-//codeOp2 :: (Code a p) String (Code b q) -> Code c r
-//include :: String -> Code a b
-//argList :: [a] -> String | toCode a
-//c :: a -> Code b p | toCode a
-//indent :: Code a p
-//unindent :: Code a p
-//nl :: Code a p
-//setBinds :: [String] -> Code a p
-//addBinds :: String -> Code a p
-//getBinds :: ([String] -> Code a p) -> (Code a p)
-//
-//// ----- driver ----- //
-//
-//compile :: (Main (Code a p)) -> [String]
-//mkset :: [a] -> [a] | Eq a
-//newCode :: CODE
diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 56d19e6..993fa74 100644
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -112,15 +112,20 @@ withLabel :: (Int -> (ByteCode b q)) -> ByteCode b q
 withLabel f = BC \s->let [fresh:fs] = s.freshl
 	in runBC (f fresh) {s & freshl=fs}
 
-/*
+withSDS :: (Int -> (ByteCode b q)) -> ByteCode b q
+withSDS f = BC \s->let [fresh:fs] = s.freshs
+	in runBC (f fresh) {s & freshs=fs}
+
 instance sds ByteCode where
-	sds f = undef/*{main = 
-			let var = 42
-			    (v In body) = f var
-			in unMain body
-		}*/
+//	sds f = {main = withSDS \sds->
+//			let (v In body) = f sds
+//			in retrn [BCSdsStore sds]
+//		}
+	sds f = abort "undef on sds"
 	con f = undef
-*/
+
+instance assign ByteCode where
+	(=.) v e = e <++> v
 
 instance serial ByteCode where
 	serialAvailable = retrn [BCSerialAvail]
@@ -130,7 +135,7 @@ instance serial ByteCode where
 	serialParseInt = retrn [BCSerialParseInt]
 
 instance zero BCState where
-	zero = {freshl=[1..]}
+	zero = {freshl=[1..], freshs=[1..]}
 
 toRealByteCode :: (ByteCode a Expr) -> String
 toRealByteCode x
@@ -146,11 +151,17 @@ toReadableByteVal :: BC -> String
 toReadableByteVal a = printToString a
 
 
+//Start :: String
+//Start = toReadableByteCode bc
+//	where
+//		bc :: ByteCode Int Expr
+//		bc = (lit 36 +. lit 42) +. lit 44
+
 Start :: String
-Start = toReadableByteCode bc
+Start = toReadableByteCode $ unMain bc
 	where
-		bc :: ByteCode Int Expr
-		bc = (lit 36 +. lit 42) +. lit 44
+		bc :: Main (ByteCode Int Expr)
+		bc = sds \x=46 In {main = x =. x +. lit 31}
 
 //to16bit :: Int -> String
 //to16bit i = toString (toChar (i/265)) +++ toString (toChar (i rem 265))