Cleanup bootstrap

4 files changed, 124 insertions, 85 deletions

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

-