Artifact f2e1592d16c84bcb3371f79beb1ab1d63d43518d:

• File packages/parser/lib/scripted_prototype.tcl — part of check-in [6842ef1911] at 2015-11-03 13:10:04 on branch trunk — Rename various packages in list format .

  First commit of sql .

  Early version of entity-attribute-value model in test/lib/data.tcl . It has a context column , but the idea of using an events and attributes in the "what" colun comes in the next changeset . (user: pooryorick size: 3202)

#! /bin/env tclsh

package require ycl::knit
namespace import [yclprefix]::knit::knead
namespace import [yclprefix]::knit::knit
package require ycl::parse::tcl::commands
namespace import [yclprefix]::parse::tcl::commands
package require {ycl proc}
namespace import [yclprefix]::proc::checkargs

package require {ycl shelf}
namespace import [yclprefix]::shelf

shelf new [namespace current]


variable doc::init {
	args {
		_ {
			description {
				this instance
			}
		}
		states {
			description {
				The states script for this parser
			}
		}
	}
}
proc init {_ args} {
	checkargs doc::init
	$_ $ states [$_ states $states]
	return $_
}
[namespace current] method init

proc parse {_ nodes} {
	upvar 0 [$_ ns]::sindex sindex
	upvar 0 [$_ ns]::states states
	set sindex 0

	set defaultbody {
		upvar 0 [$_ ns]::parsed
		lappend [$_ $.locate parsed] $value
	}

	puts [list stooble $nodes]

	foreach node $nodes {
		if {$sindex >= [llength $states]} break 
		set func [lindex $states $sindex]
		puts [list bloomfallow [string trim [$node text]]]
		::apply $func $_ $node [string trim [$node text]]
	}

	if {$sindex < [llength $states]} {
		error [list {failed to parse} {last node was} [lindex $states $sindex]]
	}

}
[namespace current] method parse

proc repeat {_ args} {
	upvar 0 [$_ ns]::sindex sindex
	incr sindex -1
}
[namespace current] method repeat

proc reset {_} {
	set sindex 0
}
[namespace current] method reset


variable doc::states {
	args {
		_ {
			description {
				the current object
			}
		}
		spec {
			description {
				a script describing the parser behaviour
			}
		}
		debugging {
			description {
				add debugging output to parsing steps
			}
			default {lindex 0}
		}
	}
}
proc states {_ spec args} {
	checkargs doc::states
	set states {}
	foreach command [commands $spec] {
		lassign {} first pattern body otherwise
		set mode match
		if {[llength $command] == 5} {
			lassign $command first mode pattern body otherwise
		}
		if {[llength $command] == 4} {
			lassign $command mode pattern body otherwise
		} elseif {[llength $command] == 3} {
			lassign $command mode pattern body 
		} elseif {[llength $command] == 2} {
			lassign $command pattern body
		} elseif {[llength $command] == 1} {
			lassign $command body
			set mode expr
			set pattern 1
			if {[string trim $body] eq {}} {
				set body $defaultbody
			}
		} else {
			error [list {wrong # arguments} $command]
		}
		set condition [apply [knead {mode pattern} {
			dict get {
				equal {if {$value eq ${pattern}}}
				expr {if {#{pattern}}}
				match  {if {[string match ${pattern} $value]}}
				re {if {[regexp ${pattern} $value]}}
			} ${mode}
		}] $mode $pattern]

		if {$debugging} {
			set debug {
				puts stderr "\n\nvalue: $value"
				puts stderr "condition: ${condition}"
			}
		} else {
			set debug {}
		}

		set func [apply [knead {first condition body otherwise debug} {
			list {_ node value} {
				upvar 0 [$_ ns]::sindex sindex
				#{first}

				#{debug}

				#{condition} {
					#{body}
					incr sindex
				} else {
					#{otherwise}
				}
			}
		}] $first $condition $body $otherwise $debug]
		lappend states [list {*}$func [$_ ns]]
	}
	return $states
}
[namespace current] method states