From d35da17fff1880bb6f861f1da016a59bdc6f088f Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 7 Nov 2018 09:40:05 +0100
Subject: [PATCH] a7

---
 afp/a7/a7.icl    | 92 ++++++++++++++++++++++++++++++++++++++++++++++++
 choose/Makefile  |  4 +++
 choose/test.icl  | 21 +++++++++++
 cleanup/test.icl | 10 ++++++
 4 files changed, 127 insertions(+)
 create mode 100644 afp/a7/a7.icl
 create mode 100644 choose/Makefile
 create mode 100644 choose/test.icl
 create mode 100644 cleanup/test.icl

diff --git a/afp/a7/a7.icl b/afp/a7/a7.icl
new file mode 100644
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
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
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
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
-- 
2.20.1