vnom.icn

$ifndef VNOM
$define VNOM
############################################################################
#
# File: vnom.icn
#
# Subject: vnom.icn - a named vector with Lua-style metatable access
#
# Author: Arthur Eschenlauer (https://orcid.org/0000-0002-2882-0508)
#
# Date: 1 November 2022
#
# URL: https://chiselapp.com/user/eschen42/repository/aceincl/file?name=vnom.icn
#
############################################################################
#
# This file is in the public domain. Art Eschenlauer has waived all
# copyright and related or neighboring rights to:
#   vnom.icn - a named vector with Lua-style metatable access
# For details, see:
#   https://creativecommons.org/publicdomain/zero/1.0/
#
# If you require a specific license and public domain status is not suffi-
# cient for your needs, please substitute the MIT license (see below), bearing
# in mind that the copyright "claim" is solely to meet your requirements
# and does not imply any restriction on use or copying by the author:
#
#   Copyright (c) 2022, Arthur Eschenlauer
#
#   Permission is hereby granted, free of charge, to any person obtaining
#   a copy of this software and associated documentation files (the
#   "Software"), to deal in the Software without restriction, including
#   without limitation the rights to use, copy, modify, merge, publish,
#   distribute, sublicense, and/or sell copies of the Software, and to
#   permit persons to whom the Software is furnished to do so, subject
#   to the following conditions:
#
#   The above copyright notice and this permission notice shall be
#   included in all copies or substantial portions of the Software.
#
#   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
#   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
#   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT.
#   IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
#   CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
#   TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
#   SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
############################################################################
#
# A VNom is a "Nominal Vector", a list with named cells.
# The type-letter "V" is used in the overview below to represent this type.
# Elements are apparently stored in a monotonic order, accessible by key.
# However, to accommodate insertions and deletions predictably, this is
# implemented as an "indirect list" of keys for a table whose values
# are the stored values. Keys and values are any Icon type.
#
# A use case for this construct might a dynamically-defined record
# (i.e., an ordered list of key-value pairs), such as might be used to
# represent a row returned by an SQL query.
# 
# Through use of a Lua-inspired "metatable", operations on this structure
# may be defined or extended with a few message-handler-extension functions.
# Note that a metatable may be shared among several VNom instances to give
# them identical behavior; for this reason, the copy constructor copies
# a reference to the metatable rather than making a copy of the metatable.
# Thus, behavior of the set of instances may (even dynamically) be modified
# by changing a single structure.
#
# Schematic Overview:
#
#   State
#     - L of keys of table T
#     - value of T is indirectly specified by the corresponding index of L
#
#   Operations (messages passed to message handler)
#     vmsg(V, "!"                 ) : x1, ...  # generate values
#                                              #  in order keys in L
#     vmsg(V, "*"                 ) : i  # produce number of values
#
#     vmsg(V, "copy"              ) : V  # produce a copy of V
#                                        #   having same metatable instance
#     vmsg(V, "get" | "pop"       ) : x  # pop value, discarding key
#     vmsg(V, "pull"              ) : x  # pull value, discarding key
#     vmsg(V, "push",       xk, xv) : V  # push|replace value xv for key xk
#     vmsg(V, "put",        xk, xv) : V  # put|replace  value xv for key xk
#     vmsg(V, "key"               ) : x1, ...  # generate keys
#                                              #   in order keys in L
#     vmsg(V, "keylist"           ) : L  # copy of L of ranked keys
#     vmsg(V, "bykey",      x     ) : s  # value, assignable by key
#     vmsg(V, "byrank",     i     ) : s  # value, assignable by rank
#     vmsg(V, "delbykey",   x     ) : n  # delete value by key
#     vmsg(V, "delbyrank",  i     ) : n  # delete value by rank
#
#     vmsg(V, "disposable"        ) : s  # disposable property
#     vmsg(V, "id"                ) : s  # ID property, assignable
#     vmsg(V, "image"             ) : s  # image property
#     vmsg(V, "kind"              ) : s  # Kind property, assignable
#     vmsg(V, "metatable"         ) : s  # Metatable, assignable
#     vmsg(V, "strings"           ) : s  # generate a string to show each KVP
#     vmsg(V, "type"              ) : s  # Type property, assignable
#
#   Constructor
#     vnew(Original:T, Type:s, ID:s, Metatable:T, Disposable:s, Kind:s):V
#       Construct a new VNom instance.
#         - Original:T
#             if not null, a plain table, or another VNom (or extension
#             of VNom), making this a "copy-constructor"
#         - Type:s
#             Type property, if null then Type of \Original; default is
#             Kind || typecount
#         - ID:s
#             ID property, defaults to VNom_n, where n the table counter
#         - Metatable:T
#             table mapping message strings to message-handler procedures
#         - Disposable:n?
#             Disposable property, if not null, a disposable property is
#             added and set to "yes", to be switched to "done" if the
#             VNom has been disposed
#         - Kind:s
#             Kind property, defaults to "VNom"
#
############################################################################
#
# For example:
#
#   icon -P '
#   link ximage
#   $include "lindel.icn"
#   $include "vnom.icn"
#   # vnew and vmsg are $defined in vnom.icn as:
#   #   $define vnew VNomCtor
#   #   $define vmsg VNomMesg
#   procedure main()
#     local V
#     V := vnew(, "vtype", , , , "vkind")
#     vmsg(V, "push", 1, "bye bye")
#     vmsg(V, "put", "hola", "mundo")
#     vmsg(V, "push", "hello", "world")
#     write(ximage(V))
#   end
#   '
#
# produces this output:
#
#   T1 := table(&null)
#      T1[1] := "bye bye"
#      T1["hello"] := "world"
#      T1["hola"] := "mundo"
#      T1[T1] := T2 := table(&null)
#         T2["Dspsbl"] := &null
#         T2["ID"] := "vtype_1"
#         T2["Kind"] := "vkind"
#         T2["Mttbl"] := T3 := table(&null)
#            T3["!"] := procedure VNomMesg
#            T3["*"] := procedure VNomMesg
#            T3["bykey"] := procedure VNomMesg
#            T3["byrank"] := procedure VNomMesg
#            T3["copy"] := procedure VNomMesg
#            T3["delbykey"] := procedure VNomMesg
#            T3["delbyrank"] := procedure VNomMesg
#            T3["disposable"] := procedure VNomMesg
#            T3["get"] := procedure VNomMesg
#            T3["id"] := procedure VNomMesg
#            T3["image"] := procedure VNomMesg
#            T3["key"] := procedure VNomMesg
#            T3["keylist"] := procedure VNomMesg
#            T3["kind"] := procedure VNomMesg
#            T3["metatable"] := procedure VNomMesg
#            T3["pop"] := procedure VNomMesg
#            T3["pull"] := procedure VNomMesg
#            T3["push"] := procedure VNomMesg
#            T3["put"] := procedure VNomMesg
#            T3["type"] := procedure VNomMesg
#         T2["State"] := L1 := list(3)
#            L1[1] := "hello"
#            L1[2] := 1
#            L1[3] := "hola"
#         T2["Type"] := "vtype"
#
############################################################################
#
# Requires:
#   - preprocessor
#   - $include "lindel.icn"
#
############################################################################
#
# Links: none
#
############################################################################

# vnom.icn - a named vector with Lua-style metatable access

# require LINDEL for Ldelete from lindel.icn
$ifndef LINDEL
$include "lindel.icn"
$endif

$ifndef vnew
$define vnew VNomCtor
$endif

$ifndef vmsg
$define vmsg VNomMesg
$endif

# VNomCtor - a VNom constructor
procedure VNomCtor(Original, Type, ID, Metatable, Disposable, Kind)
  local V, MT, L, OrigProps
  static typecount
  initial typecount := 0
  if \Original
    then OrigProps := Original[key(Original) === Original]
  # allocate the the external "VNom" reference
  V              := copy(\Original) | table()
  delete(V, \Original)
  # allocate internal table for properties
  V[V]           := table()

  #----- META-PROPERTIES -----
  # Dspsbl is &null | "yes" | "done"
  V[V, "Dspsbl"] := /Disposable |
                   "yes"
  # in case someone chooses to extend VNom
  V[V, "Kind"]   := \Kind |
                    Original[\Original, key(\OrigProps) == "Kind"] |
                    "VNom"
  # emulate Lua metatables, i.e.:
  #   https://www.lua.org/manual/5.4/manual.html#2.4
  V[V, "Mttbl"]  :=
    MT           := \Metatable |
                    Original[\Original, key(\OrigProps) == "Mttbl"] |
                    table()
  # allocate a list to hold the values
  V[V, "State"]  := if key(\OrigProps) == "State"
                    then
                      copy(Original[\Original, "State"])
                    else {
                      L := list()
                      every put(L, key(\Original))
                      L
                      }
  # default Type is VNom_n where n is typecount
  V[V, "Type"]   := \Type |
                    Original[\Original, key(\OrigProps) == "Type"] |
                    (V[V, "Kind"] || (typecount +:= 1))
  # default ID is Kind || "_n" where n is typecount
  V[V, "ID"]     := \ID |
                    V[V, "Type"] || (image(V) ? (="table",tab(upto('('))))

  #----- MESSAGE HANDLERS -----
  # messages having 0 args
  #   - property accessors
  MT["disposable"] := VNomMesg
  MT["id"]         := VNomMesg
  MT["image"]      := VNomMesg
  MT["kind"]       := VNomMesg
  MT["metatable"]  := VNomMesg
  MT["type"]       := VNomMesg
  #   - L/T messages
  MT["!"]          := VNomMesg
  MT["*"]          := VNomMesg
  MT["copy"]       := VNomMesg
  MT["get"]        := VNomMesg
  MT["key"]        := VNomMesg
  MT["keylist"]    := VNomMesg
  MT["pop"]        := VNomMesg
  MT["pull"]       := VNomMesg

  # messages having 1 arg
  #   - element selectors/deleters
  MT["bykey"]      := VNomMesg
  MT["byrank"]     := VNomMesg
  MT["delbykey"]   := VNomMesg
  MT["delbyrank"]  := VNomMesg

  # messages having 2 args
  #   - L/T messages
  MT["push"]       := VNomMesg
  MT["put"]        := VNomMesg

  # produce newly-constructed "object"
  return V
end

# VNomMesg - a VNom message handler
procedure VNomMesg(args[])
  local V, message, idx                   # args[1:3]
  local state                             # list of keys of V
  local properties                        # map property name:s to X
  local metamethod                        # possibly override this proc.
  local val                               # pulled or popped val
  local nargs                             # "excess" args beyond first two
  if *args < 2                            # need at least V and message
    then {
      &dump := 1
      stop("VNomMesg() from vnom.icn: *args < 2")
      }
  nargs := *args - 2                      # count of args beyond V and msg
  V := args[1]                            # extract VNom from args
  if "table" ~== type(V)
    then {
      &dump := 1
      stop("VNomMesg() from vnom.icn: first arg of type ", image(type(V)))
      }
  message := args[2]                      # extract message from args
  if /V[V]                                # coerce ordinary table to get
    then V := VNomCtor(V)                 #   the same interface as VNom
  metamethod := V[V, "Mttbl", message]    # extract metamethod from VNom
  suspend if (\metamethod ~=== VNomMesg)  # Is this proc the impl. of msg.?
    then metamethod ! args                #   if not, invoke implementation
    else {                                #   else, this proc. handles msg.
      properties := V[V]                  # retrieve properties T from V
      state := properties["State"]        # retrieve state L from props. T
      case nargs of {
        2 : case message of {              # message handlers taking 2 args
          "push" : {                     # "push" message handler
            idx := args[3]                 # get intended key
            if not (idx  === !state)       # make sure key is in state;
              then push(state, idx)        #   or add left end of state L
            V[idx] := args[4]              # assign key and value in V
            V                              # produce V
            }
          "put" : {                      # "put" message handler
            idx := args[3]                 # get intended key
            if not (idx  === !state)       # make sure key is in state;
              then put(state, idx)         #   or add right end of state L
            V[idx] := args[4]              # assign key and value in V
            V                              # produce V
            }
          default : fail
          }
        1 : case message of {              # message handlers taking 0 args
          "bykey" : {                    # "bykey" message handler
            V[args[3]]                     # produce L-value for key in V
            }
          "byrank" : {                   # "byrank" message handler
            V[state[args[3]]]              # produce L-value for rank in L
            }
          "delbykey" : (                 # "delbykey" message handler
            idx :=                         # if key exists in state,
              args[3] ===                  #   get index of key in state
              state[                       #   otherwise fail
                val := 1 to *state
                ],
            Ldelete(state, val),           # delete element at index
            delete(V, idx),                # delete key from V
            &null
            )
          "delbyrank" : (                # "delbyrank" message handler
            0 < ( val :=                   # fail when rank is valid
                (*state >= args[3])),
            idx := state[val],             # get key from state
            Ldelete(state, val),           # delete element at index
            delete(V, idx),                # delete key from V
            &null
            )
          default : fail
          }
        0 : case message of {              # message handlers taking 0 args
          "!" : {                        # "!" message handler
            V[!state]                      # generate values,
            }                              #   ordered by state L
          "*" : {                        # "*" message handler
            *state                         # produce length of state L
            }
          "copy" : {                     # "copy" message handler
            val := VNomCtor(V)             # produce copy of V
            }                              #   with same metatable instance
          "disposable" : {               # "disposable" message handler
            V[V, "Dspsbl"]                 # produce disposable property
            }                              #   as an L-value
          "id" : {                       # "id" message handler
            V[V, "ID"]                     # produces ID property
            }                              #   as an L-value
          "image" : {                    # "image" message handler
            V[V, "ID"] || "(" || *state || ")" # produces s
            }
          "key" : {                      # "key" message handler
            !state                         # generate keys (names),
            }                              #   ordered by state L
          "keylist" : {                  # "keylist" message handler
            copy(state)                    # produce L of keys (names),
            }                              #   ordered by state L
          "kind" : {                     # "kind" message handler
            V[V, "Kind"]                   # produces Kind property
            }                              #   as an L-value
          "metatable" : {                # "metatable" message handler
            V[V, "Mttbl"]                  # produce metatable
            }                              #   as an L-value
          "pop" | "get" : {              # "pop" and "get" message handlers
            val := V[idx := pull(state)]   # get idx and val
            delete(V, idx)                 # remove idx from keys of V
            val                            # produce val
            }
          "pull" : {                     # "pull" message handler
            val := V[idx := pull(state)]   # get idx and val
            delete(V, idx)                 # remove idx from keys of V
            val                            # produce val
            }
          "strings" : {                  # "strings" message handler
            VNomStrings(V)                 # generates one representative
            }                              #   string per key-value pair
          "type" : {                     # "type" message handler
            V[V, "Type"]                   # produces Type property
            }                              #   as an L-value
          default : fail
          }
        default : fail
        }
      }
end

invocable "json"

# generate elements of VNom as strings
procedure VNomStrings(V, j)
  local k, p, s, x, e
  e := &error; &error := -1 # save &error state; convert errors to failure
  /j := proc("json") | proc("encode") | image
  &error := e # restore error state
  every k := vmsg(V, "key")
    do
      case type(x := V[k]) of {
        default     : suspend j(x)
        "null"      : suspend k || ": " || "NA"
        "string"  |
        "integer" |
        "real"      : suspend k || ": " || V[k]
        "list"      : {
          s := "["
          every p := 1 to *x
            do
              s ||:=
                if p ~= *x
                  then x[p] || ", "
                  else x[p]
          suspend s || "]"
          }
        }
end


# see tests/test_vnom.* for demonstrations
$endif # VNOM