add ports

diff --git a/Makefile b/Makefile
index 28bd5d5..6ad7e16 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- a/int/.gitignore
+++ b/int/.gitignore
@@ -1,2 +1 @@
 int
-Makefile

diff --git a/int/Makefile b/int/Makefile
new file mode 100644 (file)
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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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