package provide patternpredator1 1.2.4

proc ::p::internals::trailing, {map command stack i arglist pending} {
	error "trailing ',' is not a valid sequence. If the comma was meant to be an argument, precede it with the -- operator."
}
proc ::p::internals::trailing.. {map command stack i arglist pending} {
    error "trailing .. references not implemented."
}

proc ::p::internals::trailing. {map command _ID_ stack i arglist pending} {
        if {![llength $map]} {
			error "Trailing .  but no map  - command:'$command' stack:$stack  i:$i  arglist:$arglist pending:$pending"
		}



		#trailing dot - get reference.
		#puts ">>trailing dot>>  map:$map command:$command _ID_:$_ID_ stack:$stack i:$i arglist:$arglist pending:$pending"
		lassign [lindex $map 0] OID alias itemCmd cmd


        #lassign $command command _ID_

		
		if {$pending eq {}} {
            #no pending operation requiring evaluation.

			#presumably we're getting a ref to the object, not a property or method.
			#set traceCmd [::list ::p::objectRef_TraceHandler $cmd $_self $OID]
			#if {[::list {array read write unset} $traceCmd] ni [trace info variable $refname]} {
			#	trace add variable $refname {array read write unset} $traceCmd
			#}
			set refname ::p::${OID}::_ref::__OBJECT	;#!todo - avoid potential collision with ref to member named '__OBJECT'.		
			#object ref - ensure trace-var is an array upon which the objects methods & properties can be accessed as indices
			array set $refname [list]
			#!todo?- populate array with object methods/properties now?
			
			
            set _ID_ [list i [list this [list [list $OID [list map $map]]]]]

			#!todo - review. What if $map is out of date?

			set traceCmd [list ::p::predator::object_read_trace $OID $_ID_]
			if {[list {read} $traceCmd] ni [trace info variable $refname]} {
				trace add variable $refname {read} $traceCmd
			}
			
			set traceCmd [list ::p::predator::object_array_trace $OID $_ID_]
			if {[list {array} $traceCmd] ni [trace info variable $refname]} {
				trace add variable $refname {array} $traceCmd
			}

			set traceCmd [list ::p::predator::object_write_trace $OID $_ID_]
			if {[list {write} $traceCmd] ni [trace info variable $refname]} {
				trace add variable $refname {write} $traceCmd
			}

			set traceCmd [list ::p::predator::object_unset_trace $OID $_ID_]
			if {[list {unset} $traceCmd] ni [trace info variable $refname]} {
				trace add variable $refname {unset} $traceCmd
			}


			#set command $refname			
            return $refname
		} else {
			#puts "- 11111111 '$command' '$stack'"
			
			if {[string range $command 0 171] eq "::p::-1::"} {
				#!todo - review/enable this branch?

				#reference to meta-member

				#STALE map problem!!

				puts "\naaaaa command: $command\n"

				set field [namespace tail [lindex $command 0]]
				set map [lindex $stack 0]
				set OID [lindex $map 0 0]


				if {[llength $stack]} {
					set refname ::p::${OID}::_ref::[join [concat $field [lrange $stack 1 end]] +]
					set command [interp alias {} $refname {} {*}$command {*}$stack]
				} else {
					set refname ::p::${OID}::_ref::$field
					set command [interp alias {} $refname {} {*}$command]
				}
				puts "???? command '$command' \n refname '$refname' \n"

			} else {
				#Property or Method reference (possibly with curried indices or arguments)

				#we don't want our references to look like objects.
				#(If they did, they might be found by namespace tidyup code and treated incorrectly)
				set field [string map {> __OBJECT_} [namespace tail $command]]

                #!todo?
                # - make every object's OID unpredictable and sparse (UUID) and modify 'namespace child' etc to prevent iteration/inspection of ::p namespace.


                #references created under ::p::${OID}::_ref are effectively inside a 'varspace' within the object itself.
                # - this would  in theory allow a set of interface functions on the object which have direct access to the reference variables.


				if {[llength $stack]} {
					set refname ::p::${OID}::_ref::[join [concat $field $stack] +]
					#puts stdout " ------------>>>> refname:$refname"
                    if {[string length $_ID_]} {
					    set command [interp alias {} $refname {} $command $_ID_ {*}$stack]
                    } else {
					    set command [interp alias {} $refname {} $command {*}$stack]
                    }
				} else {
					set refname ::p::${OID}::_ref::$field
					#!review - for consistency.. we don't directly return method name.
                    if {[string length $_ID_]} {
    					set command [interp alias {} $refname {} $command $_ID_]
                    } else {
    					set command [interp alias {} $refname {} $command]
                    }
				}


				#puts ">>>!>>>> refname $refname \n"


				#NOTE! - we always create a command alias even if $field is not a method.
				#(
	
				#!todo? - build a list of properties from all interfaces (cache it on object??)
				set iflist [lindex $map 1 0]




				set found 0
				foreach IFID [lreverse $iflist] {
                    #if {$field in [dict keys [set ::p::${IFID}::_iface::o_methods]]} { 
					#	set found 1
					#	break
					#}
                    if {[llength [info commands ::p::${IFID}::_iface::(GET)$field]] || [llength [info commands ::p::${IFID}::_iface::(SET)$field]]} {
                        set found 1
                        break
                    }
				}


				if {$found} {
					#property reference

					#?
					#set readref [string map [list ::_ref:: ::_ref::(GET)
					#set writeref [string map [list ::_ref:: ::_ref::(SET)

					#puts "-2222222222 $refname"
	
                    #puts "---HERE! $OID $property ::p::${OID}::_ref::${property}"
                    #trace remove variable $refname {read write unset} [list ::p::internals::commandrefMisuse_TraceHandler $alias $field]
            		foreach tinfo [trace info variable $refname] {	
            			#puts "-->removing traces on $refname:  $tinfo"
                        if {[lindex $tinfo 1 0] eq "::p::internals::commandrefMisuse_TraceHandler"} {
            			    trace remove variable $refname {*}$tinfo
                        }
            		}


		

	
					#!todo - move to within trace info test below.. no need to test for refsync trace if no other trace?
					#We only trace on entire property.. not array elements (if references existed to both the array and an element both traces would be fired -(entire array trace first))
					set Hndlr 	[::list ::p::predator::refsync_TraceHandler $OID $alias "" $field]
					if { [::list {write unset} $Hndlr] ni [trace info variable ::p::${OID}::o_${field}]} {
						trace add variable ::p::${OID}::o_${field} {write unset} $Hndlr
					}	
	
	                set _ID_ [dict create i [dict create this [list [list $OID [list map $map] ]]]]
		
                    #supply all data in easy-access form so that prop_trace_read is not doing any extra work.
                    set get_cmd ::p::${OID}::(GET)$field
					set traceCmd [list ::p::predator::prop_trace_read $get_cmd $_ID_ $refname $field $stack]
		
					if {[list {read} $traceCmd] ni [trace info variable $refname]} {
	
						#synch the refvar with the real var if it exists
						#catch {set $refname [$refname]}
						if {[array exists ::p::${OID}::o_$field]} {
								if {![llength $stack]} {
									#unindexed reference
									array set $refname [array get ::p::${OID}::o_$field]
								} else {
									#refs to nonexistant array members common? (catch vs 'info exists')
									if {[info exists ::p::${OID}::o_${field}([lindex $stack 0])]} {
										set $refname [set ::p::${OID}::o_${field}([lindex $stack 0])]
									}
								}
						} else {
							#catch means retrieving refs to non-initialised props slightly slower.
							set errorInfo_prev $::errorInfo  ;#preserve errorInfo across these catches!

							if {![llength $stack]} {
								catch {set $refname [set ::p::${OID}::o_$field]}
							} else {
								if {[llength $stack] == 1} {
									catch {set $refname [lindex [set ::p::${OID}::o_$field] [lindex $stack 0]]}
								} else {
									catch {set $refname [lindex [set ::p::${OID}::o_$field] $stack]}
								}
							}

							#! what if someone has put a trace on ::errorInfo??
							set ::errorInfo $errorInfo_prev

						}
			
						trace add variable $refname {read} $traceCmd
			
						set traceCmd [list ::p::predator::prop_trace_write $_ID_ $OID $alias $refname]
						trace add variable $refname {write} $traceCmd
	
						set traceCmd [list ::p::predator::prop_trace_unset $_ID_ $OID $alias $refname]
						trace add variable $refname {unset} $traceCmd
	
						set traceCmd [list ::p::predator::prop_trace_array $_ID_ $OID $alias $refname]
						trace add variable $refname {array} $traceCmd
	
					}
	
	
				} else {
					#matching variable in order to detect attempted use as property and throw error
					#puts "$refname ====> adding refMisuse_traceHandler $alias $field"
				 	trace add variable $refname {read write unset} [list ::p::internals::commandrefMisuse_TraceHandler $alias $field]
				}
			}

            return $command
		}
}


#script to inline at placeholder @reduce_pending_stack@
set ::p::internals::reduce_pending_stack  {
    if {$pending eq {idx}} {
        if {$OID ne {null}} {
            #pattern object
			#set command [list ::p::${OID}::$itemCmd [dict create i [dict create this [list $OID]]]]
            set command ::p::${OID}::$itemCmd
            set _ID_ [dict create i [dict create this [list [list $OID [list map $map]]]]]
						#todo: set _ID_ [dict create i [dict create this [list [list $OID - - - {}]]] context {}]
						
        } else {
            set command [list $itemCmd $command]
        }
    }
    if {![llength [info commands [lindex $command 0]]]} {
		set cmdname [namespace tail [lindex $command 0]]
        if {[llength [info commands ::p::${OID}::(UNKNOWN)]]} {
			lset command 0 ::p::${OID}::(UNKNOWN)
            #puts stdout "!\n calling UNKNOWN $command $cmdname $stack\n\n"

            if {[string length $_ID_]} {
			    set interim [uplevel 1 [list {*}$command $_ID_ $cmdname {*}$stack]]  ;#delegate to UNKNOWN, along with original commandname as 1st arg.
            } else {
			    set interim [uplevel 1 [list {*}$command $cmdname {*}$stack]]  ;#delegate to UNKNOWN, along with original commandname as 1st arg.
            }
        } else {
			return -code error -errorinfo "1)error running command:'$command' argstack:'$stack'\n - command not found and no 'unknown' handler"  "method '$command' not found"
        }
    } else {
        #puts "---??? uplevelling $command $_ID_ $stack"
        
        if {[string length $_ID_]} {
            set interim [uplevel 1 [list {*}$command $_ID_ {*}$stack]]
        } else {
            set interim [uplevel 1 [list {*}$command {*}$stack]]
        }
        #puts "---?2? interim:$interim"
    }



	if {[string first ::> $interim] >= 0} {
        #puts "--- ---> tailcalling $interim [lrange $args $i end]"
        tailcall {*}$interim  {*}[lrange $args $i end]  ;#don't use a return statement as tailcall implies return
    } else {
        #the interim result is not a pattern object - but the . indicates we should treat it as a command
        #tailcall ::p::internals::predator [list [list {null} {} {lindex} $interim {}]] {*}[lrange $args $i end]
        #set nextmap [list [list {null} {} {lindex} $interim {}]]
        #tailcall ::p::internals::predator [dict create i [dict create this [list null ]] map $nextmap]  {*}[lrange $args $i end]
        #tailcall ::p::internals::predator [dict create i [dict create this [list [list null [list]]  ]] xmap $nextmap]  {*}[lrange $args $i end]

        tailcall ::p::internals::predator [dict create i [dict create this [list [list null [list map [list [list {null} {} {lindex} $interim {}]]]]  ]] callerinfo ""]  {*}[lrange $args $i end]

    }
}




proc ::p::predator1 {subject args} [string map [list @reduce_pending_stack@ $::p::internals::reduce_pending_stack] {
    #set OID [lindex [dict get $subject i this] 0 0]
		
    set this_invocant [lindex [dict get $subject i this] 0] ;#for the role 'this' we assume only one invocant in the list.
    lassign $this_invocant OID this_info

    if {$OID ne {null}} {
        #upvar #0 ::p::${OID}::_meta::map map
        #if {![dict exists [lindex [dict get $subject i this] 0 1] map]} {
        #    set map [set ::p::${OID}::_meta::map]
        #} else {
        #    set map [dict get [lindex [dict get $subject i this] 0 1] map]
        #}
        #seems to be faster just to grab from the variable, than to unwrap from $_ID_ !?
        #set map [set ::p::${OID}::_meta::map]

		
		
       # if {![dict exists $this_info map]} {
            set map [set ::p::${OID}::_meta::map]
        #} else {
        #    set map [dict get $this_info map]
        #}
    
        



    	lassign [lindex $map 0] OID alias itemCmd cmd

        set cheat 1
        #-------
        #the common optimised case first. A single . followed by args which contain no other operators (non-chained call)
        #(it should be functionally equivalent to remove this shortcut block)
        if {$cheat} {
        if {([llength $args] > 1) && ([lindex $args 0] eq {.}) && ([llength [lsearch -all $args .]] == 1) && ({,} ni $args) && ({..} ni $args) && ({--} ni $args)} {
            set command ::p::${OID}::[lindex $args 1]                    
    
            if {![llength [info commands $command]]} {
                if {[llength [info commands ::p::${OID}::(UNKNOWN)]]} {
					set cmdname [namespace tail $command]
    				lset command 0 ::p::${OID}::(UNKNOWN)
                	#return [uplevel 1 [list {*}$command [dict create i [dict create this [list [list $OID [list map $map]]]]] $cmdname {*}[lrange $args 2 end]]]  ;#delegate to UNKNOWN, along with original commandname as 1st arg.
					tailcall {*}$command [dict create i [dict create this [list [list $OID [list map [list [lindex $map 0] {{} {}} ] ] ]]]] $cmdname {*}[lrange $args 2 end] ;#delegate to UNKNOWN, along with original commandname as 1st arg.
				} else {
    				return -code error -errorinfo "2)error running command:'$command' argstack:'[lrange $args 2 end]'\n - command not found and no 'unknown' handler"  "method '$command' not found"
                }
            } else {
                #puts " -->> tailcalling $command [lrange $args 2 end]"
                #tailcall $command [dict create i [dict create this [list [list $OID [list map $map]] ]]] {*}[lrange $args 2 end]
                #tailcall $command [dict create i [dict create this [list [list $OID {}] ]]] {*}[lrange $args 2 end]

				#jjj
                #tailcall $command [list i [list this [list [list $OID [list map $map]] ]]] {*}[lrange $args 2 end]
				tailcall $command [list i [list this [list [list $OID [list map [list [lindex $map 0]  { {} {} } ]]] ]]] {*}[lrange $args 2 end]
            }
        }
        }
        #------------
    
    
    	if {![llength $args]} {
    		#return $map
    		return [lindex $map 0 1]
    	} elseif {[llength $args] == 1} {
    		#short-circuit the single index case for speed.
    		if {$args ni {.. . -- - & @}} {
                if {$cheat} {
    
    			lassign [lindex $map 0] OID alias itemCmd 
    			#return [::p::${OID}::$itemCmd [lindex $args 0]]
                #tailcall ::p::${OID}::$itemCmd [dict create i [dict create this [list [list $OID [list map $map]]]]] [lindex $args 0]
                tailcall ::p::${OID}::$itemCmd [list i [list this [list [list $OID [list map $map]]]]] [lindex $args 0]
                }
    		} elseif {[lindex $args 0] eq {--}} {
    			#!todo - we could hide the invocant by only allowing this call from certain uplevel procs.. 
    			# - combined with using UUIDs for $OID, and a secured/removed metaface on the object 
    			# - (and also hiding of [interp aliases] command so they can't iterate and examine all aliases)
    			# - this could effectively hide the object's namespaces,vars etc from the caller (?)
    			return $map
            }
    	}
    } else {
        #null OID - assume map is included in the _ID_ dict.
        #set map [dict get $subject map]
        set map [dict get $this_info map]

        lassign [lindex $map 0] OID alias itemCmd cmd
    }
    #puts "predator====  subject:$subject args:$args  map:$map cmd:$cmd  "



	#set map $invocant  ;#retain 'invocant' in case we need original caller info.. 'map' is the data for whatever is at base of stack.
	set command $cmd
	set stack [list]

	#set operators [list . , ..]  ;#(exclude --) 


	#!todo? short-circuit/inline commonest/simplest case {llength $args == 2}


	set argProtect 0
	set pending "" ;#pending operator  e.g . , idx .. & @
    set _ID_ ""

	set i 0

	while {$i < [llength $args]} {
		set word [lindex $args $i]

        if {$argProtect} {
            #argProtect must be checked first.
            # We are here because a previous operator necessitates that this word is an argument, not another operator.
			set argProtect 0
			lappend stack $word
			if {$pending eq {}} {
			    set pending idx ;#An argument only implies the index operator if no existing operator is in effect. (because '>obj $arg'  must be equivalent to '>obj . item $arg'
			}
			incr i
		} else {
            switch -- $word {.} {
                #$i is the operator, $i + 1 is the command.
                if {[llength $args] > ($i + 1)} {
                    #there is at least a command, possibly args too
                    
                    if {$pending ne {}} {
                        #puts ">>>> >>>>> about to reduce. pending:$pending  command:$command _ID_:$_ID_ stack:$stack"


                        #always bounces back into the predator via tailcall
                        @reduce_pending_stack@  
                    } else {
                        if {$OID ne {null}} {
                            #set command ::p::${OID}::[lindex $args $i+1]      
                            #lappend stack [dict create i [dict create this [list $OID]]]

                            set command ::p::${OID}::[lindex $args $i+1]
                            set _ID_ [list i [list this [list [list $OID [list map $map]]]]]

                        } else {
                            #set command [list $command [lindex $args $i+1]]
                            lappend stack [lindex $args $i+1]
                        }
                        set pending .
                        set argProtect 0
                        incr i 2
                    }
                } else {
                    #this is a trailing .
                   	#puts "----> MAP $map ,command $command ,stack $stack"
                    if {$OID ne {null}} {
                        return [::p::internals::trailing. $map $command $_ID_ $stack $i $args $pending]
                    } else {
                        #!todo - fix. This is broken!
                        #the usefulness of a reference to an already-resolved value is questionable.. but for consistency it should probably be made to work.

                        #for a null object - we need to supply the map in the invocation data
                        set command ::p::internals::predator

                        set this_info [dict create map [list [list {null} {} {lindex} $command {}]] ]
                        set this_invocant [list null $this_info]

                        set _ID_ [dict create i [dict create this [list $this_invocant]]   ]
						
                        return [::p::internals::trailing. $map $command $_ID_ $stack $i $args $pending]
                    }
                }
            } {--} {
				#argSafety operator (see also "," &  -* below)
				set argProtect 1
				incr i
            } {,} {
				set argProtect 1
				if {$i+1 < [llength $args]} {
					#not trailing
					if {$pending ne {}} {
                        @reduce_pending_stack@
					} else {
                        if {$OID ne {null}} {
                            #set command [list ::p::[lindex $map 0 0]::$itemCmd  [lindex $args $i+1]]   
                            #set command [list $command . $itemCmd [lindex $args $i+1]]

                            set stack [list . $itemCmd [lindex $args $i+1]]

                            set _ID_ ""

                            #lappend stack [dict create i [dict create this [list $OID]]]

                            set pending "."
                        } else {
                            # this is an index operation into what is presumed to be a previously returned standard tcl list. (as opposed to an index operation into a returned pattern object)
                            #set command [list $itemCmd $command [lindex $args $i+1]]
                            #set command  [list ::p::internals::predator [list [list {null} {} {lindex} $command {}]] [lindex $args $i+1] ]


                            #set command  ::p::internals::predator 
                            #set _ID_ [dict create i [dict create this [list null]] map [list [list {null} {} {lindex} [lindex $args $i+1] {}]] ]
                            #lappend stack [lindex $args $i+1] 
 

                            set command [list $itemCmd $command]  ;#e.g  {lindex {a b c}}

                            #set command  ::p::internals::predator
                            #set _ID_ [dict create i [dict create this [list null]] map [list [list {null} {} {lindex} $nextcommand {}]]]
                            set _ID_ {}
                            lappend stack [lindex $args $i+1] 


                            set pending "."  ;#*not* idx or "," 
                        }

                        set argProtect 0
                        incr i 2
                    }
				} else {
                    return [::p::internals::trailing, $map $command $stack $i $args $pending]
                }
            } {..} {
                    #Metaface operator
					if {$i+1 < [llength $args]} {
						#operator is not trailing.
						if {$pending ne {}} {
                            @reduce_pending_stack@
						} else {
                            incr i
    
                            #set command [list ::p::-1::[lindex $args $i] [dict create i [dict create this [list $OID]]]]
                            set command ::p::-1::[lindex $args $i]
    
                    		#_ID_ is a list, 1st element being a dict of invocants.
                    		# Each key of the dict is an invocant 'role'
                    		# Each value is a list of invocant-aliases fulfilling that role
                    		#lappend stack [list [list caller [lindex $map 0 1] ]]
                            #lappend stack [list [dict create this [lindex $map 0 1]]]  ;#'this' being the 'subject' in a standard singledispatch method call.
                            #lappend stack [dict create i [dict create this [list [lindex $map 0 1]]]]

                            set _ID_ [dict create i [dict create this [list [list $OID [list map $map]]]]]

                            set pending ..
                            incr i
                        }
					} else {
                        return [::p::internals::trailing.. $map $command $stack $i $args $pending]
                    }
            } {&} {
                #conglomeration operator
                if {$i+1 < [llength $args]} {
                        if {$pending ne {} } {
                            @reduce_pending_stack@

                            #set interim [uplevel 1 [list {*}$command {*}$stack]]
                            #tailcall {*}$interim  {*}[lrange $args $i end]  ;#don't use a return statement as tailcall implies return
                        }
                        
                        set command [list ::p::-1::Conglomerate $command]
                        lappend stack [lindex $args $i+1]
                        set pending &
                        incr i


                        
                } else {
                    error "trailing & not supported"
                }           
            } {@} {
                #named-invocant operator
                if {$i+1 < [llength $args]} {
                    if {$pending ne {} } {
                        @reduce_pending_stack@
                    } else {
                        error "@ not implemented"

                        set pending @
                        incr i
                    }
                } else {
                    error "trailing @ not supported"
                }
            } default {
                if {[string index $word 0] ni {. -}} {
    					lappend stack $word
    					if {$pending eq {}} {
    						set pending idx
    					}
    					incr i
                } else {
        			if {[string match "-*" $word]} {
        				#argSafety operator  (tokens that appear to be Tcl 'options' automatically 'protect' the subsequent argument)
        				set argProtect 1
        				lappend stack $word
        				incr i
        			} else {
        				if {([string index $word 0] eq ".") && ([string index $word end] eq ".") }  {
        					#interface accessor!
        					error "interface casts not yet implemented!"
        		
        		            set ifspec [string range $word 1 end]
        		            if {$ifspec eq "!"} {
        		                    #create 'snapshot' reference with all current interfaces
        		
        		            } else {
        		                foreach ifname [split $ifspec ,] {
        		                    #make each comma-separated interface-name accessible via the 'casted object'
        		
        		                }
        		            }
        		
        				} else {
                            #has a leading . only. treat as an argument not an operator.
        					lappend stack $word
        					if {$pending eq {}} {
        						set pending idx
        					}
        					incr i
        				}
        			}
                }
            }


		}
	}

    #assert: $pending ne ""
    #(we've run out of args, and if no 'operators' were found, then $pending will have been set to 'idx' - equivalent to '. item' )
        
	#puts "---> evalling command + stack:'$command' '$stack' (pending:'$pending')"
	if {$pending in {idx}} {
		if {$OID ne {null}} {
			#pattern object
			set command ::p::${OID}::$itemCmd
            set _ID_ [dict create i [dict create this [list [list $OID [list map $map] ] ]]]
		} else {
			# some other kind of command 
            set command [list $itemCmd $command]
        }
	}
    if {![llength [info commands [lindex $command 0]]]} {
		set cmdname [namespace tail [lindex $command 0]]
        if {[llength [info commands ::p::${OID}::(UNKNOWN)]]} {
			lset command 0 ::p::${OID}::(UNKNOWN)
            #puts stdout "!\n calling UNKNOWN $command $cmdname $stack\n\n"

            if {[string length $_ID_]} {
			    tailcall {*}$command $_ID_ $cmdname {*}$stack   ;#delegate to UNKNOWN, along with original commandname as 1st arg.
            } else {
			    tailcall {*}$command $cmdname {*}$stack   ;#delegate to UNKNOWN, along with original commandname as 1st arg.
            }
        } else {
     	    return -code error -errorinfo "3)error running command:'$command' argstack:'$stack'\n - command not found and no 'unknown' handler" "method '$command' not found"
        }
    }
    #puts "... tailcalling $command $stack"
    if {[string length $_ID_]} {
        tailcall {*}$command $_ID_ {*}$stack
    } else {
        tailcall {*}$command {*}$stack
    }
}]