a7

diff --git a/afp/a7/a7.icl b/afp/a7/a7.icl
new file mode 100644 (file)
index 0000000..e3442ab
--- /dev/null
+++ b/afp/a7/a7.icl
@@ -0,0 +1,92 @@
+module a7
+
+import StdEnv
+
+import qualified Data.Map as Map
+
+import Data.Func
+import Data.Functor
+import Data.Maybe
+import Data.Tuple
+import Control.Applicative
+import Control.Monad
+
+:: Gram
+       = Lit String
+       | Idn
+       | Int
+       | Seq [Gram]
+       | Alt [Gram]
+       | Def Name Gram Gram
+       | Var Name
+:: Name :== String
+:: State = {input :: [String], store :: Store}
+:: Store :== 'Map'.Map Name Gram
+:: Parse a = Parse (State -> (Maybe a, State))
+:: TREE = LIT String | IDN String | INT Int | SEQ [TREE]
+
+runParse :: (Parse a) -> (State -> (Maybe a, State))
+runParse (Parse a) = a
+
+instance Functor Parse where fmap f a = Parse (appFst (fmap f) <$> runParse a)
+instance Applicative Parse
+where
+       pure a = Parse (tuple (pure a))
+       <*> fab fb = Parse \s->let
+                  (mab, (mb, s`)) = appSnd (runParse fb) (runParse fab s)
+               in (mab <*> mb, s`)
+instance Monad Parse
+where
+       bind ma a2mb = Parse \s->case runParse ma s of
+               (Just a, s`) = runParse (a2mb a) s`
+               (Nothing, s`) = (Nothing, s`)
+
+instance Alternative Parse
+where
+       empty = Parse (tuple Nothing)
+       <|> ma mb = Parse \s->case runParse ma s of
+               (Nothing, _) = runParse mb s
+               t = t
+
+next :: Parse String
+next = Parse \s->case s.input of
+       [] = (Nothing, s)
+       [i:is] = (Just i, {s & input=is})
+
+setGram :: Name Gram -> Parse Gram
+setGram n g = Parse \s->(Just g, {s & store='Map'.put n g s.store})
+
+getGram :: Name -> Parse Gram
+getGram n = Parse \s->('Map'.get n s.store, s)
+
+(?) infix 5 :: (a -> Bool) (Parse a) -> Parse a
+(?) p pa = pa >>= \a->if (p a) (pure a) empty
+
+parse :: Gram -> Parse TREE
+parse (Lit s) = LIT <$> ((==)s) ? next
+parse Idn = IDN <$> next
+parse Int = INT o toInt <$> (\s->toString (toInt s) == s) ? next
+parse (Seq gs) = SEQ <$> sequence (map parse gs)
+parse (Alt as) = foldr (<|>) empty (map parse as)
+parse (Def n g1 g2) = setGram n g1 *> parse g2
+parse (Var n) = join (parse <$> getGram n)
+parse _ = empty
+
+run :: Gram [String] -> Maybe TREE
+run g t = fst (runParse (parse g) {store='Map'.newMap,input=t})
+
+Start = (run listIntGram listIntInput, run arithGram arithInput)
+where
+       listIntInput = ["mylist","=","[","7",":","[","42",":","[]","]","]"]
+       arithInput = ["12","*","2","+","4","*","3","*","2","-","6"]
+
+listIntGram :: Gram
+listIntGram
+       = Def "list" (Alt [Lit "[]",Seq [Lit "[",Int,Lit ":",Var "list",Lit "]"]])
+       $ Seq [Idn,Lit "=",Var "list"]
+
+arithGram :: Gram
+arithGram
+       = Def "fac" (Alt [Seq [Int, Lit "*", Var "fac"], Int])
+       $ Def "exp" (Alt [Seq [Var "fac", Lit "+", Var "exp"], Var "fac"])
+       $ Var "exp"

diff --git a/choose/Makefile b/choose/Makefile
new file mode 100644 (file)
index 0000000..83f7745
--- /dev/null
+++ b/choose/Makefile
@@ -0,0 +1,4 @@
+all:
+       mkdir -p Clean\ System\ Files
+       gcc -c test.c -o test.o
+       clm -l test.o -dynamics -IL Dynamics test -o test

diff --git a/choose/test.icl b/choose/test.icl
new file mode 100644 (file)
index 0000000..442e3ed
--- /dev/null
+++ b/choose/test.icl
@@ -0,0 +1,21 @@
+module test
+
+import iTasks
+
+import iTasks.UI.Editor.Common
+
+derive class iTask P
+:: P = Z | S P
+
+Start w = doTasks (
+       enterInformation () [EnterUsing id e]
+       >&> viewSharedInformation "TaskValue" []
+       ) w
+where
+       e :: Editor P
+       e = bijectEditorValue (\i->(0,i)) snd
+               (containerc (chooseWithDropdown ["Z", "S"])
+                       [ (const Z, emptyEditor)
+                       , (const (S Z), bijectEditorValue S S e)
+                       ]
+               )

diff --git a/cleanup/test.icl b/cleanup/test.icl
new file mode 100644 (file)
index 0000000..4b78848
--- /dev/null
+++ b/cleanup/test.icl
@@ -0,0 +1,10 @@
+module test
+
+import iTasks, iTasks.Extensions.DateTime
+
+Start w = doTasks (
+       cleanupHook (traceValue "Cleanup") (viewInformation () [] "Task that cleans up")
+       >>= viewInformation "Stepped" []
+       >>| cleanupHook (waitForTimer 1 >>- \_->traceValue "Cleanup") (viewInformation () [] "Task that cleans up")
+       >>= viewInformation "Stepped" []
+       ) w