diff --git a/Elm.cabal b/Elm.cabal --- a/Elm.cabal +++ b/Elm.cabal @@ -1,5 +1,5 @@ Name: Elm -Version: 0.9.0.1 +Version: 0.9.0.2 Synopsis: The Elm language module. Description: Elm aims to make client-side web-development more pleasant. It is a statically/strongly typed, functional reactive diff --git a/changelog.txt b/changelog.txt --- a/changelog.txt +++ b/changelog.txt @@ -29,6 +29,10 @@ * Allow infix op definitions without args: (*) = add * Unparenthesized if, let, case, lambda at end of binary expressions +elm-server: + * Build multi-module projects + * Report all errors in browser + Libraries: * Detect hovering over any Element * Set alpha of arbitrary forms in collages diff --git a/compiler/Transform/Canonicalize.hs b/compiler/Transform/Canonicalize.hs --- a/compiler/Transform/Canonicalize.hs +++ b/compiler/Transform/Canonicalize.hs @@ -134,7 +134,7 @@ Lambda pattern e -> let env' = extend env pattern in - Lambda pattern `liftM` rename env' e + Lambda `liftM` format (renamePattern env' pattern) `ap` rename env' e App e1 e2 -> App `liftM` rnm e1 `ap` rnm e2 diff --git a/compiler/Type/Constrain/Expression.hs b/compiler/Type/Constrain/Expression.hs --- a/compiler/Type/Constrain/Expression.hs +++ b/compiler/Type/Constrain/Expression.hs @@ -86,13 +86,11 @@ and . (:) ce <$> mapM branch branches Data name exprs -> - do pairs <- mapM pair exprs + do vars <- forM exprs $ \_ -> var Flexible + let pairs = zip exprs (map VarN vars) (ctipe, cs) <- Monad.foldM step (tipe,true) (reverse pairs) - return (cs /\ name t, c /\ c') @@ -153,9 +151,11 @@ let qs = [] -- should come from the def, but I'm not sure what would live there... (schemes, rigidQuantifiers, flexibleQuantifiers, headers, c2, c1) = info in - case (pattern, maybeTipe) of - (PVar name, Just tipe) -> - do flexiVars <- mapM (\_ -> var Flexible) qs + do rigidVars <- mapM (\_ -> var Rigid) qs -- Some mistake may be happening here. + -- Currently, qs is always the empty list. + case (pattern, maybeTipe) of + (PVar name, Just tipe) -> do + flexiVars <- mapM (\_ -> var Flexible) qs let inserts = zipWith (\arg typ -> Map.insert arg (VarN typ)) qs flexiVars env' = env { Env.value = List.foldl' (\x f -> f x) (Env.value env) inserts } (vars, typ) <- Env.instantiateType env tipe Map.empty @@ -169,12 +169,10 @@ , flexibleQuantifiers , headers , c2 - , fl rigidQuantifiers c /\ c1 ) + , fl rigidVars c /\ c1 ) - (PVar name, Nothing) -> - do v <- var Flexible - rigidVars <- mapM (\_ -> var Rigid) qs -- Some mistake may be happening here. - -- Currently, qs is always the empty list. + (PVar name, Nothing) -> do + v <- var Flexible let tipe = VarN v inserts = zipWith (\arg typ -> Map.insert arg (VarN typ)) qs rigidVars env' = env { Env.value = List.foldl' (\x f -> f x) (Env.value env) inserts } @@ -195,7 +193,7 @@ _ -> (PVar x, lexpr, maybeType) : map toDef vars where vars = Set.toList $ SD.boundVars pattern - x = concat vars + x = "$" ++ concat vars var = L s . Var toDef y = (PVar y, L s $ Case (var x) [(pattern, var y)], Nothing) diff --git a/compiler/Type/Solve.hs b/compiler/Type/Solve.hs --- a/compiler/Type/Solve.hs +++ b/compiler/Type/Solve.hs @@ -49,16 +49,17 @@ -- otherwise generalize let registerIfLowerRank var = do isRedundant <- liftIO $ UF.redundant var - if isRedundant then return () else do + case isRedundant of + True -> return () + False -> do desc <- liftIO $ UF.descriptor var - if rank desc < youngRank - then TS.register var >> return () - else let flex' = if flex desc == Flexible then Rigid else flex desc - in liftIO $ UF.setDescriptor var (desc { rank = noRank, flex = flex' }) - - mapM registerIfLowerRank (Map.findWithDefault [] youngRank rankDict) - - return () + case rank desc < youngRank of + True -> TS.register var >> return () + False -> do + let flex' = case flex desc of { Flexible -> Rigid ; other -> other } + liftIO $ UF.setDescriptor var (desc { rank = noRank, flex = flex' }) + + mapM_ registerIfLowerRank (Map.findWithDefault [] youngRank rankDict) -- adjust the ranks of variables such that ranks never increase as you diff --git a/compiler/Type/State.hs b/compiler/Type/State.hs --- a/compiler/Type/State.hs +++ b/compiler/Type/State.hs @@ -139,7 +139,8 @@ () | mark desc == alreadyCopied -> case copy desc of Just v -> return v - Nothing -> error "This should be impossible." + Nothing -> error $ "Error copying type variable. This should be impossible." ++ + " Please report an error to the github repo!" | rank desc /= noRank || flex desc == Constant -> return variable diff --git a/compiler/Type/Type.hs b/compiler/Type/Type.hs --- a/compiler/Type/Type.hs +++ b/compiler/Type/Type.hs @@ -277,7 +277,11 @@ Is Number -> (Just $ "number" ++ replicate a '\'', (vars, a+1, b, c)) Is Comparable -> (Just $ "comparable" ++ replicate b '\'', (vars, a, b+1, c)) Is Appendable -> (Just $ "appendable" ++ replicate c '\'', (vars, a, b, c+1)) - _ -> (Just $ head vars, (tail vars, a, b, c)) + other -> (Just $ head vars, (tail vars, a, b, c)) + where mark = case other of + Flexible -> "" + Rigid -> "!" + Constant -> "#" type CrawlState = ([String], Int, Int, Int) diff --git a/compiler/Type/Unify.hs b/compiler/Type/Unify.hs --- a/compiler/Type/Unify.hs +++ b/compiler/Type/Unify.hs @@ -77,7 +77,7 @@ unify' variable1 variable2 unifyNumber svar name - | name `elem` ["Int","Float"] = flexAndUnify svar + | name `elem` ["Int","Float","number"] = flexAndUnify svar | otherwise = TS.addError span "Expecting a number (Int or Float)" variable1 variable2 comparableError str = TS.addError span (str ++ msg) variable1 variable2 @@ -85,7 +85,7 @@ "Int, Float, Char, or a list or tuple of comparables." unifyComparable var name - | name `elem` ["Int","Float","Char"] = flexAndUnify var + | name `elem` ["Int","Float","Char","comparable"] = flexAndUnify var | otherwise = comparableError "" unifyComparableStructure varSuper varFlex = @@ -168,7 +168,7 @@ (Record1 fields1 ext1, Record1 fields2 ext2) -> do sequence . concat . Map.elems $ Map.intersectionWith (zipWith unify') fields1 fields2 - let mkRecord fs ext = liftIO . structuredVar $ Record1 fs ext + let mkRecord fs ext = fresh . Just $ Record1 fs ext case (Map.null fields1', Map.null fields2') of (True , True ) -> unify' ext1 ext2 (True , False) -> do @@ -178,8 +178,8 @@ record1' <- mkRecord fields1' ext1 unify' record1' ext2 (False, False) -> do - record1' <- mkRecord fields1' =<< liftIO (var Flexible) - record2' <- mkRecord fields2' =<< liftIO (var Flexible) + record1' <- mkRecord fields1' =<< fresh Nothing + record2' <- mkRecord fields2' =<< fresh Nothing unify' record1' ext2 unify' ext1 record2' where diff --git a/data/elm-runtime.js b/data/elm-runtime.js --- a/data/elm-runtime.js +++ b/data/elm-runtime.js @@ -2578,7 +2578,7 @@ case '_Tuple2': return function(){ var sum$ = ((arg1._2+n)-case19._0._0); - return {ctor:"_Tuple2", _0:{ctor:"_Tuple3", _0:A2(enqueue, n, case19._0._1), _1:arg1._1, _2:sum$}, _1:(sum$/arg1._1)};}(); + return {ctor:"_Tuple2", _0:{ctor:"_Tuple3", _0:A2(enqueue, n, case19._0._1), _1:arg1._1, _2:sum$}, _1:(sum$/Basics.toFloat(arg1._1))};}(); }break; case 'Nothing': return {ctor:"_Tuple2", _0:{ctor:"_Tuple3", _0:arg1._0, _1:arg1._1, _2:arg1._2}, _1:0}; @@ -2588,7 +2588,7 @@ return function(){ switch (arg1.ctor) { case '_Tuple3': - return (_N.eq(arg1._1,k) ? A2(stepFull, n, {ctor:"_Tuple3", _0:arg1._0, _1:arg1._1, _2:arg1._2}) : (Basics.otherwise ? {ctor:"_Tuple2", _0:{ctor:"_Tuple3", _0:A2(enqueue, n, arg1._0), _1:(arg1._1+1), _2:(arg1._2+n)}, _1:((arg1._2+n)/(arg1._1+1))} : _E.If($moduleName,'between lines 82 and 83'))); + return (_N.eq(arg1._1,k) ? A2(stepFull, n, {ctor:"_Tuple3", _0:arg1._0, _1:arg1._1, _2:arg1._2}) : (Basics.otherwise ? {ctor:"_Tuple2", _0:{ctor:"_Tuple3", _0:A2(enqueue, n, arg1._0), _1:(arg1._1+1), _2:(arg1._2+n)}, _1:((arg1._2+n)/(Basics.toFloat(arg1._1)+1))} : _E.If($moduleName,'between lines 82 and 83'))); }_E.Case($moduleName,'between lines 82 and 83')}();}); return A2(hiddenState, {ctor:"_Tuple3", _0:empty, _1:0, _2:0}, step);}();}; var pure = function(f){ diff --git a/data/interfaces.data b/data/interfaces.data Binary files a/data/interfaces.data and b/data/interfaces.data differ