X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=examples%2FDemo.hs;h=0a5e4e48077be405bb2d2498fa96bb46e95418d3;hb=3a2879d925d4e13e9c89bc768df111684d2b4a59;hp=74bbef0ef54ecdd731b6f8e0e1384ebeaae86e33;hpb=15df3430938d7175361b848de6578aea195e612f;p=coq-hetmet.git diff --git a/examples/Demo.hs b/examples/Demo.hs index 74bbef0..0a5e4e4 100644 --- a/examples/Demo.hs +++ b/examples/Demo.hs @@ -1,10 +1,56 @@ -{-# OPTIONS_GHC -XRankNTypes -XScopedTypeVariables -XFlexibleContexts -XModalTypes -XKindSignatures -fcoqpass -XMultiParamTypeClasses -dcore-lint #-} -import GHC.HetMet.GArrow -import GHC.HetMet.CodeTypes -import GHC.HetMet.Private -import GArrowTikZ - -foo x = <[ ~~x ]> -foo' = unG . pga_flatten . foo . pga_unflatten ---foo x z = <[ let y = ~~x in ~~z y y ]> -main = tikz (foo' (PGArrowD { unG = TikZ_const 12 })) +{-# OPTIONS_GHC -XModalTypes -fflatten -funsafe-skolemize -dcore-lint -XScopedTypeVariables #-} +module Demo (demo) where + + +demo const mult = <[ \(y::Int) -> ~~mult y ~~(const 12) ]> +{- +demo const mult = <[ \y -> ~~(demo' 0) ]> + where + demo' 0 = const 4 + demo' n = const 4 +-} +-- demo' n = <[ ~~mult ~~(demo' (n-1)) ~~(demo' (n-1)) ]> + + + +{- +demo const mult = + <[ \y -> let y = ~~(const 4) in ~~mult (~~mult y y) (~~mult y y) ]> +-} + +{- +demo const mult = + <[ \(y::Int) -> + let four = ~~mult four ~~(const 4) +-- twelve = {- {- ~~mult four -} ~~(const 12) -} four + in four + ]> +-} +demo :: + forall c . + (Int -> <[Int]>@c) -> + <[Int -> Int -> Int]>@c -> + <[Int -> Int]>@c + +{- +demo const mult = + <[ let twelve = ~~(const (12::Int)) + in let four = ~~(const (4::Int)) + in ~~mult four twelve ]> +-} +{- +demo const mult = + <[ let twelve = ~~(const (12::Int)) + in let twelvea = twelve + four = ~~(const (4::Int)) + twelveb = twelve + in ~~mult (~~mult twelvea four) (~~mult twelveb twelveb) ]> +-} + +{- +demo const mult = demo' 3 + where + demo' 0 = const 12 + demo' 1 = const 12 + demo' n = <[ ~~mult ~~(demo' (n-1)) ~~(demo' (n-2)) ]> +-} \ No newline at end of file