From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 10 Nov 2016 11:26:40 +0000 (+0100)
Subject: add ports
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=8316870cacd21b19badf032f3b8189bdd54eb1e3;p=mTask.git

add ports
---

diff --git a/Makefile b/Makefile
index 28bd5d5..6ad7e16 100644
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,6 @@
 CLEAN_HOME?=/opt/clean
 CLM:=clm
-CLMFLAGS+=-dynamics -l -no-pie -h 200M -t -nt -lat
+override CLMFLAGS+=-dynamics -l -no-pie -h 200M -t -nt -lat
 CLMLIBS:=\
 	-I $(CLEAN_HOME)/lib/iTasks-SDK/Patches/Dynamics\
 	-I $(CLEAN_HOME)/lib/iTasks-SDK/Patches/Generics\
diff --git a/gCons.dcl b/gCons.dcl
index c43236a..72ab853 100644
--- a/gCons.dcl
+++ b/gCons.dcl
@@ -14,3 +14,6 @@ derive consName CONS of {gcd_name},UNIT,PAIR,EITHER,OBJECT,RECORD,FIELD,Int,Bool
 
 generic consIndex a :: a -> Int
 derive consIndex CONS of {gcd_index},UNIT,PAIR,EITHER,OBJECT,Int,Bool,Char,String
+
+generic conses a :: [a]
+derive conses CONS,UNIT,PAIR,EITHER,OBJECT,FIELD,RECORD,Int,Bool,Char,Real,String,(),{},{!},[],[! ],[ !],[!!]
diff --git a/gCons.icl b/gCons.icl
index 3446116..3f13a7d 100644
--- a/gCons.icl
+++ b/gCons.icl
@@ -7,7 +7,7 @@ implementation module gCons
 	ARDSL project
 */
 
-import StdEnv, StdGeneric
+import StdEnv, StdGeneric, GenBimap, _SystemStrictLists
 
 generic consName a :: a -> String
 consName{|CONS of {gcd_name}|} f x = gcd_name
@@ -35,3 +35,25 @@ consIndex{|Int|} i = i
 consIndex{|Bool|} b = if b 1 0
 consIndex{|Char|} c = toInt c
 consIndex{|String|} _ = 0
+
+generic conses a :: [a]
+conses{|CONS|} f = map CONS f
+conses{|UNIT|} = [UNIT]
+conses{|PAIR|} f g = []
+conses{|EITHER|} f g = map LEFT f ++ map RIGHT g
+conses{|OBJECT|} f = map OBJECT f
+conses{|RECORD|} f = map RECORD f
+conses{|FIELD|} f = map FIELD f
+conses{|Int|} = [0]
+conses{|Bool|} = [True]
+conses{|Char|} = ['\0']
+conses{|Real|} = [0.0]
+conses{|String|} = [""]
+conses{|[]|} _ = [[ ]]
+conses{|[!]|} _ = [[!]]
+conses{|[ !]|} _ = [[ !]]
+conses{|[!!]|} _ = [[!!]]
+conses{|{}|} _ = [{}]
+conses{|{!}|} _ = [{!}]
+conses{|()|} = [()]
+
diff --git a/int/.gitignore b/int/.gitignore
index 9162877..b5287f3 100644
--- a/int/.gitignore
+++ b/int/.gitignore
@@ -1,2 +1 @@
 int
-Makefile
diff --git a/int/Makefile b/int/Makefile
new file mode 100644
index 0000000..4539229
--- /dev/null
+++ b/int/Makefile
@@ -0,0 +1,6 @@
+CFLAGS:=-g -Wall -Wextra -Werror
+all: mTaskSymbols.h int
+
+mTaskSymbols.h: 
+	CLMFLAGS=-nr make -BC .. mTaskInterpret
+	../mTaskInterpret > $@
diff --git a/int/int.c b/int/int.c
index 71d3b4c..89dcd0d 100644
--- a/int/int.c
+++ b/int/int.c
@@ -19,7 +19,6 @@ int stack[STACKSIZE+1] = {0};
 
 int main(void)
 {
-	//
 	char c;
 	int pl, sp, pc;
 
@@ -101,16 +100,25 @@ int main(void)
 			pc = pc + program[pc];
 			break;
 		case BCJmpT:
-			if (stack[sp])
-				pc = pc + program[pc];
-			else
-				pc++;
+			pc += stack[sp] ? program[pc] : 1;
 			break;
 		case BCJmpF:
-			if (stack[sp])
-				pc++;
-			else
-				pc = pc + program[pc];
+			pc += stack[sp] ? 1 : program[pc];
+			break;
+		case BCSERIALAVAIL:
+			printf("SerialAvailable()\n");
+			break;
+		case BCSERIALPRINT:
+			printf("SerialPrint()\n");
+			break;
+		case BCSERIALPRINTLN:
+			printf("SerialPrintln()\n");
+			break;
+		case BCSERIALREAD:
+			printf("SerialRead()\n");
+			break;
+		case BCSERIALPARSEINT:
+			printf("SerialParseInt()\n");
 			break;
 		default:
 			die("Unrecognized command: %X\n", program[--pc]);
diff --git a/int/mTaskSymbols.h b/int/mTaskSymbols.h
index d4b75e9..51a8d79 100644
--- a/int/mTaskSymbols.h
+++ b/int/mTaskSymbols.h
@@ -3,21 +3,25 @@
 #define BCNop 0
 #define BCPush 1
 #define BCPop 2
-#define BCNeg 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 BCNot 3
+#define BCAdd 4
+#define BCSub 5
+#define BCMul 6
+#define BCDiv 7
+#define BCAnd 8
+#define BCOr 9
+#define BCEq 10
+#define BCNeq 11
+#define BCLes 12
+#define BCGre 13
+#define BCLeq 14
+#define BCGeq 15
+#define BCJmp 16
+#define BCJmpT 17
+#define BCJmpF 18
+#define BCSERIALAVAIL 19
+#define BCSERIALPRINT 20
+#define BCSERIALPRINTLN 21
+#define BCSERIALREAD 22
+#define BCSERIALPARSEINT 23
 #endif
diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 885d52e..fa5d1d2 100644
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -28,6 +28,15 @@ import mTask
 	| BCJmp Int
 	| BCJmpT Int
 	| BCJmpF Int
+	//Serial
+	| BCSerialAvail
+	| BCSerialPrint
+	| BCSerialPrintln
+	| BCSerialRead
+	| BCSerialParseInt
+	//Pins
+	| BCAnalogRead AnalogPin
+	| BCAnalogWrite AnalogPin
 
 //:: ByteCode a p = BC (BCState -> ([BC], BCState))
 :: ByteCode a p = BC [BC]
diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index eaded85..d689b5f 100644
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -1,7 +1,7 @@
 implementation module mTaskInterpret
 
 //import iTasks
-import gdynamic, gCons, GenEq, StdMisc, StdArray
+import gdynamic, gCons, GenEq, StdMisc, StdArray, GenBimap
 import GenPrint
 import mTask
 
@@ -9,19 +9,20 @@ import StdFile
 import StdString
 
 from StdFunc import o
+import StdBool
 import StdTuple
 import Data.Tuple
 import StdList
 from Data.Func import $
-from Text import class Text(join), instance Text String
-
-
-
+from Text import class Text(join,toUpperCase), instance Text String
 
 toByteVal :: BC -> String
 toByteVal a = undef
 
-derive gPrint BC
+derive gPrint BC, AnalogPin
+derive consIndex BC
+derive consName BC
+derive conses BC, AnalogPin
 
 toReadableByteVal :: BC -> String
 toReadableByteVal a = printToString a
@@ -44,17 +45,28 @@ instance boolExpr ByteCode where
 	(<=.) x y = x <++> y <+-> [BCLeq]
 	(>=.) x y = x <++> y <+-> [BCGeq]
 
+instance analogIO ByteCode where
+	analogRead p = BC [BCAnalogRead p]
+	analogWrite p b = b <+-> [BCAnalogWrite p]
+
 instance If ByteCode Stmt Stmt Stmt where If b t e = BCIfStmt b t e
 instance If ByteCode Stmt e Stmt where If b t e = BCIfStmt b t e
 //instance If ByteCode Stmt Stmt e where If b t e = BCIfStmt b t e
-//instance If ByteCode Stmt x y where If b t e = BCIfStmt b t e 
-instance IF ByteCode where 
+instance If ByteCode x y Expr where If b t e = BCIfStmt b t e
+instance IF ByteCode where
 	IF b t e = BCIfStmt b t e
 	(?) b t = BCIfStmt b t $ BC []
-BCIfStmt b t e = b <+-> [BCJmpF $ length <$> t + 1] <++> t <+-> [BCJmp $ length <$> e] <++> e 
+BCIfStmt b t e = b <+-> [BCJmpF $ length <$> t + 1] <++> t
+	<+-> [BCJmp $ length <$> e] <++> e
 
 instance noOp ByteCode where noOp = BC []
 
+instance serial ByteCode where
+	serialAvailable = BC [BCSerialAvail]
+	serialPrint s = BC [BCSerialPrint]
+	serialPrintln s = BC [BCSerialPrintln]
+	serialRead = BC [BCSerialRead]
+	serialParseInt = BC [BCSerialParseInt]
 
 (<++>) infixl 7
 (<++>) (BC x) (BC y) = BC $ x ++ y
@@ -66,30 +78,28 @@ instance noOp ByteCode where noOp = BC []
 (<$>) infixl 9
 (<$>) f (BC x) = f x
 
-instance serial ByteCode where
-	serialAvailable = undef
-	serialPrint _ = undef
-	serialPrintln _ = undef
-	serialRead = undef
-	serialParseInt = undef
-
 instance zero BCState where
 	zero = {a=()}
 
 //Start :: ByteCode Int Expr
 //Start = (lit 36 +. lit 42) +. lit 84
-//
-derive consIndex BC
-derive consName BC
 
-Start w
-# (io, w) = stdio w
-# io = io <<< "#ifndef MTASK_H\n#define MTASK_H\n"
-# io = io <<< join "\n" ["#define " +++ consName{|*|} x +++ " " +++ toString (consIndex{|*|} x)\\x<-allBC]
-# (ok, w) = fclose (io <<< "\n#endif\n") w
-| not ok = abort "Couldn't close stdio"
-= w
-	where
-		allBC = [BCNop, BCPush "", BCPop, BCNeg, BCNot, BCAdd, BCSub, BCMul,
-			BCDiv, BCAnd, BCOr, BCEq, BCNeq, BCLes, BCGre, BCLeq, BCGeq,
-			BCJmp 0, BCJmpT 0, BCJmpF 0]
+(<+) 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