From 592dd55a70bcf3a159c32f07c698b3cc39b0d02a Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Mon, 2 Oct 2017 20:13:38 +0200
Subject: Cleanup bootstrap

---
 assignment-4/monad.dcl      |  35 +++++++++++++++
 assignment-4/monad.icl      |   8 ++++
 assignment-4/serialize4.icl | 101 ++++++++++++++++++++++----------------------
 assignment-4/student.icl    |  65 ++++++++++++++--------------
 4 files changed, 124 insertions(+), 85 deletions(-)
 create mode 100644 assignment-4/monad.dcl
 create mode 100644 assignment-4/monad.icl

(limited to 'assignment-4')

diff --git a/assignment-4/monad.dcl b/assignment-4/monad.dcl
new file mode 100644
index 0000000..6b0b2b5
--- /dev/null
+++ b/assignment-4/monad.dcl
@@ -0,0 +1,35 @@
+definition module monad
+
+/*
+	Pieter Koopman, pieter@cs.ru.nl
+	Advanced Programming, week 4
+*/
+
+import StdMisc
+
+class Functor f where
+	fmap :: (a->b) (f a) -> (f b)
+	(<$>) infixl 4 :: (a->b) (f a) -> (f b) | Functor f
+ 	(<$>) f x :== fmap f x
+
+class Applicative f | Functor f where
+	pure :: a -> f a
+	(<*>) infixl 4 :: (f (a->b)) (f a) -> f b
+
+class Monad m | Applicative m where
+	bind :: (m a) (a->m b) -> m b
+	(>>=) infixl 1 :: (m a) (a->m b) -> m b | Monad m
+	(>>=) a f :== bind a f
+	(>>|) infixl 1 :: (m a)    (m b) -> m b | Monad m
+	(>>|) a b :== a >>= \_.b
+	rtrn :: a -> m a | Monad m
+	rtrn a :== pure a
+
+class fail m | Applicative m where
+	fail :: m a
+	guard :: Bool -> m a | fail m
+	guard b :== if b (pure undef) fail
+
+class OrMonad m where
+	(<|>) infixl 0 :: (m a) (m a) -> m a
+
diff --git a/assignment-4/monad.icl b/assignment-4/monad.icl
new file mode 100644
index 0000000..fb9b491
--- /dev/null
+++ b/assignment-4/monad.icl
@@ -0,0 +1,8 @@
+implementation module monad
+
+/*
+	Pieter Koopman, pieter@cs.ru.nl
+	Advanced Programming, week 4
+*/
+
+
diff --git a/assignment-4/serialize4.icl b/assignment-4/serialize4.icl
index 10026eb..edbcc32 100644
--- a/assignment-4/serialize4.icl
+++ b/assignment-4/serialize4.icl
@@ -3,13 +3,13 @@ module serialize4
 import StdEnv, StdMaybe, monad
 
 /*
-	Pieter Koopman, pieter@cs.ru.nl
-	Advanced Programming, week 4, 2017
-	
-	import StdMaybe from Libraries/StdLib
-	use StdEnv or StdEnv 64
-	use Basic Values Only as conclose option for a nicer output.
-*/
+ * Pieter Koopman, pieter@cs.ru.nl
+ * Advanced Programming, week 4, 2017
+ *
+ * import StdMaybe from Libraries/StdLib
+ * use StdEnv or StdEnv 64
+ * use Basic Values Only as conclose option for a nicer output.
+ */
 
 // ---
 
@@ -63,14 +63,14 @@ pred f = fail
 
 :: Write a :== a -> Serialize String
 :: Read a  :== Serialize a
- 
+
 class serialize a | isUNIT a where
-  write :: a -> Serialize String
-  read  :: Serialize a
+	write :: a -> Serialize String
+	read  :: Serialize a
 
 class serialize1 t where
-  write1 :: (Write a) (t a) -> Serialize String
-  read1  :: (Read  a) -> Serialize (t a)
+	write1 :: (Write a) (t a) -> Serialize String
+	read1  :: (Read  a) -> Serialize (t a)
 
 class serializeCONS a where
 	writeCons :: (Write a) (CONS a) -> Serialize String
@@ -85,8 +85,8 @@ instance isUNIT UNIT where isUNIT _ = True
 instance isUNIT a    where isUNIT _ = False
 
 instance serialize Bool where
-  write b = fail
-  read = fail
+	write b = fail
+	read = fail
 
 instance serialize Int where
 	write i = fail
@@ -103,19 +103,19 @@ instance serialize UNIT where
 instance serializeCONS UNIT where
 	writeCons wa (CONS name a) = fail
 	readCons name ra = fail
- 
+
 instance serializeCONS a where
 	writeCons wa (CONS name a) = fail
 	readCons name ra =fail
- 
+
 instance serialize2 EITHER where
-  write2 wa wb (LEFT  a) = fail
-  write2 wa wb (RIGHT b) = fail
-  read2 ra rb = fail
+	write2 wa wb (LEFT  a) = fail
+	write2 wa wb (RIGHT b) = fail
+	read2 ra rb = fail
 
 instance serialize2 PAIR where
-  write2 wa wb (PAIR a b) = fail
-  read2 ra rb = fail
+	write2 wa wb (PAIR a b) = fail
+	read2 ra rb = fail
 
 // ---
 
@@ -198,35 +198,34 @@ instance serialize (a,b) | serialize a & serialize b where
 
 // ---
 
-Start = 
-  [test True
-  ,test False
-  ,test 0
-  ,test 123
-  ,test -36
-  ,test Head
-  ,test Tail
-  ,test [42]
-  ,test [0..4]
-  ,test [[True],[]]
-  ,test [[[1]],[[2],[3,4]],[[]]]
-  ,test [[True],[]]
-  ,test (Bin Leaf True Leaf)
-  ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin Leaf [4,5] Leaf))]
-  ,test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin (Bin Leaf [4,5] Leaf) [6,7] (Bin Leaf [8,9] Leaf)))]
-  ,test Head
-  ,test Tail
-  ,test (7,True)
-  ,test (Head,(7,[Tail]))
-  ,["End of the tests.\n"]
-  ]
+Start =
+	[ test True
+	, test False
+	, test 0
+	, test 123
+	, test -36
+	, test Head
+	, test Tail
+	, test [42]
+	, test [0..4]
+	, test [[True],[]]
+	, test [[[1]],[[2],[3,4]],[[]]]
+	, test [[True],[]]
+	, test (Bin Leaf True Leaf)
+	, test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin Leaf [4,5] Leaf))]
+	, test [Bin (Bin Leaf [1] Leaf) [2] (Bin Leaf [3] (Bin (Bin Leaf [4,5] Leaf) [6,7] (Bin Leaf [8,9] Leaf)))]
+	, test Head
+	, test Tail
+	, test (7,True)
+	, test (Head,(7,[Tail]))
+	, ["End of the tests.\n"]
+	]
 
 test :: a -> [String] | serialize, == a
-test a = toStrings (snd ((unS t) ser)) where
- t
- 	=   write a
-	>>| read
-	>>= \b. guard (a == b)
-	>>| write "Oke "
-	<|> write "Failure "
-
+test a = toStrings (snd ((unS t) ser))
+where
+	t = write a
+		>>| read
+		>>= \b. guard (a == b)
+		>>| write "Oke "
+		<|> write "Failure "
diff --git a/assignment-4/student.icl b/assignment-4/student.icl
index fad269e..0356a04 100644
--- a/assignment-4/student.icl
+++ b/assignment-4/student.icl
@@ -2,9 +2,9 @@ module student
 
 import StdEnv, StdMaybe, monad
 /*
-	Pieter Koopman, pieter@cs.ru.nl
-	Advanced Programming, week 4
-*/
+ * Pieter Koopman, pieter@cs.ru.nl
+ * Advanced Programming, week 4
+ */
 
 // ---- an IO monad with maybe results --- //
 
@@ -33,7 +33,7 @@ class read a :: IO a
 
 instance read String where
 	read = IO r where
-		r s 
+		r s
 		#! {w,c=Just c} = open s
 		   (line, c) = freadline c
 		   s = rmNL line
@@ -76,19 +76,17 @@ instance Functor IO where
 					(Nothing,s) = (Nothing  , s)
 
 instance Applicative IO where
-  pure a = IO \s.(Just a, s)
-  (<*>) (IO f) (IO g)
-   = IO \s.case f s of
-        (Just f,s) = case g s of
-  					(Just a,s) = (Just (f a),s)
-  					(n,     s) = (Nothing, s)
-        (n,     s) = (Nothing, s)
+	pure a = IO \s.(Just a, s)
+	(<*>) (IO f) (IO g) = IO \s.case f s of
+		(Just f,s) = case g s of
+			(Just a,s) = (Just (f a),s)
+			(n,     s) = (Nothing, s)
+		(n,     s) = (Nothing, s)
 
 instance Monad IO where
-	bind (IO f) g
-	 = IO \s.case f s of
-	 	(Just a, s) = unIO (g a) s
-	 	(n,      s) = (Nothing, s)
+	bind (IO f) g = IO \s.case f s of
+		(Just a, s) = unIO (g a) s
+		(n,      s) = (Nothing, s)
 
 instance fail IO where fail = IO \s.(Nothing,s)
 
@@ -114,29 +112,29 @@ instance + String where + s t = s +++ t
 
 f0 :: *World -> (Student, *World)
 f0 world = ({fname = rmNL fname, lname = rmNL lname, snum = snum}, world2) where
-	 (console1, world1) = stdio world
-	 console2 = console1 <<< "Your first name please: "
-	 (fname,console3) = freadline console2
-	 console4 = console3 <<< "Your last name please: "
-	 (lname,console5) = freadline console4
-	 console6 = console5 <<< "Your student nmber please: "
-	 (b1,snum,console7) = freadi console6
-	 (b2, world2) = fclose console7 world1
+	(console1, world1) = stdio world
+	console2 = console1 <<< "Your first name please: "
+	(fname,console3) = freadline console2
+	console4 = console3 <<< "Your last name please: "
+	(lname,console5) = freadline console4
+	console6 = console5 <<< "Your student nmber please: "
+	(b1,snum,console7) = freadi console6
+	(b2, world2) = fclose console7 world1
 
 f1 :: *World -> (Student, *World)
 f1 world
-  #! (console, world) = stdio world
-     console = console <<< "Your first name please: "
-     (fname,console) = freadline console
-     console = console <<< "Your last name please: "
-     (lname,console) = freadline console
-     console = console <<< "Your student nmber please: "
-     (b1,snum,console) = freadi console
-     (b2, world) = fclose console world
-  = ({fname = rmNL fname, lname = rmNL lname, snum = snum}, world)
+#! (console, world) = stdio world
+   console = console <<< "Your first name please: "
+   (fname,console) = freadline console
+   console = console <<< "Your last name please: "
+   (lname,console) = freadline console
+   console = console <<< "Your student nmber please: "
+   (b1,snum,console) = freadi console
+   (b2, world) = fclose console world
+= ({fname = rmNL fname, lname = rmNL lname, snum = snum}, world)
 
 f2 :: IO String
-f2 
+f2
 	= (        write "Your first name please: "
 	>>| read
 	>>= \fname.write "Your last name please: "
@@ -153,4 +151,3 @@ rmNL string
   | len > 0 && string.[len-1] == '\n'
     = string % (0, len - 2)
     = string
-
-- 
cgit v1.2.3