From 747271941a9e4f698e985d6cb58efe2994e60d61 Mon Sep 17 00:00:00 2001 From: bringert Date: Mon, 5 Dec 2005 16:44:56 +0000 Subject: Added tuple expressions and patterns. --- src/Transfer/SyntaxToCore.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) (limited to 'src/Transfer/SyntaxToCore.hs') diff --git a/src/Transfer/SyntaxToCore.hs b/src/Transfer/SyntaxToCore.hs index 10c4e36c2..ce2ac19c6 100644 --- a/src/Transfer/SyntaxToCore.hs +++ b/src/Transfer/SyntaxToCore.hs @@ -110,7 +110,7 @@ deriveDecls ds = liftM concat (mapM der ds) Just d -> d t k cs _ -> fail $ "Don't know how to derive " ++ f where (k,cs) = getDataType ts t - der d = return [d] + der d = return [d] type Derivator = Ident -> Exp -> [(Ident,Exp)] -> C [Decl] @@ -446,7 +446,9 @@ desugar = return . map f f :: Tree a -> Tree a f x = case x of PListCons p1 p2 -> pListCons <| p1 <| p2 - PList xs -> pList (map f [p | PListElem p <- xs]) + PEmptyList -> pList [] + PList xs -> pList [f p | CommaPattern p <- xs] + PTuple x xs -> mkPTuple [f p | CommaPattern p <- (x:xs)] GuardNo -> gtrue EIf exp0 exp1 exp2 -> ifBool <| exp0 <| exp1 <| exp2 EDo bs e -> mkDo (map f bs) (f e) @@ -469,7 +471,9 @@ desugar = return . map f EDiv exp0 exp1 -> overlBin "div" <| exp0 <| exp1 EMod exp0 exp1 -> overlBin "mod" <| exp0 <| exp1 ENeg exp0 -> overlUn "neg" <| exp0 + EEmptyList -> mkList [] EList exps -> mkList (map f exps) + ETuple exp1 exps -> mkETuple (map f (exp1:exps)) _ -> composOp f x where g <| x = g (f x) @@ -687,8 +691,10 @@ dataTypes ds = Map.fromList [ (i,(t,[(c,ct) | ConsDecl c ct <- cs])) | DataDecl getDataType :: DataTypes -> Ident -> (Exp,[(Ident,Exp)]) getDataType ts i = - fromMaybe (error $ "Data type " ++ printTree i ++ " not found") - (Map.lookup i ts) + case Map.lookup i ts of + Just t -> t + Nothing -> error $ "Data type " ++ printTree i ++ " not found." + ++ " Known types: " ++ show (Map.keysSet ts) -- -- * Utilities -- cgit v1.2.3