Remove resolved implementation from scope, closes #96

Makefile

@@ -42,6 +42,7 @@ endif
 
 .PHONY: clean
 clean:
+	stack clean
 	rm -rf build
 
 .PHONY: test

regression-test/src/protocols/chainedimpl.oden

@@ -0,0 +1,19 @@
+package protocols/chainedimpl/main
+
+protocol Foo(a) {
+  Foo : a -> a
+}
+
+protocol Bar(b) {
+  Bar : b -> b
+}
+
+impl Bar(int) {
+  Bar(n) = n
+}
+
+impl Foo(int) {
+  Foo(n) = Bar::Bar(n)
+}
+
+main() = println(Foo::Foo(1))

regression-test/src/protocols/chainedimpl.oden.expected.txt

@@ -0,0 +1 @@
+1

src/Oden/Compiler/Resolution.hs

@@ -110,7 +110,8 @@ resolveInExpr' = traverseExpr traversal
 
 
 resolveInDefinition' :: TypedDefinition -> Resolve TypedDefinition
-resolveInDefinition' = \case
+resolveInDefinition' =
+  \case
     Definition si name (scheme, expr) -> do
       expr' <- resolveInExpr' expr
       return (Definition si name (scheme, expr'))
@@ -122,7 +123,7 @@ resolveInDefinition' = \case
       return (ProtocolDefinition si name protocol)
     Implementation si implementation -> do
       resolved <- resolveInImplementation implementation
-      modify (Set.insert resolved)
+      modify (Set.insert resolved . Set.delete implementation)
       return (Implementation si resolved)
 
 

src/Oden/Infer.hs

@@ -226,11 +226,14 @@ generalize env expr = (scheme, expr)
   where quantifiers = map (TVarBinding $ Metadata Missing) (Set.toList $ ftv expr `Set.difference` ftv env)
         scheme = Forall (Metadata $ getSourceInfo expr) quantifiers (collectConstraints expr) (typeOf expr)
 
-instantiateMethod :: Protocol -> ProtocolMethod -> Infer (TypedMethodReference, Type)
-instantiateMethod (Protocol _ protocolName' param _) (ProtocolMethod _ methodName (Forall _ qs cs methodType)) = do
+instantiateMethod :: Metadata SourceInfo
+                  -> Protocol
+                  -> ProtocolMethod
+                  -> Infer (TypedMethodReference, Type)
+instantiateMethod constraintSi (Protocol _ protocolName' param _) (ProtocolMethod _ methodName (Forall _ qs cs methodType)) = do
   headTypeVariables <- mapM (freshTypeForFreeVar (getSourceInfo param)) (Set.toList (ftv param))
   subst <- Substitution.fromList <$> ((headTypeVariables ++) <$> mapM freshTypeForBinding qs)
-  let constraint = apply subst (ProtocolConstraint (Metadata Missing) protocolName' param)
+  let constraint = apply subst (ProtocolConstraint constraintSi protocolName' param)
       constrainedType = TConstrained (Set.insert constraint cs) (apply subst methodType)
   return (Typed.Unresolved protocolName' methodName constraint, constrainedType)
   where
@@ -426,7 +429,7 @@ infer = \case
   MethodReference si (NamedMethodReference protocol method) Untyped -> do
     protocolType' <- lookupProtocol si protocol
     method' <- findMethod (unwrap si) protocolType' method
-    (ref, methodType) <- instantiateMethod protocolType' method'
+    (ref, methodType) <- instantiateMethod si protocolType' method'
     return (MethodReference si ref methodType)
 
   ForeignFnApplication (Metadata si) _ _ _ ->

src/Oden/Output.hs

@@ -35,17 +35,21 @@ code settings d =
   escape settings [1, 34] <> contents <> escape settings [0]
   where contents = backtick <> d <> backtick
 
+instance Pretty SourceInfo where
+  pretty e =
+    case e of
+      SourceInfo pos ->
+        text (fileName pos)
+                <> colon <> int (line pos)
+                <> colon <> int (column pos)
+      Predefined -> empty
+      Missing    -> empty
+
 formatSourceInfo :: (MonadReader OutputSettings m, OdenOutput e) => e -> m Doc
 formatSourceInfo e =
   case sourceInfo e of
-    Just (SourceInfo pos) ->
-      return $ text (fileName pos)
-               <> colon <> int (line pos)
-               <> colon <> int (column pos)
-               <> colon
-    Just Predefined                         -> return empty
-    Just Missing                            -> return empty
-    Nothing                                 -> return empty
+    Just si -> return (pretty si <> colon <> space)
+    Nothing -> return empty
 
 formatOutputType :: (MonadReader OutputSettings m, OdenOutput e) => e -> m Doc
 formatOutputType e = do
@@ -68,7 +72,7 @@ format e = do
   t <- formatOutputType e
   wl <- wikiLink e
   return (vcat [
-      pos <+> t <+> header e s,
+      pos <> t <+> header e s,
       indent 2 (details e s),
       wl
     ])

src/Oden/Output/Compiler/Resolution.hs

@@ -1,11 +1,14 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase       #-}
 module Oden.Output.Compiler.Resolution where
 
 import           Text.PrettyPrint.Leijen
 
 import           Oden.Compiler.Resolution
+import           Oden.Core.ProtocolImplementation
+import           Oden.Metadata
 import           Oden.Output
-import           Oden.Pretty                    ()
+import           Oden.Pretty                      ()
 
 instance OdenOutput ResolutionError where
   outputType _ = Error
@@ -30,10 +33,17 @@ instance OdenOutput ResolutionError where
       NoMatchingImplementationInScope _ _ _ allImpls ->
         vcat (text "The following implementations are in scope:" : map pretty allImpls)
       MultipleMatchingImplementationsInScope _ impls ->
-        vcat (text "The following implementations matched:" : map pretty impls)
+        vcat (text "The following implementations matched:" : concatMap printImpl impls)
+        where
+        printImpl impl@(ProtocolImplementation (Metadata si) _ _ _) =
+          [ empty
+          , pretty impl
+          , text "defined at" <+> pretty si
+          , empty
+          ]
+
 
   sourceInfo =
     \case
       NoMatchingImplementationInScope si _ _ _    -> Just si
       MultipleMatchingImplementationsInScope si _ -> Just si
-

src/Oden/Predefined.hs

@@ -52,7 +52,7 @@ types = [
 universe :: TypedPackage
 universe =
   TypedPackage
-  (PackageDeclaration (Metadata Missing) [])
+  (PackageDeclaration (Metadata Predefined) [])
   []
   (concat [ map toProtocolDef protocols
           , map toForeignDef foreignFns

src/Oden/Pretty.hs

@@ -136,7 +136,7 @@ instance Pretty Poly.Protocol where
 
 instance (Pretty r, Pretty t, Pretty m) => Pretty (MethodImplementation (Expr r t m)) where
   pretty (MethodImplementation _ methodName expr) =
-    vcat [ pretty methodName <+> equals <+> pretty (typeOf expr)
+    vcat [ pretty methodName <+> colon <+> pretty (typeOf expr)
          , prettyDefinition methodName expr
          ]