Make the type-class-like types implicit

gluon-lang · Feb 24, 2018 · 1c001b1 · 1c001b1
1 parent 99d796f
commit 1c001b1
Show file tree

Hide file tree

Showing 11 changed files with 96 additions and 40 deletions.
diff --git a/README.md b/README.md
@@ -86,7 +86,7 @@ let string = import! std.string
 // Since imports in gluon returns regular values we can load specific parts of a module using pattern matches.
 // This match in particular brings in the equality operator for the `Char` type (this is required in
 // the current version of gluon but will be fixed in the future).
-let { eq = { (==) } } = import! std.char
+let char = import! std.char
 
 let { (<>) } = prelude.make_Semigroup string.semigroup
 
@@ -339,3 +339,4 @@ This language takes its primary inspiration from [Lua][Lua], [Haskell][Haskell]
 [Haskell]: http://www.haskell.org
 [OCaml]: http://www.ocaml.org
 [Rust]: http://www.rust-lang.org
+st-lang.org
diff --git a/check/Cargo.toml b/check/Cargo.toml
@@ -25,6 +25,8 @@ gluon_base = { path = "../base", version = "0.7.1" } # GLUON
 gluon_parser = { path = "../parser", version = "0.7.1", optional = true } # GLUON
 
 [dev-dependencies]
+gluon_format = { path = "../format", version = "0.7.0" } # GLUON
+
 collect-mac = "0.1.0"
 pretty_assertions = "0.4"
 

diff --git a/check/src/unify_type.rs b/check/src/unify_type.rs
@@ -334,36 +334,47 @@ where
             &Type::Function(r_arg_type, ref r_arg, ref r_ret),
         ) => {
             // If arg types are not the same, fallback to explicit
-            let arg_type = if l_arg_type == r_arg_type {
-                l_arg_type
+            if l_arg_type == r_arg_type {
+                let arg = unifier.try_match(l_arg, r_arg);
+                let ret = unifier.try_match(l_ret, r_ret);
+                Ok(merge::merge(l_arg, arg, l_ret, ret, |arg, ret| {
+                    ArcType::from(Type::Function(l_arg_type, arg, ret))
+                }))
             } else {
-                ArgType::Explicit
-            };
-            let arg = unifier.try_match(l_arg, r_arg);
-            let ret = unifier.try_match(l_ret, r_ret);
-            Ok(merge::merge(l_arg, arg, l_ret, ret, |arg, ret| {
-                ArcType::from(Type::Function(arg_type, arg, ret))
-            }))
+                if l_arg_type == ArgType::Implicit {
+                    Ok(unifier.try_match(l_ret, actual))
+                } else {
+                    Ok(unifier.try_match(expected, r_ret))
+                }
+            }
         }
-        (&Type::Function(_, ref l_arg, ref l_ret), &Type::App(ref r, ref r_args)) => {
-            let l_args = collect![l_arg.clone(), l_ret.clone()];
-            Ok(unify_app(
-                unifier,
-                &Type::builtin(BuiltinType::Function),
-                &l_args,
-                r,
-                r_args,
-            ))
+        (&Type::Function(l_arg_type, ref l_arg, ref l_ret), &Type::App(ref r, ref r_args)) => {
+            if l_arg_type == ArgType::Implicit {
+                Ok(unifier.try_match(l_ret, actual))
+            } else {
+                let l_args = collect![l_arg.clone(), l_ret.clone()];
+                Ok(unify_app(
+                    unifier,
+                    &Type::builtin(BuiltinType::Function),
+                    &l_args,
+                    r,
+                    r_args,
+                ))
+            }
         }
-        (&Type::App(ref l, ref l_args), &Type::Function(_, ref r_arg, ref r_ret)) => {
-            let r_args = collect![r_arg.clone(), r_ret.clone()];
-            Ok(unify_app(
-                unifier,
-                l,
-                l_args,
-                &Type::builtin(BuiltinType::Function),
-                &r_args,
-            ))
+        (&Type::App(ref l, ref l_args), &Type::Function(r_arg_type, ref r_arg, ref r_ret)) => {
+            if r_arg_type == ArgType::Implicit {
+                Ok(unifier.try_match(expected, r_ret))
+            } else {
+                let r_args = collect![r_arg.clone(), r_ret.clone()];
+                Ok(unify_app(
+                    unifier,
+                    l,
+                    l_args,
+                    &Type::builtin(BuiltinType::Function),
+                    &r_args,
+                ))
+            }
         }
         (&Type::App(ref l, ref l_args), &Type::App(ref r, ref r_args)) => {
             Ok(unify_app(unifier, l, l_args, r, r_args))

diff --git a/check/tests/implicits.rs b/check/tests/implicits.rs
@@ -152,3 +152,44 @@ f Test
     );
     assert_eq!(result, Ok(test));
 }
+
+#[test]
+fn implicit_as_function_argument() {
+    let _ = ::env_logger::init();
+    let text = r#"
+let (==) eq l r: [a -> a -> Bool] -> a -> a -> Bool = eq l r
+/// @implicit
+let eq_int l r : Int -> Int -> Bool = True
+/// @implicit
+let eq_string l r : String -> String -> Bool = True
+
+let f eq l r : (a -> a -> Bool) -> a -> a -> Bool = eq l r
+f (==) 1 2
+"#;
+    let (mut expr, result) = support::typecheck_expr(text);
+
+    assert!(result.is_ok(), "{}", result.unwrap_err());
+
+    loop {
+        match expr.value {
+            ast::Expr::LetBindings(_, body) => {
+                expr = *body;
+            }
+            _ => match expr.value {
+                ast::Expr::App { ref args, .. } if args.len() == 3 => {
+                    assert_eq!(args.len(), 3);
+                    match args[0].value {
+                        ast::Expr::App {
+                            args: ref args_eq, ..
+                        } => {
+                            assert_eq!(args_eq.len(), 1);
+                        }
+                        _ => panic!(),
+                    }
+                    break;
+                }
+                _ => assert!(false),
+            },
+        }
+    }
+}
diff --git a/examples/24.glu b/examples/24.glu
@@ -37,7 +37,7 @@ let string = import! std.string
 // Since imports in gluon returns regular values we can load specific parts of a module using pattern matches.
 // This match in particular brings in the equality operator for the `Char` type (this is required in
 // the current version of gluon but will be fixed in the future).
-let { eq = { (==) } } = import! std.char
+let char = import! std.char
 
 let { (<>) } = prelude.make_Semigroup string.semigroup
 

diff --git a/examples/lisp/lisp.glu b/examples/lisp/lisp.glu
@@ -3,7 +3,6 @@ let { Functor, Applicative, Monad } = prelude
 let { id } = import! std.function
 
 let string = import! std.string
-let { (==) } = string.eq
 let { (<>) } = prelude.make_Semigroup string.semigroup
 
 let { Bool } = import! std.bool

diff --git a/src/lib.rs b/src/lib.rs
@@ -526,25 +526,20 @@ and { Num, Eq, Ord, Show, Functor, Monad } = __implicit_prelude
 and { Bool, not } = import! std.bool
 and { Option } = import! std.option
 
+let { (+), (-), (*), (/), (==), (/=) } = __implicit_prelude
+
 let __implicit_float = import! std.float
-let { (+), (-), (*), (/) } = __implicit_float.num
-and { (==) } = __implicit_float.eq
 
 let { (<), (<=), (>=), (>) } = __implicit_prelude.make_Ord __implicit_float.ord
 
 let __implicit_int = import! std.int
-let { (+), (-), (*), (/) } = __implicit_int.num
-and { (==) } = __implicit_int.eq
 let { (<), (<=), (>=), (>) } = __implicit_prelude.make_Ord __implicit_int.ord
 
 let __implicit_string = import! std.string
-and { eq = { (==) } } = __implicit_string
 let { (<), (<=), (>=), (>) } = __implicit_prelude.make_Ord __implicit_string.ord
 
 let { error } = import! std.prim
 
-let (/=) eq l r : [Eq a] -> a -> a -> Bool = not (eq.(==) l r)
-
 in ()
 "#;
 

diff --git a/std/parser.glu b/std/parser.glu
@@ -4,7 +4,6 @@ let { id, flip } = import! std.function
 let { Bool } = import! std.bool
 let char = import! std.char
 let int = import! std.int
-let { (==) } = char.eq
 let { Result } = import! std.result
 let string = import! std.string
 let { (<>) } = prelude.make_Semigroup string.semigroup

diff --git a/std/prelude.glu b/std/prelude.glu
@@ -62,6 +62,9 @@ type Group a = {
 /// @implicit
 type Eq a = { (==) : a -> a -> Bool }
 
+let (==) eq : [Eq a] -> a -> a -> Bool = eq.(==)
+let (/=) eq l r : [Eq a] -> a -> a -> Bool = if (eq.(==) l r) then False else True
+
 /// `Ord a` defines an ordering on `a`
 /// @implicit
 type Ord a = { eq : Eq a, compare : a -> a -> Ordering }
@@ -108,6 +111,11 @@ type Num a = {
     negate : a -> a
 }
 
+let (+) num : [Num a] -> a -> a -> a = num.(+)
+let (-) num : [Num a] -> a -> a -> a = num.(-)
+let (*) num : [Num a] -> a -> a -> a = num.(*)
+let (/) num : [Num a] -> a -> a -> a = num.(/)
+
 /// @implicit
 type Category (cat : Type -> Type -> Type) = {
     id : forall a . cat a a,
@@ -337,6 +345,7 @@ let make_Traversable traversable : Traversable t -> _ =
     Group,
 
     Eq,
+    (==), (/=),
 
     Ord,
     make_Ord,
@@ -362,6 +371,7 @@ let make_Traversable traversable : Traversable t -> _ =
     make_Traversable,
 
     Num,
+    (+), (-), (*), (/),
 
     Show,
 }
diff --git a/tests/pass/map.glu b/tests/pass/map.glu
@@ -2,7 +2,6 @@ let prelude @ { Eq, Show } = import! std.prelude
 let int = import! std.int
 let option @ { Option } = import! std.option
 let string = import! std.string
-let { (==) } = string.eq
 let { (<>) } = prelude.make_Semigroup string.semigroup
 let { Test, run, writer, assert, assert_eq }  = import! std.test
 let map  = import! std.map

diff --git a/tests/pass/reference.glu b/tests/pass/reference.glu
@@ -1,6 +1,5 @@
 let { assert } = import! std.test
 let int = import! std.int
-let { (==) } = int.eq
 let { Bool } = import! std.bool
 let { ref, (<-), load } = import! std.reference