a88ed26 · elk · git.iko.soy

git.iko.soy/elk

Switch imports from SourceSyntax to AST

Begin fixing some issues, but many still remain

commita88ed26f19c0366dc14796d2714dab1f97f25728 authorEvan Czaplicki <info@elm-lang.org> dateThu 24 Apr 2014, 07:11 (13 years ago) parente4dd7f7

16 files changed+91−74

compare with master

unifiedsplit

compiler/Build/Dependencies.hs+1−1 compiler/Build/File.hs+1−1 compiler/Build/Source.hs+5−5 compiler/Type/Alias.hs+18−9 compiler/Type/Constrain/Expression.hs+6−6 compiler/Type/Constrain/Literal.hs+2−2 compiler/Type/Constrain/Pattern.hs+3−3 compiler/Type/Environment.hs+2−2 compiler/Type/ExtraChecks.hs+29−22 compiler/Type/Fragment.hs+2−2 compiler/Type/Inference.hs+3−3 compiler/Type/PrettyPrint.hs+2−2 compiler/Type/Solve.hs+1−1 compiler/Type/State.hs+2−2 compiler/Type/Type.hs+13−12 compiler/Type/Unify.hs+1−1

compiler/Build/Dependencies.hs+1−1

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

1616

1717import Build.Print (failure)

1818

19−import qualified SourceSyntax.Module as Module

19+import qualified AST.Module as Module

2020import qualified Parse.Parse as Parse

2121import qualified Elm.Internal.Paths as Path

2222import qualified Elm.Internal.Name as N

compiler/Build/File.hs+1−1

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

2323import qualified Build.Utils as Utils

2424import qualified Generate.JavaScript as JS

2525import qualified Parse.Module as Parser

26−import qualified SourceSyntax.Module as M

26+import qualified AST.Module as M

2727import qualified Transform.Canonicalize as Canonical

2828

2929-- Reader: Runtime flags, always accessible

compiler/Build/Source.hs+5−5

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

55import System.FilePath as FP

66import Text.PrettyPrint (Doc)

8−import SourceSyntax.Declaration

9−import SourceSyntax.Module

10−import qualified SourceSyntax.Expression as Expr

11−import qualified SourceSyntax.Pattern as Pattern

12−import qualified SourceSyntax.Type as Type

8+import AST.Declaration

9+import AST.Module

10+import qualified AST.Expression.General as Expr

11+import qualified AST.Pattern as Pattern

12+import qualified AST.Type as Type

1313import qualified Parse.Parse as Parse

1414import qualified Metadata.Prelude as Prelude

1515import qualified Transform.Check as Check

compiler/Type/Alias.hs+18−9

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

1010import AST.Type

1111import AST.Module

1212

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

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

1414

1515rules interfaces moduleAliases moduleImports =

16− (collect interfaces moduleAliases, localizer moduleImports)

17−

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

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

18+{--

1819collect interfaces moduleAliases =

1920 filter (not . isPrimitive) rawAliases

2021 where

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

2526 case tipe of

2627 Data _ [] -> True

2728 _ -> False

28−

29+--}

30+{--

2931localizer moduleImports = go

3032 where

3133 go tipe =

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

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

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

5860 _ -> []

59−

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

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

61+--}

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

63+realias (aliases,localize) tipe =

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

65+ -- localize (canonicalRealias aliases tipe)

6266

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

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

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

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

6670canonicalRealias aliases tipe =

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

72+{--

6773 case concatMap tryRealias aliases of

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

6975 tipes -> f (bestType tipes)

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

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

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

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

95+--}

8996

9097allEqual [] = True

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

9299

100+{--

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

94102 where

95103 pairs :: [(Type,Int)]

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

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

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

105113

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

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

107115diff general specific =

108116 case (general, specific) of

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

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

137145

138146flattenFields fields =

139147 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

88import qualified Data.Map as Map

99import qualified Text.PrettyPrint as PP

1010

11−import SourceSyntax.Literal as Lit

12−import SourceSyntax.Annotation as Ann

13−import SourceSyntax.Expression

14−import qualified SourceSyntax.Pattern as P

15−import qualified SourceSyntax.Type as ST

16−import qualified SourceSyntax.Variable as V

11+import AST.Literal as Lit

12+import AST.Annotation as Ann

13+import AST.Expression.General

14+import qualified AST.Pattern as P

15+import qualified AST.Type as ST

16+import qualified AST.Variable as V

1717import Type.Type hiding (Descriptor(..))

1818import Type.Fragment

1919import qualified Type.Environment as Env

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

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

11{-# OPTIONS_GHC -W #-}

22module Type.Constrain.Literal where

4−import SourceSyntax.Annotation

5−import SourceSyntax.Literal

4+import AST.Annotation

5+import AST.Literal

66import Type.Type

77import Type.Environment as Env

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

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

99import qualified Data.Map as Map

1010import qualified Text.PrettyPrint as PP

1111

12−import qualified SourceSyntax.Annotation as A

13−import qualified SourceSyntax.Pattern as P

14−import SourceSyntax.PrettyPrint (pretty)

12+import qualified AST.Annotation as A

13+import qualified AST.Pattern as P

14+import AST.PrettyPrint (pretty)

1515import Type.Type

1616import Type.Fragment

1717import Type.Environment as Env

compiler/Type/Environment.hs+2−2

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

1212import Data.List (isPrefixOf)

1313import qualified Text.PrettyPrint as PP

1414

15−import qualified SourceSyntax.Type as Src

16−import SourceSyntax.Module (ADT, Alias)

15+import qualified AST.Type as Src

16+import AST.Module (ADT, Alias)

1717import Type.Type

1818

1919type TypeDict = Map.Map String Type

compiler/Type/ExtraChecks.hs+29−22

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

1313import qualified Data.UnionFind.IO as UF

1414import Text.PrettyPrint as P

1515

16−import qualified SourceSyntax.Annotation as A

17−import qualified SourceSyntax.Expression as E

18−import qualified SourceSyntax.Helpers as Help

19−import qualified SourceSyntax.PrettyPrint as SPP

20−import qualified SourceSyntax.Type as ST

16+import qualified AST.Annotation as A

17+import qualified AST.Expression.General as E

18+import qualified AST.Expression.Canonical as Canonical

19+import qualified AST.Helpers as Help

20+import qualified AST.PrettyPrint as PP

21+import qualified AST.Type as ST

22+import qualified AST.Variable as V

2123import qualified Transform.Expression as Expr

2224import qualified Type.Type as TT

2325import qualified Type.State as TS

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

2527

2628throw err = Left [ P.vcat err ]

2729

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

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

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

3234 mainCheck rules env =

3335 case Map.lookup "main" env of

3436 Nothing -> Right env

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

3941 acceptable = [ "Graphics.Element.Element"

4042 , "Signal.Signal Graphics.Element.Element" ]

4143

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

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

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

4446 , 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

4648 , P.text " " ]

4749

4850data Direction = In | Out

4951

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

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

5153portTypes rules expr =

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

5355 where

5456 check = isValid True False False

5557 isValid isTopLevel seenFunc seenSignal direction name tipe =

5658 case tipe of

57− ST.Data ctor ts

58− | validConstructor -> mapM_ valid ts

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

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

61− where

62− primitives =

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

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

60+ handleSignal t

61+

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

63+ valid t

6464

65− validConstructor =

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

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

66+ return ()

67+

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

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"

6774

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

6976

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

8592 isValid' = isValid False

8693 valid = isValid' seenFunc seenSignal direction name

8794

88− handleSignal ts

95+ handleSignal t

8996 | seenFunc = err "functions that involve signals"

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

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

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

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

93100

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

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

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

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

102109 , 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"

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

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

106113 , 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

44import qualified Data.Map as Map

66import Type.Type

7−import SourceSyntax.Pattern

8−import SourceSyntax.Annotation (noneNoDocs)

7+import AST.Pattern

8+import AST.Annotation (noneNoDocs)

1010data Fragment = Fragment

1111 { typeEnv :: Map.Map String Type

compiler/Type/Inference.hs+3−3

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

88import qualified Type.Constrain.Expression as TcExpr

99import qualified Type.Solve as Solve

1010

11−import SourceSyntax.Module as Module

12−import SourceSyntax.Annotation (noneNoDocs)

13−import SourceSyntax.Type (Type)

11+import AST.Module as Module

12+import AST.Annotation (noneNoDocs)

13+import AST.Type (Type)

1414import Text.PrettyPrint

1515import qualified Type.State as TS

1616import qualified Type.ExtraChecks as Check

compiler/Type/PrettyPrint.hs+2−2

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

22module Type.PrettyPrint where

44import Text.PrettyPrint

5−import qualified SourceSyntax.PrettyPrint as Src

5+import qualified AST.PrettyPrint as Src

77data ParensWhen = Fn | App | Never

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

1313

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

1515

16−reprime = Src.reprime

16+reprime = Src.reprime

compiler/Type/Solve.hs+1−1

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

1111import Type.Unify

1212import qualified Type.ExtraChecks as Check

1313import qualified Type.State as TS

14−import qualified SourceSyntax.Annotation as A

14+import qualified AST.Annotation as A

1515

1616

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

77import qualified Data.Traversable as Traversable

88import qualified Data.UnionFind.IO as UF

10−import qualified SourceSyntax.Annotation as A

11−import SourceSyntax.PrettyPrint

10+import qualified AST.Annotation as A

11+import AST.PrettyPrint

1212import Text.PrettyPrint as P

1313import qualified Type.Alias as Alias

1414import Type.Type

compiler/Type/Type.hs+13−12

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

1111import Control.Monad.State

1212import Control.Monad.Error

1313import Data.Traversable (traverse)

14−import SourceSyntax.Annotation

15−import SourceSyntax.Helpers (isTuple)

16−import qualified SourceSyntax.Type as Src

14+import AST.Annotation

15+import AST.Helpers (isTuple)

16+import qualified AST.Type as T

17+import qualified AST.Variable as Var

1718

1819data Term1 a

1920 = App1 a a

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

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

360361

361362

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

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

363364toSrcType variable = do

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

365366 case structure desc of

366367 Just term ->

367368 case term of

368369 App1 a b -> do

369− Src.Data name ts <- toSrcType a

370+ T.Data name ts <- toSrcType a

370371 b' <- toSrcType b

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

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

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

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

373374 Var1 a -> toSrcType a

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

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

375376 Record1 tfields extension -> do

376377 fields' <- traverse (mapM toSrcType) tfields

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

378379 ext' <- toSrcType extension

379380 return $ case ext' of

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

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

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

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

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

383384 Nothing ->

384385 case name desc of

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

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

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

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

387388 _ -> error $ concat

388389 [ "Problem converting the following type "

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

compiler/Type/Unify.hs+1−1

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

55import qualified Data.Map as Map

66import qualified Data.Maybe as Maybe

77import qualified Data.UnionFind.IO as UF

8−import qualified SourceSyntax.Annotation as A

8+import qualified AST.Annotation as A

99import qualified Type.State as TS

1010import Type.Type

1111import Type.PrettyPrint