From 7b20993869b26f08d2a445782d2a483215efbf8a Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Fri, 20 Dec 2013 16:41:02 -0800 Subject: [PATCH] Get rid of dependency on uniplate so AST does not need to derive Data or Typeable This is motivated by wanting to add things to the AST that cannot derive Data or Typeable --- Elm.cabal | 2 -- compiler/SourceSyntax/Declaration.hs | 2 -- compiler/SourceSyntax/Expression.hs | 9 ++++---- compiler/SourceSyntax/Literal.hs | 4 +--- compiler/SourceSyntax/Location.hs | 8 +++---- compiler/SourceSyntax/Module.hs | 4 +--- compiler/SourceSyntax/Pattern.hs | 4 +--- compiler/SourceSyntax/Type.hs | 4 +--- compiler/Transform/Check.hs | 34 +++++++++++++++++++++------- 9 files changed, 38 insertions(+), 33 deletions(-) diff --git a/Elm.cabal b/Elm.cabal index d8a6323..8da5c33 100644 --- a/Elm.cabal +++ b/Elm.cabal @@ -109,7 +109,6 @@ Library text, transformers >= 0.2, union-find, - uniplate, unordered-containers Executable elm @@ -188,7 +187,6 @@ Executable elm text, transformers >= 0.2, union-find, - uniplate, unordered-containers Executable elm-doc diff --git a/compiler/SourceSyntax/Declaration.hs b/compiler/SourceSyntax/Declaration.hs index 717300f..22ec074 100644 --- a/compiler/SourceSyntax/Declaration.hs +++ b/compiler/SourceSyntax/Declaration.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable #-} module SourceSyntax.Declaration where -import Data.Data import qualified SourceSyntax.Expression as Expr import SourceSyntax.Type import SourceSyntax.PrettyPrint diff --git a/compiler/SourceSyntax/Expression.hs b/compiler/SourceSyntax/Expression.hs index d9c60f6..c11e690 100644 --- a/compiler/SourceSyntax/Expression.hs +++ b/compiler/SourceSyntax/Expression.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable #-} module SourceSyntax.Expression where -import Data.Data import Data.List (intercalate) import SourceSyntax.PrettyPrint import Text.PrettyPrint as P @@ -30,12 +28,12 @@ data Expr t v | Modify (LExpr t v) [(String, LExpr t v)] | Record [(String, LExpr t v)] | Markdown String String [LExpr t v] - deriving (Eq, Show, Data, Typeable) + deriving (Eq) data Def tipe var = Def Pattern.Pattern (LExpr tipe var) | TypeAnnotation String Type.Type - deriving (Eq, Show, Data, Typeable) + deriving (Eq, Show) tuple es = Data ("_Tuple" ++ show (length es)) es @@ -47,6 +45,9 @@ saveEnvName = "_save_the_environment!!!" dummyLet defs = Location.none $ Let defs (Location.none $ Var saveEnvName) +instance Show (Expr t v) where + show = render . pretty + instance Pretty (Expr t v) where pretty expr = case expr of diff --git a/compiler/SourceSyntax/Literal.hs b/compiler/SourceSyntax/Literal.hs index 29b73af..a7bdb9d 100644 --- a/compiler/SourceSyntax/Literal.hs +++ b/compiler/SourceSyntax/Literal.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable #-} module SourceSyntax.Literal where -import Data.Data import SourceSyntax.PrettyPrint import qualified Text.PrettyPrint as PP @@ -10,7 +8,7 @@ data Literal = IntNum Int | Chr Char | Str String | Boolean Bool - deriving (Eq, Ord, Data, Typeable, Show) + deriving (Eq, Ord, Show) instance Pretty Literal where pretty literal = diff --git a/compiler/SourceSyntax/Location.hs b/compiler/SourceSyntax/Location.hs index f3d277d..fa580bf 100644 --- a/compiler/SourceSyntax/Location.hs +++ b/compiler/SourceSyntax/Location.hs @@ -1,19 +1,17 @@ -{-# LANGUAGE DeriveDataTypeable #-} module SourceSyntax.Location where -import Data.Data import Text.PrettyPrint import SourceSyntax.PrettyPrint import qualified Text.Parsec.Pos as Parsec data SrcPos = Pos { line :: Int, column :: Int } - deriving (Eq, Ord, Data, Typeable) + deriving (Eq, Ord) data SrcSpan = Span SrcPos SrcPos String | NoSpan String - deriving (Eq, Ord, Data, Typeable) + deriving (Eq, Ord) data Located e = L SrcSpan e - deriving (Eq, Ord, Data, Typeable) + deriving (Eq, Ord) none e = L (NoSpan (render $ pretty e)) e noneNoDocs = L (NoSpan "") diff --git a/compiler/SourceSyntax/Module.hs b/compiler/SourceSyntax/Module.hs index 5b02263..09094df 100644 --- a/compiler/SourceSyntax/Module.hs +++ b/compiler/SourceSyntax/Module.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable #-} module SourceSyntax.Module where -import Data.Data import Data.Binary import Data.List (intercalate) import qualified Data.Map as Map @@ -24,7 +22,7 @@ type Exports = [String] type Imports = [(String, ImportMethod)] data ImportMethod = As String | Importing [String] | Hiding [String] - deriving (Eq, Ord, Show, Data, Typeable) + deriving (Eq, Ord, Show) instance Binary ImportMethod where put (As s) = do put (0 :: Word8) diff --git a/compiler/SourceSyntax/Pattern.hs b/compiler/SourceSyntax/Pattern.hs index b1f0455..0328091 100644 --- a/compiler/SourceSyntax/Pattern.hs +++ b/compiler/SourceSyntax/Pattern.hs @@ -1,8 +1,6 @@ -{-# LANGUAGE DeriveDataTypeable #-} module SourceSyntax.Pattern where import Data.List (intercalate) -import Data.Data import SourceSyntax.Helpers as Help import SourceSyntax.PrettyPrint import Text.PrettyPrint as PP @@ -14,7 +12,7 @@ data Pattern = PData String [Pattern] | PVar String | PAnything | PLiteral Literal.Literal - deriving (Eq, Ord, Data, Typeable, Show) + deriving (Eq, Ord, Show) cons h t = PData "::" [h,t] nil = PData "[]" [] diff --git a/compiler/SourceSyntax/Type.hs b/compiler/SourceSyntax/Type.hs index 7c73243..0a0b422 100644 --- a/compiler/SourceSyntax/Type.hs +++ b/compiler/SourceSyntax/Type.hs @@ -1,8 +1,6 @@ -{-# LANGUAGE DeriveDataTypeable #-} module SourceSyntax.Type where import Data.Binary -import Data.Data import qualified Data.Map as Map import qualified SourceSyntax.Helpers as Help import Control.Applicative ((<$>), (<*>)) @@ -14,7 +12,7 @@ data Type = Lambda Type Type | Data String [Type] | EmptyRecord | Record [(String,Type)] Type - deriving (Eq, Show, Data, Typeable) + deriving (Eq, Show) fieldMap :: [(String,a)] -> Map.Map String [a] fieldMap fields = diff --git a/compiler/Transform/Check.hs b/compiler/Transform/Check.hs index 24428b5..91d9ca4 100644 --- a/compiler/Transform/Check.hs +++ b/compiler/Transform/Check.hs @@ -8,12 +8,10 @@ import Data.List as List import qualified Data.Map as Map import qualified Data.Maybe as Maybe import qualified Data.Set as Set -import Data.Data -import Data.Generics.Uniplate.Data import Text.PrettyPrint as P -mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc] +mistakes :: [Declaration t v] -> [Doc] mistakes decls = concat [ infiniteTypeAliases decls , illFormedTypes decls @@ -22,15 +20,35 @@ mistakes decls = where findErrors defs = duplicates defs ++ badOrder defs -getLets :: (Data t, Data v) => [Declaration t v] -> [[Def t v]] -getLets decls = defs : concatMap getSubLets defs +getLets :: [Declaration t v] -> [[Def t v]] +getLets decls = defs : concatMap defLets defs where - defs = concatMap (\d -> case d of Definition d -> [d] ; _ -> []) decls + defs = [ d | Definition d <- decls ] - getSubLets def = + defLets def = case def of - Def pattern expr -> [ defs | Let defs _ <- universeBi expr ] TypeAnnotation _ _ -> [] + Def _ expr -> exprLets expr + + exprLets (L _ expr) = + case expr of + Var _ -> [] + Lambda p e -> exprLets e + Binop op e1 e2 -> exprLets e1 ++ exprLets e2 + Case e cases -> exprLets e ++ concatMap (exprLets . snd) cases + Data name es -> concatMap exprLets es + Literal _ -> [] + Range e1 e2 -> exprLets e1 ++ exprLets e2 + ExplicitList es -> concatMap exprLets es + App e1 e2 -> exprLets e1 ++ exprLets e2 + MultiIf branches -> concatMap (\(b,e) -> exprLets b ++ exprLets e) branches + Access e lbl -> exprLets e + Remove e lbl -> exprLets e + Insert e lbl v -> exprLets e ++ exprLets v + Modify e fields -> exprLets e ++ concatMap (exprLets . snd) fields + Record fields -> concatMap (exprLets . snd) fields + Markdown uid md es -> [] + Let defs body -> [defs] ++ exprLets body dups :: Eq a => [a] -> [a] dups = map head . filter ((>1) . length) . List.group