diff --git a/gren.json b/gren.json index 8186ccd9..65eb8d85 100644 --- a/gren.json +++ b/gren.json @@ -8,6 +8,7 @@ "exposed-modules": { "Primitives": [ "Basics", + "Float", "String", "Char", "Bitwise", diff --git a/src/Comparable.gren b/src/Comparable.gren new file mode 100644 index 00000000..17353e8c --- /dev/null +++ b/src/Comparable.gren @@ -0,0 +1,7 @@ +signature module Comparable + +import Basics exposing (Order) + +type alias T + +compare : T -> T -> Order diff --git a/src/Dict.gren b/src/Dict.gren index 7ac0add4..493f94d5 100644 --- a/src/Dict.gren +++ b/src/Dict.gren @@ -1,10 +1,10 @@ -module Dict exposing +module Dict(Key : Comparable) exposing ( Dict , empty, singleton, insert, update, remove , isEmpty, member, get, size , keys, values, toArray, fromArray , map, foldl, foldr, filter, partition - , union, intersect, diff, merge + , union, intersect, diff ) {-| A dictionary mapping unique keys to values. The keys can be any comparable @@ -64,9 +64,9 @@ type NColor that lets you look up a `String` (such as user names) and find the associated `User`. - import Dict exposing ( Dict ) + import Dict(String) as Dict exposing ( Dict ) - users : Dict String User + users : Dict User users = Dict.fromArray [ { key = "Alice" @@ -93,14 +93,14 @@ that lets you look up a `String` (such as user names) and find the associated , height = height } -} -type Dict k v - = RBNode_gren_builtin NColor k v (Dict k v) (Dict k v) +type Dict v + = RBNode_gren_builtin NColor Key.T v (Dict v) (Dict v) | RBEmpty_gren_builtin {-| Create an empty dictionary. -} -empty : Dict k v +empty : Dict v empty = RBEmpty_gren_builtin @@ -116,14 +116,14 @@ dictionary. get "Spike" animals == Nothing -} -get : comparable -> Dict comparable v -> Maybe v +get : Key.T -> Dict v -> Maybe v get targetKey dict = case dict of RBEmpty_gren_builtin -> Nothing RBNode_gren_builtin _ key value left right -> - case compare targetKey key of + case Key.compare targetKey key of LT -> get targetKey left @@ -136,7 +136,7 @@ get targetKey dict = {-| Determine if a key is in a dictionary. -} -member : comparable -> Dict comparable v -> Bool +member : Key.T -> Dict v -> Bool member key dict = case get key dict of Just _ -> @@ -148,12 +148,12 @@ member key dict = {-| Determine the number of key-value pairs in the dictionary. -} -size : Dict k v -> Int +size : Dict v -> Int size dict = sizeHelp 0 dict -sizeHelp : Int -> Dict k v -> Int +sizeHelp : Int -> Dict v -> Int sizeHelp n dict = case dict of RBEmpty_gren_builtin -> @@ -168,7 +168,7 @@ sizeHelp n dict = isEmpty empty == True -} -isEmpty : Dict k v -> Bool +isEmpty : Dict v -> Bool isEmpty dict = case dict of RBEmpty_gren_builtin -> @@ -181,7 +181,7 @@ isEmpty dict = {-| Insert a key-value pair into a dictionary. Replaces value when there is a collision. -} -insert : comparable -> v -> Dict comparable v -> Dict comparable v +insert : Key.T -> v -> Dict v -> Dict v insert key value dict = -- Root node is always Black case insertHelp key value dict of @@ -192,7 +192,7 @@ insert key value dict = x -insertHelp : comparable -> v -> Dict comparable v -> Dict comparable v +insertHelp : Key.T -> v -> Dict v -> Dict v insertHelp key value dict = case dict of RBEmpty_gren_builtin -> @@ -201,7 +201,7 @@ insertHelp key value dict = RBNode_gren_builtin Red key value RBEmpty_gren_builtin RBEmpty_gren_builtin RBNode_gren_builtin nColor nKey nValue nLeft nRight -> - case compare key nKey of + case Key.compare key nKey of LT -> balance nColor nKey nValue (insertHelp key value nLeft) nRight @@ -212,7 +212,7 @@ insertHelp key value dict = balance nColor nKey nValue nLeft (insertHelp key value nRight) -balance : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v +balance : NColor -> Key.T -> v -> Dict v -> Dict v -> Dict v balance color key value left right = case right of RBNode_gren_builtin Red rK rV rLeft rRight -> @@ -245,7 +245,7 @@ balance color key value left right = {-| Remove a key-value pair from a dictionary. If the key is not found, no changes are made. -} -remove : comparable -> Dict comparable v -> Dict comparable v +remove : Key.T -> Dict v -> Dict v remove key dict = -- Root node is always Black case removeHelp key dict of @@ -262,14 +262,14 @@ makes sure that the bottom node is red by moving red colors down the tree throug and color flips. Any violations this will cause, can easily be fixed by balancing on the way up again. -} -removeHelp : comparable -> Dict comparable v -> Dict comparable v +removeHelp : Key.T -> Dict v -> Dict v removeHelp targetKey dict = case dict of RBEmpty_gren_builtin -> RBEmpty_gren_builtin RBNode_gren_builtin color key value left right -> - if targetKey < key then + if Key.compare targetKey key == LT then case left of RBNode_gren_builtin Black _ _ lLeft _ -> case lLeft of @@ -291,7 +291,7 @@ removeHelp targetKey dict = removeHelpEQGT targetKey (removeHelpPrepEQGT targetKey dict color key value left right) -removeHelpPrepEQGT : comparable -> Dict comparable v -> NColor -> comparable -> v -> Dict comparable v -> Dict comparable v -> Dict comparable v +removeHelpPrepEQGT : Key.T -> Dict v -> NColor -> Key.T -> v -> Dict v -> Dict v -> Dict v removeHelpPrepEQGT targetKey dict color key value left right = case left of RBNode_gren_builtin Red lK lV lLeft lRight -> @@ -317,7 +317,7 @@ removeHelpPrepEQGT targetKey dict color key value left right = {-| When we find the node we are looking for, we can remove by replacing the key-value pair with the key-value pair of the left-most node on the right side (the closest pair). -} -removeHelpEQGT : comparable -> Dict comparable v -> Dict comparable v +removeHelpEQGT : Key.T -> Dict v -> Dict v removeHelpEQGT targetKey dict = case dict of RBNode_gren_builtin color key value left right -> @@ -336,7 +336,7 @@ removeHelpEQGT targetKey dict = RBEmpty_gren_builtin -getMin : Dict k v -> Dict k v +getMin : Dict v -> Dict v getMin dict = case dict of RBNode_gren_builtin _ _ _ ((RBNode_gren_builtin _ _ _ _ _) as left) _ -> @@ -346,7 +346,7 @@ getMin dict = dict -removeMin : Dict k v -> Dict k v +removeMin : Dict v -> Dict v removeMin dict = case dict of RBNode_gren_builtin color key value ((RBNode_gren_builtin lColor _ _ lLeft _) as left) right -> @@ -371,7 +371,7 @@ removeMin dict = RBEmpty_gren_builtin -moveRedLeft : Dict k v -> Dict k v +moveRedLeft : Dict v -> Dict v moveRedLeft dict = case dict of RBNode_gren_builtin clr k v (RBNode_gren_builtin lClr lK lV lLeft lRight) (RBNode_gren_builtin rClr rK rV ((RBNode_gren_builtin Red rlK rlV rlL rlR) as rLeft) rRight) -> @@ -404,7 +404,7 @@ moveRedLeft dict = dict -moveRedRight : Dict k v -> Dict k v +moveRedRight : Dict v -> Dict v moveRedRight dict = case dict of RBNode_gren_builtin clr k v (RBNode_gren_builtin lClr lK lV (RBNode_gren_builtin Red llK llV llLeft llRight) lRight) (RBNode_gren_builtin rClr rK rV rLeft rRight) -> @@ -416,30 +416,20 @@ moveRedRight dict = (RBNode_gren_builtin Black k v lRight (RBNode_gren_builtin Red rK rV rLeft rRight)) RBNode_gren_builtin clr k v (RBNode_gren_builtin lClr lK lV lLeft lRight) (RBNode_gren_builtin rClr rK rV rLeft rRight) -> - case clr of - Black -> - RBNode_gren_builtin - Black - k - v - (RBNode_gren_builtin Red lK lV lLeft lRight) - (RBNode_gren_builtin Red rK rV rLeft rRight) - - Red -> - RBNode_gren_builtin - Black - k - v - (RBNode_gren_builtin Red lK lV lLeft lRight) - (RBNode_gren_builtin Red rK rV rLeft rRight) - + RBNode_gren_builtin + Black + k + v + (RBNode_gren_builtin Red lK lV lLeft lRight) + (RBNode_gren_builtin Red rK rV rLeft rRight) + _ -> dict {-| Update the value of a dictionary for a specific key with a given function. -} -update : comparable -> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v +update : Key.T -> (Maybe v -> Maybe v) -> Dict v -> Dict v update targetKey alter dictionary = case alter (get targetKey dictionary) of Just value -> @@ -451,7 +441,7 @@ update targetKey alter dictionary = {-| Create a dictionary with one key-value pair. -} -singleton : comparable -> v -> Dict comparable v +singleton : Key.T -> v -> Dict v singleton key value = -- Root node is always Black RBNode_gren_builtin Black key value RBEmpty_gren_builtin RBEmpty_gren_builtin @@ -464,7 +454,7 @@ singleton key value = {-| Combine two dictionaries. If there is a collision, preference is given to the first dictionary. -} -union : Dict comparable v -> Dict comparable v -> Dict comparable v +union : Dict v -> Dict v -> Dict v union t1 t2 = foldl insert t2 t1 @@ -472,14 +462,14 @@ union t1 t2 = {-| Keep a key-value pair when its key appears in the second dictionary. Preference is given to values in the first dictionary. -} -intersect : Dict comparable v -> Dict comparable v -> Dict comparable v +intersect : Dict v -> Dict v -> Dict v intersect t1 t2 = filter (\k _ -> member k t2) t1 {-| Keep a key-value pair when its key does not appear in the second dictionary. -} -diff : Dict comparable a -> Dict comparable b -> Dict comparable a +diff : Dict a -> Dict b -> Dict a diff t1 t2 = foldl (\k v t -> remove k t) t1 t2 @@ -490,7 +480,7 @@ diff t1 t2 = {-| Apply a function to all values in a dictionary. -} -map : (k -> a -> b) -> Dict k a -> Dict k b +map : (Key.T -> a -> b) -> Dict a -> Dict b map func dict = case dict of RBEmpty_gren_builtin -> @@ -515,7 +505,7 @@ map func dict = -- getAges users == [33,19,28] -} -foldl : (k -> v -> b -> b) -> b -> Dict k v -> b +foldl : (Key.T -> v -> b -> b) -> b -> Dict v -> b foldl func acc dict = case dict of RBEmpty_gren_builtin -> @@ -540,7 +530,7 @@ foldl func acc dict = -- getAges users == [28,19,33] -} -foldr : (k -> v -> b -> b) -> b -> Dict k v -> b +foldr : (Key.T -> v -> b -> b) -> b -> Dict v -> b foldr func acc t = case t of RBEmpty_gren_builtin -> @@ -552,7 +542,7 @@ foldr func acc t = {-| Keep only the key-value pairs that pass the given test. -} -filter : (comparable -> v -> Bool) -> Dict comparable v -> Dict comparable v +filter : (Key.T -> v -> Bool) -> Dict v -> Dict v filter isGood dict = foldl (\k v d -> @@ -570,7 +560,7 @@ filter isGood dict = contains all key-value pairs which passed the test, and the second contains the pairs that did not. -} -partition : (comparable -> v -> Bool) -> Dict comparable v -> { trues : Dict comparable v, falses : Dict comparable v } +partition : (Key.T -> v -> Bool) -> Dict v -> { trues : Dict v, falses : Dict v } partition isGood dict = let add key value { trues, falses } = @@ -596,7 +586,7 @@ partition isGood dict = keys (fromArray [ ( 0, "Alice" ), ( 1, "Bob" ) ]) == [ 0, 1 ] -} -keys : Dict k v -> Array k +keys : Dict v -> Array Key.T keys dict = foldl (\key value keyArray -> Array.pushLast key keyArray) [] dict @@ -606,41 +596,43 @@ keys dict = values (fromArray [ ( 0, "Alice" ), ( 1, "Bob" ) ]) == [ "Alice", "Bob" ] -} -values : Dict k v -> Array v +values : Dict v -> Array v values dict = foldl (\key value valueArray -> Array.pushLast value valueArray) [] dict {-| Convert a dictionary into an association list of key-value pairs, sorted by keys. -} -toArray : Dict k v -> Array { key : k, value : v } +toArray : Dict v -> Array { key : Key.T, value : v } toArray dict = foldl (\key value array -> Array.pushLast { key = key, value = value } array) [] dict {-| Convert an association list into a dictionary. -} -fromArray : Array { key : comparable, value : v } -> Dict comparable v +fromArray : Array { key : Key.T, value : v } -> Dict v fromArray assocs = Array.foldl (\{ key, value } dict -> insert key value dict) empty assocs -{-| The most general way of combining two dictionaries. You provide three +{- TODO: Broke after typesystem changes in Gren compiler + +The most general way of combining two dictionaries. You provide three accumulators for when a given key appears: 1. Only in the left dictionary. 2. In both dictionaries. 3. Only in the right dictionary. - You then traverse all the keys from lowest to highest, building up whatever - you want. --} +You then traverse all the keys from lowest to highest, building up whatever +you want. + merge : - (comparable -> a -> result -> result) - -> (comparable -> a -> b -> result -> result) - -> (comparable -> b -> result -> result) - -> Dict comparable a - -> Dict comparable b + (Key.T -> a -> result -> result) + -> (Key.T -> a -> b -> result -> result) + -> (Key.T -> b -> result -> result) + -> Dict a + -> Dict b -> result -> result merge leftStep bothStep rightStep leftDict rightDict initialResult = @@ -653,23 +645,25 @@ merge leftStep bothStep rightStep leftDict rightDict initialResult = } Just { first = { key = lKey, value = lValue }, rest } -> - if lKey < rKey then - stepState rKey rValue - { list = rest - , result = leftStep lKey lValue result + case Key.compare lKey rKey of + LT -> + stepState rKey rValue + { list = rest + , result = leftStep lKey lValue result + } + + GT -> + { list = list + , result = rightStep rKey rValue result } - else if lKey > rKey then - { list = list - , result = rightStep rKey rValue result - } - - else - { list = rest - , result = bothStep lKey lValue rValue result - } + EQ -> + { list = rest + , result = bothStep lKey lValue rValue result + } { list = leftovers, result = intermediateResult } = foldl stepState { list = toArray leftDict, result = initialResult } rightDict in Array.foldl (\{ key, value } result -> leftStep key value result) intermediateResult leftovers +-} diff --git a/src/Float.gren b/src/Float.gren new file mode 100644 index 00000000..42102b8f --- /dev/null +++ b/src/Float.gren @@ -0,0 +1,12 @@ +module Float exposing (T, compare) + + +import Basics exposing (Order, Float) + + +type alias T = Float + + +compare : T -> T -> Order +compare left right = + Basics.compare 1.0 2.0 diff --git a/src/Json/Decode.gren b/src/Json/Decode.gren index 2a8cf568..c5e2e307 100644 --- a/src/Json/Decode.gren +++ b/src/Json/Decode.gren @@ -52,7 +52,7 @@ JSON decoders][guide] to get a feel for how this library works! import Basics exposing (..) import Array exposing (Array) -import Dict exposing (Dict) +import Dict(String) exposing (Dict) import Char import String exposing (String) import Maybe exposing (Maybe(..)) diff --git a/src/Json/Encode.gren b/src/Json/Encode.gren index d65702b7..7c055259 100644 --- a/src/Json/Encode.gren +++ b/src/Json/Encode.gren @@ -31,8 +31,8 @@ module Json.Encode exposing import Basics exposing (..) import Array exposing (Array) -import Dict exposing (Dict) -import Set exposing (Set) +import Dict(String) exposing (Dict) +import Set(String) exposing (Set) import String exposing (String) import Gren.Kernel.Json diff --git a/src/Set.gren b/src/Set.gren index 75cfbcaa..ad8db4d1 100644 --- a/src/Set.gren +++ b/src/Set.gren @@ -1,10 +1,10 @@ -module Set exposing +module Set(Key : Comparable) exposing ( Set , empty, singleton, insert, remove , isEmpty, member, size , union, intersect, diff , toArray, fromArray - , map, foldl, foldr, filter, partition + , foldl, foldr, filter, partition ) {-| A set of unique values. The values can be any comparable type. This @@ -47,76 +47,76 @@ Insert, remove, and query operations all take _O(log n)_ time. import Array exposing (Array) import Basics exposing (Bool, Int) -import Dict +import Dict(Key) as Dict exposing (Dict) import Maybe exposing (Maybe(..)) {-| Represents a set of unique values. So `(Set Int)` is a set of integers and `(Set String)` is a set of strings. -} -type Set t - = Set_gren_builtin (Dict.Dict t {}) +type Set + = Set_gren_builtin (Dict {}) {-| Create an empty set. -} -empty : Set a +empty : Set empty = Set_gren_builtin Dict.empty {-| Create a set with one value. -} -singleton : comparable -> Set comparable +singleton : Key.T -> Set singleton key = Set_gren_builtin (Dict.singleton key {}) {-| Insert a value into a set. -} -insert : comparable -> Set comparable -> Set comparable +insert : Key.T -> Set -> Set insert key (Set_gren_builtin dict) = Set_gren_builtin (Dict.insert key {} dict) {-| Remove a value from a set. If the value is not found, no changes are made. -} -remove : comparable -> Set comparable -> Set comparable +remove : Key.T -> Set -> Set remove key (Set_gren_builtin dict) = Set_gren_builtin (Dict.remove key dict) {-| Determine if a set is empty. -} -isEmpty : Set a -> Bool +isEmpty : Set -> Bool isEmpty (Set_gren_builtin dict) = Dict.isEmpty dict {-| Determine if a value is in a set. -} -member : comparable -> Set comparable -> Bool +member : Key.T -> Set -> Bool member key (Set_gren_builtin dict) = Dict.member key dict {-| Determine the number of elements in a set. -} -size : Set a -> Int +size : Set -> Int size (Set_gren_builtin dict) = Dict.size dict {-| Get the union of two sets. Keep all values. -} -union : Set comparable -> Set comparable -> Set comparable +union : Set -> Set -> Set union (Set_gren_builtin dict1) (Set_gren_builtin dict2) = Set_gren_builtin (Dict.union dict1 dict2) {-| Get the intersection of two sets. Keeps values that appear in both sets. -} -intersect : Set comparable -> Set comparable -> Set comparable +intersect : Set -> Set -> Set intersect (Set_gren_builtin dict1) (Set_gren_builtin dict2) = Set_gren_builtin (Dict.intersect dict1 dict2) @@ -124,46 +124,39 @@ intersect (Set_gren_builtin dict1) (Set_gren_builtin dict2) = {-| Get the difference between the first set and the second. Keeps values that do not appear in the second set. -} -diff : Set comparable -> Set comparable -> Set comparable +diff : Set -> Set -> Set diff (Set_gren_builtin dict1) (Set_gren_builtin dict2) = Set_gren_builtin (Dict.diff dict1 dict2) {-| Convert a set into a list, sorted from lowest to highest. -} -toArray : Set a -> Array a +toArray : Set -> Array Key.T toArray (Set_gren_builtin dict) = Dict.keys dict {-| Convert a list into a set, removing any duplicates. -} -fromArray : Array comparable -> Set comparable +fromArray : Array Key.T -> Set fromArray list = Array.foldl insert empty list {-| Fold over the values in a set, in order from lowest to highest. -} -foldl : (a -> b -> b) -> b -> Set a -> b +foldl : (Key.T -> b -> b) -> b -> Set -> b foldl func initialState (Set_gren_builtin dict) = Dict.foldl (\key _ state -> func key state) initialState dict {-| Fold over the values in a set, in order from highest to lowest. -} -foldr : (a -> b -> b) -> b -> Set a -> b +foldr : (Key.T -> b -> b) -> b -> Set -> b foldr func initialState (Set_gren_builtin dict) = Dict.foldr (\key _ state -> func key state) initialState dict -{-| Map a function onto a set, creating a new set with no duplicates. --} -map : (comparable -> comparable2) -> Set comparable -> Set comparable2 -map func set = - foldl (\x xs -> insert (func x) xs) empty set - - {-| Only keep elements that pass the given test. import Set exposing (Set) @@ -179,7 +172,7 @@ map func set = -- positives == Set.fromArray [1,2] -} -filter : (comparable -> Bool) -> Set comparable -> Set comparable +filter : (Key.T -> Bool) -> Set -> Set filter isGood (Set_gren_builtin dict) = Set_gren_builtin (Dict.filter (\key _ -> isGood key) dict) @@ -187,7 +180,7 @@ filter isGood (Set_gren_builtin dict) = {-| Create two new sets. The first contains all the elements that passed the given test, and the second contains all the elements that did not. -} -partition : (comparable -> Bool) -> Set comparable -> { trues : Set comparable, falses : Set comparable } +partition : (Key.T -> Bool) -> Set -> { trues : Set, falses : Set } partition isGood (Set_gren_builtin dict) = let { trues, falses } = diff --git a/src/Time.gren b/src/Time.gren index 252356ca..64fe9055 100644 --- a/src/Time.gren +++ b/src/Time.gren @@ -45,7 +45,9 @@ effect module Time where { subscription = MySub } exposing import Array exposing (Array) import Basics exposing (..) -import Dict +-- TODO: the below line is required for this module to run (used in Dict import), this is a bug +import Float +import Dict(Float) as Dict exposing (Dict) import Math import Maybe exposing (Maybe(..)) import Platform @@ -443,11 +445,11 @@ type alias State msg = type alias Processes = - Dict.Dict Float Platform.ProcessId + Dict Platform.ProcessId type alias Taggers msg = - Dict.Dict Float (Array (Posix -> msg)) + Dict (Array (Posix -> msg)) init : Task Never (State msg)