summaryrefslogtreecommitdiff
path: root/assignment-4/student.icl
diff options
context:
space:
mode:
Diffstat (limited to 'assignment-4/student.icl')
-rw-r--r--assignment-4/student.icl324
1 files changed, 171 insertions, 153 deletions
diff --git a/assignment-4/student.icl b/assignment-4/student.icl
index 0356a04..96c01e0 100644
--- a/assignment-4/student.icl
+++ b/assignment-4/student.icl
@@ -1,153 +1,171 @@
-module student
-
-import StdEnv, StdMaybe, monad
-/*
- * Pieter Koopman, pieter@cs.ru.nl
- * Advanced Programming, week 4
- */
-
-// ---- an IO monad with maybe results --- //
-
-:: *State = {w :: *World, c :: *Maybe *File}
-:: IO a = IO (State -> *(Maybe a, State))
-
-open :: State -> State
-open {w, c=Nothing}
- # (console, w) = stdio w
- = {w = w, c = Just console}
-open s = s
-
-close :: State -> State
-close { w, c=Just f} = { w = snd (fclose f w), c = Nothing}
-close s = s
-
-unIO :: (IO a) -> State -> *(Maybe a, State)
-unIO (IO f) = f
-
-run :: (IO a) *World -> *World
-run m w = (close (snd (unIO m {w=w, c=Nothing}))).w
-
-// ---- reading from console --- //
-
-class read a :: IO a
-
-instance read String where
- read = IO r where
- r s
- #! {w,c=Just c} = open s
- (line, c) = freadline c
- s = rmNL line
- | size s > 0
- = (Just s,{w = w, c = Just c})
- #! c = c <<< "String must be not empty "
- (line, c) = freadline c
- s = rmNL line
- | size s > 0
- = (Just s, {w = w, c = Just c})
- = (Nothing, {w = w, c = Just c})
-
-instance read Int where
- read = IO r where
- r s
- #! {w,c=Just c} = open s
- (b,i,c) = freadi c
- | b
- = (Just i, {w = w, c = Just c})
- #! (_, c) = freadline c
- c = c <<< "An integer please "
- (b,i,c) = freadi c
- | b
- = (Just i, {w = w, c = Just c})
- #! (_, c) = freadline c
- = (Nothing, {w = w, c = Just c})
-
-write :: String -> IO String
-write mess = IO w where
- w s
- #! {w,c=Just c} = open s
- = (Just mess,{w=w,c=Just (c <<< mess)})
-
-// ---- make IO a monad --- //
-
-instance Functor IO where
- fmap f (IO g)
- = IO \s.case g s of
- (Just a, s) = (Just (f a),s)
- (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)
-
-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)
-
-instance fail IO where fail = IO \s.(Nothing,s)
-
-instance OrMonad IO where
- <|> (IO f) (IO g) =
- IO \s.case f s of
- (Nothing, s) = g s
- other = other
-
-// ---- reading a student record --- //
-
-Start w = run f2 w
-
-:: Student =
- { fname :: String
- , lname :: String
- , snum :: Int
- }
-
-instance toString Student where
- toString {fname,lname,snum} = "{Student|fname=" + fname + ",lname=" + lname + ",snum=" + toString snum + "}"
-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
-
-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)
-
-f2 :: IO String
-f2
- = ( write "Your first name please: "
- >>| read
- >>= \fname.write "Your last name please: "
- >>| read
- >>= \lname.write "Your student nmber please: "
- >>| read
- >>= \snum. rtrn {fname = rmNL fname, lname = rmNL lname, snum = snum}
- >>= write o toString)
- <|> write "failed to read a student"
-
-rmNL :: String -> String
-rmNL string
- # len = size string
- | len > 0 && string.[len-1] == '\n'
- = string % (0, len - 2)
- = string
+module student
+
+import StdEnv, StdMaybe, monad
+/*
+ * Pieter Koopman, pieter@cs.ru.nl
+ * Advanced Programming, week 4
+ */
+
+// ---- an IO monad with maybe results --- //
+
+:: *State = {w :: *World, c :: *Maybe *File}
+:: IO a = IO (State -> *(Maybe a, State))
+
+open :: State -> State
+open {w, c=Nothing}
+ # (console, w) = stdio w
+ = {w = w, c = Just console}
+open s = s
+
+close :: State -> State
+close { w, c=Just f} = { w = snd (fclose f w), c = Nothing}
+close s = s
+
+unIO :: (IO a) -> State -> *(Maybe a, State)
+unIO (IO f) = f
+
+run :: (IO a) *World -> *World
+run m w = (close (snd (unIO m {w=w, c=Nothing}))).w
+
+// ---- reading from console --- //
+
+class read a :: IO a
+
+instance read String where
+ read = IO r where
+ r s
+ #! {w,c=Just c} = open s
+ (line, c) = freadline c
+ s = rmNL line
+ | size s > 0
+ = (Just s,{w = w, c = Just c})
+ #! c = c <<< "String must be not empty "
+ (line, c) = freadline c
+ s = rmNL line
+ | size s > 0
+ = (Just s, {w = w, c = Just c})
+ = (Nothing, {w = w, c = Just c})
+
+instance read Int where
+ read = IO r where
+ r s
+ #! {w,c=Just c} = open s
+ (b,i,c) = freadi c
+ | b
+ = (Just i, {w = w, c = Just c})
+ #! (_, c) = freadline c
+ c = c <<< "An integer please "
+ (b,i,c) = freadi c
+ | b
+ = (Just i, {w = w, c = Just c})
+ #! (_, c) = freadline c
+ = (Nothing, {w = w, c = Just c})
+
+write :: String -> IO String
+write mess = IO w where
+ w s
+ #! {w,c=Just c} = open s
+ = (Just mess,{w=w,c=Just (c <<< mess)})
+
+// ---- make IO a monad --- //
+
+instance Functor IO where
+ fmap f (IO g)
+ = IO \s.case g s of
+ (Just a, s) = (Just (f a),s)
+ (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)
+
+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)
+
+instance fail IO where fail = IO \s.(Nothing,s)
+
+instance OrMonad IO where
+ <|> (IO f) (IO g) =
+ IO \s.case f s of
+ (Nothing, s) = g s
+ other = other
+
+// ---- reading a student record --- //
+
+Start w = run (f3 >>= write) w
+
+:: Student =
+ { fname :: String
+ , lname :: String
+ , snum :: Int
+ }
+
+instance toString Student where
+ toString {fname,lname,snum} = "{Student|fname=" + fname + ",lname=" + lname + ",snum=" + toString snum + "}"
+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
+
+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)
+
+f2 :: IO String
+f2
+ = ( write "Your first name please: "
+ >>| read
+ >>= \fname.write "Your last name please: "
+ >>| read
+ >>= \lname.write "Your student nmber please: "
+ >>| read
+ >>= \snum. rtrn {fname = rmNL fname, lname = rmNL lname, snum = snum}
+ >>= write o toString)
+ <|> write "failed to read a student"
+
+f3 :: IO String
+f3 =
+ ((\f l s -> (toString {fname=rmNL f, lname=rmNL l, snum=s}) +++ "\n") <$>
+ input "Your first name please: " <*>
+ input "Your last name please: " <*>
+ input "Your student number please: ")
+ <|> write "Failed to read a student.\n"
+where
+ input :: String -> IO a | read a
+ input s = write s *> read
+
+ // It would really be much easier if we would use Platform from the start in this course.
+ (*>) infixl 4 :: (f a) (f b) -> f b | Applicative f
+ (*>) fa fb = id <$ fa <*> fb
+
+ (<$) infixl 4 :: a (f b) -> f a | Functor f
+ (<$) x fa = fmap (const x) fa
+
+rmNL :: String -> String
+rmNL string
+ # len = size string
+ | len > 0 && string.[len-1] == '\n'
+ = string % (0, len - 2)
+ = string
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-17 04:40:52 +0000