dacceptor.tcl

Go to the documentation of this file.

/*  -*- tcl -*-*/
/*  Grammar / Finite Automatons / Acceptance checker, DFA only*/

/*  ### ### ### ######### ######### #########*/
/*  Package description*/

/*  A class whose instances take a FA and are able to check strings of*/
/*  symbols for acceptance. This class is restricted to deterministic*/
/*  FAs. The FA can be either a reference to some external FA container*/
/*  object, or a copy of such. The latter makes the acceptor impervious*/
/*  to changes in the original definition.*/

/*  ### ### ### ######### ######### #########*/
/*  Requisites*/

package require snit        ; /*  Tcllib | OO system used*/
package require struct:: ; # Tcllib =  | Extended  operations = .

/*  ### ### ### ######### ######### #########*/
/*  Implementation*/

snit::type ::grammar::fa::dacceptor {
    /*  ### ### ### ######### ######### #########*/
    /*  Type API. */

    /*  ### ### ### ######### ######### #########*/
    /*  Instance API.*/

    /* constructor {fa args} {}*/
    /* destructor  {}*/

    ret  accept? (type symbolstring) {}

    option -any     {}

    /*  ### ### ### ######### ######### #########*/
    /*  Internal data structures.*/

    /*  We take the relevant information from the FA specified during*/
    /*  construction, i.e. start state, final states, and transition*/
    /*  table in form for direct indexing and keep it local. No need to*/
    /*  access or even the full FA. We require a deterministic one, and*/
    /*  will complete it, if necessary.*/

    variable start ; /*  Name of start state.*/
    variable final ; /*  Array, existence = state is final.*/
    variable trans ; /*  Transition array: state x symbol -> state*/
    variable sym   ; /*  Symbol set (as array), for checking existence.*/
    variable any   ; /*  Symbol to map any unknown symbol to. If not*/
    /*               ; # specified (eq "") then unknown symbols will  cause non-*/
    /*               ; # acceptance.*/
    variable stop  ; /*  Stop state, causing immediate non-acceptance when entered.*/

    /*  ### ### ### ######### ######### #########*/
    /*  Instance API Implementation.*/

    constructor {fa args} {
     any =  {}
    $self configurelist $args

    if {![$fa is deterministic]} {
        return -code error "Source FA is not deterministic"
    }
    if {($any ne "") && ![$fa symbol exists $any]} {
        return -code error "Chosen any symbol \"$any\" does not exist"
    }

    if {![$fa is complete]} {
         istmp =  1
         tmp =  [grammar::fa ${selfns}::fa = $fa]
         before =  [$tmp states]
        $tmp complete
        /*  Our sink is a stop state.*/
         stop =  [struct:: difference =  [$tmp states] $before]
    } else {
         istmp =  0
         tmp =  $fa
        /*  We don't know if there is a sink, so no quickstop.*/
         stop =  {}
    }

     start =  [lindex [$tmp startstates] 0]
    foreach s [$tmp finalstates]        { final = ($s) .}
    foreach s [ syms =  [$tmp symbols]] { sym = ($s) .}

    foreach s [$tmp states] {
        foreach sy $syms {
         trans = ($s,$sy) [lindex [$tmp next $s $sy] 0]
        }
    }

    if {$istmp} {$tmp destroy}
    return
    }

    /* destructor {}*/

    onconfigure -any {value} {
     options = (-any) $value
     any =            $value
    return
    }

    /*  --- --- --- --------- --------- ---------*/

    ret  accept? (type symbolstring) {
    set state $start

    ## puts "\n====================== ($symbolstring)"

    if {$any eq ""} {
        # No any mapping of unknown symbols.

        foreach sy $symbolstring {
        if {![info exists sym($sy)]} {
            # Bad symbol in input. String is not accepted,
            # abort immediately.
            ## puts " \[$state\] -- Unknown symbol ($sy)"
            return 0
        }

        ## puts " \[$state\] --($sy)--> "

        set state $trans($state,$sy)
        # state == "" cannot happen, as our FA is complete.
        if {$state eq $stop} {
            # This is a known sink, we can stop processing input now.
            ## puts " \[$state\] FULL STOP"
            return 0
        }
        }

    } else {
        # Mapping of unknown symbols to any.

        foreach sy $symbolstring {
        if {![info exists sym($sy)]} {set sy $any}
        ## puts " \[$state\] --($sy)--> "
        set state $trans($state,$sy)
        # state == "" cannot happen, as our FA is complete.
        if {$state eq $stop} {
            # This is a known sink, we can stop processing input now.
            ## puts " \[$state\] FULL STOP"
            return 0
        }
        }
    }

    ## puts " \[$state\][expr {[info exists final($state)] ? " ACCEPT" : ""}]"

    return [info exists final($state)]
    }

    /*  ### ### ### ######### ######### #########*/
    /*  Type API implementation.*/

    /*  ### ### ### ######### ######### #########*/
    /*  Type Internals.*/

    /*  ### ### ### ######### ######### #########*/
}

/*  ### ### ### ######### ######### #########*/
/*  Package Management*/

package provide grammar::fa::dacceptor 0.1.1