Add left and right application operators

std/prelude.glu

@@ -385,6 +385,10 @@ let applicative_Function: Applicative ((->) a) = {
     pure = \x -> \_ -> x
 }
 
+/// const `x` creates a function which always returns `x`
+let const : a -> b -> a =
+    applicative_Function.pure
+
 let applicative_Option: Applicative Option = {
     functor = functor_Option,
     apply = \f x ->
@@ -430,14 +434,12 @@ let make_Applicative app =
     let { functor, apply, pure } = app
 
     let (<*>) : app (a -> b) -> app a -> app b = apply
+    let (<*) l r : app a -> app b -> app a = functor.map const l <*> r
+    let (*>) l r : app a -> app b -> app b = functor.map (const id) l <*> r
     let map2 f a b : (a -> b -> c) -> app a -> app b -> app c = (functor.map f a) <*> b
     let map3 f a b c : (a -> b -> c -> d) -> app a -> app b -> app c -> app d = (functor.map f a) <*> b <*> c
 
-    { functor, apply, pure, (<*>), map2, map3 }
-
-/// const `x` creates a function which always returns `x`
-let const : a -> b -> a =
-    applicative_Function.pure
+    { functor, apply, pure, (<*>), (<*), (*>), map2, map3 }
 
 type Alternative f = {
     applicative : Applicative f,
@@ -511,19 +513,18 @@ let monad_IO: Monad IO = {
 
 let make_Monad m =
     let { applicative, flat_map } = m
-    let { pure } = applicative
+    let { (*>), pure } = make_Applicative applicative
     let { id } = category_Function
 
     let (=<<) : (a -> m b) -> m a -> m b = flat_map
     let (>>=) : m a -> (a -> m b) -> m b = flip flat_map
-    let (>>) l r : m a -> m b -> m b = l >>= \_ -> r
     let join mm : m (m a) -> m a = mm >>= id
     let forM_ xs f : List a -> (a -> m b) -> m () =
         match xs with
-            | Cons y ys -> f y >> forM_ ys f
+            | Cons y ys -> f y *> forM_ ys f
             | Nil -> pure ()
 
-    { applicative, flat_map, (=<<), (>>=), (>>), join, forM_ }
+    { applicative, flat_map, (=<<), (>>=), join, forM_ }
 
 /// `Show a` represents a conversion function from `a` to a readable string.
 type Show a = {
@@ -600,7 +601,7 @@ let show_Result: Show e -> Show t -> Show (Result e t) = \e t ->
     Functor,
     functor_Option, functor_Result, functor_List, functor_IO,
 
-    Applicative,
+    Applicative, make_Applicative,
     applicative_Option, applicative_Result, applicative_List, applicative_IO,
 
     Alternative, make_Alternative,

std/repl.glu

@@ -2,8 +2,8 @@ let prelude = import "std/prelude.glu"
 let map = import "std/map.glu"
 let string = import "std/string.glu"
 let { Map } = map
-let { pure } = prelude.applicative_IO
-let { (>>=), (>>), forM_ } = prelude.make_Monad prelude.monad_IO
+let { pure, (*>) } = prelude.make_Applicative prelude.applicative_IO
+let { (>>=), forM_ } = prelude.make_Monad prelude.monad_IO
 let { Eq, Result, Monoid } = prelude
 let { append = (++) } = string.monoid
 let { singleton, find, monoid, to_list } = map.make string.ord
@@ -38,29 +38,29 @@ let commands: Map String Cmd =
         singleton "q" { info = "Quit the REPL", action = \_ -> pure False }
             <> singleton "t" {
                 info = "Prints the type with an expression",
-                action = \arg -> repl_prim.type_of_expr arg >>= print_result >> pure True
+                action = \arg -> repl_prim.type_of_expr arg >>= print_result *> pure True
             }
             <> singleton "i" {
                 info = "Prints information about the given name",
-                action = \arg -> repl_prim.find_info arg >>= print_result >> pure True
+                action = \arg -> repl_prim.find_info arg >>= print_result *> pure True
             }
             <> singleton "k" {
                 info = "Prints the kind with the given type",
-                action = \arg -> repl_prim.find_kind arg >>= print_result >> pure True
+                action = \arg -> repl_prim.find_kind arg >>= print_result *> pure True
             }
             <> singleton "l" {
                 info = "Loads the file at 'folder/module.ext' and stores it at 'module'",
-                action = \arg -> load_file arg >>= io.print >> pure True
+                action = \arg -> load_file arg >>= io.print *> pure True
             }
             <> singleton "h" {
                 info = "Print this help",
                 action = \_ ->
-                    io.print "Available commands\n" >>
+                    io.print "Available commands\n" *>
                         forM_ (to_list (load commands)) (\cmd ->
                             //FIXME This type declaration should not be needed
                             let cmd: { key: String, value: Cmd } = cmd
                             io.print ("    :" ++ cmd.key ++ " " ++ cmd.value.info)
-                        ) >>
+                        ) *>
                         pure True
             }
     commands <- cmds
@@ -71,16 +71,16 @@ let do_command line: String -> IO Bool =
     let arg = if string.length line >= 3 then string.trim (string.slice line 3 (string.length line)) else ""
     match find cmd commands with
         | Some command -> command.action arg
-        | None -> io.print ("Unknown command '"  ++ cmd ++ "'") >> pure True
+        | None -> io.print ("Unknown command '"  ++ cmd ++ "'") *> pure True
 
 let store line: String -> IO Bool =
     let line = string.trim line
     match string.find line " " with
         | Some bind_end ->
             let binding = string.slice line 0 bind_end
             let expr = string.slice line bind_end (string.length line)
-            io.load_script binding expr >> pure True
-        | None -> io.print "Expected binding in definition" >> pure True
+            io.load_script binding expr *> pure True
+        | None -> io.print "Expected binding in definition" *> pure True
 
 let loop editor: Editor -> IO () =
     let run_line line =
@@ -93,7 +93,7 @@ let loop editor: Editor -> IO () =
         else
             io.catch (io.run_expr line) pure
                 >>= io.print
-                >> pure True
+                *> pure True
 
     rustyline.readline editor "> " >>= \line_opt ->
         match line_opt with
@@ -103,6 +103,6 @@ let loop editor: Editor -> IO () =
 
 let run x: () -> IO () =
     io.print "gluon (:h for help, :q to quit)"
-        >> loop (rustyline.new_editor ())
+        *> loop (rustyline.new_editor ())
 
 run

tests/pass/alternative.hs

@@ -1,6 +1,6 @@
 let { run, writer, assert_eq } = import "std/test.glu"
 let prelude = import "std/prelude.glu"
-let { (>>) } = prelude.make_Monad writer.monad
+let { (*>) } = prelude.make_Applicative writer.applicative
 
 let test_alt show eq alt =
     let { (<|>), or, empty, many, some } = prelude.make_Alternative alt
@@ -9,10 +9,10 @@ let test_alt show eq alt =
     let assert =
             assert_eq (show prelude.show_Int) (eq prelude.eq_Int)
 
-    assert empty empty >>
-        assert (empty <|> pure 1) (pure 1) >>
-        assert (empty <|> empty) empty >>
-        assert (empty <|> empty <|> pure 10) (pure 10)
+    assert empty empty
+        *> assert (empty <|> pure 1) (pure 1)
+        *> assert (empty <|> empty) empty
+        *> assert (empty <|> empty <|> pure 10) (pure 10)
 
 test_alt prelude.show_Option prelude.eq_Option prelude.alternative_Option
-    >> test_alt prelude.show_List prelude.eq_List prelude.alternative_List
+    *> test_alt prelude.show_List prelude.eq_List prelude.alternative_List

tests/pass/arithmetic.hs

@@ -1,16 +1,16 @@
 let { run, writer, assert, assert_ieq, assert_feq } = import "std/test.glu"
 let prelude = import "std/prelude.glu"
 let { Num } = prelude
-let { (>>) } = prelude.make_Monad writer.monad
+let { (*>) } = prelude.make_Applicative writer.applicative
 
 let int_tests =
     let { (+), (-), (*) } = prelude.num_Int
-    assert_ieq 2 2 >>
-        assert_ieq 12 (10 + 2) >>
-        assert_ieq 123 (50 * 2 + 9 * 3 - 4)
+    assert_ieq 2 2
+        *> assert_ieq 12 (10 + 2)
+        *> assert_ieq 123 (50 * 2 + 9 * 3 - 4)
 
 let float_tests =
     let { (+), (-), (*) } = prelude.num_Float
     assert_feq 91.0 (50.0 * 2.0 - 3.0 * 3.0)
 
-int_tests >> float_tests
+int_tests *> float_tests

tests/pass/channel.hs

@@ -1,6 +1,6 @@
 let { run, writer, assert_eq } = import "std/test.glu"
 let prelude = import "std/prelude.glu"
-let { (>>) } = prelude.make_Monad writer.monad
+let { (*>) } = prelude.make_Applicative writer.applicative
 
 let assert =
     assert_eq (prelude.show_Result prelude.show_Unit prelude.show_Int )
@@ -13,8 +13,8 @@ send sender 1
 send sender 2
 
 let tests =
-    assert (recv receiver) (Ok 0) >>
-        assert (recv receiver) (Ok 1) >>
-        assert (recv receiver) (Ok 2)
+    assert (recv receiver) (Ok 0)
+        *> assert (recv receiver) (Ok 1)
+        *> assert (recv receiver) (Ok 2)
 
 run tests

tests/pass/lazy.hs

@@ -1,12 +1,11 @@
 let { run, writer, assert_ieq } = import "std/test.glu"
 let prelude = import "std/prelude.glu"
 let { Num } = prelude
-let { pure } = writer.applicative
-let { (>>) } = prelude.make_Monad writer.monad
+let { (*>), pure } = prelude.make_Applicative writer.applicative
 let { (+), (-), (*) } = prelude.num_Int
 
 let l = lazy (\_ -> 123 + 57)
 
-assert_ieq (force (lazy \_ -> 2)) 2 >>
-    pure () >>
-    assert_ieq 180 (force l)
+assert_ieq (force (lazy \_ -> 2)) 2
+    *> pure ()
+    *> assert_ieq 180 (force l)

tests/pass/map.hs

@@ -5,7 +5,7 @@ let { (==) } = string.eq
 let { (<>) } = prelude.make_Monoid string.monoid
 let { Test, run, writer, assert, assert_eq } = import "std/test.glu"
 let map = import "std/map.glu"
-let { (>>) } = prelude.make_Monad writer.monad
+let { (*>) } = prelude.make_Applicative writer.applicative
 
 let show_Entry e =
     let { key, value } = e
@@ -28,15 +28,15 @@ let { (<>), empty } = prelude.make_Monoid monoid
 let test_map = singleton "test" 1 <> singleton "asd" 2 <> singleton "a" 3
 let tests =
     assert_opt (find "test" test_map) (Some 1)
-        >> assert_opt (find "asd" test_map) (Some 2)
-        >> assert_opt (find "b" test_map) None
-        >> assert_opt (find "test" (insert "test" 10 test_map)) (Some 10)
-        >> assert_opt (find "test" test_map) (Some 1)
-        >> assert_list (to_list test_map) (Cons { key = "a", value = 3 }
+        *> assert_opt (find "asd" test_map) (Some 2)
+        *> assert_opt (find "b" test_map) None
+        *> assert_opt (find "test" (insert "test" 10 test_map)) (Some 10)
+        *> assert_opt (find "test" test_map) (Some 1)
+        *> assert_list (to_list test_map) (Cons { key = "a", value = 3 }
                                           (Cons { key = "asd", value = 2 }
                                           (Cons { key = "test", value = 1 }
                                           Nil)))
-        >> assert_list (to_list (test_map <> empty)) (to_list test_map)
-        >> assert_list (to_list (empty <> test_map)) (to_list test_map)
+        *> assert_list (to_list (test_map <> empty)) (to_list test_map)
+        *> assert_list (to_list (empty <> test_map)) (to_list test_map)
 
 run tests

tests/pass/state.hs

@@ -3,17 +3,14 @@ let { Monad, Num } = prelude
 let { Test, run, writer, assert, assert_ieq, assert_feq, assert_seq } = import "std/test.glu"
 let state = import "std/state.glu"
 let { State, put, get, modify, runState, evalState, execState } = import "std/state.glu"
-let { (>>) = (>>>) } = prelude.make_Monad writer.monad
-let { (>>) } = prelude.make_Monad state.monad
+let { (*>) = (>>>) } = prelude.make_Applicative writer.applicative
+let { (*>) } = prelude.make_Applicative state.applicative
 let { (+), (-), (*) } = prelude.num_Int
 
 let tests =
-    assert_ieq (execState (modify (\x -> x + 2) >> modify (\x -> x * 4)) 0) 8
-        >>>
-        assert_ieq (evalState (modify (\x -> x + 2) >> get) 0) 2
-        >>>
-        assert_seq (evalState (put "hello" >> get) "") "hello"
-        >>>
-        assert_seq (runState (put "hello" >> get) "").value "hello"
+    assert_ieq (execState (modify (\x -> x + 2) *> modify (\x -> x * 4)) 0) 8
+        >>> assert_ieq (evalState (modify (\x -> x + 2) *> get) 0) 2
+        >>> assert_seq (evalState (put "hello" *> get) "") "hello"
+        >>> assert_seq (runState (put "hello" *> get) "").value "hello"
 
 run tests

tests/pass/stream.hs

@@ -4,11 +4,12 @@ let stream = import "std/stream.glu"
 let { Ord, Num, List, Option } = prelude
 let { (<) } = prelude.make_Ord prelude.ord_Int
 let { (+) } = prelude.num_Int
-let { (>>) } = prelude.make_Monad writer.monad
+let { (*>) } = prelude.make_Applicative writer.applicative
 
 let s = stream.from (\i -> if i < 5 then Some i else None)
 
 let assert_leq = assert_eq (prelude.show_List prelude.show_Int) (prelude.eq_List prelude.eq_Int)
 
-assert_ieq (stream.fold (+) 0 s) 10 >>
-    assert_leq (stream.fold (\h l -> Cons h l) Nil s) (Cons 4 (Cons 3 (Cons 2 (Cons 1 (Cons 0 Nil)))))
+assert_ieq (stream.fold (+) 0 s) 10
+    *> assert_leq (stream.fold (\h l -> Cons h l) Nil s)
+                  (Cons 4 (Cons 3 (Cons 2 (Cons 1 (Cons 0 Nil)))))

tests/pass/string.hs

@@ -3,50 +3,50 @@ let { run, writer, assert_eq, assert_seq, assert_ieq } = import "std/test.glu"
 let { Ord, Num, List, Option, Monoid } = prelude
 let { (<) } = prelude.make_Ord prelude.ord_Int
 let { (+) } = prelude.num_Int
-let { (>>) } = prelude.make_Monad writer.monad
+let { (*>) } = prelude.make_Applicative writer.applicative
 
 let string = import "std/string.glu"
 
 let assert_oieq = assert_eq (prelude.show_Option prelude.show_Int) (prelude.eq_Option prelude.eq_Int)
 let assert_beq = assert_eq prelude.show_Bool prelude.eq_Bool
 
 let slice_tests =
-    assert_seq (string.slice "ab" 0 1) "a" >>
-        assert_seq (string.slice "ab" 1 2) "b" >>
-        assert_seq (string.slice "abcd" 2 4) "cd"
+    assert_seq (string.slice "ab" 0 1) "a"
+        *> assert_seq (string.slice "ab" 1 2) "b"
+        *> assert_seq (string.slice "abcd" 2 4) "cd"
 
 let append_tests =
     let { (<>) } = prelude.make_Monoid string.monoid
-    assert_seq ("ab" <> "cd") "abcd" >>
-        assert_seq ("ab" <> "") "ab" >>
-        assert_seq ("" <> "cd") "cd" >>
-        assert_seq ("" <> "") ""
+    assert_seq ("ab" <> "cd") "abcd"
+        *> assert_seq ("ab" <> "") "ab"
+        *> assert_seq ("" <> "cd") "cd"
+        *> assert_seq ("" <> "") ""
 
 let find_tests =
-    assert_oieq (string.find "abcd1234" "ab") (Some 0) >>
-        assert_oieq (string.find "abcd1234" "b") (Some 1) >>
-        assert_oieq (string.find "abcd1234" "4") (Some 7) >>
-        assert_oieq (string.find "abcd1234" "xyz") None >>
-        assert_oieq (string.rfind "abcdabcd" "b") (Some 5) >>
-        assert_oieq (string.rfind "abcdabcd" "d") (Some 7) >>
-        assert_oieq (string.rfind "abcd1234" "xyz") None
+    assert_oieq (string.find "abcd1234" "ab") (Some 0)
+        *> assert_oieq (string.find "abcd1234" "b") (Some 1)
+        *> assert_oieq (string.find "abcd1234" "4") (Some 7)
+        *> assert_oieq (string.find "abcd1234" "xyz") None
+        *> assert_oieq (string.rfind "abcdabcd" "b") (Some 5)
+        *> assert_oieq (string.rfind "abcdabcd" "d") (Some 7)
+        *> assert_oieq (string.rfind "abcd1234" "xyz") None
 
 let starts_ends_tests =
-    assert_beq (string.starts_with "abcd1234" "ab") True >>
-        assert_beq (string.starts_with "abcd1234" "b") False >>
-        assert_beq (string.ends_with "abcd1234" "1234") True >>
-        assert_beq (string.ends_with "abcd1234" "4") True >>
-        assert_beq (string.ends_with "abcd1234" "ab") False
+    assert_beq (string.starts_with "abcd1234" "ab") True
+        *> assert_beq (string.starts_with "abcd1234" "b") False
+        *> assert_beq (string.ends_with "abcd1234" "1234") True
+        *> assert_beq (string.ends_with "abcd1234" "4") True
+        *> assert_beq (string.ends_with "abcd1234" "ab") False
 
 let trim_tests =
-    assert_seq (string.trim "ab") "ab" >>
-        assert_seq (string.trim " ab ") "ab" >>
-        assert_seq (string.trim "ab \t") "ab" >>
-        assert_seq (string.trim "\t ab") "ab" >>
-        assert_seq (string.trim_left " ab ") "ab " >>
-        assert_seq (string.trim_right " ab ") " ab"
+    assert_seq (string.trim "ab") "ab"
+        *> assert_seq (string.trim " ab ") "ab"
+        *> assert_seq (string.trim "ab \t") "ab"
+        *> assert_seq (string.trim "\t ab") "ab"
+        *> assert_seq (string.trim_left " ab ") "ab "
+        *> assert_seq (string.trim_right " ab ") " ab"
 
 let tests =
-    slice_tests >> append_tests >> find_tests
+    slice_tests *> append_tests *> find_tests
 
 run tests