From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 23 Apr 2015 13:10:52 +0000 (+0200)
Subject: started with week2
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=caf697acd1ee77877b7cbe1c3895c47cd6c2df4c;p=fp1415.git

started with week2
---

diff --git a/fp2/week2/mart/Map.dcl b/fp2/week2/mart/Map.dcl
new file mode 100644
index 0000000..4848e1a
--- /dev/null
+++ b/fp2/week2/mart/Map.dcl
@@ -0,0 +1,10 @@
+definition module Map
+
+//import BinTree
+import StdMaybe
+
+class Map c :: (a -> b) (c a) -> c b
+
+instance Map []
+instance Map Maybe
+//instance Map Tree
diff --git a/fp2/week2/mart/Map.icl b/fp2/week2/mart/Map.icl
new file mode 100644
index 0000000..d248c66
--- /dev/null
+++ b/fp2/week2/mart/Map.icl
@@ -0,0 +1,19 @@
+implementation module Map
+
+//import BinTree
+import StdMaybe
+import StdList
+
+class Map c :: (a -> b) (c a) -> c b
+
+instance Map [] where 
+	Map f [] = []
+	Map f [x:xs] = [f x: Map f xs]
+
+instance Map Maybe where
+	Map f Nothing = Nothing
+	Map f (Just x) = Just (f x)
+
+//instance Map Tree  where
+//	Map f Leaf = Leaf
+//	Map f (Node x l r) = Node (f x) (mapTree f l) (mapTree f r)
diff --git a/fp2/week2/mart/Mappen.icl b/fp2/week2/mart/Mappen.icl
new file mode 100644
index 0000000..faca555
--- /dev/null
+++ b/fp2/week2/mart/Mappen.icl
@@ -0,0 +1,9 @@
+module Mappen
+
+import StdEnv
+import Map
+
+Start = (
+	Map ((+) 1) (Just 42), 
+	Map ((+) 1) [1..10])
+//Map ((+) 1) t7)
diff --git a/fp2/week2/mart/Random.dcl b/fp2/week2/mart/Random.dcl
new file mode 100644
index 0000000..47a7c18
--- /dev/null
+++ b/fp2/week2/mart/Random.dcl
@@ -0,0 +1,19 @@
+definition module Random
+
+ // Random number generator voor Linux gebruikers
+ // interface compatible met Random.dcl (helaas)
+ // -- mschool@science.ru.nl
+
+import StdFile
+
+:: RandomSeed 
+
+// nullRandomSeed generates a fixed RandomSeed
+nullRandomSeed :: RandomSeed
+
+// GetNewRandomSeed generates a good RandomSeed, using /dev/urandom
+getNewRandomSeed :: !*env -> (!RandomSeed, !*env) | FileSystem env
+
+// Given a RandomSeed, Random generates a random number and a new RandomSeed.
+random :: !RandomSeed -> .(!Int, !RandomSeed)
+
diff --git a/fp2/week2/mart/Random.icl b/fp2/week2/mart/Random.icl
new file mode 100644
index 0000000..b6e0768
--- /dev/null
+++ b/fp2/week2/mart/Random.icl
@@ -0,0 +1,20 @@
+implementation module Random
+
+import StdFile, StdList, StdMisc, StdArray, Random
+
+:: RandomSeed :== Int
+
+nullRandomSeed :: RandomSeed
+nullRandomSeed = 0
+
+getNewRandomSeed :: !*env -> (!RandomSeed, !*env) | FileSystem env
+getNewRandomSeed env
+# (ok, src, env) = sfopen "/dev/urandom" FReadData env
+| not ok => abort "could not open /dev/urandom"
+# (bytes, src)   = sfreads src 4
+  seed           = foldl (\x y->(x<<8)+toInt y) 0 [c \\ c<-:bytes]
+| otherwise => (seed, env)
+
+random :: !RandomSeed -> .(!Int, !RandomSeed)
+random seed = (seed>>16 bitand 0xFFFF, seed*0x08088405+1)
+
diff --git a/fp2/week2/mart/ReturnEnBind.icl b/fp2/week2/mart/ReturnEnBind.icl
new file mode 100644
index 0000000..6c3f8e4
--- /dev/null
+++ b/fp2/week2/mart/ReturnEnBind.icl
@@ -0,0 +1,19 @@
+module ReturnEnBind
+
+import StdEnv, Random
+
+Start = (r1, r2, r3, r4, nullRandomSeed, s1, s2, s3)
+	where
+		(r1, s1) = som2 nullRandomSeed
+		(r2, s2) = som2 s1
+		(r3, s3) = som2 s2
+		(r4, _) = som2 s3
+
+(bind1) infix 0 :: (St s a) (a -> (St s b)) -> St s b
+(bind1) f g = uncurry g o f
+
+som2 :: (RandomSeed -> (Int,RandomSeed))
+som2 = (\s -> random s) bind1 (\a -> random (snd a))
+
+seqList1 :: [St s a] -> St s [a]
+seqList1 ...
diff --git a/fp2/week2/mart/StdIOMonad.icl b/fp2/week2/mart/StdIOMonad.icl
new file mode 100644
index 0000000..7f112a7
--- /dev/null
+++ b/fp2/week2/mart/StdIOMonad.icl
@@ -0,0 +1,22 @@
+module StdIOMonad
+
+import StdEnv, StdMaybe, StdMonad, StdFile
+
+:: IO a = IO (*World -> *(a, *World))
+
+read :: *World -> (IO String, *World)
+read world
+# (io, world) = stdio world
+# (line, io) = freadline io
+# (ok, world) = fclose io
+| not ok = abort "Couldn't close console"
+| otherwise = line
+
+instance return IO where
+	return x = IO (\w = (x, w))
+
+instance >>= IO where
+	>>= (IO f) g = (IO f)
+
+Start :: *World -> (IO String, *World)
+Start world = read 
diff --git a/fp2/week2/mart/StdMonad.dcl b/fp2/week2/mart/StdMonad.dcl
new file mode 100644
index 0000000..cd1c654
--- /dev/null
+++ b/fp2/week2/mart/StdMonad.dcl
@@ -0,0 +1,8 @@
+definition module StdMonad
+
+class return        c :: a -> c a
+class (>>=) infix 0	c :: (c a) (a -> c b) -> c b
+class fail          c :: c a
+
+class Monad	        c | return, >>= c
+class MonadFail	    c | Monad, fail c
diff --git a/fp2/week2/mart/StdMonad.icl b/fp2/week2/mart/StdMonad.icl
new file mode 100644
index 0000000..db193ab
--- /dev/null
+++ b/fp2/week2/mart/StdMonad.icl
@@ -0,0 +1 @@
+implementation module StdMonad