git.iko.soy/elk
on master help sign in
Migrate all of SourceSyntax/ to AST/
2b6f5f1Evan Czaplicki
compiler/AST/Annotation.hsnew file+74
compare with master
unifiedsplit
@@ -0,0 +1,74 @@
1+{-# OPTIONS_GHC -W #-}
2+module AST.Annotation where
3+
4+import qualified Text.Parsec.Pos as Parsec
5+import qualified Text.PrettyPrint as P
6+import AST.PrettyPrint
7+
8+data Annotated annotation expr = A annotation expr
9+ deriving (Show)
10+
11+data Region
12+ = Span Position Position P.Doc
13+ | None P.Doc
14+ deriving (Show)
15+
16+data Position = Position
17+ { line :: Int
18+ , column :: Int
19+ } deriving (Show)
20+
21+type Located expr = Annotated Region expr
22+
23+none e = A (None (pretty e)) e
24+noneNoDocs e = A (None P.empty) e
25+
26+at :: (Pretty expr) => Parsec.SourcePos -> Parsec.SourcePos -> expr
27+ -> Annotated Region expr
28+at start end e =
29+ A (Span (position start) (position end) (pretty e)) e
30+ where
31+ position loc = Position (Parsec.sourceLine loc) (Parsec.sourceColumn loc)
32+
33+merge (A s1 _) (A s2 _) e =
34+ A (span (pretty e)) e
35+ where
36+ span = case (s1,s2) of
37+ (Span start _ _, Span _ end _) -> Span start end
38+ (Span start end _, _) -> Span start end
39+ (_, Span start end _) -> Span start end
40+ (_, _) -> None
41+
42+mergeOldDocs (A s1 _) (A s2 _) e =
43+ A span e
44+ where
45+ span = case (s1,s2) of
46+ (Span start _ d1, Span _ end d2) ->
47+ Span start end (P.vcat [d1, P.text "\n", d2])
48+
49+ (Span _ _ _, _) -> s1
50+ (_, Span _ _ _) -> s2
51+ (_, _) -> None P.empty
52+
53+sameAs :: Annotated a expr -> expr' -> Annotated a expr'
54+sameAs (A annotation _) expr = A annotation expr
55+
56+getRegionDocs region =
57+ case region of
58+ Span _ _ doc -> doc
59+ None doc -> doc
60+
61+instance Pretty Region where
62+ pretty span =
63+ case span of
64+ None _ -> P.empty
65+ Span start end _ ->
66+ P.text $
67+ case line start == line end of
68+ False -> "between lines " ++ show (line start) ++ " and " ++ show (line end)
69+ True -> "on line " ++ show (line end) ++ ", column " ++
70+ show (column start) ++ " to " ++ show (column end)
71+
72+instance Pretty e => Pretty (Annotated a e) where
73+ pretty (A _ e) = pretty e
74+
compiler/AST/Declaration.hsnew file+106
@@ -0,0 +1,106 @@
1+{-# OPTIONS_GHC -Wall #-}
2+module AST.Declaration where
3+
4+import Data.Binary
5+import qualified AST.Expression.Source as Source
6+import qualified AST.Expression.Valid as Valid
7+import qualified AST.Expression.Canonical as Canonical
8+import qualified AST.Type as T
9+import qualified AST.Variable as Var
10+import AST.PrettyPrint
11+import Text.PrettyPrint as P
12+
13+data Declaration' port def var
14+ = Definition def
15+ | Datatype String [String] [(String, [T.Type var])]
16+ | TypeAlias String [String] (T.Type var)
17+ | Port port
18+ | Fixity Assoc Int String
19+ deriving (Show)
20+
21+data Assoc = L | N | R
22+ deriving (Eq)
23+
24+data RawPort
25+ = PPAnnotation String (T.Type Var.Raw)
26+ | PPDef String Source.Expr
27+ deriving (Show)
28+
29+data Port expr var
30+ = Out String expr (T.Type var)
31+ | In String (T.Type var)
32+ deriving (Show)
33+
34+type SourceDecl = Declaration' RawPort Source.Def Var.Raw
35+type ValidDecl = Declaration' (Port Valid.Expr Var.Raw) Valid.Def Var.Raw
36+type CanonicalDecl = Declaration' (Port Canonical.Expr Var.Canonical)
37+ Canonical.Def
38+ Var.Canonical
39+
40+portName :: Port expr var -> String
41+portName port =
42+ case port of
43+ Out name _ _ -> name
44+ In name _ -> name
45+
46+instance Show Assoc where
47+ show assoc =
48+ case assoc of
49+ L -> "left"
50+ N -> "non"
51+ R -> "right"
52+
53+instance Binary Assoc where
54+ get = do n <- getWord8
55+ return $ case n of
56+ 0 -> L
57+ 1 -> N
58+ 2 -> R
59+ _ -> error "Error reading valid associativity from serialized string"
60+
61+ put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }
62+
63+instance (Pretty port, Pretty def, Pretty var, Var.ToString var) =>
64+ Pretty (Declaration' port def var) where
65+ pretty decl =
66+ case decl of
67+ Definition def -> pretty def
68+
69+ Datatype tipe tvars ctors ->
70+ P.hang (P.text "data" <+> P.text tipe <+> P.hsep (map P.text tvars)) 4
71+ (P.sep $ zipWith join ("=" : repeat "|") ctors)
72+ where
73+ join c ctor = P.text c <+> prettyCtor ctor
74+ prettyCtor (name, tipes) =
75+ P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
76+
77+ TypeAlias name tvars tipe ->
78+ P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
79+ where
80+ name' = P.text name <+> P.hsep (map P.text tvars)
81+
82+ Port port -> pretty port
83+
84+ Fixity assoc prec op -> P.text "infix" <> assoc' <+> P.int prec <+> P.text op
85+ where
86+ assoc' = case assoc of
87+ L -> P.text "l"
88+ N -> P.empty
89+ R -> P.text "r"
90+
91+instance Pretty RawPort where
92+ pretty port =
93+ case port of
94+ PPAnnotation name tipe -> prettyPort name ":" tipe
95+ PPDef name expr -> prettyPort name "=" expr
96+
97+instance (Pretty expr, Pretty var, Var.ToString var) => Pretty (Port expr var) where
98+ pretty port =
99+ case port of
100+ In name tipe -> prettyPort name ":" tipe
101+ Out name expr tipe -> P.vcat [ prettyPort name ":" tipe
102+ , prettyPort name "=" expr ]
103+
104+
105+prettyPort :: (Pretty a) => String -> String -> a -> Doc
106+prettyPort name op e = P.text "port" <+> P.text name <+> P.text op <+> pretty e
compiler/AST/Expression/Canonical.hs+3−3
@@ -2,13 +2,13 @@
2
2
3module AST.Expression.Canonical where
3module AST.Expression.Canonical where
4
4
5−import SourceSyntax.PrettyPrint
5+import AST.PrettyPrint
6import Text.PrettyPrint as P
6import Text.PrettyPrint as P
7import qualified AST.Expression.General as General
7import qualified AST.Expression.General as General
8import AST.Type (Type)
8import AST.Type (Type)
9+import qualified AST.Annotation as Annotation
10+import qualified AST.Pattern as Pattern
9import qualified AST.Variable as Var
11import qualified AST.Variable as Var
10−import qualified SourceSyntax.Annotation as Annotation
11−import qualified SourceSyntax.Pattern as Pattern
12
12
13
13
14{-| Canonicalized expressions. All variables are fully resolved to the module
14{-| Canonicalized expressions. All variables are fully resolved to the module
compiler/AST/Expression/General.hs+6−5
@@ -8,14 +8,15 @@ enrich the AST with more information.
8-}
8-}
9module AST.Expression.General where
9module AST.Expression.General where
10
10
11−import SourceSyntax.PrettyPrint
11+import AST.PrettyPrint
12import Text.PrettyPrint as P
12import Text.PrettyPrint as P
13import AST.Type (Type)
13import AST.Type (Type)
14+
15+import qualified AST.Annotation as Annotation
16+import qualified AST.Helpers as Help
17+import qualified AST.Literal as Literal
18+import qualified AST.Pattern as Pattern
14import qualified AST.Variable as Var
19import qualified AST.Variable as Var
15−import qualified SourceSyntax.Helpers as Help
16−import qualified SourceSyntax.Annotation as Annotation
17−import qualified SourceSyntax.Pattern as Pattern
18−import qualified SourceSyntax.Literal as Literal
19
20
20---- GENERAL AST ----
21---- GENERAL AST ----
21
22
compiler/AST/Expression/Source.hs+3−3
@@ -2,13 +2,13 @@
2
2
3module AST.Expression.Source where
3module AST.Expression.Source where
4
4
5−import SourceSyntax.PrettyPrint
5+import AST.PrettyPrint
6import Text.PrettyPrint as P
6import Text.PrettyPrint as P
7import qualified AST.Expression.General as General
7import qualified AST.Expression.General as General
8import AST.Type (Type)
8import AST.Type (Type)
9import qualified AST.Variable as Var
9import qualified AST.Variable as Var
10−import qualified SourceSyntax.Annotation as Annotation
10+import qualified AST.Annotation as Annotation
11−import qualified SourceSyntax.Pattern as Pattern
11+import qualified AST.Pattern as Pattern
12
12
13
13
14{-| Expressions created by the parser. These use a split representation of type
14{-| Expressions created by the parser. These use a split representation of type
compiler/AST/Expression/Valid.hs+3−3
@@ -2,13 +2,13 @@
2
2
3module AST.Expression.Valid where
3module AST.Expression.Valid where
4
4
5−import SourceSyntax.PrettyPrint
5+import AST.PrettyPrint
6import Text.PrettyPrint as P
6import Text.PrettyPrint as P
7import qualified AST.Expression.General as General
7import qualified AST.Expression.General as General
8import AST.Type (Type)
8import AST.Type (Type)
9import qualified AST.Variable as Var
9import qualified AST.Variable as Var
10−import qualified SourceSyntax.Annotation as Annotation
10+import qualified AST.Annotation as Annotation
11−import qualified SourceSyntax.Pattern as Pattern
11+import qualified AST.Pattern as Pattern
12
12
13
13
14{-| "Normal" expressions. When the compiler checks that type annotations and
14{-| "Normal" expressions. When the compiler checks that type annotations and
compiler/AST/Helpers.hsnew file+27
@@ -0,0 +1,27 @@
1+{-# OPTIONS_GHC -Wall #-}
2+module AST.Helpers where
3+
4+import qualified Data.Char as Char
5+
6+splitDots :: String -> [String]
7+splitDots = go []
8+ where
9+ go vars str =
10+ case break (=='.') str of
11+ (x,_:rest) | isOp x -> vars ++ [x ++ '.' : rest]
12+ | otherwise -> go (vars ++ [x]) rest
13+ (x,[]) -> vars ++ [x]
14+
15+brkt :: String -> String
16+brkt s = "{ " ++ s ++ " }"
17+
18+isTuple :: String -> Bool
19+isTuple name =
20+ take 6 name == "_Tuple" && all Char.isDigit (drop 6 name)
21+
22+isOp :: String -> Bool
23+isOp = all isSymbol
24+
25+isSymbol :: Char -> Bool
26+isSymbol c =
27+ Char.isSymbol c || elem c "+-/*=.$<>:&|^?%#@~!"
compiler/AST/Literal.hsnew file+21
@@ -0,0 +1,21 @@
1+{-# OPTIONS_GHC -Wall #-}
2+module AST.Literal where
3+
4+import AST.PrettyPrint
5+import qualified Text.PrettyPrint as PP
6+
7+data Literal = IntNum Int
8+ | FloatNum Double
9+ | Chr Char
10+ | Str String
11+ | Boolean Bool
12+ deriving (Eq, Ord, Show)
13+
14+instance Pretty Literal where
15+ pretty literal =
16+ case literal of
17+ IntNum n -> PP.int n
18+ FloatNum n -> PP.double n
19+ Chr c -> PP.text . show $ c
20+ Str s -> PP.text . show $ s
21+ Boolean bool -> PP.text (show bool)
compiler/AST/Module.hs+1−1
@@ -6,9 +6,9 @@ import qualified Data.Map as Map
6import Control.Applicative ((<$>),(<*>))
6import Control.Applicative ((<$>),(<*>))
7
7
8import qualified AST.Expression.Canonical as Canonical
8import qualified AST.Expression.Canonical as Canonical
9+import qualified AST.Declaration as Decl
9import qualified AST.Type as Type
10import qualified AST.Type as Type
10import qualified AST.Variable as Var
11import qualified AST.Variable as Var
11−import qualified SourceSyntax.Declaration as Decl
12
12
13import qualified Elm.Internal.Version as Version
13import qualified Elm.Internal.Version as Version
14
14
compiler/AST/Pattern.hsnew file+79
@@ -0,0 +1,79 @@
1+{-# OPTIONS_GHC -Wall #-}
2+module AST.Pattern where
3+
4+import qualified AST.Helpers as Help
5+import AST.PrettyPrint
6+import Text.PrettyPrint as PP
7+import qualified Data.Set as Set
8+
9+import qualified AST.Variable as Var
10+import AST.Literal as Literal
11+
12+data Pattern var
13+ = Data var [Pattern var]
14+ | Record [String]
15+ | Alias String (Pattern var)
16+ | Var String
17+ | Anything
18+ | Literal Literal.Literal
19+ deriving (Eq, Ord, Show)
20+
21+type RawPattern = Pattern Var.Raw
22+type CanonicalPattern = Pattern Var.Canonical
23+
24+cons :: RawPattern -> RawPattern -> RawPattern
25+cons h t = Data (Var.Raw "::") [h,t]
26+
27+nil :: RawPattern
28+nil = Data (Var.Raw "[]") []
29+
30+list :: [RawPattern] -> RawPattern
31+list = foldr cons nil
32+
33+tuple :: [RawPattern] -> RawPattern
34+tuple es = Data (Var.Raw ("_Tuple" ++ show (length es))) es
35+
36+boundVarList :: Pattern var -> [String]
37+boundVarList = Set.toList . boundVars
38+
39+boundVars :: Pattern var -> Set.Set String
40+boundVars pattern =
41+ case pattern of
42+ Var x -> Set.singleton x
43+ Alias x p -> Set.insert x (boundVars p)
44+ Data _ ps -> Set.unions (map boundVars ps)
45+ Record fields -> Set.fromList fields
46+ Anything -> Set.empty
47+ Literal _ -> Set.empty
48+
49+
50+instance Var.ToString var => Pretty (Pattern var) where
51+ pretty pattern =
52+ case pattern of
53+ Var x -> variable x
54+ Literal lit -> pretty lit
55+ Record fs -> PP.braces (commaCat $ map variable fs)
56+ Alias x p -> prettyParens p <+> PP.text "as" <+> variable x
57+ Anything -> PP.text "_"
58+ Data name [hd,tl] | Var.toString name == "::" ->
59+ parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
60+ where
61+ isCons = case hd of
62+ Data ctor _ -> Var.toString ctor == "::"
63+ _ -> False
64+
65+ Data name ps
66+ | Help.isTuple name' -> PP.parens . commaCat $ map pretty ps
67+ | otherwise -> hsep (PP.text name' : map prettyParens ps)
68+ where
69+ name' = Var.toString name
70+
71+prettyParens :: Var.ToString var => Pattern var -> Doc
72+prettyParens pattern =
73+ parensIf needsThem (pretty pattern)
74+ where
75+ needsThem =
76+ case pattern of
77+ Data name (_:_) | not (Help.isTuple (Var.toString name)) -> True
78+ Alias _ _ -> True
79+ _ -> False
compiler/AST/PrettyPrint.hsnew file+42
@@ -0,0 +1,42 @@
1+{-# LANGUAGE FlexibleInstances #-}
2+module AST.PrettyPrint where
3+
4+import Text.PrettyPrint as P
5+import qualified AST.Helpers as Help
6+
7+class Pretty a where
8+ pretty :: a -> Doc
9+
10+instance Pretty Doc where
11+ pretty doc = doc
12+
13+instance Pretty String where
14+ pretty = P.text
15+
16+renderPretty :: (Pretty a) => a -> String
17+renderPretty e = render (pretty e)
18+
19+commaCat docs = cat (punctuate comma docs)
20+commaSep docs = sep (punctuate comma docs)
21+
22+parensIf :: Bool -> Doc -> Doc
23+parensIf bool doc = if bool then parens doc else doc
24+
25+variable :: String -> Doc
26+variable x =
27+ if Help.isOp x then parens (text x)
28+ else text (reprime x)
29+
30+reprime :: String -> String
31+reprime = map (\c -> if c == '$' then '\'' else c)
32+
33+eightyCharLines :: Int -> String -> String
34+eightyCharLines indent message = answer
35+ where
36+ (answer,_,_) = foldl step (spaces, indent-1, "") chunks
37+
38+ chunks = map (\w -> (w, length w)) (words message)
39+ spaces = replicate indent ' '
40+ step (sentence, slen, space) (word, wlen)
41+ | slen + wlen > 79 = (sentence ++ "\n" ++ spaces ++ word, indent + wlen, " ")
42+ | otherwise = (sentence ++ space ++ word, slen + wlen + length space, " ")
compiler/AST/Type.hs+2−2
@@ -7,8 +7,8 @@ import qualified Data.Map as Map
7
7
8import AST.Variable (Raw(Raw))
8import AST.Variable (Raw(Raw))
9import qualified AST.Variable as Var
9import qualified AST.Variable as Var
10−import SourceSyntax.PrettyPrint
10+import AST.PrettyPrint
11−import qualified SourceSyntax.Helpers as Help
11+import qualified AST.Helpers as Help
12import Text.PrettyPrint as P
12import Text.PrettyPrint as P
13
13
14data Type var
14data Type var
compiler/AST/Variable.hs+2−2
@@ -4,11 +4,11 @@ module AST.Variable where
4import Data.Binary
4import Data.Binary
5import Control.Applicative ((<$>), (<*>))
5import Control.Applicative ((<$>), (<*>))
6import Text.PrettyPrint as P
6import Text.PrettyPrint as P
7−import SourceSyntax.PrettyPrint
7+import AST.PrettyPrint
8
8
9import qualified Data.List as List
9import qualified Data.List as List
10import qualified Text.PrettyPrint as P
10import qualified Text.PrettyPrint as P
11−import SourceSyntax.PrettyPrint
11+import AST.PrettyPrint
12
12
13newtype Raw = Raw String
13newtype Raw = Raw String
14 deriving (Eq,Ord,Show)
14 deriving (Eq,Ord,Show)