summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2014-03-29 02:40:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-03-29 02:40:00 (GMT)
commit371b3d86035b5523bca94f0f918800881ee06ce7 (patch)
tree2ea2c55f797da3800d19f8f6b814d9d857c59060
parentd072c9c63fb4775925707a4cb4cfd41926958671 (diff)
version 0.4.10.10.4.10.1
-rw-r--r--purescript.cabal4
-rw-r--r--src/Language/PureScript/Sugar/Names.hs11
-rw-r--r--src/Language/PureScript/TypeChecker/Types.hs3
3 files changed, 10 insertions, 8 deletions
diff --git a/purescript.cabal b/purescript.cabal
index 62f3ae6..43bd5aa 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
name: purescript
-version: 0.4.10
+version: 0.4.10.1
cabal-version: >=1.8
build-type: Custom
license: MIT
@@ -20,7 +20,7 @@ data-dir: ""
library
build-depends: base >=4 && <5, cmdtheline -any, containers -any,
directory -any, filepath -any, mtl -any, parsec -any, syb -any,
- transformers -any, utf8-string -any, pattern-arrows -any, monad-unify >= 0.2 && < 0.3,
+ transformers -any, utf8-string -any, pattern-arrows -any, monad-unify >= 0.2.1 && < 0.3,
xdg-basedir -any, time -any
if (!os(windows))
build-depends: unix -any
diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs
index 4410c74..a3d03f2 100644
--- a/src/Language/PureScript/Sugar/Names.hs
+++ b/src/Language/PureScript/Sugar/Names.hs
@@ -17,7 +17,7 @@ module Language.PureScript.Sugar.Names (
) where
import Data.Data
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Generics (extM, mkM, everywhereM)
import Data.Generics.Extras (mkS, extS, everywhereWithContextM')
@@ -200,7 +200,7 @@ renameInModule imports exports (Module mn decls exps) =
rethrowFor "declaration" name $ ValueDeclaration name nameKind [] Nothing <$> updateAll val'
where
bindFunctionArgs bound (Abs (Left arg) val') = return (arg : bound, Abs (Left arg) val')
- bindFunctionArgs bound (Let ds val') = let args = map letBoundVariable ds in
+ bindFunctionArgs bound (Let ds val') = let args = mapMaybe letBoundVariable ds in
return (args ++ bound, Let ds val')
bindFunctionArgs bound (Var name'@(Qualified Nothing ident)) | ident `notElem` bound =
(,) bound <$> (Var <$> updateValueName name')
@@ -214,10 +214,10 @@ renameInModule imports exports (Module mn decls exps) =
bindBinders :: [Ident] -> CaseAlternative -> Either String ([Ident], CaseAlternative)
bindBinders bound c@(CaseAlternative bs _ _) = return (binderNames bs ++ bound, c)
- letBoundVariable :: Declaration -> Ident
- letBoundVariable (ValueDeclaration ident _ _ _ _) = ident
+ letBoundVariable :: Declaration -> Maybe Ident
+ letBoundVariable (ValueDeclaration ident _ _ _ _) = Just ident
letBoundVariable (PositionedDeclaration _ d) = letBoundVariable d
- letBoundVariable _ = error "Invalid argument to letBoundVariable"
+ letBoundVariable _ = Nothing
go (ValueDeclaration name _ _ _ _) = error $ "Binders should have been desugared in " ++ show name
go (ExternDeclaration fit name js ty) =
rethrowFor "declaration" name $ ExternDeclaration <$> pure fit <*> pure name <*> pure js <*> updateType' ty
@@ -449,3 +449,4 @@ resolveImport currentModule importModule exps imps impQual = maybe importAll (fo
then return item
else throwError $ "Unable to find " ++ t ++ " '" ++ show (Qualified (Just importModule) item) ++ "'"
+
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index e75b25b..c0acf0d 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -585,7 +585,8 @@ inferLetBinding seen [] ret j = (,) seen <$> j ret
inferLetBinding seen (ValueDeclaration ident nameKind [] Nothing val : rest) ret j = do
valTy <- fresh
Just moduleName <- checkCurrentModule <$> get
- TypedValue _ val' valTy' <- bindNames (M.singleton (moduleName, ident) (valTy, nameKind)) $ infer val
+ let dict = if isFunction val then M.singleton (moduleName, ident) (valTy, nameKind) else M.empty
+ TypedValue _ val' valTy' <- bindNames dict $ infer val
valTy =?= valTy'
bindNames (M.singleton (moduleName, ident) (valTy', nameKind)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] Nothing val']) rest ret j
inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do