270dbf8 · elk · git.iko.soy

compiler/SourceSyntax/Declaration.hs+13−3

compare with master

unifiedsplit

@@ -13,7 +13,7 @@ data Declaration' port def

13 | TypeAlias String [String] T.Type [Derivation]

14 | Port port

15 | Fixity Assoc Int String

16− deriving (Eq, Show)

16+ deriving (Show)

17

18data Assoc = L | N | R

19 deriving (Eq)

@@ -25,12 +25,12 @@ data ParsePort

25 = PortAnnotation String T.Type

26 | SendDefinition String Expr.LParseExpr

27 | RecvDefinition String Expr.LParseExpr

28− deriving (Eq,Show)

28+ deriving (Show)

29

30data Port

31 = Send String Expr.LExpr T.Type

32 | Recv String Expr.LExpr T.Type

33− deriving (Eq,Show)

33+ deriving (Show)

34

35type ParseDeclaration = Declaration' ParsePort Expr.ParseDef

36type Declaration = Declaration' Port Expr.Def

@@ -59,6 +59,16 @@ instance Show Assoc where

59 N -> "non"

60 R -> "right"

61

62+instance Binary Assoc where

63+ get = do n <- getWord8

64+ return $ case n of

65+ 0 -> L

66+ 1 -> N

67+ 2 -> R

68+ _ -> error "Error reading valid associativity from serialized string"

69+

70+ put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }

71+

62instance (Pretty port, Pretty def) => Pretty (Declaration' port def) where

72instance (Pretty port, Pretty def) => Pretty (Declaration' port def) where

63 pretty decl =

73 pretty decl =

64 case decl of

74 case decl of

compiler/SourceSyntax/Helpers.hs+1−1

@@ -1,4 +1,4 @@

1−

1+{-# OPTIONS_GHC -Wall #-}

2module SourceSyntax.Helpers where

3

4import qualified Data.Char as Char

compiler/SourceSyntax/Literal.hs+1

@@ -1,3 +1,4 @@

1+{-# OPTIONS_GHC -Wall #-}

1module SourceSyntax.Literal where

2module SourceSyntax.Literal where

2

3

3import SourceSyntax.PrettyPrint

4import SourceSyntax.PrettyPrint

compiler/SourceSyntax/Module.hs+2−14

@@ -1,15 +1,13 @@

1+{-# OPTIONS_GHC -Wall #-}

1module SourceSyntax.Module where

2module SourceSyntax.Module where

2

3

3import Data.Binary

4import Data.Binary

4−import Data.List (intercalate)

5import qualified Data.Map as Map

6import Control.Applicative ((<$>), (<*>))

7−import Control.Arrow (second)

8

7

9import SourceSyntax.Expression (LExpr)

8import SourceSyntax.Expression (LExpr)

10import SourceSyntax.Declaration

9import SourceSyntax.Declaration

11import SourceSyntax.Type

10import SourceSyntax.Type

12−import System.FilePath (joinPath)

13

11

14import qualified Elm.Internal.Version as Version

12import qualified Elm.Internal.Version as Version

15

13

@@ -66,6 +64,7 @@ data ModuleInterface = ModuleInterface {

66 iFixities :: [(Assoc, Int, String)]

64 iFixities :: [(Assoc, Int, String)]

67} deriving Show

65} deriving Show

68

66

67+metaToInterface :: MetadataModule -> ModuleInterface

69metaToInterface metaModule =

68metaToInterface metaModule =

70 ModuleInterface

69 ModuleInterface

71 { iVersion = Version.elmVersion

70 { iVersion = Version.elmVersion

@@ -85,14 +84,3 @@ instance Binary ModuleInterface where

85 put (iAdts modul)

84 put (iAdts modul)

86 put (iAliases modul)

85 put (iAliases modul)

87 put (iFixities modul)

86 put (iFixities modul)

88−

89−

90−instance Binary Assoc where

91− get = do n <- getWord8

92− return $ case n of

93− 0 -> L

94− 1 -> N

95− 2 -> R

96− _ -> error "Error reading valid associativity from serialized string"

97−

98− put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }

compiler/SourceSyntax/Pattern.hs+10−2

@@ -1,6 +1,6 @@

1+{-# OPTIONS_GHC -Wall #-}

1module SourceSyntax.Pattern where

2module SourceSyntax.Pattern where

2

3

3−import Data.List (intercalate)

4import SourceSyntax.Helpers as Help

5import SourceSyntax.PrettyPrint

6import Text.PrettyPrint as PP

@@ -15,9 +15,16 @@ data Pattern = PData String [Pattern]

15 | PLiteral Literal.Literal

16 deriving (Eq, Ord, Show)

17

18+cons :: Pattern -> Pattern -> Pattern

18cons h t = PData "::" [h,t]

19cons h t = PData "::" [h,t]

20+

21+nil :: Pattern

19−nil = PData "[]" []

22+nil = PData "[]" []

23+

24+list :: [Pattern] -> Pattern

20list = foldr cons nil

25list = foldr cons nil

26+

27+tuple :: [Pattern] -> Pattern

21tuple es = PData ("_Tuple" ++ show (length es)) es

28tuple es = PData ("_Tuple" ++ show (length es)) es

22

29

23boundVars :: Pattern -> Set.Set String

30boundVars :: Pattern -> Set.Set String

@@ -48,6 +55,7 @@ instance Pretty Pattern where

48 PP.parens . commaCat $ map pretty ps

55 PP.parens . commaCat $ map pretty ps

49 else hsep (PP.text name : map prettyParens ps)

56 else hsep (PP.text name : map prettyParens ps)

50

57

58+prettyParens :: Pattern -> Doc

51prettyParens pattern = parensIf needsThem (pretty pattern)

59prettyParens pattern = parensIf needsThem (pretty pattern)

52 where

60 where

53 needsThem =

61 needsThem =

compiler/SourceSyntax/Type.hs+5−1

@@ -1,3 +1,4 @@

1+{-# OPTIONS_GHC -Wall #-}

1module SourceSyntax.Type where

2module SourceSyntax.Type where

2

3

3import Data.Binary

4import Data.Binary

@@ -31,7 +32,7 @@ tupleOf ts = Data ("_Tuple" ++ show (length ts)) ts

31instance Pretty Type where

32instance Pretty Type where

32 pretty tipe =

33 pretty tipe =

33 case tipe of

34 case tipe of

34− Lambda t1 t2 -> P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]

35+ Lambda _ _ -> P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]

35 where t:ts = collectLambdas tipe

36 where t:ts = collectLambdas tipe

36 Var x -> P.text x

37 Var x -> P.text x

37 Data "_List" [t] -> P.brackets (pretty t)

38 Data "_List" [t] -> P.brackets (pretty t)

@@ -47,12 +48,14 @@ instance Pretty Type where

47 prettyField (f,t) = P.text f <+> P.text ":" <+> pretty t

48 prettyField (f,t) = P.text f <+> P.text ":" <+> pretty t

48 prettyFields = commaSep . map prettyField $ fields

49 prettyFields = commaSep . map prettyField $ fields

49

50

51+collectLambdas :: Type -> [Doc]

50collectLambdas tipe =

52collectLambdas tipe =

51 case tipe of

53 case tipe of

52 Lambda arg@(Lambda _ _) body -> P.parens (pretty arg) : collectLambdas body

54 Lambda arg@(Lambda _ _) body -> P.parens (pretty arg) : collectLambdas body

53 Lambda arg body -> pretty arg : collectLambdas body

55 Lambda arg body -> pretty arg : collectLambdas body

54 _ -> [pretty tipe]

56 _ -> [pretty tipe]

55

57

58+collectRecords :: Type -> ([(String,Type)], Type)

56collectRecords = go []

59collectRecords = go []

57 where

60 where

58 go fields tipe =

61 go fields tipe =

@@ -60,6 +63,7 @@ collectRecords = go []

60 Record fs ext -> go (fs ++ fields) ext

63 Record fs ext -> go (fs ++ fields) ext

61 _ -> (fields, tipe)

64 _ -> (fields, tipe)

62

65

66+prettyParens :: Type -> Doc

63prettyParens tipe = parensIf needed (pretty tipe)

67prettyParens tipe = parensIf needed (pretty tipe)

64 where

68 where

65 needed =

69 needed =

compiler/SourceSyntax/Variable.hsdeleted−2

@@ -1,2 +0,0 @@

1−module SourceSyntax.Variable where

2−