update of various scripts in tests folder

scriptlib/tests/Lfilter.tcl

@@ -0,0 +1,38 @@
+struct::list::Lfilter {a apple b aardvark c} {
+    @@ok/result.= {
+        pipeswitch { 
+                        puts "c0: [string range $switchargs 0 0]"
+                        pipecase .= ,'a'.= string range $switchargs 0 0 |> {val 1}
+                        val {ok {result 0}}  
+                   } $in
+    } |> {puts $data; set data}  <in|
+}
+
+
+
+pipeset pipeb @@ok/result.= {
+        pipeswitch { 
+                        pipecase .= ,'b'.= string range $switchargs 0 0 |> {val 1}
+                        val {ok {result 0}}  
+                   } $in
+    }  <in|
+    
+    
+puts stdout [struct::list::Lfilter {a apple b aardvark banana blah c} $pipeb]
+
+
+pipeset pipec @@ok/result.=in/end \
+        pipeswitch { 
+            pipecase .= ,'c'.= string range $switchargs 0 0 |> {val 1}
+            val {ok {result 0}}  
+        }  <in|
+    
+    
+puts stdout [struct::list::Lfilter {a apple b aardvark banana blah c charlie chocolate} $pipec]
+
+
+
+#>f . reduce {.=* list |> {join $data ":"} <|}  {a b c d e f}
+
+
+

scriptlib/tests/block_padleft.tcl

@@ -0,0 +1,9 @@
+package require punk
+package require patternpunk
+
+pipealias block_padleft .= {list $input [string repeat " " $indent]} |/0,padding/1> linelist |> .= {lmap v $data {val "$padding$v"}} |> list_as_lines <input/0,indent/1|
+
+puts stdout "block_padleft pipeline"
+puts stdout "[alias block_padleft]"
+puts stderr "block_padleft \[>punk . logo] 50"
+puts stdout "[block_padleft [>punk . logo] 50]"

scriptlib/tests/curry_assign.tcl

@@ -1,21 +1,28 @@
-puts stdout "test long pipeline can be curried with simple c=x.=d e |> f etc  assignment  (no space after =)"
+set sep [string repeat - 50]
+puts stdout "test long pipeline can be curried with pipeset c= x.= d e |> f etc  assignment  "
 
-puts stdout "c=x.={5*3} |p1> y.= expr 3 * |p2> {set debug \"val is \$data\";set data}  |debug> z.= 2 + |> { set data} |> {puts stderr \"debug:\$debug\n p1:\$p1\np2:\$p2\"; set data}"
+#puts stdout "pipeset c x.= expr 5 * |p1> y.= expr 3 * |p2> {set debug \"val is \$data\";inspect $data}  |debug> z.= expr 2 +  |> {puts stderr \"debug:\$debug\n p1:\$p1\n p2:\$p2\"; inspect $data} <|"
 
-c=x.={5*3} |p1> y.= expr 3 * |p2> {set debug "val is $data";set data}  |debug> z.= 2 + |> { set data} |> {puts stderr "debug:$debug\n p1:$p1\np2:$p2"; set data}
 
-puts stdout "method1 using \$c"
+pipeset c x.=* expr 5 * |p1> y.= expr 3 * |p2> {set debug "val is $data";inspect -label inspect1 $data ; list $debug $data}  |debug/0,data/1> z.= expr 2 + |>  {puts stderr "debug:$debug\n p1:$p1\n p2:$p2"; inspect -label inspect2 $data} <|
-$c
-set answer [$c]
 
-puts stdout "set answer \[\$c\]"
+
+puts stderr $sep
+puts stderr "$c"
+puts stderr $sep
+
+
+
+puts stderr $sep
+puts stdout "method1: set answer \[{*}\$c\ 3]"
+set answer [{*}$c 3]
 puts stdout "  $answer"
+puts stderr $sep
 
-puts stdout "method2 using eval \$c"
-eval $c
 
-set answer2 [eval $c]
+puts stderr $sep
-puts stdout "set answer2 \[eval \$c\]"
+puts stdout "method2: set answer2 \[eval \$c\ 3]"
+set answer2 [eval $c 3]
 puts stdout "  $answer2"
 
 puts stdout "-done-"

scriptlib/tests/first_assign.tcl

@@ -0,0 +1,14 @@
+#experiment with the dangers of substitution in the first position after = in pipelines
+
+puts stdout {set i {"a b "}}
+set i {"a b "}
+
+catch {
+% x=$i
+} errm
+puts stderr "% x=\$i   -> $errm"
+
+% "x=$i"
+
+#%x="a b "
+

scriptlib/tests/fn.tcl

@@ -0,0 +1,320 @@
+package provide funcl [namespace eval funcl {
+    variable version
+    set version 0.1
+}]
+#funcl = function list  (nested call structure)
+#
+#a basic functional composition o combinator
+#o(f,g)(x) == f(g(x))
+
+namespace eval funcl {
+
+    #from punk
+    proc arg_is_script_shaped {arg} {
+            if {[string first " " $arg] >= 0} {
+                return 1
+            } elseif {[string first \n $arg] >= 0} {
+                return 1
+            } elseif {[string first ";" $arg] >= 0} {
+                return 1
+            } elseif {[string first \t $arg] >= 0} {
+                return 1
+            } else {
+                return 0
+            }
+    }
+
+
+    proc o args {
+        set   closing [string repeat {]} [expr [llength $args]-1]]
+        set   body   "[join $args { [}] \$data $closing"
+        return $body
+    }
+
+    proc o_ args {
+        set body ""
+        set tails [lrepeat [llength $args] ""]
+        puts stdout "tails: $tails"
+        
+        set end [lindex $args end]
+        if {[llength $end] == 1 && [arg_is_script_shaped $end]} {
+            set endfunc [string map [list <end> $end] {uplevel 1 [list if 1 <end> ]}]
+        } else {
+            set endfunc $end
+        }
+        if {[llength $args] == 1} {
+            return $endfunc
+        }
+        
+        set wrap { [}
+        append wrap $endfunc
+        append wrap { ]}
+        
+        set i 0
+        foreach cmdlist [lrange $args 0 end-1] {
+            set is_script 0
+            if {([llength $cmdlist] == 1) && [arg_is_script_shaped [lindex $cmdlist 0]]} {
+                set is_script 1
+                set script [lindex $cmdlist 0]
+            }
+            set t ""
+            if {$i > 0} {
+                append body { [}
+            }
+            set posn [lsearch $cmdlist _]
+            if {$posn <= 0} {
+                append body $cmdlist
+                if {$i == [expr {[llength $args] -2}]} {
+                    #append body " \$data"
+                    append body " $wrap"
+                }
+                if {$i > 0} {
+                    set t {]}
+                }
+            } else {
+                append body [lrange $cmdlist 0 $posn-1]
+                if {$i == [expr {[llength $args] -2}]} {
+                    #append body " \$data"
+                    append body " $wrap"
+                }
+                set t [lrange $cmdlist $posn+1 end]
+                if {$i > 0} {
+                    append t { ]}
+                }
+            }
+            lset tails $i $t
+            incr i
+        }
+        append body [join [lreverse $tails] " "]
+        puts stdout "tails: $tails"
+        
+        return $body
+     }
+
+    #review -  consider _call -- if count > 1 then they must all be callable cmdlists(?) 
+    # what does it mean to have additional _fn wrapper with no other elements? (no actual function)
+    #e.g  _fn 2 5 6 somefunc {_fn 1 3 {_call 1 3 xxx}} {_fn 1 4 command {_fn ...}}
+    # what type indicates running subtrees in parallel vs sequentially?
+    # any reason to have _call count other than 1? Presumably the parent node indicates the parallelism/sequentialism etc.
+    #
+    #
+    # accept or return a funcl (or funcltree if multiple funcls in one commandlist)
+    # also accept/return a call -  return empty list if passed a call
+    proc next_funcl {funcl_or_tree} {
+        if {[lindex $funcl_or_tree 0] eq "_call"} {
+            return [list]
+        }
+        if {[lindex $funcl_or_tree 0] in [list "_fn" "_call"]} {
+            set funcl $funcl_or_tree
+        } else {
+            error "funcltree not implemented"
+        }
+
+
+        set count [lindex $funcl 1]
+        if {$count == 0} {
+            #null funcl.. what is it? metadata/placeholder?
+            return $funcl
+        }
+        set indices [lrange $funcl 2 [expr {1 + $count}]]
+        set i 0
+        foreach idx $indices {
+            if {$i > 0} {
+                #todo - return a funcltree 
+                error "multi funcl not implemented"
+            }
+            set next [lindex $funcl $idx]
+            incr i
+        }
+        
+        return $next
+
+    }
+    
+    #convert a funcl to a tcl script
+    proc funcl_script {funcl} {
+        if {![llength $funcl]} {
+            return ""
+        }
+        set body ""
+        set tails [list]
+        
+        set type [lindex $funcl 0]
+        if {$type ni [list "_fn" "_call"]} {
+            #todo - handle funcltree 
+            error "type $type not implemented"
+        }
+        
+        
+        #only count of 1 with index 3 supported(?)
+        if {$type eq "_call"} {
+            #leaf
+            set cmdlist [lindex $funcl 3]
+            return $cmdlist
+        }
+        
+        #we will use next_funcl to walk the nodes.. todo support treefuncl response from next_funcl which could branch multiple times.
+        #by continually passing back the resulting treefuncl/funcl to next_funcl we can process in correct order (?)
+        # we would still need to maintain state to stitch it back together once returned from a subtree..
+        # ie multiple tail parts
+        set count [lindex $funcl 1]
+        
+        if {$count == 1} {
+            set idx [lindex $funcl 2]
+            if {$idx == 3} {
+                set cmdlist_pre [list]
+            } else {
+                set cmdlist_pre [lrange $funcl 3 $idx-1]
+            }
+            append body $cmdlist_pre
+            set t [lrange $funcl $idx+1 end]
+            lappend tails $t
+        } else {
+            #?? 
+            error "funcl_script branching not yet supported"
+        }
+        
+        
+        set get_next 1
+        set i 1
+        while {$get_next} {
+            set funcl [next_funcl $funcl]
+            if {![llength $funcl]} {
+                set get_next 0
+            }
+            lassign $funcl type count idx ;#todo support count > 1
+            if {$type eq "_call"} {
+                set get_next 0
+            }
+            set t ""
+            if {$type eq "_call"} {
+                append body { [}
+                append body [lindex $funcl $idx]
+                append body { ]}
+            } else {
+                append body { [}
+                if {$idx == 3} {
+                    set cmdlist_pre [list]
+                } else {
+                    set cmdlist_pre [lrange $funcl 3 $idx-1]
+                }
+                append body $cmdlist_pre
+                set t [lrange $funcl $idx+1 end]
+                lappend tails $t
+                lappend tails { ]}
+            }
+            incr i
+        }
+        append body [join [lreverse $tails] " "]
+        #puts stdout "tails: $tails"
+        
+        return $body
+    }
+
+
+    interp alias "" o_of "" o_of_n 1
+
+    #o_of_n
+    #tcl list rep o combinator
+    #
+    #  can take lists of ordinary commandlists, scripts and funcls
+    # _fn 1 x where 1 indicates number of subfuncls and where x indicates next funcl position (_fn list or _arg)
+    # _fn 0 indicates next item is an unwrapped commandlist (terminal command)
+    #
+    #o_of is equivalent to o_of_n 1   (1 argument o combinator)
+    #last n args are passed to the prior function 
+    #e.g  for n=1  f a b =  f(a(b))
+    #e.g for n=2, e f a b =  e(f(a b))
+    proc o_of_n {n args} {
+        if {$n != 1} {
+            error "o_of_n only implemented for 1 sub-funcl"
+        }
+        set comp [list] ;#composition list
+        set end [lindex $args end]
+        if {[lindex $end 0] in [list "_fn" "_call"]} {
+            #is_funcl
+            set endfunc [lindex $args end]
+        } else {
+            if {[llength $end] == 1 && [arg_is_script_shaped $end]} {
+                #set endfunc [string map [list <end> $end] {uplevel 1 [list if 1 <end> ]}]
+                set endfunc [list _call 1 3 [list uplevel 1 [list if 1 [lindex $end 0]]]]
+            } else {
+                set endfunc [list _call 1 3 [list {*}$end]]
+            }
+        }
+        
+        if {[llength $args] == 1} {
+            return $endfunc
+        }
+        set comp $endfunc
+        set revlist [lreverse [lrange $args 0 end-1]]
+        foreach cmdlist $revlist {
+            if {([llength $cmdlist] == 1) && [arg_is_script_shaped [lindex $cmdlist 0]]} {
+                set is_script 1
+                set script [lindex $cmdlist 0]
+                set arglist [list data]
+                
+                set comp [list _fn 1 6 call_script $script $arglist $comp] 
+            } else {
+                set posn1 [expr {[llength $cmdlist] + 2 + $n}]
+                set comp [list _fn $n $posn1 {*}$cmdlist $comp]
+            }
+        } 
+        return $comp
+    }
+    proc call_script {script argnames args} {
+        uplevel 3 [list if 1 [list apply [list $argnames $script] {*}$args]]
+    } 
+    proc funcl_script_test {scr} {
+        do_funcl_script_test $scr
+    }
+    proc do_funcl_script_test {scr} {
+        #set j "in do_funcl_script_test"
+        #set data "xxx"
+        #puts '$scr'
+        if 1 $scr
+    }
+
+    #standard o_ with no script-handling
+     proc o_plain args {
+        set body ""
+        set i 0
+        set tails [lrepeat [llength $args] ""]
+        #puts stdout "tails: $tails"
+        foreach cmdlist $args {
+            set t ""
+            if {$i > 0} {
+                append body { [}
+            }
+            set posn [lsearch $cmdlist _]
+            if {$posn <= 0} {
+                append body $cmdlist
+                if {$i == [expr {[llength $args] -1}]} {
+                    append body " \$data"
+                }
+                if {$i > 0} {
+                    set t {]}
+                }
+            } else {
+                append body [lrange $cmdlist 0 $posn-1]
+                if {$i == [expr {[llength $args] -1}]} {
+                    append body " \$data"
+                }
+                set t [lrange $cmdlist $posn+1 end]
+                if {$i > 0} {
+                    append t { ]}
+                }
+            }
+            lset tails $i $t
+            incr i
+        }
+        append body [join [lreverse $tails] " "]
+        #puts stdout "tails: $tails"
+        
+        return $body
+     }
+    #timings suggest no faster to split out the first item from the cmdlist loop
+}    
+
+ 
+ 

scriptlib/tests/fun.tcl

@@ -0,0 +1,392 @@
+
+#slow - but basically works. Needs pipeline compilation to tcl script to speed up?  funcl?
+package require punk
+
+
+#todo - pinned vars.. what scope? add a facility to bake values into proc body? (what equivalent is there for pipelines not bound to a proc scope? apply?)
+#if a fun is intended to bind in the caller's scope - then we just need a way to return the fun contents as a runnable pipeline
+# - conflict between build-time and run-time pinned vars? Is this really 2 separate concepts?
+# - using a pin to help build up the pattern vs using the pin for pipelined/context data?
+# - unpinned vars are clearly required in the implementation bodies - which is 'pipeline' scope only.. and limited to the running clause.
+#pipefun::setvar ?
+#consider oo version that uses properties of the object as the pinned vars in the pattern-spec?
+#pinned vars are important to be able to pass more complex values than are allowed by the pattern mini-lang e.g paths /etc  (or is that a misuse???)
+
+#what does a pin on the argspec <^var|  even mean?  other vars in <| are pure pipeline scope 
+# pins in intermediate pipes.. e.g  |^somevar@1>  could be used as sanity checks for pipeline-scope vars.. but is there a real need/usecase?
+
+
+namespace eval pipefun {
+    variable funs [dict create]
+}
+
+
+#note this isn't a 'standard' closure in the sense that the captured vars aren't modifiable - a coro or object could be used to hold state if that is required.
+proc pipefun::closure0 {body} {
+    set binding {}
+    foreach v [uplevel 1 info locals] {
+        upvar 1 $v var
+        if {[info exists var]} {
+            lappend binding [list $v $var] ;#values captured as defaults for apply args.
+        }
+    }
+    return [list apply [list $binding $body [uplevel 1 namespace current]]]
+}
+
+#much slower attempting to upvar all at once with different varnames
+proc pipefun::closure1 {body} {
+    set binding {}
+    if {[info level] == 1} {
+        #up 1 is global 
+        set get_vars [list info vars]
+    } else {
+        set get_vars [list info locals]
+    }
+    set upinfo [uplevel 1 "list \[{*}$get_vars\] \[namespace current\]"]
+    lassign $upinfo vars ns
+    #puts stdout ">>> got vars:$vars ns:$ns"
+    
+    set pairs [lmap v $vars i [lsearch -all $vars *] {list $v v$i}]
+    set flatpairs [concat {*}$pairs]
+    upvar 1 {*}$flatpairs
+    #puts stdout ">>> $flatpairs"
+    foreach {v vi} $flatpairs {
+        if {![array exists $vi] && [info exists $vi]} {
+            lappend binding [list $v [set $vi]] ;#values captured as defaults for apply args.
+        }
+    }
+    return [list apply [list $binding $body $ns]]
+}
+proc pipefun::closure1 {body} {
+    set binding {}
+    if {[info level] == 1} {
+        #up 1 is global 
+        set get_vars [list info vars]
+    } else {
+        set get_vars [list info locals]
+    }
+    set upinfo [uplevel 1 "list \[{*}$get_vars\] \[namespace current\]"]
+    lassign $upinfo vars ns
+    #puts stdout ">>> got vars:$vars ns:$ns"
+    foreach v $vars {
+        upvar 1 $v var
+        if {![array exists var] && [info exists var]} {
+            lappend binding [list $v $var] ;#values captured as defaults for apply args.
+        }
+    }
+    return [list apply [list $binding $body $ns]]
+}
+proc pipefun::closure {body} {
+    set binding {}
+    if {[info level] == 1} {
+        #up 1 is global 
+        set get_vars [list info vars]
+    } else {
+        set get_vars [list info locals]
+    }
+    #set upinfo [uplevel 1 "list \[{*}$get_vars\] \[namespace current\]"]
+    #lassign $upinfo vars ns
+    #puts stdout ">>> got vars:$vars ns:$ns"
+    foreach v [uplevel 1 {*}$get_vars] {
+        upvar 1 $v var
+        if {(![array exists var]) && [info exists var]} {
+            lappend binding [list $v $var] ;#values captured as defaults for apply args.
+        }
+    }
+    return [list apply [list $binding $body [uplevel 1 namespace current]]]
+}
+
+
+proc pipefun::funs {{glob *}} {
+    variable funs
+    return [dict keys $funs $glob]
+}
+
+proc pipefun::testpattern {pattern val} {
+    set d [apply {{mv res} {
+        punk::_multi_bind_result $mv $res -levelup 1
+    }} $pattern $val]
+    #set r [_handle_bind_result $d]
+    #set pipedvars [dict get $d setvars]
+    return $d
+} 
+
+proc pipefun::funclear {nameglob} {
+    variable funs
+    foreach k [dict keys $funs $nameglob] {
+        dict unset funs $k
+    }
+}
+proc pipefun::funinfo {name} {
+    package require overtype
+    variable funs
+    set keys [dict keys [dict get $funs $name defs]]
+    set out     "fun: $name\n"
+    append out  "clause_count: [llength $keys]\n"
+    #append out  [punk::list_as_lines $keys]
+    set maxwidth [expr {[string length Pattern] + 2}]
+    foreach k $keys {
+        set w [string length $k]
+        if {$w > $maxwidth} {
+            set maxwidth $w
+        }
+    }
+    set col1 [string repeat " " [expr {$maxwidth + 2}]]
+    set linewidth [expr {[string length $col1] + 1 + [string length LineCount]}]
+    set dashes [string repeat - $linewidth]
+    append out $dashes\n
+    append out "[overtype::left $col1 Pattern] LineCount\n"
+    append out $dashes\n
+    foreach k $keys {
+        set body [dict get $funs $name defs $k]
+        set linecount [llength [split $body \n]]
+        append out "[overtype::left $col1 $k] [$linecount]\n"
+    }
+    append out $dashes\n
+    return $out
+}
+proc pipefun::funclause {name match args} {
+    variable funs
+    set defaults [list -delete 0 -active 1]
+    if {([llength $args] % 2) != 0} {
+       error "funclause options must be in pairs. Known options: [dict keys $defaults]"
+    }
+    set opts [dict merge $defaults $args]
+
+    if {[dict exists $funs $name defs $match]} {
+        set body [dict get $funs $name defs $match]
+        if {[dict get $opts -delete]} {
+            dict unset funs $name defs $match
+        }
+    
+        return $body
+    } else {
+        return "no clause '$match'"
+    }
+}
+
+#todo - examine arity of call and limit cases tested?
+proc pipefun::fun_proc {name argspec body} {
+    variable funs
+    
+    if {[dict exists $funs $name]} {
+        set definitions [dict get $funs $name defs]
+        dict set definitions $argspec $body ;#add or override
+        dict set funs $name defs $definitions ;#write-back
+    } else {
+        #first implementations
+        dict set funs $name defs [dict create $argspec $body]
+    }
+
+    if {[llength [info commands $name]]} {
+        if {[catch {info body $name} body1]} {
+            error "fun: unable to update function '$name' - not a proc"
+        }
+    } else {
+        set body1 ""
+    }
+
+    #what is the point of <argspec> at beginning?
+    set test_case_template {
+        pipecase <argspec>.= list {*}$arglist |args> {
+            <body>
+        } <<argspec>| {*}$arglist 
+    }
+    set case_template1 {
+        pipecase .= list {*}$arglist |args> {
+            <body>
+        } <<argspec>| {*}$arglist 
+    }
+    set case_template {
+        pipecase .= {
+            <body>
+        } <<argspec>| {*}$switchargs
+    }
+
+    set pipecases ""
+    
+    set definitions [dict get $funs $name defs]
+    dict for {a b} $definitions {
+        set impl [string map [list <argspec> $a <body> $b] $case_template]
+        append pipecases ${impl}
+    }
+    set nsup [uplevel 1 [list namespace current]]
+    if {$nsup eq "::"} {
+        set nsup ""
+    }
+    if {![string match "::*" $name]} {
+        set name "${nsup}::$name"
+    }
+    
+    proc $name args [string map [list <pipecases> $pipecases] {
+        pipeswitchc {
+            <pipecases>
+        } $args
+    }]
+    
+    
+}
+
+proc pipefun::fun {name argspec body} {
+    variable funs
+    if {[dict exists $funs $name]} {
+        set definitions [dict get $funs $name defs]
+        dict set definitions $argspec $body ;#add or override
+        dict set funs $name defs $definitions ;#write-back
+    } else {
+        #first implementations
+        dict set funs $name defs [dict create $argspec $body]
+    }
+    if {[llength [info commands $name]]} {
+        if {![llength [interp alias "" $name]]} {
+            error "fun: unable to update function '$name' - not an alias"
+        }
+    }
+    
+    set pipecases ""
+    set definitions [dict get $funs $name defs]
+    dict for {a b} $definitions {
+        #set impl [string map [list <argspec> $a <body> $b] $case_template]
+        #append pipecases ${impl}
+        
+        set case [list pipecase .= $b <$a|]
+        
+        #set case [list pipecase ,$a= |$a> .= $b <|]
+        
+        
+        append  case { {*}$switchargs}
+        #we can't maintain case as a proper list.. because it isn't. (contains {*}$xxx)
+        append pipecases $case\n
+    }
+    set nsup [uplevel 1 [list namespace current]]
+    if {$nsup eq "::"} {
+        set nsup ""
+    }
+    #if {![string match "::*" $name]} {
+    #    set name "${nsup}::$name"
+    #}
+    
+    #proc $name args [string map [list <pipecases> $pipecases] {
+    #    % .= {
+    #        pipeswitch {
+    #            <pipecases>
+    #        }
+    #    } <arglist| {*}$args
+    #}]
+    puts "creating alias '$name'"
+    interp alias {} $name {} pipeswitchc $pipecases 
+    
+    
+}
+
+
+interp alias {} fun {} pipefun::fun
+interp alias {} funs {} pipefun::funs
+interp alias {} funclear {} pipefun::funclear
+interp alias {} funinfo {} pipefun::funinfo
+interp alias {} funclause {} pipefun::funclause
+
+fun age argc#,v@0-end {
+    #always runs for age - falls through to other implementations
+    puts "age called with argc:$argc args:$v"
+    error [list ignore]
+    }
+
+#only runs for exactly 2 args
+fun age a@,m@,2# {
+        puts "You're $a!  $m"
+        # pipematch r@@ok/resultx.= age $a
+    }
+
+
+#experiment with match but return error instead of ok {result xxx}
+fun age a {
+    % switchresult.= pipeswitch {
+        #puts "testing-arguments: $a"
+        if {![info exists a]} {
+            error [list ignore no-arg]
+        }
+        pipecase .= val $a |a@0> \
+        0.= {
+            string is integer -strict $a
+        }       |> {
+            puts stderr "age must be an integer"
+            val " bad arg '$a' - must be an integer"
+        }
+        
+    }
+    #puts stdout ">>> $switchresult"
+    % status@@/@0.= val $switchresult
+    % contents@1.= val $switchresult
+    puts stdout ">>> $switchresult"
+    
+    #an ordinary return value (extracted from @@ok/result above) will get wrapped in  'ok {result <value>}' which can be confusing if the result is supposed to indicate a fault
+    #return $status
+    #even worse if we return switchresult as we would get a double @@ok/result
+    
+    #pipeswitch can return @@ok/result or @@error 
+    #  we could use something like:
+    #if {[$status eq "error"]} {...}
+    # or
+    #if {$status eq "ok"} {...}
+    # or just use error "switcherror ..." directly in the above pipecase, which would propagate through as an error
+    
+    
+    
+        #wrapping in own error-bag doesn't really help as the outer ok wrapping will still get applied
+        #return [list error {reason "bad arg"}]
+
+        #raising a normal error in the above pipeswitch or anywhere in the fun results in an @@error/reason *return value*
+        #(as opposed to an @@error/mismatch *return value* for a failed binding)
+        #i.e later implementations will still be run as this will still just be a non-match
+        #error "$contents"
+
+
+        #will work to raise an error, but bad form to fake a pipesyntax error
+        #error "pipesyntax bad-arg"
+        
+        #to cause pipewitch above this to raise an error and stop processing cases..
+        #use 'switcherror' or 'funerror' as first element of a list e.g
+        #error [list funerror [list reason "$contents"]]
+        
+        #attempting to raise a normal error in the above switch - but then a bad match here.. will only cause this implementation to be a non-match 
+        # and so other implementations will still be run
+        #return [@@ok/result.= val $switchresult]
+        
+    #in this example - we want to force a terminal error (see switcherror above) or a terminal *result* that isn't wrapped in 'ok',
+    #but only if we *don't* have a mismatch.
+    #i.e we require an @@error/mismatch to proceed to other implementations
+    #puts stderr "=--->$switchresult"
+    if {[ispipematch r@@error/mismatch.= val $switchresult]} {
+        #all good - simulate an @@error/mismatch - or raise an 'ignore' error so that this implementation is considered to be unmatched and we fall through to others.
+        #puts stdout "=ispipematch true"
+        error [list ignore [list argcheck passed]]
+        #error "binding mismatch"
+    } else {
+        #puts stdout "=ispipematch false"
+        #error [list resultfunerror $contents]
+        error [list funerror $contents]
+    }
+        
+}
+
+
+
+
+    
+fun age 1 {puts "welcome!"}
+fun age 18 {puts "yay!"}
+fun age 42 {
+        error "Test that error is raised."
+    }
+fun age ''/0 {puts "enter an age, and optionally a message";return "no-value-supplied"}
+fun age a,100 {puts "congrats!"; return "congrats-$a"}
+fun age b {puts "cool"; return "cool-$b"}
+#fun age a,3+/# {puts stderr "too many args"; return}
+
+age 100
+
+
+
+
+

scriptlib/tests/html.tcl

@@ -0,0 +1,219 @@
+
+
+proc html_deep {indent tag attrs args} {
+    set out ""
+    set a ""
+    if {[dict size $attrs]} {
+        dict for {k v} $attrs {
+            append a "$k=\"$v\" "
+        }
+        set a [string range $a 0 end-1]
+        append out "<$tag $a>\n"
+    } else {
+        append out "<$tag>\n"
+    }
+        foreach a $args {
+            foreach ln [split $a \n] {
+                append out "$indent$ln\n"
+            }
+        }
+    append out "</$tag>"
+    return $out
+}
+
+
+#html 'block' elements
+interp alias {} html     {} html_deep "  " "html" 
+interp alias {} head     {} html_deep "  " "head" 
+interp alias {} script     {} html_deep "  " "script" 
+interp alias {} body     {} html_deep "  " "body" 
+interp alias {} div     {} html_deep "  " "div" 
+interp alias {} p       {} html_deep "  " "p" 
+interp alias {} content {} html_deep "  " "content" 
+interp alias {} table   {} html_deep "  " "table" 
+interp alias {} tr      {} html_deep "  " "tr" 
+interp alias {} th      {} html_deep "  " "th" 
+interp alias {} footer  {} html_deep "  " "footer"
+#still an html 'block' element - but output horizontally e.g h1-h6
+interp alias {} h1     {} html_shallow "  " "h1" 
+interp alias {} h2     {} html_shallow "  " "h2" 
+interp alias {} h3     {} html_shallow "  " "h3" 
+interp alias {} h4     {} html_shallow "  " "h4" 
+interp alias {} h5     {} html_shallow "  " "h5" 
+interp alias {} h6     {} html_shallow "  " "h6" 
+
+
+#html "inline" elements
+interp alias {} a     {} html_shallow "a" 
+interp alias {} em     {} html_shallow "em" 
+interp alias {} strong   {} html_shallow  "strong" 
+interp alias {} span   {} html_shallow  "span" 
+
+
+interp alias {} title   {} html_shallow "title" 
+
+
+proc html_shallow {tag attrs args} {
+    set out ""
+    set a ""
+    if {[dict size $attrs]} {
+        dict for {k v} $attrs {
+            append a "$k=\"$v\" "
+        }
+        set a [string range $a 0 end-1]
+        append out "<$tag $a>"
+    } else {
+        append out "<$tag>"
+    }    
+    foreach a $args {
+        append out "$a"
+    }
+    append out "</$tag>"
+    return $out
+}
+interp alias {} attrs {} dict create
+
+pipeset htmldoc .= list "julian@precisium.com.au" "info@precisium.com"   |email_admin/0,email_info/1> \
+    {
+        list [title [attrs] "a test"] [script [attrs]]
+    } { 
+    } |> \
+    {
+        head [attrs] {*}$data
+    } |h> \
+    {
+    
+    
+    
+    }                                               |> {
+    
+        div [attrs id div1]
+    }                                               |d1> {
+    
+    
+    
+    }                                               |> {
+        a [attrs href "mailto:$email_admin,$email_info"] "Send Email"               
+    }                                               |>  p [attrs]  |>  div [attrs id div-main] |divmain> { 
+    
+        # we can mix imperative style blocks in 
+        set divs [list]
+        lappend divs $d1
+        
+        lappend divs $divmain
+        
+        lappend divs [div [attrs id div3]]
+            
+        return $divs
+    }                                               |divlist> {
+
+
+
+
+    }                                               |> .= {
+
+        set elements $divlist
+            #puts "---->$pipeargs"
+            #puts "----[/#.= val $pipeargs]"
+            
+            footer.= result@1/@@result.= \
+            pipeswitch {
+                
+                pipecase \
+                .= val $pipeargs                |argd> \
+                1.=         {
+                                dict exists $argd -author
+                            } {
+                
+                
+                } |> \
+                author.=    {
+                                dict get $argd -author
+                            } {                              
+                
+                
+                } |> \
+                            {
+                                return "Author: $data"
+                            }
+                
+                pipecase .= val "Author: unknown" |> div [attrs hidden hidden] 
+                
+            } |> p [attrs] |> footer [attrs]
+            
+            
+        #puts "author: $author"
+        #puts "result: $result"
+        
+        lappend elements $footer
+        lappend elements [script [attrs] ""]
+
+        return $elements
+    }                                               |> bodydebug.= {
+        body [attrs] {*}$data
+    }                                               |b> {
+        list $h $b
+    }                                               |> {
+        html [attrs lang en] {*}$data
+    }                                               |> {
+    
+        #args -author name
+        return $data
+    }                                               <pipeargs| -type optionlist
+    
+
+#test version.. doesn't set vars, or go into subpipelines    
+proc make_o {pipeline} {
+    set oline [list]  ;#o combinator list
+    set segment [list]
+    set idx 0
+    #find first .=
+    foreach x $pipeline {
+        if {[string match *.=* $x]} {
+            set posn [string first .= $x]
+            set rhs [string range $x $posn+2 end]
+            if {[string length $rhs]} {
+               lappend oline [string range $x 0 $posn+1]
+               lappend segment $rhs
+            } else {
+                lappend oline $x
+            }
+            incr idx
+            break
+        } else {
+            lappend oline $x
+        }
+        incr idx
+    }
+
+    #lappend oline o_of 
+    foreach x [lrange $pipeline $idx end] {
+        if {[string match "|*>" $x]} {
+            #end of segment
+            lappend oline o_of [list $segment] $x
+            set segment [list]
+        } else {
+            lappend segment $x
+        }
+    }
+    if {[llength $segment]} {
+        lappend oline o_of [list $segment]
+    }
+    puts stdout "-- oline :$oline"
+    return $oline
+}
+
+proc make_funcl {pipeline} {
+    set o [make_o $pipeline]
+    set funcl [$o]
+}
+
+proc make_script {pipeline} {
+    funcl::funcl_script [make_funcl $pipeline]
+}
+
+proc run_pipe {pipeline} {
+    funcl::funcl_script_test [make_script $pipeline]
+}
+
+

scriptlib/tests/json.tcl

@@ -0,0 +1,62 @@
+#another experiment
+package require fileutil
+set data [fileutil::cat [pwd]/sample1.json]
+puts stdout $data
+proc charP {ch} {
+    pipeset parser .=  {
+        pipeswitch {
+            #puts "-->$input"
+            pipecase = $input |> \
+            ,'${ch}'@1.= {list [string range $data 1 end] [string index $data 0] } |> {
+                set data
+            }
+            return nothing
+        } 
+    }   <ch/0,input/1| $ch
+}        
+
+#generate a functor on a pipeline targeting a specific section of the 'value' in: ok {result value}
+proc fmap {cmdlist pipeline {restructure ""}} {
+    pipeset functor .= {
+        pipeswitch {
+            pipecase .= list $cmd $p $s $input |cmd@,pipe@,s@,input@> \
+            ,'result'@@ok/@0.= { 
+                .= list $pipe $input |p@,i@> {{*}$p $i} 
+            } |result@@ok/result>  {
+                #todo - we need inverse of the destructure operation of pattern-matching 
+                #i.e we need restructure - which puts the values in at the matched locations
+                #-  (return the updated result without necessarily knowing its full specific structure)
+                
+            }
+        
+            return nothing-functor
+        }
+    } <cmd@,p@,s@,input@| $cmdlist $pipeline $restructure
+}
+
+#JSON Parser 100% From Scratch in Haskell (only 111 lines)
+#https://www.youtube.com/watch?v=N9RUqGYuGfw
+# see also: Understanding parser combinators: a deep dive - Scott Wlaschin https://www.youtube.com/watch?v=RDalzi7mhdY
+
+
+#produce a pipeline for inner pipeline producing: ok {result {tailchars headchar}} 
+#where cmdlist is applied to headchar
+proc charP_functor {cmdlist pipeline} {
+    pipeset functor .= {
+        pipeswitch {
+            pipecase .= list $p $input $cmd |pipe@0,input@1,cmd@2> \
+            ,'result'@@ok/@0.= { 
+                .= list $pipe $input |p@,i@> {{*}$p $i} 
+            } |tail@@ok/result/@0,char@@ok/result/@1> {list $tail [{*}$cmd $char] } |
+        
+            return nothing-functor
+        }
+    } <p@,cmd@,input/2| $pipeline $cmdlist
+}
+proc scanc {ch} {
+    scan $ch %c
+}
+
+p.= charP p
+
+fc.= charP_functor scanc $p 

scriptlib/tests/linetest.tcl

@@ -1,17 +1,46 @@
+set sep [string repeat - 40]
+
 set x [list \
 a b c\
 d e f\
 ]
-puts stdout $x
+puts stdout "x: $x"
+puts stdout $sep
 
 if {[catch {
 
-y.=list\
+y.= .= list\
 a b c\
-d e f
+d e f |> inspect -label inspect-y
 
 } errmsg]} {
     puts stderr "error: $errmsg"
 } else {
-    puts stdout $y
+    puts stdout "y: $y"
 }
+puts stdout $sep
+
+z.= = "
+a b c
+d e f
+" |> inspect -label inspect-z |> .=* list
+
+puts stdout "z: $z"
+puts stdout $sep
+
+
+j.= = "
+a b c
+d e f
+" |> inspect -label inspect-j |> linelist
+
+puts stdout "linelist: $j"
+puts stdout $sep
+
+k.= = {
+a b c
+d e f
+} |> inspect -label inspect-k |> linelist
+
+puts stdout "linelist: $k"
+puts stdout $sep

scriptlib/tests/listbuilder.tcl

@@ -1,44 +1,129 @@
 
+set sep [string repeat - 50]
+puts stderr $sep
+
+#display pipeline in alternative color
+proc pipeputs {pipeline} {
+    puts stdout [a+ purple bold]$pipeline[a+]
+}
+
 set data1 d1
 set data2 [list a b c]
 
-x.=list "
+x/0.= list "
 item1
 [list $data1]
 [list $data2]
+$data2
 [pwd]
 "
-puts stdout "4 element list built with x.=list \" (multiline) \"   syntax"
+puts stdout "7 element list built with x/0.=list \" (multiline) \"   syntax"
-puts stdout $x
+puts stdout "x: $x"
+puts stdout "len: [llength $x]"
+puts stderr $sep
+
+puts stdout "Using linelist to restrict to the intended 5 elements"
+out.= = $x |> linelist
+puts stdout "out.=  = \$x |> linelist"
+puts stdout "out: $out" 
+puts stdout "len: [llength $out]"
+puts stderr $sep
+
 
 
-x.=list "
+y.= list "
-{[set x aaa]}
+{[set j aaa]}
-{$x}
+{$j etc}
 blah
 "
-puts stdout "strange but possibly useful"
+puts stdout "y: $y"
-puts stdout $x
+puts stderr $sep
 
-puts stdout "building a dict"
 
-d@0="list "
+
+puts stdout "building a dict - with some impurities! (pwd)"
+puts stdout "Note that the commands in the dict-building string are resolved at pipeline construction time"
+puts stdout "To resolve commands at pipeline run-time, we can pass as arguments (see extrakey key), or put them in a script block in the pipeline (see runtimedir key)"
+puts stdout "Some alternatives not demonstrated here are to use 'subst' or compose pipelines"
+
+pipeset dictpipe result.= inputdict_with_args,k@keys,p@@k2/patchlevel,etc/@@k4/etc=* "
 k1
-   {[pwd]}
+   {dir {[pwd]}}
 k2
-   {[info patchlevel]}
+   {patchlevel [info patchlevel]}
 
 k3
-   {something}
+   {something etc}
-"
+k4 
-puts stdout "dict: $d"
+    {
+        hmmm well
+        etc blah
+        dir {[pwd]}
+    }
+" |> finald,rtkey/@@runtimedir.= {
+    #a very impure script block!
+    set origdir [pwd]
+    set parent [file dirname [pwd]]
+    cd $parent
+    dict set data runtimedir [pwd]
+    cd $origdir
+    set data
+}  |@@k4/dir> <| extrakey [pwd] anotherkey foo
+
+
+puts stdout "dictpipe:"
+pipeputs $dictpipe
+{*}$dictpipe
+puts stdout "dict: $finald"
+#todo - a function to repack a nested dict into a flat structure (no linefeeds unless a leaf can't be interpreted as a dict)?
+# i.e - k4 is constructed as a string - but we may want to discard the stringrep and rebuild it as a pure list/dict
+puts stdout "keys: $k"
+puts stdout "k2/patchlevel: $p"
+puts stdout "k4/etc: $etc"
+puts stdout "runtimedir: $rtkey"
+puts stdout "result(k4/dir): $result"
+puts stderr $sep
+
+
+puts stdout "script block comment test (using multiple scripts in segment via implicit pipedata mechanism"
+
+pipeset commentpipe normallist.= rawlist/0.= {
+#a not terribly useful comment block
+#comments
+# etc 
+#blah
+} {inspect -channel stderr -label inspect_no_data $data} {list \
+    {
+       data
+       over here
+       etc
+    }
+} {
+#more comments - but we need to pass the pipeline data through here - so 'set data' required at end.
+set data
+} |> string trim |> linelist |> .=/2 lmap v {string trim $v}
+
+pipeputs $commentpipe
+{*}$commentpipe
+
+puts stdout "rawlist:$rawlist"
+puts stdout "normallist:$normallist"
+puts stderr $sep
+
+
+pipeset pipe2 alt.= = $rawlist |> .=/1 lrange 0 end
+puts stdout "Alternative interpretation of list data"
+puts stdout "pipe2:"
+pipeputs $pipe2
+{*}$pipe2
+puts stdout "alt: $alt"
+
+pipeset pipe3 alt.= = $rawlist |> .=* list
+puts stdout "Or.."
+puts stdout "pipe3:"
+pipeputs $pipe3
+{*}$pipe3
+puts stdout "alt: $alt"
 
-puts stdout "comment test"
-x="# "
-testing
-comments
-here
-"
-puts stdout "x:$x"
 
 puts stdout -done-

scriptlib/tests/listrep_bug.tcl

@@ -0,0 +1,17 @@
+#string rep generated for variable when script is changed or unset
+
+set script {set j [list a] ; list}
+append script "\n"
+uplevel #0 $script
+puts stdout [tcl::unsupported::representation $j]
+puts stdout [tcl::unsupported::representation $j] 
+puts stdout [tcl::unsupported::representation $j] 
+set script ""
+puts stdout [tcl::unsupported::representation $j] 
+puts stdout [tcl::unsupported::representation $j] 
+
+#value is a list with a refcount of 3, object pointer at 0x833d30, internal representation 0x878810:0x0, no string representation
+#value is a list with a refcount of 3, object pointer at 0x833d30, internal representation 0x878810:0x0, no string representation
+#value is a list with a refcount of 3, object pointer at 0x833d30, internal representation 0x878810:0x0, no string representation
+#value is a list with a refcount of 2, object pointer at 0x833d30, internal representation 0x878810:0x0, string representation "a"
+#value is a list with a refcount of 2, object pointer at 0x833d30, internal representation 0x878810:0x0, string representation "a"

scriptlib/tests/listrep_bug2.tcl

@@ -0,0 +1,21 @@
+
+#source this file.. 
+# get value is a list with a refcount of 4 .. no string representation
+interp alias "" rep "" tcl::unsupported::representation
+set j [list a];list
+rep $j
+set command {set j [list a];list}
+uplevel #0 $command\n
+rep $j
+set j [list a];list
+rep $j 
+
+#then type following line in shell:
+#$rep j
+
+#value is a list with a refcount of 3  string representation "a"
+
+
+set x [rep $j];list
+puts stdout $x
+

scriptlib/tests/monadtest.tcl

@@ -0,0 +1,93 @@
+package require punk
+
+#https://www.youtube.com/watch?v=26jVysJHB-s
+#based on Monads in Python: Why and How?
+
+#some function timer 
+proc xxxpipet {subcommand} {
+    return [list % val $subcommand |sub> {
+        if {![info exists input]} {
+            set input ""
+        } else {
+            set input
+        }
+        } |input> {clock micros} |start> {{*}$sub {*}$input} |res> {expr [clock micros] - $start} |t> {list $res $t} <input| ]
+}
+proc pipet {subcommand} {
+    return [list % list $subcommand |sub/0,input/1> \
+        {clock micros} |start> {{*}$sub {*}$input} |res> {expr [clock micros] - $start} |t> {list $res $t} <input| ]
+}
+
+pipeset fast  % {expr {$x + 1}} <x|
+pipeset slow  % {after 100} |> {expr {$x + 1}} <x|
+pipeset slow2 % {after 150} |> {expr {$x + 2}} <x|
+
+#naive chaining of time-wrapped commands. 
+#Requires unpacking/matching at each stage of pipeline and summing at end.
+% .= val 2 |> .= {{*}[pipet $::fast] $data} |d@0,t@1> {{*}[pipet $::slow] $d} |d@,t2@> {{*}[pipet $::slow2] $d} |d@,t3@> {list $d [expr {$t + $t2 + $t3}]}
+
+
+#method 2 - abstract away the extraction and summation in a bind function
+# x2, t = bind(bind(fast(1), slow), slow2)
+# % bind=% {list $vt $f} |v@0/0,t@0/1> {{*}$f $v} |r2@,t2@>  {list $r2 [expr {$t + $t2}]} <vt@,f@|
+ pipeset bind % {list $vt $f} |v@0/0,t@0/1> {{*}$f $v} |r2@,t2@>  {list $r2 [expr {$t + $t2}]} <vt@,f@|
+
+# requires nested binds .. a bit messy 
+ {*}$bind    [{*}$bind [{*}[pipet $::fast] 1] [pipet $::slow]]       [pipet $::slow2]
+ 
+ #we can neaten it up with tcl aliases, but we still don't have a straightforward pipeline so it will get messier with more operations.
+ alias t_fast   {*}[pipet $fast]
+ alias t_slow   {*}[pipet $slow]
+ alias t_slow2  {*}[pipet $slow2]
+ alias bind {*}$bind
+ 
+ bind [bind [t_fast 1] t_slow] t_slow2
+  
+#now with oo approach
+
+catch {timedvalue destroy}
+
+oo::class create timedvalue {
+    variable o_value
+    variable o_time
+    constructor {value {time 0}} {
+        set o_value $value
+        set o_time $time
+    }
+    method value {} {return $o_value}
+    method time {} {return $o_time}
+    method bind {f} {
+        set timed_value [{*}$f $o_value]
+        set new_value [$timed_value value]
+        set new_time [expr {$o_time + [$timed_value time]}]
+        return [timedvalue new $new_value $new_time]
+    }
+}
+ 
+#we need a new timing wrapper that returns an object
+proc pipet2 {subcommand} {
+    return [list % list $subcommand |sub/0,input/1> \
+    {clock micros} |start> {{*}$sub {*}$input} |res> {expr [clock micros] - $start} |t> {timedvalue new $res $t} <input| ]
+}
+  
+alias o_fast {*}[pipet2 $fast]
+alias o_slow {*}[pipet2 $slow]
+alias o_slow2 {*}[pipet2 $slow2]
+
+tvresult.=             \
+ .=          o_fast 1  \
+|o> {$o bind o_slow}   \
+|o> {$o bind o_slow2} 
+
+puts "tvresult value: [$tvresult value]"
+puts "tvresult time: [$tvresult time]"
+#timedvalue class is a monad
+
+  
+  
+  
+  
+  
+  
+  
+ 

scriptlib/tests/multireturn.tcl

@@ -18,7 +18,7 @@ puts stdout "scriptline: d@end-3-end-1= {a b c d e f}"
 puts stdout "d: $d"
 
 set dict {key0 000 key1 111 key2 222 key3 333 key4 444}
-pipeline=.= e@@key1,f@@key3,g= $dict
+pipeset pipeline .= e@@key1,f@@key3,g= $dict
 puts stdout "pipeline:   $pipeline"
 $pipeline
 puts stdout "e: $e"

scriptlib/tests/nameservers.tcl

@@ -0,0 +1,42 @@
+
+proc listmap {commandlist list} {
+    tailcall lmap item $list $commandlist
+}
+
+proc pipe_webpub {} {
+pipeset subpipe % .= {
+    pipeswitch {
+        pipecase \
+            .= val [lindex $switchargs 0] \
+            |> {string trimright $data .} |server> {split $data .} \
+            |> 'webpub.net'.= {
+                join [lrange $data 1 2] .
+            } \
+            |> {
+                list type internal server $server
+            }
+            
+        pipecase .= val [list type external server [lindex $switchargs 0]]
+        #val [list type external server [lindex $switchargs 0]]
+        
+    } $ns
+} <ns|
+
+return $subpipe
+}
+
+proc pipe_nameserverlist {} {
+    return [list % {val $domain} |>  {runout -n dig $data  ns +short} |> linelist |> {listmap {{*}[pipe_webpub] $item} $data} <domain|]
+}
+
+#{*}[pipe_nameserverlist] precisium.com.au
+
+
+proc nameserverlist {domain} {
+    tailcall {*}[pipe_nameserverlist] $domain
+}
+proc nameserverdisplay {domain} {
+    return [list % val $domain |> {{*}[pipe_nameserverlist] $data } |> lsort]
+}
+
+puts stdout "command available: nameserverlist <domain>"

scriptlib/tests/pipeindex.tcl

@@ -3,13 +3,13 @@ catch {unset result}
 
 dict= {a aaa b {z zzz x xxx y yyy}}
 
-pipeline=result.= in.= val $dict |> string toupper |> @@B/X=
+pipeset pipeline result.= in.= val $dict |> string toupper |> @@B/X=
 puts stdout "pipeline: $pipeline"
 $pipeline
 puts stdout "result: $result"
 punk::assert {$result eq "XXX"}
 
-pipeline=result.= in.= val $dict |> string toupper |> @tail/end/not-head/not-tail/0/0= 
+pipeset pipeline result.= in.= val $dict |> string toupper |> @tail/end/not-head/not-tail/0/0= 
 puts stdout "pipeline: $pipeline"
 $pipeline
 puts stdout "result: $result"

scriptlib/tests/pipeline1.tcl

@@ -3,12 +3,15 @@
 # a formatting experiment
 #-----------------------------------------------------------
 
-x.= val {
+x.= concat \
+"
 a
 b c
+[runout -n pwd]
+trailing space      
 d e     f
    g h i
-}                                                |> {
+"                                               |> {
 
 
 
@@ -17,13 +20,13 @@ d e     f
 
     set data}                                    |> {
 
-    puts "raw: $data"
+    puts "raw input + pipeline args: $data"
     set data
 } \
 |> \
     \
      \
-l.=linelist    %data%\
+l.=/1 linelist  \
        \
      |> \
           {
@@ -31,7 +34,7 @@ l.=linelist    %data%\
             puts "args: $args"
             set data
           } \
-                    <args| a b c
+                    <args|  "a b c" x y z
 #-----------------------------------------------------------
 
 set input [list a b c d e f g]
@@ -42,16 +45,16 @@ a.=val $input    |> {
         b.= string toupper 
         
         puts stdout "=================================="
-        puts stdout [info vars]
+        puts stdout "info vars: [info vars]"
         foreach v [info vars] {
-            puts stderr "  '$v'"
+            puts stderr "  '$v' [set $v]"
         }
         puts stdout "=================================="
         return $b
 } |>  b.= val                       
 
-puts $a
+puts "a:$a"
-puts $b
+puts "b:$b"
 
 
 

scriptlib/tests/pipeswitch.tcl

@@ -11,7 +11,7 @@ proc  test1 {} {
     pipeswitch {
         puts stderr "pre pipecase code always runs"
         
-        pipecase pipenomatchvar nomatch1 ,'p1v0@0.= val {p1v0x b c} |> {
+        pipecase pipenomatchvar nomatch1 ,'p1v0'@0.= val {p1v0x b c} |> {
             puts stdout "pipecase1 $data"
             set data
         }
@@ -19,14 +19,14 @@ proc  test1 {} {
         # in between
         puts stderr "code after unmatched but before matched will run"
         
-        pipecase pipenomatchvar nomatch2 input,'p2v1@1.= val {x p2v1 z} |> {
+        pipecase pipenomatchvar nomatch2 input,'p2v1'@1.= val {x p2v1 z} |> {
             puts stdout "pipecase2 $data"
             return [list source pipecase2 data $data]
         }                                       |> {
             string toupper $data
         }
         
-        pipecase ,'p3v3@2.= val {d e p3v3x} |> {
+        pipecase ,'p3v3'@2.= val {d e p3v3x} |> {
             puts stdout "pipecase3 $data"
             set data
         }
@@ -37,7 +37,7 @@ proc  test1 {} {
     
     puts stdout "returnvalue of pipeswitch return is: $returnvalue"
     puts stdout "[a+ yellow bold]nomatch var pipe1: $nomatch1[a+]"
-    puts stdout "nomatch destructured to 'matchinfo': [mi@@error/reason/matchinfo= $nomatch1]"
+    puts stdout "nomatch destructured to 'matchinfo': [mi@@error/mismatch/matchinfo= $nomatch1]"
     puts stdout "[a+ green bold]nomatch var pipe2 (empty if there was a match): $nomatch2[a+]"
     puts stdout "value of pipeswitch result is: $result"
     puts stdout "status of pipeswitch is: $status"
@@ -48,25 +48,28 @@ test1
 
 puts stderr "proc test follows"
 proc  match_args {args} {
-    procresult,'ok@0.= pipeswitch {
+    set arglist $args
-        pipecase p1,'a@0.= val $args |> string toupper |> {
+    procresult,'ok'@0.= pipeswitch {
-            
+        puts stdout "----$arglist"
+        pipecase p1,'a'@0.= val $args |> string toupper |> {
+            puts stderr "p1 data:'$data'"
             return [list source pipecase1 data $data]
         }
         
-        pipecase p2,'x@0,'y@1.=val $args |> {
+        pipecase p2,'x'@0,'y'@1.= val $args |> {
             return [list source pipecase2 data $data]
         }
         
-        pipecase p3,'x@0.=val $args |> {
+        pipecase p3,'x'@0.= val $args |> {
             return [list source pipecase3 data [list transformed {*}$data]]
         }
         
         pipecase .= val $args |> {
-            puts "catchall pipe4"
+            puts "catchall pipe4 $data"
             return $data
         }
-    }
+    } {*}$args
+    #scope is ok - but pipeswitch overrides'args' so we need to either pass them in, or set another variable  - Review.
 }
 puts "match_args a b c : [match_args a b c]"
 puts "match_args x y z : [match_args x y z]"

scriptlib/tests/quicksort.tcl

@@ -0,0 +1,17 @@
+#testing.
+
+
+
+proc quicksort {m} {
+    if {[llength $m] <= 1} {
+        return $m
+    }
+    set pivot [lindex $m 0]
+    set less [set equal [set greater [list]]]
+    foreach x $m {
+        lappend [expr {$x < $pivot ? "less" : $x > $pivot ? "greater" : "equal"}] $x
+    }
+    return [concat [quicksort $less] $equal [quicksort $greater]]
+}
+
+puts [quicksort {8 6 4 2 1 3 5 7 9}] ;# => 1 2 3 4 5 6 7 8 9

scriptlib/tests/reverse.tcl

@@ -0,0 +1,22 @@
+
+
+fun reverse     list/0,1#                       {@@ok/result.= do_reverse $list [list]}
+fun do_reverse  h/0/head,t/0/tail,reversed/1    {tailcall @@ok/result.= do_reverse $t [list $h {*}$reversed]}
+fun do_reverse  0/0/#,reversed/1                {return $reversed}
+
+
+
+#2023-06 initial punk version.. creates string rep, no compiled pattern matching - extremely slow
+#set x [list a b c d e f g h i j];list
+#P% llength $x
+#-  10
+#P% rep $x
+#-  value is a list with a refcount of 4, object pointer at 00000000097F65F0, internal representation 0000000004ABCE90:0000000000000000, no string representation
+#P% reverse $x; list
+#P% rep $x
+#-  value is a list with a refcount of 4, object pointer at 00000000097F65F0, internal representation 0000000004ABCE90:0000000000000000, string representation "a b c d e f #g..."
+#P% time {reverse $x} 100
+#-  2457.0330000000004 microseconds per iteration
+#P% time {reverse $x} 1000
+#-  2460.8575 microseconds per iteration
+

scriptlib/tests/sample1.json

@@ -0,0 +1,23 @@
+{
+  "name": "grpc/grpc",
+  "type": "library",
+  "description": "gRPC library for PHP",
+  "keywords": ["rpc"],
+  "homepage": "https://grpc.io",
+  "license": "Apache-2.0",
+  "require": {
+    "php": ">=7.0.0"
+  },
+  "require-dev": {
+    "google/auth": "^v1.3.0"
+  },
+  "suggest": {
+    "ext-protobuf": "For better performance, install the protobuf C extension.",
+    "google/protobuf": "To get started using grpc quickly, install the native protobuf library."
+  },
+  "autoload": {
+    "psr-4": {
+      "Grpc\\": "src/php/lib/Grpc/"
+    }
+  }
+}

scriptlib/tests/simplepipe.tcl

@@ -0,0 +1,48 @@
+proc pipe* args {
+    set r [uplevel 1 [lindex $args 0]]
+    for {set i 1} {$i < [llength $args]} {incr i} {
+        set e [lindex $args $i]
+        if {[llength $e] == 1} {
+            if {$e eq {>}} {
+                incr i
+                uplevel 1 [list set [lindex $args $i] $r]
+            } else {
+                set r [uplevel 1 [list $e $r]]
+            }
+        } else {
+            set cmd {}
+            set substdone 0
+            foreach arg $e {
+                if {$arg eq {*}} {
+                    lappend cmd $r
+                    set substdone 1
+                } else {
+                    lappend cmd $arg
+                }
+            }
+            if {$substdone == 0} {
+                lappend cmd $r
+            }
+            set r [uplevel 1 $cmd]
+        }
+    }
+    return $r
+}
+
+set s "    supercalifragilistichespiralitoso    "
+pipe*    {string trim $s} {split * {}} {lsort -unique} {join * {}} > s \
+        {string length} > l
+puts $s
+puts $l
+
+#test running of patternmatching pipelines within pipe*
+set x [list a b blah etc]
+pipe* {set x} {,'a'@0/0= |@0> {puts $data; set data} <| *} {val *}
+
+pipe* {set x} {,'a'@0/0= |@0> {
+            puts $data
+            set data
+        } <| *} {val *}
+
+
+

scriptlib/tests/simplepipe2.tcl

@@ -0,0 +1,73 @@
+proc pipedata {data args} {
+    #puts stderr "'$args'"
+    set r $data
+    for {set i 0} {$i < [llength $args]} {incr i} {
+        set e [lindex $args $i]
+        if {[catch {llength $e} seglen]} {
+                #not a list - assume script and run anyway
+                set r [apply [list {data} $e] $r]
+        } else {
+            if {[llength $e] == 1} {
+                if {$e eq {>}} {
+                    #output to calling context. only pipedata return value and '> varname' should affect caller.
+                    incr i
+                    uplevel 1 [list set [lindex $args $i] $r]
+                } elseif {$e in {% pipematch ispipematch}} {
+                    incr i
+                    set e2 [lindex $args $i]
+                    #set body [list $e {*}$e2] 
+                    #append body { $data}
+                    
+                    set body [list $e {*}$e2] 
+                    append body { {*}$data}
+                    
+                    
+                    set applylist [list {data}  $body]
+                    #puts stderr $applylist
+                    set r [apply $applylist $r]
+                } elseif {$e in [list pipeswitch pipeswitchc]} {
+                    #pipeswitch takes a script not a list.
+                    incr i
+                    set e2 [lindex $args $i]
+                    set body [list $e $e2]
+                    #pipeswitch takes 'args' - so expand $data when in pipedata context 
+                    append body { {*}$data}
+                    #use applylist instead of uplevel when in pipedata context!
+                    #can use either switchdata/data but not vars in calling context of 'pipedata' command.
+                    #this is consistent with pipeswitch running in a % / .= pipeline which can only access vars in immediate calling context.
+                    set applylist [list {data} $body]
+                    #puts stderr $applylist
+                    set r [apply $applylist $r]
+                } else {
+                    #puts "other single arg: [list $e $r]"
+                    append e { $data}
+                    set r [apply [list {data} $e] $r]
+                }
+            } else {
+                set r [apply [list {data} $e] $r]
+            }
+        }
+    }
+    return $r
+}
+
+set s "    supercalifragilistichespiralitoso    "
+pipedata  $s  {string trim $data} {split $data {}} {lsort -unique $data} {join $data {}} > s \
+        {string length $data} > l
+puts $s
+puts $l
+
+#test running of patternmatching pipelines within pipe*
+set x [list a b blah etc]
+puts "-1"
+pipedata $x {,'a'@0/0= |@0> {puts $data; set data} <| $data} {val $data}
+
+puts "-2"
+pipedata $x {,'a'@0/0= |@0> {
+            puts $data
+            set data
+        } <| $data} {val $data}
+        
+pipeset pipe1 ,'a'@0/0= |/0-1> {puts $data; set data} |> string toupper <|
+puts "-3"
+pipedata $x pipematch $pipe1 

scriptlib/tests/unbalanced.tcl

@@ -4,6 +4,12 @@ x=$$"}
 
 puts $x
 
+
+if {[catch {
+
 y="
 
-puts $y
+} errM]} {
+    puts "got error $errM"
+}   
+

scriptlib/tests/wanted.tcl

@@ -0,0 +1,18 @@
+
+# this should run 'list a b c tail' 
+catch {
+
+% x.=/0*   tail  |> {puts $data;set data} <in| list a b c
+
+}
+
+#should it then be able to run pipelines as 'args' 
+% x.=/0*    |> {puts $data;set data} <in| % y.= list etc blah |> string toupper
+
+#but then what would happen if the args pipeline also took input via another <| ?
+#% x.=/0*    |> {puts $data;set data} <in| % y.= list etc blah  <| list data 
+
+#presumably pipelines shouldn't be passed in as expanded lists..
+
+
+% out= x=   |> {puts $data; set data}  |p1/0> .= { {*}$p1 }   |> {puts $data;set data} <in| [list % y.= list etc blah |> string toupper]