tests'
authorMart Lubbers <mart@martlubbers.net>
Mon, 19 Aug 2019 17:37:51 +0000 (19:37 +0200)
committerMart Lubbers <mart@martlubbers.net>
Mon, 19 Aug 2019 17:37:51 +0000 (19:37 +0200)
constructordynamic/test.icl [new file with mode: 0644]
stepparallel/test.icl [new file with mode: 0644]
test.icl
test.prt [new file with mode: 0644]

diff --git a/constructordynamic/test.icl b/constructordynamic/test.icl
new file mode 100644 (file)
index 0000000..1c6a567
--- /dev/null
@@ -0,0 +1,14 @@
+module test
+
+import StdEnv, StdMaybe
+
+Start :: (Maybe Int, Maybe (Maybe Int))
+Start = (id (dynamic 42), kid (dynamic (Just 42)))
+
+id :: Dynamic -> Maybe m | TC m
+id (m :: m^) = Just m
+id _ = Nothing
+
+kid :: Dynamic -> Maybe (m a) | TC (m a)
+kid (m :: (m a)^)) = Just m
+kid _ = Nothing
diff --git a/stepparallel/test.icl b/stepparallel/test.icl
new file mode 100644 (file)
index 0000000..b5253ef
--- /dev/null
@@ -0,0 +1,59 @@
+module test
+
+import StdMisc
+import iTasks
+import Data.Either
+import StdEnv
+import Data.Func
+
+Start w = flip doTasks w $
+       updateInformation () [] 42
+       >>* [OnAction (Action "Continue") (always (return 43))]
+
+(>>*) infixl 1// :: !(Task a) ![TaskCont a (Task b)] -> Task b | iTask a & iTask b
+(>>*) task steps :== step task (const Nothing) steps
+
+step :: !(Task a) ((Maybe a) -> Maybe b) [TaskCont a (Task b)] -> Task b | iTask a & iTask b
+step lhs lhsValFun conts
+       = parallel
+               [(Embedded, \stl->lhs @? \v->case v of
+                       NoValue = Value (Left Nothing) False
+                       (Value v s) = Value (Left (Just v)) s
+               )]
+               (map stepCont conts)
+               @? stepVal lhsValFun
+where
+       stepVal :: ((Maybe a) -> Maybe b) (TaskValue [(Int, TaskValue (Either (Maybe a) b))]) -> TaskValue b
+       stepVal tfun NoValue = NoValue
+       stepVal tfun (Value [(_, x):_] _) = case x of
+               //Not yet stepped:
+               Value (Left l) s = case tfun l of
+                       Nothing = NoValue
+                       Just v = Value v False
+               //Stepped but no value
+               NoValue = NoValue
+               Value (Right r) s = Value r s
+       stepVal _ _ = abort "cannot happen"
+
+       stepCont :: (TaskCont a (Task b)) -> TaskCont
+               [(Int, TaskValue (Either (Maybe a) b))]
+               (ParallelTaskType, ParallelTask (Either (Maybe a) b))
+       stepCont (OnValue f) = OnValue (transform f)
+       stepCont (OnAction a f) = OnAction a (transform f)
+       
+       transform f v
+               # v = case v of
+                       Value [(_, v)] _ = case v of
+                               NoValue = NoValue
+                               Value (Left (Just v)) s = Value v s
+                               Value _ = NoValue
+                       NoValue = NoValue
+               = case f v of
+                       Nothing = Nothing
+                       Just t = Just (Embedded, \stl->
+                               get (sdsFocus {onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False,includeValue=False,includeProgress=False,includeAttributes=False} stl)
+                               removeTask taskId stl
+                               >-| t @ Right)
+
+//     stepCont (OnException f) = OnException \e->(Embedded, \stl->e f @ Right)
+//     stepCont (OnAllExceptions b) = OnAllExceptions b
index e437b71..97f071a 100644 (file)
--- a/test.icl
+++ b/test.icl
@@ -5,7 +5,7 @@ import iTasks
 import iTasks.Extensions.DateTime
 import iTasks.UI.Layout.Minimal
 
-Start w = doTasksWithOptions opt p2 w
+Start w = doTasksWithOptions opt t2 w
 where
        t :: Task DateTime
        t = waitForTimer 7
diff --git a/test.prt b/test.prt
new file mode 100644 (file)
index 0000000..ffa9e0b
--- /dev/null
+++ b/test.prt
@@ -0,0 +1,52 @@
+Version: 1.5
+Global
+       ProjectRoot:    .
+       Target: StdEnv
+       Exec:   {Project}/test
+       ByteCode:       {Project}/test.bc
+       CodeGen
+               CheckStacks:    False
+               CheckIndexes:   True
+               OptimiseABC:    False
+               GenerateByteCode:       False
+       Application
+               HeapSize:       2097152
+               StackSize:      512000
+               ExtraMemory:    8192
+               IntialHeapSize: 204800
+               HeapSizeMultiplier:     4096
+               ShowExecutionTime:      False
+               ShowGC: False
+               ShowStackSize:  False
+               MarkingCollector:       False
+               DisableRTSFlags:        False
+               StandardRuntimeEnv:     True
+               Profile
+                       Memory: False
+                       MemoryMinimumHeapSize:  0
+                       Time:   False
+                       Stack:  False
+                       Dynamics:       False
+                       GenericFusion:  False
+                       DescExL:        False
+               Output
+                       Output: ShowConstructors
+                       Font:   Monaco
+                       FontSize:       9
+                       WriteStdErr:    False
+       Link
+               LinkMethod:     Static
+               GenerateRelocations:    False
+               GenerateSymbolTable:    False
+               GenerateLinkMap:        False
+               LinkResources:  False
+               ResourceSource: 
+               GenerateDLL:    False
+               ExportedNames:  
+               StripByteCode:  True
+               KeepByteCodeSymbols:    True
+               PrelinkByteCode:        False
+       Paths
+               Path:   {Project}
+       Precompile:     
+       Postlink: