Tcl Library Source Code

# Import plugins, connecting manager to the core conversion packages.
package ifneeded pt::peg::import::json      1 [list source [file join $dir pt_peg_import_json.tcl]]
package ifneeded pt::peg::import::peg       1 [list source [file join $dir pt_peg_import_peg.tcl]]

# Export core functionality: Conversion from PEG to a specific format.
package ifneeded pt::peg::to::container     1 [list source [file join $dir pt_peg_to_container.tcl]]
package ifneeded pt::peg::to::cparam    1.1.3 [list source [file join $dir pt_peg_to_cparam.tcl]]
package ifneeded pt::peg::to::json          1 [list source [file join $dir pt_peg_to_json.tcl]]
package ifneeded pt::peg::to::param     1.0.1 [list source [file join $dir pt_peg_to_param.tcl]]
package ifneeded pt::peg::to::peg       1.0.2 [list source [file join $dir pt_peg_to_peg.tcl]]
package ifneeded pt::peg::to::tclparam  1.0.2 [list source [file join $dir pt_peg_to_tclparam.tcl]]

# Import core functionality: Conversion from a specific format to PEG.
package ifneeded pt::peg::from::json      1 [list source [file join $dir pt_peg_from_json.tcl]]
package ifneeded pt::peg::from::peg   1.0.3 [list source [file join $dir pt_peg_from_peg.tcl]]

# PARAM runtime.
package ifneeded pt::rde      1.0.3 [list source [file join $dir pt_rdengine.tcl]]

    namespace ensemble create
}

# ### ### ### ######### ######### #########
## API.

proc ::pt::peg::to::cparam::reset {} {
    variable insertcmd {}             ; # -insert-command (hook)
    variable template  @code@         ; # -template
    variable name      a_pe_grammar   ; # -name
    variable file      unknown        ; # -file
    variable user      unknown        ; # -user
    variable self      {}             ; # -self-command
    variable ns        {}             ; # -namespace
    variable def       static         ; # -fun-qualifier
    variable main      __main         ; # -main
    variable indent    0              ; # -indent
    variable comments  1              ; # -comments
    variable prelude   {}             ; # -prelude
    variable statedecl {RDE_PARAM p}  ; # -state-decl
    variable stateref  {p}            ; # -state-ref
    variable strings   p_string       ; # -string-varname
    return
}

proc ::pt::peg::to::cparam::configure {args} {
    variable template
    variable name
    variable file
    variable user
    variable self
    variable ns
    variable def
    variable main
    variable omap
    variable indent
    variable insertcmd
    variable comments
    variable prelude
    variable statedecl
    variable stateref
    variable strings

    if {[llength $args] == 0} {
	return [list \
		    -comments        $comments \
		    -file            $file \
		    -fun-qualifier   $def \
		    -indent          $indent \
		    -insert-command  $insertcmd \
		    -main            $main \
		    -name            $name \
		    -namespace       $ns \
		    -self-command    $self \
		    -state-decl      $statedecl \
		    -state-ref       $stateref \
		    -string-varname  $strings \
		    -template        $template \
		    -user            $user \
		   ]
    } elseif {[llength $args] == 1} {
	lassign $args option
	set variable [string range $option 1 end]
	if {[info exists omap($variable)]} {
	    return [set $omap($variable)]
	} else {
	    # TODO: compute this string dynamically.
	    return -code error "Expected one of -comments, -file, -fun-qualifier, -indent, -insert-cmd, -main, -name, -namespace, -self-command, -state-decl, -state-ref, -string-varname, -template, or -user, got \"$option\""
	}
    } elseif {[llength $args] % 2 == 0} {
	foreach {option value} $args {
	    set variable [string range $option 1 end]
	    if {![info exists omap($variable)]} {
		# TODO: compute this string dynamically.
		return -code error "Expected one of -comments, -file, -fun-qualifier, -indent, -insert-cmd, -main, -name, -namespace, -self-command, -state-decl, -state-ref, -string-varname, -template, or -user, got \"$option\""
	    }
	}
	foreach {option value} $args {
	    set variable $omap([string range $option 1 end])
	    switch -exact -- $variable {
		template {
		    if {$value eq {}} {
			return -code error "Expected template, got the empty string"
		    }
		}
		indent {
		    if {![string is integer -strict $value] || ($value < 0)} {
			return -code error "Expected int > 0, got \"$value\""
		    }
		}
		comments {
		    if {![string is boolean -strict $value]} {
			return -code error "Expected boolean, got \"$value\""
		    }
		}
		insert-cmd -
		statedecl -
		stateref -
		strings -
		self -
		def -
		ns -
		main -

    variable file
    variable user
    variable self
    variable ns
    variable def
    variable main
    variable indent
    variable insertcmd
    variable prelude
    variable statedecl
    variable stateref
    variable strings

    Op::Asm::Setup

    if {$indent} {
	set code [Indent $code $indent]
    }

    set xprelude $prelude ; if {$xprelude ne {}} { set xprelude " $xprelude" }
    set xself    $self    ; if {$xself    ne {}} { append xself { } }

    # I. run code through the insertcmd hook (if specified) to prepare it for embedding
    if {[llength $insertcmd]} {
	set code [{*}$insertcmd $code]
    }

    # II. Phase 1 merge of code into the template.
    #     (Placeholders only in the template)
    lappend map @user@   $user
    lappend map @format@ C/PARAM
    lappend map @file@   $file
    lappend map @name@   $name
    lappend map @code@   $code
    set code [string map $map $template]
    unset map

    # III. Phase 2 merge of code into the template.
    #      (Placeholders in generated code, and template).
    lappend map @statedecl@  $statedecl
    lappend map @stateref@   $stateref
    lappend map @strings@    $strings
    lappend map { @prelude@} $xprelude
    lappend map {@self@ }    $xself
    lappend map @def@        $def
    lappend map @ns@         $ns
    lappend map @main@       $main
    set code [string map $map $code]

    return $code
    # ### ### ### ######### ######### #########
}

# ### ### ### ######### ######### #########
## Internals

proc ::pt::peg::to::cparam::Indent {text n} {
    set b [string repeat { } $n]
    return $b[join [split $text \n] \n$b]
}

proc ::pt::peg::to::cparam::Expression {expression modes} {
    return [pt::pe bottomup \
		[list [namespace current]::Op $modes] \
		$expression]
}

proc ::pt::peg::to::cparam::Symbol {symbol mode rhs modes} {

    set expression [Expression $rhs $modes]

    text::write clear
    Op::Asm::Header "$mode Symbol '$symbol'"
    text::write store FUN_HEADER

    Op::Asm::Start
    Op::Asm::ReExpression $symbol
    Op::Asm::GenAST $expression
    Op::Asm::PE $rhs

    set gen [dict get $result gen]

    Op::Asm::Function sym_$symbol {
	# Message is Tcl list. Quote for C embedding.
	set msg    [Op::Asm::String [char quote cstring [list n $symbol]]]
	# Quote for C embedding.
	set symbol [Op::Asm::String [char quote cstring $symbol]]

	# We have six possibilites for the combination of AST node
	# generation by the rhs and AST generation by the symbol. Two
	# of these (leaf/0, value/0 coincide, leaving 5). This
	# controls the use of AS/ARS instructions.

	switch -exact -- $mode/$gen {

	}]
}

proc ::pt::peg::to::cparam::Op::t {modes char} {
    Asm::Start
    Asm::ReTerminal t $char
    Asm::Direct {
	# Message is Tcl list. Quote for C embedding.
	set msg  [Asm::String [char quote cstring [list t $char]]]
	# Quote for C embedding.
	set char [char quote cstring $char]

	#Asm::Ins input_next $msg
	#Asm::CStmt if (!rde_param_query_st(@stateref@)) return
	#Asm::Ins test_char \"$char\" $msg
	Asm::Ins next_char \"$char\" $msg
    }
    Asm::Done
}

proc ::pt::peg::to::cparam::Op::.. {modes chs che} {
    Asm::Start
    Asm::ReTerminal .. $chs $che
    Asm::Direct {
	# Message is Tcl list. Quote for C embedding.
	set msg [Asm::String [char quote cstring [list .. $chs $che]]]

	# Quote for C embedding
	set chs [char quote cstring $chs]
	set che [char quote cstring $che]

	#Asm::Ins input_next $msg
	#Asm::CStmt if (!rde_param_query_st(@stateref@)) return
	#Asm::Ins test_range \"$chs\" \"$che\" $msg
	Asm::Ins next_range \"$chs\" \"$che\" $msg
    }
    Asm::Done
}

proc ::pt::peg::to::cparam::Op::str {modes args} {
    Asm::Start
    Asm::ReTerminal str {*}$args
    Asm::Direct {
	set str [join $args {}]
	# Message is Tcl list. Quote for C embedding.
	set msg [Asm::String [char quote cstring [list str $str]]]
	# Quote for C embedding
	set str [char quote cstring $str]

	# Without fusing this would be rendered as a sequence of
	# characters, with associated stack churn for each
	# character/part (See Op::x, void/all).

	Asm::Ins next_str \"$str\" $msg
    }
    Asm::Done
}

proc ::pt::peg::to::cparam::Op::cl {modes args} {
    # rorc = Range-OR-Char-List
    Asm::Start
    Asm::ReTerminal cl {*}$args
    Asm::Direct {
	# Without fusing this would be rendered as a choice of
	# characters, with associated stack churn for each
	# character/branch (See Op::/, void/all).

	set cl  [join [Ranges {*}$args] {}]
	# Message is Tcl list. Quote for C embedding.
	set msg [Asm::String [char quote cstring [list cl $cl]]]
	# Quote for C embedding
	set cl  [char quote cstring $cl]

	Asm::Ins next_class \"$cl\" $msg
    }
    Asm::Done
}

proc ::pt::peg::to::cparam::Op::Ranges {args} {
    set res {}
    foreach rorc $args { lappend res [Range $rorc] }

	set res {}
	for {set i $s} {$i <= $e} {incr i} {
	    append res [format %c $i]
	}
	return $res
    } else {
	return $rorc ;#[char quote tcl $rorc]
    }
}

proc ::pt::peg::to::cparam::Op::n {modes symbol} {
    # symbol mode determines AST generation
    # void       => non-generative,
    # leaf/value => generative.

    # Map from option name (without leading dash) to the name of the
    # variable used to store setting.
    variable omap ; array set omap {
	comments        comments
	file            file
	fun-qualifier   def
	indent          indent
	insert-cmd      insertcmd
	main            main
	name            name
	namespace       ns
	prelude         prelude
	self-command    self
	state-decl      statedecl
	state-ref       stateref
	string-varname  strings
	template        template
	user            user
    }

    variable insertcmd {}
    variable comments  1
    variable self      {}
    variable ns        {}
    variable def       static
    variable main      __main
    variable indent    0
    variable prelude   {}
    variable statedecl {RDE_PARAM p}
    variable stateref  p
    variable strings   p_string

    variable template @code@       ; # A string. Together with the
				     # insertcmd (if any) it specifies
				     # how to embed the generated code
				     # into a larger framework (the
				     # template).
    variable name     a_pe_grammar ; # String. Name of the grammar.
    variable file     unknown      ; # String. Name of the file or
				     # other entity the grammar came
				     # from.
    variable user     unknown      ; # String. Name of the user on
				     # which behalf the conversion has
				     # been invoked.
}

# ### ### ### ######### ######### #########
## Ready

package provide pt::peg::to::cparam 1.1.3
return

# peg_to_param.tcl --
#
#	Conversion of PEG to PARAM assembler.
#
# Copyright (c) 2009-2014 Andreas Kupries <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: pt_peg_to_param.tcl,v 1.1 2010/03/26 05:07:24 andreas_kupries Exp $

# This package takes the canonical serialization of a parsing

proc ::pt::peg::to::param::Op::t {modes char} {
    variable ::pt::peg::to::param::inline
    Asm::Start
    Asm::ReTerminal t $char
    if {$inline} {
	Asm::Direct {
	    set c [char quote string $char]

	    Asm::Ins input_next "\"t $c\""
	    Asm::Ins ok! test_char \"$c\"
	}
    } else {
	Asm::Function [Asm::NewBlock char ] {
	    set c [char quote string $char]

	    Asm::Ins input_next "\"t $c\""
	    Asm::Ins ok! test_char \"$c\"
	}
    }
    Asm::Done
}

proc ::pt::peg::to::param::Op::.. {modes chstart chend} {
    variable ::pt::peg::to::param::inline
    Asm::Start
    Asm::ReTerminal .. $chstart $chend
    if {$inline} {
	Asm::Direct {
	    set s [char quote string $chstart]
	    set e [char quote string $chend]

	    Asm::Ins input_next "\".. $s $e\""
	    Asm::Ins ok! test_range \"$s\" \"$e\"
	}
    } else {
	Asm::Function [Asm::NewBlock range] {
	    set s [char quote string $chstart]
	    set e [char quote string $chend]

	    Asm::Ins input_next "\".. $s $e\""
	    Asm::Ins ok! test_range \"$s\" \"$e\"
	}
    }
    Asm::Done
}

				     # which behalf the conversion has
				     # been invoked.
}

# ### ### ### ######### ######### #########
## Ready

package provide pt::peg::to::param 1.0.1
return

	}]
}

proc ::pt::peg::to::tclparam::Op::t {modes char} {
    Asm::Start
    Asm::ReTerminal t $char
    Asm::Direct {
	set char [char quote tcl $char]

	#Asm::Ins i_input_next "\{t $char\}"
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_char $char

	Asm::Ins si:next_char $char
    }
    Asm::Done
}

proc ::pt::peg::to::tclparam::Op::.. {modes chs che} {
    Asm::Start
    Asm::ReTerminal .. $chs $che
    Asm::Direct {
	set chs [char quote tcl $chs]
	set che [char quote tcl $che]

	#Asm::Ins i_input_next "\{.. $chs $che\}"
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_range $chs $che

	Asm::Ins si:next_range $chs $che
    }
    Asm::Done
}

proc ::pt::peg::to::tclparam::Op::str {modes args} {
    Asm::Start
    Asm::ReTerminal str {*}$args
    Asm::Direct {


	# Without fusing this would be rendered as a sequence of
	# characters, with associated stack churn for each character/part
	# (See Op::x, void/all).

	set str [join $args {}]
	set str [char quote tcl $str]

	Asm::Ins si:next_str $str
    }
    Asm::Done
}

proc ::pt::peg::to::tclparam::Op::cl {modes args} {
    # rorc = Range-OR-Char-List
    Asm::Start
    Asm::ReTerminal cl {*}$args
    Asm::Direct {
	# Without fusing this would be rendered as a choice of
	# characters, with associated stack churn for each
	# character/branch (See Op::/, void/all).

	set cl [join [Ranges {*}$args] {}]
	set cl [char quote tcl $cl]

	Asm::Ins si:next_class $cl
    }
    Asm::Done
}

proc ::pt::peg::to::tclparam::Op::Ranges {args} {
    set res {}
    foreach rorc $args { lappend res [Range $rorc] }
    return $res
}

proc ::pt::peg::to::tclparam::Op::Range {rorc} {
    # See also pt::peg::to::peg

    # We use string ops here to distinguish terminals and ranges. The
    # input can be a single char, not a list, and further the char may
    # not be a proper list. Example: double-apostroph.

	set res {}
	for {set i $s} {$i <= $e} {incr i} {
	    append res [format %c $i]
	}
	return $res
    } else {
	return $rorc ;#[char quote tcl $rorc]
    }
}

proc ::pt::peg::to::tclparam::Op::n {modes symbol} {
    # symbol mode determines AST generation
    # void       => non-generative,
    # leaf/value => generative.

				     # which behalf the conversion has
				     # been invoked.
}

# ### ### ### ######### ######### #########
## Ready

package provide pt::peg::to::tclparam 1.0.2
return