Add the 'Str' data constructor to Ast.hs. Makes type checking go much much much faster!
This commit is contained in:
parent
5b4950006f
commit
c00d0171a8
3 changed files with 6 additions and 10 deletions
|
@ -1,3 +1,4 @@
|
||||||
|
|
||||||
module Ast where
|
module Ast where
|
||||||
|
|
||||||
data Pattern = PData String [Pattern] | PVar String | PAnything
|
data Pattern = PData String [Pattern] | PVar String | PAnything
|
||||||
|
@ -5,6 +6,7 @@ data Pattern = PData String [Pattern] | PVar String | PAnything
|
||||||
|
|
||||||
data Expr = Number Int
|
data Expr = Number Int
|
||||||
| Chr Char
|
| Chr Char
|
||||||
|
| Str String
|
||||||
| Boolean Bool
|
| Boolean Bool
|
||||||
| Range Expr Expr
|
| Range Expr Expr
|
||||||
| Access Expr String
|
| Access Expr String
|
||||||
|
|
|
@ -27,6 +27,7 @@ toJS expr =
|
||||||
Number n -> show n
|
Number n -> show n
|
||||||
Var x -> x
|
Var x -> x
|
||||||
Chr c -> show c
|
Chr c -> show c
|
||||||
|
Str s -> toJS . list $ map Chr s
|
||||||
Boolean b -> if b then "true" else "false"
|
Boolean b -> if b then "true" else "false"
|
||||||
Range lo hi -> jsRange (toJS lo) (toJS hi)
|
Range lo hi -> jsRange (toJS lo) (toJS hi)
|
||||||
Access e lbl -> toJS e ++ "." ++ lbl
|
Access e lbl -> toJS e ++ "." ++ lbl
|
||||||
|
|
|
@ -3,6 +3,7 @@ module Constrain where
|
||||||
|
|
||||||
import Ast
|
import Ast
|
||||||
import Types
|
import Types
|
||||||
|
import Data.List (foldl')
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Control.Monad (liftM,mapM)
|
import Control.Monad (liftM,mapM)
|
||||||
|
@ -60,7 +61,7 @@ inference (If e1 e2 e3) =
|
||||||
, Set.unions [c1,c2,c3, Set.fromList [ t1 :=: BoolT, t2 :=: t3 ] ]
|
, Set.unions [c1,c2,c3, Set.fromList [ t1 :=: BoolT, t2 :=: t3 ] ]
|
||||||
, t2 )
|
, t2 )
|
||||||
|
|
||||||
inference (Data name es) = inference $ foldl App (Var name) es
|
inference (Data name es) = inference $ foldl' App (Var name) es
|
||||||
inference (Binop op e1 e2) = inference (Var op `App` e1 `App` e2)
|
inference (Binop op e1 e2) = inference (Var op `App` e1 `App` e2)
|
||||||
inference (Access (Var x) y) = inference . Var $ x ++ "." ++ y
|
inference (Access (Var x) y) = inference . Var $ x ++ "." ++ y
|
||||||
inference (Range e1 e2) = inference (Var "elmRange" `App` e1 `App` e2)
|
inference (Range e1 e2) = inference (Var "elmRange" `App` e1 `App` e2)
|
||||||
|
@ -69,16 +70,8 @@ inference other =
|
||||||
case other of
|
case other of
|
||||||
Number _ -> primitive IntT
|
Number _ -> primitive IntT
|
||||||
Chr _ -> primitive CharT
|
Chr _ -> primitive CharT
|
||||||
|
Str _ -> primitive string
|
||||||
Boolean _ -> primitive BoolT
|
Boolean _ -> primitive BoolT
|
||||||
_ -> beta >>= primitive
|
_ -> beta >>= primitive
|
||||||
|
|
||||||
primitive t = return (Map.empty, Set.empty, t)
|
primitive t = return (Map.empty, Set.empty, t)
|
||||||
{--
|
|
||||||
Let x e1 e2 ->
|
|
||||||
do (a1,c1,t1) <- inference e1
|
|
||||||
(a2,c2,t2) <- inference e2
|
|
||||||
let ts = Map.findWithDefault (error "inference") x a
|
|
||||||
return ( unionA a1 $ Map.delete x a2
|
|
||||||
, Set.unions [ c1, c2, Set.fromList $ map (:<: t1) ts ]
|
|
||||||
, t2 )
|
|
||||||
--}
|
|
||||||
|
|
Loading…
Reference in a new issue