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:
parent
39769b77af
commit
7b20993869
9 changed files with 38 additions and 33 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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 "")
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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 "[]" []
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue