git.iko.soy/elk
on master help sign in
Load json representation of types with Template Haskell, so library files are the base truth of type information.

Make minor fixes in libraries, such as adding the Char labrary and fixing the types in the Dict library.

commit7dbb052b225664d5455fa086833b02159339da2c authorevancz <info@elm-lang.org> dateSat 16 Mar 2013, 22:24 (14 years ago) parent96ef984
14 files changed+283−575
compare with master
unifiedsplit
Elm.cabal+10−2 compiler/Docs.hs+3−2 compiler/Initialize.hs+3−3 compiler/Language/Elm.hs+1−2 compiler/Model/Libraries.hs+37 compiler/Model/LoadLibraries.hs+13 compiler/Types/Hints.hs+16−441 libraries/Char.elm+38 libraries/Dict.elm+119−116 libraries/Json.elm+1−1 libraries/Native/Char.js+31 libraries/Native/Prelude.js+7−6 libraries/Prelude.elm+2 libraries/Set.elm+2−2
Elm.cabal+10−2
@@ -42,6 +42,8 @@ Library
4242 GenerateHtml,
4343 Guid,
4444 LetBoundVars,
45+ Libraries,
46+ LoadLibraries,
4547 Optimize,
4648 Initialize,
4749 Rename,
@@ -77,7 +79,9 @@ Library
7779 bytestring,
7880 hjsmin,
7981 indents,
80− filepath
82+ filepath,
83+ template-haskell,
84+ json
8185
8286Executable elm
8387 Main-is: Compiler.hs
@@ -91,6 +95,8 @@ Executable elm
9195 GenerateHtml,
9296 Guid,
9397 LetBoundVars,
98+ Libraries,
99+ LoadLibraries,
94100 Optimize,
95101 Initialize,
96102 Rename,
@@ -124,7 +130,9 @@ Executable elm
124130 bytestring,
125131 hjsmin,
126132 indents,
127− filepath
133+ filepath,
134+ template-haskell,
135+ json
128136
129137Executable elm-doc
130138 Main-is: Docs.hs
compiler/Docs.hs+3−2
@@ -3,13 +3,13 @@ module Main where
33
44import Ast
55import Control.Applicative ((<$>), (<*>))
6−import Data.List as List
6+import Data.List (intercalate)
77import Parse.Library
88import Parse.Modules (moduleDef)
99import Parse.Types (typeAnnotation)
10+import Text.Parsec hiding (newline,spaces)
1011import System.Environment
1112import System.Exit
12−import Text.Parsec hiding (newline,spaces)
1313import Types.Types
1414
1515
@@ -29,6 +29,7 @@ toModule (name, values) =
2929toValue (name, tipe) =
3030 "{ \"name\" : " ++ show name ++ ",\n \"type\" : \"" ++ show tipe ++ "\"\n }"
3131
32+
3233docParse :: String -> Either String (String, [(String, Type)])
3334docParse = setupParser $ do
3435 optional freshLine
compiler/Initialize.hs+3−3
@@ -27,9 +27,9 @@ checkTypes (Module name ex im stmts) =
2727 let stmts' = dealias stmts
2828 modul = Module name ex im stmts'
2929 in do subs <- unify hints modul
30− let im' | any ((=="Prelude") . fst) im = im
31− | otherwise = ("Prelude", Importing []) : im
32− modul' = optimize . renameModule $ Module name ex im' stmts'
30+ let --im' | any ((=="Prelude") . fst) im = im
31+ -- | otherwise = ("Prelude", Importing []) : im
32+ modul' = optimize . renameModule $ Module name ex im stmts'
3333 subs `seq` return modul'
3434
3535check :: Module -> Either String Module
compiler/Language/Elm.hs+1−2
@@ -32,8 +32,7 @@ import qualified Data.Text.Lazy as TL
3232
3333-- |The absolute path to Elm's runtime system.
3434runtimeLocation :: IO FilePath
35−runtimeLocation =
36− getDataFileName ("elm-runtime-" ++ showVersion version ++ ".js")
35+runtimeLocation = getDataFileName "elm-runtime.js"
3736
3837class ElmSource a where
3938 -- |This function compiles Elm code to three separate parts: HTML, CSS,
compiler/Model/Libraries.hsnew file+37
@@ -0,0 +1,37 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+
3+module Libraries (libraries) where
4+
5+import qualified Data.Map as Map
6+import Text.JSON
7+import LoadLibraries
8+
9+libraries :: Map.Map String (Map.Map String String)
10+libraries = case getLibs of
11+ Ok libs -> libs
12+ Error err -> error err
13+
14+getLibs :: Result (Map.Map String (Map.Map String String))
15+getLibs = do
16+ obj <- decodeStrict $(docs) :: Result (JSObject JSValue)
17+ modules <- valFromObj "modules" obj :: Result [JSObject JSValue]
18+ Map.fromList `fmap` mapM getValues modules
19+
20+
21+getName :: JSObject JSValue -> Result String
22+getName obj = valFromObj "name" obj
23+
24+getType :: JSObject JSValue -> Result String
25+getType obj = valFromObj "type" obj
26+
27+getValue :: JSObject JSValue -> Result (String,String)
28+getValue obj = do n <- getName obj
29+ t <- getType obj
30+ return (n,t)
31+
32+getValues :: JSObject JSValue -> Result (String, Map.Map String String)
33+getValues obj = do
34+ name <- getName obj
35+ vs <- valFromObj "values" obj
36+ vals <- mapM getValue vs
37+ return (name, Map.fromList vals)
compiler/Model/LoadLibraries.hsnew file+13
@@ -0,0 +1,13 @@
1+
2+module LoadLibraries where
3+
4+import Language.Haskell.TH.Syntax
5+import Paths_Elm
6+
7+docs :: Q Exp
8+docs = liftString =<< qRunIO (do
9+ s <- readFile =<< getDataFileName "docs.json"
10+ putStrLn s
11+ return s
12+ )
13+
compiler/Types/Hints.hs+16−441
@@ -1,446 +1,21 @@
11module Types.Hints (hints) where
22
3−import Context
43import Control.Arrow (first)
5−import Control.Monad (liftM,mapM)
4+import qualified Data.Map as Map
5+import Guid
6+import Libraries
7+import Parse.Library (iParse)
8+import Parse.Types
9+import Types.Substitutions
610import Types.Types
7−import Types.Substitutions (rescheme)
811
9−ctx str = C (Just str) NoSpan
10−prefix pre xs = map (first (\x -> pre ++ "." ++ x)) xs
11−hasType t = map (-: t)
12−
13−
14−-------- Text and Elements --------
15−
16−textToText = [ "header", "italic", "bold", "underline"
17− , "overline", "strikeThrough", "monospace" ]
18−
19−textAttrs = [ "toText" -: string ==> text
20− , "Text.typeface" -: string ==> text ==> text
21− , "Text.link" -:: string ==> text ==> text
22− , numScheme (\t -> t ==> text ==> text) "Text.height"
23− ] ++ prefix "Text" (hasType (text ==> text) textToText)
24−
25−elements =
26− let iee = int ==> element ==> element in
27− [ "plainText" -: string ==> element
28− , "link" -:: string ==> element ==> element
29− , "flow" -: direction ==> listOf element ==> element
30− , "layers" -: listOf element ==> element
31− , "text" -: text ==> element
32− , "image" -: int ==> int ==> string ==> element
33− , "video" -: int ==> int ==> string ==> element
34− , "opacity" -: float ==> element ==> element
35− , "width" -: iee
36− , "height" -: iee
37− , "size" -: int ==> iee
38− , "widthOf" -: element ==> int
39− , "heightOf"-: element ==> int
40− , "sizeOf" -: element ==> pairOf int
41− , "color" -: color ==> element ==> element
42− , "container" -: int ==> int ==> position ==> element ==> element
43− , "spacer" -: int ==> int ==> element
44− , "rightedText" -: text ==> element
45− , "centeredText" -: text ==> element
46− , "justifiedText" -: text ==> element
47− , "asText" -:: a ==> element
48− , "collage" -: int ==> int ==> listOf form ==> element
49− , "fittedImage" -: int ==> int ==> string ==> element
50− ]
51−
52−directions = hasType direction ["up","down","left","right","inward","outward"]
53−positions =
54− hasType position ["topLeft","midLeft","bottomLeft","midTop","middle"
55− ,"midBottom","topRight","midRight","bottomRight"] ++
56− hasType (location ==> location ==> position)
57− ["topLeftAt","bottomLeftAt","middleAt","topRightAt","bottomRightAt"] ++
58− [ "absolute" -: int ==> location, "relative" -: float ==> location ]
59−
60−lineTypes = [ numScheme (\n -> listOf (pairOf n) ==> line) "line"
61− , numScheme (\n -> pairOf n ==> pairOf n ==> line) "segment"
62− , "customLine" -: listOf int ==> color ==> line ==> form
63− ] ++ hasType (color ==> line ==> form) ["solid","dashed","dotted"]
64−
65−shapes = [ twoNums (\n m -> listOf (pairOf n) ==> pairOf m ==> shape) "polygon"
66− , "filled" -: color ==> shape ==> form
67− , "outlined" -: color ==> shape ==> form
68− , "textured" -: string ==> shape ==> form
69− , "customOutline" -: listOf int ==> color ==> shape ==> form
70− ] ++ map (twoNums (\n m -> n ==> n ==> pairOf m ==> shape)) [ "ngon"
71− , "rect"
72− , "oval" ]
73−
74−collages = [ numScheme (\n -> pairOf n ==> element ==> form) "toForm"
75− , numScheme (\n -> string ==> n ==> n ==> pairOf n ==> form) "sprite"
76− , numScheme (\n -> n ==> n ==> form ==> form) "move"
77− , numScheme (\n -> n ==> form ==> form) "rotate"
78− , numScheme (\n -> n ==> form ==> form) "scale"
79− , numScheme (\n -> pairOf n ==> form ==> bool) "isWithin"
80− ]
81−
82−graphicsElement = prefix "Graphics"
83− (concat [elements,directions,positions,lineTypes,shapes,collages])
84−graphicsColor = prefix "Color" clrs
85− where clrs = [ numScheme (\n -> n ==> n ==> n ==> color) "rgb"
86− , numScheme (\n -> n ==> n ==> n ==> n ==> color) "rgba"
87− , "complement" -: color ==> color
88− ] ++ hasType color ["red","green","blue","black","white"
89− ,"yellow","cyan","magenta","grey","gray"]
90−
91−
92−-------- Foreign --------
93−
94−casts =
95− [ "castJSBoolToBool" -: jsBool ==> bool
96− , "castBoolToJSBool" -: bool ==> jsBool
97− , "castJSNumberToInt" -: jsNumber ==> int
98− , "castIntToJSNumber" -: int ==> jsNumber
99− , "castJSElementToElement" -: int ==> int ==> jsElement ==> element
100− , "castElementToJSElement" -: element ==> jsElement
101− , "castJSStringToString" -: jsString ==> string
102− , "castStringToJSString" -: string ==> jsString
103− , "castJSNumberToFloat" -: jsNumber ==> float
104− , "castFloatToJSNumber" -: float ==> jsNumber
105− ]
106−
107−castToTuple n = (,) name $ Forall [1..n] [] (jsTuple vs ==> tupleOf vs)
108− where vs = map VarT [1..n]
109− name = "castJSTupleToTuple" ++ show n
110−castToJSTuple n = (,) name $ Forall [1..n] [] (tupleOf vs ==> jsTuple vs)
111− where vs = map VarT [1..n]
112− name = "castTupleToJSTuple" ++ show n
113−
114−polyCasts =
115− map castToTuple [2..5] ++ map castToJSTuple [2..5] ++
116− [ "castJSArrayToList" -:: jsArray a ==> listOf a
117− , "castListToJSArray" -:: listOf a ==> jsArray a
118− ]
119−
120−javascript = prefix "JavaScript" (concat [casts,polyCasts])
121−
122−json = prefix "JSON"
123− [ "JsonString" -: string ==> jsonValue
124− , "JsonBool" -: bool ==> jsonValue
125− , "JsonNull" -: jsonValue
126− , "JsonArray" -: listOf jsonValue ==> jsonValue
127− , "JsonObject" -: jsonObject ==> jsonValue
128− , numScheme (\n -> n ==> jsonValue) "JsonNumber"
129− , "toString" -: jsonObject ==> string
130− , "fromString" -: string ==> maybeOf jsonObject
131− , "lookup" -: string ==> jsonObject ==> maybeOf jsonValue
132− , "findObject" -: string ==> jsonObject ==> jsonObject
133− , "findArray" -: string ==> jsonObject ==> listOf jsonValue
134− , "findString" -: string ==> jsonObject ==> string
135− , "findNumber" -: float ==> jsonObject ==> float
136− , "findWithDefault" -:: jsonValue ==> string ==> jsonObject ==> jsonValue
137− , "toPrettyString" -: string ==> jsonObject ==> string
138− , "toPrettyJSString" -: string ==> jsonObject ==> jsString
139− , "toList" -: jsonObject ==> listOf (tupleOf [string,jsonValue])
140− , "fromList" -: listOf (tupleOf [string,jsonValue]) ==> jsonObject
141− , "toJSString" -: jsonObject ==> jsString
142− , "fromJSString" -: jsString ==> jsonObject
143− ]
144−
145−
146−-------- Signals --------
147−
148−lyft n = sig (n+1) ("lift" ++ show n)
149−sig n name = (,) name $ Forall [1..n] [] (fn ts ==> fn (map signalOf ts))
150− where fn = foldr1 (==>)
151− ts = map VarT [1..n]
152−
153−signals = prefix "Signal"
154− [ sig 1 "constant"
155− , sig 2 "lift"
156− ] ++ map lyft [2..8] ++ [
157− "<~" -:: (a ==> b) ==> signalOf a ==> signalOf b
158− , "~" -:: signalOf (a ==> b) ==> signalOf a ==> signalOf b
159− , "foldp" -:: (a ==> b ==> b) ==> b ==> signalOf a ==> signalOf b
160− , "foldp1" -:: (a ==> a ==> a) ==> signalOf a ==> signalOf a
161− , "foldp'" -:: (a ==> b ==> b) ==> (a ==> b) ==> signalOf a ==> signalOf b
162− , "count" -:: signalOf a ==> signalOf int
163− , "countIf" -:: (a ==> bool) ==> signalOf a ==> signalOf int
164− , "keepIf" -:: (a ==> bool) ==> a ==> signalOf a ==> signalOf a
165− , "dropIf" -:: (a ==> bool) ==> a ==> signalOf a ==> signalOf a
166− , "keepWhen" -:: signalOf bool ==> a ==> signalOf a ==> signalOf a
167− , "dropWhen" -:: signalOf bool ==> a ==> signalOf a ==> signalOf a
168− , "dropRepeats" -:: signalOf a ==> signalOf a
169− , "sampleOn" -:: signalOf a ==> signalOf b ==> signalOf b
170− , "timestamp" -:: signalOf a ==> signalOf (tupleOf [time,a])
171− , "timeOf" -:: signalOf a ==> signalOf time
172− , "merge" -:: signalOf a ==> signalOf a ==> signalOf a
173− , "merges" -:: listOf (signalOf a) ==> signalOf a
174− , "mergeEither" -:: signalOf a ==> signalOf b ==> signalOf (eitherOf a b)
175− , numScheme (\n -> int ==> signalOf n ==> signalOf float) "average"
176− ]
177−
178−http = prefix "HTTP"
179− [ "send" -:: signalOf (request a) ==> signalOf (response string)
180− , "sendGet" -:: signalOf string ==> signalOf (response string)
181− , "get" -: string ==> request string
182− , "post" -: string ==> string ==> request string
183− , "request" -: string ==> string ==> string ==> listOf (pairOf string) ==> request string
184− , "Waiting" -:: response a
185− , "Failure" -:: int ==> string ==> response a
186− , "Success" -:: a ==> response a ]
187− where request t = ADT "Request" [t]
188− response t = ADT "Response" [t]
189−
190−concreteSignals =
191− [ "Random.inRange" -: int ==> int ==> signalOf int
192− , "Random.randomize" -:: int ==> int ==> signalOf a ==> signalOf int
193− , "Window.dimensions" -: signalOf point
194− , "Window.width" -: signalOf int
195− , "Window.height" -: signalOf int
196− , "Mouse.position" -: signalOf point
197− , "Mouse.x" -: signalOf int
198− , "Mouse.y" -: signalOf int
199− , "Mouse.isDown" -: signalOf bool
200− , "Mouse.isClicked" -: signalOf bool
201− , "Mouse.clicks" -: signalOf (tupleOf [])
202− , "Input.textField" -: string ==> tupleOf [element, signalOf string]
203− , "Input.password" -: string ==> tupleOf [element, signalOf string]
204− , "Input.textArea" -: int ==> int ==> tupleOf [element, signalOf string]
205− , "Input.checkBox" -: bool ==> tupleOf [element, signalOf bool]
206− , "Input.button" -: string ==> tupleOf [element, signalOf bool]
207− , "Input.stringDropDown" -: listOf string ==> tupleOf [element, signalOf string]
208− , "Input.dropDown" -:: listOf (tupleOf [string,a]) ==> tupleOf [element, signalOf a]
209− ]
210−
211−keyboards = prefix "Keyboard"
212− [ "Raw.keysDown" -: signalOf (listOf int)
213− , "Raw.charPressed" -: signalOf (maybeOf int)
214− , "arrows" -: signalOf (recordOf [("x",int),("y",int)])
215− , "wasd" -: signalOf (recordOf [("x",int),("y",int)])
216− , "ctrl" -: signalOf bool
217− , "space" -: signalOf bool
218− , "shift" -: signalOf bool
219− ]
220−
221−touches = prefix "Touch"
222− [ "touches" -: signalOf (listOf (recordOf [("x" ,int) ,("y" ,int)
223− ,("x0",int) ,("y0",int)
224− ,("t0",time),("id",int)]))
225− , "taps" -: signalOf (recordOf [("x",int),("y",int)])
226− ]
227−
228−times = prefix "Time"
229− [ numScheme (\n -> n ==> signalOf time) "fps"
230− , numScheme (\n -> n ==> signalOf bool ==> signalOf time) "fpsWhen"
231− , "every" -: time ==> signalOf time
232− , "delay" -:: time ==> signalOf a ==> signalOf a
233− , "since" -:: time ==> signalOf a ==> signalOf bool
234− , "hour" -: time
235− , "minute" -: time
236− , "second" -: time
237− , "ms" -: time
238− , "inHours" -: time ==> float
239− , "inMinutes" -: time ==> float
240− , "inSeconds" -: time ==> float
241− , "inMss" -: time ==> float
242− , "toDate" -: time ==> date
243− , "read" -: string ==> maybeOf time
244− ]
245−
246−dates =
247− let days = map (-: day) ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
248− months = map (-: month) [ "Jan", "Feb", "Mar", "Apr", "May", "Jun"
249− , "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ]
250− in prefix "Date"
251− ([ "read" -: string ==> maybeOf date
252− , "year" -: date ==> int
253− , "month" -: date ==> month
254− , "day" -: date ==> int
255− , "hour" -: date ==> int
256− , "minute" -: date ==> int
257− , "second" -: date ==> int
258− , "dayOfWeek" -: date ==> day
259− , "toTime" -: date ==> time
260− ] ++ days ++ months)
261−
262−-------- Math and Binops --------
263−
264−binop t = t ==> t ==> t
265−scheme1 super t name =
266− (name, Forall [0] [ ctx name $ VarT 0 :<: super
267− ] (t (VarT 0)))
268−scheme2 s1 s2 t name =
269− (name, Forall [0,1] [ ctx name $ VarT 0 :<: s1
270− , ctx name $ VarT 1 :<: s2
271− ] (t (VarT 0) (VarT 1)))
272−numScheme t name = scheme1 number t name
273−twoNums f name = scheme2 number number f name
274−
275−math =
276− map (numScheme (\t -> t ==> binop t)) ["clamp"] ++
277− map (numScheme (\t -> binop t)) ["+","-","*","max","min"] ++
278− [ numScheme (\t -> t ==> t) "abs" ] ++
279− hasType (binop float) [ "/", "logBase" ] ++
280− hasType (binop int) ["rem","div","mod"] ++
281− hasType (float ==> float) ["sin","cos","tan","asin","acos","atan","sqrt"] ++
282− hasType float ["pi","e"] ++
283− hasType (int ==> float) ["toFloat","castIntToFloat"] ++
284− hasType (float ==> int) ["round","floor","ceiling","truncate"] ++
285− [ "show" -:: a ==> string
286− , "readInt" -: string ==> maybeOf int
287− , "readFloat" -: string ==> maybeOf float ]
288−
289−bools =
290− [ "not" -: bool ==> bool ] ++
291− hasType (binop bool) ["&&","||","xor"] ++
292− map (scheme1 comparable (\t -> t ==> t ==> bool)) ["<",">","<=",">="] ++
293− [ ( "compare"
294− , Forall [0,1] [ ctx "compare" $ VarT 0 :<: comparable ] (VarT 0 ==> VarT 0 ==> VarT 1) )
295− ]
296−
297−chars = prefix "Char" (classify ++ convert1 ++ convert2)
298− where classify = hasType (char ==> bool)
299− ["isDigit","isOctDigit","isHexDigit","isUpper","isLower"]
300− convert1 = hasType (char ==> char)
301− ["toUpper","toLower","toLocaleUpper","toLocaleLower"]
302− convert2 = [ "toCode" -: char ==> int, "fromCode" -: int ==> char ]
303−
304−
305−-------- Polymorphic Functions --------
306−
307−[a,b,c] = map VarT [1,2,3]
308−
309−infix 8 -::
310−name -:: tipe = (name, Forall [1,2,3] [] tipe)
311−
312−funcs =
313− [ "id" -:: a ==> a
314− , "==" -:: a ==> a ==> bool
315− , "/=" -:: a ==> a ==> bool
316− , "flip" -:: (a ==> b ==> c) ==> (b ==> a ==> c)
317− , "." -:: (b ==> c) ==> (a ==> b) ==> (a ==> c)
318− , "$" -:: (a ==> b) ==> a ==> b
319− , ":" -:: a ==> listOf a ==> listOf a
320− , (,) "++" . Forall [0,1] [ ctx "++" $ VarT 0 :<: appendable (VarT 1) ] $ VarT 0 ==> VarT 0 ==> VarT 0
321− , "Cons" -:: a ==> listOf a ==> listOf a
322− , "Nil" -:: listOf a
323− , "Just" -:: a ==> maybeOf a
324− , "Nothing" -:: maybeOf a
325− , "Left" -:: a ==> eitherOf a b
326− , "Right" -:: b ==> eitherOf a b
327− , "curry" -:: (tupleOf [a,b] ==> c) ==> a ==> b ==> c
328− , "uncurry" -:: (a ==> b ==> c) ==> tupleOf [a,b] ==> c
329− ] ++ map tuple [0..8]
330−
331−tuple n = ("Tuple" ++ show n, Forall [1..n] [] $ foldr (==>) (tupleOf vs) vs)
332− where vs = map VarT [1..n]
333−
334−lists = prefix "List"
335− [ "and" -:: listOf bool ==> bool
336− , "or" -:: listOf bool ==> bool
337− , numScheme (\n -> listOf n ==> listOf n) "sort"
338− , "head" -:: listOf a ==> a
339− , "tail" -:: listOf a ==> listOf a
340− , "length" -:: listOf a ==> int
341− , "filter" -:: (a ==> bool) ==> listOf a ==> listOf a
342− , "foldr1" -:: (a ==> a ==> a) ==> listOf a ==> a
343− , "foldl1" -:: (a ==> a ==> a) ==> listOf a ==> a
344− , "scanl1" -:: (a ==> a ==> a) ==> listOf a ==> a
345− , "all" -:: (a ==> bool) ==> listOf a ==> bool
346− , "any" -:: (a ==> bool) ==> listOf a ==> bool
347− , "reverse" -:: listOf a ==> listOf a
348− , "take" -:: int ==> listOf a ==> listOf a
349− , "drop" -:: int ==> listOf a ==> listOf a
350− , "partition" -:: (a ==> bool) ==> listOf a ==> tupleOf [listOf a,listOf a]
351− , "intersperse" -:: a ==> listOf a ==> listOf a
352− , "zip" -:: listOf a ==>listOf b ==>listOf(tupleOf [a,b])
353− , "map" -:: (a ==> b) ==> listOf a ==> listOf b
354− , "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
355− , "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
356− , "scanl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> listOf b
357− , (,) "concat" . Forall [0,1] [ ctx "concat" $ VarT 0 :<: appendable (VarT 1) ] $
358− listOf (VarT 0) ==> VarT 0
359− , (,) "concatMap" . Forall [0,1,2] [ ctx "concatMap" $ VarT 0 :<: appendable (VarT 1) ] $
360− (VarT 2 ==> VarT 0) ==> listOf (VarT 2) ==> VarT 0
361− , (,) "intercalate" . Forall [0,1] [ ctx "intercalate" $ VarT 0 :<: appendable (VarT 1) ] $
362− VarT 0 ==> listOf (VarT 0) ==> VarT 0
363− , "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c
364− ] ++ map (numScheme (\n -> listOf n ==> n)) [ "sum", "product"
365− , "maximum", "minimum" ]
366−
367−maybeFuncs = prefix "Maybe"
368− [ "maybe" -:: b ==> (a ==> b) ==> maybeOf a ==> b
369− , "isJust" -:: maybeOf a ==> bool
370− , "isNothing" -:: maybeOf a ==> bool
371− , "cons" -:: maybeOf a ==> listOf a ==> listOf a
372− , "justs" -:: listOf (maybeOf a) ==> listOf a
373− ]
374−
375−eithers = prefix "Either"
376− [ "isLeft" -:: eitherOf a b ==> bool
377− , "isRight" -:: eitherOf a b ==> bool
378− , "either" -:: (a ==> c) ==> (b ==> c) ==> eitherOf a b ==> c
379− , "lefts" -:: listOf (eitherOf a b) ==> listOf a
380− , "rights" -:: listOf (eitherOf a b) ==> listOf b
381− , "partition" -:: listOf (eitherOf a b) ==> tupleOf [listOf a,listOf b]
382− ]
383−
384−dictionary =
385− let dict k v = ADT "Dict" [k,v] in
386− prefix "Dict"
387− [ "empty" -:: dict a b
388− , "singleton" -:: a ==> b ==> dict a b
389− , "insert" -:: a ==> b ==> dict a b ==> dict a b
390− , "remove" -:: a ==> dict a b ==> dict a b
391− , "member" -:: a ==> dict a b ==> bool
392− , "lookup" -:: a ==> dict a b ==> maybeOf b
393− , "findWithDefault" -:: b ==> a ==> dict a b ==> b
394− , "intersect" -:: dict a b ==> dict a c ==> dict a b
395− , "union" -:: dict a b ==> dict a b ==> dict a b
396− , "diff" -:: dict a b ==> dict a c ==> dict a b
397− , "map" -:: (b ==> c) ==> dict a b ==> dict a c
398− , "foldl" -:: (a ==> b ==> c ==> c) ==> c ==> dict a b ==> c
399− , "foldr" -:: (a ==> b ==> c ==> c) ==> c ==> dict a b ==> c
400− , "keys" -:: dict a b ==> listOf a
401− , "values" -:: dict a b ==> listOf b
402− , "toList" -:: dict a b ==> listOf (tupleOf [a,b])
403− , "fromList" -:: listOf (tupleOf [a,b]) ==> dict a b
404− ]
405−
406−sets =
407− let set v = ADT "Set" [v] in
408− prefix "Set"
409− [ "empty" -:: set a
410− , "singleton" -:: a ==> set a
411− , "insert" -:: a ==> set a ==> set a
412− , "remove" -:: a ==> set a ==> set a
413− , "member" -:: a ==> set a ==> bool
414− , "intersect" -:: set a ==> set a ==> set a
415− , "union" -:: set a ==> set a ==> set a
416− , "diff" -:: set a ==> set a ==> set a
417− , "map" -:: (a ==> b) ==> set a ==> set b
418− , "foldl" -:: (a ==> b ==> b) ==> b ==> set a ==> b
419− , "foldr" -:: (a ==> b ==> b) ==> b ==> set a ==> b
420− , "toList" -:: set a ==> listOf a
421− , "fromList" -:: listOf a ==> set a
422− ]
423−
424−automaton =
425− let auto a b = ADT "Automaton" [a,b] in
426− prefix "Automaton"
427− [ "pure" -:: (a ==> b) ==> auto a b
428− , "init" -:: b ==> (a ==> b ==> b) ==> auto a b
429− , "init'" -:: c ==> (a ==> c ==> tupleOf [b,c]) ==> auto a b
430− , ">>>" -:: auto a b ==> auto b c ==> auto a c
431− , "<<<" -:: auto b c ==> auto a b ==> auto a c
432− , "combine" -:: listOf (auto a b) ==> auto a (listOf b)
433− , "run" -:: auto a b ==> signalOf a ==> signalOf b
434− , "step" -:: auto a b ==> a ==> tupleOf [b,auto a b]
435− , "count" -:: auto a int
436− , "draggable" -:: form ==> auto (tupleOf [bool,point]) form
437− ]
438−
439−-------- Everything --------
440−
441−hints = mapM (\(n,s) -> (,) n `liftM` rescheme s) (concat hs)
442− where hs = [ funcs, lists, signals, math, bools, textAttrs
443− , graphicsElement, graphicsColor, eithers, keyboards, touches
444− , concreteSignals, javascript, json, maybeFuncs
445− , http, dictionary, sets, automaton, times, dates
446− ]
12+hints :: GuidCounter [(String, Scheme)]
13+hints = mapM toScheme values
14+ where
15+ addPrefixes = concatMap (\(m,vs) -> map (first (\n -> m ++ "." ++ n)) vs)
16+ values = addPrefixes (Map.toList (Map.map Map.toList libraries))
17+ toScheme (name, tipeString) =
18+ case iParse (fmap toType typeExpr) "libraries" tipeString of
19+ Left err -> error (show err)
20+ Right tipe -> do scheme <- generalize [] (Forall [] [] tipe)
21+ return (name, scheme)
libraries/Char.elmnew file+38
@@ -0,0 +1,38 @@
1+
2+module Char where
3+
4+import Native.Char as N
5+
6+-- Selects upper case letters.
7+isUpper : Char -> Bool
8+
9+-- Selects lower case letters.
10+isLower : Char -> Bool
11+
12+-- Selects ASCII digits (0..9).
13+isDigit : Char -> Bool
14+
15+-- Selects ASCII octal digits (0..7).
16+isOctDigit : Char -> Bool
17+
18+-- Selects ASCII hexadecimal digits (0..9a..fA..F).
19+isHexDigit : Char -> Bool
20+
21+-- Convert to upper case.
22+toUpper : Char -> Char
23+
24+-- Convert to lower case.
25+toLower : Char -> Char
26+
27+-- Convert to upper case, according to any locale-specific case mappings.
28+toLocaleUpper : Char -> Char
29+
30+-- Convert to lower case, according to any locale-specific case mappings.
31+toLocaleLower : Char -> Char
32+
33+-- Convert to unicode.
34+toCode : Char -> Int
35+
36+-- Convert from unicode.
37+fromCode : Int -> Char
38+
libraries/Dict.elm+119−116
@@ -10,13 +10,14 @@ module Dict (empty,singleton,insert
1010
1111import Maybe as Maybe
1212import Native.Error as Error
13+import List as List
1314
1415data NColor = Red | Black
1516
16−data RBTree k v = RBNode NColor k v (RBTree k v) (RBTree k v) | RBEmpty
17+data Dict k v = Node NColor k v (Dict k v) (Dict k v) | Empty
1718
18−empty : RBTree k v
19−empty = RBEmpty
19+empty : Dict k v
20+empty = Empty
2021
2122{-- Helpers for checking invariants
2223
@@ -24,8 +25,8 @@ empty = RBEmpty
2425equal_pathLen t =
2526 let path_numBlacks t =
2627 case t of
27− { RBEmpty -> 1
28− ; RBNode col _ _ l r ->
28+ { Empty -> 1
29+ ; Node col _ _ l r ->
2930 let { bl = path_numBlacks l ; br = path_numBlacks r } in
3031 if bl /= br || bl == 0-1 || br == 0-1
3132 then 0-1
@@ -35,22 +36,22 @@ equal_pathLen t =
3536
3637rootBlack t =
3738 case t of
38− { RBEmpty -> True
39− ; RBNode Black _ _ _ _ -> True
39+ { Empty -> True
40+ ; Node Black _ _ _ _ -> True
4041 ; _ -> False }
4142
4243redBlack_children t =
4344 case t of
44− { RBNode Red _ _ (RBNode Red _ _ _ _) _ -> False
45− ; RBNode Red _ _ _ (RBNode Red _ _ _ _) -> False
46− ; RBEmpty -> True
47− ; RBNode _ _ _ l r -> redBlack_children l && redBlack_children r
45+ { Node Red _ _ (Node Red _ _ _ _) _ -> False
46+ ; Node Red _ _ _ (Node Red _ _ _ _) -> False
47+ ; Empty -> True
48+ ; Node _ _ _ l r -> redBlack_children l && redBlack_children r
4849 }
4950
5051findExtreme f t =
5152 case t of
52− { RBEmpty -> Nothing
53− ; RBNode c k _ l r ->
53+ { Empty -> Nothing
54+ ; Node c k _ l r ->
5455 case findExtreme f (f (l,r)) of
5556 { Nothing -> Just k
5657 ; Just k' -> Just k' }
@@ -74,8 +75,8 @@ olte xo yo = optionRelation (<=) True xo yo
7475
7576ordered t =
7677 case t of
77− { RBEmpty -> True
78− ; RBNode c k v l r ->
78+ { Empty -> True
79+ ; Node c k v l r ->
7980 let (lmax,rmin) = (findmaxRbt l, findminRbt r) in
8081 olte lmax (Just k) && olte (Just k) rmin && ordered l && ordered r
8182 }
@@ -83,10 +84,10 @@ ordered t =
8384-- Check that there aren't any right red nodes in the tree *)
8485leftLeaning t =
8586 case t of
86− { RBEmpty -> True
87− ; RBNode _ _ _ (RBNode Black _ _ _ _) (RBNode Red _ _ _ _) -> False
88− ; RBNode _ _ _ RBEmpty (RBNode Red _ _ _ _) -> False
89− ; RBNode _ _ _ l r -> (leftLeaning l) && (leftLeaning r)
87+ { Empty -> True
88+ ; Node _ _ _ (Node Black _ _ _ _) (Node Red _ _ _ _) -> False
89+ ; Node _ _ _ Empty (Node Red _ _ _ _) -> False
90+ ; Node _ _ _ l r -> (leftLeaning l) && (leftLeaning r)
9091 }
9192
9293invariants_hold t =
@@ -97,37 +98,37 @@ invariants_hold t =
9798--}
9899
99100
100−min : RBTree k v -> (k,v)
101+min : Dict k v -> (k,v)
101102min t =
102103 case t of
103− RBNode _ k v RBEmpty _ -> (k,v)
104− RBNode _ _ _ l _ -> min l
105− RBEmpty -> Error.raise "(min RBEmpty) is not defined"
104+ Node _ k v Empty _ -> (k,v)
105+ Node _ _ _ l _ -> min l
106+ Empty -> Error.raise "(min Empty) is not defined"
106107
107108{--
108109max t =
109110 case t of
110− { RBNode _ k v _ RBEmpty -> (k,v)
111− ; RBNode _ _ _ _ r -> max r
112− ; RBEmpty -> Error.raise "(max RBEmpty) is not defined"
111+ { Node _ k v _ Empty -> (k,v)
112+ ; Node _ _ _ _ r -> max r
113+ ; Empty -> Error.raise "(max Empty) is not defined"
113114 }
114115--}
115116
116−lookup : k -> RBTree k v -> Maybe v
117+lookup : k -> Dict k v -> Maybe v
117118lookup k t =
118119 case t of
119− RBEmpty -> Nothing
120− RBNode _ k' v l r ->
120+ Empty -> Nothing
121+ Node _ k' v l r ->
121122 case compare k k' of
122123 LT -> lookup k l
123124 EQ -> Just v
124125 GT -> lookup k r
125126
126−findWithDefault : v -> k -> RBTree k v -> v
127+findWithDefault : v -> k -> Dict k v -> v
127128findWithDefault base k t =
128129 case t of
129− RBEmpty -> base
130− RBNode _ k' v l r ->
130+ Empty -> base
131+ Node _ k' v l r ->
131132 case compare k k' of
132133 LT -> findWithDefault base k l
133134 EQ -> v
@@ -136,8 +137,8 @@ findWithDefault base k t =
136137{--
137138find k t =
138139 case t of
139− { RBEmpty -> Error.raise "Key was not found in dictionary!"
140− ; RBNode _ k' v l r ->
140+ { Empty -> Error.raise "Key was not found in dictionary!"
141+ ; Node _ k' v l r ->
141142 case compare k k' of
142143 { LT -> find k l
143144 ; EQ -> v
@@ -146,71 +147,71 @@ find k t =
146147--}
147148
148149-- Does t contain k?
149−member : k -> RBTree k v -> Bool
150+member : k -> Dict k v -> Bool
150151member k t = Maybe.isJust $ lookup k t
151152
152−rotateLeft : RBTree k v -> RBTree k v
153+rotateLeft : Dict k v -> Dict k v
153154rotateLeft t =
154155 case t of
155− RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c
156+ Node cy ky vy a (Node cz kz vz b c) -> Node cy kz vz (Node Red ky vy a b) c
156157 _ -> Error.raise "rotateLeft of a node without enough children"
157158
158159-- rotateRight -- the reverse, and
159160-- makes Y have Z's color, and makes Z Red.
160−rotateRight : RBTree k v -> RBTree k v
161+rotateRight : Dict k v -> Dict k v
161162rotateRight t =
162163 case t of
163− RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)
164+ Node cz kz vz (Node cy ky vy a b) c -> Node cz ky vy a (Node Red kz vz b c)
164165 _ -> Error.raise "rotateRight of a node without enough children"
165166
166−rotateLeftIfNeeded : RBTree k v -> RBTree k v
167+rotateLeftIfNeeded : Dict k v -> Dict k v
167168rotateLeftIfNeeded t =
168169 case t of
169− RBNode _ _ _ _ (RBNode Red _ _ _ _) -> rotateLeft t
170+ Node _ _ _ _ (Node Red _ _ _ _) -> rotateLeft t
170171 _ -> t
171172
172−rotateRightIfNeeded : RBTree k v -> RBTree k v
173+rotateRightIfNeeded : Dict k v -> Dict k v
173174rotateRightIfNeeded t =
174175 case t of
175− RBNode _ _ _ (RBNode Red _ _ (RBNode Red _ _ _ _) _) _ -> rotateRight t
176+ Node _ _ _ (Node Red _ _ (Node Red _ _ _ _) _) _ -> rotateRight t
176177 _ -> t
177178
178179otherColor c = case c of { Red -> Black ; Black -> Red }
179180
180−color_flip : RBTree k v -> RBTree k v
181+color_flip : Dict k v -> Dict k v
181182color_flip t =
182183 case t of
183− RBNode c1 bk bv (RBNode c2 ak av la ra) (RBNode c3 ck cv lc rc) ->
184− RBNode (otherColor c1) bk bv
185− (RBNode (otherColor c2) ak av la ra)
186− (RBNode (otherColor c3) ck cv lc rc)
187− _ -> Error.raise "color_flip called on a RBEmpty or RBNode with a RBEmpty child"
184+ Node c1 bk bv (Node c2 ak av la ra) (Node c3 ck cv lc rc) ->
185+ Node (otherColor c1) bk bv
186+ (Node (otherColor c2) ak av la ra)
187+ (Node (otherColor c3) ck cv lc rc)
188+ _ -> Error.raise "color_flip called on a Empty or Node with a Empty child"
188189
189−color_flipIfNeeded : RBTree k v -> RBTree k v
190+color_flipIfNeeded : Dict k v -> Dict k v
190191color_flipIfNeeded t =
191192 case t of
192− RBNode _ _ _ (RBNode Red _ _ _ _) (RBNode Red _ _ _ _) -> color_flip t
193+ Node _ _ _ (Node Red _ _ _ _) (Node Red _ _ _ _) -> color_flip t
193194 _ -> t
194195
195196fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))
196197
197−ensureBlackRoot : RBTree k v -> RBTree k v
198+ensureBlackRoot : Dict k v -> Dict k v
198199ensureBlackRoot t =
199200 case t of
200− RBNode Red k v l r -> RBNode Black k v l r
201+ Node Red k v l r -> Node Black k v l r
201202 _ -> t
202203
203204-- Invariant: t is a valid left-leaning rb tree *)
204−insert : k -> v -> RBTree k v -> RBTree k v
205+insert : k -> v -> Dict k v -> Dict k v
205206insert k v t =
206207 let ins t =
207208 case t of
208− RBEmpty -> RBNode Red k v RBEmpty RBEmpty
209− RBNode c k' v' l r ->
209+ Empty -> Node Red k v Empty Empty
210+ Node c k' v' l r ->
210211 let h = case compare k k' of
211− LT -> RBNode c k' v' (ins l) r
212− EQ -> RBNode c k' v l r -- replace
213− GT -> RBNode c k' v' l (ins r)
212+ LT -> Node c k' v' (ins l) r
213+ EQ -> Node c k' v l r -- replace
214+ GT -> Node c k' v' l (ins r)
214215 in fixUp h
215216 in ensureBlackRoot (ins t)
216217{--
@@ -222,71 +223,71 @@ insert k v t =
222223 else new_t)
223224--}
224225
225−singleton : k -> v -> RBTree k v
226−singleton k v = insert k v RBEmpty
226+singleton : k -> v -> Dict k v
227+singleton k v = insert k v Empty
227228
228−isRed : RBTree k v -> Bool
229+isRed : Dict k v -> Bool
229230isRed t =
230231 case t of
231− RBNode Red _ _ _ _ -> True
232+ Node Red _ _ _ _ -> True
232233 _ -> False
233234
234−isRedLeft : RBTree k v -> Bool
235+isRedLeft : Dict k v -> Bool
235236isRedLeft t =
236237 case t of
237− RBNode _ _ _ (RBNode Red _ _ _ _) _ -> True
238+ Node _ _ _ (Node Red _ _ _ _) _ -> True
238239 _ -> False
239240
240−isRedLeftLeft : RBTree k v -> Bool
241+isRedLeftLeft : Dict k v -> Bool
241242isRedLeftLeft t =
242243 case t of
243− RBNode _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) _ -> True
244+ Node _ _ _ (Node _ _ _ (Node Red _ _ _ _) _) _ -> True
244245 _ -> False
245246
246−isRedRight : RBTree k v -> Bool
247+isRedRight : Dict k v -> Bool
247248isRedRight t =
248249 case t of
249− RBNode _ _ _ _ (RBNode Red _ _ _ _) -> True
250+ Node _ _ _ _ (Node Red _ _ _ _) -> True
250251 _ -> False
251252
252−isRedRightLeft : RBTree k v -> Bool
253+isRedRightLeft : Dict k v -> Bool
253254isRedRightLeft t =
254255 case t of
255− RBNode _ _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) -> True
256+ Node _ _ _ _ (Node _ _ _ (Node Red _ _ _ _) _) -> True
256257 _ -> False
257258
258−moveRedLeft : RBTree k v -> RBTree k v
259+moveRedLeft : Dict k v -> Dict k v
259260moveRedLeft t =
260261 let t' = color_flip t in
261262 case t' of
262− RBNode c k v l r ->
263+ Node c k v l r ->
263264 case r of
264− RBNode _ _ _ (RBNode Red _ _ _ _) _ ->
265− color_flip (rotateLeft (RBNode c k v l (rotateRight r)))
265+ Node _ _ _ (Node Red _ _ _ _) _ ->
266+ color_flip (rotateLeft (Node c k v l (rotateRight r)))
266267 _ -> t'
267268 _ -> t'
268269
269−moveRedRight : RBTree k v -> RBTree k v
270+moveRedRight : Dict k v -> Dict k v
270271moveRedRight t =
271272 let t' = color_flip t in
272273 if isRedLeftLeft t' then color_flip (rotateRight t') else t'
273274
274−moveRedLeftIfNeeded : RBTree k v -> RBTree k v
275+moveRedLeftIfNeeded : Dict k v -> Dict k v
275276moveRedLeftIfNeeded t =
276277 if not (isRedLeft t) && not (isRedLeftLeft t) then moveRedLeft t else t
277278
278−moveRedRightIfNeeded : RBTree k v -> RBTree k v
279+moveRedRightIfNeeded : Dict k v -> Dict k v
279280moveRedRightIfNeeded t =
280281 if not (isRedRight t) && not (isRedRightLeft t) then moveRedRight t else t
281282
282−deleteMin : RBTree k v -> RBTree k v
283+deleteMin : Dict k v -> Dict k v
283284deleteMin t =
284285 let del t =
285286 case t of
286− RBNode _ _ _ RBEmpty _ -> RBEmpty
287+ Node _ _ _ Empty _ -> Empty
287288 _ -> case moveRedLeftIfNeeded t of
288− RBNode c k v l r -> fixUp (RBNode c k v (del l) r)
289− RBEmpty -> RBEmpty
289+ Node c k v l r -> fixUp (Node c k v (del l) r)
290+ Empty -> Empty
290291 in ensureBlackRoot (del t)
291292
292293{--
@@ -294,35 +295,35 @@ deleteMax t =
294295 let del t =
295296 let t' = if isRedLeft t then rotateRight t else t in
296297 case t' of
297− { RBNode _ _ _ _ RBEmpty -> RBEmpty
298+ { Node _ _ _ _ Empty -> Empty
298299 ; _ -> let t'' = moveRedRightIfNeeded t' in
299300 case t'' of
300− { RBNode c k v l r -> fixUp (RBNode c k v l (del r))
301− ; RBEmpty -> RBEmpty } }
301+ { Node c k v l r -> fixUp (Node c k v l (del r))
302+ ; Empty -> Empty } }
302303 in ensureBlackRoot (del t)
303304--}
304305
305−remove : k -> RBTree k v -> RBTree k v
306+remove : k -> Dict k v -> Dict k v
306307remove k t =
307308 let eq_and_noRightNode t =
308− case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False }
309− eq t = case t of { RBNode _ k' _ _ _ -> k == k' ; _ -> False }
309+ case t of { Node _ k' _ _ Empty -> k == k' ; _ -> False }
310+ eq t = case t of { Node _ k' _ _ _ -> k == k' ; _ -> False }
310311 delLT t = case moveRedLeftIfNeeded t of
311− RBNode c k' v l r -> fixUp (RBNode c k' v (del l) r)
312− RBEmpty -> Error.raise "delLT on RBEmpty"
312+ Node c k' v l r -> fixUp (Node c k' v (del l) r)
313+ Empty -> Error.raise "delLT on Empty"
313314 delEQ t = case t of -- Replace with successor
314− RBNode c _ _ l r -> let (k',v') = min r in
315− fixUp (RBNode c k' v' l (deleteMin r))
316− RBEmpty -> Error.raise "delEQ called on a RBEmpty"
315+ Node c _ _ l r -> let (k',v') = min r in
316+ fixUp (Node c k' v' l (deleteMin r))
317+ Empty -> Error.raise "delEQ called on a Empty"
317318 delGT t = case t of
318− RBNode c k' v l r -> fixUp (RBNode c k' v l (del r))
319− RBEmpty -> Error.raise "delGT called on a RBEmpty"
319+ Node c k' v l r -> fixUp (Node c k' v l (del r))
320+ Empty -> Error.raise "delGT called on a Empty"
320321 del t = case t of
321− RBEmpty -> RBEmpty
322− RBNode _ k' _ _ _ ->
322+ Empty -> Empty
323+ Node _ k' _ _ _ ->
323324 if k < k' then delLT t else
324325 let u = if isRedLeft t then rotateRight t else t in
325− if eq_and_noRightNode u then RBEmpty else
326+ if eq_and_noRightNode u then Empty else
326327 let t' = moveRedRightIfNeeded t in
327328 if eq t' then delEQ t' else delGT t'
328329 in if member k t then ensureBlackRoot (del t) else t
@@ -334,41 +335,43 @@ remove k t =
334335 Error.raise "invariants broken after remove")
335336--}
336337
337−map : (a -> b) -> RBTree k a -> RBTree k b
338+map : (a -> b) -> Dict k a -> Dict k b
338339map f t =
339340 case t of
340− RBEmpty -> RBEmpty
341− RBNode c k v l r -> RBNode c k (f v) (map f l) (map f r)
341+ Empty -> Empty
342+ Node c k v l r -> Node c k (f v) (map f l) (map f r)
342343
343−foldl : (k -> v -> b -> b) -> b -> RBTree k v -> b
344+foldl : (k -> v -> b -> b) -> b -> Dict k v -> b
344345foldl f acc t =
345346 case t of
346− RBEmpty -> acc
347− RBNode _ k v l r -> foldl f (f k v (foldl f acc l)) r
347+ Empty -> acc
348+ Node _ k v l r -> foldl f (f k v (foldl f acc l)) r
348349
349−foldr : (k -> v -> b -> b) -> b -> RBTree k v -> b
350+foldr : (k -> v -> b -> b) -> b -> Dict k v -> b
350351foldr f acc t =
351352 case t of
352− RBEmpty -> acc
353− RBNode _ k v l r -> foldr f (f k v (foldr f acc r)) l
353+ Empty -> acc
354+ Node _ k v l r -> foldr f (f k v (foldr f acc r)) l
354355
355−union : RBTree k v -> RBTree k v -> RBTree k v
356+union : Dict k v -> Dict k v -> Dict k v
356357union t1 t2 = foldl insert t2 t1
357358
358−intersect : RBTree k v -> RBTree k v -> RBTree k v
359−intersect t1 t2 = foldl (\k v t -> if k `member` t2 then insert k v t else t) empty t1
359+intersect : Dict k v -> Dict k v -> Dict k v
360+intersect t1 t2 =
361+ let combine k v t = if k `member` t2 then insert k v t else t
362+ in foldl combine empty t1
360363
361−diff : RBTree k v -> RBTree k v -> RBTree k v
364+diff : Dict k v -> Dict k v -> Dict k v
362365diff t1 t2 = foldl (\k v t -> remove k t) t1 t2
363366
364−keys : RBTree k v -> [k]
367+keys : Dict k v -> [k]
365368keys t = foldr (\k v acc -> k :: acc) [] t
366369
367−values : RBTree k v -> [v]
370+values : Dict k v -> [v]
368371values t = foldr (\k v acc -> v :: acc) [] t
369372
370−toList : RBTree k v -> [(k,v)]
373+toList : Dict k v -> [(k,v)]
371374toList t = foldr (\k v acc -> (k,v) :: acc) [] t
372375
373−fromList : [(k,v)] -> RBTree k v
374−fromList assocs = Elm.List.foldl (uncurry insert) empty assocs
376+fromList : [(k,v)] -> Dict k v
377+fromList assocs = List.foldl (uncurry insert) empty assocs
libraries/Json.elm+1−1
@@ -1,7 +1,7 @@
11
22module Json where
33
4−import Dict
4+import Dict as Dict
55import JavaScript as JS
66import Native.Json as Native
77
libraries/Native/Char.jsnew file+31
@@ -0,0 +1,31 @@
1+
2+Elm.Native.Char = function(elm) {
3+ 'use strict';
4+
5+ elm.Native = elm.Native || {};
6+ if (elm.Native.Char) return elm.Native.Char;
7+
8+ function isBetween(lo,hi) { return function(chr) {
9+ var c = chr.charCodeAt(0);
10+ return lo <= c && c <= hi;
11+ };
12+ }
13+ var isDigit = isBetween('0'.charCodeAt(0),'9'.charCodeAt(0));
14+ var chk1 = isBetween('a'.charCodeAt(0),'f'.charCodeAt(0));
15+ var chk2 = isBetween('A'.charCodeAt(0),'F'.charCodeAt(0));
16+
17+ return elm.Native.Char = {
18+ fromCode : function(c) { return String.fromCharCode(c); },
19+ toCode : function(c) { return c.charCodeAt(0); },
20+ toUpper : function(c) { return c.toUpperCase(); },
21+ toLower : function(c) { return c.toLowerCase(); },
22+ toLocaleUpper : function(c) { return c.toLocaleUpperCase(); },
23+ toLocaleLower : function(c) { return c.toLocaleLowerCase(); },
24+ isLower : isBetween('a'.charCodeAt(0),'z'.charCodeAt(0)),
25+ isUpper : isBetween('A'.charCodeAt(0),'Z'.charCodeAt(0)),
26+ isDigit : isDigit,
27+ isOctDigit : isBetween('0'.charCodeAt(0),'7'.charCodeAt(0)),
28+ isHexDigit : function(c) { return isDigit(c) || chk1(c) || chk2(c); }
29+ };
30+
31+};
libraries/Native/Prelude.js+7−6
@@ -1,11 +1,12 @@
11
2−Elm.Prelude = function(elm) {
2+Elm.Native.Prelude = function(elm) {
33 'use strict';
4− if (elm.Prelude) return elm.Prelude;
4+ if (elm.Native.Prelude) return elm.Native.Prelude;
55
66 var JS = Elm.JavaScript(elm);
77 var Maybe = Elm.Maybe(elm);
88 var Utils = Elm.Native.Utils(elm);
9+ var Char = Elm.Char(elm);
910
1011 function div(a,b) { return (a/b)|0 }
1112 function rem(a,b) { return a % b }
@@ -41,7 +42,7 @@ Elm.Prelude = function(elm) {
4142 start = 1;
4243 }
4344 for (var i = start; i < len; ++i) {
44− if (!Elm.Char.isDigit(s[i])) { return Maybe.Nothing }
45+ if (!Char.isDigit(s[i])) { return Maybe.Nothing }
4546 }
4647 return Maybe.Just(parseInt(s));
4748 }
@@ -57,7 +58,7 @@ Elm.Prelude = function(elm) {
5758 }
5859 var dotCount = 0;
5960 for (var i = start; i < len; ++i) {
60− if (Elm.Char.isDigit(s[i])) { continue; }
61+ if (Char.isDigit(s[i])) { continue; }
6162 if (s[i] === '.') {
6263 dotCount += 1;
6364 if (dotCount <= 1) { continue; }
@@ -119,7 +120,7 @@ Elm.Prelude = function(elm) {
119120 add(Elm.List);
120121 add(Elm.Maybe);
121122 add(Elm.Time);
122− add(Elm.Graphics);
123+ add(Elm.Graphics.Element);
123124
124− return elm.Prelude = prelude;
125+ return elm.Native.Prelude = prelude;
125126};
libraries/Prelude.elm+2
@@ -1,6 +1,8 @@
11
22module Prelude where
33
4+import Native.Prelude as N
5+
46radians : Float -> Float
57radians t = t
68
libraries/Set.elm+2−2
@@ -6,8 +6,8 @@ module Set (empty,singleton,insert,remove
66 ,toList,fromList
77 ) where
88
9−import Dict
10−import List
9+import Dict as Dict
10+import List as List
1111
1212type Set t = Dict t ()
1313