Can a Standard ML functor take another functor as parameter? - sml

I have an implementation of sets and maps as unbalanced binary trees. Because sets and maps are so alike, I actually only wrote an implementation for maps from scratch, and then trivially implemented sets as maps from keys to units:
signature EQ =
sig
type t;
val eq : t * t -> bool;
end;
signature ORD =
sig
include EQ;
val lt : t * t -> bool;
end;
signature SET =
sig
structure Elem : EQ;
type set;
val empty : set;
val member : Elem.t * set -> bool;
val insert : Elem.t * set -> set option;
end;
signature MAP =
sig
structure Key : EQ;
type 'a map;
val empty : 'a map;
val lookup : Key.t * 'a map -> 'a option;
val insert : Key.t * 'a * 'a map -> 'a map option;
end;
functor UnbalancedMap (Key : ORD) :> MAP =
struct
structure Key = Key;
datatype 'a tree = E | T of Key.t * 'a * 'a tree * 'a tree;
type 'a map = 'a tree;
val empty = E;
fun lookup (k, t) =
let
fun loop (k, E, E) = NONE
| loop (k, E, T (x, y, _, _)) =
if Key.eq (k, x) then SOME y
else NONE
| loop (k, t as T (x, _, a, b), r) =
if Key.lt (k, x) then loop (k, a, r)
else loop (k, b, t);
in
loop (k, t, E)
end;
fun insert (k, v, t) =
let
exception Exists;
fun loop (k, v, E, E) = T (k, v, E, E)
| loop (k, v, E, T (x, _, _, _)) =
if Key.eq (k, x) then raise Exists
else T (k, v, E, E)
| loop (k, v, t as T (x, y, a, b), r) =
if Key.lt (k, x) then T (x, y, loop (k, v, a, r), b)
else T (x, y, a, loop (k, v, b, t));
in
SOME (loop (k, v, t, E)) handle Exists => NONE
end;
end;
functor UnbalancedSet (Elem : ORD) :> SET =
struct
structure Map = UnbalancedMap (Elem);
structure Elem = Map.Key;
type set = unit Map.map;
val empty = Map.empty;
fun member (x, t) = case Map.lookup (x, t) of
NONE => false
| _ => true;
fun insert (x, t) = Map.insert (x, (), t);
end;
Let's assume I come up with another implementation of maps using some other data structure. Then I should be able to reuse that data structure to define sets as maps from keys to units as well:
functor AnotherMap (Key : EQ) :> MAP =
struct
(* ... *)
end;
functor AnotherSet (Elem : EQ) :> SET =
struct
structure Map = AnotherMap (Elem);
structure Elem = Map.Key;
type set = unit Map.map;
val empty = Map.empty;
fun member (x, t) = case Map.lookup (x, t) of
NONE => false
| _ => true;
fun insert (x, t) = Map.insert (x, (), t);
end;
However, if I come up with arbitrarily many implementations of maps, redefining sets that use the same data structures as those maps quickly becomes tedious. What I would really like to have is a functor that takes a functor from X to MAP, and produces a functor from X to SET, where X is any signature that includes EQ (or possibly EQ itself). Is this possible in Standard ML?

As a non-standard extension, yes. I believe the feature you are looking for is called 'higher order functors' by SML/NJ. Here's some limited detail on their implementation.
I stress that this is not a standard feature of SML, though. It is not possible to achieve this directly using the SML module system.

Related

OCaml: Instantiating parameterized type imported from another module

I have a module in one file that contains the type type move = Move of int. In another file, I open this module and can refer to the type by ModuleName1.move. But is it possible to construct an instance of this type in the second file, given that I'd have to use the Move i syntax, and since that Move parameter/keyword isn't really accessible from the second file?
Here's the module where I want to instantiate the type from the first module (which is called Game and contains the type type move = Move of int. It's right at the end, in the next_move function, that I want to construct a (Move 0) and pass it to make_tree, however it doesn't recognize Move since it's a parameterized type constructor from the other module:
#use "sig_player.ml" ;;
#use "game.ml" ;;
module TestAIPlayer =
struct
module PlayerGame = Game
open PlayerGame
let max_depth = 4 ;;
(* Data Definition *)
type tree = Node of PlayerGame.state * PlayerGame.move * tree list ;;
let rec make_tree (root: PlayerGame.state * PlayerGame.move) (d: int): tree =
let (s, m) = root in
let lms = PlayerGame.legal_moves s in
match lms, d with
| [], _ | _, 0 -> Node (s, m, [])
| _, _ -> Node (s, m, (List.map
(fun mv -> make_tree ((PlayerGame.next_state s mv), mv) (d - 1))
lms)) ;;
let compare_node (n1: PlayerGame.move * float) (n2: PlayerGame.move * float)
(comp: 'a -> 'a -> 'a): PlayerGame.move * float =
match n1, n2 with
| (m1, f1), (m2, f2) -> if (comp f1 f2) = f1 then n1 else n2 ;;
let rec minimax (t: tree) (mm: bool): PlayerGame.move * float =
match t with
| Node (s, m, []) -> (m, PlayerGame.estimate_value s)
| Node (s, m, children) -> let propagated = List.map
(fun c -> minimax c (not mm)) children in
(match mm with
| true -> List.fold_right
(fun x y -> compare_node x y max)
propagated (m, neg_infinity)
| false -> List.fold_right
(fun x y -> compare_node x y min)
propagated (m, infinity)) ;;
let next_move s = minimax (make_tree (s, (Move 0)) max_depth) true ;;
end ;;
module AIPlayer = (TestAIPlayer : PLAYER with module PlayerGame := Game) ;;

SML Match Redundant Error

Im writing some code for an insertion sort in SML. Here it is.
fun compare(x:real, y:real, F) = F(x, y);
fun isEqual(x:real, y:real) = ((x <= y) andalso (x >= y));
fun rinsert(x: real, L: real list, F) = [x]
|rinsert(x, (y::ys), F) =
if isEqual(x, y) then rinsert (x, ys, F)
else if compare(x, y, F) then x::y::ys
else y::(rinsert (x, ys, F));
fun rinsort(L : real list, F) = []
|rinsort(x::xs, F) = rinsert(x, (rinsort (xs, F), F);
For whatever reason i keep coming up with this error
- val compare = fn : real * real * (real * real -> 'a) -> 'a
val isEqual = fn : real * real -> bool
stdIn:4.6-8.42 Error: match redundant
(x,L,F) => ...
--> (x,y :: ys,F) => ...
I understand what it's saying, that I've got a repetitive line somewhere, but I'm not sure where the problem could be.
The first line of rinsert has plain variables for each argument, so matches everything. Consequently, the second case is never reached. Same for rinsort.
To fix this, you'll need to replace the L parameter in both with the pattern [] for the empty list.

SMLNJ Insertion Sort Operator and Operand dont agree error

Im making an insertion sort code in SML, here it is
fun compare(x:real, y:real, F) = F(x, y);
fun isEqual(x:real, y:real) = ((x <= y) andalso (x >= y));
fun rinsert(x: real, [], F) = [x]
|rinsert(x, (y::ys), F) =
if isEqual(x, y) then rinsert (x, ys, F)
else if compare(x, y, F) then x::y::ys
else y::(rinsert (x, ys, F));
fun rinsort([], F) = []
|rinsort(x::xs, F) = rinsert(x, (rinsort(xs, F), F));
However, on running it i get this error
val isEqual = fn : real * real -> bool
val rinsert = fn : real * real list * (real * real -> bool) -> real list
stdIn:12.27-12.58 Error: operator and operand don't agree [tycon mismatch]
operator domain: real * real list * (real * real -> bool)
operand: 'Z * ('Y list * 'X)
in expression:
rinsert (x,(rinsort (<exp>,<exp>),F))
I understand that rinsort is calling rinsert incorrectly, but I'm not sure how to fix it.
If it can be useful, This is an example of how your code should work with areal list:
fun compare(x:real, y:real, F) = F x y;
fun isEqual(x:real, y:real) = ((x <= y) andalso (x >= y));
fun rinsert(x: real, [], F) = [x]
|rinsert(x, (y::ys), F) =
if isEqual(x, y) then rinsert (x, ys, F)
else if compare(x, y, F) then x::y::ys
else y::(rinsert (x, ys, F));
fun rinsort([], F) = []
|rinsort(x::xs, F) = rinsert(x, rinsort(xs, F), F);
val funcComp = fn r1 : real => fn r2 : real => if r1 < r2 then true else false;
val l : real list = [1.0, 3.8, 5.6, 3.8, 4.4, 5.6, 6.3, 5.5, 4.6, 8.1];
val b = rinsort(l, funcComp);
Some general feedback:
The function compare only serves the purpose to switch the order of the arguments of F, so you might as well just refer to F itself then.
The function isEqual is kind of bad. Since reals are not equality types in SML for a reason, try and avoid comparing them like that. It turns out, in order to sort reals, you only need <=, not =.
The function rinsert has strict : real type annotations that are unnecessary since your insertion sort, in taking the comparison operator F as a parameter, might as well be generic (polymorphic).
You might want to call the parameter F something more descriptive, like cmp, leq, or whatever reminds you of its purpose.
Here's an example of how one might also make an insertion sort function:
fun sort leq xs =
let fun insert (x, []) = [x]
| insert (x, y::ys) =
if leq (x, y)
then x::y::ys
else y::insert (x, ys)
in List.foldl insert [] xs
end
It has the type ('a * 'a -> bool) -> 'a list -> 'a list. This is comparable to e.g. SML/NJ's built-in ListMergeSort.sort. I've chosen sort to be curried since you might want to specialize it by partial function application, e.g.,
val realsort = sort (op <=) : real list -> real list
val stringsort = sort (op >) : string list -> string list
but I've let the embedded helper function insert to be uncurried since List.foldl takes a function with type ('a * 'b -> 'b), i.e., a tuple of (x, ys) and returns a modified ys with x inserted.
You may want to consider which properties that can test that your function does sort. One property could be that all list elements in the sorted list are in the order specified by the comparison operator leq.
fun sorted_prop _ [] = true
| sorted_prop _ [_] = true
| sorted_prop leq (x::y::xs) = leq (x, y) andalso sorted_prop leq (y::xs)
Another property could be that each element in the unsorted list exists in the sorted list. The latter property may be hard to test if you're not assuming x to have an equality type (''a). But you could do that in the test specifically.

Haskell infinite recursion in list comprehension

I am trying to define a function that accepts a point (x,y) as input, and returns an infinite list corresponding to recursively calling
P = (u^2 − v^2 + x, 2uv + y)
The initial values of u and v are both 0.
The first call would be
P = (0^2 - 0^2 + 1, 2(0)(0) + 2) = (1,2)
Then that resulting tuple (1,2) would be the next values for u and v, so then it would be
P = (1^2 - 2^2 + 1, 2(1)(2) + 2) = (-2,6)
and so on.
I'm trying to figure out how to code this in Haskell. This is what I have so far:
o :: Num a =>(a,a) -> [(a,a)]
o (x,y) = [(a,b)| (a,b)<- [p(x,y)(x,y)]]
where p(x,y)(u,v) = ((u^2)-(v^2)+x,(2*u*v)+y)
I'm really not sure how to make this work. Any help would be appreciated!
Let's first ignore the exact question you have, and focus on getting the loop working. What you want, essentially, is to have something that takes some initial value iv (namely, (0, 0) for (u, v)), and returns the list
f iv : f (f iv) : f (f (f iv)) : f (f (f (f iv))) : ...
for some function f (constructed from your p and (x, y)). Moreover, you want the result to reuse the previously computed elements of the list. If I would write a function myself that does this, it might looke like this (but maybe with some different names):
looper :: (a -> a) -> a -> [a]
looper f iv = one_result : more_results
where
one_result = f iv
more_results = looper f one_result
But, of course, I would first look if a function with that type exists. It does: it's called Data.List.iterate. The only thing it does wrong is the first element of the list will be iv, but that can be easily fixed by using tail (which is fine here: as long as your iteration function terminates, iterate will always generate an infinite list).
Let's now get back to your case. We established that it'll generally look like this:
o :: Num a => (a, a) -> [(a, a)]
o (x, y) = tail (iterate f iv)
where
f (u, v) = undefined
iv = undefined
As you indicated, the initial value of (u, v) is (0, 0), so that's what our definition of iv will be. f now has to call p with the (x, y) from o's argument and the (u, v) for that iteration:
o :: Num a => (a, a) -> [(a, a)]
o (x, y) = tail (iterate f iv)
where
f (u, v) = p (x, y) (u, v)
iv = (0, 0)
p = undefined
It's as simple as that: the (x, y) from o's definition is actually in scope in the where-clause. You could even decide to merge f and p, and end up with
o :: Num a => (a, a) -> [(a, a)]
o (x, y) = tail (iterate p iv)
where
iv = (0, 0)
p (u, v) = (u^2 - v^2 + x, 2 * u * v + y)
Also, may I suggest that you use Data.Complex for your application? This makes the constraints on a a bit stricter (you need RealFloat a, because of Num.signum), but in my opinion, it makes your code much easier to read:
import Data.Complex
import Data.List (iterate)
{- ... -}
o :: Num (Complex a) => Complex a -> [Complex a]
o c = tail (iterate p iv)
where
iv = 0 -- or "0 :+ 0", if you want to be explicit
p z = z^2 + c
You want:
To construct a list [(u, v)] with the head of this list equal (0, 0)
And then map this list with the function \(u, v) -> (u^2 - v^2 + x, 2 * u * v + y), appending results of this function to the list.
We can write this function as described:
func :: (Num t) => (t, t) -> [(t, t)]
func (x, y) = (0, 0) : map functionP (func (x, y))
where functionP (u, v) = (u^2 - v^2 + x, 2 * u * v + y)
GHCi > take 5 $ func (1, 2)
> [(0,0),(1,2),(-2,6),(-31,-22),(478,1366)]

Sneaking lenses and CPS past the value restriction

I'm encoding a form of van Laarhoven lenses in OCaml, but am having difficulty due to the value restriction.
The relevant code is as follows:
module Optic : sig
type (-'s, +'t, +'a, -'b) t
val lens : ('s -> 'a) -> ('s -> 'b -> 't) -> ('s, 't, 'a, 'b) t
val _1 : ('a * 'x, 'b * 'x, 'a, 'b) t
end = struct
type (-'s, +'t, +'a, -'b) t =
{ op : 'r . ('a -> ('b -> 'r) -> 'r) -> ('s -> ('t -> 'r) -> 'r) }
let lens get set =
let op cont this read = cont (get this) (fun b -> read (set this b))
in { op }
let _1 = let build (_, b) a = (a, b) in lens fst build
end
Here I am representing a lens as a higher order type, a transformer of CPS-transformed functions ('a -> 'b) -> ('s -> 't) (as was suggested here and discussed here). The functions lens, fst, and build all have fully generalized types but their composition lens fst build does not.
Error: Signature mismatch:
...
Values do not match:
val _1 : ('_a * '_b, '_c * '_b, '_a, '_c) t
is not included in
val _1 : ('a * 'x, 'b * 'x, 'a, 'b) t
As shown in the gist, it's perfectly possible to write _1
let _1 = { op = fun cont (a, x) read -> cont a (fun b -> read (b, x)) }
but having to manually construct these lenses each time is tedious and it would be nice to build them using higher order functions like lens.
Is there any way around the value restriction here?
The value restriction is a limitation of the OCaml type system that prevents some polymorphic values from being generalized, i.e. having a type that is universally quantified over all type variables. This is done to preserve soundness of the type system in the presence of mutable references and side effects.
In your case, the value restriction applies to the _1 value, which is defined as the result of applying the lens function to two other functions, fst and build. The lens function is polymorphic, but its result is not, because it depends on the type of the arguments it receives. Therefore, the type of _1 is not fully generalized, and it cannot be given the type signature you expect.
There are a few possible ways to work around the value restriction in this case:
Use explicit type annotations to specify the type variables you want to generalize. For example, you can write:
let _1 : type a b x. (a * x, b * x, a, b) Optic.t = lens fst (fun (_, b) a -> (a, b))
This tells the compiler that you want to generalize over the type variables a, b, and x, and that the type of _1 should be a lens that works on pairs with any types for the first and second components.
Use functors to abstract over the type variables and delay the instantiation of the lens function. For example, you can write:
module MakeLens (A : sig type t end) (B : sig type t end) (X : sig type t end) = struct
let _1 = lens fst (fun (_, b) a -> (a, b))
end
This defines a functor that takes three modules as arguments, each defining a type t, and returns a module that contains a value _1 of type (A.t * X.t, B.t * X.t, A.t, B.t) Optic.t. You can then apply this functor to different modules to get different instances of _1. For example, you can write:
module IntLens = MakeLens (struct type t = int end) (struct type t = int end) (struct type t = string end)
let _1_int = IntLens._1
This gives you a value _1_int of type (int * string, int * string, int, int) Optic.t.
Use records instead of tuples to represent the data types you want to manipulate with lenses. Records have named fields, which can be accessed and updated using the dot notation, and they are more amenable to polymorphism than tuples. For example, you can write:
type ('a, 'x) pair = { first : 'a; second : 'x }
let lens_first = lens (fun p -> p.first) (fun p b -> { p with first = b })
let lens_second = lens (fun p -> p.second) (fun p b -> { p with second = b })
This defines two lenses, lens_first and lens_second, that work on any record type that has a first and a second field, respectively. You can then use them to manipulate different kinds of records, without having to worry about the value restriction. For example, you can write:
type point = { x : int; y : int }
type person = { name : string; age : int }
let p = { x = 1; y = 2 }
let q = lens_first.op (fun x f -> x + 1) p (fun p -> p)
(* q is { x = 2; y = 2 } *)
let r = { name = "Alice"; age = 25 }
let s = lens_second.op (fun x f -> x + 1) r (fun r -> r)
(* s is { name = "Alice"; age = 26 } *)