From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 7 Dec 2015 19:42:24 +0000 (+0100)
Subject: 1 tot 3 af, alleen gadts nog
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=500fef18a33d3ed4a1ea120988b47376175cb801;p=ap2015.git

1 tot 3 af, alleen gadts nog
---

diff --git a/a12/mart/skeleton12.icl b/a12/mart/skeleton12.icl
index b03141e..72c38a5 100644
--- a/a12/mart/skeleton12.icl
+++ b/a12/mart/skeleton12.icl
@@ -1,32 +1,91 @@
 module skeleton12
 
-import Data.Maybe
-import Control.Monad
-import StdInt, StdString, StdBool
+from Text import class Text, instance Text String
+import Control.Applicative, Control.Monad
+import Data.Maybe, Data.Functor
+import StdInt, StdString, StdBool, StdList
+import qualified Text
 
 class arith x where
 	lit :: a -> x a | toString a
-	(+.) infixl 6 :: (x a) (x a) -> x a | + a // integer addition, Boolean OR
-	(*.) infixl 7 :: (x a) (x a) -> x a | * a // integer multiplication, Boolean AND
+	(+.) infixl 6 :: (x a) (x a) -> x a | + a
+	(*.) infixl 7 :: (x a) (x a) -> x a | * a
 class store x where
-	read  :: (x Int)
+	read :: (x Int)
 	write :: (x Int) -> x Int
 class truth x where
 	(XOR) infixr 3 :: (x Bool) (x Bool) -> x Bool
-	-.    :: (x Bool) -> x Bool
+	-. :: (x Bool) -> x Bool
 class (=.=) infix 4 x :: (x a) (x a) -> x Bool | == a
 class except x where
 	throw :: (x a)
-	try   :: (x a) (x a) -> x a
+	try :: (x a) (x a) -> x a
 
 class aexpr x | arith, store, except, =.= x
 class bexpr x | arith, truth, except, =.= x
-class expr x  | aexpr, bexpr x
+class expr x | aexpr, bexpr x
 
+instance * Bool where (*) b1 b2 = b1 && b2
+instance + Bool where (+) b1 b2 = b1 || b2
+
+
+//Section 1: Showing expressions
+:: Show a = Show ([String] -> [String])
+instance arith Show where
+	lit x = Show \s.[toString x:s]
+	(+.) (Show x1) (Show x2) = Show \s.x1 ["+":x2 s]
+	(*.) (Show x1) (Show x2) = Show \s.x1 ["*":x2 s]
+instance store Show where
+	read = Show \s.["read":s]
+	write (Show x) = Show \s.["write (":x [")":s]]
+instance truth Show where
+	(XOR) (Show x1) (Show x2) = Show \s.x1 ["⊕":x2 s]
+	-. (Show x) = Show \s.["¬":x s]
+instance =.= Show where
+	(=.=) (Show x1) (Show x2) = Show \s.x1 ["=":x2 s]
+instance except Show where
+	throw = Show \s.["throw":s]
+	try (Show x1) (Show x2) = Show \s.["try (":x1 [") except (":x2 [")":s]]]
+
+show (Show f) = 'Text'.concat (f ["\n"])
+
+//Section 2: Evaluation
 :: Step a = Step (State -> (Maybe a, State))
 :: State :== Int
 
-/*seven :: e Int | aexpr e
+instance Functor Step where
+	fmap f (Step s) = Step \st.let (x, st`)=s st in (fmap f x, st`)
+instance Applicative Step where
+	pure s = Step \st.(pure s, st)
+	(<*>) x1 x2 = ap x1 x2
+instance Monad Step where
+	bind (Step s) f = Step \st.case s st of
+		(Just x, st`) = let (Step s`) = f x in s` st`
+		(_, st`) = (Nothing, st`)
+
+instance arith Step where
+	lit x = pure x
+	(+.) x1 x2 = (+) <$> x1 <*> x2
+	(*.) x1 x2 = (*) <$> x1 <*> x2
+instance store Step where
+	read = Step \st.(Just st, st)
+	write (Step x) = Step \st.case x st of
+		(Just v`, _) = (Just v`, v`)
+		(_, st) = (Nothing, st) 
+instance truth Step where
+	(XOR) x1 x2 = (\x.(\y.x && not y || not x && y)) <$> x1 <*> x2
+	-. x1 = (not) <$> x1
+instance =.= Step where
+	(=.=) x1 x2 = (==) <$> x1 <*> x2
+instance except Step where
+	throw = Step \st.(Nothing, st)
+	try (Step x1) (Step x2) = Step \st.case x1 st of
+		(Just v`, st`) = (Just v`, st)
+		(Nothing, st`) = x2 st`
+
+eval (Step f) = f 0
+
+seven :: e Int | aexpr e
 seven = lit 3 +. lit 4
 
 throw1 :: e Int | expr e
@@ -42,6 +101,20 @@ loge :: e Bool | expr e
 loge = lit True *. -. (lit True)
 
 comp :: e Bool | expr e
-comp = lit 1 =.= lit 2 XOR -. (-. (lit True))*/
+comp = lit 1 =.= lit 2 XOR -. (-. (lit True))
 
-Start = 0
+Start = (
+	(eval seven, show seven),
+	(eval throw1, show throw1),
+	(eval six, show six),
+	(eval try1, show try1),
+	(eval loge, show loge),
+	(eval comp, show comp))
+/*
+((Just 7),0),"3+4"),
+((Nothing,0),"3+throw"),
+(((Just 6),3),"write (3)+read"),
+(((Just 42),0),"try (3+throw) except (42)"),
+(((Just False),0),"True*¬True"),
+(((Just True),0),"1=2⊕¬¬True")
+*/
diff --git a/a12/mart/skeleton12.prj b/a12/mart/skeleton12.prj
index 794a601..983035a 100644
--- a/a12/mart/skeleton12.prj
+++ b/a12/mart/skeleton12.prj
@@ -447,6 +447,20 @@ OtherModules
 			ReadableABC:	False
 			ReuseUniqueNodes:	True
 			Fusion:	False
+	Module
+		Name:	Text
+		Dir:	{Application}/lib/iTasks-SDK/Dependencies/Platform/OS-Independent
+		Compiler
+			NeverMemoryProfile:	False
+			NeverTimeProfile:	False
+			StrictnessAnalysis:	True
+			ListTypes:	StrictExportTypes
+			ListAttributes:	True
+			Warnings:	True
+			Verbose:	True
+			ReadableABC:	False
+			ReuseUniqueNodes:	True
+			Fusion:	False
 	Module
 		Name:	_SystemDynamic
 		Dir:	{Application}/lib/iTasks-SDK/Patches/Dynamics