diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,14 @@
+hsc3-rw - hsc3 re-writing
+-------------------------
+
+[hsc3-rw][hsc3-rw] provides re-writing functions for use with [hsc3][hsc3].
+
+- `Sound.SC3.RW.Tag` tags numeric literals with identifiers.
+
+[hsc3]: http://rd.slavepianos.org/?t=hsc3
+[hsc3-rw]: http://rd.slavepianos.org/?t=hsc3-rw
+
+© [rohan drape][rd], 2013, [gpl][gpl].
+
+[rd]: http://rd.slavepianos.org/
+[gpl]: http://gnu.org/copyleft/
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Sound/SC3/RW/HP.hs b/Sound/SC3/RW/HP.hs
new file mode 100644
--- /dev/null
+++ b/Sound/SC3/RW/HP.hs
@@ -0,0 +1,202 @@
+-- | Hash parentheses.  A simple minded haskell pre-processor that
+-- extends the haskell /do/ syntax by rewriting @#@ parenthesised
+-- elements of a right hand side expression as monadic bindings.
+-- The basic pre-processor is 'hp_rewrite'.
+module Sound.SC3.RW.HP where
+
+import Data.Char {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import qualified Data.List.Split as S {- split -}
+import System.Environment {- base -}
+
+import Sound.SC3.RW.HP.Parsec
+
+-- * String
+
+-- | Return indentation of line.
+--
+-- > indent_of "  a <- b" == "  "
+indent_of :: String -> String
+indent_of = takeWhile isSpace
+
+-- | Delete indentation of line.
+--
+-- > remove_indent "  a <- b"  == "a <- b"
+remove_indent :: String -> String
+remove_indent = dropWhile isSpace
+
+-- * List
+
+-- | Variant of 'splitOn' requiring one match only.
+--
+-- > split_on_1 " <- " "  a <- f #(b) #(c)" == Just ("  a","f #(b) #(c)")
+-- > split_on_1 " do " "  let a = do f #(b) #(c)" == Just ("  let a =","f #(b) #(c)")
+split_on_1 :: Eq a => [a] -> [a] -> Maybe ([a],[a])
+split_on_1 p q =
+    case S.splitOn p q of
+      [r,s] -> Just (r,s)
+      _ -> Nothing
+
+-- * Inline do
+
+-- | Split inline /do/ line into separate lines.
+--
+-- > let r = ["  let a = do "
+-- >         ,"             f #(b) #(c)"]
+-- > in hp_remove_inline_do "  let a = do f #(b) #(c)" == r
+hp_remove_inline_do :: String -> [String]
+hp_remove_inline_do s =
+    let q = " do "
+    in case split_on_1 q s of
+         Just (p,r) -> let s0 = p ++ q
+                           s1 = replicate (length s0) ' ' ++ r
+                       in [s0,s1]
+         _ -> [s]
+
+-- * Continuation lines
+
+-- | Return indent of /s/ if it 'has_hash_paren'.
+--
+-- > hp_indent "  a <- f #(b) #(c)" == Just 2
+hp_indent :: String -> Maybe Int
+hp_indent s =
+    if has_hash_paren s
+    then Just (length (indent_of s))
+    else Nothing
+
+-- | Note which lines are /continued/ hash parenethsis lines.
+--
+-- > hp_non_inline ["f = do"
+-- >               ,"  a #(b)"
+-- >               ,"    #(c)"
+-- >               ,"    #(d)"
+-- >               ,"  p #(q) #(r)"] == [False,False,True,True,False]
+hp_non_inline :: [String] -> [Bool]
+hp_non_inline l =
+    let f (o,n') n = case (n',n) of
+                       (Just x',Just x) -> case compare x x' of
+                                             LT -> ((False,n),False)
+                                             EQ -> ((o,n),o)
+                                             GT -> ((True,n),True)
+                       _ -> ((False,n),False)
+    in snd (mapAccumL f (False,Nothing) (map hp_indent l))
+
+-- | Re-layout to put broken /hash parenthesis/ lines onto one line.
+--
+-- > let r = ["f = do"
+-- >         ,"  a #(b) #(c) #(d)"
+-- >         ,"  p #(q) #(r)"]
+-- > in hp_uncontinue ["f = do"
+-- >                  ,"  a #(b)"
+-- >                  ,"    #(c)"
+-- >                  ,"    #(d)"
+-- >                  ,"  p #(q) #(r)"] == r
+hp_uncontinue :: [String] -> [String]
+hp_uncontinue l =
+    let f st (e,c,k) = let e' = if c then ' ' : remove_indent e else e
+                       in if k
+                          then (st ++ e',Nothing)
+                          else ("",Just (st ++ e'))
+        i = hp_non_inline l
+        (z,l') = mapAccumL f "" (zip3 l i (tail i ++ [False]))
+        z' = if null z then [] else [z]
+    in catMaybes l' ++ z'
+
+-- * Hash Parentheses
+
+-- | Name supply for introduced variables.
+--
+-- > hp_names !! 9 == "_hp_9"
+hp_names :: Name_Supply
+hp_names = map (\n -> "_hp_" ++ show n) [0::Integer ..]
+
+-- | Does /s/ have a /hash parenthesis/ expression.
+--
+-- > has_hash_paren "  a <- f #(b) #(c)" == True
+has_hash_paren :: String -> Bool
+has_hash_paren = isInfixOf "#("
+
+-- | Process one line of /hash-parenthesis/ re-writes.
+hp_analyse :: Name_Supply -> String -> (Name_Supply,([Binding],HP))
+hp_analyse nm =
+    let rec n b s = case hp_do_next_binding n s of
+                      Nothing -> (n,(reverse b,s))
+                      Just (n',b',s') -> rec n' (b':b) s'
+    in rec nm [] . hp_parse
+
+-- | Variant of 'hp_analyse' for examining intermediate state.
+--
+-- > let r = ([("_hp_0","b"),("_hp_1","c (d e)")],"  a <- f _hp_0 _hp_1")
+-- > in hp_analyse' hp_names "  a <- f #(b) #(c (d e))" == r
+--
+-- > let r = ([("_hp_0","a")],"  return (f _hp_0)")
+-- > in hp_analyse' hp_names "  return (f #(a))" == r
+--
+-- > let r = ([("_hp_0","a"),("_hp_1","d e"),("_hp_2","c _hp_1 f"),("_hp_3","b _hp_2 g")]
+-- >         ,"c <- f (_hp_0,_hp_3) h")
+-- > in hp_analyse' hp_names "c <- f (#(a),#(b #(c #(d e) f) g)) h" == r
+--
+-- > let r = ([("_hp_0","v w")],"  return (h (_hp_0 * 2))")
+-- > in hp_analyse' hp_names "  return (h (#(v w) * 2))" == r
+hp_analyse' :: Name_Supply -> String -> ([Binding],String)
+hp_analyse' nm s =
+    let (_,(n,h)) = hp_analyse nm s
+    in (n,hp_print h)
+
+-- | Re-construct 'hp_analyse' output.
+hp_build :: ([Binding],HP) -> [String]
+hp_build (b,e) =
+    let e' = hp_print e
+        f (i,j) = concat [i," <- ",j]
+        ind = indent_of e'
+        b' = map ((ind ++) . f) b
+    in b' ++ [e']
+
+-- | Process a line for /hash parentheses/.
+hp_process :: Name_Supply -> String -> (Name_Supply, [String])
+hp_process n s =
+    if has_hash_paren s
+    then let (n',r) = hp_analyse n s
+             r' = hp_build r
+         in (n',r')
+    else (n,[s])
+
+-- | Run /hash parenthesis/ rewriter.
+--
+-- > let {i = ["main = do"
+-- >          ,"  let a = f #(b) (#(c) * 2)"
+-- >          ,"  d <- e"
+-- >          ,"  p <- g #(q r)"
+-- >          ,"         #(s #(t u))"
+-- >          ,"  return (h (#(v w) * 2))"]
+-- >     ;r = ["main = do"
+-- >          ,"  _hp_0 <- b"
+-- >          ,"  _hp_1 <- c"
+-- >          ,"  let a = f _hp_0 (_hp_1 * 2)"
+-- >          ,"  d <- e"
+-- >          ,"  _hp_2 <- q r"
+-- >          ,"  _hp_3 <- t u"
+-- >          ,"  _hp_4 <- s _hp_3"
+-- >          ,"  p <- g _hp_2 _hp_4"
+-- >          ,"  _hp_5 <- v w"
+-- >          ,"  return (h (_hp_5 * 2))"]}
+-- > in hp_rewrite i == r
+hp_rewrite :: [String] -> [String]
+hp_rewrite =
+    concat .
+    snd .
+    mapAccumL hp_process hp_names .
+    concatMap hp_remove_inline_do .
+    hp_uncontinue
+
+-- | Arguments as required by @ghc -F -pgmF@.
+hp_rewrite_ghcF :: IO ()
+hp_rewrite_ghcF = do
+  a <- getArgs
+  case a of
+    [_,i_fn,o_fn] -> do
+           i <- readFile i_fn
+           let f = unlines . hp_rewrite . lines
+           writeFile o_fn (f i)
+    _ -> error "initial-file input-file output-file"
diff --git a/Sound/SC3/RW/HP/Parsec.hs b/Sound/SC3/RW/HP/Parsec.hs
new file mode 100644
--- /dev/null
+++ b/Sound/SC3/RW/HP/Parsec.hs
@@ -0,0 +1,111 @@
+module Sound.SC3.RW.HP.Parsec where
+
+import Text.ParserCombinators.Parsec {- parsec -}
+
+data HP = S String | H HP | J HP HP deriving (Eq,Show)
+
+type Binding = (String,String)
+type Name_Supply = [String]
+
+-- | Simplifying constructor (do not use 'J' directly).
+hp_cons :: HP -> HP -> HP
+hp_cons p q =
+    case (p,q) of
+      (S s1,S s2) -> S (s1 ++ s2)
+      (S s1,J (S s2) r) -> S (s1 ++ s2) `hp_cons` r
+      (J l r,_) -> l `hp_cons` (r `hp_cons` q)
+      _ -> J p q
+
+from_list1 :: [HP] -> HP
+from_list1 l =
+    case l of
+      [] -> error "from_list1: []"
+      [h] -> h
+      p:l' -> p `hp_cons` (from_list1 l')
+
+hp_parser :: Parser HP
+hp_parser =
+    let p_node l = from_list1 [S "(",from_list1 l,S ")"]
+        in_paren = between (char '(') (char ')')
+        s = fmap S (many1 (noneOf "#()"))
+        p = fmap p_node (in_paren (many1 hp_parser))
+        h = char '#' >> fmap (H . from_list1) (in_paren (many1 hp_parser))
+    in fmap from_list1 (many1 (choice [h,p,s]))
+
+-- > hp_parse "a"
+-- > hp_parse "a b"
+-- > hp_parse "a (b c)"
+-- > hp_parse "a #(b (#(c d) e))"
+-- > hp_parse "c <- f (#(a),#(b #(c #(d e) f) g)) h"
+-- > let r = hp_parse "c <- f (#(a),#(b #(c #(d e) f) g)) h"
+-- > hp_print r
+hp_parse :: String -> HP
+hp_parse s =
+    case parse hp_parser "" s of
+      Right t -> hp_simplify t
+      Left e -> error (show e)
+
+hp_print :: HP -> String
+hp_print h =
+    case h of
+      S s -> s
+      H h' -> "#(" ++ hp_print h' ++ ")"
+      J p q -> hp_print p ++ hp_print q
+
+-- > let r = hp_parse "c <- f (a,#(b #(c de f) g)) h"
+-- > in hp_simplify r
+hp_simplify :: HP -> HP
+hp_simplify h =
+    case h of
+      S s -> S s
+      H (S s) -> H (S s)
+      J (S _) (S _) -> error "J S S"
+      J (S _) (J (S _) _) -> error "J S (J S ..)"
+      J (J _ _) _ -> error "J (J .. ..) .."
+      J p q -> let (p',q') = (hp_simplify p,hp_simplify q)
+               in if p /= p' || q /= q'
+                  then hp_simplify (p' `hp_cons` q')
+                  else p `hp_cons` q
+      H h' -> let h'' = hp_simplify h'
+              in if h' /= h'' then hp_simplify (H h'') else H h'
+
+next_nm :: Name_Supply -> (String,Name_Supply)
+next_nm nm =
+    case nm of
+      n:nm' -> (n,nm')
+      _ -> error "next_nm"
+
+-- > let r = hp_parse "c <- f (#(a),#(b #(c #(d e) f) g)) h"
+-- > in hp_find_next_binding ["_hp_0"] r
+--
+-- > let r = hp_parse "c <- f (_hp_0,#(b #(c _hp_1 f) g)) h"
+-- > in hp_find_next_binding ["_hp_2"] r
+hp_find_next_binding :: Name_Supply -> HP -> Maybe (Name_Supply,Binding)
+hp_find_next_binding nm h =
+    let (n,nm') = next_nm nm
+    in case h of
+         S _ -> Nothing
+         H (S s) -> Just (nm',(n,s))
+         H h' -> hp_find_next_binding nm h'
+         J l r -> maybe
+                  (hp_find_next_binding nm r)
+                  Just
+                  (hp_find_next_binding nm l)
+
+-- > let r = hp_parse "c <- f (#(a),#(b #(c #(d e) f) g)) h"
+-- > in hp_print (hp_simplify (hp_replace ("_hp_0","a") r))
+hp_replace :: Binding -> HP -> HP
+hp_replace (p,q) h =
+    case h of
+      S _ -> h
+      H (S s) -> if s == q then S p else h
+      H h' -> H (hp_replace (p,q) h')
+      J l r -> let l' = hp_replace (p,q) l
+               in if l /= l'
+                  then l' `hp_cons` r
+                  else l `hp_cons` hp_replace (p,q) r
+
+hp_do_next_binding :: Name_Supply -> HP -> Maybe (Name_Supply,Binding,HP)
+hp_do_next_binding nm h =
+    let f (nm',b) = (nm',b,hp_simplify (hp_replace b h))
+    in fmap f (hp_find_next_binding nm h)
diff --git a/Sound/SC3/RW/HP/Polyparse.hs b/Sound/SC3/RW/HP/Polyparse.hs
new file mode 100644
--- /dev/null
+++ b/Sound/SC3/RW/HP/Polyparse.hs
@@ -0,0 +1,99 @@
+module Sound.SC3.RW.HP.Polyparse where
+
+import Data.Function
+import Data.List
+import Data.Maybe
+import Text.ParserCombinators.Poly.State {- polyparse -}
+
+type Binding = (String,String)
+type Name_Supply = [String]
+
+type HP_Char = (Char,Maybe Int)
+type HP_String = [HP_Char]
+
+type ST = (Int,[Int])
+type HP = Parser ST Char
+
+hp_st :: ST
+hp_st = (0,[])
+
+safe_head :: [a] -> Maybe a
+safe_head l =
+    case l of
+      [] -> Nothing
+      e:_ -> Just e
+
+-- | Only count parens in #().
+hp_next :: HP (Char,Maybe Int)
+hp_next = do
+  let stPut st = stUpdate (const st)
+  c <- next
+  (n,h) <- stGet
+  case c of
+    '#' -> stPut (n,n : h) >> return (c,Just n)
+    '(' -> stPut (if null h then (n,h) else (n + 1,h)) >> return (c,safe_head h)
+    ')' -> let n' = n - 1
+               (st',e) = case h of
+                           [] -> ((n,[]),Nothing)
+                           x:h' -> if x == n'
+                                   then ((n',h'),Just x)
+                                   else ((n',h),safe_head h)
+           in stPut st' >> return (c,e)
+    _ -> return (c,safe_head h)
+
+-- > runParser hp_hash_paren hp_st "r <- #(a)"
+-- > runParser hp_hash_paren hp_st "#(a (b)) (c (d))"
+-- > runParser hp_hash_paren hp_st "#(a (b) (c (d)))"
+-- > runParser hp_hash_paren hp_st "#a"
+-- > runParser hp_hash_paren hp_st "a"
+-- > runParser hp_hash_paren hp_st "c <- f #(a) #(b c) d"
+-- > runParser hp_hash_paren hp_st "c <- f #(a) #(b #(c)) d"
+-- > runParser hp_hash_paren hp_st "c <- f #(a) #(b #(c #(d e) f) #(g)) #(h) i"
+hp_hash_paren :: HP HP_String
+hp_hash_paren = many1 hp_next
+
+-- > hp_parse "c <- f #(a) #(b #(c #(d e) f) g) h"
+hp_parse :: String -> HP_String
+hp_parse s =
+    case runParser hp_hash_paren hp_st s of
+      (Right r,(0,[]),[]) -> r
+      _ -> error "hp_parse"
+
+-- | Left biased 'max' variant.
+--
+-- > max_by last "cat" "mouse" == "cat"
+-- > max_by last "aa" "za" == "aa"
+max_by :: Ord a => (t -> a) -> t -> t -> t
+max_by f p q = if f q > f p then q else p
+
+-- > replace_first 1 (-1) [-2,1,0,1] == [-2 .. 1]
+replace_first :: Eq a => a -> a -> [a] -> [a]
+replace_first p q =
+    let rec r l = case l of
+                  [] -> reverse r
+                  e:l' -> if e == p then reverse (q : r) ++ l' else rec (e : r) l'
+    in rec []
+
+-- > un_hash_paren "#(a)" == "a"
+-- > un_hash_paren "b" == "b"
+un_hash_paren :: String -> String
+un_hash_paren s =
+    let f = reverse . drop 1 . reverse
+    in case s of
+         '#' : '(' : s' -> f s'
+         _ -> s
+
+hp_next_binding :: Name_Supply -> HP_String -> Maybe (Name_Supply,Binding,HP_String)
+hp_next_binding n s =
+    if null s || all ((== Nothing) . snd) s
+    then Nothing
+    else let nm:n' = n
+             s' = groupBy ((==) `on` snd) s
+             e = foldl1 (max_by (fromMaybe (-1) . snd . head)) s'
+             x = fromJust (snd (head e)) - 1
+             x' = if x >= 0 then Just x else Nothing
+             s'' = replace_first e (map (\c -> (c,x')) nm) s'
+         in Just (n',(nm,un_hash_paren (map fst e)),concat s'')
+
+hp_print :: HP_String -> String
+hp_print = map fst
diff --git a/Sound/SC3/RW/ID.hs b/Sound/SC3/RW/ID.hs
new file mode 100644
--- /dev/null
+++ b/Sound/SC3/RW/ID.hs
@@ -0,0 +1,100 @@
+-- | Rewrite character ifdentifiers for @UGen.ID@ graphs.
+module Sound.SC3.RW.ID where
+
+import Data.Char {- base -}
+import System.Directory {- directory -}
+
+-- * Greek letters
+
+-- | Table of greek letters (upper-case,lower-case,name).
+--
+-- > length greek_letters == 24
+-- > (['Α' .. 'Ρ'] ++ ['Σ' .. 'Ω']) == map (\(c,_,_) -> c) greek_letters
+-- > (['α' .. 'ρ'] ++ ['σ' .. 'ω']) == map (\(_,c,_) -> c) greek_letters
+greek_letters :: [(Char,Char,String)]
+greek_letters =
+    [('Α','α',"Alpha")
+    ,('Β','β',"Beta")
+    ,('Γ','γ',"Gamma")
+    ,('Δ','δ',"Delta")
+    ,('Ε','ε',"Epsilon")
+    ,('Ζ','ζ',"Zeta")
+    ,('Η','η',"Eta")
+    ,('Θ','θ',"Theta")
+    ,('Ι','ι',"Iota")
+    ,('Κ','κ',"Kappa")
+    ,('Λ','λ',"Lambda")
+    ,('Μ','μ',"Mu")
+    ,('Ν','ν',"Nu")
+    ,('Ξ','ξ',"Xi")
+    ,('Ο','ο',"Omicron")
+    ,('Π','π',"Pi")
+    ,('Ρ','ρ',"Rho")
+    ,('Σ','σ',"Sigma")
+    ,('Τ','τ',"Tau")
+    ,('Υ','υ',"Upsilon")
+    ,('Φ','φ',"Phi")
+    ,('Χ','χ',"Chi")
+    ,('Ψ','ψ',"Psi")
+    ,('Ω','ω',"Omega")]
+
+-- | Indefinite sequence of character identifiers.
+type Name_Supply = [Char]
+
+-- | 'greek_letters' as 'Name_Supply'.
+--
+-- > take 4 greek_letters_nm == ['α' .. 'δ']
+greek_letters_nm :: Name_Supply
+greek_letters_nm =
+    let uc = map (\(c,_,_) -> c) greek_letters
+        lc = map (\(_,c,_) -> c) greek_letters
+    in lc ++ uc
+
+-- * Rewriters
+
+-- | Rewrite each haskell /letter/ character literal at string /l/
+-- with values from the character supply /s/.
+--
+-- > rewrite ['α'..] "'a',' ',foldl','a'" == "'α',' ',foldl','β'"
+rewrite :: Name_Supply -> String -> String
+rewrite s l =
+    case s of
+      k:s' -> case l of
+                [] -> []
+                '\'' : c : '\'' : l' ->
+                    if isLetter c
+                    then '\'' : k : '\'' : rewrite s' l'
+                    else '\'' : c : rewrite s ('\'' : l')
+                c : l' -> c : rewrite s l'
+      _ -> undefined
+
+-- | 'rewrite' 'greek_letters_nm'.
+--
+-- > hsc3_id_rewrite "'a','.','a'" == "'α','.','β'"
+hsc3_id_rewrite :: String -> String
+hsc3_id_rewrite = rewrite greek_letters_nm
+
+-- | 'rewrite' 'repeat' @α@.
+--
+-- > hsc3_id_clear "'α','.','β'" == "'α','.','α'"
+hsc3_id_clear :: String -> String
+hsc3_id_clear = rewrite (repeat 'α')
+
+-- * IO
+
+-- | File based (haskell pre-processor) variant of 'hsc3_id_rewrite'.
+hsc3_id_rewrite_preprocessor :: FilePath -> FilePath -> FilePath -> IO ()
+hsc3_id_rewrite_preprocessor _ i_fn o_fn = do
+  s <- readFile i_fn
+  writeFile o_fn (hsc3_id_rewrite s)
+
+-- | File based (inplace) variant of 'hsc3_id_rewrite'.  Copies file
+-- to @~@ suffix and replaces initial file.
+--
+-- > let fn = "/home/rohan/sw/hsc3-graphs/gr/resonant-dust.hs"
+-- > in hsc3_id_rewrite_file fn
+hsc3_id_rewrite_inplace :: FilePath -> IO ()
+hsc3_id_rewrite_inplace fn = do
+  let fn' = fn ++ "~"
+  copyFile fn fn'
+  hsc3_id_rewrite_preprocessor fn fn' fn
diff --git a/Sound/SC3/RW/Tag.hs b/Sound/SC3/RW/Tag.hs
new file mode 100644
--- /dev/null
+++ b/Sound/SC3/RW/Tag.hs
@@ -0,0 +1,208 @@
+-- | Rewrite expressions and modules attaching tags to numeric literals.
+module Sound.SC3.RW.Tag where
+
+import Control.Monad.Trans.State {- transformers -}
+import Data.Functor.Identity {- transformers -}
+import Data.Generics {- syb -}
+import Language.Haskell.Exts {- haskell-src-exts -}
+
+-- | Make 'Var' 'Exp' for 'String'.
+--
+-- > mk_var "tag" == Var (UnQual (Ident "tag"))
+mk_var :: String -> Exp
+mk_var = Var . UnQual . Ident
+
+-- | Make 'String' 'Lit'.
+--
+-- > mk_str_lit "c1" == Lit (String "c1")
+mk_str_lit :: String -> Exp
+mk_str_lit = Lit . String
+
+-- | Make 'Int' 'Lit'.
+mk_int_lit :: Integral n => n -> Exp
+mk_int_lit = Lit . Int .toInteger
+
+-- | Make 'Frac' 'Lit'.
+mk_frac_lit :: Real n => n -> Exp
+mk_frac_lit = Lit . Frac . toRational
+
+-- | Numeric literal at 'Exp' else 'Nothing'
+exp_num_lit :: Exp -> Maybe Literal
+exp_num_lit e =
+    case e of
+      Lit (Int n) -> Just (Int n)
+      Lit (Frac n) -> Just (Frac n)
+      _ -> Nothing
+
+-- | Tag an 'Exp' with 'String'.
+tag_exp :: String -> Exp -> Exp
+tag_exp k e = (mk_var "tag" `App` mk_str_lit k) `App` e
+
+-- | Apply /f/ at 'Exp' /e/ if it is tagged, else /g/.  If the tag is
+-- within a 'Paren' then it is discarded.
+at_tagged :: (String -> Exp -> Exp) -> (Exp -> Exp) -> Exp -> Exp
+at_tagged f g e =
+    case e of
+      Paren e' -> at_tagged f (Paren . g) e'
+      App (App (Var (UnQual (Ident "tag"))) (Lit (String k))) e' -> f k e'
+      _ -> g e
+
+-- | Inverse of 'tag_exp'.
+--
+-- > let z = mk_int_lit (0::Integer)
+-- > in untag_exp (Paren (tag_exp "c1" z)) == z
+untag_exp :: Exp -> Exp
+untag_exp = at_tagged (\_ e -> e) id
+
+-- | Empty source location.
+nil_src_loc :: SrcLoc
+nil_src_loc = SrcLoc "" 0 0
+
+mk_span_id :: String -> [Exp] -> Exp
+mk_span_id k =
+    let nm = XName "span"
+        cl_a = XAttr (XName "class") (mk_str_lit "numeric-literal")
+        id_a = XAttr (XName "id") (mk_str_lit k)
+    in XTag nil_src_loc nm [cl_a,id_a] Nothing
+
+-- > let {e = tag_exp "c1" (mk_int_lit 0)
+-- >     ;r = "<span class = \"numeric-literal\" id = \"c1\" >0</span >"}
+-- > in prettyPrint (tag_to_span (Paren e)) == r
+tag_to_span :: Exp -> Exp
+tag_to_span =
+    let f k e = mk_span_id k [e]
+    in at_tagged f id
+
+-- | Variant of 'tag_exp' that derives the the tag name using a
+-- 'State' counter.
+tag_exp_auto :: Exp -> State Int Exp
+tag_exp_auto e = do
+  i <- get
+  let k = 'c' : show i
+  put (i + 1)
+  return (tag_exp k e)
+
+span_exp_auto :: Exp -> State Int Exp
+span_exp_auto e = do
+  i <- get
+  let k = 'c' : show i
+  put (i + 1)
+  return (mk_span_id k [e])
+
+-- | Apply /f/ at numeric literals, else /g/.
+at_num_lit :: (Exp -> t) -> (Exp -> t) -> Exp -> t
+at_num_lit f g e =
+    case e of
+      Lit (Int _) -> f e
+      Lit (Frac _) -> f e
+      _ -> g e
+
+-- | 'at_num_lit' of 'tag_exp_auto'.
+tag_num_lit :: Exp -> State Int Exp
+tag_num_lit = at_num_lit tag_exp_auto return
+
+-- | 'at_num_lit' of 'tag_exp_auto'.
+span_num_lit :: Exp -> State Int Exp
+span_num_lit = at_num_lit span_exp_auto return
+
+type Parser r = String -> ParseResult r
+type RW t m a = t -> m a
+type RW_st t a = t -> State Int a
+type Tr = String -> String
+type Tr_m m = String -> m String
+type RW_Opt = (PPLayout,Int)
+
+-- | Parse 'String' using 'Parser' and apply 'RW'.
+apply_rw :: (Monad m,Pretty a) => RW_Opt -> Parser t -> RW t m a -> Tr_m m
+apply_rw (l,w) p f s = do
+  let m = defaultMode {layout = l}
+      r = fromParseResult (p s)
+      sty = Style {mode = PageMode,lineLength = w,ribbonsPerLine = 1}
+  r' <- f r
+  return (prettyPrintStyleMode sty m r')
+
+apply_rw_pure :: Pretty a => RW_Opt -> Parser t -> (t -> a) -> Tr
+apply_rw_pure o p f = runIdentity . apply_rw o p (return . f)
+
+apply_rw_st :: Pretty a => RW_Opt -> Parser t -> RW_st t a -> Tr
+apply_rw_st o p f = flip evalState 1 . apply_rw o p f
+
+-- | Rewrite 'Exp'.
+--
+-- > let r = "sinOsc AR (tag \"c1\" 440) (tag \"c2\" 0) * tag \"c3\" 0.1"
+-- > in exp_rw "sinOsc AR 440 0 * 0.1" == r
+exp_rw :: String -> String
+exp_rw =
+    let f = everywhereM (mkM tag_num_lit)
+    in apply_rw_st (PPNoLayout,80) parseExp f
+
+-- | Rewrite 'Module'.
+--
+-- > let m = ["import Sound.SC3"
+-- >         ,"o = sinOsc AR (midiCPS 65.00) 0.00"
+-- >         ,"a = dbAmp (-12.00)"
+-- >         ,"main = audition (out 0.00 (o * a))"]
+-- > in module_rw (unlines m)
+module_rw :: String -> String
+module_rw =
+    let f = everywhereM (mkM tag_num_lit)
+    in apply_rw_st (PPNoLayout,80) parseModule f
+
+-- | Inverse of 'exp_rw'.
+exp_un_rw :: String -> String
+exp_un_rw =
+    let f = everywhere (mkT untag_exp)
+    in apply_rw_pure (PPNoLayout,80) parseExp f
+
+-- | 'RW_Opt' for html.  The /span/ code generates long lines...
+rw_html_opt :: RW_Opt
+rw_html_opt = (PPOffsideRule,640)
+
+-- | Transform re-written form to @HTML@.
+--
+-- > let e = "sinOsc AR 440 0 * 0.1"
+-- > in exp_rw_html (exp_rw e)
+exp_rw_html :: String -> String
+exp_rw_html =
+    let f = everywhere' (mkT tag_to_span)
+    in apply_rw_pure rw_html_opt parseExp f
+
+-- | 'Module' variant of 'exp_rw_html'.
+--
+-- > let m = "o = sinOsc AR 440 0 * 0.1\nmain = audition (out 0 o)"
+-- > in module_rw_html (module_rw m)
+module_rw_html :: String -> String
+module_rw_html =
+    let f = everywhere' (mkT tag_to_span)
+    in apply_rw_pure rw_html_opt parseModule f
+
+-- > exp_html "sinOsc AR 440 0 * 0.1"
+exp_html :: String -> String
+exp_html =
+    let f = everywhereM (mkM span_num_lit)
+    in apply_rw_st rw_html_opt parseExp f
+
+-- > module_html "o = sinOsc AR 440 0 * 0.1;main = audition (out 0 o)"
+module_html :: String -> String
+module_html =
+    let f = everywhereM (mkM span_num_lit)
+    in apply_rw_st rw_html_opt parseModule f
+
+-- > let e = "let o = sinOsc AR 440 0 * 0.1 in audition (out 0.00 o)"
+-- > in putStrLn (html_framework "/home/rohan/sw/hosc-utils" (exp_html e))
+html_framework :: String -> String -> String
+html_framework d m =
+    unlines
+    ["<!DOCTYPE html>"
+    ,"<html>"
+    ," <head>"
+    ,"  <script src=\"" ++ d ++ "/js/json-ws.04.js\"></script>"
+    ,"  <link rel=\"stylesheet\" href=\"" ++ d ++ "/css/json-ws.04.css\" />"
+    ," </head>"
+    ," <body>"
+    ,"  <pre>"
+    ,m
+    ,"  </pre>"
+    ,"  <p id=\"sent\">[]</p>"
+    ," </body>"
+    ,"</html>"]
diff --git a/hsc3-rw.cabal b/hsc3-rw.cabal
new file mode 100644
--- /dev/null
+++ b/hsc3-rw.cabal
@@ -0,0 +1,36 @@
+Name:              hsc3-rw
+Version:           0.14
+Synopsis:          hsc3 re-writing
+Description:       hsc3 re-writing
+License:           GPL
+Category:          Sound
+Copyright:         (c) Rohan Drape and others, 2013
+Author:            Rohan Drape
+Maintainer:        rd@slavepianos.org
+Stability:         Experimental
+Homepage:          http://rd.slavepianos.org/?t=hsc3-rw
+Tested-With:       GHC == 7.6.1
+Build-Type:        Simple
+Cabal-Version:     >= 1.8
+
+Data-files:        README
+
+Library
+  Build-Depends:   base == 4.*,
+                   directory,
+                   parsec,
+                   polyparse,
+                   split,
+                   syb,
+                   transformers,
+                   haskell-src-exts
+  GHC-Options:     -Wall -fwarn-tabs
+  Exposed-modules: Sound.SC3.RW.HP
+                   Sound.SC3.RW.HP.Parsec
+                   Sound.SC3.RW.HP.Polyparse
+                   Sound.SC3.RW.ID
+                   Sound.SC3.RW.Tag
+
+Source-Repository  head
+  Type:            darcs
+  Location:        http://rd.slavepianos.org/sw/hsc3-rw