Idris - erasure of indices fails - vector

I am currently trying to erase all unused indices from my Idris
program - in one case however, the Idris compiler sees indices
as reachable. I tried to replicate the behaviour in the following
minimal example:
module Main
%access public export
-- CUSTOM VECTOR TYPES
data VectA : Nat -> Type -> Type where
VNilA : VectA Z a
VConsA : a -> VectA len a -> VectA (S len) a
data VectB : Nat -> Type -> Type where
VNilB : VectB Z a
VConsB : a -> VectB len a -> VectB (S len) a
-- THE FOLLOWING FUNCTIONS ARE USED TO CREATE A
-- CUSTOM VECTOR WHERE THE SIZE IS UNKNOWN
fromList : (l : List a) -> VectA (length l) a
fromList [] = VNilA
fromList (x::xs) = VConsA x (fromList xs)
createList : String -> List Int
createList "42" = [42, 42, 42]
createList _ = [1, 2, 3, 4]
-- SOME NESTED TRANSFORMATION FUNCTIONS ON VECT
transformVectA : VectA n a -> Maybe (VectB n a)
transformVectA VNilA = Just VNilB
transformVectA (VConsA v vs) =
case transformVectA vs of
Just vs' => Just $ VConsB v vs'
Nothing => Nothing
transformVectB : VectA m a -> VectB n a -> Maybe (VectB n a)
transformVectB VNilA ws = Just ws
transformVectB (VConsA v vs) ws = transformVectB vs ws
transformVect : VectA n a -> VectA m a -> Maybe (VectB n a)
transformVect VNilA VNilB = Nothing
transformVect VNilA VNilA = Nothing
transformVect vs VNilA = Nothing
transformVect (VConsA v vs) xs =
case transformVectA (VConsA v vs) of
Nothing => Nothing
Just vs' => transformVectB xs vs'
main : IO ()
main = do
(testArg :: _) <- getArgs
ls <- pure $ createList testArg
va <- pure $ fromList ls
vb <- pure $ transformVect va va
putStrLn "OK"
When this is compiled by running:
idris Erasure.idr -o Erasure --warnreach
...the following warnings are shown:
Main.transformVect: inaccessible arguments reachable:
n (no more information available)
m (no more information available)
I also have trouble reading the dumpcases when
compiling with the additional option:
--dumpcases cases.txt
Why do these warnings appear ?
Is there any information available about how Idris is handling
erasure besides the Chapter 'Erasure By Usage Analysis' in the
Tutorial ?

Related

Why is this lazy evaluation function not working in OCaml

I made this example up to better understand how lazy evaluation works in OCaml - using thonks.
let rec imp n = fun () -> imp(n*n);;
My understanding of lazy evaluation / thonks is that impl will
square an initial number as often as I'm calling
imp ().
However this function imp raises the following error:
---
let rec imp n acc = fun()->(***imp (n\*acc)***);;
This expression has type int -> unit -> 'a
but an expression was expected of type 'a
The type variable 'a occurs inside int -> unit -> 'a
---
The compiler is telling you that your function has a recursive type. You can work with recursive types if you supply -rectypes when you run ocaml:
$ ocaml -rectypes
OCaml version 4.10.0
# let rec imp n = fun () -> imp(n*n);;
val imp : int -> (unit -> 'a as 'a) = <fun>
On the other hand I don't think your function works like you think. Or at least I don't see any way to find out what number it has recently calculated. You'll have to take it on faith that it is calculating larger and larger numbers, I guess.
I would investigate the Seq module and use that.
Here's an example that demonstrates what you are trying to accomplish:
type func = Func of (unit -> int * func)
let rec incr_by_2 x =
let ans = x + 2 in
(ans, Func(fun () -> incr_by_2 ans))
let ans = incr_by_2 10
let () =
match ans with
| (d, Func f) -> print_endline(string_of_int d);
match f() with
| (d, Func f) -> print_endline(string_of_int d);
match f() with
| (d, _) -> print_endline(string_of_int d);
Please note the type constructor Func which is used to resolve the type problem in the function incr_by_2.
Here's an example using the Seq module's unfold function.
type func = Func of (unit -> int * func)
let rec incr_by_2 x =
let ans = x + 2 in
(ans, Func(fun () -> incr_by_2 ans))
let seq x =
Seq.unfold
(
fun (d, Func f) ->
if d < x
then
Some(d, f())
else
None
)
(incr_by_2 10)
let () =
(seq 100) |> Seq.iter (Printf.printf "%d\n"); print_newline()

Optimized version of except for Map

I've written a generic except function for Maps that, given a source map and an other map, returns only the items of the source map without corresponding keys in the other map.
module MapExt =
let getKeys<'k,'v when 'k : comparison> : Map<'k,'v> -> 'k[] =
Map.toArray >> Array.map fst
let except<'k,'v when 'k : comparison>(other:Map<'k,'v>) (source:Map<'k,'v>) : ('k * 'v)[] =
source |> getKeys
|> Array.except (other |> getKeys)
|> Array.map(fun k -> (k, source.[k]))
Now, I've seen in the second part of this answer, that an optimized version of the map's keys is obtained via a Map.fold.
Therefore, can I do a similar optimization of my original MapExt module in the following way?
module MapExtOpt =
let getKeys<'k,'v when 'k : comparison> (m : Map<'k,'v>) : 'k list =
Map.fold (fun keys key _ -> key::keys) [] m
let except<'k,'v when 'k : comparison>
(other : Map<'k,'v>) (source : Map<'k,'v>) : ('k * 'v) list =
source
|> Map.fold (fun s k v ->
if (other.ContainsKey k) then
s
else
(k,v) :: s
) []
Or am I reinventing some already existing (and optimized) functions?
I don't think there is a built in function, but this is a simpler way of doing what you are trying to do. It only goes over the 'to be removed' map once, so its much more efficient.
let except toRemove source =
Map.fold (fun m k _ -> if Map.containsKey k m then Map.remove k m else m) source toRemove
Finally,
thanks to Loïc Denuzière for his comment on Slack:
The if is not necessary: if m doesn't contain k, Map.remove k m just returns m anyway
I think I can also apply a double eta reduction by considering that it makes sense to speak about the keys to remove (not about a map whose values are ignored), so I would simply redefine it as
let except<'k,'v when 'k : comparison> = List.foldBack Map.remove<'k,'v>

How do I printf a map in OCaml?

open Map
open Pretty
let d_doc () (x : doc) : doc = x
let d_str () = text
let d_map d_k d_v () m : doc =
printf "{%a}"
d_doc
(Map.fold (fun k v acc -> printf "%a, %a -> %a" d_doc acc d_k k d_v v) m (text ""))
tells me "Error: Unbound value Map.fold". How do I do this? (I'd like either a pointer to a reference that explains how to use Map functions (or module functions in general), a standard library pretty printer for maps, and/or a fix for my code.)
I realize this post is old, but for the future visitor, the following works:
module IntMap = Map.Make(Int)
type map = string IntMap.t
let pp_map ppf (m : map) =
IntMap.iter (fun k v -> Format.fprintf ppf "%d -> %s#\n" k v) m
let _ =
IntMap.empty
|> IntMap.add 4 "hello"
|> IntMap.add 2 "world"
|> Format.printf "%a" pp_map
You can print out a map using sexplib quite conveniently. Here's how you'd do it using Core.
open Core.Std
let map = Int.Map.of_alist_exn [1,"one"; 2,"two"; 3,"three"]
let () =
(<:sexp_of<string Int.Map.t>> map)
|> Sexp.to_string_hum
|> print_endline

Conduits - multiple "attempts" into one Source

I am trying to do the following:
sourceIRC
:: (MonadBaseControl IO m, MonadLogger m)
=> NetworkSettings
-> Producer (ConnectionT m) Message
sourceIRC networkSettings = do
withConnectionForever networkSettings $ \socket -> do
bracket (liftBase $ Network.socketToHandle socket IO.ReadWriteMode)
(\handle -> liftBase $ IO.hClose handle)
(\handle -> do
mvar <- newMVar False
bracket (fork $ do
threadDelay 5000000
_ <- swapMVar mvar True
return ())
(killThread)
(\_ -> runConnectionT handle (sourceHandle handle))
takeMVar mvar)
As you can see, I am trying to create a Producer in terms of a primitive withConnectionForever. That primitive is of type:
withConnectionForever
:: (MonadBaseControl IO m, MonadLogger m)
=> NetworkSettings
-> (Network.Socket -> m Bool)
-> m ()
As you can imagine, I am getting an error message on compilation! It is:
Haskell/IRC.hs:128:54:
Couldn't match expected type `ConnectionT m0 a0'
with actual type `ConduitM i0 ByteString.ByteString m1 ()'
In the return type of a call of `sourceHandle'
In the second argument of `runConnectionT', namely
`(sourceHandle handle)'
In the expression: runConnectionT handle (sourceHandle handle)
Now, I know that the type of the call to withConnectionForever is not obviously a conduit, but I had hoped that it could manage to be one, by virtue of the fact that a conduit is also a monad and withConnectionForever uses a free monad instead of a hardcoded one. My understanding of what the message is trying to communicate is that that's not happening, and I'd like to know why and what I can do about it.
Here, for completeness, is the source of the primitive:
withConnectionForever
:: (MonadBaseControl IO m, MonadLogger m)
=> NetworkSettings
-> (Network.Socket -> m Bool)
-> m ()
withConnectionForever networkSettings action = do
let loop nFailures = do
maybeSocket <- newConnection networkSettings
case maybeSocket of
Nothing -> return ()
Just socket -> do
terminatedNormally <- action socket
if terminatedNormally
then loop 0
else do
exponentTwiddle <- liftBase $ Random.randomRIO (0, 100)
let exponent =
1.25 + fromIntegral (exponentTwiddle - 50) / 100.0
delay = floor $ 1000000.0 *
((0.5 ** (fromIntegral nFailures * negate exponent))
- 1.0 :: Double)
$(logInfo) (Text.concat
["Abnormal disconnection from the network ",
networkSettingsName networkSettings,
"; pausing attempts for ",
Text.pack $ show $ fromIntegral delay / 1000000.0,
" seconds..."])
liftBase $ threadDelay delay
loop (nFailures + 1)
loop 0
I'd really prefer not to rewrite the primitive, unless it can be done in minimally invasive fashion, but I suppose that's on the table.
Thanks in advance!
The relevant thing to do was
(\_ -> transPipe (runConnectionT handle) (sourceHandle handle))
instead of
(\_ -> runConnectionT handle (sourceHandle handle))
Thanks for your time! :D

Implementing Okasaki's bootstrapped heaps in OCaml, why doesn't it compile?

(A minimal non-compiling example can be found at https://gist.github.com/4044467, see more background below.)
I am trying to implement Bootstrapped Heaps introduced in Chapter 10 of Okasaki's Purely Functional Data Structure. The following is a simplified version of my non-compiling code.
We're to implement a heap with following signature:
module type ORDERED =
sig
type t
val compare : t -> t -> int
end
module type HEAP =
sig
module Elem : ORDERED
type heap
val empty : heap
val insert : Elem.t -> heap -> heap
val find_min : heap -> Elem.t
val delete_min : heap -> heap
end
We say a data structure is bootstrapped when its implementation depends on another implementation of the same kind of data structure. So we have a heap like this (the actual implementation is not important):
module SomeHeap (Element : ORDERED) : (HEAP with module Elem = Element) =
struct
module Elem = Element
type heap
let empty = failwith "skipped"
let insert = failwith "skipped"
let find_min = failwith "skipped"
let delete_min = failwith "skipped"
end
Then, the bootstrapped heap we're going to implement, which can depend on any heap implementation, is supposed to have the following signature:
module BootstrappedHeap
(MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element)
(Element : ORDERED) : (HEAP with module Elem = Element)
So we can use it like this:
module StringHeap = BootstrappedHeap(SomeHeap)(String)
The implementation of BootstrappedHeap, according to Okasaki, is like this:
module BootstrappedHeap
(MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element)
(Element : ORDERED) : (HEAP with module Elem = Element) =
struct
module Elem = Element
module rec BootstrappedElem :
sig
type t =
| E
| H of Elem.t * PrimH.heap
val compare : t -> t -> int
end =
struct
type t =
| E
| H of Elem.t * PrimH.heap
let compare t1 t2 = match t1, t2 with
| H (x, _), H (y, _) -> Elem.compare x y
| _ -> failwith "unreachable"
end
and PrimH : (HEAP with module Elem = BootstrappedElem) =
MakeH(BootstrappedElem)
type heap
let empty = failwith "not implemented"
let insert = failwith "not implemented"
let find_min = failwith "not implemented"
let delete_min = failwith "not implemented"
end
But this is not compiling! The error message is:
File "ordered.ml", line 52, characters 15-55:
Error: In this `with' constraint, the new definition of Elem
does not match its original definition in the constrained signature:
Modules do not match:
sig type t = BootstrappedElem.t end
is not included in
ORDERED
The field `compare' is required but not provided
The line 52 is the line
and PrimH : (HEAP with module Elem = BootstrappedElem) =
I think BootstrappedElem did implement ORDERED as it has both t and compare, but I failed to see why the compiler fails to find the compare function.
Change the signature of BootstrappedElem to
module rec BootstrappedElem : ORDERED
will make it compiling but this will hide the type constructor E and T in BootstrappedElem to make it impossible to implement the later parts.
The whole non-compiling code can be downloaded at https://raw.github.com/gist/4044281/0ce0336c40b277e59cece43dbadb9b94ce6efdaf/ordered.ml
I believe this might be a bug in the type-checker. I have reduced your code to the following example:
module type ORDERED =
sig
type t
val compare : t -> t -> int
end
module type CARRY = sig
module M : ORDERED
end
(* works *)
module HigherOrderFunctor
(Make : functor (X : ORDERED) -> (CARRY with module M = X))
= struct
module rec Base
: (ORDERED with type t = string)
= String
and Other
: (CARRY with module M = Base)
= Make(Base)
end
(* does not work *)
module HigherOrderFunctor
(Make : functor (X : ORDERED) -> (CARRY with module M = X))
= struct
module rec Base
: sig
(* 'compare' seems dropped from this signature *)
type t = string
val compare : t -> t -> int
end
= String
and Other
: (CARRY with module M = (Base : sig type t = string val compare : t -> t -> int end))
= Make(Base)
end
I don't understand why the first code works and the second (which seems equivalent) doesn't. I suggest you wait a bit to see if an expert comes with an explanation (Andreas?), then consider sending a bug report.
In this case, a solution is to first bind the signature that seems mishandled:
(* works again *)
module HigherOrderFunctor
(Make : functor (X : ORDERED) -> (CARRY with module M = X))
= struct
(* bind the problematic signature first *)
module type S = sig
type t = string
val compare : t -> t -> int
end
module rec Base : S = String
and Other : (CARRY with module M = Base) = Make(Base)
end
However, that is not possible in your setting, because the signature of BootstrappedElem is mutually recursive with BootstrappedHeap.
A workaround is to avoid the apparently-delicate with module ... construct and replace it with a simple type equality with type Elem.t = ...:
module BootstrappedHeap
(MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element)
(Element : ORDERED) : (HEAP with module Elem = Element) =
struct
module Elem = Element
module rec BootstrappedElem :
sig
type t =
| E
| H of Elem.t * PrimH.heap
val compare : t -> t -> int
end =
struct
type t =
| E
| H of Elem.t * PrimH.heap
let compare t1 t2 = match t1, t2 with
| H (x, _), H (y, _) -> Elem.compare x y
| _ -> failwith "unreachable"
end
and PrimH : (HEAP with type Elem.t = BootstrappedElem.t) =
MakeH(BootstrappedElem)
type heap
let empty = failwith "not implemented"
let insert = failwith "not implemented"
let find_min = failwith "not implemented"
let delete_min = failwith "not implemented"
end
You could also avoid the mutual recursion and define both BootstrappedElem and BootstrappedHeap in one recursive knot, by defining BootstrappedElem inside the recursive BootstrappedHeap.
module BootstrappedHeap
(MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element)
(Element : ORDERED) : (HEAP with module Elem = Element) =
struct
module rec BootstrappedHeap : sig
module Elem : sig
type t = E | H of Element.t * BootstrappedHeap.heap
val compare : t -> t -> int
end
include (HEAP with module Elem := Elem)
end = struct
module Elem = struct
type t = E | H of Element.t * BootstrappedHeap.heap
let compare t1 t2 = match t1, t2 with
| H (x, _), H (y, _) -> Element.compare x y
| _ -> failwith "unreachable"
end
include (MakeH(Elem) : HEAP with module Elem := Elem)
end
module Elem = Element
type heap
let empty = failwith "not implemented"
let insert = failwith "not implemented"
let find_min = failwith "not implemented"
let delete_min = failwith "not implemented"
end
This style corresponds naturally to your decision of embedding Elem in the HEAP signature and using with module ... for refinement. Another solution would have been to define HEAP as a functor returning a signature, used as HEAP(Elem).S, and I suppose a different recursive style could have been chosed. Not to say that this would have been better: I think the "abstract module" style is more convenient.

Resources