Just occurred to me that you can actually do this with a preprocessor.
If we extract the "template" declarations to a separate module, then
it can happen something like this (I have corrected some errors in the
above code):
---- main.hs ----
import Language.Haskell.TH
import QList
import Control.Monad
{-
pretend we had this:
main = do
print (1,2,3)
print (1)
print (1,(2,3))
print ((1,2),3)
- "template_outfix_lparen_rparen_expression" matches normal parens in
the expression context
- we also have a template operator for commas
The rules for the preprocessor are: inputs to the templates are always
wrapped in [| |].
The templates are wrapped in $().
This explains some of the extraneous nesting below (trying to pretend
I'm a machine!)
-}
main = do
print $(
template_outfix_lparen_rparen_expression `fmap` [|
$( comma `fmap` [| 1 |] `ap` (comma `fmap` [| 2 |] `ap` [| 3 |]) )
|])
print $(
template_outfix_lparen_rparen_expression `fmap` [|
$( [| 1 |] )
|])
print $(
template_outfix_lparen_rparen_expression `fmap` [|
$( comma `fmap` [| 1 |] `ap` [|
$(template_outfix_lparen_rparen_expression `fmap` [| $( comma
`fmap` [| 2 |] `ap` [| 3 |]) |] ) |] )
|])
print $(
template_outfix_lparen_rparen_expression `fmap` [|
$( comma `fmap` [| $( template_outfix_lparen_rparen_expression
`fmap` [| $(comma `fmap` [| 1 |] `ap` [| 2 |]) |] ) |]
`ap` [| 3 |] )
|])
---------------------- QList.hs -------------------------------
{-
contains the templates and QList.
(the module created by preprocessor would usually only include
templates, with QList being a helper module)
-}
module QList
where
import Debug.Trace
import Language.Haskell.TH
data QList a = QCons a (QList a) | QNil
comma :: Exp → Exp → Exp
a `comma` b@(AppE (AppE (ConE x) _) _)
| x == qconsName = a `qcons` b
| otherwise = a `qcons` (b `qcons` qnil)
a `comma` b = a `qcons` (b `qcons` qnil)
qnil :: Exp
qnil = ConE (mkName "QNil")
qcons :: Exp → Exp → Exp
a `qcons` b = (ConE (mkName "QCons")) `AppE` a `AppE` b
template_outfix_lparen_rparen_expression :: Exp → Exp
template_outfix_lparen_rparen_expression x = case x of
(AppE (AppE (ConE y) _) _) → if y == qconsName
then TupE $ fromQList x
else x
_ → x
fromQList :: Exp → [Exp]
fromQList (AppE (AppE (ConE c) h) t)
| c == qconsName = h:fromQList t
| otherwise = error "malformed qlist (head)"
fromQList (ConE n)
| n == mkName "QNil" = []
| otherwise = error "malformed qlist (tail)"
qconsName = mkName "QCons"
_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe
