I am trying to make a function hpure that generates an hvect by repeating the same element until it reaches the required length. Each element may have a different type. Ex: If the argument was show each element would be a specialization of the show function.
hpure show : HVect [Int -> String, String -> String, SomeRandomShowableType -> String]
This is my attempt:
hpure : {outs : Vect k Type} -> ({a : _} -> {auto p : Elem a outs} -> a) -> HVect outs
hpure {outs = []} _ = []
hpure {outs = _ :: _ } v = v :: hpure v
This error occurs on the final v:
When checking an application of Main.hpure:
Unifying len and S len would lead to infinite value
Why does the error occur and how can I fix it?
The issue is that the type of v depends on outs, and the recursive call to hpure passes the tail of outs. So v needs to be adjusted as well.
The error is essentially saying that the lengths of outs and its tail would have to be the same in order for your version to typecheck.
Here is a version that typechecks.
hpure : {outs : Vect k Type} -> ({a : Type} -> {auto p : Elem a outs} -> a) -> HVect outs
hpure {outs = []} _ = []
hpure {outs = _ :: _} v = v Here :: hpure (\p => v (There p))
Related
Sorry I couldn't think of a less confusing way to put this.
I'm trying to build something like a map that can be safely accessed without returning a maybe, because all of its keys are contained in its type and querying for a key that isn't contained in its list of keys will throw a type error.
data SafeMap : (keys : List k) -> Type -> Type where
Nil : SafeMap [] v
(::) : Pair k v -> SafeMap ks v -> SafeMap (newKey :: ks) v
empty : SafeMap Nil v
empty = Nil
add : k -> v -> SafeMap ks v -> SafeMap (k :: ks) v
add k v l = (k,v) :: l
myDict : SafeMap ["test"] Nat
myDict = add "test" 234 Nil
-- ^^^^^^^^^^^^^^^^^^^ error here
The error message is
While processing right hand side of myDict. When unifying:
SafeMap [?k] Nat
and:
SafeMap [fromString "test"] Nat
Mismatch between: Type and String.
Why does it think that ?k is of type Type?
By contrast, if I replace k with an explicit String everything works and there's no type error.
data SafeMap : (keys : List String) -> Type -> Type where
-- ^^^^^^ changed here
Nil : SafeMap [] v
(::) : Pair k v -> SafeMap ks v -> SafeMap (newKey :: ks) v
empty : SafeMap Nil v
empty = Nil
add : (k : String) -> v -> SafeMap ks v -> SafeMap (k :: ks) v
-- ^^^^^^ and here
add k v l = (k,v) :: l
myDict : SafeMap ["test"] Nat
myDict = add "test" 234 Nil
-- No error here! ^
Your mistake is here:
add : k -> v -> SafeMap ks v -> SafeMap (k :: ks) v
You want:
add : (k : _) -> v -> SafeMap ks v -> SafeMap (k :: ks) v
In (v : t) ->, v is the name of an argument of type t.
Faced next problem while reading great Type Driven Development book and trying to implement some small modifications of tasks in it.
module Main
import Data.Vect
%default total
data Forever = More Forever
partial
forever : Forever
forever = More forever
data StackCmd : Type -> (inputHeight : Nat) -> (outputHeight : Nat) -> Type where
Push : Integer -> StackCmd () height (S height)
Pop : StackCmd Integer (S height) height
Top : StackCmd Integer (S height) (S height)
PutStr : String -> StackCmd () h h
PutStrLn : String -> StackCmd () h h
GetStr : StackCmd String h h
Pure : a -> StackCmd a h h
(>>=) : StackCmd a h1 h2 -> (a -> StackCmd b h2 h3) -> StackCmd b h1 h3
runStack : (stck : Vect inH Integer) -> StackCmd ty inH outH -> IO (ty, Vect outH Integer)
runStack stck (Push x) = pure ((), x :: stck)
runStack (x :: xs) Pop = pure (x, xs)
runStack (x :: xs) Top = pure (x, x :: xs)
runStack xs (PutStr str) = do putStr str; pure ((), xs)
runStack xs (PutStrLn str) = do putStrLn str; pure ((), xs)
runStack xs (GetStr) = do str <- getLine; pure (str, xs)
runStack stck (Pure x) = pure (x, stck)
runStack stck (x >>= f) = do (x', stck') <- runStack stck x
runStack stck' (f x')
data StackIO : Nat -> Type where
Do : StackCmd a h1 h2 -> (a -> Inf (StackIO h2)) -> StackIO h1
QuitCmd : (a : Nat) -> StackIO a
namespace StackDo
(>>=) : StackCmd a h1 h2 -> (a -> Inf (StackIO h2)) -> StackIO h1
(>>=) = Do
data Input : Type where
INumber : Integer -> Input
IAdd : Input
IDuplicate : Input
IDiscard : Input
parseInput : String -> Maybe Input
parseInput str =
case str of
"" => Nothing
"add" => Just IAdd
"duplicte" => Just IDuplicate
"discard" => Just IDiscard
_ => if all isDigit $ unpack str then Just (INumber $ cast str) else Nothing
run : Forever -> Vect n Integer -> StackIO n -> IO ()
run _ _ (QuitCmd a) = pure ()
run (More far) stck (Do sa f) = do (a', stck') <- runStack stck sa
run far stck' (f a')
biOp : (Integer -> Integer -> Integer) -> StackCmd String (S (S height)) (S height)
biOp op = do a <- Pop
b <- Pop
let res = a `op` b
Push res
Pure $ show res
discardUnOp : StackCmd String (S height) height
discardUnOp = do v <- Pop
Pure $ "Discarded: " ++ show v
duplicateUnOp : StackCmd String (S height) (S (S height))
duplicateUnOp = do v <- Top
Push v
Pure $ "Duplicated: " ++ show v
mutual
tryBiOp : String -> (Integer -> Integer -> Integer) -> StackIO hin
tryBiOp _ op {hin=S (S k)} = do res <- biOp op
PutStrLn res
stackCalc
tryBiOp opName _ = do PutStrLn $
"Unable to execute operation " ++ opName ++ ": fewer then two items on stack."
stackCalc
tryUnOp : Show a => String -> StackCmd a hIn hOut -> StackIO hIn
tryUnOp _ op {hIn=S h} = do res <- op
PutStrLn $ show res
stackCalc
tryUnOp opName _ = do PutStrLn $
"Unable to execute " ++ opName ++ " operation: no elements on stack."
stackCalc
stackCalc : StackIO height
stackCalc = do PutStr "> "
inp <- GetStr
case parseInput inp of
Nothing => do PutStrLn "invalid input"; stackCalc
(Just (INumber x)) => do Push x; stackCalc
(Just IAdd) => tryBiOp "add" (+)
(Just IDuplicate) => ?holedup
(Just IDiscard) => ?holedisc -- tryUnOp "discard" discardUnOp
partial
main : IO ()
main = run forever [] stackCalc
Code given above is mostly from TDD book. Sorry that its a bit long: it can be compiled. The code is rather straightforward: this is a stack implemented above vector. Then, user can type numbers in command prompt (one per line) and program pushes the numbers on stack. User is also able to call operations, i.e. add. add pops two elements from stack, adds them and pushes the result back on stack. So, add requires at least two numbers to be on stack when it is called.
Please take a look on tryBiOp function. It takes an Integer -> Integer -> Integer (i.e. (+) or (-)) operation as it's argument and returns sequence of StackCmd operations which implements needed action. As a result programmer can write (Just IAdd) => tryBiOp "add" (+) inside stackCalc. This is very close to what I would like to have.
Question. Next thing I would like to do is very the same wrapper (it named tryUnOp) for operations which require one element on stack. And since these operations are not on integers, but on a stack itself (i.e. "duplicate top of stack" or "discard top element") I would like to pass to wrapper the sequence of StackCmd operations instead of Integer -> Integer -> Integer. So, what I would like to gain is
(Just IDuplicate) => tryUnOp "duplicate" $
(do v <- Top
Push v
Pure $ "Duplicated: " ++ show v)
Problem. If you uncomment code in string (Just IDiscard) => ?holedisc -- tryUnOp "discard" discardUnOp (and remove hole), you will see that code can not be compiled. As I see problem is that when I call tryUnOp "discard" discardUnOp Idris can see that tryUnOp's hIn must be of form (S k) because it follows from discardUnOp's type. But stackCalc does not provide such guarantee.
Working solution. It works, but it is essentially the same thing for unary operation as for binary. So, it is not exactly what I would like to have. There is a function which converts name of operation to sequence of stack commands:
data UnaryOperation : Type where
UODup : UnaryOperation
UODisc : UnaryOperation
UnaryOpOutHeight : UnaryOperation -> Nat -> Nat
UnaryOpOutHeight UODup inheightBase = S (S inheightBase)
UnaryOpOutHeight UODisc inheightBase = inheightBase
unaryStackCmd : (op: UnaryOperation) -> StackCmd String (S h) (UnaryOpOutHeight op h)
unaryStackCmd UODup = duplicateUnOp
unaryStackCmd UODisc = discardUnOp
mutual
tryUnOp' : String -> UnaryOperation -> StackIO height
tryUnOp' _ op {height=S h} = do res <- unaryStackCmd op
PutStrLn res
stackCalc
tryUnOp' opName _ = do PutStrLn $
"Unable to execute " ++ opName ++ " operation: no elements on stack."
stackCalc
Any ideas / comments are wellcome!!!
I have the following working function:
unMaybe : (t : Type) -> {auto p : t = Maybe x} -> Type
unMaybe {x} _ = x
This function works fine:
> unMaybe (Maybe Int)
Int
I also have another similar function:
unMaybesA : (ts : Vect n Type) -> {xs : Vect n Type} -> {auto p : map Maybe xs = ts} -> Vect n Type
unMaybesA {xs} _ = xs
Unfortunately the following fails:
> unMaybesA [Maybe Int, Maybe String]
(input):1:1-35:When checking argument p to function Main.unMaybesA:
Can't find a value of type
Data.Vect.Vect n implementation of Prelude.Functor.Functor, method map Maybe
xs =
[Maybe Int, Maybe String]
But the following works:
> unMaybesA {xs=[_,_]} [Maybe Int, Maybe String]
[Int, String]
Is the a way to get Idris to automatically do {xs=[_,_]} with however many _ the vector has?
unMaybesB : (ts : Vect n Type) -> {auto p : (xs : Vect n Type ** map Maybe xs = ts)} -> Vect n Type
unMaybesB {p} _ = fst p
Possibly by using an elaborator script to automatically fill p in the function above?
I have the outline of an elab script below. I just need to figure out how to generate n, ts, and xs from the goal.
helper1 : Vect n Type -> Vect n Type -> Type
helper1 ts xs = (map Maybe xs) = ts
unMaybesC : (ts : Vect n Type) -> {auto p : DPair (Vect n Type) (helper1 ts)} -> Vect n Type
unMaybesC {p} _ = fst p
helper2 : (n : Nat) -> (ts : Vect n Type) -> (xs : Vect n Type) -> helper1 ts xs -> DPair (Vect n Type) (helper1 ts)
helper2 _ _ xs p = MkDPair xs p
q : Elab ()
q = do
let n = the Raw `(2 : Nat)
let ts = the Raw `(with Vect [Maybe String, Maybe Int])
let xs = the Raw `(with Vect [String, Int])
fill `(helper2 ~n ~ts ~xs Refl)
solve
qC : Vect 2 Type
qC = unMaybesC {p=%runElab q} [Maybe String, Maybe Int]
map Maybe xs = ts seems idiomatic, but is quite difficult. If you want to auto search for a non-simple proof, write an explicit proof type. Then the proof search will try the constructors and is guided in the right direction.
data IsMaybes : Vect n Type -> Vect n Type -> Type where
None : IsMaybes [] []
Then : IsMaybes xs ms -> IsMaybes (t :: xs) (Maybe t :: ms)
unMaybes : (ts : Vect n Type) -> {xs : Vect n Type} -> {auto p : IsMaybes xs ts} -> Vect n Type
unMaybes ts {xs} = xs
And with this:
> unMaybes [Maybe Nat, Maybe Int, Maybe (Maybe String)]
[Nat, Int, Maybe String] : Vect 3 Type
Why does I confuse auto? Deleting it makes everything work.
module Main
import Data.Vect
%default total
data LessThan : String -> String -> Type where
D : (x < x' = True) -> LessThan x x'
I : LessThan x x' -> LessThan x' x'' -> LessThan x x'' -- Deleting this line fixes the error
data OrderedStringVect : Vect n String -> Type where
Nil : OrderedStringVect []
OAddF : (x : String) -> OrderedStringVect [] -> OrderedStringVect [x] -- Adding the first element does not require a LT from
OAddO : (x : String) -> OrderedStringVect (x'::xs) -> {auto p : LessThan x x'} -> OrderedStringVect (x :: x' :: xs) -- Adding another element does
data InsertProof : String -> Vect n String -> Type where
IPF : InsertProof n [] -- There is no first element
IPH : LessThan n n' -> InsertProof n (n' :: ns) -- Less the the first element
IPL : LessThan n' n -> InsertProof n ns -> InsertProof n (n' :: ns) -- Greater than the first element
-- Eq is not allowed
insertT : (n : String) -> (ns : Vect m String) -> {auto p : InsertProof n ns} -> Vect (S m) String
insertT {p = IPF} n [] = n :: []
insertT {p = IPH _} n (n'::ns) = n :: n' :: ns
insertT {p = IPL _ _} n (n'::ns) = n' :: insertT n ns
(::) : (n : String) -> OrderedStringVect ns -> {auto p : InsertProof n ns} -> OrderedStringVect (insertT {p=p} n ns)
(::) {p = IPF} n Nil = OAddF n Nil
(::) {p = IPH _} n (OAddF n' []) = OAddO n (OAddF n' [])
(::) {p = IPH _} n (OAddO n' ns) = OAddO n (OAddO n' ns)
(::) {p = IPL _ IPF} n (OAddF n' Nil) = OAddO n' (OAddF n Nil)
(::) {p = IPL _ (IPH _)} n (OAddO n' ns) = OAddO n' (OAddO n ns)
(::) {p = IPL _ (IPL _ _)} n (OAddO n' ns) = OAddO n' (n :: ns)
test : with Main ["foo", "bar", "biz"] = ["bar", "biz", "foo"] -- Prove order does not matter
test = Refl
Error:
Type checking ./main7.idr
main7.idr:32:58-60:When checking right hand side of Main.:: with expected type
OrderedStringVect (insertT n (n' :: x' :: xs))
When checking argument p to Main.:::
Can't find a value of type
InsertProof n (x' :: xs)
main7.idr:34:6:When checking type of Main.test:
Can't disambiguate name: Prelude.List.::, Main.::, Prelude.Stream.::, Data.Vect.::
Edit: I have decided to do something completely different so I no longer need the answer, but would still like to know.
Let's say we have an infinite list:
data InfList : Type -> Type where
(::) : (value : elem) -> Inf (InfList elem) -> InfList elem
And we want to have finite number of its elements:
getPrefix : (count : Nat) -> InfList a -> List a
getPrefix Z _ = []
getPrefix (S k) (value :: xs) = value :: getPrefix k (?rest)
So, what is left:
a : Type
k : Nat
value : a
xs : InfList a
--------------------------------------
rest : InfList a
It turned out that after pattern matching xs become InfList a instead of Inf (InfList a).
Is there a way to have xs delayed?
It seems to be delayed anyway.
If you execute :x getPrefix 10 one with
one : InfList Int
one = 1 :: one
you get 1 :: getPrefix 9 (1 :: Delay one)
I can't find it anymore in the documentation but idris seems to insert Delay automatically.
Just try to add Delay constructor manually. It's removed implicitly.
getPrefix : (count : Nat) -> InfList a -> List a
getPrefix Z _ = []
getPrefix (S k) (value :: Delay xs) = value :: getPrefix k xs