TH problem

"Ch. A. Herrmann" <[email protected]> Tue, 29 Nov 2005 17:54:37 +0100

Newsgroups	gmane.comp.lang.haskell.template
Message-ID	<[email protected]>

Dear TH gurus,

I'm desperately trying to convert the old TH examples to work with ghc-6.4.1
and got stuck with a problem I cannot explain. Although the splice seems
to be correct, the compiler complains about the (:) in the gerated
pattern match.
I appended the source files. They are not very nice right now, because all
guidance I have are the types generated by haddock and all effort I spent
was to make them fit somehow.
Please tell me where the error is and how to proceed or, even
better, please send me the corrected source files back.

Many thanks in advance.

Christoph
----------------------------------------------------------------------------------------
Loading package base-1.0 ... linking ... done.
Compiling Zip              ( ./Zip.hs, interpreted )
Compiling Sel              ( ./Sel.hs, interpreted )
Compiling Main             ( Main.hs, interpreted )
Loading package haskell98-1.0 ... linking ... done.
Loading package haskell-src-1.0 ... linking ... done.
Loading package template-haskell-1.0 ... linking ... done.
Main.hs:16:18:
     Main.hs:16:18-23: Splicing expression
         zipN 3
       ======>
         let
           zp[a4fV] = \ y1 y2 y3
                          -> case (y1, y2, y3) of
                               (x1 : xs1, x2 : xs2, x3 : xs3)
                                 -> ((x1, x2, x3) `GHC.Base.:` (zp[a4fV]
xs1 xs2 xs3))
                               (_, _, _) -> GHC.Base.[]
         in zp[a4fV]
     In the second argument of `($)', namely `$[splice](zipN 3) as bs cs'
     In a 'do' expression: print $ ($[splice](zipN 3) as bs cs)
     In the definition of `main':
         main = do
                  let as = ['a' .. 'e']
                      bs = map toUpper as
                      cs = map ord as
                  print $ ($[splice](zipN 3) as bs cs)
                  let ds = [1 .. ]
                  print $ ($[splice](zipN 4) ds as bs cs)
                  print $ ($[splice](sel 1 3) (2, 'a', 6))

Main.hs:16:18: Not in scope: data constructor `:'

Main.hs:16:18: Not in scope: data constructor `:'

Main.hs:16:18: Not in scope: data constructor `:'
Failed, modules loaded: Sel, Zip.
--
  Christoph

_______________________________________________
template-haskell mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/template-haskell

Sel.hs (text/x-haskell, 534 B)

{-# OPTIONS -fglasgow-exts #-}
module Sel where

import Data.Dynamic
import Language.Haskell.TH

sel :: Int -> Int -> Q Exp
sel i n = lamE [varP (mkName "x")] (caseE (varE (mkName "x")) [alt])
  where alt :: Q Match
        alt = do
               body <- rhs
               pattern <- pat
               return (Match pattern (NormalB body) []) 
 
        pat :: Q Pat
        pat = tupP (map varP as)
 
        rhs :: Q Exp
        rhs = varE (as !! (i-1))
 
        as :: [Name]
        as = [mkName ("a" ++ show j) | j<-[1..n] ]

Zip.hs (text/x-haskell, 1.1 KB)

{-# OPTIONS -fglasgow-exts #-}
module Zip where

import Data.Dynamic
import Language.Haskell.Syntax
import Language.Haskell.TH

zipN :: Int -> Q Exp
zipN n = [| let zp = $(mkZip n [| zp |]) in zp |]

genPE :: String -> Int -> Q ([Pat],[Exp])
genPE s n = let ns = [ mkName (s++(show i)) | i<-[1..n]]
            in do
                ps <- mapM varP ns
                es <- mapM varE ns
                return (ps,es)


apps xs = return $ foldl1 AppE xs


mkZip :: Int -> Q Exp -> Q Exp
mkZip n name = 
    do 
     (pXs,eXs) <- genPE "x" n
     (pYs,eYs) <- genPE "y" n
     (pXSs,eXSs) <- genPE "xs" n
     name' <- name
     let pcons x xs = return $ InfixP x (mkName ":") xs
     m1 <- do
            r <- tupP (zipWith pcons pXs pXSs)
            body <- normalB [| ($(tupE (map return eXs)) : ($(apps(name' : eXSs)))) |]
            return $ Match r body []
     m2 <- do
            b <- normalB [| [] |]
            pat <- tupP (take n (repeat wildP))
            return $ Match pat b []
     lamE (map return pYs) (caseE (tupE (map return eYs)) (map return [m1,m2]))

Main.hs (text/x-haskell, 1.2 KB)

{-# OPTIONS -fglasgow-exts #-}

module Main where

import GHC.Base
import Language.Haskell.TH
import Language.Haskell.Syntax
import Char
import Zip
import Sel

main = do
        let as = ['a'..'e']
            bs = map toUpper as
            cs = map ord as
        print $ $(zipN 3) as bs cs
        let ds = [1..]
        print $ $(zipN 4) ds as bs cs
        print $ $(sel 1 3) (2,'a',6) 
{-



121> a.out
[('a','A',97),('b','B',98),('c','C',99),('d','D',100),('e','E',101)]
[(1,'a','A',97),(2,'b','B',98),(3,'c','C',99),(4,'d','D',100),(5,'e','E',101)]




    zipN 3
  ======>
    let
      zp'0 = \ y1 y2 y3
                 -> case (y1, y2, y3) of
                      (GHC.Base.: x1 xs1, GHC.Base.: x2 xs2, GHC.Base.: x3 xs3)
                        -> ((x1, x2, x3) `GHC.Base.:` (zp'0 xs1 xs2 xs3))
                      (_, _, _) -> GHC.Base.[]
    in zp'0
Main.hs:12: Splicing expression
    zipN 4
  ======>
    let
      zp'1 = \ y1 y2 y3 y4
                 -> case (y1, y2, y3, y4) of
                      (GHC.Base.: x1 xs1, GHC.Base.: x2 xs2, GHC.Base.: x3 xs3, GHC.Base.: x4 xs4)
                        -> ((x1, x2, x3, x4) `GHC.Base.:` (zp'1 xs1 xs2 xs3 xs4))
                      (_, _, _, _) -> GHC.Base.[]
 -}