Version 2 of parsing with coroutine

Updated 2010-01-18 15:28:24 by dkf

FM This is an experimentation to parse with coroutine. It uses the typedlist package.

#! /bin/sh
# this is a -*-Tcl-*- file

package require typedlist

typedlist create BNF::nombre

coroutine nombre apply {{} {
    while 1 {
        if {[regexp {[0-9]} [set n [yield]]]} {
            if {[info exist ::String($::Instruction)] && \
                    [[lindex $::String($::Instruction) end] type] eq "nombre"} {
                [lindex $::String($::Instruction) end] lappend $n
            } else {
                lappend ::String($::Instruction) [BNF::nombre $n]
            }
        } 
    }
}}

typedlist create BNF::mot
coroutine mot apply {{} {
    while 1 {
        set n [yield]
        if {[regexp {[a-zA-Z]} $n]} {
            if {[info exist ::String($::Instruction)]} {
                if {[[lindex $::String($::Instruction) end] type] eq "mot"} {
                    [lindex $::String($::Instruction) end] lappend $n
                } elseif {[[lindex $::String($::Instruction) end] type] eq "var"} {
                    [lindex $::String($::Instruction) end] lappend $n
                } else {
                    lappend ::String($::Instruction) [BNF::mot $n]
                }
            } else {
                lappend ::String($::Instruction) [BNF::mot $n]
            }
        } elseif {[regexp {[0-9]} $n]} {
            if {[info exist ::String($::Instruction)]} {
                if {[[lindex $::String($::Instruction) end] type] eq "mot"} {
                    [lindex $::String($::Instruction) end] lappend $n
                } elseif {[[lindex $::String($::Instruction) end] type] eq "var"} {
                    [lindex $::String($::Instruction) end] lappend $n
                } 
            }
        }
    }
}}

typedlist create BNF::égal
coroutine égal apply {{} {
    while 1 {
        if {[regexp {=} [set n [yield]]]} {
            lappend ::String($::Instruction) [BNF::égal $n]
        } 
    }
}}

typedlist create BNF::plus
coroutine plus apply {{} {
    while 1 {
        if {[regexp {\+} [set n [yield]]]} {
            lappend ::String($::Instruction) [BNF::plus $n]
        } 
    }
}}
typedlist create BNF::fois
coroutine fois apply {{} {
    while 1 {
        if {[regexp -- {\*} [set n [yield]]]} {
            lappend ::String($::Instruction) [BNF::fois $n]
        } 
    }
}}
typedlist create BNF::moins
coroutine moins apply {{} {
    while 1 {
        if {[regexp -- {-} [set n [yield]]]} {
            lappend ::String($::Instruction) [BNF::moins $n]
        } 
    }
}}
typedlist create BNF::rapport
coroutine rapport apply {{} {
    while 1 {
        if {[regexp -- {/} [set n [yield]]]} {
            lappend ::String($::Instruction) [BNF::rapport $n]
        } 
    }
}}
typedlist create BNF::ParenthèseOuverte
coroutine ParenthèseOuverte apply {{} {
    while 1 {
        if {[regexp -- {\(} [set n [yield]]]} {
            lappend ::String($::Instruction) [BNF::ParenthèseOuverte $n]
        } 
    }
}}
typedlist create BNF::ParenthèseFermée
coroutine ParenthèseFermée apply {{} {
    while 1 {
        if {[regexp -- {\)} [set n [yield]]]} {
            lappend ::String($::Instruction) [BNF::ParenthèseFermée $n]
        } 
    }
}}

typedlist create BNF::var
coroutine var apply {{} {
    while 1 {
        set n [yield]
        if {[regexp {\$} $n]} {
            lappend ::String($::Instruction) [BNF::var $n]
        } 
    }
}}
typedlist create BNF::FinDeInstruction
coroutine FinDeInstruction apply {{} {
    while 1 {
        set n [yield]
        if {[regexp {\;} $n] || [regexp {\n} $n]} {
            incr ::Instruction
        } 
    }
}}

typedlist create BNF::point
coroutine point apply {{} {
    while 1 {
        set n [yield]
        if {[regexp {\.} $n]} {
            if {[info exist ::String($::Instruction)] && \
                    [[lindex $::String($::Instruction) end] type] eq "nombre"} {
                [lindex $::String($::Instruction) end] lappend $n
            } else {
                lappend ::String($::Instruction) [BNF::nombre $n]
            }
        } 
    }
}}

typedlist create BNF::sousScript 
coroutine sousScript apply {{} {
    while 1 {
        set n [yield]
        if {[regexp {\[} $n]} {
            if {$::sousScript == 0} {
                lappend ::String($::Instruction) [BNF::sousScript $n]
            } else {
                [lindex $::String($::Instruction) end] lappend $n
            }
            incr ::sousScript 
        } elseif {[regexp {\]} $n]} {
            [lindex $::String($::Instruction) end] lappend $n
            incr ::sousScript -1
        } elseif {$::sousScript >= 1} {
            ToutVenant $n
        }
    }
}}

typedlist create BNF::FinDeMot 
coroutine FinDeMot apply {{} {
    while 1 {
        set n [yield]
        if {[regexp {[ \t]} $n]} {
            lappend ::String($::Instruction) [BNF::FinDeMot $n]
        }
    }
}}

typedlist create BNF::ToutVenant 
coroutine ToutVenant apply {{} {
    set i 0
    set N {}
    set ::SousExpression 0
    while 1 {
        set n [yield]
        if {$n eq " " && $i == 0} {
            lappend N " "
            incr i
        } elseif {$n eq "\{" && $i == 1} {
            lappend N \{
            incr i
        } elseif {$n eq "=" && $i == 2} {
            lappend N =
            incr i
        } elseif {$n eq "\}" && $i == 3} {
            lappend N \}
            incr i
        } elseif {$n eq "(" && $i == 4} {
            set ::SousExpression 1
            set ::Parenthèse 1
            [lindex $::String($::Instruction) end] lappend \[ e x p r { } \{ $n
            set N {}
            set i 5
        } elseif {$::SousExpression} {
            sousExpression $n
            if {!$::SousExpression} {
                set i 1                
            }
        } else {
            [lindex $::String($::Instruction) end] lappend {*}$N $n
            set N {}
        }
    }
}}

typedlist create BNF::sousExpression
coroutine sousExpression apply {{} {
    set i 0
    while 1 {
        set n [yield]
        if {$n eq ")" && ${::Parenthèse} == 1} {
            [lindex $::String($::Instruction) end] lappend $n \} \]
            set ::SousExpression 0
        } elseif {$n eq ")" && ${::Parenthèse} > 1} {
            [lindex $::String($::Instruction) end] lappend $n
            incr ::Parenthèse -1
        } elseif {$n eq "("} {
            [lindex $::String($::Instruction) end] lappend $n
            incr ::Parenthèse
        } else {
            [lindex $::String($::Instruction) end] lappend $n
        }
    }
}}

proc lexpr {sz} {
    catch {array unset ::String}
    array set ::String {}
    set ::Instruction 0
    set ::sousScript 0
    # lexer
    foreach c [split $sz ""] {
        sousScript $c
        if {$::sousScript} continue
        mot $c
        égal $c
        var $c
        nombre $c
        plus $c
        fois $c
        moins $c
        rapport $c
        point $c
        ParenthèseOuverte $c
        ParenthèseFermée $c
        FinDeInstruction $c
    }
    set Res []
    # interpreteur
    for {set i 0} {$i <= $::Instruction} {incr i} {
        set res []
        set var []
        set Silencieux 0

        if {![info exist ::String($i)]} continue
        if {[set range [lsearch $::String($i) *::égal:*]] ne {}} {
            foreach e [lrange $::String($i) 0 ${range}-1] {
                append var [$e get]
            }
            set ::String($i) [lrange $::String($i) ${range}+1 end]
            if {$range == 0} {
                set Silencieux 1
            }
        }
        foreach e $::String($i) {
            append res [join [$e get] ""]
        }
        if {$var ne {}} {
            set $var [expr $res]
        } elseif {$Silencieux} {
            eval subst $res
        } else {
            lappend Res [expr $res]
        }
    }
    return $Res
}


# Test

lexpr {
    =[wm withdraw .
      toplevel [set t .top_tmp_]
      wm geom $t +100+100
      wm attributes $t -alpha 0.0
      wm state $t zoomed
      update idletask
      lassign [split [winfo geometry $t] x+] W H X Y]
    w=[winfo width .]; h=[winfo height .]
    =[wm geom . +{=}(($W-$w)/2+$X)+{=}(($H-$h)/2+$Y)
      wm deiconify .
      destroy $t
      update idletask]
}

the lexpr proc here do :

  • if the line begin with v =, v is seen as a variable and so is set to the value calculate after the equal sign (variable is only one letter long for the moment)
  • if the line begin with =, the action isn't return as result of the command (else it will be appended to a list which will be return)
  • what is between [ and ] is a seen as a subscript to be evaluated
  • the construct {=}( ... ) is seen as an expression to be calculated in a subscript.
Category Parsing