Detecting the Tcl implementation in use

Prior to the introduction of TIP #440 , detecting the Tcl implementation (a.k.a. "engine") in use could be a bit complex. Ironically, detecting Tcl itself was the toughest job of all, especially for versions less than 8.6. The following script demonstrates how this could have been accomplished. If TIP #440 support is present, it will be used; otherwise, detection heuristics that are somewhat more complex will be used. Perhaps this should be added to tcllib, I don't know (if so, it would need to be in its own file).

###############################################################################
# https://wiki.tcl-lang.org/42279
###############################################################################
#
# Created by Joe Mistachkin on January 27th, 2016.
# Dedicated to the Public Domain.
#
# NOTE: This is a script to detect the engine (a.k.a. implementation) of
#       the Tcl language being used.  Here are the underlying assumptions
#       and rules:
#
#       0. If TIP 440 support is present, the checking is trivial.
#
#       1. The interpreter instance being checked has its standard set of
#          commands and variables.  Ideally, it should be freshly created.
#
#       2. The [detectEngine] procedure should not raise uncaught script
#          errors in any recognized implementation.
#
#       3. The [detectEngine] procedure should not cause any recognized
#          implementation to crash or hang.
#
#       4. The [detectEngine] procedure should not rely on undefined or
#          undocumented behavior of any recognized implementation.
#
#       5. The [detectEngine] procedure should not add, modify, or remove
#          any global variables.  Furthermore, it should not modify or
#          remove any preexisting procedures.  Finally, it should remove
#          any other procedures added during its execution.
#
#       6. All recognized implementations must support array variables -OR-
#          scalar variables that look like array elements, both for use with
#          [info exists] and the "$" syntax.
#
#       7. All recognized implementations must support the "::" prefix that
#          is used to designate a variable in the global namespace.  This
#          rule applies even if the recognized implementation does not have
#          full support for namespaces.
#
#       8. All recognized implementations should support (or correctly fake)
#          infix expressions with at least the following subset of operators:
#
#                                      ==
#                                      >=
#                                      >
#
#          There are cases where some of these operators may not be needed,
#          e.g. ">=" when the implementation was detected before that point
#          in the [detectEngine] procedure.  It should be noted that several
#          recognized implementations (e.g. TH1 and Picol) do not support
#          operator short-circuiting (e.g. "&&", etc).  Additionally, Picol
#          cannot handle expressions containing more than one operator.
#
#       9. All recognized implementations should support the following subset
#          of commands and sub-commands:
#
#                 [proc name args body]
#                 [if expr1 body1]; # NOTE: No "then" clauses.
#                 [info exists varName]
#                 [return value]
#                 [set varName varValue]
#                 [catch script ?varName?]
#                 [llength list]
#                 [info commands name]
#                 [clock seconds]
#                 [rename oldName newName]
#                 [string trim string]
#                 [info vars pattern]
#                 [package versions package]
#
#          There are cases where some of these commands may not be needed,
#          e.g. [clock seconds] when the implementation was detected prior
#          to that point in the [detectEngine] procedure.
#
#          Additional commands and sub-commands may be used within some of
#          the [if] blocks -OR- after checking for all implementations
#          recognized to be minimalist (i.e. where the chance is quite high
#          that they are available).
#
#      10. No implementation of the Tcl language, other than Tcl itself,
#          claims to be version 8.6 or higher, as of January 2016.
#
#      11. Only Tcl itself has BigNum support, version 8.5 and higher, as
#          of January 2016.
#
#      12. Only Tcl itself has a bytecode compiler, version 8.0 and higher,
#          as of January 2016.
#
#      13. The recognized Tcl language implementations are:
#
#                 Eagle, all versions (verified)
#                 TH1, all versions (verified)
#                 Jim, all versions (verified)
#                 JTcl, version 2.7.0+ (verified)
#                 Jacl, version 1.3.2+ (verified)
#                 Picol, version 0.1.22+ (verified)
#
#                 Tcl, version 8.4, without TIP 440 (verified)
#                 Tcl, version 8.5, with TIP 440 (verified)
#                 Tcl, version 8.5, without TIP 440 (verified)
#                 Tcl, version 8.6+, with TIP 440 (verified)
#                 Tcl, version 8.6+, without TIP 440 (verified)
#
#          Detection of Tcl itself, versions from 8.0 to 8.3, will probably
#          work; however, it has not been tested.
#
#      14. Feel free to improve this by making it more robust, recognizing
#          more implementations of the Tcl language (or versions thereof),
#          or fixing mistakes.
#
proc detectEngine {} {
  #
  # NOTE: The following [if] block must not cause an error in any recognized
  #       implementation.
  #
  if {[info exists ::tcl_platform(engine)]} {
    return $::tcl_platform(engine)
  }

  #
  # HACK: This must be first because both TH1 and Picol lack support for
  #       the "then" clause; however, only Picol has the [_l] command.
  #       The "&&" operator cannot be used here.  So, nested [if] blocks
  #       are used instead.
  #
  set code [catch {llength [info commands _l]} result]
  if {$code == 0} {if {$result == 1} {return Picol}}

  #
  # HACK: This must be second because there are a number of constructs
  #       used beyond this point that TH1 cannot handle.  This works by
  #       checking for a lack of "then" clause support.  This cannot be
  #       Picol, because that was already checked above; therefore, it
  #       must be TH1.
  #
  if {[catch {if {1} then {}}] == 1} {return TH1}

  #
  # NOTE: Check for the $::tcl_version variable, which Tcl itself should
  #       always have.
  #
  if {[info exists ::tcl_version]} {
    #
    # NOTE: Check for Tcl version 8.6 or higher.  If this is true, it can
    #       only be Tcl itself, as of January 2016.
    #
    if {$::tcl_version >= 8.6} {
      return Tcl
    }

    #
    # NOTE: Check for Tcl version 8.5 or higher.  If this is true, we can
    #       check for BigNum support as that is found only in Tcl itself,
    #       as of January 2016.
    #
    if {$::tcl_version >= 8.5} {
      set code [catch {
        if {1 << 99 == 633825300114114700748351602688} {
          return 1
        } else {
          return 0
        }
      } result]

      if {$code == 2} {
        if {$result == 1} {
          return Tcl
        }
      }
    }

    #
    # HACK: Check for Tcl version 8.0 or higher.  If this is true, then
    #       we can (indirectly) check for the bytecode compiler.  This
    #       uses a "dirty trick" (i.e. the entire procedure is compiled,
    #       which will cause a script compilation error in Tcl 8.0, 8.1,
    #       8.2, 8.3, and 8.4 because they lack the "in" operator.
    #
    if {$::tcl_version >= 8.0} {
      set procName __detect__tcl8x__bc__[clock seconds]

      set code [catch {
        proc $procName { arg } {
          if {$arg} {
            return $arg
          } else {
            if {1 in "1 2 3"} {
              return 2
            } else {
              return 3
            }
          }
        }

        $procName 1
      } result]

      catch {rename $procName {}}; # NOTE: Just in case.

      if {$code == 1} {
        set error [string trim {
          syntax error in expression "1 in "1 2 3"":\
          extra tokens at end of expression
        }]

        if {$result == $error} {
          return Tcl
        }
      }
    }
  }

  #
  # NOTE: All versions of Eagle have the $::eagle_platform array.  Also,
  #       all versions of Eagle have the [nop] command.
  #
  if {[info exists ::eagle_platform]} {
    return Eagle
  } else {
    if {[llength [info commands nop]] == 1} {
      return Eagle
    }
  }

  #
  # NOTE: It appears that all versions of Jim have the [ref] command.
  #
  if {[llength [info vars jim::*]] > 0} {
    return Jim
  } else {
    if {[llength [info commands ref]] == 1} {
      return Jim
    }
  }

  #
  # NOTE: Both Jacl and JTcl provide a package named "java".  No other
  #       recognized implementation of Tcl provides this package in a
  #       freshly created interpreter, as of January 2016.
  #
  set code [catch {llength [package versions java]} result]

  if {$code == 0} {
    if {$result > 0} {
      #
      # NOTE: Only JTcl has the [apply] and [lset] commands.
      #
      if {[llength [info commands apply]] == 1} {
        return JTcl
      } else {
        if {[llength [info commands lset]] == 1} {
          return JTcl
        }
      }

      return Jacl
    }
  }

  return unknown; # TODO: No idea, improve me?
}

###############################################################################
#
# NOTE: All of the following code is ONLY used for testing the [detectEngine]
#       procedure itself and can be safely removed.
#
###############################################################################

if {1} {
  #
  # NOTE: First, try the detection (possibly with TIP 440).
  #
  catch {
    puts "Detection (maybe) with TIP 440: [detectEngine]\n"
  }

  #
  # NOTE: Next, remove the TIP 440 array element.
  #
  catch {
    unset ::tcl_platform(engine)
  }

  #
  # NOTE: Next, remove the TIP 440 array element for Picol.
  #
  catch {
    #
    # NOTE: Picol cannot unset a single array element.  Use a
    #       workaround, just in case it is Picol.
    #
    if {[info exists tcl_platform(engine)]} {
      set list [array get tcl_platform]
      unset tcl_platform
      foreach {name value} $list {
        if {$name ne "engine"} {
          set tcl_platform($name) $value
        }
      }
      puts "OLD tcl_platform = $list\n"
      puts "NEW tcl_platform = [array get tcl_platform]\n"
    }
  }

  #
  # NOTE: Next, try the detection again without TIP 440.
  #
  catch {
    puts "Detection without TIP 440: [detectEngine]\n"
  }

  #
  # NOTE: Finally, halt evaluation of the script file.
  #
  catch {return ""}
}

The Eagle script library ("platform.eagle") defines the following procedure:

proc isEagle {} {
  return [expr {[info exists ::tcl_platform(engine)] && \
      [string compare -nocase eagle $::tcl_platform(engine)] == 0}]
}