/**
 * Implementation of accept for Deterministic Finite Tree Automaton (DFTA).
 *
 * @author Martin Bravenboer
 */
module stratego/rtg/dfta-accept
imports
  stratego/rtg/signature
  libstratego-lib

signature
  constructors
    DFTA : List(State) * Hashtable -> DFTA
    Failure : Failure

/**
 * Open an DFTA to a simple representation of a tree automaton.
 */
strategies

  /**
   * @todo We really need garbage collection for hashtables to avoid the destroy.
   */
  open-dfta =
    ?RTG(Start(start-states), ProdRules(<id>))
    ; where(tbl := <new-hashtable>)
    ; map({a, q:
        ?ProdRule(q, [a@Appl(_, _)])
        ; <hashtable-put(|a, q)> tbl
        <+ debug(!"internal error: cannot create type rule for ")
           ; fail
      })
    ; !DFTA(start-states, tbl)

  dfta-destroy =
    DFTA(id, hashtable-destroy)

  is-dfta =
    ?DFTA(_, _)

strategies

  /**
   * The result of dtfa-accept is a state. The strategy does not check
   * if this state is one of the start states of the DFTA.
   */
  dfta-accept(fail-hook : t * Appl -> a | dfta) =
    where(!dfta => DFTA(set, tbl))
    ; let transition(|t) = dfta-accept-transition(fail-hook | tbl, t)
       in bottomup-reconstruct(transition, dfta-accept-reconstruct)
      end

  dfta-accept-transition(fail-hook : t * Appl -> a | tbl, t) = id
    ; ?a
    ; <hashtable-get(|a)> tbl
    <+ fail-hook(|t)
       ; !Failure()

/**
 * Explode determines the next transition.
 */
strategies

  dfta-accept-reconstruct(|args) =
       dfta-accept-explode-int(|args)
    <+ dfta-accept-explode-string(|args)
    <+ dfta-accept-explode-nil(|args)
    <+ dfta-accept-explode-cons(|args)
    <+ dfta-accept-explode-conc(|args)
    <+ dfta-accept-explode-some(|args)
    <+ dfta-accept-explode-none(|args)
    <+ dfta-accept-explode-appl(|args)

  dfta-accept-explode-nil(|args) =
    ?[]
    ; !Appl(NilTerm(), [])

  dfta-accept-explode-cons(|args) =
    ?[_ | _]
    ; !Appl(ConsTerm(), args)

  dfta-accept-explode-conc(|args) =
    ?Conc(_, _)
    ; !Appl(ConcTerm(), args)

  dfta-accept-explode-none(|args) =
    ?None()
    ; !Appl(NoneTerm(), [])

  dfta-accept-explode-some(|args) =
    ?Some(_)
    ; !Appl(SomeTerm(), args)

  dfta-accept-explode-appl(|args) = id
    ; where(f := <get-constructor>)
    ; if f := "" then
        !Appl(TupleTerm(<length> args), args)
      else
        !Appl(Term(f), args)
      end

  dfta-accept-explode-int(|args) =
    is-int
    ; !Appl(IntTerm(), [])

  dfta-accept-explode-string(|args) =
    is-string
    ; !Appl(StringTerm(), [])

strategies

  /**
   * Bottom traversal where the current term is reconstructed
   * from the arguments using a custom strategy.
   */
  bottomup-reconstruct(s, reconstruct : List(b) * a -> c) =
    ?t
    ; ( ?[x | xs]
      < ![<bottomup-reconstruct(s, reconstruct)> x, <bottomup-reconstruct(s, reconstruct)> xs]
      + ?[]
      < ![]
      + is-int
      < ![]
      + is-string
      < ![]
      + get-appl-arguments(bottomup-reconstruct(s, reconstruct))
      )
    ; ?args
    ; <reconstruct(|args)> t
    ; s(|t)