humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

use parametric polymorphism for value in gap_map.sml, instead of specifying value via functor. This is more flexible because a type which is defined after the functor can be used with the map. (The key in gap_map.sml is still specified by functor, though, which is necessary because the structure uses comparison functions which work with the key.)

Browse Source
This commit is contained in:
Humza Shahid
2025-03-12 23:25:29 +00:00
parent e2da10e908
commit a84490c86c
1 changed files with 32 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

67
src/gap_map.sml
View File

@@ -1,7 +1,6 @@
signature GAP_MAP_PAIR = signature GAP_MAP_PAIR =
sig sig
type key type key
type value
val l: key * key -> bool val l: key * key -> bool
val eq: key * key -> bool val eq: key * key -> bool
@@ -15,26 +14,25 @@ sig
structure Fn: GAP_MAP_PAIR structure Fn: GAP_MAP_PAIR
type key = Fn.key type key = Fn.key
type value = Fn.value
type t = type 'value t =
{ leftKeys: Fn.key vector list { leftKeys: Fn.key vector list
, leftVals: Fn.value vector list , leftVals: 'value vector list
, rightKeys: Fn.key vector list , rightKeys: Fn.key vector list
, rightVals: Fn.value vector list , rightVals: 'value vector list
} }
val empty: t val empty: 'value t
val isEmpty: t -> bool val isEmpty: 'value t -> bool
val add: Fn.key * Fn.value * t -> t val add: Fn.key * 'value * 'value t -> 'value t
val remove: Fn.key * t -> t val remove: Fn.key * 'value t -> 'value t
val get: Fn.key * t -> Fn.value option val get: Fn.key * 'value t -> 'value option
val moveToStart: t -> t val moveToStart: 'value t -> 'value t
val moveToEnd: t -> t val moveToEnd: 'value t -> 'value t
val moveTo: Fn.key * t -> t val moveTo: Fn.key * 'value t -> 'value t
end end
signature GAP_MAP_FOLDER = signature GAP_MAP_FOLDER =
@@ -42,7 +40,7 @@ sig
structure Pair: GAP_MAP_PAIR structure Pair: GAP_MAP_PAIR
type env type env
type state type state
val fold: Pair.key * Pair.value * env * state -> state val fold: Pair.key * 'value * env * state -> state
end end
signature MAKE_GAP_MAP_FOLDER = signature MAKE_GAP_MAP_FOLDER =
@@ -53,14 +51,14 @@ sig
type env = Folder.env type env = Folder.env
type state = Folder.state type state = Folder.state
type t = type 'value t =
{ leftKeys: Pair.key vector list { leftKeys: Pair.key vector list
, leftVals: Pair.value vector list , leftVals: 'value vector list
, rightKeys: Pair.key vector list , rightKeys: Pair.key vector list
, rightVals: Pair.value vector list , rightVals: 'value vector list
} }
val foldUnordered: t * env * state -> state val foldUnordered: 'value t * env * state -> state
end end
functor MakeGapMapFolder(Folder: GAP_MAP_FOLDER): MAKE_GAP_MAP_FOLDER = functor MakeGapMapFolder(Folder: GAP_MAP_FOLDER): MAKE_GAP_MAP_FOLDER =
@@ -71,11 +69,11 @@ struct
type env = Folder.env type env = Folder.env
type state = Folder.state type state = Folder.state
type t = type 'value t =
{ leftKeys: Pair.key vector list { leftKeys: Pair.key vector list
, leftVals: Pair.value vector list , leftVals: 'value vector list
, rightKeys: Pair.key vector list , rightKeys: Pair.key vector list
, rightVals: Pair.value vector list , rightVals: 'value vector list
} }
fun foldVecUnordered (pos, keys, values, env, state) = fun foldVecUnordered (pos, keys, values, env, state) =
@@ -106,7 +104,7 @@ signature MAP =
sig sig
structure Pair: GAP_MAP_PAIR structure Pair: GAP_MAP_PAIR
type env type env
val map: Pair.value * env -> Pair.value val map: 'value * env -> 'value
end end
signature MAPPER = signature MAPPER =
@@ -114,14 +112,14 @@ sig
structure Map: MAP structure Map: MAP
structure Pair: GAP_MAP_PAIR structure Pair: GAP_MAP_PAIR
type t = type 'value t =
{ leftKeys: Pair.key vector list { leftKeys: Pair.key vector list
, leftVals: Pair.value vector list , leftVals: 'value vector list
, rightKeys: Pair.key vector list , rightKeys: Pair.key vector list
, rightVals: Pair.value vector list , rightVals: 'value vector list
} }
val map: t * Map.env -> t val map: 'value t * Map.env -> 'value t
end end
functor MakeGapMapMapper(Map: MAP): MAPPER = functor MakeGapMapMapper(Map: MAP): MAPPER =
@@ -129,11 +127,11 @@ struct
structure Map = Map structure Map = Map
structure Pair = Map.Pair structure Pair = Map.Pair
type t = type 'value t =
{ leftKeys: Pair.key vector list { leftKeys: Pair.key vector list
, leftVals: Pair.value vector list , leftVals: 'value vector list
, rightKeys: Pair.key vector list , rightKeys: Pair.key vector list
, rightVals: Pair.value vector list , rightVals: 'value vector list
} }
fun mapList (hd :: tl, acc, env) = fun mapList (hd :: tl, acc, env) =
@@ -142,7 +140,7 @@ struct
end end
| mapList ([], acc, env) = List.rev acc | mapList ([], acc, env) = List.rev acc
fun map ({leftKeys, leftVals, rightKeys, rightVals}: t, env) : t = fun map ({leftKeys, leftVals, rightKeys, rightVals}: 'value t, env) : 'value t =
let let
val leftVals = mapList (leftVals, [], env) val leftVals = mapList (leftVals, [], env)
val rightVals = mapList (rightVals, [], env) val rightVals = mapList (rightVals, [], env)
@@ -160,18 +158,17 @@ struct
structure Fn = Fn structure Fn = Fn
type key = Fn.key type key = Fn.key
type value = Fn.value
type t = type 'value t =
{ leftKeys: Fn.key vector list { leftKeys: Fn.key vector list
, leftVals: Fn.value vector list , leftVals: 'value vector list
, rightKeys: Fn.key vector list , rightKeys: Fn.key vector list
, rightVals: Fn.value vector list , rightVals: 'value vector list
} }
val empty = {leftKeys = [], leftVals = [], rightKeys = [], rightVals = []} val empty = {leftKeys = [], leftVals = [], rightKeys = [], rightVals = []}
fun isEmpty ({leftKeys = [], rightKeys = [], ...}: t) = true fun isEmpty ({leftKeys = [], rightKeys = [], ...}: 'value t) = true
| isEmpty _ = false | isEmpty _ = false
fun isLessThanTarget (v1, v2) = fun isLessThanTarget (v1, v2) =