From 0089cf72c2a5ff347afda4fd9a9a29c3e2ea6896 Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 24 Nov 2016 15:28:16 +0100
Subject: [PATCH] started with sds

---
 int/mTaskSymbols.h | 53 +++++++++++++++++++++++-----------------------
 mTask.dcl          |  2 +-
 mTaskExamples.icl  |  5 ++++-
 mTaskInterpret.dcl |  9 ++++++++
 mTaskInterpret.icl | 34 +++++++++++++++++++++--------
 5 files changed, 66 insertions(+), 37 deletions(-)

diff --git a/int/mTaskSymbols.h b/int/mTaskSymbols.h
index 1e865fa..c16a8bb 100644
--- a/int/mTaskSymbols.h
+++ b/int/mTaskSymbols.h
@@ -3,30 +3,31 @@
 #define BCNOP 1
 #define BCPUSH 2
 #define BCPOP 3
-#define BCNOT 4
-#define BCADD 5
-#define BCSUB 6
-#define BCMUL 7
-#define BCDIV 8
-#define BCAND 9
-#define BCOR 10
-#define BCEQ 11
-#define BCNEQ 12
-#define BCLES 13
-#define BCGRE 14
-#define BCLEQ 15
-#define BCGEQ 16
-#define BCJMP 17
-#define BCJMPT 18
-#define BCJMPF 19
-#define BCSERIALAVAIL 20
-#define BCSERIALPRINT 21
-#define BCSERIALPRINTLN 22
-#define BCSERIALREAD 23
-#define BCSERIALPARSEINT 24
-#define BCANALOGREAD 25
-#define BCANALOGWRITE 26
-#define BCDIGITALREAD 27
-#define BCDIGITALWRITE 28
-#define BCTEST 29
+#define BCSDS 4
+#define BCNOT 5
+#define BCADD 6
+#define BCSUB 7
+#define BCMUL 8
+#define BCDIV 9
+#define BCAND 10
+#define BCOR 11
+#define BCEQ 12
+#define BCNEQ 13
+#define BCLES 14
+#define BCGRE 15
+#define BCLEQ 16
+#define BCGEQ 17
+#define BCJMP 18
+#define BCJMPT 19
+#define BCJMPF 20
+#define BCSERIALAVAIL 21
+#define BCSERIALPRINT 22
+#define BCSERIALPRINTLN 23
+#define BCSERIALREAD 24
+#define BCSERIALPARSEINT 25
+#define BCANALOGREAD 26
+#define BCANALOGWRITE 27
+#define BCDIGITALREAD 28
+#define BCDIGITALWRITE 29
+#define BCTEST 30
 #endif
diff --git a/mTask.dcl b/mTask.dcl
index 7380ebc..4ecf37d 100644
--- a/mTask.dcl
+++ b/mTask.dcl
@@ -61,7 +61,7 @@ instance == MTask
 unMain :: (Main x) -> x
 
 class arith v where
-  lit :: t -> v t Expr | toCode t
+  lit :: t -> v t Expr | toCode t & toByteCode t
   (+.) infixl 6 :: (v t p) (v t q) -> v t Expr | type, +, zero t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
   (-.) infixl 6 :: (v t p) (v t q) -> v t Expr | type, -, zero t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
   (*.) infixl 7 :: (v t p) (v t q) -> v t Expr | type, *, zero, one t & isExpr p & isExpr q //& toExpr2 p & toExpr2 q
diff --git a/mTaskExamples.icl b/mTaskExamples.icl
index dbe2ca7..d916951 100644
--- a/mTaskExamples.icl
+++ b/mTaskExamples.icl
@@ -6,7 +6,9 @@ import mTask
 
 Start =
     [["//mTaskTFP16_3 \n"]
-  ,["// --- p1 \n"]
+  ,["// --- p0 \n"]
+  ,compile p0
+    ,["// --- p1 \n"]
   ,compile p1
     ,["// --- p2 \n"]
   ,compile p2
@@ -206,6 +208,7 @@ count =
       count (sec 1) (n +. One)) In
     {main = count (sec 0) Zero}
 
+p0 :: (Main (Code Int Expr))
 p0 = sds \x = 6 In {main = x =. x *. lit 7}
 p1 = {main = lit 2 +. lit 4 >>=. \x. (x +. lit 1) *. x}
 p2 =
diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 2648cb9..a7b463d 100644
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -8,6 +8,7 @@ import mTask
 	= BCNop
 	| BCPush Int
 	| BCPop
+	| BCSds Int
 	//Unary ops
 	| BCNot
 	//Binary Int ops
@@ -48,6 +49,14 @@ import mTask
 		a::()
 	}
 
+class toByteCode a :: a -> [Char]
+instance toByteCode Int
+instance toByteCode Bool
+instance toByteCode Char
+instance toByteCode String
+instance toByteCode Long
+instance toByteCode Button
+
 toByteVal :: BC -> [Char]
 toReadableByteVal :: BC -> String
 
diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 886f463..275e8cc 100644
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -22,7 +22,6 @@ toByteVal b
 = [bt:case b of
 		(BCPush i) = [toChar i]
 		(BCAnalogRead i) = [toChar i]
-		(BCAnalogRead i) = [toChar i]
 		(BCAnalogWrite i) = [toChar i]
 		(BCDigitalRead i) = [toChar i]
 		(BCDigitalWrite i) = [toChar i]
@@ -33,19 +32,28 @@ toByteVal b
 	where
 		toByteCode b = toChar $ consIndex{|*|} b + 1
 
+instance toByteCode Bool where
+	toByteCode True = [toChar 1]
+	toByteCode False = [toChar 0]
+instance toByteCode Int where toByteCode n = map toChar [n/(2<<7),n rem 265]
+instance toByteCode Long where toByteCode (L n) = toByteCode n
+instance toByteCode Char where toByteCode c = [c]
+instance toByteCode String where toByteCode s = undef
+instance toByteCode Button where toByteCode s = [toChar $ consIndex{|*|} s]
+
 instance toChar Pin where
 	toChar (Digital p) = toChar $ consIndex{|*|} p + 1
 	toChar (Analog p) = toChar $ consIndex{|*|} p + 1
 
 derive gPrint BC, AnalogPin, Pin, DigitalPin
-derive consIndex BC, Pin
-derive consName BC, Pin
+derive consIndex BC, Pin, Button
+derive consName BC, Pin, Button
 
 toReadableByteVal :: BC -> String
 toReadableByteVal a = printToString a
 
 instance arith ByteCode where
-	lit x = BC [BCPush $ 1]
+	lit x = BC [BCPush 1]
 	(+.) x y = x <++> y <+-> [BCAdd]
 	(-.) x y = x <++> y <+-> [BCSub]
 	(*.) x y = x <++> y <+-> [BCMul]
@@ -82,6 +90,14 @@ BCIfStmt b t e = b <+-> [BCJmpF $ length <$> t + 1] <++> t
 
 instance noOp ByteCode where noOp = BC []
 
+instance sds ByteCode where
+	sds f = {main = 
+			let var = 42
+			    (v In body) = f var
+			in unMain body
+		}
+	con f = undef
+
 instance serial ByteCode where
 	serialAvailable = BC [BCSerialAvail]
 	serialPrint s = BC [BCSerialPrint]
@@ -112,12 +128,12 @@ to16bit :: Int -> String
 to16bit i = toString (toChar (i/265)) +++ toString (toChar (i rem 265))
 
 //Run test programma en pretty print
-Start :: String
-Start = "t" +++ to16bit (size b) +++ b
-//Start :: ByteCode Int Expr
-//Start = bc
+//Start :: String
+//Start = "t" +++ to16bit (size b) +++ b
+Start :: Main (ByteCode Int Expr)
+Start = bc
 	where
-		bc = If (lit True) (analogRead A1) (analogRead A0)
+		bc = sds \x=43 In {main = If (x ==. lit 42) (analogRead A1) (analogRead A0)}
 		b = toRealByteCode bc
 //Start :: ByteCode Int Expr
 //Start = If (lit True) (analogRead A1) (analogRead A0)
-- 
2.20.1