From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 14 Nov 2016 15:29:36 +0000 (+0100)
Subject: fix conses generic function
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=fe2e0f56c77de00d25686ab0b583a40595b35ab8;p=mTask.git

fix conses generic function
---

diff --git a/gCons.dcl b/gCons.dcl
index 72ab853..edd0a4a 100644
--- a/gCons.dcl
+++ b/gCons.dcl
@@ -15,5 +15,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,(),{},{!},[],[! ],[ !],[!!]
+conses :: [a] | gconses{|*|} a
+generic gconses a :: Bool -> [a]
+derive gconses CONS,UNIT,PAIR,EITHER,OBJECT,FIELD,RECORD,Int,Bool,Char,Real,String,(),{},{!},[],[! ],[ !],[!!]
diff --git a/gCons.icl b/gCons.icl
index 77e223b..6ed064d 100644
--- a/gCons.icl
+++ b/gCons.icl
@@ -38,24 +38,27 @@ consIndex{|String|} _ = 0
 
 import StdMisc, StdDebug
 
-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{|()|} = [()]
+conses :: [a] | gconses{|*|} a
+conses = gconses{|*|} True
 
+generic gconses a :: Bool -> [a]
+gconses{|CONS|} f True = map CONS (f False)
+gconses{|CONS|} f b = [CONS (hd (f b))]
+gconses{|UNIT|} _ = [UNIT]
+gconses{|PAIR|} f g _ = []
+gconses{|EITHER|} f g b = map LEFT (f b) ++ map RIGHT (g b)
+gconses{|OBJECT|} f b = map OBJECT (f b)
+gconses{|RECORD|} f b = map RECORD (f b)
+gconses{|FIELD|} f b = map FIELD (f b)
+gconses{|Int|} _ = [0]
+gconses{|Bool|} _ = [True]
+gconses{|Char|} _ = ['\0']
+gconses{|Real|} _ = [0.0]
+gconses{|String|} _ = [""]
+gconses{|[]|} _ _ = [[ ]]
+gconses{|[!]|} _ _ = [[!]]
+gconses{|[ !]|} _ _ = [[ !]]
+gconses{|[!!]|} _ _ = [[!!]]
+gconses{|{}|} _ _ = [{}]
+gconses{|{!}|} _ _ = [{!}]
+gconses{|()|} _ = [()]
diff --git a/int/mTaskSymbols.h b/int/mTaskSymbols.h
index f67721b..4aaef2a 100644
--- a/int/mTaskSymbols.h
+++ b/int/mTaskSymbols.h
@@ -1,31 +1,31 @@
 #ifndef MTASK_H
 #define MTASK_H
-#define BCNOP 0
-#define BCPUSH 1
-#define BCPOP 2
-#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
-#define BCANALOGREAD 24
-#define BCANALOGWRITE 25
-#define BCDIGITALREAD 26
-#define BCDIGITALWRITE 27
+#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
 #endif
diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 600f86c..6c9fd52 100644
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -22,7 +22,6 @@ toByteVal a = undef
 derive gPrint BC, AnalogPin
 derive consIndex BC
 derive consName BC
-derive conses BC, AnalogPin
 
 toReadableByteVal :: BC -> String
 toReadableByteVal a = printToString a
diff --git a/mTaskMakeSymbols.icl b/mTaskMakeSymbols.icl
index b18c546..15b78e4 100644
--- a/mTaskMakeSymbols.icl
+++ b/mTaskMakeSymbols.icl
@@ -19,7 +19,7 @@ from Text import class Text(join,toUpperCase), instance Text String
 
 derive consIndex BC
 derive consName BC
-derive conses BC, AnalogPin
+derive gconses BC, AnalogPin
 
 (<+) infixr 5 :: a b -> String | toString a & toString b
 (<+) a b = toString a +++ toString b
@@ -30,7 +30,7 @@ toDefine i b = "#define " <+ toUpperCase (consName{|*|} b) <+ " " <+ i
 Start w
 # (io, w) = stdio w
 # io = io <<< "#ifndef MTASK_H\n#define MTASK_H\n"
-# io = io <<< join "\n" (map (uncurry toDefine) (zip2 [0..] conses{|*|}))
+# io = io <<< join "\n" (map (uncurry toDefine) (zip2 [1..] conses))
 # (ok, w) = fclose (io <<< "\n#endif\n") w
 | not ok = abort "Couldn't close stdio"
 = w