9a40249 · elk · git.iko.soy

compiler/Generate/JavaScript.hs+9−3

compare with master

unifiedsplit

@@ -29,7 +29,8 @@ internalImports =

29 ("_N", "N.Utils(elm)"),

30 ("_L", "N.List(elm)"),

31 ("_E", "N.Error(elm)"),

32− ("_str", "N.JavaScript(elm).toString")

32+ ("_J", "N.JavaScript(elm)"),

33+ ("_str", "_J.toString")

33 ]

34 ]

34

35

35parens s = "(" ++ s ++ ")"

36parens s = "(" ++ s ++ ")"

@@ -225,11 +226,16 @@ instance ToJS (Expr t v) where

225

226

226 App e1 e2 -> jsApp e1 e2

227 App e1 e2 -> jsApp e1 e2

227 Let defs e -> jsLet defs e

228 Let defs e -> jsLet defs e

229+

230+ ExplicitList es ->

231+ do es' <- mapM toJS' es

232+ return $ "_J.toList" ++ parens (jsList es')

233+

228 Data name es ->

234 Data name es ->

229 do fs <- mapM toJS' es

235 do fs <- mapM toJS' es

230 return $ case name of

236 return $ case name of

231− "Nil" -> jsNil

237+ "[]" -> jsNil

232− "Cons" -> jsCons (head fs) ((head . tail) fs)

238+ "::" -> jsCons (head fs) ((head . tail) fs)

233 _ -> jsObj $ ("ctor:" ++ show name) : fields

239 _ -> jsObj $ ("ctor:" ++ show name) : fields

234 where fields = zipWith (\n e -> "_" ++ show n ++ ":" ++ e) [0..] fs

240 where fields = zipWith (\n e -> "_" ++ show n ++ ":" ++ e) [0..] fs

235

241

compiler/Metadata/Libraries.hs+2−2

@@ -29,8 +29,8 @@ libraries =

29 Ok libs -> Map.unionWith Map.union libs nilAndTuples

30 where nilAndTuples = Map.singleton "Prelude" (Map.fromList pairs)

31 pairs =

32− [ ("Cons", "a -> [a] -> [a]")

32+ [ ("::", "a -> [a] -> [a]")

33− , ("Nil", "[a]")

33+ , ("[]", "[a]")

34 ] ++ map makeTuple (inits ['a'..'i'])

35

36 makeTuple cs =

compiler/Parse/Expression.hs+1−2

@@ -52,8 +52,7 @@ listTerm =

52 <|> (braces $ choice

53 [ try $ do { lo <- expr; whitespace; string ".." ; whitespace

54 ; Range lo <$> expr }

55− , do (L _ _ e) <- list <$> commaSep expr

55+ , ExplicitList <$> commaSep expr

56− return e

57 ])

56 ])

58

57

59parensTerm :: IParser (LExpr t v)

58parensTerm :: IParser (LExpr t v)

compiler/SourceSyntax/Expression.hs+7−10

@@ -26,6 +26,7 @@ data Expr t v

26 | MultiIf [(LExpr t v,LExpr t v)]

27 | Let [Def t v] (LExpr t v)

28 | Case (LExpr t v) [(Pattern.Pattern, LExpr t v)]

29+ | ExplicitList [LExpr t v]

29 | Data String [LExpr t v]

30 | Data String [LExpr t v]

30 | Markdown Pandoc.Pandoc

31 | Markdown Pandoc.Pandoc

31 deriving (Eq, Data, Typeable)

32 deriving (Eq, Data, Typeable)

@@ -36,12 +37,9 @@ data Def tipe var

36 | TypeAnnotation String Type

37 | TypeAnnotation String Type

37 deriving (Eq, Data, Typeable)

38 deriving (Eq, Data, Typeable)

38

39

39−cons h t = Location.merge h t (Data "Cons" [h,t])

40−nil = Location.L (Just "[]") Location.NoSpan (Data "Nil" [])

41−list = foldr cons nil

42tuple es = Data ("Tuple" ++ show (length es)) es

40tuple es = Data ("Tuple" ++ show (length es)) es

43

41

44−delist (Location.L _ _ (Data "Cons" [h,t])) = h : delist t

42+delist (Location.L _ _ (Data "::" [h,t])) = h : delist t

45delist _ = []

43delist _ = []

46

44

47

45

@@ -71,11 +69,10 @@ instance Show (Expr t v) where

71 Var (c:cs) -> if Help.isOp c then Help.parens (c:cs) else c:cs

69 Var (c:cs) -> if Help.isOp c then Help.parens (c:cs) else c:cs

72 Case e pats -> "case "++ show e ++" of " ++ Help.brkt (intercalate " ; " pats')

70 Case e pats -> "case "++ show e ++" of " ++ Help.brkt (intercalate " ; " pats')

73 where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats

71 where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats

74− Data name es

72+ ExplicitList es -> "[" ++ intercalate "," (map show es) ++ "]"

75− | name == "Cons" -> ("["++) . (++"]") . intercalate "," . map show $

73+ Data "::" [h,t] -> show h ++ " :: " ++ show t

76− delist (Location.none $ Data "Cons" es)

74+ Data "[]" [] -> "[]"

77− | name == "Nil" -> "[]"

78− | otherwise -> name ++ " " ++ intercalate " " (map show' es)

75+ Data name es -> name ++ " " ++ intercalate " " (map show' es)

79 Markdown _ -> "[markdown| ... |]"

76 Markdown _ -> "[markdown| ... |]"

80

77

81

78

@@ -99,5 +96,5 @@ needsParens e =

99 MultiIf _ -> True

96 MultiIf _ -> True

100 Let _ _ -> True

97 Let _ _ -> True

101 Case _ _ -> True

98 Case _ _ -> True

102− Data name (x:xs) -> name /= "Cons"

99+ Data name (x:xs) -> name /= "::"

103 _ -> False

100 _ -> False

compiler/SourceSyntax/Pattern.hs+5−5

@@ -15,8 +15,8 @@ data Pattern = PData String [Pattern]

15 | PLiteral Literal.Literal

16 deriving (Eq, Data, Typeable)

17

18−cons h t = PData "Cons" [h,t]

18+cons h t = PData "::" [h,t]

19−nil = PData "Nil" []

19+nil = PData "[]" []

20list = foldr cons nil

21tuple es = PData ("Tuple" ++ show (length es)) es

22

@@ -29,10 +29,10 @@ instance Show Pattern where

29 PRecord fs -> brkt (intercalate ", " fs)

30 PAlias x p -> show p ++ " as " ++ x

31 PAnything -> "_"

32− PData "Cons" [hd@(PData "Cons" _),tl] ->

32+ PData "::" [hd@(PData "::" _),tl] ->

33 parens (show hd) ++ " :: " ++ show tl

34− PData "Cons" [hd,tl] -> show hd ++ " :: " ++ show tl

34+ PData "::" [hd,tl] -> show hd ++ " :: " ++ show tl

35− PData "Nil" [] -> "[]"

35+ PData "[]" [] -> "[]"

36 PData name ps ->

37 if take 5 name == "Tuple" && all isDigit (drop 5 name) then

38 parens . intercalate ", " $ map show ps

compiler/SourceSyntax/Rename.hs+2

@@ -108,6 +108,8 @@ instance Rename (Expr t v) where

108

109 Data name es -> Data name `liftM` mapM rnm es

110

111+ ExplicitList es -> ExplicitList `liftM` mapM rnm es

112+

111 Case e cases -> Case `liftM` rnm e

113 Case e cases -> Case `liftM` rnm e

112 `ap` mapM (patternRename env) cases

114 `ap` mapM (patternRename env) cases

113

115

compiler/Transform/Optimize.hs+4−4

@@ -121,7 +121,7 @@ binop op ce1@(L t1 s1 e1) ce2@(L t2 s2 e2) =

121 ("||", Literal (Boolean True), _) -> bool True

122 ("||", Literal (Boolean False), _) -> e2

123

124− ("::", _, _) -> let (L _ _ e) = cons ce1 ce2 in e

124+ ("::", _, _) -> Data "::" [ce1, ce2]

125

126 ("++", Literal (Str s1), Literal (Str s2)) -> str $ s1 ++ s2

127 ("++", Literal (Str s1), Binop "++" (L _ _ (Literal (Str s2))) ce) ->

@@ -129,9 +129,9 @@ binop op ce1@(L t1 s1 e1) ce2@(L t2 s2 e2) =

129 ("++", Binop "++" e (L _ _ (Literal (Str s1))), Literal (Str s2)) ->

130 Binop "++" e (c1 . str $ s1 ++ s2)

131

132− ("++", Data "Nil" [], _) -> e2

132+ ("++", Data "[]" [], _) -> e2

133− ("++", _, Data "Nil" []) -> e1

133+ ("++", _, Data "[]" []) -> e1

134− ("++", Data "Cons" [h,t], _) -> Data "Cons" [h, none $ binop "++" t ce2]

134+ ("++", Data "::" [h,t], _) -> Data "::" [h, none $ binop "++" t ce2]

135

136 ("|>", _, _) -> App ce2 ce1

137 ("<|", _, _) -> App ce1 ce2

compiler/Transform/Replace.hs+2−1

@@ -20,6 +20,7 @@ replace y v expr =

20 Let defs e -> if y `elem` vs then Let defs e else Let (zip vs (map f es)) (f e)

21 where (vs,es) = unzip defs

22 Var x -> if x == y then v else Var x

23+ ExplicitList es -> ExplicitList (map f es)

23 Data name es -> Data name (map f es)

24 Data name es -> Data name (map f es)

24 Case e cases -> Case (f e) $ map (caseReplace y v) cases

25 Case e cases -> Case (f e) $ map (caseReplace y v) cases

25 _ -> expr

26 _ -> expr

@@ -52,7 +53,7 @@ depth' d expr =

52 Fold e1 e2 e3 -> maximum [f e1, f e2, f e3]

53 Fold e1 e2 e3 -> maximum [f e1, f e2, f e3]

53 Async e -> f e

54 Async e -> f e

54 Let defs e -> let (_,es) = unzip defs in maximum $ f e : map f es

55 Let defs e -> let (_,es) = unzip defs in maximum $ f e : map f es

55− Data "Cons" es -> maximum $ map (depth' d) es

56+ Data "::" es -> maximum $ map (depth' d) es

56 Data name es -> maximum $ 1 : map f es

57 Data name es -> maximum $ 1 : map f es

57 Case e cases -> maximum $ f e : map (f . snd) cases

58 Case e cases -> maximum $ f e : map (f . snd) cases

58 _ -> d

59 _ -> d

compiler/Types/Constrain.hs+6

@@ -150,6 +150,12 @@ gen (L _ span expr) =

150 in concat $ cs' : cs : css

151 , head ts)

152

153+ ExplicitList es ->

154+ do (ass,css,ts) <- unzip3 `liftM` mapM gen es

155+ t <- beta

156+ let cs = zipWith (\t' (L a b _) -> L a b (t :=: t')) ts es

157+ return ( unionsA ass, cs ++ concat css, listOf t )

158+

153 Data name es ->

159 Data name es ->

154 gen $ foldl' (\f x -> merge f x $ App f x) (loc' $ Var name) es

160 gen $ foldl' (\f x -> merge f x $ App f x) (loc' $ Var name) es

155

161

compiler/Types/Solver.hs+2−2

@@ -28,9 +28,9 @@ crush aliases forall@(Forall xs cs t) =

28 return $ do ss' <- subs

29 let ss = Map.toList ss'

30 cs' = filter (not . isSolved ss) (subst ss cs)

31− f x = (unsafePerformIO $ do

31+ f x = x {-(unsafePerformIO $ do

32 print forall >> putStrLn "-------"

33− print x >> putStrLn "~~~~~~~") `seq` x

33+ print x >> putStrLn "~~~~~~~") `seq` x-}

34 return . f $ Forall xs cs' (subst ss t)

35

36schemeSubHelp txt span x s t1 rltn t2 = do

compiler/Types/Types.hs+1−1

@@ -71,7 +71,7 @@ parens = ("("++) . (++")")

71instance Show Type where

72 show t =

73 let addParens (c:cs) =

74− if notElem ' ' cs || c == '(' then c:cs else parens (c:cs)

74+ if notElem ' ' cs || c == '(' || c == '{' then c:cs else parens (c:cs)

75 in case t of

76 LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2

77 LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2

libraries/Native/JavaScript.js+1−1

@@ -44,7 +44,7 @@ Elm.Native.JavaScript = function(elm) {

44 }

45 return obj;

46 }

47− if (type === 'object' && (v.ctor === 'Cons' || v.ctor === 'Nil')) {

47+ if (type === 'object' && (v.ctor === '::' || v.ctor === '[]')) {

48 var array = List.toArray(v);

49 if (typeof array[0] === 'string') {

50 array = array.join('');

libraries/Native/List.js+27−27

@@ -9,7 +9,7 @@ Elm.Native.List = function(elm) {

9 var Utils = Elm.Native.Utils(elm);

10

11 // TODO: Improve Nil handling

12− // We can change places like: if (xs.ctor === 'Nil') ... to if (xs === Nil) ...

12+ // We can change places like: if (xs.ctor === '[]') ... to if (xs === Nil) ...

13 // but only if we're confident Nil can only be defined once.

14 // Currently (27Mar2013) each module can have different instantiations, so multiple Nil objects can exist

15 // (and if they're used interchangeably then direct object comparison fails where ctor doesn't).

@@ -17,11 +17,11 @@ Elm.Native.List = function(elm) {

17 // The performance overhead of the .ctor calls is 5-10% according to jsperf (depending on fn + list size)

18 // (on firefox 19)

19

20− var Nil = { ctor:'Nil' };

20+ var Nil = { ctor:'[]' };

21

22 // using freeze for every cons would be nice but is a huge (9x on firefox 19)

23 // performance penalty

24− function Cons(hd,tl) { return { ctor:"Cons", _0:hd, _1:tl }; }

24+ function Cons(hd,tl) { return { ctor:"::", _0:hd, _1:tl }; }

25

26 function throwError(f) {

27 throw new Error("Function '" + f + "' expects a non-empty list!");

@@ -29,7 +29,7 @@ Elm.Native.List = function(elm) {

29

30 function toArray(xs) {

31 var out = [];

32− while (xs.ctor !== 'Nil') {

32+ while (xs.ctor !== '[]') {

33 out.push(xs._0);

34 xs = xs._1;

35 }

@@ -54,11 +54,11 @@ Elm.Native.List = function(elm) {

54

55 function append(xs,ys) {

56 if (typeof xs === "string") { return xs.concat(ys); }

57− if (xs.ctor === 'Nil') { return ys; }

57+ if (xs.ctor === '[]') { return ys; }

58 var root = Cons(xs._0, Nil);

59 var curr = root;

60 xs = xs._1;

61− while (xs.ctor !== 'Nil') {

61+ while (xs.ctor !== '[]') {

62 curr._1 = Cons(xs._0, Nil);

63 xs = xs._1;

64 curr = curr._1;

@@ -67,13 +67,13 @@ Elm.Native.List = function(elm) {

67 return root;

68 }

69

70− function head(v) { return v.ctor === 'Nil' ? throwError('head') : v._0; }

70+ function head(v) { return v.ctor === '[]' ? throwError('head') : v._0; }

71− function tail(v) { return v.ctor === 'Nil' ? throwError('tail') : v._1; }

71+ function tail(v) { return v.ctor === '[]' ? throwError('tail') : v._1; }

72

73 function last(xs) {

74− if (xs.ctor === 'Nil') { throwError('last'); }

74+ if (xs.ctor === '[]') { throwError('last'); }

75 var out = xs._0;

76− while (xs.ctor !== 'Nil') {

76+ while (xs.ctor !== '[]') {

77 out = xs._0;

78 xs = xs._1;

79 }

@@ -82,7 +82,7 @@ Elm.Native.List = function(elm) {

82

83 function map(f, xs) {

84 var arr = [];

85− while (xs.ctor !== 'Nil') {

85+ while (xs.ctor !== '[]') {

86 arr.push(f(xs._0));

87 xs = xs._1;

88 }

@@ -93,7 +93,7 @@ Elm.Native.List = function(elm) {

93 // ie, foldl :: (a -> b -> b) -> b -> [a] -> b

94 function foldl(f, b, xs) {

95 var acc = b;

96− while (xs.ctor !== 'Nil') {

96+ while (xs.ctor !== '[]') {

97 acc = A2(f, xs._0, acc);

98 xs = xs._1;

99 }

@@ -110,11 +110,11 @@ Elm.Native.List = function(elm) {

110 }

111

112 function foldl1(f, xs) {

113− return xs.ctor === 'Nil' ? throwError('foldl1') : foldl(f, xs._0, xs._1);

113+ return xs.ctor === '[]' ? throwError('foldl1') : foldl(f, xs._0, xs._1);

114 }

115

116 function foldr1(f, xs) {

117− if (xs.ctor === 'Nil') { throwError('foldr1'); }

117+ if (xs.ctor === '[]') { throwError('foldr1'); }

118 var arr = toArray(xs);

119 var acc = arr.pop();

120 for (var i = arr.length; i--; ) {

@@ -134,12 +134,12 @@ Elm.Native.List = function(elm) {

134 }

135

136 function scanl1(f, xs) {

137− return xs.ctor === 'Nil' ? throwError('scanl1') : scanl(f, xs._0, xs._1);

137+ return xs.ctor === '[]' ? throwError('scanl1') : scanl(f, xs._0, xs._1);

138 }

139

140 function filter(pred, xs) {

141 var arr = [];

142− while (xs.ctor !== 'Nil') {

142+ while (xs.ctor !== '[]') {

143 if (pred(xs._0)) { arr.push(xs._0); }

144 xs = xs._1;

145 }

@@ -148,7 +148,7 @@ Elm.Native.List = function(elm) {

148

149 function length(xs) {

150 var out = 0;

151− while (xs.ctor !== 'Nil') {

151+ while (xs.ctor !== '[]') {

152 out += 1;

153 xs = xs._1;

154 }

@@ -156,7 +156,7 @@ Elm.Native.List = function(elm) {

156 }

157

158 function member(x, xs) {

159− while (xs.ctor !== 'Nil') {

159+ while (xs.ctor !== '[]') {

160 if (Utils.eq(x,xs._0)) return true;

161 xs = xs._1;

162 }

@@ -166,7 +166,7 @@ Elm.Native.List = function(elm) {

166 function reverse(xs) { return fromArray(toArray(xs).reverse()); }

167

168 function concat(xss) {

169− if (xss.ctor === 'Nil') return xss;

169+ if (xss.ctor === '[]') return xss;

170 var arr = toArray(xss);

171 var xs = arr[arr.length-1];

172 for (var i = arr.length-1; i--; ) {

@@ -176,7 +176,7 @@ Elm.Native.List = function(elm) {

176 }

177

178 function all(pred, xs) {

179− while (xs.ctor !== 'Nil') {

179+ while (xs.ctor !== '[]') {

180 if (!pred(xs._0)) return false;

181 xs = xs._1;

182 }

@@ -184,7 +184,7 @@ Elm.Native.List = function(elm) {

184 }

185

186 function any(pred, xs) {

187− while (xs.ctor !== 'Nil') {

187+ while (xs.ctor !== '[]') {

188 if (pred(xs._0)) return true;

189 xs = xs._1;

190 }

@@ -193,7 +193,7 @@ Elm.Native.List = function(elm) {

193

194 function zipWith(f, xs, ys) {

195 var arr = [];

196− while (xs.ctor !== 'Nil' && ys.ctor !== 'Nil') {

196+ while (xs.ctor !== '[]' && ys.ctor !== '[]') {

197 arr.push(A2(f, xs._0, ys._0));

198 xs = xs._1;

199 ys = ys._1;

@@ -203,7 +203,7 @@ Elm.Native.List = function(elm) {

203

204 function zip(xs, ys) {

205 var arr = [];

206− while (xs.ctor !== 'Nil' && ys.ctor !== 'Nil') {

206+ while (xs.ctor !== '[]' && ys.ctor !== '[]') {

207 arr.push(Utils.Tuple2(xs._0, ys._0));

208 xs = xs._1;

209 ys = ys._1;

@@ -221,7 +221,7 @@ Elm.Native.List = function(elm) {

221

222 function take(n, xs) {

223 var arr = [];

224− while (xs.ctor !== 'Nil' && n > 0) {

224+ while (xs.ctor !== '[]' && n > 0) {

225 arr.push(xs._0);

226 xs = xs._1;

227 --n;

@@ -230,7 +230,7 @@ Elm.Native.List = function(elm) {

230 }

231

232 function drop(n, xs) {

233− while (xs.ctor !== 'Nil' && n > 0) {

233+ while (xs.ctor !== '[]' && n > 0) {

234 xs = xs._1;

235 --n;

236 }

@@ -239,11 +239,11 @@ Elm.Native.List = function(elm) {

239

240 function join(sep, xss) {

241 if (typeof sep === 'string') return toArray(xss).join(sep);

242− if (xss.ctor === 'Nil') return Nil;

242+ if (xss.ctor === '[]') return Nil;

243 var s = toArray(sep);

244 var out = toArray(xss._0);

245 xss = xss._1;

246− while (xss.ctor !== 'Nil') {

246+ while (xss.ctor !== '[]') {

247 out = out.concat(s, toArray(xss._0));

248 xss = xss._1;

249 }

libraries/Native/Show.js+4−4

@@ -44,7 +44,7 @@ Elm.Native.Show = function(elm) {

44 output.push(toString(v[k]));

45 }

46 return "(" + output.join(",") + ")";

47− } else if (v.ctor === "Cons") {

47+ } else if (v.ctor === "::") {

48 var isStr = typeof v._0 === "string",

49 start = isStr ? '"' : "[",

50 end = isStr ? '"' : "]",

@@ -52,18 +52,18 @@ Elm.Native.Show = function(elm) {

52 f = !isStr ? toString : showChar;

53 var output = start + f(v._0);

54 v = v._1;

55− while (v.ctor === "Cons") {

55+ while (v.ctor === "::") {

56 output += sep + f(v._0);

57 v = v._1;

58 }

59 return output + end;

60− } else if (v.ctor === "Nil") {

60+ } else if (v.ctor === "[]") {

61 return "[]";

62 } else if (v.ctor === "RBNode" || v.ctor === "RBEmpty") {

63 var cons = F3(function(k,v,acc){return NList.Cons(Tuple2(k,v),acc)});

64 var list = A3(Dict.foldr, cons, NList.Nil, v);

65 var name = "Dict";

66− if (list.ctor === "Cons" && list._0._1.ctor === "Tuple0") {

66+ if (list.ctor === "::" && list._0._1.ctor === "Tuple0") {

67 name = "Set";

68 list = A2(List.map, function(x){return x._0}, list);

69 }

libraries/Native/Signal/Http.js+1−1

@@ -11,7 +11,7 @@ Elm.Native.Http = function(elm) {

11

12

13 function registerReq(queue,responses) { return function(req) {

14− if (req.url.ctor !== 'Nil') { sendReq(queue,responses,req); }

14+ if (req.url.ctor !== '[]') { sendReq(queue,responses,req); }

15 };

16 }

17

libraries/Native/Signal/Keyboard.js+1−1

@@ -35,7 +35,7 @@ Elm.Native.Keyboard = function(elm) {

35 function dir(up, down, left, right) {

36 function f(ks) {

37 var x = 0, y = 0;

38− while (ks.ctor == "Cons") {

38+ while (ks.ctor === "::") {

39 switch (ks._0) {

40 case left : --x; break;

41 case right: ++x; break;

libraries/Native/Utils.js+3−3

@@ -25,10 +25,10 @@ Elm.Native.Utils = function(elm) {

25 var ord;

26 if (typeof x !== 'object') return x === y ? EQ : x < y ? LT : GT;

27

28− if (x.ctor === "Cons" || x.ctor === "Nil") {

28+ if (x.ctor === "::" || x.ctor === "[]") {

29 while (true) {

30− if (x.ctor === "Nil" && y.ctor === "Nil") return EQ;

30+ if (x.ctor === "[]" && y.ctor === "[]") return EQ;

31− if (x.ctor !== y.ctor) return x.ctor === 'Nil' ? LT : GT;

31+ if (x.ctor !== y.ctor) return x.ctor === '[]' ? LT : GT;

32 ord = cmp(x._0, y._0);

33 if (ord !== EQ) return ord;

34 x = x._1;