TCL - Playing with Records - Part Two

   
   
 cli  functional  
 code  
Article Series

This article series discuss more than 30 different programming languages. Please read overview before you read any of the details.

Playing with Records Related Articles.

Table of Content
Where to Discuss?

Local Group

Preface

Goal: Continue Part One

4: List Comprehension Equivalent.

Using Map and Grep.

TCL support map and grep, or even list comprehension. But since this approach, we require additional funtcion. We will skip this list comprehension parts.

However, if you care you can read thoroughly in article below:

5: Approach in Solving Unique

A custom example, that you can rewrite.

An Algorithm Case

Why reinvent the wheel?

The same reason as any other articles.

x:xs Pattern Matching

The same with any other articles as well.

Array Filtering

We can just filter array, as this example below:

#/usr/bin/tclsh

set tags [list "rock" \
  "jazz" "rock" "pop" "pop"]
set tags [lsearch -inline \
  -all -not -exact $tags "rock"]
puts "[join $tags ":"]"

With the result as below array:

❯ ./11-exclude-a.tcl
jazz:pop:pop

TCL/TK: Exclude Function

Exclude Function

The exclude function is just a filter with below details:

#!/usr/bin/env tclsh

proc exclude {value tags} {
  return [lsearch -inline \
    -all -not -exact $tags $value]
}

set tags [list "rock" "jazz" "rock" "pop" "pop"]

puts [join [exclude rock $tags] :]

With the result exactly the same as above:

TCL/TK: Exclude Function

Unique Module

Since we are going to reuse the unique approach above in other script. It is better to bundle the script in its own tcl module.

namespace eval ::MyHelperUnique {
  namespace export unique

  set version 1.0
  set MyDescription "MyHelperUnique"
  variable home [file join [pwd]\
    [file dirname [info script]]]
}

proc unique {tags} { ... }

package provide MyHelperUnique $MyHelperUnique::version
package require Tcl 8.0

The return values is an array.

TCL/TK: The Unique Module

Package Index

We still need to configure package index for MySongs module.

package ifneeded MySongs 1.0 \
  [list source [file join $dir MySongs.tcl]]

package ifneeded MyHelperUnique 1.0 \
  [list source [file join $dir MyHelperUnique.tcl]]

package ifneeded MyHelperFlatten 1.0 \
  [list source [file join $dir MyHelperFlatten.tcl]]

TCL/TK: Package Index

Recursive Unique Function

With exclude function above, we can build unique function recursively, to get distinct value.

proc unique {tags} {
  if { [llength $tags] <= 1 } {
    return $tags
  } else {
    set head [lindex $tags 0]
    set tail [lreplace $tags 0 0]

    set xcld [lsearch -inline \
      -all -not -exact $tail $head];
    set uniq [unique $xcld]

    return [linsert $uniq 0 $head]
  }
}

The return values is in array.

TCL/TK: The Unique Module

Using Unique Module

There is nothing to say in this code below. Just apply unique function to our song records.

#!/usr/bin/env tclsh

lappend auto_path "./"
package require MyHelperUnique 1.0

set tags [list "rock" \
  "jazz" "rock" "pop" "pop"]

puts [join [unique $tags] :]

With the result as below array:

❯ ./12-unique-a.tcl
rock:jazz:pop

TCL/TK: Using Recursive Unique Function

Applying Unique to Songs Records

Now we can apply the method to our unique song challenge.

#!/usr/bin/env tclsh

lappend auto_path "./"
package require MySongs 1.0
package require MyHelperFlatten 1.0
package require MyHelperUnique 1.0

set tags [flatten $MySongs::Songs]
puts [join [unique $tags] :]

With the same result as below

TCL/TK: Solving Unique Song

❯ ./12-unique-b.tcl
60s:jazz:rock:70s:pop

6: Coroutine

TCL/TK support Actor Model pattern. We can rewrite previous process through coroutine, using sender and receiver.

This is rather like a yield in generator in python, than go like channel.

Reference

The Simple Skeleton

We should be ready for the simple demo. This is only consist of one short file.

#!/usr/bin/env tclsh

proc sender {songs} { ... }

proc receiver { message } { ... }

# main: entry point
...

Producer and Consumer

We should prepare two functions:

  1. One for sender, that yield message to coroutine,

  2. And the other one for receiver, that resume message from coroutine.

sender, that yield message.

We add empty string "" value as a stopper.

proc sender {songs} {
  yield [info coroutine]

  foreach song $songs {
    if [dict exist $song tags] {
      set tagss [dict get $song tags]
      foreach tag $tagss {
        yield $tag
  }}}
  yield ""
}

TCL/TK: Coroutine: Sender

This empty string "" value is yielded outside the loop.

receiver, that resume message.

Now we can build a while loop that will stop, whenever the value is empty string "".

Otherwise the while loop will, resume any yielded value.

proc receiver { message } {
  set tags {}

  while true {
    set tag [message]
    if {$tag == ""} {
      return $tags
    } elseif {[lsearch $tags $tag] < 0} {
      lappend tags $tag
    }
  }
}

TCL/TK: Coroutine: Receiver

Running Coroutine

Pretty short entry point right?

No need to bundle into function.

# main: entry point
lappend auto_path "./"
package require MySongs 1.0

coroutine message sender $MySongs::Songs
set tags [receiver message]
puts [join $tags :]

TCL/TK: Coroutine: Program entry Point

Result

The result will be as below list:

❯ ./14-yield.tcl
60s:jazz:rock:70s:pop

This is the end of our tcl journey in this article. We shall meet again in other article.

What is Next 🤔?

Consider continue reading [ Guile - Playing with Records - Part One ].