syntax...(strings/interpolation/here docs)
Malcolm Wallace
Malcolm.Wallace@cs.york.ac.uk
Wed, 13 Feb 2002 13:42:04 +0000
> Does anybody with their elbows in the
> code think variable interpolation and/or
> multi-line strings are good/doable ideas?
> Would this be the sort of change one could make
> without a lot of previous familiarity with
> the implementation of Hugs/Ghc?
I don't think it is really necessary to add the feature to the language,
since you can program something very similar for yourself in user-code.
Here's a sample of a single-character macro expansion within strings,
that took a couple of minutes to write.
module Printf where
import Maybe(fromMaybe)
hereDocument :: (Show a, Show b) => a -> b -> String
hereDocument v w =
"Multi-line string starts here\
\ and uses string gap delimiters.\n\
\ Variable names like $$a are filled in from the\n\
\ bindings specified in the `with` clause,\n\
\ e.g. $$a = $a, $$b = $b\n\
\ and unused bindings pass through e.g. $$c = $c."
`with` [('a',show v), ('b',show w)]
with :: String -> [(Char,String)] -> String
[] `with` env = []
('$':'$':cs) `with` env = '$': cs `with` env
('$':c:cs) `with` env = s ++ cs `with` env
where s = fromMaybe ('$':c:[]) (lookup c env)
(c:cs) `with` env = c : cs `with` env
Regards,
Malcolm