/**
 * Implosion of productions that result in constructor applications.
 *
 * An application of a context-free production is transformed
 * into an actual application of a constructor name to the list
 * of children. The Stratego primitive \verb|mkterm| takes a pair
 * of a string \verb|c| and a list of terms \verb|ts| and turns
 * it into the term \verb|c(ts)|. The constructor \verb|c| is
 * derived from the production. If it has a \verb|cons(c)|
 * attribute that attribute is taken. Otherwise the production
 * should be some derived production for regular expressions.
 */
module stratego/asfix/implode/constructor
strategies

  ReplCons(impl) =
       ReplNamedCons(impl)
    <+ ReplAstPattern(impl)
    <+ ReplConsNil(impl)
    <+ ReplConsNone(impl)
    <+ ReplConsIns(impl)
    <+ ReplConsSome(impl)
    <+ ReplConsConc(impl)

rules

  ReplNamedCons(impl) : 
    appl(p, ts){a*} -> c#(<map(impl)>ts){a*}
    where
      <get-cons> p => c

  get-cons : 
    prod(_, _, as) -> x
    where
      <oncetd(?cons(x))> as

rules

  /**
   * Handles the experimental ast annotations.
   */
  ReplAstPattern(impl) : 
    appl(p, ts){a*} -> term{c*}
    where
      <get-ast-pattern> p => pattern 
    ; <map(impl)>ts => is
    ; {| ReplacePlaceholder: 
        <map-with-index({ ?(i, t) ; rules( ReplacePlaceholder : i -> t ) })>is
      ; !pattern
      ; rec rec(
           alltd({ ph, t1, t2, a*, b*, c*:
             if is-placeholder then
               ?_{a*}
               ; get-placeholder => ph
               ; (  ReplacePlaceholder

                 <+ "conc"#([rec, rec])
                    ; if "conc"#([is-list, is-list]) then
                        \ "conc"#([xs, ys]) -> <conc> (xs, ys) \
                      end

                 <+ ?"yield"#([<ReplacePlaceholder>])
                    ; asfix-yield-appl

                 <+ log(| Error()
                        , <concat-strings>[ "Could not replace placeholder <",<write-to-string>ph,"> in pattern "
                                          , <write-to-string>pattern]) ; <exit> 1 )
               ; if not([] := a*) then
                   \ t1{b*} -> t1{c*} where c* := <conc> (<map(rec)> a*, b*) \
                 end
             else
               ?_{^[_ | _]}
               ; \ t1{a*} -> t2{b*} where b* := <map(rec)> a*; t2 := <rec> t1{^[]} \
             end
           })
         )
      ; ?term{b*}
      ; if [] := a* then
          !b*
        else
          if [] := b* then
            <conc> (a*, b*)
          else
            !a*
          end
        end
      ; ?c*
      |}

  /**
   * @todo Cache the parsed placeholders.
   */
  get-ast-pattern : 
    prod(_, _, as) -> <read-from-string>x
    where <oncetd(?ast(x))> as

/**
 * @todo Find a more appropiate place for this.
 */
signature
  constructors
    ast : Term -> Term

rules

  ReplConsNil(impl) : 
    appl(p, []) -> []
    where
      <is-nil> p

  ReplConsNone(impl) : 
    appl(p, []) -> None
    where
      <is-none> p

  ReplConsIns(impl) : 
    appl(p, [t]) -> [<impl>t]
    where
      <is-ins> p

/**
 * In some case a present literal is relevant.
 */
rules

  ReplConsIns(impl) : 
    appl(prod([lit(x)], sym, _), []) -> t
    where
      t := <implode-constant-literal(|x)> sym

  ReplConsIns(impl) : 
    appl(prod([cilit(x)], sym, _), []) -> t
    where
      t := <implode-constant-literal(|x)> sym

  implode-constant-literal(|constant) =
    rec rec(
      ?cf(<rec>)
    + ?lex(<rec>)
    + \ iter(<rec>) -> [<id>] \
    + \ iter-star(<rec>) -> [<id>] \
    + \ iter-sep(<rec>, _) -> [<id>] \
    + \ iter-star-sep(<rec>, _) -> [<id>] \
    + \ opt(<rec>) -> Some(<id>) \
    + \ lit(_) -> constant \
    + \ cilit(_) -> constant \
    )

rules

  ReplConsSome(impl) : 
    appl(p, [t]) -> Some(<impl>t)
    where
      <is-some> p

  ReplConsConc(impl) : 
    appl(p, [t1,t2]) -> t
    where
      <is-conc> p
      ; <impl>t1 => ts1
      ; <impl>t2 => ts2
      ; (<[] + [id|id]> ts2; <conc>(ts1, ts2)
          <+ !"Conc"#([ts1, ts2])) => t

  /**
   * Note: the separator of this concatenation operator is
   * made into an element of the list. Does this make sense?
   */
  ReplConsConc(impl) : 
    appl(p, [t1,t2,t3]) -> <conc>(<impl>t1, [<impl>t2 | <impl>t3])
    where
      <is-conc> p

strategies

  is-nil  = ?prod([], cf(iter-star-sep(_, _)), _)
  is-nil  = ?prod([], cf(iter-star(_)), _)
  is-nil  = ?prod([], iter-star-sep(_, _), _)
  is-nil  = ?prod([], iter-star(_), _)

  is-ins  = ?prod([cf(x)], cf(iter-sep(x,_)), _)
  is-ins  = ?prod([cf(x)], cf(iter(x)), _)
  is-ins  = ?prod([x], iter-sep(x,_), _)
  is-ins  = ?prod([x], iter(x), _)

  is-conc = ?prod([_, _, _], cf(iter(_)), _)
  is-conc = ?prod([_,    _],    iter(_), _)
  is-conc = ?prod([_, _, _], cf(iter-star(_)), _)
  is-conc = ?prod([_, _, _],    iter-star(_), _)
  is-conc = ?prod([_, _, _, _, _], cf(iter-sep(_, _)), _)
  is-conc = ?prod([_,    _,    _], iter-sep(_, _), _)
  is-conc = ?prod([_, _, _, _, _], cf(iter-star-sep(_, _)), _)
  is-conc = ?prod([_,    _,    _], cf(iter-star-sep(_, _)), _)

  /**
   * @todo Not sure what this case is for.
   */
  is-conc = ?prod([_, _], cf(iter-star-sep(_, _)), _)

  is-none = ?prod([], cf(opt(_)), _)
  is-none = ?prod([], opt(_), _)

  is-some = ?prod([cf(x)], cf(opt(x)), _)
  is-some = ?prod([x], opt(x), _)

strategies

  Cns = CnsNil <+ CnsGeneric

rules

  CnsNil : 
    appl(p, ts) -> []
    where
      <ConstrNil> p => c 

  ConstrNil : prod([],cf(iter-star-sep(_,_)),_)     -> "Nil"
  ConstrNil : prod([],cf(iter-star(_)),_)           -> "Nil"
  ConstrNil : prod([],iter-star-sep(_,_),_)         -> "Nil"
  ConstrNil : prod([],iter-star(_),_)               -> "Nil"

  CnsGeneric : 
    appl(p, ts) -> c#(ts)
    where <Constr0 <+ Constr1> p => c 

  /**
   * @todo Optimize the oncetd
   */
  Constr0 : 
    prod(_, _, as) -> x
    where
      <oncetd(?cons(x))> as

  Constr1 : prod([cf(x)], cf(iter-sep(x,_)), _)   -> "Ins"
  Constr1 : prod([cf(x)], cf(iter(x)), _)         -> "Ins"
  Constr1 : prod([x], iter-sep(x,_), _)           -> "Ins"
  Constr1 : prod([x], iter(x), _)                 -> "Ins"

  Constr1 : prod([_,_,_,_,_],cf(iter-sep(_,_)),_) -> "Conc"
  Constr1 : prod([_,_,_],    cf(iter-sep(_,_)),_) -> "Conc" // after layout removal
  Constr1 : prod([_,_,_],    cf(iter(_)),_)       -> "Conc"
  Constr1 : prod([_,_],      cf(iter(_)),_)       -> "Conc" // after layout removal
  Constr1 : prod([_,_,_],    iter-sep(_,_),_)	  -> "Conc"
  Constr1 : prod([_,_],      iter(_),_)           -> "Conc"

  Constr1 : prod([_,_,_,_,_], cf(iter-star-sep(_,_)),_) -> "Conc"
  Constr1 : prod([_,_,_],     cf(iter-star-sep(_,_)),_) -> "Conc"

  Constr1 : prod([], cf(opt(_)), _)		  -> "None"
  Constr1 : prod([], opt(_), _)			  -> "None"

  Constr1 : prod([cf(x)], cf(opt(x)), _)          -> "Some"
  Constr1 : prod([x], opt(x), _)                  -> "Some"

  Constr23 : 
    prod(args, cf(iter-sep(x, y)), _) -> c
    where <(?[cf(x)]; !"Ins" <+ ?[_,_,_,_,_]; !"Conc")> args => c