git.iko.soy/elk
on master help sign in
Merge pull request #4 from abhinav/master
5696b02Evan Czaplicki
src/Parse/Binop.hs+1−1
compare with master
unifiedsplit
@@ -26,7 +26,7 @@ sortOps = sortBy (\(i,_,_) (j,_,_) -> compare i j)
26binops term anyOp = do
26binops term anyOp = do
27 e <- term
27 e <- term
28 (ops,es) <- liftM unzip $ star (do { op <- anyOp; e <- term; return (op,e) })
28 (ops,es) <- liftM unzip $ star (do { op <- anyOp; e <- term; return (op,e) })
29− case binopOf (Map.empty) (sortOps table) ops (e:es) of
29+ case binopOf Map.empty (sortOps table) ops (e:es) of
30 Right e -> return e
30 Right e -> return e
31 Left msg -> zero
31 Left msg -> zero
32
32
src/Parse/Combinators.hs+6−6
@@ -13,7 +13,7 @@ instance Monad (Parser from) where
13 p >>= f = Parser (\cs -> concat [parse (f a) cs' | (a,cs') <- parse p cs])
13 p >>= f = Parser (\cs -> concat [parse (f a) cs' | (a,cs') <- parse p cs])
14
14
15instance MonadPlus (Parser from) where
15instance MonadPlus (Parser from) where
16− mzero = Parser (\cs -> [])
16+ mzero = Parser $ const []
17 mplus p q = Parser (\cs -> parse p cs ++ parse q cs)
17 mplus p q = Parser (\cs -> parse p cs ++ parse q cs)
18
18
19-- True recursive descent, tries everything.
19-- True recursive descent, tries everything.
@@ -24,7 +24,7 @@ p +|+ q = Parser (\cs -> case parse (mplus p q) cs of
24 [] -> []
24 [] -> []
25 (x:xs) -> [x])
25 (x:xs) -> [x])
26
26
27−zero = Parser (\cs -> [])
27+zero = Parser $ const []
28
28
29item = Parser (\cs -> case cs of
29item = Parser (\cs -> case cs of
30 [] -> []
30 [] -> []
@@ -40,7 +40,7 @@ string (c:cs) = do {char c; string cs; return (c:cs)}
40star p = plus p +++ return []
40star p = plus p +++ return []
41plus p = do {a <- p; as <- star p; return (a:as)}
41plus p = do {a <- p; as <- star p; return (a:as)}
42
42
43−optional p = do { p >>= return . Just } +++ return Nothing
43+optional p = (Just `liftM` p) +++ return Nothing
44
44
45nospace = guard . (==0) . length =<< space
45nospace = guard . (==0) . length =<< space
46space = star $ sat isSpace
46space = star $ sat isSpace
@@ -66,9 +66,9 @@ sepBy1 sep p = do
66 xs <- star (sep >> p)
66 xs <- star (sep >> p)
67 return $ x:xs
67 return $ x:xs
68
68
69−select ps = foldl1 (+|+) ps
69+select = foldl1 (+|+)
70
70
71−chainl p op a = (chainl1 p op) +++ return a
71+chainl p op a = chainl1 p op +++ return a
72chainl1 p op = do {a <- p; rest a}
72chainl1 p op = do {a <- p; rest a}
73 where
73 where
74 rest a = (do f <- op
74 rest a = (do f <- op
@@ -79,4 +79,4 @@ extractResult err parse =
79 case parse of
79 case parse of
80 (r,[]) : _ -> Right r
80 (r,[]) : _ -> Right r
81 _ : rest -> extractResult err rest
81 _ : rest -> extractResult err rest
82− [] -> Left err
82+ [] -> Left err
src/Parse/Lexer.hs+6−5
@@ -6,8 +6,9 @@ import Text.Parsec.Char
6import Text.Parsec.Combinator
6import Text.Parsec.Combinator
7import Text.ParserCombinators.Parsec.Prim (parse,(<|>),many,try)
7import Text.ParserCombinators.Parsec.Prim (parse,(<|>),many,try)
8import Tokens
8import Tokens
9+import Control.Monad (liftM)
9
10
10−token = do { integer >>= return . NUMBER }
11+token = NUMBER `liftM` integer
11 <|> whitespace
12 <|> whitespace
12 <|> chrs [ ('(',LPAREN) , (')',RPAREN)
13 <|> chrs [ ('(',LPAREN) , (')',RPAREN)
13 , ('{',LBRACE) , ('}',RBRACE)
14 , ('{',LBRACE) , ('}',RBRACE)
@@ -24,7 +25,7 @@ token = do { integer >>= return . NUMBER }
24 ; return $ STRING s}
25 ; return $ STRING s}
25 <|> do { char '\''; c <- backslashed <|> satisfy (/='\''); char '\''
26 <|> do { char '\''; c <- backslashed <|> satisfy (/='\''); char '\''
26 ; return $ CHAR c}
27 ; return $ CHAR c}
27− <|> do { variable >>= return . ID }
28+ <|> (ID `liftM` variable)
28 <|> typeVar
29 <|> typeVar
29 <|> do { try $ string "\r\n" <|> string "\n"; return NEWLINE }
30 <|> do { try $ string "\r\n" <|> string "\n"; return NEWLINE }
30
31
@@ -39,7 +40,7 @@ anyOp = do op <- many1 (satisfy isSymbol <|> oneOf "+-/*=.$<>:&|^?%#@~!")
39 ; "->" -> return ARROW; "\8594" -> return ARROW
40 ; "->" -> return ARROW; "\8594" -> return ARROW
40 ; _ -> return $ OP op }
41 ; _ -> return $ OP op }
41
42
42−backslashed = do { char '\\'; c <- satisfy (\x -> True)
43+backslashed = do { char '\\'; c <- satisfy $ const True
43 ; return . read $ ['\'','\\',c,'\''] }
44 ; return . read $ ['\'','\\',c,'\''] }
44
45
45integer = return . read =<< many1 digit
46integer = return . read =<< many1 digit
@@ -66,8 +67,8 @@ closeComment = manyTill anyChar . choice $
66 , do { try $ string "{-"; closeComment; closeComment }
67 , do { try $ string "{-"; closeComment; closeComment }
67 ]
68 ]
68
69
69−token_parser = many1 token
70+tokenParser = many1 token
70
71
71−tokenize s = case parse token_parser "" s of
72+tokenize s = case parse tokenParser "" s of
72 Right ts -> Right ts
73 Right ts -> Right ts
73 Left err -> Left $ "Syntax error: " ++ show err
74 Left err -> Left $ "Syntax error: " ++ show err
src/Parse/ParsePatterns.hs+14−13
@@ -1,30 +1,31 @@
1−module ParsePatterns (pattern_term, pattern_expr) where
1+module ParsePatterns (patternTerm, patternExpr) where
2
2
3import Ast
3import Ast
4import Combinators
4import Combinators
5import Data.Char (isUpper)
5import Data.Char (isUpper)
6import ParserLib
6import ParserLib
7import Tokens
7import Tokens
8+import Control.Monad (liftM)
8
9
9−pattern_basic =
10+patternBasic =
10 (t UNDERSCORE >> return PAnything) +|+
11 (t UNDERSCORE >> return PAnything) +|+
11 (do { x@(c:_) <- var ;
12 (do { x@(c:_) <- var ;
12− if isUpper c then star pattern_term >>= return . PData x
13+ if isUpper c then PData x `liftM` star patternTerm
13 else return $ PVar x })
14 else return $ PVar x })
14
15
15−pattern_tuple = do
16+patternTuple = do
16− t LPAREN; ps <- sepBy1 (t COMMA) pattern_expr; t RPAREN
17+ t LPAREN; ps <- sepBy1 (t COMMA) patternExpr; t RPAREN
17 return $ case ps of { [p] -> p; _ -> ptuple ps }
18 return $ case ps of { [p] -> p; _ -> ptuple ps }
18
19
19−pattern_cons = do
20+patternCons = do
20− p <- pattern_term
21+ p <- patternTerm
21− colon <- optional $ op_parser (==":")
22+ colon <- optional $ opParser (==":")
22 case colon of
23 case colon of
23− Just ":" -> pattern_expr >>= return . pcons p
24+ Just ":" -> pcons p `liftM` patternExpr
24 Nothing -> return p
25 Nothing -> return p
25
26
26−pattern_list = do
27+patternList = do
27− t LBRACKET; ps <- sepBy (t COMMA) pattern_expr; t RBRACKET; return (plist ps)
28+ t LBRACKET; ps <- sepBy (t COMMA) patternExpr; t RBRACKET; return (plist ps)
28
29
29−pattern_term = pattern_tuple +|+ pattern_list +|+ pattern_basic
30+patternTerm = patternTuple +|+ patternList +|+ patternBasic
30−pattern_expr = pattern_tuple +|+ pattern_list +|+ pattern_cons
31+patternExpr = patternTuple +|+ patternList +|+ patternCons
src/Parse/ParseTypes.hs+30−29
@@ -6,40 +6,41 @@ import Data.Char (isUpper)
6import ParserLib
6import ParserLib
7import Tokens
7import Tokens
8import Types
8import Types
9−
9+import Control.Monad (liftM)
10+
10−type_var = do whitespace; t <- item
11+typeVar = do whitespace; t <- item
11− case t of
12+ case t of
12− ID "Int" -> return IntT
13+ ID "Int" -> return IntT
13− ID "String" -> return StringT
14+ ID "String" -> return StringT
14− ID "Char" -> return CharT
15+ ID "Char" -> return CharT
15− ID "Bool" -> return BoolT
16+ ID "Bool" -> return BoolT
16− ID (v:vs) -> return (if isUpper v then ADT (v:vs) []
17+ ID (v:vs) -> return (if isUpper v then ADT (v:vs) []
17− else VarT (v:vs))
18+ else VarT (v:vs))
18− _ -> zero
19+ _ -> zero
19−
20+
20−type_list = do t LBRACKET; ti <- type_expr; t RBRACKET; return $ ADT "List" []
21+typeList = do t LBRACKET; ti <- typeExpr; t RBRACKET; return $ ADT "List" []
21−type_tuple = do { t LPAREN; ts <- sepBy (t COMMA) type_expr; t RPAREN
22+typeTuple = do { t LPAREN; ts <- sepBy (t COMMA) typeExpr; t RPAREN
22 ; return $ case ts of { [t] -> t; _ -> ADT "Tuple" [] } }
23 ; return $ case ts of { [t] -> t; _ -> ADT "Tuple" [] } }
23
24
24−type_unamb = type_list +|+ type_tuple
25+typeUnamb = typeList +|+ typeTuple
25
26
26−type_term = type_app +|+ type_unamb
27+typeTerm = typeApp +|+ typeUnamb
27
28
28−type_app = do
29+typeApp = do
29− tipe <- type_var
30+ tipe <- typeVar
30 case tipe of
31 case tipe of
31− ADT name _ -> star type_term >>= return . AppT name
32+ ADT name _ -> AppT name `liftM` star typeTerm
32 _ -> return tipe
33 _ -> return tipe
33
34
34−type_expr = do t1 <- type_term
35+typeExpr = do t1 <- typeTerm
35− arrow <- optional $ t ARROW
36+ arrow <- optional $ t ARROW
36− case arrow of
37+ case arrow of
37− Just ARROW -> type_term >>= return . LambdaT t1
38+ Just ARROW -> LambdaT t1 `liftM` typeTerm
38− Nothing -> return t1
39+ Nothing -> return t1
39
40
40−type_constr = do
41+typeConstr = do
41− name <- cap_var
42+ name <- capVar
42− args <- star (type_var +|+ type_unamb)
43+ args <- star (typeVar +|+ typeUnamb)
43 return (Constructor name args)
44 return (Constructor name args)
44
45
45constr (Constructor name args) =
46constr (Constructor name args) =
@@ -48,9 +49,9 @@ constr (Constructor name args) =
48
49
49datatype = do
50datatype = do
50 t DATA
51 t DATA
51− adt <- cap_var
52+ adt <- capVar
52 vs <- star var
53 vs <- star var
53 assign
54 assign
54− ts <- sepBy1 (op_parser (=="|")) type_constr
55+ ts <- sepBy1 (opParser (=="|")) typeConstr
55 -- (adt, foldr ForallT (ADT adt ts) vs)
56 -- (adt, foldr ForallT (ADT adt ts) vs)
56− return (map constr ts)
57+ return (map constr ts)
src/Parse/Parser.hs+36−35
@@ -9,48 +9,49 @@ import ParserLib
9import ParseTypes (datatype)
9import ParseTypes (datatype)
10import ParsePatterns
10import ParsePatterns
11import Tokens
11import Tokens
12+import Control.Monad (liftM)
12
13
13-------- Basic Terms --------
14-------- Basic Terms --------
14
15
15−num_term = do { whitespace; t <- item
16+numTerm = do { whitespace; t <- item
16 ; case t of { NUMBER n -> return $ Number n; _ -> zero } }
17 ; case t of { NUMBER n -> return $ Number n; _ -> zero } }
17−str_term = do { whitespace; t <- item
18+strTerm = do { whitespace; t <- item
18 ; case t of { STRING cs -> return . list $ map Chr cs
19 ; case t of { STRING cs -> return . list $ map Chr cs
19 ; _ -> zero } }
20 ; _ -> zero } }
20
21
21−var_term = do var >>= return . Var
22+varTerm = Var `liftM` var
22−chr_term = do chr >>= return . Chr
23+chrTerm = Chr `liftM` chr
23
24
24−true_term = do { t TRUE; return $ Boolean True }
25+trueTerm = do { t TRUE; return $ Boolean True }
25−false_term = do { t FALSE; return $ Boolean False }
26+falseTerm = do { t FALSE; return $ Boolean False }
26
27
27
28
28-------- Complex Terms --------
29-------- Complex Terms --------
29
30
30−list_term = (do { t LBRACKET; start <- expr; t DOT2; end <- expr; t RBRACKET
31+listTerm = (do { t LBRACKET; start <- expr; t DOT2; end <- expr; t RBRACKET
31 ; return $ Range start end }) +|+
32 ; return $ Range start end }) +|+
32 (do { t LBRACKET; es <- sepBy (t COMMA) expr; t RBRACKET
33 (do { t LBRACKET; es <- sepBy (t COMMA) expr; t RBRACKET
33 ; return $ list es })
34 ; return $ list es })
34
35
35−parens_term = (do { t LPAREN; op <- anyOp; t RPAREN
36+parensTerm = (do { t LPAREN; op <- anyOp; t RPAREN
36 ; return . Lambda "x" . Lambda "y" $
37 ; return . Lambda "x" . Lambda "y" $
37 Binop op (Var "x") (Var "y") }) +|+
38 Binop op (Var "x") (Var "y") }) +|+
38 (do { t LPAREN; es <- sepBy (t COMMA) expr; t RPAREN
39 (do { t LPAREN; es <- sepBy (t COMMA) expr; t RPAREN
39 ; return $ case es of { [e] -> e; _ -> tuple es } })
40 ; return $ case es of { [e] -> e; _ -> tuple es } })
40
41
41−term = select [ num_term
42+term = select [ numTerm
42− , str_term
43+ , strTerm
43− , accessible var_term
44+ , accessible varTerm
44− , chr_term
45+ , chrTerm
45− , true_term
46+ , trueTerm
46− , false_term
47+ , falseTerm
47− , list_term
48+ , listTerm
48− , accessible parens_term
49+ , accessible parensTerm
49 ]
50 ]
50
51
51-------- Applications --------
52-------- Applications --------
52
53
53−app_expr = do
54+appExpr = do
54 tlist <- plus term
55 tlist <- plus term
55 return $ case tlist of
56 return $ case tlist of
56 t:[] -> t
57 t:[] -> t
@@ -59,20 +60,20 @@ app_expr = do
59
60
60-------- Expressions with infix operators --------
61-------- Expressions with infix operators --------
61
62
62−binary_expr = binops app_expr anyOp
63+binaryExpr = binops appExpr anyOp
63
64
64
65
65-------- Normal Expressions --------
66-------- Normal Expressions --------
66
67
67−if_expr = do { t IF; e1 <- expr; t THEN; e2 <- expr; t ELSE; e3 <- expr
68+ifExpr = do { t IF; e1 <- expr; t THEN; e2 <- expr; t ELSE; e3 <- expr
68 ; return $ If e1 e2 e3 }
69 ; return $ If e1 e2 e3 }
69
70
70−lambda_expr = do { t LAMBDA; vs <- plus var; t ARROW; e <- expr
71+lambdaExpr = do { t LAMBDA; vs <- plus var; t ARROW; e <- expr
71− ; return $ foldr (\x e -> Lambda x e) e vs }
72+ ; return $ foldr Lambda e vs }
72
73
73−assign_expr = whitespace >> assign_expr_nospace
74+assignExpr = whitespace >> assignExprNospace
74−assign_expr_nospace = do
75+assignExprNospace = do
75− p:ps <- plus pattern_term; assign; e <- expr
76+ p:ps <- plus patternTerm; assign; e <- expr
76 case p:ps of
77 case p:ps of
77 PVar x : _ -> return (x, foldr func e ps)
78 PVar x : _ -> return (x, foldr func e ps)
78 where func PAnything e' = Lambda "_" e'
79 where func PAnything e' = Lambda "_" e'
@@ -81,30 +82,30 @@ assign_expr_nospace = do
81-- _ : [] -> return $ \hole -> Case e [(p,hole)]
82-- _ : [] -> return $ \hole -> Case e [(p,hole)]
82 _ -> zero
83 _ -> zero
83
84
84−let_expr = do
85+letExpr = do
85 t LET; brace <- optional $ t LBRACE
86 t LET; brace <- optional $ t LBRACE
86 case brace of
87 case brace of
87− Nothing -> do f <- assign_expr; t IN; e <- expr; return (Let [f] e)
88+ Nothing -> do f <- assignExpr; t IN; e <- expr; return (Let [f] e)
88− Just LBRACE -> do fs <- sepBy1 (t SEMI) assign_expr; t RBRACE; t IN;
89+ Just LBRACE -> do fs <- sepBy1 (t SEMI) assignExpr; t RBRACE; t IN;
89 e <- expr; return (Let fs e)
90 e <- expr; return (Let fs e)
90
91
91−case_expr = do
92+caseExpr = do
92 t CASE; e <- expr; t OF; t LBRACE
93 t CASE; e <- expr; t OF; t LBRACE
93 cases <- sepBy1 (t SEMI)
94 cases <- sepBy1 (t SEMI)
94− (do { p <- pattern_expr; t ARROW; e <- expr; return (p,e) })
95+ (do { p <- patternExpr; t ARROW; e <- expr; return (p,e) })
95 t RBRACE
96 t RBRACE
96 return $ Case e cases
97 return $ Case e cases
97
98
98-------- All Expressions --------
99-------- All Expressions --------
99
100
100−expr = select [ let_expr
101+expr = select [ letExpr
101− , binary_expr
102+ , binaryExpr
102− , if_expr
103+ , ifExpr
103− , case_expr
104+ , caseExpr
104− , lambda_expr
105+ , lambdaExpr
105 ]
106 ]
106
107
107−def = assign_expr_nospace >>= return . (:[])
108+def = (:[]) `liftM` assignExprNospace
108
109
109defs = do
110defs = do
110 ds <- plus (whitespace >> plus (sat (==NEWLINE)) >> def +|+ datatype)
111 ds <- plus (whitespace >> plus (sat (==NEWLINE)) >> def +|+ datatype)
src/Parse/ParserLib.hs+12−11
@@ -3,18 +3,19 @@ module ParserLib where
3import Ast
3import Ast
4import Combinators
4import Combinators
5import Data.Char (isUpper)
5import Data.Char (isUpper)
6+import Control.Monad (liftM)
6import Tokens
7import Tokens
7
8
8−var_noSpace = do { t <- item; case t of { ID v -> return v; _ -> zero } }
9+varNoSpace = do { t <- item; case t of { ID v -> return v; _ -> zero } }
9−var = whitespace >> var_noSpace
10+var = whitespace >> varNoSpace
10−cap_var = do
11+capVar = do
11 whitespace; t <- item
12 whitespace; t <- item
12 case t of { ID (v:vs) -> if isUpper v then return (v:vs) else zero }
13 case t of { ID (v:vs) -> if isUpper v then return (v:vs) else zero }
13
14
14chr = do { whitespace; t <- item; case t of { CHAR c -> return c; _ -> zero } }
15chr = do { whitespace; t <- item; case t of { CHAR c -> return c; _ -> zero } }
15
16
16−t_noSpace token = sat (==token)
17+tNoSpace token = sat (==token)
17−t_withSpace token = forcedWS >> sat (==token)
18+tWithSpace token = forcedWS >> sat (==token)
18t token = whitespace >> sat (==token)
19t token = whitespace >> sat (==token)
19
20
20forcedWS = do { sat (==SPACES); star nl_space } +|+ plus nl_space
21forcedWS = do { sat (==SPACES); star nl_space } +|+ plus nl_space
@@ -23,14 +24,14 @@ whitespace = optional forcedWS
23
24
24accessible exp = do
25accessible exp = do
25 e <- exp
26 e <- exp
26− access <- optional $ op_parser_nospace (==".")
27+ access <- optional $ opParserNospace (==".")
27 case access of
28 case access of
28− Just "." -> accessible (var >>= return . Access e)
29+ Just "." -> accessible (Access e `liftM` var)
29 Nothing -> return e
30 Nothing -> return e
30
31
31−op_parser_nospace pred =
32+opParserNospace pred =
32 do { t <- item
33 do { t <- item
33 ; case t of { OP op -> if pred op then return op else zero; _ -> zero } }
34 ; case t of { OP op -> if pred op then return op else zero; _ -> zero } }
34−op_parser pred = whitespace >> op_parser_nospace pred
35+opParser pred = whitespace >> opParserNospace pred
35−anyOp = op_parser (const True)
36+anyOp = opParser (const True)
36−assign = op_parser (=="=")
37+assign = opParser (=="=")
src/Replace.hs+11−7
@@ -1,8 +1,9 @@
1module Replace (replace, depth) where
1module Replace (replace, depth) where
2
2
3import Ast
3import Ast
4−import Data.Set (singleton,empty,unions,member)
4+import Data.Set (singleton,empty,unions,member, Set)
5
5
6+replace :: String -> Expr -> Expr -> Expr
6replace y v expr =
7replace y v expr =
7 let f = replace y v in
8 let f = replace y v in
8 case expr of
9 case expr of
@@ -14,22 +15,25 @@ replace y v expr =
14 Lift e es -> Lift (f e) (map f es)
15 Lift e es -> Lift (f e) (map f es)
15 Fold e1 e2 e3 -> Fold (f e1) (f e2) (f e3)
16 Fold e1 e2 e3 -> Fold (f e1) (f e2) (f e3)
16 Async e -> Async (f e)
17 Async e -> Async (f e)
17− Let defs e -> if elem y vs then Let defs e else Let (zip vs (map f es)) (f e)
18+ Let defs e -> if y `elem` vs then Let defs e else Let (zip vs (map f es)) (f e)
18 where (vs,es) = unzip defs
19 where (vs,es) = unzip defs
19 Var x -> if x == y then v else Var x
20 Var x -> if x == y then v else Var x
20 Data name es -> Data name (map f es)
21 Data name es -> Data name (map f es)
21− Case e cases -> Case (f e) $ map (case_replace y v) cases
22+ Case e cases -> Case (f e) $ map (caseReplace y v) cases
22 _ -> expr
23 _ -> expr
23
24
24−case_replace y v (p,e) =
25+caseReplace :: String -> Expr -> (Pattern, Expr) -> (Pattern, Expr)
26+caseReplace y v (p,e) =
25− if member y (pattern_vars p) then (p,e) else (p, replace y v e)
27+ if member y (patternVars p) then (p,e) else (p, replace y v e)
26
28
27−pattern_vars pattern =
29+patternVars :: Pattern -> Set String
30+patternVars pattern =
28 case pattern of
31 case pattern of
29− PData _ ps -> unions (map pattern_vars ps)
32+ PData _ ps -> unions (map patternVars ps)
30 PVar x -> singleton x
33 PVar x -> singleton x
31 PAnything -> empty
34 PAnything -> empty
32
35
36+depth :: Expr -> Integer
33depth = depth' 0
37depth = depth' 0
34depth' d expr =
38depth' d expr =
35 let f = depth' (d+1) in
39 let f = depth' (d+1) in
src/Types/TypeCheck.hs+5−5
@@ -32,7 +32,7 @@ guess = liftM GuessT (newIORef Nothing)
32varType env x =
32varType env x =
33 case Map.lookup x env of
33 case Map.lookup x env of
34 Just t -> return $ Right t
34 Just t -> return $ Right t
35− Nothing -> liftM Right $ guess
35+ Nothing -> liftM Right guess
36 -- return . Left $ "Variable '" ++ x ++ "' is not bound to a value!"
36 -- return . Left $ "Variable '" ++ x ++ "' is not bound to a value!"
37 -- This is no good because some fundamental functions are only
37 -- This is no good because some fundamental functions are only
38 -- defined in JS, but it is the right thing to do.
38 -- defined in JS, but it is the right thing to do.
@@ -115,11 +115,11 @@ checkBinop Compose t1 t2 = do
115checkBinop Apply t1 t2 = do { g <- guess
115checkBinop Apply t1 t2 = do { g <- guess
116 ; check [unify t1 (LambdaT t2 g), tipe g] }
116 ; check [unify t1 (LambdaT t2 g), tipe g] }
117checkBinop op t1 t2
117checkBinop op t1 t2
118− | elem op [And, Or] = check [unify BoolT t1, unify BoolT t2]
118+ | op `elem` [And, Or] = check [unify BoolT t1, unify BoolT t2]
119− | elem op [Equ, Neq] = check [guess >>= unify t1, unify t1 t2, tipe BoolT]
119+ | op `elem` [Equ, Neq] = check [guess >>= unify t1, unify t1 t2, tipe BoolT]
120− | elem op [Lt, Lte, Gt, Gte] =
120+ | op `elem` [Lt, Lte, Gt, Gte] =
121 check [unify NumberT t1, unify NumberT t2, tipe BoolT]
121 check [unify NumberT t1, unify NumberT t2, tipe BoolT]
122− | elem op [Add, Sub, Mul, Div] = check [unify NumberT t1, unify NumberT t2]
122+ | op `elem` [Add, Sub, Mul, Div] = check [unify NumberT t1, unify NumberT t2]
123
123
124unify t1 t2
124unify t1 t2
125 | t1 == t2 = tipe t1
125 | t1 == t2 = tipe t1
src/Types/Types.hs+1−1
@@ -28,7 +28,7 @@ instance Show Type where
28 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
28 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
29 ; VarT x -> x
29 ; VarT x -> x
30 ; ForallT x t' -> "forall " ++ x ++ ". " ++ show t'
30 ; ForallT x t' -> "forall " ++ x ++ ". " ++ show t'
31− ; AppT name args -> name ++ " " ++ intercalate " " (map show args)
31+ ; AppT name args -> name ++ " " ++ unwords (map show args)
32 ; ADT name constrs ->
32 ; ADT name constrs ->
33 name ++ " = " ++ intercalate " | " (map show constrs)
33 name ++ " = " ++ intercalate " | " (map show constrs)
34 }
34 }