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
This commit is contained in:
Evan Czaplicki 2013-12-20 16:41:02 -08:00
parent 39769b77af
commit 7b20993869
9 changed files with 38 additions and 33 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 =

View file

@ -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 "")

View file

@ -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)

View file

@ -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 "[]" []

View file

@ -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 =

View file

@ -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