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,
|
text,
|
||||||
transformers >= 0.2,
|
transformers >= 0.2,
|
||||||
union-find,
|
union-find,
|
||||||
uniplate,
|
|
||||||
unordered-containers
|
unordered-containers
|
||||||
|
|
||||||
Executable elm
|
Executable elm
|
||||||
|
@ -188,7 +187,6 @@ Executable elm
|
||||||
text,
|
text,
|
||||||
transformers >= 0.2,
|
transformers >= 0.2,
|
||||||
union-find,
|
union-find,
|
||||||
uniplate,
|
|
||||||
unordered-containers
|
unordered-containers
|
||||||
|
|
||||||
Executable elm-doc
|
Executable elm-doc
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
|
||||||
module SourceSyntax.Declaration where
|
module SourceSyntax.Declaration where
|
||||||
|
|
||||||
import Data.Data
|
|
||||||
import qualified SourceSyntax.Expression as Expr
|
import qualified SourceSyntax.Expression as Expr
|
||||||
import SourceSyntax.Type
|
import SourceSyntax.Type
|
||||||
import SourceSyntax.PrettyPrint
|
import SourceSyntax.PrettyPrint
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
|
||||||
module SourceSyntax.Expression where
|
module SourceSyntax.Expression where
|
||||||
|
|
||||||
import Data.Data
|
|
||||||
import Data.List (intercalate)
|
import Data.List (intercalate)
|
||||||
import SourceSyntax.PrettyPrint
|
import SourceSyntax.PrettyPrint
|
||||||
import Text.PrettyPrint as P
|
import Text.PrettyPrint as P
|
||||||
|
@ -30,12 +28,12 @@ data Expr t v
|
||||||
| Modify (LExpr t v) [(String, LExpr t v)]
|
| Modify (LExpr t v) [(String, LExpr t v)]
|
||||||
| Record [(String, LExpr t v)]
|
| Record [(String, LExpr t v)]
|
||||||
| Markdown String String [LExpr t v]
|
| Markdown String String [LExpr t v]
|
||||||
deriving (Eq, Show, Data, Typeable)
|
deriving (Eq)
|
||||||
|
|
||||||
data Def tipe var
|
data Def tipe var
|
||||||
= Def Pattern.Pattern (LExpr tipe var)
|
= Def Pattern.Pattern (LExpr tipe var)
|
||||||
| TypeAnnotation String Type.Type
|
| TypeAnnotation String Type.Type
|
||||||
deriving (Eq, Show, Data, Typeable)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
tuple es = Data ("_Tuple" ++ show (length es)) es
|
tuple es = Data ("_Tuple" ++ show (length es)) es
|
||||||
|
|
||||||
|
@ -47,6 +45,9 @@ saveEnvName = "_save_the_environment!!!"
|
||||||
dummyLet defs =
|
dummyLet defs =
|
||||||
Location.none $ Let defs (Location.none $ Var saveEnvName)
|
Location.none $ Let defs (Location.none $ Var saveEnvName)
|
||||||
|
|
||||||
|
instance Show (Expr t v) where
|
||||||
|
show = render . pretty
|
||||||
|
|
||||||
instance Pretty (Expr t v) where
|
instance Pretty (Expr t v) where
|
||||||
pretty expr =
|
pretty expr =
|
||||||
case expr of
|
case expr of
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
|
||||||
module SourceSyntax.Literal where
|
module SourceSyntax.Literal where
|
||||||
|
|
||||||
import Data.Data
|
|
||||||
import SourceSyntax.PrettyPrint
|
import SourceSyntax.PrettyPrint
|
||||||
import qualified Text.PrettyPrint as PP
|
import qualified Text.PrettyPrint as PP
|
||||||
|
|
||||||
|
@ -10,7 +8,7 @@ data Literal = IntNum Int
|
||||||
| Chr Char
|
| Chr Char
|
||||||
| Str String
|
| Str String
|
||||||
| Boolean Bool
|
| Boolean Bool
|
||||||
deriving (Eq, Ord, Data, Typeable, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
instance Pretty Literal where
|
instance Pretty Literal where
|
||||||
pretty literal =
|
pretty literal =
|
||||||
|
|
|
@ -1,19 +1,17 @@
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
|
||||||
module SourceSyntax.Location where
|
module SourceSyntax.Location where
|
||||||
|
|
||||||
import Data.Data
|
|
||||||
import Text.PrettyPrint
|
import Text.PrettyPrint
|
||||||
import SourceSyntax.PrettyPrint
|
import SourceSyntax.PrettyPrint
|
||||||
import qualified Text.Parsec.Pos as Parsec
|
import qualified Text.Parsec.Pos as Parsec
|
||||||
|
|
||||||
data SrcPos = Pos { line :: Int, column :: Int }
|
data SrcPos = Pos { line :: Int, column :: Int }
|
||||||
deriving (Eq, Ord, Data, Typeable)
|
deriving (Eq, Ord)
|
||||||
|
|
||||||
data SrcSpan = Span SrcPos SrcPos String | NoSpan String
|
data SrcSpan = Span SrcPos SrcPos String | NoSpan String
|
||||||
deriving (Eq, Ord, Data, Typeable)
|
deriving (Eq, Ord)
|
||||||
|
|
||||||
data Located e = L SrcSpan e
|
data Located e = L SrcSpan e
|
||||||
deriving (Eq, Ord, Data, Typeable)
|
deriving (Eq, Ord)
|
||||||
|
|
||||||
none e = L (NoSpan (render $ pretty e)) e
|
none e = L (NoSpan (render $ pretty e)) e
|
||||||
noneNoDocs = L (NoSpan "")
|
noneNoDocs = L (NoSpan "")
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
|
||||||
module SourceSyntax.Module where
|
module SourceSyntax.Module where
|
||||||
|
|
||||||
import Data.Data
|
|
||||||
import Data.Binary
|
import Data.Binary
|
||||||
import Data.List (intercalate)
|
import Data.List (intercalate)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
@ -24,7 +22,7 @@ type Exports = [String]
|
||||||
|
|
||||||
type Imports = [(String, ImportMethod)]
|
type Imports = [(String, ImportMethod)]
|
||||||
data ImportMethod = As String | Importing [String] | Hiding [String]
|
data ImportMethod = As String | Importing [String] | Hiding [String]
|
||||||
deriving (Eq, Ord, Show, Data, Typeable)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
instance Binary ImportMethod where
|
instance Binary ImportMethod where
|
||||||
put (As s) = do put (0 :: Word8)
|
put (As s) = do put (0 :: Word8)
|
||||||
|
|
|
@ -1,8 +1,6 @@
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
|
||||||
module SourceSyntax.Pattern where
|
module SourceSyntax.Pattern where
|
||||||
|
|
||||||
import Data.List (intercalate)
|
import Data.List (intercalate)
|
||||||
import Data.Data
|
|
||||||
import SourceSyntax.Helpers as Help
|
import SourceSyntax.Helpers as Help
|
||||||
import SourceSyntax.PrettyPrint
|
import SourceSyntax.PrettyPrint
|
||||||
import Text.PrettyPrint as PP
|
import Text.PrettyPrint as PP
|
||||||
|
@ -14,7 +12,7 @@ data Pattern = PData String [Pattern]
|
||||||
| PVar String
|
| PVar String
|
||||||
| PAnything
|
| PAnything
|
||||||
| PLiteral Literal.Literal
|
| PLiteral Literal.Literal
|
||||||
deriving (Eq, Ord, Data, Typeable, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
cons h t = PData "::" [h,t]
|
cons h t = PData "::" [h,t]
|
||||||
nil = PData "[]" []
|
nil = PData "[]" []
|
||||||
|
|
|
@ -1,8 +1,6 @@
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
|
||||||
module SourceSyntax.Type where
|
module SourceSyntax.Type where
|
||||||
|
|
||||||
import Data.Binary
|
import Data.Binary
|
||||||
import Data.Data
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified SourceSyntax.Helpers as Help
|
import qualified SourceSyntax.Helpers as Help
|
||||||
import Control.Applicative ((<$>), (<*>))
|
import Control.Applicative ((<$>), (<*>))
|
||||||
|
@ -14,7 +12,7 @@ data Type = Lambda Type Type
|
||||||
| Data String [Type]
|
| Data String [Type]
|
||||||
| EmptyRecord
|
| EmptyRecord
|
||||||
| Record [(String,Type)] Type
|
| Record [(String,Type)] Type
|
||||||
deriving (Eq, Show, Data, Typeable)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
fieldMap :: [(String,a)] -> Map.Map String [a]
|
fieldMap :: [(String,a)] -> Map.Map String [a]
|
||||||
fieldMap fields =
|
fieldMap fields =
|
||||||
|
|
|
@ -8,12 +8,10 @@ import Data.List as List
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.Maybe as Maybe
|
import qualified Data.Maybe as Maybe
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Data.Data
|
|
||||||
import Data.Generics.Uniplate.Data
|
|
||||||
import Text.PrettyPrint as P
|
import Text.PrettyPrint as P
|
||||||
|
|
||||||
|
|
||||||
mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]
|
mistakes :: [Declaration t v] -> [Doc]
|
||||||
mistakes decls =
|
mistakes decls =
|
||||||
concat [ infiniteTypeAliases decls
|
concat [ infiniteTypeAliases decls
|
||||||
, illFormedTypes decls
|
, illFormedTypes decls
|
||||||
|
@ -22,15 +20,35 @@ mistakes decls =
|
||||||
where
|
where
|
||||||
findErrors defs = duplicates defs ++ badOrder defs
|
findErrors defs = duplicates defs ++ badOrder defs
|
||||||
|
|
||||||
getLets :: (Data t, Data v) => [Declaration t v] -> [[Def t v]]
|
getLets :: [Declaration t v] -> [[Def t v]]
|
||||||
getLets decls = defs : concatMap getSubLets defs
|
getLets decls = defs : concatMap defLets defs
|
||||||
where
|
where
|
||||||
defs = concatMap (\d -> case d of Definition d -> [d] ; _ -> []) decls
|
defs = [ d | Definition d <- decls ]
|
||||||
|
|
||||||
getSubLets def =
|
defLets def =
|
||||||
case def of
|
case def of
|
||||||
Def pattern expr -> [ defs | Let defs _ <- universeBi expr ]
|
|
||||||
TypeAnnotation _ _ -> []
|
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 :: Eq a => [a] -> [a]
|
||||||
dups = map head . filter ((>1) . length) . List.group
|
dups = map head . filter ((>1) . length) . List.group
|
||||||
|
|
Loading…
Reference in a new issue