From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 21 Nov 2019 08:44:59 +0000 (+0100)
Subject: Merge branch 'master' of git.martlubbers.net:clean-tests
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=dfcca36a36a964320436b622d18bce909ed5a9fc;hp=0ca0e0086ac4e1b0be40f820d213fcfcb7deec20;p=clean-tests.git

Merge branch 'master' of git.martlubbers.net:clean-tests
---

diff --git a/.gitignore b/.gitignore
index c17b393..df867ba 100644
--- a/.gitignore
+++ b/.gitignore
@@ -13,3 +13,5 @@ test
 gopt
 afp/a[0-9]/a[0-9]
 afp/a1[0-9]/a1[0-9]
+
+struct
diff --git a/generic_constraints/test.icl b/generic_constraints/test.icl
new file mode 100644
index 0000000..758dd3b
--- /dev/null
+++ b/generic_constraints/test.icl
@@ -0,0 +1,17 @@
+module test
+
+import StdGeneric
+
+:: T a = T a & C a
+
+class C a where c :: a -> Bool
+instance C Int where c _ = True
+
+generic g a :: a -> Bool
+g{|Int|} _ = True
+g{|T|} ga (T a) = f a
+
+f :: a -> Bool
+f _ = True
+
+Start = g{|*|} (T 42)
diff --git a/stampedShare/test.icl b/stampedShare/test.icl
index 9b62ee7..d9e330e 100644
--- a/stampedShare/test.icl
+++ b/stampedShare/test.icl
@@ -1,5 +1,6 @@
 module test
 
+<<<<<<< HEAD
 import iTasks.Extensions.DateTime
 import System.Time
 import iTasks
@@ -13,3 +14,22 @@ t     =  viewSharedInformation [] sh
 	-&&- updateSharedInformation [] (dateTimeStampedShare sh)
 	-&&- viewSharedInformation [] sh`
 	-&&- updateSharedInformation [] (timespecStampedShare sh`)
+=======
+import iTasks.Internal.IWorld
+import System.Time
+import iTasks
+
+sh = sharedStore "bork2" ({Timespec|tv_sec=0,tv_nsec=0}, 42)
+
+Start w = doTasks t w
+
+t = viewSharedInformation [] sh
+	-&&- updateSharedInformation [] (
+			  sdsTranslate "" (\p->((), p))
+			(sdsStamp sh ticker (\x y->(x, y))))
+
+// This gives you 100% cpu because you get updates very fast
+//t = viewSharedInformation [] ticker
+
+ticker = sdsFocus {start={tv_sec=0,tv_nsec=0},interval={Timespec|tv_sec=0,tv_nsec=1000000}} iworldTimespec
+>>>>>>> 49f7dcc4c088dc816398a0c7854d75d7c2628f15
diff --git a/struct/struct.icl b/struct/struct.icl
new file mode 100644
index 0000000..f5cb346
--- /dev/null
+++ b/struct/struct.icl
@@ -0,0 +1,131 @@
+module struct
+
+import StdEnv
+import StdGeneric
+import StdDebug
+
+import Text
+
+import Data.Functor
+import Control.Applicative
+
+toEnumValue :: GenericConsDescriptor -> String
+toEnumValue gcd = gcd.gcd_type_def.gtd_name +++ "_" +++ gcd.gcd_name
+
+toEnumType :: GenericTypeDefDescriptor -> String
+toEnumType gtd = "enum cleanc_" +++ gtd.gtd_name
+
+class gGenerateC a | gToCType{|*|}, gToCValue{|*|}, gToCEnums{|*|} a
+
+:: CInfo a = {header :: String , toValue :: a -> String}
+
+generateCInfo :: CInfo a | gGenerateC a
+generateCInfo =
+	let
+		(CEnums enums) = cast res gToCEnums{|*|}
+		(SM types) = cast res gToCType{|*|}
+		res =
+			{ header = concat
+				[ join "\n" (removeDup (sort enums))
+				, "\n\n"
+				, concat (types {fresh=0,inRecord=False,indent=0} [])
+				, ";"
+				]
+			, toValue = \a->concat (gToCValue{|*|} a [])
+			}
+	in res
+where
+	cast :: (v a) -> ((w a) -> w a)
+	cast _ = id
+
+generic gToCType a :: Structmaker a
+:: Structmaker a = SM (SData [String] -> [String]) | StructMakerOnzin a
+:: SData = {indent :: Int, fresh :: Int, inRecord :: Bool}
+indent s c = [createArray s.indent '\t':c]
+show str s c = indent s [str:c]
+
+gToCType{|Int|}  = SM (show "uint64_t")
+gToCType{|Real|} = SM (show "double") 
+gToCType{|Bool|} = SM (show "bool")
+gToCType{|UNIT|} = SM \_->id
+gToCType{|EITHER|} (SM fl) (SM fr) = SM \s->fl s o fr s
+gToCType{|PAIR|} (SM fl) (SM fr)
+	 = SM \s c
+		| s.inRecord = fl s (fr s c)
+		= fl s [" f", toString s.fresh, ";\n":fr {s & fresh=s.fresh+1} c]
+gToCType{|OBJECT of gtd|} (SM f)
+	//Newtype
+	| gtd.gtd_num_conses == 0 = SM f
+	= SM \s c
+		//Enumeration (no data)
+		| and [gcd.gcd_arity == 0\\gcd<-gtd.gtd_conses] = indent s [toEnumType gtd:c]
+		//Regular ADTs
+		# s` = {s & indent = s.indent + 1}
+		= indent s ["struct clean_", gtd.gtd_name, " {\n":
+			indent s` [toEnumType gtd, " cons;\n":
+			indent s` ["union {\n":
+			f {s` & indent=s`.indent+1, inRecord=False} (indent s` ["} data;\n":
+			indent s ["}":c]])]]]
+gToCType{|CONS of gcd|} (SM f)
+	//No data field
+	| gcd.gcd_arity == 0 = SM \_->id
+	//Only one data field
+	| gcd.gcd_arity == 1 = SM \s c->f s [" ", gcd.gcd_name, ";\n":c]
+	= SM \s c->indent s ["struct {\n":f {s & indent=s.indent+1} [" f", toString (gcd.gcd_arity - 1), ";\n":indent s ["} ", gcd.gcd_name, ";\n":c]]]
+gToCType{|RECORD of grd|} (SM f)
+	= SM \s c->indent s ["struct clean_", grd.grd_name, " {\n": f {s & indent=s.indent+1, inRecord=True} (indent s ["}":c])]
+gToCType{|FIELD of gfd|} (SM f) = SM \s c->f s [" ", gfd.gfd_name,";\n":c]
+
+:: CEnums a = CEnums [String] | CEnumsOnzin a
+generic gToCEnums a :: CEnums a
+gToCEnums{|a|} = CEnums []
+gToCEnums{|UNIT|} = CEnums []
+gToCEnums{|EITHER|} (CEnums fl) (CEnums fr) = CEnums (fl ++ fr)
+gToCEnums{|PAIR|} (CEnums fl) (CEnums fr) = CEnums (fl ++ fr)
+gToCEnums{|OBJECT of gtd|} (CEnums f) = CEnums [concat [toEnumType gtd, " {", join ", " (map toEnumValue gtd.gtd_conses), "};"]:f]
+gToCEnums{|CONS|} (CEnums f) = CEnums f
+gToCEnums{|RECORD|} (CEnums f) = CEnums f
+gToCEnums{|FIELD|} (CEnums f) = CEnums f
+
+generic gToCValue a :: a [String] -> [String]
+gToCValue{|Int|} i c = [toString i:c]
+gToCValue{|Real|} r c = [toString r:c]
+gToCValue{|Bool|} b c = [if b "true" "false":c]
+gToCValue{|UNIT|} _ _ = []
+gToCValue{|EITHER|} fl _ (LEFT l) c = fl l c
+gToCValue{|EITHER|} _ fr (RIGHT l) c = fr l c
+gToCValue{|PAIR|} fl fr (PAIR l r) c = fl l [", ":fr r c]
+gToCValue{|OBJECT of gtd|} f (OBJECT a) c
+	//Newtype
+	| gtd.gtd_num_conses == 0 = f a c
+	| and [gcd.gcd_arity == 0\\gcd<-gtd.gtd_conses] = f a c
+	= ["{":f a ["}":c]]
+gToCValue{|CONS of gcd|} f (CONS a) c
+	//No data field
+	| gcd.gcd_arity == 0 = [toEnumValue gcd:c]
+	| gcd.gcd_arity == 1 = [" .cons=",toEnumValue gcd,", .data.",gcd.gcd_name,"=":f a c]
+	= [" .cons=",toEnumValue gcd,", .data.",gcd.gcd_name,"={":f a ["} ":c]]
+gToCValue{|RECORD|} f (RECORD a) c = ["{":f a ["}":c]]
+gToCValue{|FIELD of gfd|} f (FIELD a) c = [" .", gfd.gfd_name, "=": f a c]
+
+:: DHTDetails
+	= DHT Int Bool
+	| SHT Addr
+	| XXX Int Int Int
+	| XXY Int Int DHTType
+
+:: Addr =: Addr Int
+
+:: DHTType = DHT11 | DHT12 | DHT22
+
+derive class gGenerateC DHTDetails, DHTType, Addr, Record
+
+Start :: CInfo Record
+Start = generateCInfo
+
+:: Record =
+	{ field1 :: Int
+	, field2 :: Bool
+	, field3 :: DHTType
+	, field4 :: DHTDetails
+	}
diff --git a/test.icl b/test.icl
index 6459207..2076421 100644
--- a/test.icl
+++ b/test.icl
@@ -1,4 +1,5 @@
 module test
+<<<<<<< HEAD
 
 import StdEnv
 from Data.Func import $
@@ -16,3 +17,29 @@ runS (S s) = s
 Start world = flip runS world
 	$   (S time)
 	>>= \_->S (readDirectory "/home/mrl")
+=======
+import qualified Data.Map as DM
+import iTasks
+import Data.Func
+import Data.Tuple
+import StdEnv
+
+Start w = doTasksWithOptions (\a o->Ok $ flip tuple {o & autoLayout=True} $
+	(parallel
+		[(Embedded, tab "tab1")
+		,(Embedded, tab "tab2")
+		]
+		[ OnAction (Action "New") (always (Embedded, tab "New tab"))
+		, OnAction (Action " ") (always (Embedded, tab "New tab"))
+		, OnAction (Action "Close") (never (Embedded, \_->treturn ()))
+		, OnAction (Action "Dis no icon") (never (Embedded, \_->treturn ()))
+		, OnAction (Action "+") (always (Embedded, tab "New tab"))
+		]
+	<<@ ArrangeWithTabs True
+	<<@ ApplyLayout (setActionIcon ('DM'.put " " "new" 'DM'.newMap))
+	)) w
+
+tab title _ = tune (Title title)
+	$   viewInformation [] ()
+	>>* [OnAction (Action "Close") (always (treturn ()))]
+>>>>>>> 49f7dcc4c088dc816398a0c7854d75d7c2628f15