#<p>
#   General purpose test procedures contributed by various people:
#<pre>
#       Art Eschenlauer
#       Kevin Wampler
#       Steve Wampler (<i>sbw@tapestry.tucson.az.us</i>)
#</pre>
#   This is one of several files contributing to the lang package. Changes have
#   been made to rationalise the code to use Unicon functions to avoid implementation
#   dependencies.
#</p>
#<p>
#  This file is in the <i>public domain</i>.
#</p>

package lang

#<p>
# How to tell if something is a class. We now use the langprocs procedure instead
# of implementation dependent code.
# <i>This can be tricked, but only by evil people.</i>
#
# <[returns <tt>var</tt> if it's a class]>
# <[fails if <tt>var</tt> is not a class]>
#</p>
procedure isClass(var)       # Object to examine
   return get_type(var) == "class" & var
end

#<p>
# A version of the type command designed to work on classes.
# For non class objects it behaves exactly as the standard type()
# function.  For classes it generates the name of the class and
# the names of all classes that it inherits from
#  <[generates name of class <tt>var</tt> and all superclasses or standard
#              Unicon type if <tt>var</tt> is not a class]>
#</p>
#<p>
#   <p>Note:</b> For all entities defined in packages, returns user-level
#      form of name, e.g.: "package::class" instead of the internal form
#      of name, e.g.: "package__class".
#</p>
#<p>
# We now use the langprocs procedure instead of implementation dependent code.
#   <i>As with <tt>isClass()</tt>, this can be tricked by evil people.</i>
#</p>
procedure Type(var)      # Object to examine
   if isClass(var) then {
      suspend lang::mapPackageInt2Ext(::classname(var) | !get_class(var).get_supers())
      }
   else return lang::mapPackageInt2Ext(::type(var))
end

#<p>
#  <i>Intended for internal use only.</i>
#  Map "package__object" into "package::object". This is implementation dependent
#  code and at present there is no Unicon function that returns the package
#  information for any defined value. It also checks that the name is not in
#  external format first and if it finds it is then it will return it unchanged.
#  This allows "__" to be used in external names.
#</p>
procedure mapPackageInt2Ext(s)
   local ns := ""
   s ? {
      if not ::find("::") then {
         ns ||:= ::tab(::find("__")) || (::move(2),"::")
         ns ||:= ::tab(0)
      } else {
         ns := s
      }
   }
   return ns
end

#<p>
# Is className an ancestor of class x?
#   Any class is considered as an ancestor of itself.
#   <[param x -- class to test]>
#   <[param className -- name of potential ancestor or actual potential ancestor.
#        For example, <tt>instanceof(X,"lang::Object")</tt> and
#        <tt>instanceof(X,Object())</tt> are equivalent.]>
#   <[returns <tt>x</tt> if <tt>x</tt> is an instance of <tt>className</tt>]>
#</p>
procedure instanceof(x, className)
   # The call to isClass is just to ensure x is a class, since
   #   istype(...) doesn't care.
   return (isClass(x) & istype(x, className))
end

#<p>
# Is the type of x s?  Works even if s is "class" or "record".
# Also works if s is an actual class instead of a string, as in:
# </p>
# <pre>
#   if istype(x,Object())
# </pre>
#<p>
#   Will accept s as "numeric" to check if x is either
#      a real or an integer.
#   <[returns <tt>x</tt> if it's of type <tt>s</tt>]>
#   <[fails if <tt>x</tt> is not of type <tt>s</tt>]>
#</p>
procedure istype(x,         # Object to examine
                 s)         # Type to check against
   local ss

   if ss := ::string(s) then {
      if ss == "numeric" then {
         return ::numeric(x) & x
      } else {
         return ss == get_type(x) & x
      }
   } else {
      #
      # Last gasp, maybe s is really a class/object instead of a classname
      #
      return get_type(s) == Type(x) & x
   }
end

#<p>
# Is x a list?
#   <[returns <tt>x</tt> if <tt>x</tt> is a list]>
#   <[fails if <tt>x</tt> is not a list]>
#</p>
procedure isList(x)          # Object to examine
   return istype(x, "list")
end

#<p>
# Is x a table?
#   <[returns <tt>x</tt> if <tt>x</tt> is a table]>
#   <[fails if <tt>x</tt> is not a table]>
#</p>
procedure isTable(x)         # Object to examine
   return istype(x, "table")
end

#<p>
# Is x a set?
#   <[returns <tt>x</tt> if <tt>x</tt> is a set]>
#   <[fails if <tt>x</tt> is not a set]>
#</p>
procedure isSet(x)           # Object to examine
   return istype(x, "set")
end

#<p>
# Is x a record?
#   A class is NOT a record! Use get_type(o) which returns "record" for all not
#   object/class values that are records.
#   <[returns <tt>x</tt> if <tt>x</tt> is a record]>
#   <[fails if <tt>x</tt> is not a record]>
#</p>
procedure isRecord(x)        # Object to examine
   return (get_type(x) == "record" & x)
end

#<p>
# Is x a procedure?
#   <[returns <tt>x</tt> if <tt>x</tt> is a procedure]>
#   <[fails if <tt>x</tt> is not a procedure]>
#</p>
procedure isProcedure(x)     # Object to examine
   return istype(x, "procedure")
end