module verbalize-sdf
imports
  AsFix
  Sdf2

strategies

  syms2strs =
    filter(sym2strs)
    ; concat

  sym2strs =
    Sym2Strs
    ; map(try(toAlphaNum))

  sym2str =
    sym2strs
    ; concat-strings

  /**
   * Same as sym2str, except literals and labels are ignored)
   */
  sym2str' =
    Sym2Strs'
    ; map(toAlphaNum <+ id)
    ; concat-strings
    ; not(?"")

  lits2strs =
    filter(lit2str)

  lit2str =
    list-ana(Lit2Str)
    ; separate-by(!"-")
    ; concat-strings
    ; try(toAlphaNum)


  Lit2Str :
    lit(str) -> <try(un-double-quote;unescape)> str

strategies

  Sym2Strs = rec x( 
    \ cf(sym)			-> <x> sym \
  + \ lex(sym)			-> <x> sym \
  + \ empty()			-> ["unit"] \
  + \ seq(s,ss)			-> <filter(x);concat>Cons(s,ss) \
  + \ opt(sym)			-> <x;at-end(!["opt"])> sym \
  + \ iter(sym)			-> <x;at-end(!["p"])> sym \
  + \ iter-star(sym)		-> <x;at-end(!["s"])> sym \
  + \ iter-sep(sym,sep)		-> <concat>[<x>sym,<x>sep,["p"]] \
  + \ iter-star-sep(sym,sep)	-> <concat>[<x>sym,<x>sep,["s"]] \
  + \ func(ss,s)		-> <concat>[<filter(x);concat>ss,["to"],<x>s] \
  + \ alt(s1,s2)		-> <concat>[<x>s1,["or"],<x>s2] \
  + \ sort(str)			-> [str] \
  + \ lit(str)			-> [<try(un-double-quote;unescape)>str] \
  + \ label(str,_)		-> [<try(un-double-quote;unescape)>str] \
  + \ layout			-> ["LAYOUT"] \
  )

  /**
   * Same as Sym2Strs, except that literals and labels are ignored
   */
  Sym2Strs' = rec x(
    \ cf(sym)			-> <x> sym \
  + \ lex(sym)			-> <x> sym \
  + \ empty()			-> ["unit"] \
  + \ seq(s,ss)			-> <filter(x);concat>Cons(s,ss) \
  + \ opt(sym)			-> <x;at-end(!["opt"])> sym \
  + \ iter(sym)			-> <x;at-end(!["p"])> sym \
  + \ iter-star(sym)		-> <x;at-end(!["s"])> sym \
  + \ iter-sep(sym,sep)		-> <concat>[<x>sym,<x>sep,["p"]] \
  + \ iter-star-sep(sym,sep)	-> <concat>[<x>sym,<x>sep,["s"]] \
//  + \ iter-star-sep(sym,sep)	-> <filter(x);concat;at-end(!["s"])>[sym,sep] \
  + \ func(ss,s)		-> <concat>[<filter(x);concat>ss,["to"],<x>s] \
  + \ alt(s1,s2)		-> <concat>[<x>s1,["or"],<x>s2] \
  + \ sort(str)			-> [str] \
  + \ lit(_)			-> [] \
  + \ label(_,sym)		-> <x> sym \
  )

  PpSym = rec x( 
    \ cf(sym)			-> <concat>[["<"], <x> sym, ["-CF>"]] \
  + \ lex(sym)			-> <concat>[["<"], <x> sym, ["-LEX>"]] \
  + \ empty()			-> ["()"] \
  + \ seq(s,ss)			-> <concat>[["("], <map(x)> [s|ss], [")"]] \
  + \ opt(sym)			-> <x;at-end(!["opt"])> sym \
  + \ iter(sym)			-> <x;at-end(!["+"])> sym \
  + \ iter-star(sym)		-> <x;at-end(!["*"])> sym \
  + \ iter-sep(sym,sep)		-> <concat>[["{"], <x>sym, <x>sep, ["}+"]] \
  + \ iter-star-sep(sym,sep)	-> <concat>[["{"], <x>sym, <x>sep,["}*"]] \
  + \ func(ss,s)		-> <concat>[<filter(x);concat>ss,["to"],<x>s] \
  + \ alt(s1,s2)		-> <concat>[<x>s1,["|"],<x>s2] \
  + \ sort(str)			-> [str] \
  + \ lit(str)			-> [<try(un-double-quote;unescape)>str] \
  + \ label(str,_)		-> [<try(un-double-quote;unescape)>str] \
 <+ \ layout			-> ["LAYOUT"] \
  )

rules

  /**
   * @note This order of application is rather strange (I don't think the fancy 
   *   alphaNum can ever be invoked) but, this seems to have been the order of 
   *   application. The rules are ambigious so we force the rule into this order 
   *   of application.
   */
  toAlphaNum =
    toAlphaNumGeneric <+ toAlphaNumFancy

  toAlphaNumFancy : ","	-> "comma"
  toAlphaNumFancy : ":"	-> "colon"
  toAlphaNumFancy : ";"	-> "semicolon"
  toAlphaNumFancy : "+"	-> "plus"
  toAlphaNumFancy : "++" -> "incr"
  toAlphaNumFancy :  "-" -> "minus"
  toAlphaNumFancy : "--" -> "decr"
  toAlphaNumFancy : "*"	-> "times"
  toAlphaNumFancy : "/"	-> "div"
  toAlphaNumFancy : "&"	-> "address"
  toAlphaNumFancy : "&&" -> "and"
  toAlphaNumFancy : "!"	-> "not"
  toAlphaNumFancy : "-"	-> "minus"
  toAlphaNumFancy : "~"	-> "tilde"

  toAlphaNumFancy : "%"	-> "mod"
  toAlphaNumFancy : "<<" -> "shift-left"
  toAlphaNumFancy : ">>" -> "shift-right"
  toAlphaNumFancy : "!=" -> "not-equal"

  toAlphaNumFancy : "<"  -> "lt"
  toAlphaNumFancy : "<=" -> "le"
  toAlphaNumFancy : ">"	 -> "gt"
  toAlphaNumFancy : ">=" -> "ge"
  toAlphaNumFancy : "|"  -> "bar"
  toAlphaNumFancy : "="  -> "equal"
  toAlphaNumFancy : "==" -> "equal"
  toAlphaNumFancy : "||" -> "or"
  toAlphaNumFancy : ":=" -> "assign"
  toAlphaNumFancy : "->" -> "rightarrow"
  toAlphaNumFancy : "=>" -> "rightdoublearrow"

  toAlphaNumFancy :  "*=" -> "assignMul" 
  toAlphaNumFancy :  "/=" -> "assignDiv" 
  toAlphaNumFancy :  "%=" -> "assignMod" 
  toAlphaNumFancy :  "+=" -> "assignPlus" 
  toAlphaNumFancy :  "-=" -> "assignMin" 
  toAlphaNumFancy :  "<<=" -> "assignSL" 
  toAlphaNumFancy :  ">>=" -> "assignSR" 
  toAlphaNumFancy :  "&=" -> "assignAnd" 
  toAlphaNumFancy :  "^=" -> "assignExp" 
  toAlphaNumFancy :  "|=" -> "assignOr" 

  toAlphaNumGeneric : xs -> ""
  where
    <explode-string; not(map(is-alphanum + '-'))> xs

strategies

  sepby(s)
    = rec x(  Nil
           <+ Cons(id,Nil)
           <+ Cons(id, \ tl -> Cons(<s>tl,<x>tl) \)
           )

  list-ana(s) =
    rec x(
       (s;Singleton)

    <+ {xs:
         ?_#(xs)
         ; !xs
         ; filter(x)
         ; concat
       }
    <+ ![]
    )

//  tfilter(s)
//    = rec x(TNil + (TCons(s,x) <+ tTl ; x))

rules

  tuple2list = ?""#(<id>)

  Singleton : x -> [x]  

  tTl : ""#([x, tp]) -> ""#(tp)


