nonexhaustive binding failure in sml code - smlnj

I'm supposed to right a function less(e, L) int * int list -> int list that returns a list of all the elements in L that are smaller then e. I wrote this:
fun less(_, nil) = nil
| less(e, L) =
let
val x::xs = less (e, tl L)
in
if e > hd L then hd L::x::xs
else nil # x::xs
end;
I'm getting a binding failure, surely in the let in bit. I tried a lot of different thinfs already, and I can't figure out why this is wrong. Can anyone shed a light?

val x::xs = less (e, tl L)
This does not match the case where the result of less (e, t1 L) is the empty list.
A correct implementation of the function is this:
fun less (_, nil) = nil
| less (y, x::xs) =
let
val xs' = less (y, xs)
in
if x < y then x::xs' else xs'

Related

Why does this SML mergeSort function not return a sorted list?

It ends up returning nothing. Also, when run, it says it is:
- val merge_sort = fn : ('a * 'a -> bool) -> 'b list -> 'a list
When I know it should be this:
- val merge_sort = fn : ('a * 'a -> bool) -> 'a list -> 'a list
The function:
fun merge_sort f =
let
fun merge(nil, ylist) = ylist
| merge(xlist, nil) = xlist
| merge(x::xend, y::yend) =
if f (x,y) then
x::merge(xend, y::yend)
else
y::merge(x::xend, yend)
fun split nil = (nil, nil)
| split [x] = ([x], nil)
| split (x::y::xy) =
let
val (low, up) = split xy
in
(x::low, y::up)
end
in
let
fun real nil = nil
| real L =
let
val (list1,list2) = split L
in
merge (real list1,real list2)
end
in
fn last => real last
end
end;
merge_sort (op >) [0, 5, 1, ~4, 9, 11]
The funny type is actually somewhat related to the bug that makes your function never terminate.
Removing the custom comparison and separating the helpers (and collapsing merge_sort and real):
fun split nil = (nil, nil)
| split [x] = ([x], nil)
| split (x::y::xy) =
let
val (low, up) = split xy
in
(x::low, y::up)
end;
fun merge (nil, ylist) = ylist
| merge (xlist, nil) = xlist
| merge (x::xend, y::yend) =
if x < y then
x::merge (xend, y::yend)
else
y::merge (x::xend, yend);
fun merge_sort nil = nil
| merge_sort L =
let
val (list1,list2) = split L
in
merge (merge_sort list1, merge_sort list2)
end;
we get these types:
val split = fn : 'a list -> 'a list * 'a list
val merge = fn : int list * int list -> int list
val merge_sort = fn : 'a list -> int list
and merge_sort takes a list of anything and produces an int list.
That's weird.
Let's look at how that was arrived at.
fun merge_sort nil = nil
nil can be a list of anything, so that gives 'a list -> 'a list.
| merge_sort L =
let
val (list1,list2) = split L
in
merge (merge_sort list1, merge_sort list2)
end;
Now, the result must be int list, because that's what merge produces, and that also agrees with the parameters of merge.
But there is still no way to infer a more specific type from merge_sort's parameter - it's only passed back to merge_sort, and 'a list is what we've already got, so we end up with 'a list -> int list.
Look at what happens when you sort a singleton list:
merge-sort [1]
--> let val (list1, list2) = split [1] in merge (merge_sort list1, merge_sort list2)
--> merge (merge_sort [1], merge_sort [])
and we have a recursion that doesn't terminate.
You need a separate base case for a singleton list:
| merge_sort [x] = [x]
and when you add that, the types are what they should be.
Since this is a debugging problem, here is how I might go about finding the problem:
First, I run the program and realize it throws an Out_of_memory exception. So I know that there's some infinite recursion going on. Somewhere a recursive call is supposed to hit a base case, but it isn't, and instead it calls itself until it eventually runs out of memory.
The function consists of multiple helper functions. See if they all work as intended.
Because merge is embedded as an inner function of merge_sort, it is hard to test in isolation because you can't refer directly to it, and if you move it out, it fails to compile because it expects the comparison function f from its parent scope. So I'm going to change merge slightly for testability purposes.
The split function doesn't need a similar modification, and the real function seems kind of unnecessary since it is just the merge-sort function; the let within a let also seems unnecessary, but since I'm moving all the helper functions out, those will be removed as a consequence anyway. So I'm going to remove real and just call it mergeSort.
The result (with some extra renaming of nil into [] and so on, which is just my preference):
fun merge p ([], ys) = ys
| merge p (xs, []) = xs
| merge p (x::xs, y::ys) =
if p (x,y) then
x::merge p (xs, y::ys)
else
y::merge p (x::xs, ys)
fun split [] = ([], [])
| split [x] = ([x], [])
| split (x::y::xys) =
let
val (lo, hi) = split xys
in
(x::lo, y::hi)
end
fun mergeSort p [] = []
| mergeSort p zs =
let
val (xs, ys) = split zs
in
merge p (mergeSort p xs, mergeSort p ys)
end
Testing this, it still throws an Out_of_memory error, so I didn't actually fix anything.
Let's try and run it by hand on a small input;
Every line that begins with = below signifies a term rewrite where I've replaced some part of the former expression with its definition. For example, mergeSort (op >) [1,2,3], which is the starting point, is replaced with the definition of mergeSort on the input that pattern matches [1,2,3].
Every line that begins with `- is my attempt to expand on a sub-part of an expression without including that in the total rewrite of the above expression -- otherwise that might get a bit messy.
mergeSort (op >) [1,2,3]
= let val (xs, ys) = split [1,2,3] in merge (op >) (mergeSort (op >) xs, mergeSort (op >) ys) end
`- split [1,2,3]
= let val (lo, hi) = split [3] in (1::lo, 2::hi) end
= let val (lo, hi) = ([3], []) in (1::lo, 2::hi) end
= (1::[3], 2::[])
= ([1,3], [2])
= let val (xs, ys) = ([1,3], [2]) in merge (op >) (mergeSort p xs, mergeSort p ys) end
= merge (op >) (mergeSort (op >) [1,3], mergeSort (op >) [2])
`- mergeSort (op >) [1,3]
= let val (xs, ys) = split [1,3] in merge (op >) (mergeSort (op >) xs, mergeSort (op >) ys) end
`- split [1,3]
= let val (lo, hi) = split [] in (1::lo, 3::hi) end
= let val (lo, hi) = ([], []) in (1::lo, 3::hi) end
= (1::[], 3::hi)
= ([1], [3])
= let val (xs, ys) = ([1], [3]) in merge (op >) (mergeSort (op >) xs, mergeSort (op >) ys) end
= merge (op >) (mergeSort (op >) [1], mergeSort (op >) [3])
`- mergeSort (op >) [1]
= let val (xs, ys) = split [1] in merge (op >) (mergeSort (op >) xs, mergeSort (op >) ys) end
= let val (xs, ys) = ([1], []) in merge (op >) (mergeSort (op >) xs, mergeSort (op >) ys) end
= merge (op >) (mergeSort (op >) [1], mergeSort (op >) [])
`- OOPS!
I don't know if you noticed, but in my attempt to calculate mergeSort (op >) [1], I was very quickly asked to calculate mergeSort (op >) [1] as part of its result. But doing that I'll quickly end up doing that again, and again, and again. So it appears, from running the function by hand, that the infinite recursion is located in what I call mergeSort and what your code calls real.
This is a bug in the algorithm that can be fixed by stating something about the sortedness of a singleton list.
As a side note, here's how I might rewrite this function entirely:
fun merge cmp ([], ys) = ys
| merge cmp (xs, []) = xs
| merge cmp (xs as x::xs', ys as y::ys') =
case cmp (x, y) of
GREATER => y :: merge cmp (xs, ys')
| _ => x :: merge cmp (xs', ys)
fun sort cmp [] = []
| sort cmp [x] = [x]
| sort cmp xs =
let
val ys = List.take (xs, length xs div 2)
val zs = List.drop (xs, length xs div 2)
in
merge cmp (sort cmp ys, sort cmp zs)
end
fun down LESS = GREATER
| down GREATER = LESS
| down EQUAL = EQUAL
(I've preserved the bug.)
Sorting integers is now:
sort (fn (x,y) => down (Int.compare (x,y))) [1,2,3]

Rank-2 types in data constructors

I've been trying to encode GADTs in PureScript using rank-2 types, as described here for Haskell
My code looks like:
data Z
data S n
data List a n
= Nil (Z -> n)
| Cons forall m. a (List a m) (S m -> n)
fw :: forall f a. (Functor f) => (forall b . (a -> b) -> f b) -> f a
fw f = f id
bw :: forall f a. (Functor f) => f a -> (forall b . (a -> b) -> f b)
bw x f = map f x
nil :: forall a. List a Z
nil = fw Nil
cons :: forall a n. a -> List a (S n)
cons a as = fw (Cons a as)
instance listFunctor :: Functor (List a) where
map f (Nil k) = Nil (f <<< k)
map f (Cons x xs k) = Cons x xs (f <<< k)
The compiler complains Wrong number of arguments to constructor Main.Cons, referring to the LHS pattern match in the Functor instance.
What is going wrong here?
Regards,
Michael
The syntax used for existential types in Haskell is not present in PureScript. What you've written for Cons is a data constructor with a single universally-quantified argument.
You might like to try using purescript-exists to encode the existential type instead.
Another option is to use a final-tagless encoding of the GADT:
class Listy l where
nil :: forall a. l Z a
cons :: forall a n. a -> l n a -> l (S n) a
You can write terms for any valid Listy instance:
myList :: forall l. (Listy l) => l (S (S Z)) Int
myList = cons 1 (cons 2 nil)
and interpret them by writing instances
newtype Length n a = Length Int
instance lengthListy :: Listy Length where
nil = Length 0
cons _ (Length n) = Length (n + 1)
newtype AsList n a = AsList (List a)
instance asListListy :: Listy AsList where
nil = AsList Nil
cons x (AsList xs) = AsList (Cons x xs)

understanding merge sort in ML

I have an assignment to translate the following ML code into Java, but I cannot tell what it is doing. What are the 'halve' and 'merge' functions doing here?
fun halve nil = (nil, nil)
| halve [a] = ([a], nil)
| halve (a :: b :: cs) =
let
val (x, y) = halve cs
in
(a :: x, b :: y)
end;
fun merge (nil, ys) = ys
| merge (xs, nil) = xs
| merge (x :: xs, y :: ys) =
if (x > y) then x :: merge(xs, y :: ys)
else y :: merge(x :: xs, ys);
fun mergeSort nil = nil
| mergeSort [a] = [a]
| mergeSort theList =
let
val (x, y) = halve theList
in
print("xList: "^printList(x));
print("yList: "^printList(y));
merge(mergeSort x, mergeSort y)
end;
halve splits a list in two by adding its elements alternatingly to two lists (this saves you from having to calculate the length first and then splitting it, which would require 1.5 traversals of the list instead of just one).
merge merges two lists in decreasing order.
mergeSort splits a list in two, sorts the two halves, then merges the sorted sublists.

User-defined List instance

This is supposed to be really simple, but I cannot seem to get around it.
Suppose I have my own List class, declaring head and tail in its interface. List is supposed to be what you expect, that is a collection of homogeneous items.
Then, I want to create a data type implementing the List interface.
The following code is what I came up with, but it does not work: how would you fix it?
class List l where
head :: l -> a -- ERROR! How do I tell: given a list, return an element?
tail :: l -> l
data ConsList a = Nil | Cons a (ConsList a)
instance List (ConsList Int) where
head Nil = error "Empty List"
head (Cons h _) = h
tail Nil = error "Empty List"
tail (Cons _ t) = t
Thanks in advance!
Rather than defining List a type class, define it as a constructor class:
class List l where
head :: l a -> a
tail :: l a -> l a
data ConsList a = Nil | Cons a (ConsList a)
instance List ConsList where
head Nil = error "Empty List"
head (Cons h _) = h
tail Nil = error "Empty List"
tail (Cons _ t) = t
Alternatively, fix the element type (note: for your type ConsList, this requires flexible instances):
{-# LANGUAGE FlexibleInstances #-}
class List l where
head :: l -> Int
tail :: l -> l
data ConsList a = Nil | Cons a (ConsList a)
instance List (ConsList Int) where
head Nil = error "Empty List"
head (Cons h _) = h
tail Nil = error "Empty List"
tail (Cons _ t) = t
Finally, with type families you can do even more fancy stuff, but it really depends on your specific scenario if you should go that far (probably not):
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
class List l where
type Elt l
head :: l -> Elt l
tail :: l -> l
data ConsList a = Nil | Cons a (ConsList a)
instance List (ConsList Int) where
type Elt (ConsList Int) = Int
head Nil = error "Empty List"
head (Cons h _) = h
tail Nil = error "Empty List"
tail (Cons _ t) = t
You can
make it a constructor class,
class List l where
head :: l a -> a
tail :: l a -> l a
make it a multiparameter type class with functional dependencies
class List l a | l -> a where
head :: l -> a
tail :: l -> l
use a type family
class List l where
type Elem l
head :: l -> Elem l
tail :: l -> l
I consider the constructor class the best way to go about it.
The easiest way to make an abstraction over lists is to abstract over the type constructor, i.e., over [], not over [a] (which is syntactic sugar for [] a).
So your class becomes:
class List l where
head :: l a -> a -- now l is applied to the element type
tail :: l a -> l a
Then your instance changes accordingly:
instance List ConsList where
... -- code as before

Rotate the first argument to a function to become nth

Given a function with at least n arguments, I want to rotate the first argument so that it becomes the nth argument. For example (in untyped lambda calculus):
r(λa. a) = λa. a
r(λa. λb. a b) = λb. λa. a b
r(λa. λb. λc. a b c) = λb. λc. λa. a b c
r(λa. λb. λc. λd. a b c d) = λb. λc. λd. λa. a b c d
And so on.
Can you write r in a generic way? What if you know that n >= 2?
Here's the problem stated in Scala:
trait E
case class Lam(i: E => E) extends E
case class Lit(i: Int) extends E
case class Ap(e: E, e: E) extends E
The rotation should take Lam(a => Lam(b => Lam(c => Ap(Ap(a, b), c)))) and return Lam(b => Lam(c => Lam(a => Ap(Ap(a, b), c)))), for example.
The trick is to tag the "final" value of the functions involved, since to normal haskell, both a -> b and a -> (b->c) are just functions of a single variable.
If we do that, though, we can do this.
{-# LANGUAGE TypeFamilies,FlexibleInstances,FlexibleContexts #-}
module Rotate where
data Result a = Result a
class Rotate f where
type After f
rotate :: f -> After f
instance Rotate (a -> Result b) where
type After (a -> Result b) = a -> Result b
rotate = id
instance Rotate (a -> c) => Rotate (a -> b -> c) where
type After (a -> b -> c) = b -> After (a -> c)
rotate = (rotate .) . flip
Then, to see it in action:
f0 :: Result a
f0 = Result undefined
f1 :: Int -> Result a
f1 = const f0
f2 :: Char -> Int -> Result a
f2 = const f1
f3 :: Float -> Char -> Int -> Result a
f3 = const f2
f1' :: Int -> Result a
f1' = rotate f1
f2' :: Int -> Char -> Result a
f2' = rotate f2
f3' :: Char -> Int -> Float -> Result a
f3' = rotate f3
It's probably impossible without violating the ‘legitimacy’ of HOAS, in the sense that the E => E must be used not just for binding in the object language, but for computation in the meta language. That said, here's a solution in Haskell. It abuses a Literal node to drop in a unique ID for later substitution. Enjoy!
import Control.Monad.State
-- HOAS representation
data Expr = Lam (Expr -> Expr)
| App Expr Expr
| Lit Integer
-- Rotate transformation
rot :: Expr -> Expr
rot e = case e of
Lam f -> descend uniqueID (f (Lit uniqueID))
_ -> e
where uniqueID = 1 + maxLit e
descend :: Integer -> Expr -> Expr
descend i (Lam f) = Lam $ descend i . f
descend i e = Lam $ \a -> replace i a e
replace :: Integer -> Expr -> Expr -> Expr
replace i e (Lam f) = Lam $ replace i e . f
replace i e (App e1 e2) = App (replace i e e1) (replace i e e2)
replace i e (Lit j)
| i == j = e
| otherwise = Lit j
maxLit :: Expr -> Integer
maxLit e = execState (maxLit' e) (-2)
where maxLit' (Lam f) = maxLit' (f (Lit 0))
maxLit' (App e1 e2) = maxLit' e1 >> maxLit' e2
maxLit' (Lit i) = get >>= \k -> when (i > k) (put i)
-- Output
toStr :: Integer -> Expr -> State Integer String
toStr k e = toStr' e
where toStr' (Lit i)
| i >= k = return $ 'x':show i -- variable
| otherwise = return $ show i -- literal
toStr' (App e1 e2) = do
s1 <- toStr' e1
s2 <- toStr' e2
return $ "(" ++ s1 ++ " " ++ s2 ++ ")"
toStr' (Lam f) = do
i <- get
modify (+ 1)
s <- toStr' (f (Lit i))
return $ "\\x" ++ show i ++ " " ++ s
instance Show Expr where
show e = evalState (toStr m e) m
where m = 2 + maxLit e
-- Examples
ex2, ex3, ex4 :: Expr
ex2 = Lam(\a -> Lam(\b -> App a (App b (Lit 3))))
ex3 = Lam(\a -> Lam(\b -> Lam(\c -> App a (App b c))))
ex4 = Lam(\a -> Lam(\b -> Lam(\c -> Lam(\d -> App (App a b) (App c d)))))
check :: Expr -> IO ()
check e = putStrLn(show e ++ " ===> \n" ++ show (rot e) ++ "\n")
main = check ex2 >> check ex3 >> check ex4
with the following result:
\x5 \x6 (x5 (x6 3)) ===>
\x5 \x6 (x6 (x5 3))
\x2 \x3 \x4 (x2 (x3 x4)) ===>
\x2 \x3 \x4 (x4 (x2 x3))
\x2 \x3 \x4 \x5 ((x2 x3) (x4 x5)) ===>
\x2 \x3 \x4 \x5 ((x5 x2) (x3 x4))
(Don't be fooled by the similar-looking variable names. This is the rotation you seek, modulo alpha-conversion.)
Yes, I'm posting another answer. And it still might not be exactly what you're looking for. But I think it might be of use nonetheless. It's in Haskell.
data LExpr = Lambda Char LExpr
| Atom Char
| App LExpr LExpr
instance Show LExpr where
show (Atom c) = [c]
show (App l r) = "(" ++ show l ++ " " ++ show r ++ ")"
show (Lambda c expr) = "(λ" ++ [c] ++ ". " ++ show expr ++ ")"
So here I cooked up a basic algebraic data type for expressing lambda calculus. I added a simple, but effective, custom Show instance.
ghci> App (Lambda 'a' (Atom 'a')) (Atom 'b')
((λa. a) b)
For fun, I threw in a simple reduce method, with helper replace. Warning: not carefully thought out or tested. Do not use for industrial purposes. Cannot handle certain nasty expressions. :P
reduce (App (Lambda c target) expr) = reduce $ replace c (reduce expr) target
reduce v = v
replace c expr av#(Atom v)
| v == c = expr
| otherwise = av
replace c expr ap#(App l r)
= App (replace c expr l) (replace c expr r)
replace c expr lv#(Lambda v e)
| v == c = lv
| otherwise = (Lambda v (replace c expr e))
It seems to work, though that's really just me getting sidetracked. (it in ghci refers to the last value evaluated at the prompt)
ghci> reduce it
b
So now for the fun part, rotate. So I figure I can just peel off the first layer, and if it's a Lambda, great, I'll save the identifier and keep drilling down until I hit a non-Lambda. Then I'll just put the Lambda and identifier right back in at the "last" spot. If it wasn't a Lambda in the first place, then do nothing.
rotate (Lambda c e) = drill e
where drill (Lambda c' e') = Lambda c' (drill e') -- keep drilling
drill e' = Lambda c e' -- hit a non-Lambda, put c back
rotate e = e
Forgive the unimaginative variable names. Sending this through ghci shows good signs:
ghci> Lambda 'a' (Atom 'a')
(λa. a)
ghci> rotate it
(λa. a)
ghci> Lambda 'a' (Lambda 'b' (App (Atom 'a') (Atom 'b')))
(λa. (λb. (a b)))
ghci> rotate it
(λb. (λa. (a b)))
ghci> Lambda 'a' (Lambda 'b' (Lambda 'c' (App (App (Atom 'a') (Atom 'b')) (Atom 'c'))))
(λa. (λb. (λc. ((a b) c))))
ghci> rotate it
(λb. (λc. (λa. ((a b) c))))
One way to do it with template haskell would be like this:
With these two functions:
import Language.Haskell.TH
rotateFunc :: Int -> Exp
rotateFunc n = LamE (map VarP vars) $ foldl1 AppE $ map VarE $ (f:vs) ++ [v]
where vars#(f:v:vs) = map (\i -> mkName $ "x" ++ (show i)) [1..n]
getNumOfParams :: Info -> Int
getNumOfParams (VarI _ (ForallT xs _ _) _ _) = length xs + 1
Then for a function myF with a variable number of parameters you could rotate them this way:
$(return $ rotateFunc $ read $(stringE . show =<< (reify 'myF >>= return . getNumOfParams))) myF
There most certainly are neater ways of doing this with TH, I am very new to it.
OK, thanks to everyone who provided an answer. Here is the solution I ended up going with. Taking advantage of the fact that I know n:
rot :: Int -> [Expr] -> Expr
rot 0 xs = Lam $ \x -> foldl App x (reverse xs)
rot n xs = Lam $ \x -> rot (n - 1) (x : xs)
rot1 n = rot n []
I don't think this can be solved without giving n, since in the lambda calculus, a term's arity can depend on its argument. I.e. there is no definite "last" argument. Changed the question accordingly.
I think you could use the techniques described int the paper An n-ary zipWith in Haskell for this.
Can you write r in a generic way?
What if you know n?
Haskell
Not in plain vanilla Haskell. You'd have to use some deep templating magic that someone else (much wiser than I) will probably post.
In plain Haskell, let's try writing a class.
class Rotatable a where
rotate :: a -> ???
What on earth is the type for rotate? If you can't write its type signature, then you probably need templates to program at the level of generality you are looking for (in Haskell, anyways).
It's easy enough to translate the idea into Haskell functions, though.
r1 f = \a -> f a
r2 f = \b -> \a -> f a b
r3 f = \b -> \c -> \a -> f a b c
etc.
Lisp(s)
Some Lispy languages have the apply function (linked: r5rs), which takes a function and a list, and applies the elements of the list as arguments to the function. I imagine in that case it wouldn't be so hard to just un-rotate the list and send it on its way. I again defer to the gurus for deeper answers.