a88ed26 · elk · git.iko.soy

compiler/Build/Dependencies.hs+1−1

compare with master

unifiedsplit

@@ -16,7 +16,7 @@ import System.FilePath as FP

16

17import Build.Print (failure)

18

19−import qualified SourceSyntax.Module as Module

19+import qualified AST.Module as Module

20import qualified Parse.Parse as Parse

21import qualified Elm.Internal.Paths as Path

22import qualified Elm.Internal.Name as N

compiler/Build/File.hs+1−1

@@ -23,7 +23,7 @@ import qualified Build.Source as Source

23import qualified Build.Utils as Utils

24import qualified Generate.JavaScript as JS

25import qualified Parse.Module as Parser

26−import qualified SourceSyntax.Module as M

26+import qualified AST.Module as M

27import qualified Transform.Canonicalize as Canonical

28

29-- Reader: Runtime flags, always accessible

compiler/Build/Source.hs+5−5

@@ -5,11 +5,11 @@ import qualified Data.Map as Map

5import System.FilePath as FP

6import Text.PrettyPrint (Doc)

7

8−import SourceSyntax.Declaration

8+import AST.Declaration

9−import SourceSyntax.Module

9+import AST.Module

10−import qualified SourceSyntax.Expression as Expr

10+import qualified AST.Expression.General as Expr

11−import qualified SourceSyntax.Pattern as Pattern

11+import qualified AST.Pattern as Pattern

12−import qualified SourceSyntax.Type as Type

12+import qualified AST.Type as Type

13import qualified Parse.Parse as Parse

14import qualified Metadata.Prelude as Prelude

15import qualified Transform.Check as Check

compiler/Type/Alias.hs+18−9

@@ -10,11 +10,12 @@ import qualified Data.List as List

10import AST.Type

11import AST.Module

12

13−type Rules = ([Alias], Type -> Type)

13+type Rules = (Aliases, CanonicalType -> CanonicalType)

14

15rules interfaces moduleAliases moduleImports =

16+ (error "Type.Alias.rules is not defined")

16− (collect interfaces moduleAliases, localizer moduleImports)

17+ --(collect interfaces moduleAliases, localizer moduleImports)

17−

18+{--

18collect interfaces moduleAliases =

19collect interfaces moduleAliases =

19 filter (not . isPrimitive) rawAliases

20 filter (not . isPrimitive) rawAliases

20 where

21 where

@@ -25,7 +26,8 @@ collect interfaces moduleAliases =

25 case tipe of

26 case tipe of

26 Data _ [] -> True

27 Data _ [] -> True

27 _ -> False

28 _ -> False

28−

29+--}

30+{--

29localizer moduleImports = go

31localizer moduleImports = go

30 where

32 where

31 go tipe =

33 go tipe =

@@ -56,14 +58,18 @@ localizer moduleImports = go

56 Hiding xs | name `notElem` xs -> [name]

58 Hiding xs | name `notElem` xs -> [name]

57 Importing xs | name `elem` xs -> [name]

59 Importing xs | name `elem` xs -> [name]

58 _ -> []

60 _ -> []

59−

61+--}

60−realias :: Rules -> Type -> Type

62+realias :: Rules -> CanonicalType -> CanonicalType

63+realias (aliases,localize) tipe =

64+ (error "Type.Alias.realias is not defined")

61−realias (aliases,localize) tipe = localize (canonicalRealias aliases tipe)

65+ -- localize (canonicalRealias aliases tipe)

62

66

63-- Realias using canonical aliases, so results will have aliases

67-- Realias using canonical aliases, so results will have aliases

64-- that are fully qualified and possible to compare.

68-- that are fully qualified and possible to compare.

65−canonicalRealias :: [Alias] -> Type -> Type

69+canonicalRealias :: Aliases -> CanonicalType -> CanonicalType

66canonicalRealias aliases tipe =

70canonicalRealias aliases tipe =

71+ (error "Type.Alias.rules is not defined")

72+{--

67 case concatMap tryRealias aliases of

73 case concatMap tryRealias aliases of

68 [] -> if tipe == tipe' then tipe else f tipe'

74 [] -> if tipe == tipe' then tipe else f tipe'

69 tipes -> f (bestType tipes)

75 tipes -> f (bestType tipes)

@@ -86,10 +92,12 @@ canonicalRealias aliases tipe =

86 Lambda t1 t2 -> Lambda (f t1) (f t2)

92 Lambda t1 t2 -> Lambda (f t1) (f t2)

87 Data name ts -> Data name (map f ts)

93 Data name ts -> Data name (map f ts)

88 Record fs ext -> Record (map (second f) fs) ext

94 Record fs ext -> Record (map (second f) fs) ext

95+--}

89

96

90allEqual [] = True

97allEqual [] = True

91allEqual (x:xs) = all (==x) xs

98allEqual (x:xs) = all (==x) xs

92

99

100+{--

93bestType tipes = fst $ List.minimumBy (\a b -> compare (snd a) (snd b)) pairs

101bestType tipes = fst $ List.minimumBy (\a b -> compare (snd a) (snd b)) pairs

94 where

102 where

95 pairs :: [(Type,Int)]

103 pairs :: [(Type,Int)]

@@ -103,7 +111,7 @@ bestType tipes = fst $ List.minimumBy (\a b -> compare (snd a) (snd b)) pairs

103 Data _ ts -> sum (map numFields ts)

111 Data _ ts -> sum (map numFields ts)

104 Record fields _ -> length fields + sum (map (numFields . snd) fields)

112 Record fields _ -> length fields + sum (map (numFields . snd) fields)

105

113

106−diff :: Type -> Type -> Maybe [(String,Type)]

114+diff :: CanonicalType -> CanonicalType -> Maybe [(String,CanonicalType)]

107diff general specific =

115diff general specific =

108 case (general, specific) of

116 case (general, specific) of

109 (Lambda g1 g2, Lambda s1 s2) -> (++) <$> diff g1 s1 <*> diff g2 s2

117 (Lambda g1 g2, Lambda s1 s2) -> (++) <$> diff g1 s1 <*> diff g2 s2

@@ -137,3 +145,4 @@ collectFields fields =

137

145

138flattenFields fields =

146flattenFields fields =

139 concatMap (\(f,ts) -> map ((,) f) ts) (Map.toList fields)

147 concatMap (\(f,ts) -> map ((,) f) ts) (Map.toList fields)

148+--}

compiler/Type/Constrain/Expression.hs+6−6

@@ -8,12 +8,12 @@ import qualified Data.List as List

8import qualified Data.Map as Map

9import qualified Text.PrettyPrint as PP

10

11−import SourceSyntax.Literal as Lit

11+import AST.Literal as Lit

12−import SourceSyntax.Annotation as Ann

12+import AST.Annotation as Ann

13−import SourceSyntax.Expression

13+import AST.Expression.General

14−import qualified SourceSyntax.Pattern as P

14+import qualified AST.Pattern as P

15−import qualified SourceSyntax.Type as ST

15+import qualified AST.Type as ST

16−import qualified SourceSyntax.Variable as V

16+import qualified AST.Variable as V

17import Type.Type hiding (Descriptor(..))

18import Type.Fragment

19import qualified Type.Environment as Env

compiler/Type/Constrain/Literal.hs+2−2

@@ -1,8 +1,8 @@

1{-# OPTIONS_GHC -W #-}

2module Type.Constrain.Literal where

3

4−import SourceSyntax.Annotation

4+import AST.Annotation

5−import SourceSyntax.Literal

5+import AST.Literal

6import Type.Type

7import Type.Environment as Env

8

compiler/Type/Constrain/Pattern.hs+3−3

@@ -9,9 +9,9 @@ import Control.Monad.Error

9import qualified Data.Map as Map

10import qualified Text.PrettyPrint as PP

11

12−import qualified SourceSyntax.Annotation as A

12+import qualified AST.Annotation as A

13−import qualified SourceSyntax.Pattern as P

13+import qualified AST.Pattern as P

14−import SourceSyntax.PrettyPrint (pretty)

14+import AST.PrettyPrint (pretty)

15import Type.Type

16import Type.Fragment

17import Type.Environment as Env

compiler/Type/Environment.hs+2−2

@@ -12,8 +12,8 @@ import qualified Data.Map as Map

12import Data.List (isPrefixOf)

13import qualified Text.PrettyPrint as PP

14

15−import qualified SourceSyntax.Type as Src

15+import qualified AST.Type as Src

16−import SourceSyntax.Module (ADT, Alias)

16+import AST.Module (ADT, Alias)

17import Type.Type

18

19type TypeDict = Map.Map String Type

compiler/Type/ExtraChecks.hs+29−22

@@ -13,11 +13,13 @@ import qualified Data.Traversable as Traverse

13import qualified Data.UnionFind.IO as UF

14import Text.PrettyPrint as P

15

16−import qualified SourceSyntax.Annotation as A

16+import qualified AST.Annotation as A

17−import qualified SourceSyntax.Expression as E

17+import qualified AST.Expression.General as E

18−import qualified SourceSyntax.Helpers as Help

18+import qualified AST.Expression.Canonical as Canonical

19+import qualified AST.Helpers as Help

19−import qualified SourceSyntax.PrettyPrint as SPP

20+import qualified AST.PrettyPrint as PP

20−import qualified SourceSyntax.Type as ST

21+import qualified AST.Type as ST

22+import qualified AST.Variable as V

21import qualified Transform.Expression as Expr

23import qualified Transform.Expression as Expr

22import qualified Type.Type as TT

24import qualified Type.Type as TT

23import qualified Type.State as TS

25import qualified Type.State as TS

@@ -25,10 +27,10 @@ import qualified Type.Alias as Alias

25

27

26throw err = Left [ P.vcat err ]

28throw err = Left [ P.vcat err ]

27

29

28−mainType :: Alias.Rules -> TS.Env -> IO (Either [P.Doc] (Map.Map String ST.Type))

30+mainType :: Alias.Rules -> TS.Env -> IO (Either [P.Doc] (Map.Map String ST.CanonicalType))

29mainType rules env = mainCheck rules <$> Traverse.traverse TT.toSrcType env

31mainType rules env = mainCheck rules <$> Traverse.traverse TT.toSrcType env

30 where

32 where

31− mainCheck :: Alias.Rules -> Map.Map String ST.Type -> Either [P.Doc] (Map.Map String ST.Type)

33+ mainCheck :: Alias.Rules -> Map.Map String ST.CanonicalType -> Either [P.Doc] (Map.Map String ST.CanonicalType)

32 mainCheck rules env =

34 mainCheck rules env =

33 case Map.lookup "main" env of

35 case Map.lookup "main" env of

34 Nothing -> Right env

36 Nothing -> Right env

@@ -39,31 +41,36 @@ mainType rules env = mainCheck rules <$> Traverse.traverse TT.toSrcType env

39 acceptable = [ "Graphics.Element.Element"

41 acceptable = [ "Graphics.Element.Element"

40 , "Signal.Signal Graphics.Element.Element" ]

42 , "Signal.Signal Graphics.Element.Element" ]

41

43

42− tipe = SPP.renderPretty $ Alias.canonicalRealias (fst rules) mainType

44+ tipe = PP.renderPretty $ Alias.canonicalRealias (fst rules) mainType

43 err = [ P.text "Type Error: 'main' must have type Element or (Signal Element)."

45 err = [ P.text "Type Error: 'main' must have type Element or (Signal Element)."

44 , P.text "Instead 'main' has type:\n"

46 , P.text "Instead 'main' has type:\n"

45− , P.nest 4 . SPP.pretty $ Alias.realias rules mainType

47+ , P.nest 4 . PP.pretty $ Alias.realias rules mainType

46 , P.text " " ]

48 , P.text " " ]

47

49

48data Direction = In | Out

50data Direction = In | Out

49

51

50−portTypes :: Alias.Rules -> E.Expr -> Either [P.Doc] ()

52+portTypes :: Alias.Rules -> Canonical.Expr -> Either [P.Doc] ()

51portTypes rules expr =

53portTypes rules expr =

52 const () <$> Expr.checkPorts (check In) (check Out) expr

54 const () <$> Expr.checkPorts (check In) (check Out) expr

53 where

55 where

54 check = isValid True False False

56 check = isValid True False False

55 isValid isTopLevel seenFunc seenSignal direction name tipe =

57 isValid isTopLevel seenFunc seenSignal direction name tipe =

56 case tipe of

58 case tipe of

57− ST.Data ctor ts

59+ ST.Data (V.Canonical (V.Module "Signal") "Signal") [t] ->

58− | validConstructor -> mapM_ valid ts

59− | ctor == "Signal.Signal" -> handleSignal ts

60+ handleSignal t

60− | otherwise -> err' True "an unsupported type"

61+

61− where

62+ ST.Data (V.Canonical (V.Module "Maybe") "Maybe") [t] ->

62− primitives =

63+ valid t

63− ["Int","Float","String","Bool","Maybe.Maybe","_List","Json.Value"]

64

65− validConstructor =

65+ ST.Data (V.Canonical (V.Module "Json") "Value") [] ->

66+ return ()

67+

68+ ST.Data (V.Canonical V.BuiltIn ctor) ts

66− ctor `elem` primitives || Help.isTuple ctor

69+ | ctor `elem` primitives || Help.isTuple ctor -> mapM_ valid ts

70+ where

71+ primitives = ["Int","Float","String","Bool","_List"]

72+

73+ ST.Data _ _ -> err' True "an unsupported type"

67

74

68 ST.Var _ -> err "free type variables"

75 ST.Var _ -> err "free type variables"

69

76

@@ -85,10 +92,10 @@ portTypes rules expr =

85 isValid' = isValid False

92 isValid' = isValid False

86 valid = isValid' seenFunc seenSignal direction name

93 valid = isValid' seenFunc seenSignal direction name

87

94

88− handleSignal ts

95+ handleSignal t

89 | seenFunc = err "functions that involve signals"

96 | seenFunc = err "functions that involve signals"

90 | seenSignal = err "signals-of-signals"

97 | seenSignal = err "signals-of-signals"

91− | isTopLevel = mapM_ (isValid' seenFunc True direction name) ts

98+ | isTopLevel = isValid' seenFunc True direction name t

92 | otherwise = err "a signal within a data stucture"

99 | otherwise = err "a signal within a data stucture"

93

100

94 dir inMsg outMsg = case direction of { In -> inMsg ; Out -> outMsg }

101 dir inMsg outMsg = case direction of { In -> inMsg ; Out -> outMsg }

@@ -100,7 +107,7 @@ portTypes rules expr =

100 [ txt [ "Type Error: the value ", dir "coming in" "sent out"

107 [ txt [ "Type Error: the value ", dir "coming in" "sent out"

101 , " through port '", name, "' is invalid." ]

108 , " through port '", name, "' is invalid." ]

102 , txt [ "It contains ", kind, ":\n" ]

109 , txt [ "It contains ", kind, ":\n" ]

103− , (P.nest 4 . SPP.pretty $ Alias.realias rules tipe) <> P.text "\n"

110+ , (P.nest 4 . PP.pretty $ Alias.realias rules tipe) <> P.text "\n"

104 , txt [ "Acceptable values for ", dir "incoming" "outgoing", " ports include:" ]

111 , txt [ "Acceptable values for ", dir "incoming" "outgoing", " ports include:" ]

105 , txt [ " Ints, Floats, Bools, Strings, Maybes, Lists, Tuples," ]

112 , txt [ " Ints, Floats, Bools, Strings, Maybes, Lists, Tuples," ]

106 , txt [ " Json.Values, ", dir "" "first-order functions, ", "and concrete records." ]

113 , txt [ " Json.Values, ", dir "" "first-order functions, ", "and concrete records." ]

compiler/Type/Fragment.hs+2−2

@@ -4,8 +4,8 @@ import qualified Data.List as List

4import qualified Data.Map as Map

5

6import Type.Type

7−import SourceSyntax.Pattern

7+import AST.Pattern

8−import SourceSyntax.Annotation (noneNoDocs)

8+import AST.Annotation (noneNoDocs)

9

10data Fragment = Fragment

11 { typeEnv :: Map.Map String Type

compiler/Type/Inference.hs+3−3

@@ -8,9 +8,9 @@ import qualified Type.Environment as Env

8import qualified Type.Constrain.Expression as TcExpr

9import qualified Type.Solve as Solve

10

11−import SourceSyntax.Module as Module

11+import AST.Module as Module

12−import SourceSyntax.Annotation (noneNoDocs)

12+import AST.Annotation (noneNoDocs)

13−import SourceSyntax.Type (Type)

13+import AST.Type (Type)

14import Text.PrettyPrint

15import qualified Type.State as TS

16import qualified Type.ExtraChecks as Check

compiler/Type/PrettyPrint.hs+2−2

@@ -2,7 +2,7 @@

2module Type.PrettyPrint where

3

4import Text.PrettyPrint

5−import qualified SourceSyntax.PrettyPrint as Src

5+import qualified AST.PrettyPrint as Src

6

7data ParensWhen = Fn | App | Never

8

@@ -13,4 +13,4 @@ commaSep docs = sep (punctuate comma docs)

13

14parensIf bool doc = if bool then parens doc else doc

15

16−reprime = Src.reprime

16+reprime = Src.reprime

compiler/Type/Solve.hs+1−1

@@ -11,7 +11,7 @@ import Type.Type

11import Type.Unify

12import qualified Type.ExtraChecks as Check

13import qualified Type.State as TS

14−import qualified SourceSyntax.Annotation as A

14+import qualified AST.Annotation as A

15

16

17-- | Every variable has rank less than or equal to the maxRank of the pool.

compiler/Type/State.hs+2−2

@@ -7,8 +7,8 @@ import qualified Data.Map as Map

7import qualified Data.Traversable as Traversable

8import qualified Data.UnionFind.IO as UF

9

10−import qualified SourceSyntax.Annotation as A

10+import qualified AST.Annotation as A

11−import SourceSyntax.PrettyPrint

11+import AST.PrettyPrint

12import Text.PrettyPrint as P

13import qualified Type.Alias as Alias

14import Type.Type

compiler/Type/Type.hs+13−12

@@ -11,9 +11,10 @@ import Control.Applicative ((<$>),(<*>))

11import Control.Monad.State

12import Control.Monad.Error

13import Data.Traversable (traverse)

14−import SourceSyntax.Annotation

14+import AST.Annotation

15−import SourceSyntax.Helpers (isTuple)

15+import AST.Helpers (isTuple)

16−import qualified SourceSyntax.Type as Src

16+import qualified AST.Type as T

17+import qualified AST.Variable as Var

17

18

18data Term1 a

19data Term1 a

19 = App1 a a

20 = App1 a a

@@ -359,31 +360,31 @@ instance Crawl Descriptor where

359 return $ desc { name = name', structure = structure' }

360 return $ desc { name = name', structure = structure' }

360

361

362

362−toSrcType :: Variable -> IO Src.Type

363+toSrcType :: Variable -> IO T.CanonicalType

363toSrcType variable = do

364toSrcType variable = do

364 desc <- UF.descriptor =<< addNames variable

365 desc <- UF.descriptor =<< addNames variable

365 case structure desc of

366 case structure desc of

366 Just term ->

367 Just term ->

367 case term of

368 case term of

368 App1 a b -> do

369 App1 a b -> do

369− Src.Data name ts <- toSrcType a

370+ T.Data name ts <- toSrcType a

370 b' <- toSrcType b

371 b' <- toSrcType b

371− return (Src.Data name (ts ++ [b']))

372+ return (T.Data name (ts ++ [b']))

372− Fun1 a b -> Src.Lambda <$> toSrcType a <*> toSrcType b

373+ Fun1 a b -> T.Lambda <$> toSrcType a <*> toSrcType b

373 Var1 a -> toSrcType a

374 Var1 a -> toSrcType a

374− EmptyRecord1 -> return $ Src.Record [] Nothing

375+ EmptyRecord1 -> return $ T.Record [] Nothing

375 Record1 tfields extension -> do

376 Record1 tfields extension -> do

376 fields' <- traverse (mapM toSrcType) tfields

377 fields' <- traverse (mapM toSrcType) tfields

377 let fields = concat [ map ((,) name) ts | (name,ts) <- Map.toList fields' ]

378 let fields = concat [ map ((,) name) ts | (name,ts) <- Map.toList fields' ]

378 ext' <- toSrcType extension

379 ext' <- toSrcType extension

379 return $ case ext' of

380 return $ case ext' of

380− Src.Record fs ext -> Src.Record (fs ++ fields) ext

381+ T.Record fs ext -> T.Record (fs ++ fields) ext

381− Src.Var x -> Src.Record fields (Just x)

382+ T.Var x -> T.Record fields (Just ext')

382 _ -> error "Used toSrcType on a type that is not well-formed"

383 _ -> error "Used toSrcType on a type that is not well-formed"

383 Nothing ->

384 Nothing ->

384 case name desc of

385 case name desc of

385− Just x@(c:_) | Char.isLower c -> return (Src.Var x)

386+ Just x@(c:_) | Char.isLower c -> return (T.Var x)

386− | otherwise -> return (Src.Data x [])

387+ | otherwise -> return (T.Data (Var.Canonical (error "did not finish converting toSrcType") x) [])

387 _ -> error $ concat

388 _ -> error $ concat

388 [ "Problem converting the following type "

389 [ "Problem converting the following type "

389 , "from a type-checker type to a source-syntax type:"

390 , "from a type-checker type to a source-syntax type:"

compiler/Type/Unify.hs+1−1

@@ -5,7 +5,7 @@ import Control.Monad.State

5import qualified Data.Map as Map

6import qualified Data.Maybe as Maybe

7import qualified Data.UnionFind.IO as UF

8−import qualified SourceSyntax.Annotation as A

8+import qualified AST.Annotation as A

9import qualified Type.State as TS

10import Type.Type

11import Type.PrettyPrint