Bugs item #1194808, was opened at 2005-05-03 15:59 Message generated for change (Tracker Item Submitted) made by Item Submitter You can respond by visiting: https://sourceforge.net/tracker/?func=detail&atid=108032&aid=1194808&group_id=8032
Category: Template Haskell Group: 6.4 Status: Open Resolution: None Priority: 5 Submitted By: Nobody/Anonymous (nobody) Assigned to: Simon Peyton Jones (simonpj) Summary: Template panics the compiler Initial Comment: Experimenting a little with the template example from http://www.haskell.org/ghc/docs/latest/html/users_guide/template-haskell.html i tried to put a small parser into it, and ran into this: ghc --make -fth template.hs -o template Chasing modules from: template.hs Skipping Printf ( ./Printf.hs, ./Printf.o ) Compiling Main ( template.hs, template.o ) Loading package base-1.0 ... linking ... done. Loading package haskell98-1.0 ... linking ... done. Loading package parsec-1.0 ... linking ... done. Loading package template-haskell-1.0 ... linking ... done. ghc: panic! (the `impossible' happened, GHC version 6.4): ./Printf.hs:(40,0)-(42,20): Non-exhaustive patterns in function gen Please report it as a compiler bug to [email protected], or http://sourceforge.net/projects/ghc/. Compilation exited abnormally with code 1 at Wed May 04 00:50:37 I was running on winxp The code was: --template.hs: module Main where import Printf (pr) main = putStrLn ( $(pr "hello")) --Printf.hs: module Printf where -- Skeletal printf from the paper. -- It needs to be in a separate module to the one where -- you intend to use it. -- Import some Template Haskell syntax import Language.Haskell.TH import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Char import Text.ParserCombinators.Parsec.Prim import Text.ParserCombinators.Parsec.Combinator -- Describe a format string data Format = D | S | L String parsePercent = do char '%' k <- oneOf "sd" return (case k of 's' -> S 'd' -> D) parseString = do s <- many (satisfy (/= '%')) return (L s) -- Is not used yet since it doesn't work -- parseFormat' = return many (parsePercent <|> parseString) -- Parse a format string. This is left largely to you -- as we are here interested in building our first ever -- Template Haskell program and not in building printf. parseFormat :: String -> [Format] parseFormat s = case (parse (many parsePercent) [] s) of Left err -> fail "Printf parser error" Right x -> x -- Generate Haskell source code from a parsed representation -- of the format string. This code will be spliced into -- the module which calls "pr", at compile time. gen :: [Format] -> ExpQ gen [D] = [| \n -> show n |] gen [S] = [| \s -> s |] gen [L s] = stringE s -- Here we generate the Haskell code for the splice -- from an input format string. pr :: String -> ExpQ pr s = gen (parseFormat s) ---------------------------------------------------------------------- You can respond by visiting: https://sourceforge.net/tracker/?func=detail&atid=108032&aid=1194808&group_id=8032 _______________________________________________ Glasgow-haskell-bugs mailing list [email protected] http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
