• In OOP, a new type can be implemented as a new class, whereas a new operation can be implemented as a new method on the ancestor class.
• With data-is-code, a new type is implemented by defining commands for it in all operation namespaces, whereas a new operation is implemented as a new namespace.

An example: Algebraic expressions edit

+ expression expression

- expression expression

* expression expression

/ expression expression

var name

const value

  / {- {* {const 2} {var x}} {const 1}} {+ {var x} {const 3}}

  namespace eval algexpr::eval {
     proc + {term1 term2} {
        expr {[eval $term1] + [eval $term2]}
     }
     proc - {term1 term2} {
        expr {[eval $term1] - [eval $term2]}
     }
     proc * {factor1 factor2} {
        expr {[eval $factor1] * [eval $factor2]}
     }
     proc / {numer denom} {
        expr {[eval $numer] / double([eval $denom])}
     }
     proc const {val} {return $val}
     proc var {name} {
        upvar #0 $name val
        return $val
     }
  }

  namespace inscope algexpr::eval $datum

  % set datum {/ {- {* {const 2} {var x}} {const 1}} {+ {var x} {const 3}}}
  % set x 1
  % namespace inscope algexpr::eval $datum
  0.25
  % set x 2
  % namespace inscope algexpr::eval $datum
  0.6
  % set x 3
  % namespace inscope algexpr::eval $datum
  0.833333333333

  namespace eval algexpr::eval2 {
     proc + {term1 term2 args} {
        expr {[eval $term1 $args] + [eval $term2 $args]}
     }
     proc - {term1 term2 args} {
        expr {[eval $term1 $args] - [eval $term2 $args]}
     }
     proc * {factor1 factor2 args} {
        expr {[eval $factor1 $args] * [eval $factor2 $args]}
     }
     proc / {numer denom args} {
        expr {[eval $numer $args] / double([eval $denom $args])}
     }
     proc const {val args} {return $val}
     proc var {name args} {
        foreach {var val} $args {
           if {$name eq $var} then {return $val}
        }
        error "No value specified for '$name'"
     }
  }

  % namespace inscope algexpr::eval2 $datum x 1
  0.25
  % namespace inscope algexpr::eval2 $datum x 2
  0.6
  % namespace inscope algexpr::eval2 $datum x 3
  0.833333333333

  % set datum2 {/ {- {* {const 2} {var x}} {const 1}} {+ {var y} {const 3}}}
  % namespace inscope algexpr::eval2 $datum2 x 1 y 2
  0.2

  namespace inscope algexpr::diff $datum $var

  namespace eval algexpr::diff {
     proc + {term1 term2 var} {
        list + [eval $term1 [list $var]] [eval $term2 [list $var]]
     }
     proc - {term1 term2 var} {
        list - [eval $term1 [list $var]] [eval $term2 [list $var]]
     }
     proc * {factor1 factor2 var} {
        list + [
           list * [eval $factor1 [list $var]] $factor2
        ] [
           list * $factor1 [eval $factor2 [list $var]]
        ]

     }
     proc / {factor1 factor2 var} {
        list / [
           list - [
              list * [eval $factor1 [list $var]] $factor2
           ] [
              list * $factor1 [eval $factor2 [list $var]]
           ]
        ] [
           list * $factor2 $factor2
        ]
     }
     proc const {val var} {
        list const 0
     }
     proc var {name var} {
        list const [expr {$name eq $var}]
     }
  }

  % set ddx_datum [namespace inscope algexpr::diff $datum x]
  / {- {* {- {+ {* {const 0} {var x}} {* {const 2} {const 1}}} {const 0}} {+ {var x} {const 3}}} {* {- {* {const 2} {var x}} {const 1}} {+ {const 1} {const 0}}}} {* {+ {var x} {const 3}} {+ {var x} {const 3}}}
  % namespace inscope algexpr::eval2 $ddx_datum x 2
  0.28

• convert an algexpr to expr form such that it can safely be made an operand of an expr-operation with priority priority, where 0 means no operation, 1 means +, 2 means *, and 3 is as denominator.

  namespace eval algexpr::toexpr {
     proc + {term1 term2 priority} {
        set res "[eval $term1 [list 1]]+[eval $term2 [list 1]]"
        if {$priority>1} then {
           return ($res)
        } else {
           return $res
        }
     }
     proc - {term1 term2 priority} {
        set res "[eval $term1 [list 1]]-[eval $term2 [list 2]]"
        if {$priority>1} then {
           return ($res)
        } else {
           return $res
        }
     }
     proc * {factor1 factor2 priority} {
        set res "[eval $factor1 [list 2]]*[eval $factor2 [list 2]]"
        if {$priority>2} then {
           return ($res)
        } else {
           return $res
        }
     }
     proc / {numer denom priority} {
        set res "[eval $numer [list 2]]/[eval $denom [list 3]]"
        if {$priority>2} then {
           return ($res)
        } else {
           return $res
        }
     }
     proc var {name priority} {
        if {[regexp -nocase -- {^[a-z_][a-z0-9_]*$} $name]} then {
           return "\$$name"
        } else {
           return "\[[list set $name]\]"
        }
     }
     proc const {val priority} {return $val}
  }

  % namespace inscope algexpr::toexpr $datum 0
  (2*$x-1)/($x+3)

  % namespace inscope algexpr::toexpr $ddx_datum 0
  ((0*$x+2*1-0)*($x+3)-(2*$x-1)*(1+0))/(($x+3)*($x+3))

  namespace eval algexpr::parteval {
     proc const {val args} {list const $val}
     proc var {name args} {
        foreach {var val} $args {
           if {$name eq $var} then {return [list const $val]}
        }
        return [list var $name]
     }
     # These two were the central ones, but most of the actual 
     # work remains, since there are many small cases where
     # partial evaluation is possible.
     proc + {term1 term2 args} {
        set res1 [eval $term1 $args]
        foreach {t1 v1} $res1 break
        set res2 [eval $term2 $args]
        foreach {t2 v2} $res2 break
        if {$t1 eq "const"} then {
           if {$t2 eq "const"} then {
              list const [expr {$v1 + $v2}]
           } elseif {$v1==0} then {
              set res2
           } else {
              list + $res2 $res1
           }
        } elseif {$t2 eq "const" && $v2==0} then {
           set res1
        } else {
           list + $res1 $res2
        }
     }
     proc - {term1 term2 args} {
        set res1 [eval $term1 $args]
        foreach {t1 v1} $res1 break
        set res2 [eval $term2 $args]
        foreach {t2 v2} $res2 break
        if {$t1 eq "const"} then {
           if {$t2 eq "const"} then {
              list const [expr {$v1 - $v2}]
           } else {
              list - $res1 $res2
           }
        } elseif {$t2 eq "const" && $v2==0} then {
           set res1
        } else {
           list - $res1 $res2
        }
     }
     proc * {factor1 factor2 args} {
        set res1 [eval $factor1 $args]
        foreach {t1 v1} $res1 break
        set res2 [eval $factor2 $args]
        foreach {t2 v2} $res2 break
        if {$t1 eq "const"} then {
           if {$t2 eq "const"} then {
              list const [expr {$v1 * $v2}]
           } elseif {$v1==0} then {
              list const 0
           } elseif {$v1==1} then {
              set res2
           } else {
              list * $res1 $res2
           }
        } elseif {$t2 eq "const"} then {
           if {$v2==0} then {
              list const 0
           } elseif {$v2==1} then {
              set res1
           } else {
              list * $res2 $res1
           }
        } else {
           list * $res1 $res2
        }
     }
     proc / {numer denom args} {
        set res1 [eval $numer $args]
        foreach {t1 v1} $res1 break
        set res2 [eval $denom $args]
        foreach {t2 v2} $res2 break
        if {$t2 eq "const"} then {
           if {$t1 eq "const"} then {
              list const [expr {$v1 / double($v2)}]
           } elseif {$v2==1} then {
              set res1
           } else {
              list / $res1 $res2
           }
        } else {
           list / $res1 $res2
        }
     }
  }

  % namespace inscope algexpr::parteval $datum x 2
  const 0.6
  % namespace inscope algexpr::parteval $datum2 x 2
  / {const 3} {+ {var y} {const 3}}

  % set ddx_datum_simplified [namespace inscope algexpr::parteval $ddx_datum]
  / {- {* {const 2} {+ {var x} {const 3}}} {- {* {const 2} {var x}} {const 1}}} {* {+ {var x} {const 3}} {+ {var x} {const 3}}}
  % namespace inscope algexpr::toexpr $ddx_datum_simplified 0
  (2*($x+3)-(2*$x-1))/(($x+3)*($x+3))

  namespace eval algexpr::eval {
     proc exp {arg} {expr {exp([eval $arg])}}
  }
  namespace eval algexpr::eval2 {
     proc exp {arg args} {expr {exp([eval $arg $args])}}
  }
  namespace eval algexpr::diff {
     proc exp {arg var} {
        list * [list exp $arg] [eval $arg [list $var]]
     }
  }
  namespace eval algexpr::toexpr {
     proc exp {arg priority} {return "exp([eval $arg [list 0]])"}
  }
  namespace eval algexpr::parteval {
     proc exp {arg args} {
        set ares [eval $arg $args]
        if {[lindex $ares 0] eq "const"} then {
           list const [expr {exp([lindex $ares 1])}]
        } else {
           list exp $ares
        }
     }
  }

  % set datum3 {exp {/ {var x} {var y}}}
  % namespace inscope algexpr::eval2 $datum3 x 2 y 1
  7.38905609893
  % set ddy_datum3 [namespace inscope algexpr::diff $datum3 y]
  * {exp {/ {var x} {var y}}} {/ {- {* {const 0} {var y}} {* {var x} {const 1}}} {* {var y} {var y}}}
  % namespace inscope algexpr::toexpr $ddy_datum3 0
  exp($x/$y)*(0*$y-$x*1)/($y*$y)
  % set ddy_datum3 [namespace inscope algexpr::parteval $ddy_datum3]
  * {exp {/ {var x} {var y}}} {/ {- {const 0} {var x}} {* {var y} {var y}}}
  % namespace inscope algexpr::toexpr $ddy_datum3 0
  exp($x/$y)*(0-$x)/($y*$y)

Sharing commands edit

Avoid colons in node types

Colons interact strangely with the namespace separator ::, so you may be unable to make use of, or even speak about, the command you want.

Be aware of the namespace context

If you import or alias a proc into a namespace, then the namespace context of this proc does not follow. For set-ups such as the above, where the namespace context is an essential foundation for the interpretation, this can be disastrous.

  namespace eval ::foo {}
  proc ::a {} {
     puts "- I'm ::a, called as [info level 0]."
     return ::a
  }
  proc ::foo::a {} {
     puts "- I'm ::foo::a, called as [info level 0]."
     return ::foo::a
  }
  proc ::b {} {
     puts -nonewline "- I'm ::b, called as [info level 0]; "
     puts "my namespace is [namespace current]."
     puts "::b says: I've just called [uplevel 1 a]."
  }
  interp alias {} ::foo::b {} ::b

  - I'm ::b, called as b; my namespace is ::.
  - I'm ::a, called as a.
  ::b says: I've just called ::a.

  - I'm ::b, called as ::b; my namespace is ::.
  - I'm ::foo::a, called as a.
  ::b says: I've just called ::foo::a.

  proc exprbinop {ns op left right args} {
     set leftval [namespace eval $ns $left $args]
     set rightval [namespace eval $ns $right $args]
     expr \$leftval $op \$rightval
  }

  interp alias {} algexpr::eval::+ {} exprbinop algexpr::eval +
  interp alias {} algexpr::eval::- {} exprbinop algexpr::eval -
  interp alias {} algexpr::eval::* {} exprbinop algexpr::eval *
  interp alias {} algexpr::eval2::+ {} exprbinop algexpr::eval2 +
  interp alias {} algexpr::eval2::- {} exprbinop algexpr::eval2 -
  interp alias {} algexpr::eval2::* {} exprbinop algexpr::eval2 *

Handling unknown node types edit

  interp create -safe dispatch
  dispatch hide namespace
  dispatch invokehidden namespace delete ::

dispatch invokehidden namespace inscope namespace node ?arg ...?

  namespace eval $operation {
      namespace export *
      namespace ensemble create -prefix 0
  }

  namespace inscope $operation $node $arg

  $operation {*}$node $arg

  algexpr::eval2 {*}$datum x 1

  namespace inscope algexpr::eval2 $datum x 1

     proc + {term1 term2 args} {
        expr {[[namespace current] {*}$term1 {*}$args] + [[namespace current] {*}$term2 {*}$args]}
     }

  namespace eval algexpr::eval2 {
     proc + {term1 term2 args} {
        expr {["" {*}$term1 {*}$args] + ["" {*}$term2 {*}$args]}
     }
     proc - {term1 term2 args} {
        expr {["" {*}$term1 {*}$args] - ["" {*}$term2 {*}$args]}
     }
     proc * {factor1 factor2 args} {
        expr {["" {*}$factor1 {*}$args] * ["" {*}$factor2 {*}$args]}
     }
     proc / {numer denom args} {
        expr {["" {*}$numer {*}$args] / double(["" {*}$denom {*}$args])}
     }
     proc const {val args} {return $val}
     proc var {name args} {
        foreach {var val} $args {
           if {$name eq $var} then {return $val}
        }
        error "No value specified for '$name'"
     }
     namespace export ?*
     namespace ensemble create -command [namespace current]:: \
        -prefix 0 -unknown [list ::default_to_type +]
     interp alias {} [namespace current] {} [namespace current]::
  }
  proc default_to_type {type ensemble args} {list $ensemble $type}

  % algexpr::eval2 + {const 1} {var x} x 2
  3
  % algexpr::eval2 - {const 1} {var x} x 2
  -1
  % algexpr::eval2 / {const 1} {var x} x 2
  0.5
  % algexpr::eval2 & {const 1} {var x} x 2
  3

Traversals with state edit

1. Use a global or namespace variable. Inelegant, but often easy and good enough.
2. Use a local variable that is accessed using upvar. Gets into trouble if uplevel or namespace eval is being used as shown in the previous section.
3. Pass the previous state as a command argument and return it as the command result. This is the functional programming idiom.

Collecting children in a sublist or placing them directly the node list edit

1. Node type.
2. Annotations (data not in the form of a node).
3. Children (data in node format).

  nodetype annot1 annot2 ... annotM child1 child2 ... childN

  proc $nodetype {annot1 annot2 ... annotM child1 child2 ... childN} { # ...

  proc $nodetype {annot1 annot2 ... annotN args} { # ...

  proc $nodetype {annot1 annot2 ... annotN children} { # ...

+ ?term ...?

  proc algexpr::eval::+ {args} {
     set sum 0
     foreach term $args {
        set sum [expr {$sum + [eval $term]}]
     }
     return $sum
  }

  proc algexpr::diff::+ {args} {
     set var [lindex $args end]
     set res [list +]
     foreach term [lrange $args 0 end-1] {
        lappend res [eval $term [list $var]]
     }
     return $res
  }

sum term-list

  proc algexpr::diff::sum {terms var} {
     set res [list sum]
     foreach term $terms {
        lappend res [eval $term [list $var]]
     }
     return $res
  }
  proc algexpr::eval2::sum {terms args} {
     set sum 0
     foreach term $terms {
        set sum [expr {$sum + [eval $term $args]}]
     }
     return $sum
  }

  proc algexpr::eval3::+ {args} {
     set n 0
     foreach term $args {
        if {[llength $term] < 1} then {break}
        incr n
     }
     set sum 0
     foreach term [lreplace $args $n end] {
        set sum [expr {$sum + [eval $term [lrange $args $n end]]}]
     }
     return $sum
  }

  namespace inscope algexpr::eval3 $datum {} x 1

Discussion edit

1. Read the file data
2. Convert the file data to a valid list
3. Reorganize the file data list to have all VRML node attributes in sub lists
4. Evaluate this list with the scheme, that each VRML node name could be the name of a tcl command or procedure. If such a tcl procedure exists, than evaluate it with the VRML node attributes as arguments, if not ignore this VRML node.

 proc algexpr::calc expr {         
    lassign $expr op a b
    switch -exact -- $op {
        +     { expr {[calc $a] + [calc $b]} }
        -     { expr {[calc $a] - [calc $b]} }
        *     { expr {[calc $a] * [calc $b]} }
        /     { expr {[calc $a] / double([calc $b])} }
        const { return $a }
        var   { upvar #0 $a v; return $v }
    }     
 }

 proc calc {self expr env} {
     lassign $expr op a b
     switch -exact -- $op {
         +       { expr {[call $self $a $env] + [call $self $b $env]} }
         -       { expr {[call $self $a $env] - [call $self $b $env]} }
         *       { expr {[call $self $a $env] * [call $self $b $env]} }
         /       { expr {[call $self $a $env] / 
                             double([call $self $b $env])} }
         const   { return $a }
         var     { dict get $env $a }
         default { error "unknown op \"$op\"" }
     }
 }
 # fixpoint operator (similar to Y combinator):
 proc call {cmd args} { uplevel #0 $cmd [linsert $args 0 $cmd] }

 % set datum {/ {- {* {const 2} {var x}} {const 1}} {+ {var x} {const 3}}}
 / {- {* {const 2} {var x}} {const 1}} {+ {var x} {const 3}}
 % call calc $datum {x 1}
 0.25

 proc calcexp {self expr env} {
     lassign $expr op arg
     switch -exact -- $op {
         exp     { expr {exp([call $self $arg $env])} }
         default { calc $self $expr $env }
     }
 }

 % set datum3 {exp {/ {var x} {var y}}}
 exp {/ {var x} {var y}}
 % call calcexp $datum3 {x 2 y 1}
 7.38905609893065

 % call calc $datum3 {x 2 y 1}
 unknown op "exp"

 proc calclam {self expr env} {
     lassign $expr op a b
     switch -exact -- $op {
         lambda  { list closure $a $b $env }
         app     { calcapp $self [call $self $a $env] [call $self $b $env] }
         default { calc $self $expr $env }
     }
 }
 proc calcapp {self f x} {
     lassign $f op arg body env
     switch -exact -- $op {
         closure { call $self $body [dict replace $env $arg $x] }
         default { error "not a closure: \"$f\"" }
     }
 }

 % set f {lambda x {lambda y {* {var x} {var y}}}}
 lambda x {lambda y {* {var x} {var y}}}
 % set exp [list app [list app $f {const 3}] {const 4}]
 app {app {lambda x {lambda y {* {var x} {var y}}}} {const 3}} {const 4}
 % call calclam $exp {} 
 12

 class Expr {
     abstract method visit {visitor}
 }
 class Num val {
     inherit Expr
     method visit {visitor} { $visitor visitNum $val }
 }
 class AddOp a b {
     inherit Expr
     method visit {visitor} { $visitor visitAddOp $a $b }
 }
 ...
 class ExprVisitor {
     abstract method visitNum {val}
     abstract method visitAddOp {a b}
     ...
 }
 class ExprInterp {
     inherit ExprVisitor
     method visitNum {val} { return $val }
     method visitAddOp {a b} { expr {[$a visit $self] + [$b visit $self]} }
     ...
 }
 [AddOp [AddOp [Num 2] [Num 5]] [Num 4]] visit [ExprInterp] ;# => 11

See also edit

parsetcl

Represents the syntactic structure of Tcl code as a list-tree. A wiki user contributed a set of procs that made the list-tree convert itself back to Tcl code when evaluated!

grammar_fa

Has a list-tree representation for regular expressions. Node types are S, ., |, &, *, ?, +, and !.

A little XML parser

Has tree-list representation (inherited from tdom) for XML data. Node types are the tags that may occur, and #text for text content.

Geometry

Represents geometric objects as list-trees, with POINT and VECTOR as leaf node types.

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References