Commit cc57f80c authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

First step towards support for nonlinear left-hand-sides in functions

parent e34d49bd
......@@ -24,7 +24,7 @@ definition.
> import Control.Monad (liftM, liftM2, liftM3, unless, when)
> import qualified Control.Monad.State as S (State, runState, gets, modify)
> import Data.List ((\\), insertBy, partition)
> import Data.List ((\\), insertBy, nub, partition)
> import Data.Maybe (fromJust, isJust, isNothing, maybeToList)
> import qualified Data.Set as Set (empty, insert, member)
> import Text.PrettyPrint
......@@ -489,7 +489,7 @@ top-level.
> checkEquation :: Equation -> SCM Equation
> checkEquation (Equation p lhs rhs) = inNestedScope $ do
> lhs' <- checkLhs p lhs >>= addBoundVariables
> lhs' <- checkLhs p lhs >>= addBoundVariables False
> rhs' <- checkRhs rhs
> return $ Equation p lhs' rhs'
......@@ -801,7 +801,7 @@ checkParen
> StmtDecl `liftM` (incNesting >> checkDeclGroup bindVarDecl ds)
> bindPattern :: Position -> Pattern -> SCM Pattern
> bindPattern p t = checkPattern p t >>= addBoundVariables
> bindPattern p t = checkPattern p t >>= addBoundVariables True
> checkOp :: InfixOp -> SCM InfixOp
> checkOp op = do
......@@ -825,11 +825,11 @@ checkParen
> checkAlt (Alt p t rhs) = inNestedScope $
> liftM2 (Alt p) (bindPattern p t) (checkRhs rhs)
> addBoundVariables :: QuantExpr t => t -> SCM t
> addBoundVariables ts = do
> case findDouble bvs of
> Nothing -> modifyRenameEnv $ \ env -> foldr bindVar env bvs
> Just v -> report $ errDuplicateVariable v
> addBoundVariables :: QuantExpr t => Bool -> t -> SCM t
> addBoundVariables checkDuplicates ts = do
> when checkDuplicates $ maybe (return ()) (report . errDuplicateVariable)
> $ findDouble bvs
> modifyRenameEnv $ \ env -> foldr bindVar env (nub bvs)
> return ts
> where bvs = bv ts
......
......@@ -541,8 +541,10 @@ signature the declared type must be too general.
> ty <- case lookupTypeSig v sigs of
> Nothing -> freshTypeVar
> Just t -> expandPolyType t >>= inst
> modifyValueEnv $ bindFun m v (arrowArity ty) $ monoType ty
> return ty
> tyEnv <- getValueEnv
> maybe (modifyValueEnv (bindFun m v (arrowArity ty) (monoType ty)) >> return ty)
> (\ (ForAll _ t) -> return t)
> (sureVarType v tyEnv)
> tcPattern p t@(ConstructorPattern c ts) = do
> m <- getModuleIdent
> tyEnv <- getValueEnv
......@@ -633,14 +635,13 @@ because of possibly multiple occurrences of variables.
> tcPatternFP _ (VariablePattern v) = do
> sigs <- getSigEnv
> m <- getModuleIdent
> ty <- maybe freshTypeVar
> (\t -> expandPolyType t >>= inst)
> (lookupTypeSig v sigs)
> ty <- case lookupTypeSig v sigs of
> Nothing -> freshTypeVar
> Just t -> expandPolyType t >>= inst
> tyEnv <- getValueEnv
> ty' <- maybe (modifyValueEnv (bindFun m v (arrowArity ty) (monoType ty)) >> return ty)
> (\ (ForAll _ t) -> return t)
> (sureVarType v tyEnv)
> return ty'
> maybe (modifyValueEnv (bindFun m v (arrowArity ty) (monoType ty)) >> return ty)
> (\ (ForAll _ t) -> return t)
> (sureVarType v tyEnv)
> tcPatternFP p t@(ConstructorPattern c ts) = do
> m <- getModuleIdent
> tyEnv <- getValueEnv
......
f x y x | True = x + y
-- g = let (x,x) = (0,1) in x
-- g x y z | x =:= z &> True = x + y
\ No newline at end of file
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment