Data commit

Task/Inverted-syntax/Tcl/inverted-syntax-1.tcl

@@ -0,0 +1,84 @@
+# do.tcl --
+#
+#        Tcl implementation of a "do ... while|until" loop.
+#
+# Originally written for the "Texas Tcl Shootout" programming contest
+# at the 2000 Tcl Conference in Austin/Texas.
+#
+# Copyright (c) 2001 by Reinhard Max <Reinhard.Max@gmx.de>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: do.tcl,v 1.6 2004/01/15 06:36:12 andreas_kupries Exp $
+#
+namespace eval ::control {
+
+    proc do {body args} {
+
+	#
+	# Implements a "do body while|until test" loop
+	#
+	# It is almost as fast as builtin "while" command for loops with
+	# more than just a few iterations.
+	#
+
+	set len [llength $args]
+	if {$len !=2 && $len != 0} {
+	    set proc [namespace current]::[lindex [info level 0] 0]
+	    return -code error "wrong # args: should be \"$proc body\" or \"$proc body \[until|while\] test\""
+	}
+	set test 0
+	foreach {whileOrUntil test} $args {
+	    switch -exact -- $whileOrUntil {
+		"while" {}
+		"until" { set test !($test) }
+		default {
+		    return -code error \
+			"bad option \"$whileOrUntil\": must be until, or while"
+		}
+	    }
+	    break
+	}
+
+	# the first invocation of the body
+	set code [catch { uplevel 1 $body } result]
+
+	# decide what to do upon the return code:
+	#
+	#               0 - the body executed successfully
+	#               1 - the body raised an error
+	#               2 - the body invoked [return]
+	#               3 - the body invoked [break]
+	#               4 - the body invoked [continue]
+	# everything else - return and pass on the results
+	#
+	switch -exact -- $code {
+	    0 {}
+	    1 {
+		return -errorinfo [ErrorInfoAsCaller uplevel do]  \
+		    -errorcode $::errorCode -code error $result
+	    }
+	    3 {
+		# FRINK: nocheck
+		return
+	    }
+	    4 {}
+	    default {
+		return -code $code $result
+	    }
+	}
+	# the rest of the loop
+	set code [catch {uplevel 1 [list while $test $body]} result]
+	if {$code == 1} {
+	    return -errorinfo [ErrorInfoAsCaller while do] \
+		-errorcode $::errorCode -code error $result
+	}
+	return -code $code $result
+	
+    }
+}
+
+#usage:
+package require control
+control::do {set i 0; puts "hello world"; incr i} until {$i > 0}

Task/Inverted-syntax/Tcl/inverted-syntax-2.tcl

@@ -0,0 +1,12 @@
+rename unknown __unknown
+proc unknown {args} {
+   if {3 == [llength $args]} {
+      package require control
+      return [control::do {*}$args]
+   } else {
+      return [__unknown {*}$args]
+   }
+}
+#usage
+% {set i 0; puts "hello world"; incr i} until {$i > 0}
+hello world