d1c3c08 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Fix a bunch of -Wall warnings

d1c3c08Phil Freeman13 years ago

src/Data/Generics/Extras.hs+1−1

compare with golang

unifiedsplit

@@ -18,7 +18,7 @@ module Data.Generics.Extras where

19import Data.Data

21−everywhereM' :: (Monad m, Data d) => (forall d. (Data d) => d -> m d) -> d -> m d

21+everywhereM' :: (Monad m, Data d) => (forall d1. (Data d1) => d1 -> m d1) -> d -> m d

22everywhereM' f x = do

23 y <- f x

24 gmapM (everywhereM' f) y

src/Language/PureScript/CodeGen/Externs.hs+3−4

@@ -16,7 +16,6 @@ module Language.PureScript.CodeGen.Externs (

16 externToPs

17) where

19−import Data.List (intercalate)

20import Data.Maybe (mapMaybe)

19import Data.Maybe (mapMaybe)

21import qualified Data.Map as M

20import qualified Data.Map as M

22import Language.PureScript.Declarations

21import Language.PureScript.Declarations

@@ -31,11 +30,11 @@ externToPs indent path env (ValueDeclaration name _) = do

31externToPs indent path env (DataDeclaration name _ _) = do

30externToPs indent path env (DataDeclaration name _ _) = do

32 (kind, _) <- M.lookup (path, name) $ types env

31 (kind, _) <- M.lookup (path, name) $ types env

33 return $ replicate indent ' ' ++ "foreign import data " ++ show name ++ " :: " ++ prettyPrintKind kind

32 return $ replicate indent ' ' ++ "foreign import data " ++ show name ++ " :: " ++ prettyPrintKind kind

34−externToPs indent path env (ExternMemberDeclaration member name ty) =

33+externToPs indent _ _ (ExternMemberDeclaration member name ty) =

35 return $ replicate indent ' ' ++ "foreign import member " ++ show member ++ " " ++ show name ++ " :: " ++ prettyPrintType ty

34 return $ replicate indent ' ' ++ "foreign import member " ++ show member ++ " " ++ show name ++ " :: " ++ prettyPrintType ty

36−externToPs indent path env (ExternDataDeclaration name kind) =

35+externToPs indent _ _ (ExternDataDeclaration name kind) =

37 return $ replicate indent ' ' ++ "foreign import data " ++ show name ++ " :: " ++ prettyPrintKind kind

36 return $ replicate indent ' ' ++ "foreign import data " ++ show name ++ " :: " ++ prettyPrintKind kind

38−externToPs indent path env (TypeSynonymDeclaration name args ty) =

37+externToPs indent _ _ (TypeSynonymDeclaration name args ty) =

39 return $ replicate indent ' ' ++ "type " ++ show name ++ " " ++ unwords args ++ " = " ++ prettyPrintType ty

38 return $ replicate indent ' ' ++ "type " ++ show name ++ " " ++ unwords args ++ " = " ++ prettyPrintType ty

40externToPs indent path env (ModuleDeclaration name decls) =

39externToPs indent path env (ModuleDeclaration name decls) =

41 return $ replicate indent ' ' ++ "module " ++ show name ++ " where\n" ++ unlines (mapMaybe (externToPs (indent + 2) (subModule path name) env) decls)

40 return $ replicate indent ' ' ++ "module " ++ show name ++ " where\n" ++ unlines (mapMaybe (externToPs (indent + 2) (subModule path name) env) decls)

src/Language/PureScript/CodeGen/JS.hs+31−34

@@ -17,17 +17,12 @@ module Language.PureScript.CodeGen.JS (

17 declToJs

18) where

20−import Data.Char

20+import Data.Maybe (mapMaybe)

21−import Data.Maybe (fromMaybe, mapMaybe)

22−import Data.List (intercalate)

23import qualified Data.Map as M

21import qualified Data.Map as M

24−import qualified Control.Arrow as A

22+import Control.Arrow (second)

25−import Control.Arrow ((<+>), second)

26import Control.Monad (forM)

23import Control.Monad (forM)

27−import Control.Applicative

29import Language.PureScript.TypeChecker (Environment, names)

25import Language.PureScript.TypeChecker (Environment, names)

30−import Language.PureScript.Types

31import Language.PureScript.Values

26import Language.PureScript.Values

32import Language.PureScript.Names

27import Language.PureScript.Names

33import Language.PureScript.Declarations

28import Language.PureScript.Declarations

@@ -37,16 +32,16 @@ import Language.PureScript.CodeGen.JS.AST as AST

37import Language.PureScript.TypeChecker.Monad (NameKind(..))

32import Language.PureScript.TypeChecker.Monad (NameKind(..))

39declToJs :: Maybe Ident -> ModulePath -> Declaration -> Environment -> Maybe [JS]

34declToJs :: Maybe Ident -> ModulePath -> Declaration -> Environment -> Maybe [JS]

40−declToJs mod mp (ValueDeclaration ident (Abs args ret)) e =

35+declToJs curMod mp (ValueDeclaration ident (Abs args ret)) e =

41 Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp e ret)]) :

36 Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp e ret)]) :

42− maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod

37+ maybe [] (return . setProperty (identToJs ident) (JSVar ident)) curMod

43−declToJs mod mp (ValueDeclaration ident val) e =

38+declToJs curMod mp (ValueDeclaration ident val) e =

44 Just $ JSVariableIntroduction ident (Just (valueToJs mp e val)) :

39 Just $ JSVariableIntroduction ident (Just (valueToJs mp e val)) :

45− maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod

40+ maybe [] (return . setProperty (identToJs ident) (JSVar ident)) curMod

46−declToJs mod _ (ExternMemberDeclaration member ident _) _ =

41+declToJs curMod _ (ExternMemberDeclaration member ident _) _ =

47 Just $ JSFunction (Just ident) [Ident "value"] (JSBlock [JSReturn (JSAccessor member (JSVar (Ident "value")))]) :

42 Just $ JSFunction (Just ident) [Ident "value"] (JSBlock [JSReturn (JSAccessor member (JSVar (Ident "value")))]) :

48− maybe [] (return . setProperty (show ident) (JSVar ident)) mod

43+ maybe [] (return . setProperty (show ident) (JSVar ident)) curMod

49−declToJs mod mp (DataDeclaration _ _ ctors) _ =

44+declToJs curMod mp (DataDeclaration _ _ ctors) _ =

50 Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->

45 Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->

51 let

46 let

52 ctorJs =

47 ctorJs =

@@ -56,18 +51,18 @@ declToJs mod mp (DataDeclaration _ _ ctors) _ =

56 (JSBlock [JSReturn

51 (JSBlock [JSReturn

57 (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified mp pn)))

52 (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified mp pn)))

58 , ("value", JSVar (Ident "value")) ])])

53 , ("value", JSVar (Ident "value")) ])])

59− in ctorJs : maybe [] (return . setProperty ctor (JSVar (Ident ctor))) mod

54+ in ctorJs : maybe [] (return . setProperty ctor (JSVar (Ident ctor))) curMod

60−declToJs mod mp (ModuleDeclaration pn@(ProperName name) decls) env =

55+declToJs curMod mp (ModuleDeclaration pn@(ProperName name) decls) env =

61 Just $ [ JSVariableIntroduction (Ident name) Nothing

56 Just $ [ JSVariableIntroduction (Ident name) Nothing

62 , JSApp (JSFunction Nothing [Ident name]

57 , JSApp (JSFunction Nothing [Ident name]

63 (JSBlock (concat $ mapMaybe (\decl -> declToJs (Just (Ident name)) (subModule mp pn) decl env) decls)))

58 (JSBlock (concat $ mapMaybe (\decl -> declToJs (Just (Ident name)) (subModule mp pn) decl env) decls)))

64 [JSAssignment (JSAssignVariable (Ident name))

59 [JSAssignment (JSAssignVariable (Ident name))

65 (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]] ++

60 (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]] ++

66− maybe [] (return . setProperty name (JSVar (Ident name))) mod

61+ maybe [] (return . setProperty name (JSVar (Ident name))) curMod

67declToJs _ _ _ _ = Nothing

62declToJs _ _ _ _ = Nothing

69setProperty :: String -> JS -> Ident -> JS

64setProperty :: String -> JS -> Ident -> JS

70−setProperty prop val mod = JSAssignment (JSAssignProperty prop (JSAssignVariable mod)) val

65+setProperty prop val curMod = JSAssignment (JSAssignProperty prop (JSAssignVariable curMod)) val

72valueToJs :: ModulePath -> Environment -> Value -> JS

67valueToJs :: ModulePath -> Environment -> Value -> JS

73valueToJs _ _ (NumericLiteral n) = JSNumericLiteral n

68valueToJs _ _ (NumericLiteral n) = JSNumericLiteral n

@@ -76,7 +71,7 @@ valueToJs _ _ (BooleanLiteral b) = JSBooleanLiteral b

76valueToJs m e (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs m e) xs)

71valueToJs m e (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs m e) xs)

77valueToJs m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs m e)) ps)

72valueToJs m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs m e)) ps)

78valueToJs m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar (Ident "Object"))) [ valueToJs m e o, JSObjectLiteral (map (second (valueToJs m e)) ps)]

73valueToJs m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar (Ident "Object"))) [ valueToJs m e o, JSObjectLiteral (map (second (valueToJs m e)) ps)]

79−valueToJs m e (Constructor name) = qualifiedToJS runProperName name

74+valueToJs _ _ (Constructor name) = qualifiedToJS runProperName name

80valueToJs m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs m e) sts))) []

75valueToJs m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs m e) sts))) []

81valueToJs m e (Case value binders) = runGen (bindersToJs m e binders (valueToJs m e value))

76valueToJs m e (Case value binders) = runGen (bindersToJs m e binders (valueToJs m e value))

82valueToJs m e (IfThenElse cond th el) = JSConditional (valueToJs m e cond) (valueToJs m e th) (valueToJs m e el)

77valueToJs m e (IfThenElse cond th el) = JSConditional (valueToJs m e cond) (valueToJs m e th) (valueToJs m e el)

@@ -90,12 +85,14 @@ valueToJs m e (Var ident) = case M.lookup (qualify m ident) (names e) of

90 Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS identToJs (Qualified aliasModule aliasIdent)

85 Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS identToJs (Qualified aliasModule aliasIdent)

91 _ -> qualifiedToJS identToJs ident

86 _ -> qualifiedToJS identToJs ident

92valueToJs m e (TypedValue val _) = valueToJs m e val

87valueToJs m e (TypedValue val _) = valueToJs m e val

88+valueToJs _ _ _ = error "Invalid argument to valueToJs"

94qualifiedToJS :: (a -> String) -> Qualified a -> JS

90qualifiedToJS :: (a -> String) -> Qualified a -> JS

95qualifiedToJS f (Qualified (ModulePath parts) a) =

91qualifiedToJS f (Qualified (ModulePath parts) a) =

96 delimited (f a : reverse (map show parts))

92 delimited (f a : reverse (map show parts))

97 where delimited [part] = JSVar (Ident (part))

93 where delimited [part] = JSVar (Ident (part))

98− delimited (part:parts) = JSAccessor part (delimited parts)

94+ delimited (part:parts') = JSAccessor part (delimited parts')

95+ delimited _ = error "Invalid argument to delimited"

100bindersToJs :: ModulePath -> Environment -> [(Binder, Value)] -> JS -> Gen JS

97bindersToJs :: ModulePath -> Environment -> [(Binder, Value)] -> JS -> Gen JS

101bindersToJs m e binders val = do

98bindersToJs m e binders val = do

@@ -105,7 +102,7 @@ bindersToJs m e binders val = do

105 [val]

102 [val]

106

103

107binderToJs :: ModulePath -> Environment -> String -> [JS] -> Binder -> Gen [JS]

104binderToJs :: ModulePath -> Environment -> String -> [JS] -> Binder -> Gen [JS]

108−binderToJs _ _ varName done NullBinder = return done

105+binderToJs _ _ _ done NullBinder = return done

109binderToJs _ _ varName done (StringBinder str) =

106binderToJs _ _ varName done (StringBinder str) =

110 return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSStringLiteral str)) (JSBlock done) Nothing]

107 return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSStringLiteral str)) (JSBlock done) Nothing]

111binderToJs _ _ varName done (NumberBinder num) =

108binderToJs _ _ varName done (NumberBinder num) =

@@ -114,9 +111,9 @@ binderToJs _ _ varName done (BooleanBinder True) =

114 return [JSIfElse (JSVar (Ident varName)) (JSBlock done) Nothing]

111 return [JSIfElse (JSVar (Ident varName)) (JSBlock done) Nothing]

115binderToJs _ _ varName done (BooleanBinder False) =

112binderToJs _ _ varName done (BooleanBinder False) =

116 return [JSIfElse (JSUnary Not (JSVar (Ident varName))) (JSBlock done) Nothing]

113 return [JSIfElse (JSUnary Not (JSVar (Ident varName))) (JSBlock done) Nothing]

117−binderToJs _ e varName done (VarBinder ident) =

114+binderToJs _ _ varName done (VarBinder ident) =

118 return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : done)

115 return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : done)

119−binderToJs m e varName done (NullaryBinder ctor) =

116+binderToJs m _ varName done (NullaryBinder ctor) =

120 return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral (show (uncurry Qualified $ qualify m ctor)))) (JSBlock done) Nothing]

117 return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral (show (uncurry Qualified $ qualify m ctor)))) (JSBlock done) Nothing]

121binderToJs m e varName done (UnaryBinder ctor b) = do

118binderToJs m e varName done (UnaryBinder ctor b) = do

122 value <- fresh

119 value <- fresh

@@ -125,11 +122,11 @@ binderToJs m e varName done (UnaryBinder ctor b) = do

125binderToJs m e varName done (ObjectBinder bs) = go done bs

122binderToJs m e varName done (ObjectBinder bs) = go done bs

126 where

123 where

127 go :: [JS] -> [(String, Binder)] -> Gen [JS]

124 go :: [JS] -> [(String, Binder)] -> Gen [JS]

128− go done [] = return done

125+ go done' [] = return done'

129− go done ((prop, binder):bs) = do

126+ go done' ((prop, binder):bs') = do

130 propVar <- fresh

127 propVar <- fresh

131− done' <- go done bs

128+ done'' <- go done' bs'

132− js <- binderToJs m e propVar done' binder

129+ js <- binderToJs m e propVar done'' binder

133 return (JSVariableIntroduction (Ident propVar) (Just (JSAccessor prop (JSVar (Ident varName)))) : js)

130 return (JSVariableIntroduction (Ident propVar) (Just (JSAccessor prop (JSVar (Ident varName)))) : js)

134binderToJs m e varName done (ArrayBinder bs rest) = do

131binderToJs m e varName done (ArrayBinder bs rest) = do

135 js <- go done rest 0 bs

132 js <- go done rest 0 bs

@@ -138,15 +135,15 @@ binderToJs m e varName done (ArrayBinder bs rest) = do

138 cmp :: BinaryOperator

135 cmp :: BinaryOperator

139 cmp = maybe EqualTo (const GreaterThanOrEqualTo) rest

136 cmp = maybe EqualTo (const GreaterThanOrEqualTo) rest

140 go :: [JS] -> Maybe Binder -> Integer -> [Binder] -> Gen [JS]

137 go :: [JS] -> Maybe Binder -> Integer -> [Binder] -> Gen [JS]

141− go done Nothing _ [] = return done

138+ go done' Nothing _ [] = return done'

142− go done (Just binder) index [] = do

139+ go done' (Just binder) index [] = do

143 restVar <- fresh

140 restVar <- fresh

144− js <- binderToJs m e restVar done binder

141+ js <- binderToJs m e restVar done' binder

145 return (JSVariableIntroduction (Ident restVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left index)])) : js)

142 return (JSVariableIntroduction (Ident restVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left index)])) : js)

146− go done rest index (binder:bs) = do

143+ go done' rest' index (binder:bs') = do

147 elVar <- fresh

144 elVar <- fresh

148− done' <- go done rest (index + 1) bs

145+ done'' <- go done' rest' (index + 1) bs'

149− js <- binderToJs m e elVar done' binder

146+ js <- binderToJs m e elVar done'' binder

150 return (JSVariableIntroduction (Ident elVar) (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar (Ident varName)))) : js)

147 return (JSVariableIntroduction (Ident elVar) (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar (Ident varName)))) : js)

151binderToJs m e varName done (NamedBinder ident binder) = do

148binderToJs m e varName done (NamedBinder ident binder) = do

152 js <- binderToJs m e varName done binder

149 js <- binderToJs m e varName done binder

@@ -167,5 +164,5 @@ statementToJs m e (If ifst) = ifToJs ifst

167 ifToJs (IfStatement cond thens elses) = JSIfElse (valueToJs m e cond) (JSBlock (map (statementToJs m e) thens)) (fmap elseToJs elses)

164 ifToJs (IfStatement cond thens elses) = JSIfElse (valueToJs m e cond) (JSBlock (map (statementToJs m e) thens)) (fmap elseToJs elses)

168 elseToJs :: ElseStatement -> JS

165 elseToJs :: ElseStatement -> JS

169 elseToJs (Else sts) = JSBlock (map (statementToJs m e) sts)

166 elseToJs (Else sts) = JSBlock (map (statementToJs m e) sts)

170− elseToJs (ElseIf ifst) = ifToJs ifst

167+ elseToJs (ElseIf elif) = ifToJs elif

171statementToJs m e (Return value) = JSReturn (valueToJs m e value)

168statementToJs m e (Return value) = JSReturn (valueToJs m e value)

src/Language/PureScript/Operators.hs+2−4

@@ -22,7 +22,6 @@ import Language.PureScript.Names

22import Language.PureScript.Declarations

23import Language.PureScript.Values

25−import qualified Data.Data as D

26import Data.Function (on)

25import Data.Function (on)

27import Data.List (groupBy, sortBy)

26import Data.List (groupBy, sortBy)

28import qualified Data.Map as M

27import qualified Data.Map as M

@@ -62,10 +61,10 @@ matchOperators ops val = G.everywhereM' (G.mkM parseChains) val

62 where

61 where

63 parseChains :: Value -> Either String Value

62 parseChains :: Value -> Either String Value

64 parseChains b@(BinaryNoParens _ _ _) = bracketChain (extendChain b)

63 parseChains b@(BinaryNoParens _ _ _) = bracketChain (extendChain b)

65− parseChains val = return val

64+ parseChains other = return other

66 extendChain :: Value -> Chain

65 extendChain :: Value -> Chain

67 extendChain (BinaryNoParens name l r) = Left l : Right name : extendChain r

66 extendChain (BinaryNoParens name l r) = Left l : Right name : extendChain r

68− extendChain val = [Left val]

67+ extendChain other = [Left other]

69 bracketChain :: Chain -> Either String Value

68 bracketChain :: Chain -> Either String Value

70 bracketChain = either (Left . show) Right . P.parse (P.buildExpressionParser opTable parseValue <* P.eof) "operator expression"

69 bracketChain = either (Left . show) Right . P.parse (P.buildExpressionParser opTable parseValue <* P.eof) "operator expression"

71 opTable = map (map (\(name, f, a) -> P.Infix (P.try (matchOp name) >> return f) (toAssoc a))) ops

70 opTable = map (map (\(name, f, a) -> P.Infix (P.try (matchOp name) >> return f) (toAssoc a))) ops

@@ -113,7 +112,6 @@ builtIns = [ (globalOp "<", Binary LessThan, 3, Infixl)

113 , (globalOp "/", Binary Divide, 5, Infixl)

112 , (globalOp "/", Binary Divide, 5, Infixl)

114 , (globalOp "%", Binary Modulus, 5, Infixl)

113 , (globalOp "%", Binary Modulus, 5, Infixl)

115 , (globalOp "++", Binary Concat, 6, Infixr)

114 , (globalOp "++", Binary Concat, 6, Infixr)

116− , (globalOp ":", Binary Cons, 6, Infixr)

117 , (globalOp "+", Binary Add, 7, Infixl)

115 , (globalOp "+", Binary Add, 7, Infixl)

118 , (globalOp "-", Binary Subtract, 7, Infixl)

116 , (globalOp "-", Binary Subtract, 7, Infixl)

119 , (globalOp "<<", Binary ShiftLeft, 8, Infixl)

117 , (globalOp "<<", Binary ShiftLeft, 8, Infixl)

src/Language/PureScript/Optimize.hs+1−1

@@ -29,7 +29,7 @@ replaceIdent :: (Data d) => Ident -> JS -> d -> d

29replaceIdent var1 js = everywhere (mkT replace)

30 where

31 replace (JSVar var2) | var1 == var2 = js

32− replace js = js

32+ replace other = other

34isReassigned :: (Data d) => Ident -> d -> Bool

35isReassigned var1 = everything (||) (mkQ False check)

src/Language/PureScript/Parser/Common.hs+2−2

@@ -74,7 +74,7 @@ reservedNames = [ "case"

75builtInOperators :: [String]

76builtInOperators = [ "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"

77− , "==", "!=", "&&", "||", "&", "^", "|", "!!", "!", ":" ]

77+ , "==", "!=", "&&", "||", "&", "^", "|", "!!", "!" ]

79reservedOpNames :: [String]

80reservedOpNames = builtInOperators ++ [ "->" ]

@@ -89,7 +89,7 @@ identLetter :: P.Parsec String u Char

89identLetter = P.alphaNum <|> P.oneOf "_'"

91opStart :: P.Parsec String u Char

92−opStart = P.oneOf "!#$%&*+/<=>?@^|~:"

92+opStart = P.oneOf "!#$%&*+/<=>?@^|~"

94opLetter :: P.Parsec String u Char

95opLetter = P.oneOf ":#$%&*+./<=>?@^|"

src/Language/PureScript/Parser/Declarations.hs−10

@@ -17,20 +17,10 @@ module Language.PureScript.Parser.Declarations (

17 parseDeclarations

18) where

20−import Data.Char

21−import Data.List

22−import Data.Maybe

23−import Data.Function

24import Control.Applicative

20import Control.Applicative

25−import Control.Arrow (Arrow(..))

26−import Control.Monad.State

27−import qualified Data.Map as M

28import qualified Text.Parsec as P

21import qualified Text.Parsec as P

29−import qualified Text.Parsec.Pos as P

31import Language.PureScript.Names

23import Language.PureScript.Names

32−import Language.PureScript.Values

33−import Language.PureScript.Types

34import Language.PureScript.Parser.State

24import Language.PureScript.Parser.State

35import Language.PureScript.Parser.Common

25import Language.PureScript.Parser.Common

36import Language.PureScript.Declarations

26import Language.PureScript.Declarations

src/Language/PureScript/Parser/State.hs−4

@@ -14,11 +14,7 @@

15module Language.PureScript.Parser.State where

17−import Language.PureScript.Names

18−import Language.PureScript.Declarations

19−

20import qualified Text.Parsec as P

17import qualified Text.Parsec as P

21−import qualified Data.Map as M

23data ParseState = ParseState

19data ParseState = ParseState

24 { indentationLevel :: P.Column } deriving Show

20 { indentationLevel :: P.Column } deriving Show

src/Language/PureScript/Parser/Values.hs+2−15

@@ -18,21 +18,12 @@ module Language.PureScript.Parser.Values (

18) where

20import Language.PureScript.Values

21−import Language.PureScript.Names

22−import Language.PureScript.Declarations

23import Language.PureScript.Parser.State

21import Language.PureScript.Parser.State

24−import Data.Function (on)

25−import Data.List

26−import Data.Functor.Identity

27−import qualified Data.Map as M

28import qualified Language.PureScript.Parser.Common as C

22import qualified Language.PureScript.Parser.Common as C

29import Control.Applicative

23import Control.Applicative

30import qualified Text.Parsec as P

24import qualified Text.Parsec as P

31import Text.Parsec.Expr

25import Text.Parsec.Expr

32−import Control.Monad

33−import Control.Arrow (Arrow(..))

34import Language.PureScript.Parser.Types

26import Language.PureScript.Parser.Types

35−import Language.PureScript.Types

37booleanLiteral :: P.Parsec String ParseState Bool

28booleanLiteral :: P.Parsec String ParseState Bool

38booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)

29booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)

@@ -74,10 +65,6 @@ parseAbs = do

74 toFunction [] value = Abs [] value

65 toFunction [] value = Abs [] value

75 toFunction args value = foldr (($)) value args

66 toFunction args value = foldr (($)) value args

77−parseApp :: P.Parsec String ParseState Value

78−parseApp = App <$> parseValue

79− <*> (C.indented *> C.parens (C.commaSep parseValue))

80−

81parseVar :: P.Parsec String ParseState Value

68parseVar :: P.Parsec String ParseState Value

82parseVar = Var <$> C.parseQualified C.parseIdent

69parseVar = Var <$> C.parseQualified C.parseIdent

@@ -172,12 +159,12 @@ parseWhile = While <$> (C.reserved "while" *> C.indented *> parseValue <* C.inde

172parseFor :: P.Parsec String ParseState Statement

159parseFor :: P.Parsec String ParseState Statement

173parseFor = For <$> (C.reserved "for" *> C.indented *> C.parseIdent)

160parseFor = For <$> (C.reserved "for" *> C.indented *> C.parseIdent)

174 <*> (C.indented *> C.lexeme (P.string "<-") *> parseValue)

161 <*> (C.indented *> C.lexeme (P.string "<-") *> parseValue)

175− <*> (C.indented *> C.reserved "until" *> parseValue <* C.colon)

162+ <*> (C.indented *> C.reserved "until" *> parseValue <* C.indented <* C.colon)

176 <*> parseManyStatements

163 <*> parseManyStatements

177

164

178parseForEach :: P.Parsec String ParseState Statement

165parseForEach :: P.Parsec String ParseState Statement

179parseForEach = ForEach <$> (C.reserved "foreach" *> C.indented *> C.parseIdent)

166parseForEach = ForEach <$> (C.reserved "foreach" *> C.indented *> C.parseIdent)

180− <*> (C.indented *> C.reserved "in" *> parseValue <* C.colon)

167+ <*> (C.indented *> C.reserved "in" *> parseValue <* C.indented <* C.colon)

181 <*> parseManyStatements

168 <*> parseManyStatements

182

169

183parseIf :: P.Parsec String ParseState Statement

170parseIf :: P.Parsec String ParseState Statement

src/Language/PureScript/Pretty/Common.hs+6−13

@@ -17,20 +17,13 @@

17module Language.PureScript.Pretty.Common where

19import Data.Char

20−import Data.Maybe (fromMaybe)

21−import Data.List (nub, intersperse, intercalate)

22−import Data.Function (fix)

23import Control.Monad.State

20import Control.Monad.State

24−import Control.Applicative (Applicative(..), Alternative(..))

25import qualified Control.Category as C

21import qualified Control.Category as C

26import Control.Category ((>>>))

22import Control.Category ((>>>))

27import qualified Control.Arrow as A

23import qualified Control.Arrow as A

28import Control.Arrow ((***), (<+>))

24import Control.Arrow ((***), (<+>))

30import Language.PureScript.Names

26import Language.PureScript.Names

31−import Language.PureScript.Values

32−import Language.PureScript.Types

33−import Language.PureScript.Declarations

35identToJs :: Ident -> String

28identToJs :: Ident -> String

36identToJs (Ident name) = name

29identToJs (Ident name) = name

@@ -57,16 +50,16 @@ parens :: String -> String

57parens s = ('(':s) ++ ")"

50parens s = ('(':s) ++ ")"

59chainl :: Pattern u a (a, a) -> (r -> r -> r) -> Pattern u a r -> Pattern u a r

52chainl :: Pattern u a (a, a) -> (r -> r -> r) -> Pattern u a r -> Pattern u a r

60−chainl split f p = fix $ \c -> split >>> ((c <+> p) *** p) >>> A.arr (uncurry f)

53+chainl g f p = fix $ \c -> g >>> ((c <+> p) *** p) >>> A.arr (uncurry f)

62chainr :: Pattern u a (a, a) -> (r -> r -> r) -> Pattern u a r -> Pattern u a r

55chainr :: Pattern u a (a, a) -> (r -> r -> r) -> Pattern u a r -> Pattern u a r

63−chainr split f p = fix $ \c -> split >>> (p *** (c <+> p)) >>> A.arr (uncurry f)

56+chainr g f p = fix $ \c -> g >>> (p *** (c <+> p)) >>> A.arr (uncurry f)

65wrap :: Pattern u a (s, a) -> (s -> r -> r) -> Pattern u a r -> Pattern u a r

58wrap :: Pattern u a (s, a) -> (s -> r -> r) -> Pattern u a r -> Pattern u a r

66−wrap split f p = fix $ \c -> split >>> (C.id *** (c <+> p)) >>> A.arr (uncurry f)

59+wrap g f p = fix $ \c -> g >>> (C.id *** (c <+> p)) >>> A.arr (uncurry f)

68−split :: Pattern u a (s, t) -> (s -> t -> r) -> Pattern u a r -> Pattern u a r

61+split :: Pattern u a (s, t) -> (s -> t -> r) -> Pattern u a r

69−split s f p = s >>> A.arr (uncurry f)

62+split s f = s >>> A.arr (uncurry f)

71data OperatorTable u a r = OperatorTable { runOperatorTable :: [ [Operator u a r] ] }

64data OperatorTable u a r = OperatorTable { runOperatorTable :: [ [Operator u a r] ] }

@@ -82,5 +75,5 @@ buildPrettyPrinter table p = foldl (\p' ops -> foldl1 (<+>) (flip map ops $ \op

82 AssocL pat g -> chainl pat g p'

75 AssocL pat g -> chainl pat g p'

83 AssocR pat g -> chainr pat g p'

76 AssocR pat g -> chainr pat g p'

84 Wrap pat g -> wrap pat g p'

77 Wrap pat g -> wrap pat g p'

85− Split pat g -> split pat g p'

78+ Split pat g -> split pat g

86 ) <+> p') p $ runOperatorTable table

79 ) <+> p') p $ runOperatorTable table

src/Language/PureScript/Pretty/JS.hs+15−16

@@ -24,7 +24,7 @@ import Language.PureScript.CodeGen.JS.AST

24import Data.List

25import Data.Maybe (fromMaybe)

26import qualified Control.Arrow as A

27−import Control.Arrow ((***), (<+>), first, second)

27+import Control.Arrow ((<+>))

28import Control.Applicative

29import Control.Monad.State

@@ -34,11 +34,10 @@ blockIndent :: Int

34blockIndent = 4

36withIndent :: StateT PrinterState Maybe String -> StateT PrinterState Maybe String

37−withIndent s = do

37+withIndent action = do

38− current <- get

39− modify $ \s -> s { indent = indent s + blockIndent }

38+ modify $ \st -> st { indent = indent st + blockIndent }

40− result <- s

39+ result <- action

41− modify $ \s -> s { indent = indent s - blockIndent }

40+ modify $ \st -> st { indent = indent st - blockIndent }

42 return result

41 return result

44currentIndent :: StateT PrinterState Maybe String

43currentIndent :: StateT PrinterState Maybe String

@@ -158,22 +157,22 @@ app = mkPattern' match

158 match _ = mzero

157 match _ = mzero

159

158

160unary :: UnaryOperator -> String -> Operator PrinterState JS String

159unary :: UnaryOperator -> String -> Operator PrinterState JS String

161−unary op str = Wrap pattern (++)

160+unary op str = Wrap match (++)

162 where

161 where

163− pattern :: Pattern PrinterState JS (String, JS)

162+ match :: Pattern PrinterState JS (String, JS)

164− pattern = mkPattern match

163+ match = mkPattern match'

165 where

164 where

166− match (JSUnary op' val) | op' == op = Just (str, val)

165+ match' (JSUnary op' val) | op' == op = Just (str, val)

167− match _ = Nothing

166+ match' _ = Nothing

168

167

169binary :: BinaryOperator -> String -> Operator PrinterState JS String

168binary :: BinaryOperator -> String -> Operator PrinterState JS String

170−binary op str = AssocR pattern (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2)

169+binary op str = AssocR match (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2)

171 where

170 where

172− pattern :: Pattern PrinterState JS (JS, JS)

171+ match :: Pattern PrinterState JS (JS, JS)

173− pattern = mkPattern match

172+ match = mkPattern match'

174 where

173 where

175− match (JSBinary op' v1 v2) | op' == op = Just (v1, v2)

174+ match' (JSBinary op' v1 v2) | op' == op = Just (v1, v2)

176− match _ = Nothing

175+ match' _ = Nothing

177

176

178prettyPrintJS1 :: JS -> String

177prettyPrintJS1 :: JS -> String

179prettyPrintJS1 = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyPrintJS'

178prettyPrintJS1 = fromMaybe (error "Incomplete pattern") . flip evalStateT (PrinterState 0) . prettyPrintJS'

src/Language/PureScript/Pretty/Kinds.hs+1−5

@@ -17,15 +17,11 @@ module Language.PureScript.Pretty.Kinds (

17) where

19import Data.Maybe (fromMaybe)

20−import Data.List (intersperse, intercalate)

21−import qualified Control.Arrow as A

22−import Control.Arrow ((<+>))

23−import qualified Data.Map as M

24−import Control.Applicative

26import Language.PureScript.Kinds

21import Language.PureScript.Kinds

27import Language.PureScript.Pretty.Common

22import Language.PureScript.Pretty.Common

28import Language.PureScript.Unknown

23import Language.PureScript.Unknown

24+import Control.Arrow (ArrowPlus(..))

30typeLiterals :: Pattern () Kind String

26typeLiterals :: Pattern () Kind String

31typeLiterals = mkPattern match

27typeLiterals = mkPattern match

src/Language/PureScript/Pretty/Types.hs+3−9

@@ -18,17 +18,10 @@ module Language.PureScript.Pretty.Types (

18) where

20import Data.Maybe (fromMaybe)

21−import Data.List (intersperse, intercalate)

21+import Data.List (intercalate)

22−import qualified Control.Arrow as A

23import Control.Arrow ((<+>))

22import Control.Arrow ((<+>))

24−import qualified Data.Map as M

25−import Control.Applicative

27−import Language.PureScript.Values

28import Language.PureScript.Types

24import Language.PureScript.Types

29−import Language.PureScript.Names

30−import Language.PureScript.Declarations

31−import Language.PureScript.TypeChecker.Monad

32import Language.PureScript.Pretty.Common

25import Language.PureScript.Pretty.Common

33import Language.PureScript.Unknown

26import Language.PureScript.Unknown

@@ -49,7 +42,7 @@ typeLiterals = mkPattern match

49 match _ = Nothing

42 match _ = Nothing

51prettyPrintRow :: Row -> String

44prettyPrintRow :: Row -> String

52−prettyPrintRow = (\(tys, tail) -> intercalate ", " (map (uncurry nameAndTypeToPs) tys) ++ tailToPs tail) . toList []

45+prettyPrintRow = (\(tys, rest) -> intercalate ", " (map (uncurry nameAndTypeToPs) tys) ++ tailToPs rest) . toList []

53 where

46 where

54 nameAndTypeToPs :: String -> Type -> String

47 nameAndTypeToPs :: String -> Type -> String

55 nameAndTypeToPs name ty = name ++ " :: " ++ prettyPrintType ty

48 nameAndTypeToPs name ty = name ++ " :: " ++ prettyPrintType ty

@@ -58,6 +51,7 @@ prettyPrintRow = (\(tys, tail) -> intercalate ", " (map (uncurry nameAndTypeToPs

58 tailToPs (RUnknown (Unknown u)) = " | u" ++ show u

51 tailToPs (RUnknown (Unknown u)) = " | u" ++ show u

59 tailToPs (RowVar var) = " | " ++ var

52 tailToPs (RowVar var) = " | " ++ var

60 tailToPs (RSkolem s) = " | s" ++ show s

53 tailToPs (RSkolem s) = " | s" ++ show s

54+ tailToPs _ = error "Invalid row tail"

61 toList :: [(String, Type)] -> Row -> ([(String, Type)], Row)

55 toList :: [(String, Type)] -> Row -> ([(String, Type)], Row)

62 toList tys (RCons name ty row) = toList ((name, ty):tys) row

56 toList tys (RCons name ty row) = toList ((name, ty):tys) row

63 toList tys r = (tys, r)

57 toList tys r = (tys, r)

src/Language/PureScript/Pretty/Values.hs+10−15

@@ -17,16 +17,12 @@ module Language.PureScript.Pretty.Values (

17 prettyPrintBinder

18) where

20−import Data.Char

21import Data.Maybe (fromMaybe)

20import Data.Maybe (fromMaybe)

22import Data.List (intercalate)

21import Data.List (intercalate)

23−import qualified Control.Arrow as A

24import Control.Arrow ((<+>))

22import Control.Arrow ((<+>))

25−import Control.Applicative

27import Language.PureScript.Types

24import Language.PureScript.Types

28import Language.PureScript.Values

25import Language.PureScript.Values

29−import Language.PureScript.Names

30import Language.PureScript.Pretty.Common

26import Language.PureScript.Pretty.Common

31import Language.PureScript.Pretty.Types

27import Language.PureScript.Pretty.Types

@@ -91,22 +87,22 @@ typed = mkPattern match

91 match _ = Nothing

87 match _ = Nothing

93unary :: UnaryOperator -> String -> Operator () Value String

89unary :: UnaryOperator -> String -> Operator () Value String

94−unary op str = Wrap pattern (++)

90+unary op str = Wrap match (++)

95 where

91 where

96− pattern :: Pattern () Value (String, Value)

92+ match :: Pattern () Value (String, Value)

97− pattern = mkPattern match

93+ match = mkPattern match'

98 where

94 where

99− match (Unary op' val) | op' == op = Just (str, val)

95+ match' (Unary op' val) | op' == op = Just (str, val)

100− match _ = Nothing

96+ match' _ = Nothing

101

102binary :: BinaryOperator -> String -> Operator () Value String

98binary :: BinaryOperator -> String -> Operator () Value String

103−binary op str = AssocR pattern (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2)

99+binary op str = AssocR match (\v1 v2 -> v1 ++ " " ++ str ++ " " ++ v2)

104 where

100 where

105− pattern :: Pattern () Value (Value, Value)

101+ match :: Pattern () Value (Value, Value)

106− pattern = mkPattern match

102+ match = mkPattern match'

107 where

103 where

108− match (Binary op' v1 v2) | op' == op = Just (v1, v2)

104+ match' (Binary op' v1 v2) | op' == op = Just (v1, v2)

109− match _ = Nothing

105+ match' _ = Nothing

110

106

111prettyPrintValue :: Value -> String

107prettyPrintValue :: Value -> String

112prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue ()

108prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue ()

@@ -133,7 +129,6 @@ prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue (

133 , [ binary Divide "/" ]

129 , [ binary Divide "/" ]

134 , [ binary Modulus "%" ]

130 , [ binary Modulus "%" ]

135 , [ binary Concat "++" ]

131 , [ binary Concat "++" ]

136− , [ binary Cons ":" ]

137 , [ binary Add "+" ]

132 , [ binary Add "+" ]

138 , [ binary Subtract "-" ]

133 , [ binary Subtract "-" ]

139 , [ binary ShiftLeft "<<" ]

134 , [ binary ShiftLeft "<<" ]

src/Language/PureScript/TypeChecker.hs+5−8

@@ -24,9 +24,7 @@ import Language.PureScript.TypeChecker.Kinds as T

24import Language.PureScript.TypeChecker.Types as T

25import Language.PureScript.TypeChecker.Synonyms as T

27−import Data.List

28import Data.Maybe

27import Data.Maybe

29−import Data.Function

30import qualified Data.Map as M

28import qualified Data.Map as M

32import Language.PureScript.Values

30import Language.PureScript.Values

@@ -35,7 +33,6 @@ import Language.PureScript.Names

35import Language.PureScript.Kinds

33import Language.PureScript.Kinds

36import Language.PureScript.Declarations

34import Language.PureScript.Declarations

38−import Control.Monad (forM_)

39import Control.Monad.State

36import Control.Monad.State

40import Control.Monad.Error

37import Control.Monad.Error

@@ -74,7 +71,7 @@ typeCheckAll (ValueDeclaration name val : rest) = do

74 env <- getEnv

71 env <- getEnv

75 modulePath <- checkModulePath `fmap` get

72 modulePath <- checkModulePath `fmap` get

76 case M.lookup (modulePath, name) (names env) of

73 case M.lookup (modulePath, name) (names env) of

77− Just ty -> throwError $ show name ++ " is already defined"

74+ Just _ -> throwError $ show name ++ " is already defined"

78 Nothing -> do

75 Nothing -> do

79 ty <- typeOf (Just name) val

76 ty <- typeOf (Just name) val

80 putEnv (env { names = M.insert (modulePath, name) (ty, Value) (names env) })

77 putEnv (env { names = M.insert (modulePath, name) (ty, Value) (names env) })

@@ -101,7 +98,7 @@ typeCheckAll (ExternMemberDeclaration member name ty : rest) = do

101 typeCheckAll rest

98 typeCheckAll rest

102 where

99 where

103 isSingleArgumentFunction (Function [_] _) = True

100 isSingleArgumentFunction (Function [_] _) = True

104− isSingleArgumentFunction (ForAll _ ty) = isSingleArgumentFunction ty

101+ isSingleArgumentFunction (ForAll _ t) = isSingleArgumentFunction t

105 isSingleArgumentFunction _ = False

102 isSingleArgumentFunction _ = False

106typeCheckAll (ExternDeclaration name ty : rest) = do

103typeCheckAll (ExternDeclaration name ty : rest) = do

107 rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do

104 rethrow (("Error in foreign import declaration " ++ show name ++ ":\n") ++) $ do

@@ -128,13 +125,13 @@ typeCheckAll (ImportDeclaration modulePath idents : rest) = do

128 guardWith ("Module " ++ show modulePath ++ " does not exist") $ moduleExists env

125 guardWith ("Module " ++ show modulePath ++ " does not exist") $ moduleExists env

129 case idents of

126 case idents of

130 Nothing -> bindIdents (map snd $ filterModule env) currentModule env

127 Nothing -> bindIdents (map snd $ filterModule env) currentModule env

131− Just idents -> bindIdents idents currentModule env

128+ Just idents' -> bindIdents idents' currentModule env

132 typeCheckAll rest

129 typeCheckAll rest

133 where errorMessage = (("Error in import declaration " ++ show modulePath ++ ":\n") ++)

130 where errorMessage = (("Error in import declaration " ++ show modulePath ++ ":\n") ++)

134 filterModule = filter ((== modulePath) . fst) . M.keys . names

131 filterModule = filter ((== modulePath) . fst) . M.keys . names

135 moduleExists env = not $ null $ filterModule env

132 moduleExists env = not $ null $ filterModule env

136− bindIdents idents currentModule env =

133+ bindIdents idents' currentModule env =

137− forM_ idents $ \ident -> do

134+ forM_ idents' $ \ident -> do

138 guardWith (show currentModule ++ "." ++ show ident ++ " is already defined") $ (currentModule, ident) `M.notMember` names env

135 guardWith (show currentModule ++ "." ++ show ident ++ " is already defined") $ (currentModule, ident) `M.notMember` names env

139 case (modulePath, ident) `M.lookup` names env of

136 case (modulePath, ident) `M.lookup` names env of

140 Just (pt, _) -> modifyEnv (\e -> e { names = M.insert (currentModule, ident) (pt, Alias modulePath ident) (names e) })

137 Just (pt, _) -> modifyEnv (\e -> e { names = M.insert (currentModule, ident) (pt, Alias modulePath ident) (names e) })

src/Language/PureScript/TypeChecker/Kinds.hs+7−14

@@ -19,15 +19,9 @@ module Language.PureScript.TypeChecker.Kinds (

19 kindOf

20) where

22−import Data.List

23−import Data.Maybe (fromMaybe)

24−import Data.Function

25−import Data.Data

26−

27import Language.PureScript.Types

22import Language.PureScript.Types

28import Language.PureScript.Kinds

23import Language.PureScript.Kinds

29import Language.PureScript.Names

24import Language.PureScript.Names

30−import Language.PureScript.Declarations

31import Language.PureScript.TypeChecker.Monad

25import Language.PureScript.TypeChecker.Monad

32import Language.PureScript.Pretty

26import Language.PureScript.Pretty

33import Language.PureScript.Unknown

27import Language.PureScript.Unknown

@@ -36,8 +30,6 @@ import Control.Monad.State

36import Control.Monad.Error

30import Control.Monad.Error

38import Control.Applicative

32import Control.Applicative

39−import Control.Arrow (Kleisli(..), (***))

40−import qualified Control.Category as C

42import qualified Data.Map as M

34import qualified Data.Map as M

@@ -94,14 +86,14 @@ infer name m (Function args ret) = do

94 ks <- inferAll name m args

86 ks <- inferAll name m args

95 k <- infer name m ret

87 k <- infer name m ret

96 k ~~ Star

88 k ~~ Star

97− forM ks $ \k -> k ~~ Star

89+ forM ks (~~ Star)

98 return Star

90 return Star

99infer _ m (TypeVar v) =

91infer _ m (TypeVar v) =

100 case M.lookup v m of

92 case M.lookup v m of

101 Just k -> return k

93 Just k -> return k

102 Nothing -> throwError $ "Unbound type variable " ++ v

94 Nothing -> throwError $ "Unbound type variable " ++ v

103−infer (Just (name, k)) m c@(TypeConstructor v@(Qualified (ModulePath []) pn)) | name == pn = return k

95+infer (Just (name, k)) _ (TypeConstructor (Qualified (ModulePath []) pn)) | name == pn = return k

104−infer name m (TypeConstructor v) = do

96+infer _ _ (TypeConstructor v) = do

105 env <- liftCheck getEnv

97 env <- liftCheck getEnv

106 modulePath <- checkModulePath `fmap` get

98 modulePath <- checkModulePath `fmap` get

107 case M.lookup (qualify modulePath v) (types env) of

99 case M.lookup (qualify modulePath v) (types env) of

@@ -116,17 +108,18 @@ infer name m (TypeApp t1 t2) = do

116infer name m (ForAll ident ty) = do

108infer name m (ForAll ident ty) = do

117 k <- fresh

109 k <- fresh

118 infer name (M.insert ident k m) ty

110 infer name (M.insert ident k m) ty

119−infer _ m t = return Star

111+infer _ _ _ = return Star

120

112

121inferRow :: Maybe (ProperName, Kind) -> M.Map String Kind -> Row -> Subst Kind

113inferRow :: Maybe (ProperName, Kind) -> M.Map String Kind -> Row -> Subst Kind

122inferRow _ m (RowVar v) = do

114inferRow _ m (RowVar v) = do

123 case M.lookup v m of

115 case M.lookup v m of

124 Just k -> return k

116 Just k -> return k

125 Nothing -> throwError $ "Unbound row variable " ++ v

117 Nothing -> throwError $ "Unbound row variable " ++ v

126−inferRow _ m r@REmpty = return Row

118+inferRow _ _ REmpty = return Row

127−inferRow name m r@(RCons _ ty row) = do

119+inferRow name m (RCons _ ty row) = do

128 k1 <- infer name m ty

120 k1 <- infer name m ty

129 k2 <- inferRow name m row

121 k2 <- inferRow name m row

130 k1 ~~ Star

122 k1 ~~ Star

131 k2 ~~ Row

123 k2 ~~ Row

132 return Row

124 return Row

125+inferRow _ _ _ = error "Invalid row in inferRow"

src/Language/PureScript/TypeChecker/Monad.hs−3

@@ -25,13 +25,10 @@ import Language.PureScript.Unknown

25import Data.Data

26import Data.Maybe

27import Data.Monoid

28−import Data.Typeable

29import Control.Applicative

28import Control.Applicative

30import Control.Monad.State

29import Control.Monad.State

31import Control.Monad.Error

30import Control.Monad.Error

33−import Control.Arrow ((***), first, second)

34−

35import qualified Data.Map as M

32import qualified Data.Map as M

37data NameKind = Value | Extern | Alias ModulePath Ident | LocalVariable deriving Show

34data NameKind = Value | Extern | Alias ModulePath Ident | LocalVariable deriving Show

src/Language/PureScript/TypeChecker/Synonyms.hs+3−6

@@ -18,25 +18,22 @@ module Language.PureScript.TypeChecker.Synonyms (

18) where

20import Language.PureScript.Types

21−import Language.PureScript.Declarations

22import Language.PureScript.Names

21import Language.PureScript.Names

24import Data.Maybe (fromMaybe)

23import Data.Maybe (fromMaybe)

25import Data.Data

24import Data.Data

26import Data.Generics

25import Data.Generics

27import Data.Generics.Extras

26import Data.Generics.Extras

28−import Control.Arrow

29import Control.Monad.Writer

27import Control.Monad.Writer

30import Control.Monad.Error

28import Control.Monad.Error

31−import qualified Data.Map as M

33buildTypeSubstitution :: Qualified ProperName -> Int -> Type -> Either String (Maybe Type)

30buildTypeSubstitution :: Qualified ProperName -> Int -> Type -> Either String (Maybe Type)

34buildTypeSubstitution name n = go n []

31buildTypeSubstitution name n = go n []

35 where

32 where

36 go :: Int -> [Type] -> Type -> Either String (Maybe Type)

33 go :: Int -> [Type] -> Type -> Either String (Maybe Type)

37 go 0 args (TypeConstructor ctor) | name == ctor = return (Just $ SaturatedTypeSynonym ctor args)

34 go 0 args (TypeConstructor ctor) | name == ctor = return (Just $ SaturatedTypeSynonym ctor args)

38− go n _ (TypeConstructor ctor) | n > 0 && name == ctor = throwError $ "Partially applied type synonym " ++ show name

35+ go m _ (TypeConstructor ctor) | m > 0 && name == ctor = throwError $ "Partially applied type synonym " ++ show name

39− go n args (TypeApp f arg) = go (n - 1) (arg:args) f

36+ go m args (TypeApp f arg) = go (m - 1) (arg:args) f

40 go _ _ _ = return Nothing

37 go _ _ _ = return Nothing

42saturateTypeSynonym :: (Data d) => Qualified ProperName -> Int -> d -> Either String d

39saturateTypeSynonym :: (Data d) => Qualified ProperName -> Int -> d -> Either String d

@@ -45,7 +42,7 @@ saturateTypeSynonym name n = everywhereM' (mkM replace)

45 replace t = fmap (fromMaybe t) $ buildTypeSubstitution name n t

42 replace t = fmap (fromMaybe t) $ buildTypeSubstitution name n t

47saturateAllTypeSynonyms :: (Data d) => [(Qualified ProperName, Int)] -> d -> Either String d

44saturateAllTypeSynonyms :: (Data d) => [(Qualified ProperName, Int)] -> d -> Either String d

48−saturateAllTypeSynonyms syns d = foldM (\d (name, n) -> saturateTypeSynonym name n d) d syns

45+saturateAllTypeSynonyms syns d = foldM (\result (name, n) -> saturateTypeSynonym name n result) d syns

src/Language/PureScript/TypeChecker/Types.hs+39−44

@@ -19,12 +19,10 @@ module Language.PureScript.TypeChecker.Types (

19) where

21import Data.List

22−import Data.Maybe (isJust, fromMaybe)

22+import Data.Maybe (fromMaybe)

23−import Data.Function

24import qualified Data.Data as D

23import qualified Data.Data as D

25import Data.Generics

24import Data.Generics

26− (extT, something, everywhere, everywhereM, everything,

27− everywhereBut, mkT, mkM, mkQ, extM, extQ)

25+ (mkT, something, everywhere, everywhereBut, mkQ, extQ)

29import Language.PureScript.Values

27import Language.PureScript.Values

30import Language.PureScript.Types

28import Language.PureScript.Types

@@ -40,8 +38,7 @@ import Control.Monad.State

40import Control.Monad.Error

38import Control.Monad.Error

42import Control.Applicative

40import Control.Applicative

43−import Control.Arrow (Arrow(..), Kleisli(..), (***), (&&&), second)

41+import Control.Arrow (Arrow(..))

44−import qualified Control.Category as C

46import qualified Data.Map as M

43import qualified Data.Map as M

@@ -60,7 +57,7 @@ instance Unifiable Type where

60 apply _ t = t

57 apply _ t = t

61 unknowns (TUnknown (Unknown u)) = [u]

58 unknowns (TUnknown (Unknown u)) = [u]

62 unknowns (SaturatedTypeSynonym _ tys) = concatMap unknowns tys

59 unknowns (SaturatedTypeSynonym _ tys) = concatMap unknowns tys

63− unknowns (ForAll idents ty) = unknowns ty

60+ unknowns (ForAll _ ty) = unknowns ty

64 unknowns (Array t) = unknowns t

61 unknowns (Array t) = unknowns t

65 unknowns (Object r) = unknowns r

62 unknowns (Object r) = unknowns r

66 unknowns (Function args ret) = concatMap unknowns args ++ unknowns ret

63 unknowns (Function args ret) = concatMap unknowns args ++ unknowns ret

@@ -85,16 +82,16 @@ instance Unifiable Row where

85 unifyRows :: [(String, Type)] -> Row -> [(String, Type)] -> Row -> Subst ()

82 unifyRows :: [(String, Type)] -> Row -> [(String, Type)] -> Row -> Subst ()

86 unifyRows [] (RUnknown u) sd r = replace u (rowFromList (sd, r))

83 unifyRows [] (RUnknown u) sd r = replace u (rowFromList (sd, r))

87 unifyRows sd r [] (RUnknown u) = replace u (rowFromList (sd, r))

84 unifyRows sd r [] (RUnknown u) = replace u (rowFromList (sd, r))

88− unifyRows ns@((name, ty):row) r others u@(RUnknown un) = do

85+ unifyRows ((name, ty):row) r others u@(RUnknown un) = do

89 occursCheck un ty

86 occursCheck un ty

90− forM row $ \(_, ty) -> occursCheck un ty

87+ forM row $ \(_, t) -> occursCheck un t

91 u' <- fresh

88 u' <- fresh

92 u ~~ RCons name ty u'

89 u ~~ RCons name ty u'

93 unifyRows row r others u'

90 unifyRows row r others u'

94 unifyRows [] REmpty [] REmpty = return ()

91 unifyRows [] REmpty [] REmpty = return ()

95 unifyRows [] (RowVar v1) [] (RowVar v2) | v1 == v2 = return ()

92 unifyRows [] (RowVar v1) [] (RowVar v2) | v1 == v2 = return ()

96 unifyRows [] (RSkolem s1) [] (RSkolem s2) | s1 == s2 = return ()

93 unifyRows [] (RSkolem s1) [] (RSkolem s2) | s1 == s2 = return ()

97− unifyRows sd1 r1 sd2 r2 = throwError $ "Cannot unify " ++ prettyPrintRow (rowFromList (sd1, r1)) ++ " with " ++ prettyPrintRow (rowFromList (sd2, r2)) ++ "."

94+ unifyRows sd3 r3 sd4 r4 = throwError $ "Cannot unify " ++ prettyPrintRow (rowFromList (sd3, r3)) ++ " with " ++ prettyPrintRow (rowFromList (sd4, r4)) ++ "."

98 apply s (RUnknown u) = runSubstitution s u

95 apply s (RUnknown u) = runSubstitution s u

99 apply s (RCons name ty r) = RCons name (apply s ty) (apply s r)

96 apply s (RCons name ty r) = RCons name (apply s ty) (apply s r)

100 apply _ r = r

97 apply _ r = r

@@ -136,11 +133,11 @@ unifyTypes t1 t2 = rethrow (\e -> "Error unifying type " ++ prettyPrintType t1 +

136 unifyTypes' (TypeConstructor c1) (TypeConstructor c2) = do

133 unifyTypes' (TypeConstructor c1) (TypeConstructor c2) = do

137 modulePath <- checkModulePath `fmap` get

134 modulePath <- checkModulePath `fmap` get

138 guardWith ("Cannot unify " ++ show c1 ++ " with " ++ show c2 ++ ".") (qualify modulePath c1 == qualify modulePath c2)

135 guardWith ("Cannot unify " ++ show c1 ++ " with " ++ show c2 ++ ".") (qualify modulePath c1 == qualify modulePath c2)

139− unifyTypes' (TypeApp t1 t2) (TypeApp t3 t4) = do

136+ unifyTypes' (TypeApp t3 t4) (TypeApp t5 t6) = do

140− t1 `unifyTypes` t3

137+ t3 `unifyTypes` t5

141− t2 `unifyTypes` t4

138+ t4 `unifyTypes` t6

142 unifyTypes' (Skolem s1) (Skolem s2) | s1 == s2 = return ()

139 unifyTypes' (Skolem s1) (Skolem s2) | s1 == s2 = return ()

143− unifyTypes' t1 t2 = throwError $ "Cannot unify " ++ prettyPrintType t1 ++ " with " ++ prettyPrintType t2 ++ "."

140+ unifyTypes' t3 t4 = throwError $ "Cannot unify " ++ prettyPrintType t3 ++ " with " ++ prettyPrintType t4 ++ "."

144

141

145isFunction :: Value -> Bool

142isFunction :: Value -> Bool

146isFunction (Abs _ _) = True

143isFunction (Abs _ _) = True

@@ -152,12 +149,12 @@ typeOf name val = do

152 (ty, sub, checks) <- runSubst $ case name of

149 (ty, sub, checks) <- runSubst $ case name of

153 Just ident | isFunction val ->

150 Just ident | isFunction val ->

154 case val of

151 case val of

155− TypedValue val ty -> do

152+ TypedValue value ty -> do

156 kind <- liftCheck $ kindOf ty

153 kind <- liftCheck $ kindOf ty

157 guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star

154 guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star

158 ty' <- replaceAllTypeSynonyms ty

155 ty' <- replaceAllTypeSynonyms ty

159 modulePath <- checkModulePath <$> get

156 modulePath <- checkModulePath <$> get

160− bindNames (M.singleton (modulePath, ident) (ty, LocalVariable)) $ check val ty'

157+ bindNames (M.singleton (modulePath, ident) (ty, LocalVariable)) $ check value ty'

161 return ty'

158 return ty'

162 _ -> do

159 _ -> do

163 me <- fresh

160 me <- fresh

@@ -175,7 +172,7 @@ escapeCheck checks ty sub =

175 let

172 let

176 visibleUnknowns = nub $ unknowns ty

173 visibleUnknowns = nub $ unknowns ty

177 in

174 in

178− forM_ checks $ \check -> case check of

175+ forM_ checks $ \c -> case c of

179 AnyUnifiable t -> do

176 AnyUnifiable t -> do

180 let unsolvedUnknowns = nub . unknowns $ apply sub t

177 let unsolvedUnknowns = nub . unknowns $ apply sub t

181 guardWith "Escape check fails" $ null $ unsolvedUnknowns \\ visibleUnknowns

178 guardWith "Escape check fails" $ null $ unsolvedUnknowns \\ visibleUnknowns

@@ -214,18 +211,18 @@ replaceAllTypeVars :: (D.Data d) => [(String, Type)] -> d -> d

214replaceAllTypeVars = foldl' (\f (name, ty) -> replaceTypeVars name ty . f) id

211replaceAllTypeVars = foldl' (\f (name, ty) -> replaceTypeVars name ty . f) id

215

212

216replaceTypeVars :: (D.Data d) => String -> Type -> d -> d

213replaceTypeVars :: (D.Data d) => String -> Type -> d -> d

217−replaceTypeVars name t = everywhereBut (mkQ False isShadowed) (mkT replace)

214+replaceTypeVars name t = everywhereBut (mkQ False isShadowed) (mkT replaceTypeVar)

218 where

215 where

219− replace (TypeVar v) | v == name = t

216+ replaceTypeVar (TypeVar v) | v == name = t

220− replace t = t

217+ replaceTypeVar other = other

221 isShadowed (ForAll v _) | v == name = True

218 isShadowed (ForAll v _) | v == name = True

222 isShadowed _ = False

219 isShadowed _ = False

223

220

224replaceRowVars :: (D.Data d) => String -> Row -> d -> d

221replaceRowVars :: (D.Data d) => String -> Row -> d -> d

225−replaceRowVars name r = everywhere (mkT replace)

222+replaceRowVars name r = everywhere (mkT replaceRowVar)

226 where

223 where

227− replace (RowVar v) | v == name = r

224+ replaceRowVar (RowVar v) | v == name = r

228− replace t = t

225+ replaceRowVar other = other

229

226

230replaceAllVarsWithUnknowns :: Type -> Subst Type

227replaceAllVarsWithUnknowns :: Type -> Subst Type

231replaceAllVarsWithUnknowns (ForAll ident ty) = replaceVarWithUnknown ident ty >>= replaceAllVarsWithUnknowns

228replaceAllVarsWithUnknowns (ForAll ident ty) = replaceVarWithUnknown ident ty >>= replaceAllVarsWithUnknowns

@@ -244,14 +241,10 @@ replaceAllTypeSynonyms d = do

244 either throwError return $ saturateAllTypeSynonyms syns d

241 either throwError return $ saturateAllTypeSynonyms syns d

245

242

246desaturateAllTypeSynonyms :: (D.Data d) => d -> d

243desaturateAllTypeSynonyms :: (D.Data d) => d -> d

247−desaturateAllTypeSynonyms = everywhere (mkT replace)

244+desaturateAllTypeSynonyms = everywhere (mkT replaceSaturatedTypeSynonym)

248 where

245 where

249− replace (SaturatedTypeSynonym name args) = foldl TypeApp (TypeConstructor name) args

246+ replaceSaturatedTypeSynonym (SaturatedTypeSynonym name args) = foldl TypeApp (TypeConstructor name) args

250− replace t = t

247+ replaceSaturatedTypeSynonym t = t

251−

252−expandAllTypeSynonyms :: Type -> Subst Type

253−expandAllTypeSynonyms (SaturatedTypeSynonym name args) = expandTypeSynonym name args >>= expandAllTypeSynonyms

254−expandAllTypeSynonyms ty = return ty

255

248

256expandTypeSynonym :: Qualified ProperName -> [Type] -> Subst Type

249expandTypeSynonym :: Qualified ProperName -> [Type] -> Subst Type

257expandTypeSynonym name args = do

250expandTypeSynonym name args = do

@@ -276,9 +269,9 @@ infer' (StringLiteral _) = return String

276infer' (BooleanLiteral _) = return Boolean

269infer' (BooleanLiteral _) = return Boolean

277infer' (ArrayLiteral vals) = do

270infer' (ArrayLiteral vals) = do

278 ts <- mapM (infer) vals

271 ts <- mapM (infer) vals

279− arr <- fresh

272+ els <- fresh

280− forM_ ts $ \t -> arr ~~ Array t

273+ forM_ ts $ \t -> els ~~ Array t

281− return arr

274+ return els

282infer' (Unary op val) = do

275infer' (Unary op val) = do

283 t <- infer val

276 t <- infer val

284 inferUnary op t

277 inferUnary op t

@@ -324,7 +317,7 @@ infer' app@(App _ _) = do

324 ret <- fresh

317 ret <- fresh

325 checkFunctionApplications ft argss ret

318 checkFunctionApplications ft argss ret

326 return ret

319 return ret

327−infer' (Var var@(Qualified mp name)) = do

320+infer' (Var var) = do

328 ty <- lookupVariable var

321 ty <- lookupVariable var

329 replaceAllTypeSynonyms ty

322 replaceAllTypeSynonyms ty

330infer' (Block ss) = do

323infer' (Block ss) = do

@@ -355,6 +348,7 @@ infer' (TypedValue val ty) = do

355 ty' <- replaceAllTypeSynonyms ty

348 ty' <- replaceAllTypeSynonyms ty

356 check val ty'

349 check val ty'

357 return ty'

350 return ty'

351+infer' _ = error "Invalid argument to infer"

358

352

359inferProperty :: Type -> String -> Subst (Maybe Type)

353inferProperty :: Type -> String -> Subst (Maybe Type)

360inferProperty (Object row) prop = do

354inferProperty (Object row) prop = do

@@ -366,7 +360,7 @@ inferProperty (SaturatedTypeSynonym name args) prop = do

366inferProperty (ForAll ident ty) prop = do

360inferProperty (ForAll ident ty) prop = do

367 replaced <- replaceVarWithUnknown ident ty

361 replaced <- replaceVarWithUnknown ident ty

368 inferProperty replaced prop

362 inferProperty replaced prop

369−inferProperty _ prop = return Nothing

363+inferProperty _ _ = return Nothing

370

364

371inferUnary :: UnaryOperator -> Type -> Subst Type

365inferUnary :: UnaryOperator -> Type -> Subst Type

372inferUnary op val =

366inferUnary op val =

@@ -487,6 +481,7 @@ inferBinder val (ArrayBinder binders rest) = do

487inferBinder val (NamedBinder name binder) = do

481inferBinder val (NamedBinder name binder) = do

488 m <- inferBinder val binder

482 m <- inferBinder val binder

489 return $ M.insert name val m

483 return $ M.insert name val m

484+inferBinder _ _ = error "Invalid argument to inferBinder"

490

485

491inferGuardedBinder :: Type -> Binder -> Subst (M.Map Ident Type)

486inferGuardedBinder :: Type -> Binder -> Subst (M.Map Ident Type)

492inferGuardedBinder val (GuardedBinder cond binder) = do

487inferGuardedBinder val (GuardedBinder cond binder) = do

@@ -511,11 +506,11 @@ assignVariable name = do

511 _ -> return ()

506 _ -> return ()

512

507

513checkStatement :: M.Map Ident Type -> Type -> Statement -> Subst (Bool, M.Map Ident Type)

508checkStatement :: M.Map Ident Type -> Type -> Statement -> Subst (Bool, M.Map Ident Type)

514−checkStatement mass ret (VariableIntroduction name val) = do

509+checkStatement mass _ (VariableIntroduction name val) = do

515 assignVariable name

510 assignVariable name

516 t <- infer val

511 t <- infer val

517 return (False, M.insert name t mass)

512 return (False, M.insert name t mass)

518−checkStatement mass ret (Assignment ident val) = do

513+checkStatement mass _ (Assignment ident val) = do

519 t <- infer val

514 t <- infer val

520 case M.lookup ident mass of

515 case M.lookup ident mass of

521 Nothing -> throwError $ "No local variable with name " ++ show ident

516 Nothing -> throwError $ "No local variable with name " ++ show ident

@@ -567,7 +562,7 @@ checkBlock mass ret (s:ss) = do

567 bindLocalVariables (M.toList mass1) $ case (b1, ss) of

562 bindLocalVariables (M.toList mass1) $ case (b1, ss) of

568 (True, []) -> return (True, mass1)

563 (True, []) -> return (True, mass1)

569 (True, _) -> throwError "Unreachable code"

564 (True, _) -> throwError "Unreachable code"

570− (False, ss) -> checkBlock mass1 ret ss

565+ (False, ss') -> checkBlock mass1 ret ss'

571

566

572skolemize :: String -> Type -> Subst Type

567skolemize :: String -> Type -> Subst Type

573skolemize ident ty = do

568skolemize ident ty = do

@@ -609,7 +604,7 @@ check' app@(App _ _) ret = do

609 let (f, argss) = unfoldApplication app

604 let (f, argss) = unfoldApplication app

610 ft <- infer f

605 ft <- infer f

611 checkFunctionApplications ft argss ret

606 checkFunctionApplications ft argss ret

612−check' v@(Var var@(Qualified mp name)) ty = do

607+check' (Var var) ty = do

613 ty1 <- lookupVariable var

608 ty1 <- lookupVariable var

614 repl <- replaceAllTypeSynonyms ty1

609 repl <- replaceAllTypeSynonyms ty1

615 repl `subsumes` ty

610 repl `subsumes` ty

@@ -663,21 +658,21 @@ checkProperties ps row lax = let (ts, r') = rowToList row in go ps ts r' where

663 go [] ((p, _): _) _ | lax = return ()

658 go [] ((p, _): _) _ | lax = return ()

664 | otherwise = throwError $ prettyPrintValue (ObjectLiteral ps) ++ " does not have property " ++ p

659 | otherwise = throwError $ prettyPrintValue (ObjectLiteral ps) ++ " does not have property " ++ p

665 go ((p,_):_) [] REmpty = throwError $ "Property " ++ p ++ " is not present in closed object type " ++ prettyPrintRow row

660 go ((p,_):_) [] REmpty = throwError $ "Property " ++ p ++ " is not present in closed object type " ++ prettyPrintRow row

666− go ((p,v):ps) [] u@(RUnknown _) = do

661+ go ((p,v):ps') [] u@(RUnknown _) = do

667 ty <- infer v

662 ty <- infer v

668 rest <- fresh

663 rest <- fresh

669 u ~~ RCons p ty rest

664 u ~~ RCons p ty rest

670− go ps [] rest

665+ go ps' [] rest

671− go ((p,v):ps) ts r =

666+ go ((p,v):ps') ts r =

672 case lookup p ts of

667 case lookup p ts of

673 Nothing -> do

668 Nothing -> do

674 ty <- infer v

669 ty <- infer v

675 rest <- fresh

670 rest <- fresh

676 r ~~ RCons p ty rest

671 r ~~ RCons p ty rest

677− go ps ts rest

672+ go ps' ts rest

678 Just ty -> do

673 Just ty -> do

679 check v ty

674 check v ty

680− go ps (delete (p, ty) ts) r

675+ go ps' (delete (p, ty) ts) r

681 go _ _ _ = throwError $ prettyPrintValue (ObjectLiteral ps) ++ " does not have type " ++ prettyPrintType (Object row)

676 go _ _ _ = throwError $ prettyPrintValue (ObjectLiteral ps) ++ " does not have type " ++ prettyPrintType (Object row)

682

677

683unfoldApplication :: Value -> (Value, [[Value]])

678unfoldApplication :: Value -> (Value, [[Value]])

src/Language/PureScript/Types.hs+1−1

@@ -63,7 +63,7 @@ isPolyType (Object ps) = all isPolyType (map snd . fst $ rowToList ps)

63isPolyType (Function args ret) = all isPolyType args && isPolyType ret

64isPolyType (TypeApp t1 t2) = isMonoType t1 && isMonoType t2

65isPolyType (SaturatedTypeSynonym _ args) = all isPolyType args

66−isPolyType (ForAll idents ty) = isPolyType ty

66+isPolyType (ForAll _ ty) = isPolyType ty

67isPolyType _ = True

69mkForAll :: [String] -> Type -> Type

src/Language/PureScript/Unknown.hs−1

@@ -17,7 +17,6 @@

17module Language.PureScript.Unknown where

19import Data.Data

20−import Data.Typeable

22newtype Unknown t = Unknown { runUnknown :: Int } deriving (Show, Eq, Ord, Data, Typeable)

21newtype Unknown t = Unknown { runUnknown :: Int } deriving (Show, Eq, Ord, Data, Typeable)

src/Language/PureScript/Values.hs+1−2

@@ -46,8 +46,7 @@ data BinaryOperator

46 | ShiftLeft

47 | ShiftRight

48 | ZeroFillShiftRight

49− | Concat

50− | Cons deriving (Show, Eq, Data, Typeable)

49+ | Concat deriving (Show, Eq, Data, Typeable)

52data Value

51data Value

53 = NumericLiteral (Either Integer Double)

52 = NumericLiteral (Either Integer Double)