From 242037ad9965c6e8ffef0ea6e3e24d5c0f3725d3 Mon Sep 17 00:00:00 2001
From: Finn Teegen <fte@informatik.uni-kiel.de>
Date: Wed, 27 Jun 2018 11:37:42 +0200
Subject: [PATCH] Fix bug with generated default implementations of nullary
 class methods

---
 CHANGELOG.md                      | 1 +
 src/Transformations/Dictionary.hs | 6 ++++--
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 426fbf96..5b88d76f 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,6 +5,7 @@ Version 1.0.2 (under development)
 =============
 
   * Fixed bug with wrong type of free variables in the intermediate language.
+  * Fixed bug with generated default implementations of nullary class methods.
 
 Version 1.0.1
 =============
diff --git a/src/Transformations/Dictionary.hs b/src/Transformations/Dictionary.hs
index e74c0e12..854cd410 100644
--- a/src/Transformations/Dictionary.hs
+++ b/src/Transformations/Dictionary.hs
@@ -413,10 +413,12 @@ defaultClassMethodDecl :: QualIdent -> Ident -> DTM (Decl PredType)
 defaultClassMethodDecl cls f = do
   pty@(PredType _ ty) <- getClassMethodType cls f
   augEnv <- getAugEnv
-  let pats = if isAugmented augEnv (qualifyLike cls f)
+  let augmented = isAugmented augEnv (qualifyLike cls f)
+      pats = if augmented
                then [ConstructorPattern predUnitType qUnitId []]
                else []
-  return $ funDecl NoPos pty f pats $ preludeError (instType ty) $
+      ty' = if augmented then arrowBase ty else ty
+  return $ funDecl NoPos pty f pats $ preludeError (instType ty') $
     "No instance or default method for class operation " ++ escName f
 
 getClassMethodType :: QualIdent -> Ident -> DTM PredType
-- 
GitLab