[Haskell-cafe] Manual type-checking in graphs: Avoidable?
Jeffrey Brown
jeffbrown.the at gmail.com
Sat Feb 20 09:46:25 UTC 2016
After further study I believe existentials are not (at least alone) enough
to solve the problem.
They do allow a heterogeneous graph type to be defined and populated:
:set -XExistentialQuantification
import Data.Graph.Inductive
import Data.Maybe as Maybe
data ShowBox = forall s. Show s => SB s
instance Show ShowBox where show (SB x) = "SB: " ++ show x
type ExQuantGraph = Gr ShowBox String
let g = insNode (0, SB 1)
$ insNode (1, SB 'a')
$ empty :: ExQuantGraph
And once you've loaded those ShowBoxes, you can retrieve them:
getSB :: ExQuantGraph -> Node -> ShowBox
getSB g n = Maybe.fromJust $ lab g n
But you can't unwrap them. The following:
getInt :: ShowBox -> Int
getInt (SB i) = i
will not compile, because it cannot infer that i is an Int:
todo/existentials.hs:19:21:
Couldn't match expected type ‘Int’ with actual type ‘s’
‘s’ is a rigid type variable bound by
a pattern with constructor
SB :: forall s. Show s => s -> ShowBox,
in an equation for ‘getInt’
at todo/existentials.hs:19:13
Relevant bindings include
i :: s (bound at todo/existentials.hs:19:16)
In the expression: i
In an equation for ‘getInt’: getInt (SB i) = i
Failed, modules loaded: none.
On Fri, Feb 19, 2016 at 2:12 PM, Gesh <gesh at gesh.uni.cx> wrote:
> On February 19, 2016 10:54:11 PM GMT+02:00, Francesco Ariis <
> fa-ml at ariis.it> wrote:
> >hey Gesh,
> >
> >you are right (not able to compile it atm too, but it looks
> >correct and way elegant).
> >Maybe post it in the Ml to help OP?
> >
> >ciao ciao
> >F
> >
> >
> >On Fri, Feb 19, 2016 at 04:59:56PM +0200, Gesh wrote:
> >> I'm away from compiler at the moment, but...
> >> Shouldn't this work?
> >> > {-# LANGUAGE GADTs #-}
> >> > data NodeS = HamsterS | PersonS
> >> > data NodeP a where
> >> > Hamster :: String -> NodeP HamsterS
> >> > Person :: String -> NodeP PersonS
> >> > data Node = forall a. NodeP a
> >> > type Graph = Gr Node...
> >> > hamsters :: NodeP PersonS -> ...
> >>
> >> Basically the idea of that you reify the choice of constructor to the
> >type level, permitting static restriction of the constructors used.
> >>
> >> HTH,
> >> Gesh
>
> Oops, meant to send to list.
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>
--
Jeffrey Benjamin Brown
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20160220/70a00380/attachment.html>
More information about the Haskell-Cafe
mailing list