git.iko.soy/elk
on master help sign in
Merge branch 'master' of https://github.com/evancz/Elm
61b6c88evancz
README.md+1−1
compare with master
unifiedsplit
@@ -20,7 +20,7 @@ Assuming everything goes correctly (potential problems are discussed later), thi
20
20
21* elm-server :: This is both a compiler and server, allowing you to develop without designing and setting up a server yourself. Running the "elm-server" program starts a server in the current directory. It will compile and serve any .elm files in the current directory and its sub-directories. This is how I prefer to develop Elm programs.
21* elm-server :: This is both a compiler and server, allowing you to develop without designing and setting up a server yourself. Running the "elm-server" program starts a server in the current directory. It will compile and serve any .elm files in the current directory and its sub-directories. This is how I prefer to develop Elm programs.
22
22
23−To use these executables you may need to add a new directory to your PATH. For me, the executables were placed in /home/evan/.cabal/bin which I appended to the end of my PATH variable in my .bashrc file. Cabal should tell you where your executables are located, so you can make a similar addition.
23+To use these executables you need to add a new directory to your PATH. For me, the executables were placed in /home/evan/.cabal/bin which I appended to the end of my PATH variable in my .bashrc file. Cabal should tell you where your executables are located, so you can make a similar addition (see this tutorial if you are new to changing your PATH in [Unix/Linux](http://www.cyberciti.biz/faq/unix-linux-adding-path/)).
24
24
25That is almost everything. Create a new directory and navigate into it. Download the [elm-mini.js](https://raw.github.com/evancz/Elm/master/elm-mini.js) file which is the Elm runtime system. It is separate from the compiler for now. You can use the command
25That is almost everything. Create a new directory and navigate into it. Download the [elm-mini.js](https://raw.github.com/evancz/Elm/master/elm-mini.js) file which is the Elm runtime system. It is separate from the compiler for now. You can use the command
26
26
src/ExtractNoscript.hs+3−3
@@ -2,7 +2,7 @@
2module ExtractNoscript (extract) where
2module ExtractNoscript (extract) where
3
3
4import Ast
4import Ast
5−import List (isPrefixOf)
5+import Data.List (isPrefixOf)
6
6
7extract = extract'
7extract = extract'
8
8
@@ -35,9 +35,9 @@ toString _ = []
35makeLinks (a:b:[]) = linkify a b
35makeLinks (a:b:[]) = linkify a b
36makeLinks xs = xs
36makeLinks xs = xs
37
37
38−linkish s = not (isPrefixOf "<a" s) && all (/=' ') s && any (=='/') s
38+linkish s = not ("<a" `isPrefixOf` s) && notElem ' ' s && elem '/' s
39
39
40linkify a b
40linkify a b
41 | linkish a = [ "<a href=\"" ++ a ++ "\">" ++ b ++ "</a>" ]
41 | linkish a = [ "<a href=\"" ++ a ++ "\">" ++ b ++ "</a>" ]
42 | linkish b = [ "<a href=\"" ++ b ++ "\">" ++ a ++ "</a>" ]
42 | linkish b = [ "<a href=\"" ++ b ++ "\">" ++ a ++ "</a>" ]
43− | otherwise = [a,b]
43+ | otherwise = [a,b]
src/FreeVar.hs+5−5
@@ -8,10 +8,10 @@ x `freeIn` expr = member x $ freeVars expr
8freeVars expr =
8freeVars expr =
9 let f = freeVars in
9 let f = freeVars in
10 case expr of
10 case expr of
11− Range e1 e2 -> union (f e1) (f e2)
11+ Range e1 e2 -> f e1 `union` f e2
12− Binop op e1 e2 -> union (f e1) (f e2)
12+ Binop op e1 e2 -> f e1 `union` f e2
13 Lambda x e -> delete x (f e)
13 Lambda x e -> delete x (f e)
14− App e1 e2 -> union (f e1) (f e2)
14+ App e1 e2 -> f e1 `union` f e2
15 If e1 e2 e3 -> unions $ map f [e1,e2,e3]
15 If e1 e2 e3 -> unions $ map f [e1,e2,e3]
16 Lift e es -> unions $ map f es
16 Lift e es -> unions $ map f es
17 Fold e1 e2 e3 -> unions $ map f [e1,e2,e3]
17 Fold e1 e2 e3 -> unions $ map f [e1,e2,e3]
@@ -20,11 +20,11 @@ freeVars expr =
20 where (vs,es) = unzip defs
20 where (vs,es) = unzip defs
21 Var x -> singleton x
21 Var x -> singleton x
22 Data name es -> unions (map f es)
22 Data name es -> unions (map f es)
23− Case e cases -> union (f e) (unions $ map caseFreeVars cases)
23+ Case e cases -> f e `union` unions (map caseFreeVars cases)
24 _ -> empty
24 _ -> empty
25
25
26caseFreeVars (p,e) = difference (freeVars e) (pvars p)
26caseFreeVars (p,e) = difference (freeVars e) (pvars p)
27 where pvars p = case p of
27 where pvars p = case p of
28 PAnything -> empty
28 PAnything -> empty
29 PVar x -> singleton x
29 PVar x -> singleton x
30− PData _ ps -> unions (map pvars ps)
30+ PData _ ps -> unions (map pvars ps)
src/Parse/Binop.hs+3−3
@@ -5,7 +5,7 @@ import Combinators
5import Control.Monad (liftM,guard)
5import Control.Monad (liftM,guard)
6import Control.Monad.Error
6import Control.Monad.Error
7import Data.List (foldl',splitAt,elemIndices,group,groupBy,sortBy,find)
7import Data.List (foldl',splitAt,elemIndices,group,groupBy,sortBy,find)
8−import Data.Map as Map
8+import qualified Data.Map as Map
9import Data.Maybe (mapMaybe)
9import Data.Maybe (mapMaybe)
10
10
11data Assoc = L | Non | R deriving (Eq,Show)
11data Assoc = L | Non | R deriving (Eq,Show)
@@ -45,14 +45,14 @@ binopOf seen (tbl@((lvl, L, op):rest)) ops es =
45 case elemIndices op ops of
45 case elemIndices op ops of
46 [] -> binopOf seen rest ops es
46 [] -> binopOf seen rest ops es
47 is -> case Map.lookup lvl seen of
47 is -> case Map.lookup lvl seen of
48− Nothing -> binopSplit (insert lvl (L,op) seen) tbl (last is) ops es
48+ Nothing -> binopSplit (Map.insert lvl (L,op) seen) tbl (last is) ops es
49 Just (L,_) -> binopSplit seen tbl (last is) ops es
49 Just (L,_) -> binopSplit seen tbl (last is) ops es
50 Just (assoc,op') -> Left $ errorMessage lvl op L op' assoc
50 Just (assoc,op') -> Left $ errorMessage lvl op L op' assoc
51binopOf seen (tbl@((lvl, assoc, op):rest)) ops es =
51binopOf seen (tbl@((lvl, assoc, op):rest)) ops es =
52 case elemIndices op ops of
52 case elemIndices op ops of
53 [] -> binopOf seen rest ops es
53 [] -> binopOf seen rest ops es
54 i:_ -> case Map.lookup lvl seen of
54 i:_ -> case Map.lookup lvl seen of
55− Nothing -> binopSplit (insert lvl (R,op) seen) tbl i ops es
55+ Nothing -> binopSplit (Map.insert lvl (R,op) seen) tbl i ops es
56 Just (assoc',op') ->
56 Just (assoc',op') ->
57 if assoc == assoc' && assoc /= Non then
57 if assoc == assoc' && assoc /= Non then
58 binopSplit seen tbl i ops es
58 binopSplit seen tbl i ops es
src/Rename.hs+70−46
@@ -1,73 +1,97 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1module Rename (rename) where
2module Rename (rename) where
2
3
3import Ast
4import Ast
4import Control.Arrow (first)
5import Control.Arrow (first)
5−import Control.Monad.State
6+import Control.Monad (ap, liftM, foldM, mapM, Monad)
7+import Control.Monad.State (evalState, State, get, put)
6import Data.Char (isLower)
8import Data.Char (isLower)
7−import Data.List (mapAccumL)
8−import Data.Functor.Identity
9
9
10−rename expr = evalState (rename' id expr) 0
10+-- Wrapper around State monad.
11+newtype GuidCounter a = GC { runGC :: State Int a }
12+ deriving (Monad)
11
13
14+-- Get the next GUID, incrementing the counter.
12−guid :: State Int Int
15+guid :: GuidCounter Int
13−guid = do n <- get
16+guid = GC $ do n <- get
14− put (n+1)
17+ put (n + 1)
15− return n
18+ return n
16
19
20+rename :: Expr -> Expr
21+rename expr = evalState (runGC $ rename' id expr) 0
22+
23+rename' :: (String -> String) -> Expr -> GuidCounter Expr
17rename' env expr =
24rename' env expr =
18 case expr of
25 case expr of
26+
19− Range e1 e2 -> do
27+ Range e1 e2 -> Range `liftM` rnm e1
20− re1 <- rename' env e1; re2 <- rename' env e2
28+ `ap` rnm e2
21− return $ Range re1 re2
29+
22− Access e x -> do
30+ Access e x -> Access `liftM` rnm e
23− re <- rename' env e
31+ `ap` return x
24− return $ Access re x
32+
25− Binop op e1 e2 ->
33+ Binop op@(h:_) e1 e2 ->
26− do let rop = if isLower (head op) || '_' == head op then env op else op
34+ let rop = if isLower h || '_' == h
27− re1 <- rename' env e1; re2 <- rename' env e2
35+ then env op
28− return $ Binop rop re1 re2
36+ else op
37+ in Binop rop `liftM` rnm e1
38+ `ap` rnm e2
39+
40+ Lambda x e -> do
29− Lambda x e -> do (rx, env') <- extend env x
41+ (rx, env') <- extend env x
30− rename' env' e >>= return . Lambda rx
42+ Lambda rx `liftM` rename' env' e
43+
31− App e1 e2 -> do
44+ App e1 e2 -> App `liftM` rnm e1
32− re1 <- rename' env e1; re2 <- rename' env e2
45+ `ap` rnm e2
33− return $ App re1 re2
46+
34− If e1 e2 e3 -> do
47+ If e1 e2 e3 -> If `liftM` rnm e1
35− re1 <- rename' env e1; re2 <- rename' env e2; re3 <- rename' env e3
48+ `ap` rnm e2
36− return $ If re1 re2 re3
49+ `ap` rnm e3
50+
37− Lift e es -> do
51+ Lift e es -> Lift `liftM` rnm e
38− re <- rename' env e
52+ `ap` mapM rnm es
39− mapM (rename' env) es >>= return . Lift re
53+
40− Fold e1 e2 e3 -> do
54+ Fold e1 e2 e3 -> Fold `liftM` rnm e1
41− re1 <- rename' env e1; re2 <- rename' env e2; re3 <- rename' env e3
55+ `ap` rnm e2
42− return $ Fold re1 re2 re3
56+ `ap` rnm e3
43− Async e -> rename' env e >>= return . Async
57+
58+ Async e -> Async `liftM` rnm e
59+
44 Let defs e -> do
60 Let defs e -> do
45 let (vs,es) = unzip defs
61 let (vs,es) = unzip defs
46− env' <- foldM (\acc x -> extend acc x >>= return . snd) env vs
62+ env' <- foldM (\acc x -> snd `liftM` extend acc x) env vs
47 es' <- mapM (rename' env') es; re <- rename' env' e
63 es' <- mapM (rename' env') es; re <- rename' env' e
48 return $ Let (zip (map env' vs) es') re
64 return $ Let (zip (map env' vs) es') re
65+
49 Var x -> return . Var $ env x
66 Var x -> return . Var $ env x
50− Data name es -> mapM (rename' env) es >>= return . Data name
67+
68+ Data name es -> Data name `liftM` mapM rnm es
69+
51− Case e cases -> do
70+ Case e cases -> Case `liftM` rnm e
52− re <- rename' env e
71+ `ap` mapM (patternRename env) cases
53− mapM (pattern_rename env) cases >>= return . (Case re)
72+
54 _ -> return expr
73 _ -> return expr
55
74
75+ where rnm = rename' env
76+
77+extend :: (String -> String) -> String -> GuidCounter (String, String -> String)
56extend env x = do
78extend env x = do
57 n <- guid
79 n <- guid
58 let rx = x ++ "_" ++ show n
80 let rx = x ++ "_" ++ show n
59− return (rx, (\y -> if y == x then rx else env y))
81+ return (rx, \y -> if y == x then rx else env y)
60
82
83+patternExtend :: Pattern -> (String -> String) -> GuidCounter (Pattern, String -> String)
61−pattern_extend pattern env =
84+patternExtend pattern env =
62 case pattern of
85 case pattern of
63 PAnything -> return (PAnything, env)
86 PAnything -> return (PAnything, env)
64− PVar x -> extend env x >>= return . first PVar
87+ PVar x -> first PVar `liftM` extend env x
65 PData name ps ->
88 PData name ps ->
66− foldM f ([],env) ps >>= return . first (PData name . reverse)
89+ first (PData name . reverse) `liftM` foldM f ([], env) ps
67− where f (rps,env') p = do (rp,env'') <- pattern_extend p env'
90+ where f (rps,env') p = do (rp,env'') <- patternExtend p env'
68 return (rp:rps, env'')
91 return (rp:rps, env'')
69
92
70−pattern_rename env (p,e) = do
93+patternRename :: (String -> String) -> (Pattern, Expr) -> GuidCounter (Pattern, Expr)
94+patternRename env (p,e) = do
71− (rp,env') <- pattern_extend p env
95+ (rp,env') <- patternExtend p env
72 re <- rename' env' e
96 re <- rename' env' e
73− return (rp,re)
97+ return (rp,re)