Type synonyms in typed expressions are now desugared - fixes #921

CHANGELOG.md

@@ -4,6 +4,8 @@ Change log for curry-frontend
 Under development
 =================
 
+ * Type synonyms in typed expressions are now desugared - fixes #921
+
   * Declaration of operator precedence is now optional in infix operator
     declarations
 

src/Transformations/Desugar.hs

@@ -76,9 +76,10 @@ import Curry.Base.Position hiding (first)
 import Curry.Syntax
 
 import Base.Expr
-import Base.CurryTypes (fromType)
+import Base.CurryTypes (toType, fromType)
 import Base.Messages (internalError)
 import Base.Types
+import Base.TypeSubst (expandAliasType)
 import Base.Typing
 import Base.Utils (mapAccumM, concatMapM)
 
@@ -425,7 +426,7 @@ dsExpr _ var@(Variable v)
   | otherwise              = return var
 dsExpr _ c@(Constructor _) = return c
 dsExpr p (Paren         e) = dsExpr p e
-dsExpr p (Typed      e ty) = flip Typed ty `liftM` dsExpr p e
+dsExpr p (Typed      e ty) = liftM2 Typed (dsExpr p e) (dsTypeExpr ty)
 dsExpr p (Tuple    pos es) =
   apply (Constructor $ tupleConstr es) `liftM` mapM (dsExpr p) es
   where tupleConstr es1 = addRef pos $ if null es1 then qUnitId else qTupleId (length es1)
@@ -519,6 +520,27 @@ dsExpr p (RecordUpdate fs rexpr)
     r <- recordFromField (fieldLabel (head fs))
     dsRecordUpdate p r rexpr (map field2Tuple fs)
 
+dsTypeExpr :: TypeExpr -> DsM TypeExpr
+dsTypeExpr ty = do
+  tcEnv <- getTyConsEnv
+  let expType = expandType tcEnv (toType [] ty)
+  return $ fromType expType
+
+expandType :: TCEnv -> Type -> Type
+expandType tcEnv (TypeConstructor tc tys) = case qualLookupTC tc tcEnv of
+  [DataType     tc' _  _] -> TypeConstructor tc' tys'
+  [RenamingType tc' _  _] -> TypeConstructor tc' tys'
+  [AliasType    _   _ ty] -> expandAliasType tys' ty
+  _ -> internalError $ "Desugar.expandType " ++ show tc
+  where tys' = map (expandType tcEnv) tys
+expandType _     tv@(TypeVariable      _) = tv
+expandType _     tc@(TypeConstrained _ _) = tc
+expandType tcEnv (TypeArrow      ty1 ty2) =
+  TypeArrow (expandType tcEnv ty1) (expandType tcEnv ty2)
+expandType _     ts@(TypeSkolem        _) = ts
+expandType tcEnv (TypeRecord       fs rv) =
+  TypeRecord (map (\ (l, ty) -> (l, expandType tcEnv ty)) fs) rv
+
 -- If an alternative in a case expression has boolean guards and all of
 -- these guards return 'False', the enclosing case expression does
 -- not fail but continues to match the remaining alternatives against the

test/TypedExpr.curry

-s :: String
-s = "hallo" :: String
+test1 :: String
+test1 = "hallo" :: String
+
+test2 = ["hallo","welt"] :: [String]
+
+test3 = (False, test2) :: (Bool, [String])
\ No newline at end of file