Richard Suchenwirth: This is part 3 of the series that began with
Playing APL and
APLish - a partial parser
apl2t that converts a string in sub-APL to a string that can be eval'ed by Tcl (call
apl).
It is partial in two ways: it does not attempt to build a complete parse tree, and it does not cover more than a tiny subset of APL, but some already:
% apl2t {N N rho 1,N rho 0}
rho "$N $N" [, "1" [rho "$N" "0" ]]
% set N 5
5
% apl {N N rho 1,N rho 0}
1 0 0 0 0
0 1 0 0 0
0 0 1 0 0
0 0 0 1 0
0 0 0 0 1
% apl N+2*0.5
6.414213562373095Still a lot to do (quoted strings, compound operators like -:..), but it's tremendous fun...;-)
namespace eval APL {
namespace export apl apl2t
proc apl s {uplevel [apl2t $s]}
proc apl2t list {
set res ""
#---------- insert potential blanks everywhere, then reduce
set list [join [split $list ""] \x81]
foreach i {1 2} {
regsub -all "(\[_A-Z0-9\])\x81(\[_A-Z0-9\])" $list {\1\2} list
regsub -all "(\[a-z0-9\])\x81(\[a-z0-9\])" $list {\1\2} list
}
regsub -all "(\[.\])\x81(\[0-9\])" $list {\1\2} list
regsub -all "(\[0-9\])\x81(\[.\])" $list {\1\2} list
regsub -all \x81 $list " " list
set op ""
set last ""
#---------- walk the list from back
for {set n [llength $list]} {$n>0} {incr n -1} {
set it [lindex $list [expr $n-1]]
if [regexp {^[A-Z_]} $it] {
if {$last!="val"} {set it "$it\""}
set res "\$$it $res"
set last val
} elseif {[regexp {^-?[0-9.]} $it]} {
if {$last!="val"} {set it $it\"}
set res "$it $res"
set last val
} elseif {$it==")"} {
if {$last=="val"} {set res \"$res}
set last embed
set open [lsearch $list "("]
if {$open<0} {error "unmatched paren"}
set embed [lrange $list [incr open] [incr n -2]]
set res "\[[apl2t $embed]\] $res"
set n $open
} else {
if {$last=="val"} {set res \"$res}
set last op
if [llength $op] {
set res "$op $res"; set op ""
if {$n>2} {set res "\[$res\]"}
}
set op $it
}
}
if {$last=="val"} {set res \"$res}
if [llength $op] {set res "$op $res"}
set res
}
}
