
/* Pure primitives. These operations are implemented either directly by
   machine instructions or by C functions provided in the runtime. */

/* Copyright (c) 2008-2012 by Albert Graef <Dr.Graef@t-online.de>.

   This file is part of the Pure standard library.

   The Pure standard library is free software: you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public License as
   published by the Free Software Foundation, either version 3 of the License,
   or (at your option) any later version.

   Pure is distributed in the hope that it will be useful, but WITHOUT ANY
   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public License for
   more details.

   You should have received a copy of the GNU Lesser General Public License
   along with this program.  If not, see <http://www.gnu.org/licenses/>. */

using namespace __C;

// The types are documented in prelude.pure.

/* ..

   Primitives
   ----------

   This prelude module is a collection of various lowlevel operations, which
   are implemented either directly by machine instructions or by C functions
   provided in the runtime. In particular, this module defines the basic
   arithmetic and logic operations on machine integers, bigints and floating
   point numbers, as well as various type checking predicates and conversions
   between different types. Some basic pointer operations are also provided,
   as well as "sentries" (Pure's flavour of object finalizers) and
   "references" (mutable expression pointers).

   Special Constants
   ~~~~~~~~~~~~~~~~~

   .. constant:: inf
      		 nan

      IEEE floating point infinities and NaNs. You can test for these using
      the :func:`infp` and :func:`nanp` predicates, see Predicates_ below.

   .. constant:: NULL = pointer 0

      Generic null pointer. (This is actually a built-in constant.) You can
      also check for null pointers with the :func:`null/pointer` predicate,
      see Predicates_.

   Arithmetic
   ~~~~~~~~~~

   The basic arithmetic and logic operations provided by this module are
   summarized in the following table:

   ===========  ===============  =========================================
   Kind         Operator         Meaning
   ===========  ===============  =========================================
   Arithmetic   ``+`` ``-``      addition, subtraction (also unary minus)
   \            ``*`` ``/``      multiplication, division (inexact)
   \            ``div`` ``mod``  exact int/bigint division/modulus
   \            ``^``            exponentiation (inexact)
   Comparisons  ``==`` ``~=``    equality, inequality
   \            ``<`` ``>``      less than, greater than
   \            ``<=`` ``>=``    less than or equal, greater than or equal
   Logic        ``~``            logical not
   \            ``&&`` ``||``    and, or (short-circuit)
   Bitwise      ``not``          bitwise not
   \            ``and`` ``or``   and, or
   \            ``<<`` ``>>``    bit shifts
   ===========  ===============  =========================================

   Precedence and and associativity of the operators can be found in the
   :ref:`operators <operators>` table at the beginning of this section.

   The names of some operations are at odds with C. Note, in particular, that
   logical negation is denoted ``~`` instead of ``!`` (and, consequently,
   ``~=`` denotes inequality, rather than ``!=``), and the bitwise operations
   are named differently. This is necessary because Pure uses ``!``, ``&`` and
   ``|`` for other purposes. Also, ``/`` always denotes inexact (double)
   division in Pure, whereas the integer division operators are called ``div``
   and ``mod``. (``%``, which is not defined by this module, also has a
   different meaning in Pure; it's the exact division operator, see `Rational
   Numbers`_.)

   The above operations are implemented for int, bigint and, where
   appropriate, double operands. (Pointer arithmetic and comparisons are
   provided in a separate module, see `Pointer Arithmetic`_.) The math module
   (see `Mathematical Functions`_) also provides implementations of the
   arithmetic and comparison operators for rational, complex and complex
   rational numbers.

   Note that the logical operations are actually implemented as special forms
   in order to provide for short-circuit evaluation. This needs special
   support from the compiler to work. The primitives module still provides
   definitions for these, as well as other special forms like ``quote`` and
   the thunking operator ``&`` so that they may be used as function values and
   in partial applications, but when used in this manner they lose all their
   special call-by-name properties; see :ref:`Special Forms` in the Pure
   Manual for details.

   A detailed listing of the basic arithmetic and logical operations follows
   below.

   .. function:: infix + x y
      		 infix - x y
		 infix * x y
		 infix / x y
		 infix ^ x y

      Addition, subtraction, multiplication, division and exponentiation. The
      latter two are inexact and will yield double results.

   .. function:: prefix - /unary x

      Unary minus. This has the same precedence as binary '\ :func:`-`\ '
      above.

   .. function:: infix div x y
      		 infix mod x y

      Exact int and bigint division and modulus.

   .. function:: infix == x y
      		 infix ~= x y

      Equality and inequality.

   .. function:: infix <= x y
      		 infix >= x y
		 infix > x y
		 infix < x y

      Comparisons.

   .. function:: prefix ~ x
      		 infix && x y
		 infix || x y

      Logical negation, conjunction and disjunction. These work with machine
      ints only and are evaluated in short-circuit mode.

   .. function:: prefix not x
      		 infix and x y
		 infix or x y

      Bitwise negation, conjunction and disjunction. These work with both
      machine ints and bigints.

   .. function:: infix << x k
      		 infix >> x k

      Arithmetic bit shifts. The left operand ``x`` may be a machine int or a
      bigint. The right operand ``k`` must be a machine int and denotes the
      (nonnegative) number of bits to shift.

      .. note:: This operation may expand to a single machine instruction in
      	 the right circumstances, thus the condition that ``k`` be nonnegative
      	 isn't always checked. This may lead to surprising results if you do
      	 specify a negative value for ``k``. However, in the current
      	 implementation bigint shifts do check the sign of ``k`` and handle it
      	 in the appropriate way, by turning a left shift into a corresponding
      	 right shift and vice versa.

   In addition, the following arithmetic and numeric functions are provided:

   .. function:: abs x
                 sgn x

      Absolute value and sign of a number.

   .. function:: min x y
                 max x y

      Minimum and maximum of two values. This works with any kind of values
      which have the ordering relations defined on them.

   .. function:: succ x
                 pred x

      Successor (``+1``) and predecessor (``-1``) functions.

   .. function:: gcd x y
                 lcd x y

      The greatest common divisor and least common multiple functions from the
      GMP library. These return a bigint if at least one of the arguments is a
      bigint, a machine int otherwise.

   .. function:: pow x y

      Computes exact powers of ints and bigints. The result is always a
      bigint. Note that ``y`` must always be nonnegative here, but see the
      math module (`Mathematical Functions`_) which deals with the case
      ``y<0`` using rational numbers.

   Conversions
   ~~~~~~~~~~~

   These operations convert between various types of Pure values.

   .. function:: hash x

      Compute a 32 bit hash code of a Pure expression.

   .. function:: int x
                 bigint x
                 double x

      Conversions between the different numeric types.

   .. function:: pointer x

      Convert a string, int or bigint to a pointer value. Converting a string
      returns a pointer to the underlying UTF8-encoded C string so that it can
      be passed to the appropriate C functions. Converting an integer gives a
      pointer with the given numeric address. This may be used to construct
      special pointer values such as the null pointer (``pointer 0``).

   .. function:: ubyte x
                 ushort x
                 uint x
                 uint64 x
                 ulong x

      Convert signed (8/16/32/64) bit integers to the corresponding unsigned
      quantities. These functions behave as if the value was "cast" to the
      corresponding unsigned C type, and are most useful for dealing with
      unsigned integers returned by external C routines. The routines always
      use the smallest Pure int type capable of holding the result: ``int``
      for :func:`ubyte` and :func:`ushort`, ``bigint`` for :func:`uint`,
      :func:`uint64` and :func:`ulong`. All routines take int parameters. In
      the case of :func:`uint64`, a bigint parameter is also permitted (which
      is what the C interface returns for 64 bit values). Also note that
      :func:`ulong` reduces to either :func:`uint` or :func:`uint64`,
      depending on the size of ``long`` for the host architecture.

   The following _`rounding functions` work with all kinds of numbers:

   .. function:: floor x
                 ceil x

      Floor and ceil.

   .. function:: round x
                 trunc x

      Round or truncate to an integer.

   .. function:: frac x

      Fractional part (``x-trunc x``).

   Note that all these functions return double values for double arguments, so
   if you need an integer result then you'll have to apply a suitable
   conversion, as in ``int (floor x)``.

   Predicates
   ~~~~~~~~~~

   A syntactic equality test is provided, as well as various type checking
   predicates. Note that type definitions are provided for most of the type
   checking predicates which don't denote built-in types; see `Prelude Types`_
   for details.

   .. function:: same x y
                 infix === x y
                 infix ~== x y

      Syntactic equality. In contrast to :func:`==` and :func:`~=`, this is
      defined on all Pure expressions. Basically, two expressions are
      syntactically equal if they print out the same in the interpreter. In
      the special case of pointer objects and closures, which do not have a
      syntactic representation in Pure, ``x`` and ``y`` must be the same
      object (same pointer value or function).

   .. function:: typep ty x

      Generic type checking predicate. This checks whether ``x`` is of type
      ``ty``, where ``ty`` is a symbol denoting any of the built-in types
      (:type:`int/type`, :type:`bigint/type` etc.) or any type defined in a
      :keyword:`type` definition. (Note that you may have to quote ``ty`` if
      it happens to be defined as a variable or parameterless function.)

   .. function:: intp x
                 bigintp x
                 doublep x
                 stringp x
                 pointerp x
                 matrixp x

      Predicates to check for the built-in types.

   .. function:: charp x

      Single character string predicate.

   .. function:: numberp x
                 complexp x
                 realp x
                 rationalp x
                 integerp x

      Additional number predicates. Note some further "semantic" number
      predicates are defined in the :mod:`math` module, see `Semantic Number
      Predicates and Types`_.

   .. function:: exactp x
                 inexactp x

      Check whether a number is exact (i.e., doesn't contain any double
      components).

   .. function:: infp x
      		 nanp x

      Check for :const:`inf` and :const:`nan` values.

   .. function:: null /pointer p

      Check for null pointers.

   .. function:: applp x
                 listp x
                 rlistp x
                 tuplep x

      Predicates to check for function applications, lists, proper lists and
      tuples. Note that :func:`listp` only checks for a toplevel list
      constructor, whereas :func:`rlistp` also recursively checks the tails of
      the list; the latter may need time proportional to the list size. The
      :func:`applp` and :func:`tuplep` predicates look for an application or
      tuple constructor at the toplevel only, which can always be done in
      constant time.

   .. function:: funp x
                 lambdap x
                 thunkp x
                 closurep x

      Predicates to check for various kinds of function objects (named,
      anonymous or thunk). :func:`closurep` checks for any kind of "normal"
      closure (i.e., named functions and lambdas, but not thunks).

   .. function:: functionp x

      Convenience function to check for "callable" functions. This includes
      any kind of closure with a nonzero argument count as well as partial
      (unsaturated) applications of these.

   .. function:: symbolp x
                 varp x

      Predicates to check for any kind of symbol (this also includes operator
      and nonfix symbols) and for free variable symbols, respectively. Note
      that varp returns true for any symbol which is not an operator or nonfix
      symbol (i.e., for any symbol that could in principle be bound to a
      value, either globally or locally). This holds even if the symbol is
      currently bound to a function, macro or constant.

   Inspection
   ~~~~~~~~~~

   The following operations let you peek at various internal information that
   the interpreter provides to Pure programs either for convenience or for
   metaprogramming purposes. They are complemented by the evaluation
   primitives discussed below, see `Eval and Friends`_.

   .. function:: ans

      Retrieve the most recently printed result of a toplevel expression
      evaluated in the read-eval-print loop. This is just a convenience for
      interactive usage. Note that the :func:`ans` value will stick around
      until a new expression is computed. (It is possible to clear the
      :func:`ans` value with the interactive command ``clear ans``, however.)
      Example::

        > 1/3;
        0.333333333333333
        > ans/2;
        0.166666666666667

   .. function:: __func__

      Returns the (lexically) innermost function at the point of the call.
      This can be either a global function, a local (named) function
      introduced in a :keyword:`with` clause or an anonymous function (a
      lambda). Fails (returning just the literal symbol :func:`__func__` by
      default) if there is no such function (i.e., if the call is at the
      toplevel). Note that in contrast to the C99 variable of the same name,
      this really returns the function value itself in Pure; the :func:`str`
      function can be used if you need the print name of the function.
      Examples::

        > foo x = if x>0 then x else throw __func__;
	> foo (-99);
	<stdin>, line 2: unhandled exception 'foo' while evaluating 'foo (-99)'
	> (\x->x+": "+str __func__) "test";
	"test: #<closure 0x7f4a2411db30>"

      If you want, you can add a default rule for :func:`__func__` which
      specifies the behaviour when :func:`__func__` gets called at the global
      level. E.g.::

        > __func__ = throw "__func__ called at global level";
	> __func__;
	<stdin>, line 5: unhandled exception '"__func__ called at global level"' while
	evaluating '__func__'

   .. macro:: __namespace__

      Returns the current namespace at the point of the call. This is
      implemented as a built-in macro which expands to a string. The empty
      string is returned in the default namespace. Example::

        > namespace foo;
	> foo = __namespace__;
	> namespace;
	> show foo::foo
	foo::foo = "foo";
	> foo::foo;
	"foo"

   .. macro:: __list__

      This expands a (literal) tuple to a list, preserving embedded tuples in
      the same way that list values are parsed in the Pure language,
      cf. :ref:`Primary Expressions`. This is provided for the benefit of
      custom aggregate notations (usually implemented as outfix operators)
      which are supposed to be parsed like the built-in list and matrix
      brackets. Example::

        > outfix (: :);
	> def (:x:) = __list__ x;
	> (:(1,2),(3,4):);
	[(1,2),(3,4)]

      Note that this macro uses internal information from the parser not
      available to Pure programs. Thus there's no way to actually define this
      macro in Pure, which is why it is provided as a builtin instead.

   .. macro:: __locals__

      Built-in macro which expands to a list with the local function bindings
      (:keyword:`with` clauses) visible at this point in the program. The
      return value is a list of hash pairs ``x=>f`` where ``x`` is the global
      symbol denoting the function (the symbol is always quoted) and ``f`` is
      the function value itself. Example::

        > __locals__ with foo x = x+1; x = a+b end;
        [x=>a+b,foo=>foo]
	> f 99 when _=>f = ans!1 end;
	100

      The :macro:`__locals__` function is useful for debugging purposes, as
      well as to implement dynamic environments. It is also used internally to
      implement the :macro:`reduce` macro, see `Eval and Friends`_.

      Note that :macro:`__locals__` always evaluates parameterless functions
      and returns the resulting value instead of a closure (as can be seen in
      the binding ``x=>a+b`` in the example above). Normally this is what you
      want, but it can be a problem with parameterless functions involving
      side effects. In such a case, if you want to evaluate the function at a
      later time, you'll either have to use a thunk or massage the local
      function so that it takes a dummy argument such as ``()``.

      Also note that :macro:`__locals__` will use as keys in the resulting list
      whatever global symbols are in scope at the point of the call. By
      default, i.e., if no global symbol with the same print name as the local
      is visible at the point of the call, a symbol in the default namespace
      is used, as we've seen above. Otherwise the result may be also be a
      qualified symbol if such a symbol has already been declared or defined
      at the point of the call. For instance::

        > namespace foo;
	> public foo;
	> __locals__ with foo x = x+1 end;
	[foo::foo=>foo]

      This behaviour may be a bit surprising at first sight, but is consistent
      with the way the interpreter performs its symbol lookup, see
      :ref:`Symbol Lookup and Creation` for details.

   The following functions allow you to inspect or modify the function, type,
   macro, constant and variable definitions of the running program. This uses
   a special meta representation for rewriting rules and definitions. Please
   see the :ref:`Macros` section in the Pure manual for details. Also note
   that these operations are subject to some limitations, please check the
   remarks concerning :func:`eval` and :func:`evalcmd` in the following
   subsection for details.

   .. function:: get_fundef sym
                 get_typedef sym
                 get_macdef sym

      If the given symbol is defined as a function, type or macro, return the
      corresponding list of rewriting rules. Otherwise return the empty list.

   .. function:: get_interface sym
                 get_interface_typedef sym

      If the given symbol is defined as an interface type, return its
      definition; otherwise return the empty list. :func:`get_interface`
      returns the list of patterns used to declare the type, while
      :func:`get_interface_typedef` returns the actual list of type rules, in
      the same format as with :func:`get_typedef`. Note that the latter may be
      empty even if the type is defined, meaning that the type hasn't been
      instantiated yet, see :ref:`Interface Types` for details. Also note that
      Pure allows you to have *both* an interface and a regular (concrete)
      definition of a type, in which case :func:`get_typedef` and
      :func:`get_interface_typedef` may both return nonempty (and usually
      different) results.

   .. function:: get_vardef sym
                 get_constdef sym

      If the given symbol is defined as a variable or constant, return the
      corresponding definition as a singleton list of the form
      ``[sym --> value]``. Otherwise return the empty list.

   The following functions may fail in case of error, in which case
   :func:`lasterr` is set accordingly (see `Eval and Friends`_ below).

   .. function:: add_fundef rules
                 add_typedef rules
                 add_macdef rules

      Add the given rewriting rules (given in the same format as returned by
      the :func:`get_fundef`, :func:`get_typedef` and :func:`get_macdef`
      functions above) to the running program.

   .. function:: add_fundef_at r rules
                 add_typedef_at r rules
                 add_macdef_at r rules

      Same as above, but add the given rewriting rules at (i.e., before) the
      given rule ``r`` (which must already exist, otherwise the call fails).
      Note that all added rules must have the same head symbol on the
      left-hand side, which matches the head symbol on the left-hand side of
      ``r``.

   .. function:: add_interface sym patterns

      Add the given patterns to the interface type ``sym`` (given as a
      symbol). If the interface type doesn't exist yet, it will be created.

   .. function:: add_interface_at sym p patterns

      Same as above, but add the given patterns at (i.e., before) the given
      pattern ``p`` (the given interface type must already exist and contain
      the given pattern, otherwise the call fails).

   .. function:: add_vardef rules
                 add_constdef rules

      Define variables and constants. Each rule must take the form
      ``sym --> value`` with a symbol on the left-hand side (no pattern
      matching is performed by these functions).

   The following functions may be used to delete individual rewriting rules,
   interface type patterns or variable and constant symbols.

   .. function:: del_fundef rule
                 del_typedef rule
                 del_macdef rule

      Delete the given rewriting rule (given in the same format as returned by
      the :func:`get_fundef`, :func:`get_typedef` and :func:`get_macdef`
      functions) from the running program. Returns ``()`` if successful, fails
      otherwise.

   .. function:: del_interface sym pattern

      Delete the given pattern from the given interface type. Returns ``()``
      if successful, fails otherwise.

   .. function:: del_vardef sym
                 del_constdef sym

      Delete variables and constants, given by their (quoted) symbols. Returns
      ``()`` if successful, or fails if the symbol isn't defined (or defined
      as a different kind of symbol).

   The prelude also provides some functions to retrieve various attributes of
   a function symbol which determine how the operation is applied to its
   operands or arguments. These functions all take a single argument, the
   symbol or function object to be inspected, and return an integer value.

   .. function:: nargs x

      Get the argument count of a function object, i.e., the number of
      arguments it expects. Returns 0 for thunks and saturated applications,
      -1 for over-saturated applications and non-functions.

   .. function:: arity x

      Determine the arity of an operator symbol. The returned value is 0, 1 or
      2 for nullary, unary and binary symbols, respectively, -1 for symbols
      without a fixity declaration or other kinds of objects.

   .. function:: fixity f

      Determine the fixity of an operator symbol. The fixity is encoded as an
      integer ``10*n+m`` where ``n`` is the precedence level (ranging from
      ``0`` to ``PREC_MAX``, where ``PREC_MAX`` denotes the precedence of
      primary expressions, 16777216 in the current implementation) and ``m``
      indicates the actual fixity at each level, in the order of increasing
      precedence (0 = infix, 1 = infixl, 2 = infixr, 3 = prefix, 4 =
      postfix). The fixity value of nonfix and outfix symbols, as well as
      symbols without a fixity declaration, is always given as
      ``10*PREC_MAX``, and the same value is also reported for non-symbol
      objects. Infix, prefix and postfix symbols always have a :func:`fixity`
      value less than ``10*PREC_MAX``. (``PREC_MAX`` isn't actually defined as
      a constant anywhere, but you can easily do that yourself by setting
      ``PREC_MAX`` to the fixity value of any nonfix symbol or non-symbol
      value, e.g.: ``const PREC_MAX = fixity [];``)

   Note that only closures (i.e., named and anonymous functions and thunks)
   have a defined argument count in Pure, otherwise :func:`nargs` returns -1
   indicating an unknown argument count. Partial applications of closures
   return the number of remaining arguments, which may be zero to indicate a
   `saturated` (but unevaluated) application, or -1 for `over-saturated` and
   constructor applications. (Note that in Pure a saturated application may
   also remain unevaluated because there is no definition for the given
   combination of arguments and thus the expression is in normal form, or
   because the application was quoted. If such a normal form application is
   then applied to some "extra" arguments it becomes over-saturated.)

   The value returned by :func:`nargs` always denotes the actual argument
   count of the given function, regardless of the declared arity if the
   function also happens to be an operator symbol. Often these will coincide
   (as, e.g., in the case of :func:`+` which is a binary operator and also
   expects two arguments). But this is not necessarily the case, as shown in
   the following example of a binary operator which actually takes *three*
   arguments::

     > infix 0 oops;
     > (oops) x y z = x*z+y;
     > arity (oops);
     2
     > nargs (oops);
     3
     > nargs (5 oops 8);
     1
     > map (5 oops 8) (1..5);
     [13,18,23,28,33]

   Eval and Friends
   ~~~~~~~~~~~~~~~~

   Pure provides some rather powerful operations to convert between Pure
   expressions and their string representation, and to evaluate quoted
   expressions (``'x``). The string conversions :func:`str`, :func:`val` and
   :func:`eval` also provide a convenient means to serialize Pure expressions,
   e.g., when terms are to be transferred to/from persistent storage. (Note,
   however, that this has its limitations. Specifically, some objects like
   pointers and anonymous functions do not have a parsable string
   representation. Also see the `Expression Serialization`_ section for some
   dedicated serialization operations which provide a more compact binary
   serialization format.)

   .. function:: str x

      Yields the print representation of an expression in Pure syntax, as a
      string.

   .. function:: val /string s

      Parses a single simple expression, specified as a string in Pure syntax,
      and returns the result as is, without evaluating it. Note that this is
      much more limited than the :func:`eval` operation below, as the
      expression must not contain any of the special constructs (conditional
      expressions, :keyword:`when`, :keyword:`with`, etc.), unless they are
      quoted.

   .. function:: eval x

      Parses any expression, specified as a string in Pure syntax, and returns
      its value. In fact, :func:`eval` can also parse and execute arbitrary
      Pure code. In that case it will return the last computed expression, if
      any.  Alternatively, :func:`eval` can also be invoked on a (quoted) Pure
      expression, which is recompiled and then evaluated. Exceptions during
      evaluation are reported back to the caller.

      .. note::

         The use of :func:`eval` and :func:`evalcmd` (as well as
         :func:`add_fundef`, :func:`add_typedef` etc. from the preceding
	 subsection) to modify a running program breaks referential
	 transparency and hence these functions should be used with
	 care. Also, none of the inspection and mutation capabilities provided
	 by these operations will work in batch-compiled programs, please
	 check the :ref:`Batch Compilation` section in the Pure manual for
	 details. Moreover, using these operations to modify or delete a
	 function which is currently being executed results in undefined
	 behaviour.

   .. function:: evalcmd x

      Like :func:`eval`, but allows execution of interactive commands and
      returns their captured output as a string. No other results are
      returned, so this operation is most useful for executing Pure
      definitions and interactive commands for their side-effects. (At this
      time, only the regular output of a few commands can be captured, most
      notably ``bt``, ``clear``, ``mem``, ``save`` and ``show``; otherwise the
      result string will be empty.)

   .. function:: lasterr

      Reports errors in :func:`val`, :func:`eval` and :func:`evalcmd` (as well
      as in :func:`add_fundef` et al, described in the previous subsection).
      This string value will be nonempty iff a compilation or execution error
      was encountered during the most recent invocation of these functions. In
      that case each reported error message is terminated with a newline
      character.

   .. function:: lasterrpos

      Gives more detailed error information. This returns a list of the
      individual error messages in :func:`lasterr`, along with the position of
      each error (if available). Each list item is either just a string (the
      error message, with any trailing newline stripped off) if no error
      position is available, or a tuple of the form ``msg,file,l1,c1,l2,c2``
      where ``msg`` is the error message, ``file`` the name of the file
      containing the error (which will usually be ``"<stdin>"`` indicating
      that the error is in the source string, but may also be a proper
      filename of a module imported in the evaluated code), ``l1,c1`` denotes
      the beginning of the range with the errorneous construct (given as line
      and column indices) and ``l2,c2`` its end (or rather the character
      position following it). For convenience, both line and column indices
      are zero-based, in order to facilitate extraction of the text from the
      actual source string.

      .. note:: The indicated error positions are only approximate, and
         may in many cases span an entire syntactic construct (such as a
	 subexpression or even an entire function definition) containing the
	 error. Also, the end of the range may sometimes point one token past
	 the actual end of the construct. (These limitations are due to
	 technical restrictions in the parser; don't expect them to go away
	 anytime soon.)

   Examples::

     > str (1/3);
     "0.333333333333333"
     > val "1/3";
     1/3
     > eval "1/3";
     0.333333333333333
     > eval ('(1/3));
     0.333333333333333
     > evalcmd "show evalcmd";
     "extern expr* evalcmd(expr*);\n"
     > eval "1/3)";
     eval "1/3)"
     > lasterr;
     "<stdin>, line 1: syntax error, unexpected ')', expecting '=' or '|'\n"
     > lasterrpos;
     [("<stdin>, line 1: syntax error, unexpected ')', expecting '=' or '|'",
     "<stdin>",0,3,0,4)]

   In addition to :func:`str`, the prelude also provides the following
   function for pretty-printing the internal representation used to denote
   quoted specials. This is commonly used in conjunction with the
   :func:`__show__` function, please see the :ref:`Macros` section in the Pure
   manual for details.

   .. function:: __str__ x

      Pretty-prints special expressions.

   Example::

     > __str__ ('__lambda__ [x __type__ int] (x+1));
     "\\x::int -> x+1"

   The :func:`evalcmd` function is commonly used to invoke the ``show`` and
   ``clear`` commands for metaprogramming purposes. The prelude provides the
   following two convenience functions to make this easy:

   .. function:: globsym pat level

      This uses :func:`evalcmd` with the ``show`` command to list all defined
      symbols matching the given glob pattern. A definition level may be
      specified to restrict the context in which the symbol is defined; a
      level of 0 indicates that all symbols are eligible (see the description
      of the ``show`` command in the Pure manual for details). The result is
      the list of all matching (quoted) symbols.

   .. function:: clearsym sym level

      This uses :func:`evalcmd` with the ``clear`` command to delete the
      definition of the given symbol at the given definition level. No glob
      patterns are permitted here.  The ``sym`` argument may either be a
      string or a literal (quoted) symbol.

   Example::

     > let x,y = 77,99;
     > let syms = globsym "[a-z]" 0; syms;
     [x,y]
     > map eval syms;
     [77,99]
     > do (flip clearsym 0) syms;
     ()
     > globsym "[a-z]" 0;
     []
     > x,y;
     x,y

   The following functions are useful for doing symbolic expression
   simplification.

   .. macro:: reduce x

      Reevaluates an expression in a local environment. This dynamically
      rebinds function symbols in the given expression to whatever local
      function definitions are in effect at the point of the :macro:`reduce`
      call. Note that :macro:`reduce` is actually implemented as a macro which
      expands to the :func:`reduce_with` primitive (see below), using the
      :macro:`__locals__` builtin to enumerate the bindings which are in effect
      at the call site.

   .. function:: reduce_with env x

      Like :macro:`reduce` above, but takes a list of replacements (given as
      hash pairs ``u=>v``) as the first argument. The :macro:`reduce` macro
      expands to ``reduce_with __locals__``.

   The :macro:`reduce` macro provides a restricted form of dynamic binding
   which is useful to implement local rewriting rules. It is invoked without
   parameters and expands to the curried call ``reduce_with __locals__`` of
   the :func:`reduce_with` primitive, which takes one additional argument, the
   expression to be rewritten. The following example shows how to expand or
   factorize an expression using local rules for the laws of distributivity::

     expand = reduce with
       (a+b)*c = a*c+b*c;
       a*(b+c) = a*b+a*c;
     end;

     factor = reduce with
       a*c+b*c = (a+b)*c;
       a*b+a*c = a*(b+c);
     end;

     expand ((a+b)*2); // yields a*2+b*2
     factor (a*2+b*2); // yields (a+b)*2

   Note that instances of locally bound functions are substituted back in the
   computed result, thus the instances of ``*`` and ``+`` in the results
   ``a*2+b*2`` and ``(a+b)*2`` shown above denote the corresponding globals,
   not the local incarnations of ``*`` and ``+`` defined in ``expand`` and
   ``factor``, respectively.

   :macro:`reduce` also adjusts to quoted arguments. In this case, the local
   rules are applied as usual, but back-substituted globals are *not*
   evaluated in the result::

     > expand ((a+1)*2);
     a*2+2
     > expand ('((a+1)*2));
     a*2+1*2

   Note that :macro:`reduce` only takes into account local *function* bindings
   from :keyword:`with` clauses, local *variable* bindings do not affect its
   operation in any way::

     > let y = [x,x^2,x^3];
     > reduce y when x = u+v end;
     [x,x^2,x^3]

   However, in such cases you can perform the desired substitution by turning
   the :keyword:`when` into a :keyword:`with` clause::

     > reduce y with x = u+v end;
     [u+v,(u+v)^2,(u+v)^3]

   Or you can just invoke the underlying :func:`reduce_with` builtin directly,
   with the desired substitutions given as hash pairs in the first argument::

     > reduce_with [x=>u+v] y;
     [u+v,(u+v)^2,(u+v)^3]

   Expression Serialization
   ~~~~~~~~~~~~~~~~~~~~~~~~

   Like :func:`str` and :func:`eval`, the following :func:`blob` and
   :func:`val` operations can be used to safely transfer expression data
   to/from persistent storage and between different processes (using, e.g.,
   POSIX shared memory, pipes or sockets). However, :func:`blob` and
   :func:`val` use a binary format which is usually much more compact and gets
   processed much faster than the string representations used by :func:`str`
   and :func:`eval`. Also, :func:`val` offers some additional protection
   against transmission errors through a crc check. (The advantage of the
   string representation, however, is that it's readable plain text in Pure
   syntax.)

   .. function:: blob x

      Stores the contents of the given expression as a binary object. The
      return value is a cooked pointer which frees itself when
      garbage-collected.

   .. function:: val /blob p

      Reconstructs a serialized expression from the result of a previous
      invocation of the :func:`blob` function.

   .. function:: blobp p

      Checks for a valid :func:`blob` object. (Note that :func:`val` may fail
      even if :func:`blobp` returns ``true``, because for performance reasons
      :func:`blobp` only does a quick plausibility check on the header
      information of the blob, whereas :func:`val` also performs a crc check
      and verifies data integrity.)

   .. function:: prefix # /blob p
      		 blob_size p
                 blob_crc p

     Determines the size (in bytes) and crc checksum of a blob, respectively.
     :func:`blob_size` always returns a bigint, :func:`blob_crc` a machine int
     (use :func:`uint` on the latter to get a proper unsigned 32 bit
     value). For convenience, ``#p`` is defined as an alias for ``blob_size
     p`` on :func:`blob` pointers.

   Example::

     > let b = blob {"Hello, world!", 1/3, 4711, NULL};
     > b; #b; uint $ blob_crc b;
     #<pointer 0x141dca0>
     148L
     3249898239L
     > val b;
     {"Hello, world!",0.333333333333333,4711,#<pointer 0>}

   Please note that the current implementation has some limitations:

   * Just as with :func:`str` and :func:`eval`, runtime data (local closures
     and pointers other than the :const:`NULL` pointer) can't be serialized,
     causing :func:`blob` to fail. However, it *is* possible to transfer a
     global function, provided that the function exists (and is the same) in
     both the sending and the receiving process. (This condition can't be
     verified by :func:`val` and thus is at the programmer's responsibilty.)

   * Sharing of subexpressions will in general be preserved, but sharing of
     list and tuple *tails* will be lost (unless the entire list or tuple is
     shared).

   * The :func:`val` function may fail to reconstruct the serialized
     expression even for valid blobs, if there is a conflict in symbol
     fixities between the symbol tables of the sending and the receiving
     process. To avoid this, make sure that symbol declarations in the sending
     and the receiving script match up.

   Other Special Primitives
   ~~~~~~~~~~~~~~~~~~~~~~~~

   .. function:: exit status

      Terminate the program with the given status code.

   .. function:: throw x

      Throw an exception, cf. :ref:`Exception Handling`.

   .. function:: force x

      Force a thunk (``x&``), cf. :ref:`Special Forms`. This usually happens
      automagically when the value of a thunk is needed.

*/

/* eval and friends. */

extern expr* lastres() = ans;
extern expr* eval(expr*); // IMPURE!
extern expr* evalcmd(expr*); // IMPURE!
extern char* lasterr();
extern expr* lasterrpos();

extern char* str(expr*);
extern expr* __str__(expr*);

extern expr *reduce(expr *locals, expr *x) = reduce_with;
public __locals__ __func__ __namespace__; // builtins
def reduce = reduce_with __locals__;

extern expr *get_fundef(expr *f);
extern expr *get_typedef(expr *f);
extern expr *get_interface(expr *f);
extern expr *get_interface_typedef(expr *f);
extern expr *get_macdef(expr *f);
extern expr *get_vardef(expr *f);
extern expr *get_constdef(expr *f);

extern expr *add_fundef(expr *x);
extern expr *add_typedef(expr *x);
extern expr *add_interface(expr *f, expr *x);
extern expr *add_macdef(expr *x);
extern expr *add_fundef_at(expr *x, expr *y);
extern expr *add_typedef_at(expr *x, expr *y);
extern expr *add_interface_at(expr *f, expr *x, expr *y);
extern expr *add_macdef_at(expr *x, expr *y);
extern expr *add_vardef(expr *x);
extern expr *add_constdef(expr *x);

extern expr *del_fundef(expr *x);
extern expr *del_typedef(expr *x);
extern expr *del_interface(expr *f, expr *x);
extern expr *del_macdef(expr *x);
extern expr *del_vardef(expr *x);
extern expr *del_constdef(expr *x);

/* Expression serialization. */

extern expr* blob(expr*);
extern expr* val(expr*);
extern bool blobp(expr*);
extern expr* blob_size(expr*);
extern expr* blob_crc(expr*);

blobp _ = false;
#p::pointer = blob_size p if blobp p;

/* Other specials. */

extern void pure_throw(expr*) = throw; // IMPURE!
extern expr* pure_force(expr*) = force;

/* Note that this one should actually be in system.pure, but we want to have
   it in the prelude so that programs can bail out without having to import
   the system module. */

extern void exit(int status);

/* Syntactic equality. */

extern bool same(expr* x, expr* y);
x === y		= same x y;
x ~== y		= ~same x y;

/* Generic type checking predicate. */

extern expr *typep(expr *ty, expr *x);

/* Predicates to check for the built-in types. */

intp x		= case x of _::int     = 1; _ = 0 end;
bigintp x	= case x of _::bigint  = 1; _ = 0 end;
doublep x	= case x of _::double  = 1; _ = 0 end;
stringp x	= case x of _::string  = 1; _ = 0 end;
pointerp x	= case x of _::pointer = 1; _ = 0 end;
matrixp x	= case x of _::matrix  = 1; _ = 0 end;

/* Additional single character type and predicate. Note that this
   implementation is in general *much* faster than the naive solution
   'stringp x && #x==1', because it's guaranteed to run in constant time. */

public ord; // this comes from strings.pure
type char x::string = intp (ord x);

charp x		= typep ('char) x;

/* Additional number types and predicates. */

type integer _::int | integer _::bigint;
type rational (x::integer%y::integer);
type real x::integer | real x::double | real (x::real%y::real);
type complex (x::real+:y::real) | complex (x::real<:y::real);
type number x::real | number x::complex;

integerp x	= typep ('integer) x;
rationalp x	= typep ('rational) x;
realp x		= typep ('real) x;
complexp x	= typep ('complex) x;
numberp x	= typep ('number) x;

/* Check whether a number is exact (i.e., doesn't contain any double
   components. */

exactp x	= case x of
		    x+:y = ~doublep x && ~doublep y;
		    x<:y = ~doublep x && ~doublep y;
		    x%y  = ~doublep x && ~doublep y;
		    _ = ~doublep x;
		  end if numberp x;
inexactp x      = case x of
		    x+:y = doublep x || doublep y;
		    x<:y = doublep x || doublep y;
		    x%y  = doublep x || doublep y;
		    _ = doublep x;
		  end if numberp x;

/* Predicates to check for various kinds of function objects. */

extern bool funp(expr*), bool lambdap(expr*), bool thunkp(expr*);
closurep x = funp x || lambdap x;

/* Convenience types for the above. */

type fun = funp;
type lambda = lambdap;
type thunk = thunkp;
type closure = closurep;

/* Predicates and convenience types to check for various kinds of symbols. */

extern bool symbolp(expr*);
extern bool varp(expr*);

type symbol = symbolp;
type var = varp;

/* Get the argument count of a function object, i.e., the number of arguments
   it expects. Returns 0 for thunks and saturated applications, -1 for
   over-saturated applications and non-functions. */

extern int nargs(expr *x);

/* Determine the arity and fixity of an operator symbol. arity is 0, 1 or 2
   for nullary, unary and binary symbols, respectively, -1 for symbols without
   a fixity declaration or other kinds of objects. fixity is encoded as a
   2-digit number 10n+m where n is the precedence level (ranging from 0 to 10,
   10 denotes the precedence of primary expressions) and m indicates the
   actual fixity in order of increasing precedence (0 = infix, 1 = infixl, 2 =
   infixr, 3 = prefix, 4 = postfix). For non-symbol objects, fixity is always
   100. */

extern int arity(expr *x);
extern int fixity(expr *x);

/* Convenience function and type to check for any "callable"; this also
   includes unsaturated (partial) applications of closures. */

functionp x = nargs x>0 with
  nargs (x@_ _) = nargs x-1;
  nargs x = ::nargs x otherwise;
end;

type function = functionp;

/* Types and predicates to check for function applications, lists and
   tuples. */

type appl (_ _);
type list []  | list (_:_);
type tuple () | tuple (_,_);

applp x		= typep ('appl) x;
listp x		= typep ('list) x;
tuplep x	= typep ('tuple) x;

/* Recursive a.k.a. proper lists. Make sure that the rules are in the given
   order so that the definition is tail-recursive. */

type rlist [] | rlist (_:_::rlist);

rlistp x	= typep ('rlist) x;

/* Compute a 32 bit hash code of a Pure expression. */

extern int hash(expr*);

/* Conversions between the different numeric types. */

namespace __C;
extern expr* pure_intval(expr*), expr* pure_dblval(expr*),
  expr* pure_bigintval(expr*), expr* pure_pointerval(expr*);
namespace;

int x::int		= x;
int x::bigint		|
int x::double		= pure_intval x;

bigint x::bigint	= x;
bigint x::int		|
bigint x::double	= pure_bigintval x;

double x::double	= x;
double x::int		|
double x::bigint	= pure_dblval x;

/* Pointer conversions. */

pointer x::pointer	= x;
pointer x::int		|
pointer x::bigint	|
pointer x::string	= pure_pointerval x;

namespace __C;
extern void *pure_pointer_equal(int);
namespace;
extern int pure_get_tag(expr*) = get_ptrtag;

const NULL = pointer 0; // the null pointer
// As of Pure 0.49, this predicate may be overridden by tagged pointer types.
null x::pointer = x===NULL if pure_pointer_equal (get_ptrtag x) === NULL;

/* Convert signed (8/16/32/64) bit integers to the corresponding unsigned
   quantities. */

ubyte x::int		= if x>=0 then x else x+0x100;
ushort x::int		= if x>=0 then x else x+0x10000;
uint x::int		= if x>=0 then bigint x else x+0x100000000L;
uint64 x::int		|
uint64 x::bigint	= if x>=0 then bigint x else x+0x10000000000000000L;
ulong			= if SIZEOF_LONG==4 then uint else uint64;

/* Rounding functions. */

extern double floor(double), double ceil(double);
extern double __round(double) = round, double __trunc(double) = trunc;

floor x::int | floor x::bigint = x;
ceil x::int | ceil x::bigint = x;
round x::int | round x::bigint = x;
trunc x::int | trunc x::bigint = x;

// Fractional part of x.
frac x::int | frac x::bigint | frac x::double = x-trunc x;

/* Absolute value and sign of a number. Note that these don't distinguish
   between IEEE 754 positive and negative zeros; abs always returns 0.0, sgn 0
   for these. The real sign bit of a floating point zero can be obtained with
   sgn (1/x). */

abs x::int | abs x::bigint | abs x::double
			= if x>0 then x else -x;
sgn x::int | sgn x::bigint | sgn x::double
			= if x>0 then 1 else if x<0 then -1 else 0;

/* Generic min and max functions. */

min x y			= if x<=y then x else y;
max x y			= if x>=y then x else y;

/* Generic succ and pred functions. */

succ x			= x+1;
pred x			= x-1;

/* Basic int and double arithmetic. The Pure compiler already knows how to
   handle these, we just need to supply rules with the right type tags. */

-x::int			= -x;
~x::int			= ~x;
not x::int		= not x;

x::int<<y::int		= x<<y;
x::int>>y::int		= x>>y;

x::int+y::int		= x+y;
x::int-y::int		= x-y;
x::int*y::int		= x*y;
x::int/y::int		= x/y;
x::int div y::int	= x div y;
x::int mod y::int	= x mod y;
x::int or y::int	= x or y;
x::int and y::int	= x and y;

x::int<y::int		= x<y;
x::int>y::int		= x>y;
x::int<=y::int		= x<=y;
x::int>=y::int		= x>=y;
x::int==y::int		= x==y;
x::int~=y::int		= x~=y;

-x::double		= -x;

x::double+y::double	= x+y;
x::double-y::double	= x-y;
x::double*y::double	= x*y;
x::double/y::double	= x/y;

x::double<y::double	= x<y;
x::double>y::double	= x>y;
x::double<=y::double	= x<=y;
x::double>=y::double	= x>=y;
x::double==y::double	= x==y;
x::double~=y::double	= x~=y;

// mixed operands

x::int+y::double	= x+y;
x::int-y::double	= x-y;
x::int*y::double	= x*y;
x::int/y::double	= x/y;

x::int<y::double	= x<y;
x::int>y::double	= x>y;
x::int<=y::double	= x<=y;
x::int>=y::double	= x>=y;
x::int==y::double	= x==y;
x::int~=y::double	= x~=y;

x::double+y::int	= x+y;
x::double-y::int	= x-y;
x::double*y::int	= x*y;
x::double/y::int	= x/y;

x::double<y::int	= x<y;
x::double>y::int	= x>y;
x::double<=y::int	= x<=y;
x::double>=y::int	= x>=y;
x::double==y::int	= x==y;
x::double~=y::int	= x~=y;

/* Built-in special forms. Please note that these enjoy call-by-name and
   short-circuit evaluation only as explicit calls! But we still want them to
   work if they are applied partially, so we add these rules here. */

x::int&&y		= x&&y;
x::int||y		= x||y;
x$$y			= y;
x&			= x;
'x			= x;
quote x			= x;

/* Bigint arithmetic. */

namespace __C;
extern expr* bigint_neg(void*);
extern expr* bigint_not(void*);
extern expr* bigint_add(void*, void*);
extern expr* bigint_sub(void*, void*);
extern expr* bigint_mul(void*, void*);
extern expr* bigint_div(void*, void*);
extern expr* bigint_mod(void*, void*);
extern expr* bigint_shl(void*, int);
extern expr* bigint_shr(void*, int);
extern expr* bigint_and(void*, void*);
extern expr* bigint_or(void*, void*);
extern int bigint_cmp(void*, void*);
namespace;

-x::bigint		= bigint_neg x;
not x::bigint		= bigint_not x;

x::bigint<<y::int	= bigint_shl x y if y>=0;
			= bigint_shr x (-y);
x::bigint>>y::int	= bigint_shr x y if y>=0;
			= bigint_shl x (-y);

x::bigint+y::bigint	= bigint_add x y;
x::bigint-y::bigint	= bigint_sub x y;
x::bigint*y::bigint	= bigint_mul x y;
x::bigint/y::bigint	= double x / double y;
x::bigint div y::bigint	= bigint_div x y;
x::bigint mod y::bigint	= bigint_mod x y;
x::bigint or y::bigint	= bigint_or x y;
x::bigint and y::bigint	= bigint_and x y;

x::bigint<y::bigint	= bigint_cmp x y < 0;
x::bigint>y::bigint	= bigint_cmp x y > 0;
x::bigint<=y::bigint	= bigint_cmp x y <= 0;
x::bigint>=y::bigint	= bigint_cmp x y >= 0;
x::bigint==y::bigint	= bigint_cmp x y == 0;
x::bigint~=y::bigint	= bigint_cmp x y ~= 0;

// mixed int/bigint (promote int to bigint)

x::int+y::bigint	= bigint x+y;
x::int-y::bigint	= bigint x-y;
x::int*y::bigint	= bigint x*y;
x::int/y::bigint	= double x/y;
x::int div y::bigint	= bigint x div y;
x::int mod y::bigint	= bigint x mod y;
x::int or y::bigint	= bigint x or y;
x::int and y::bigint	= bigint x and y;

x::int<y::bigint	= bigint x<y;
x::int>y::bigint	= bigint x>y;
x::int<=y::bigint	= bigint x<=y;
x::int>=y::bigint	= bigint x>=y;
x::int==y::bigint	= bigint x==y;
x::int~=y::bigint	= bigint x~=y;

x::bigint+y::int	= x+bigint y;
x::bigint-y::int	= x-bigint y;
x::bigint*y::int	= x*bigint y;
x::bigint/y::int	= x/double y;
x::bigint div y::int	= x div bigint y;
x::bigint mod y::int	= x mod bigint y;
x::bigint or y::int	= x or bigint y;
x::bigint and y::int	= x and bigint y;

x::bigint<y::int	= x<bigint y;
x::bigint>y::int	= x>bigint y;
x::bigint<=y::int	= x<=bigint y;
x::bigint>=y::int	= x>=bigint y;
x::bigint==y::int	= x==bigint y;
x::bigint~=y::int	= x~=bigint y;

// mixed double/bigint (promote bigint to double)

x::bigint+y::double	= double x+y;
x::bigint-y::double	= double x-y;
x::bigint*y::double	= double x*y;
x::bigint/y::double	= double x/y;

x::bigint<y::double	= double x<y;
x::bigint>y::double	= double x>y;
x::bigint<=y::double	= double x<=y;
x::bigint>=y::double	= double x>=y;
x::bigint==y::double	= double x==y;
x::bigint~=y::double	= double x~=y;

x::double+y::bigint	= x+double y;
x::double-y::bigint	= x-double y;
x::double*y::bigint	= x*double y;
x::double/y::bigint	= x/double y;

x::double<y::bigint	= x<double y;
x::double>y::bigint	= x>double y;
x::double<=y::bigint	= x<=double y;
x::double>=y::bigint	= x>=double y;
x::double==y::bigint	= x==double y;
x::double~=y::bigint	= x~=double y;

/* The gcd and lcm functions from the GMP library. These return a bigint if at
   least one of the arguments is a bigint, a machine int otherwise. */

namespace __C;
extern expr* bigint_gcd(void*, void*);
extern expr* bigint_lcm(void*, void*);
namespace;

gcd x::bigint y::bigint	= bigint_gcd x y;
lcm x::bigint y::bigint	= bigint_lcm x y;

gcd x::int y::bigint	= bigint_gcd (bigint x) y;
gcd x::bigint y::int	= bigint_gcd x (bigint y);
gcd x::int y::int	= int (bigint_gcd (bigint x) (bigint y));

lcm x::int y::bigint	= bigint_lcm (bigint x) y;
lcm x::bigint y::int	= bigint_lcm x (bigint y);
lcm x::int y::int	= int (bigint_lcm (bigint x) (bigint y));

/* The pow function. Computes exact powers of ints and bigints. The result is
   always a bigint. Note that y must always be nonnegative here, but see
   math.pure which deals with the case y<0 using rational numbers. */

namespace __C;
extern expr* bigint_pow(void*, int);
namespace;

pow x::int y::int	= bigint_pow (bigint x) y if y>=0;
pow x::bigint y::bigint	= bigint_pow x y if y>=0;

// mixed int/bigint
pow x::int y::bigint	= bigint_pow (bigint x) y if y>=0;
pow x::bigint y::int	= bigint_pow x y if y>=0;

/* The ^ operator. Computes inexact powers for any combination of int, bigint
   and double operands. The result is always a double. */

namespace __C;
extern double pow(double, double);
namespace;

// These two rules are needed to get proper results on some systems where the
// math library apparently isn't 100% POSIX-compatible.
public infp;
1.0^y::double		= 1.0;
(-1.0)^y::double	= 1.0 if infp y;

x::double^y::double	= __C::pow x y;
x::int^y::int		|
x::bigint^y::bigint	|
x::int^y::bigint	|
x::bigint^y::int	= (double x)^(double y);
x::double^y::int	|
x::double^y::bigint	= x^(double y);
x::int^y::double	|
x::bigint^y::double	= (double x)^y;

/* IEEE floating point infinities and NaNs. Place these after the definitions
   of the built-in operators so that the double arithmetic works. */

const inf = 1.0e307 * 1.0e307; const nan = inf-inf;

/* Generic predicates to check for inf and nan values. These should work for
   any kind of real type, as long as it supports conversion to double. */

infp x = case x of
  x::double = x==inf || x==-inf;
  x::int | x::bigint = 0;
  x::real = case double x of x::double = infp x; _ = 0 end;
  _ = 0;
end;

nanp x = case x of
  x::double = ~(x==x);
  x::int | x::bigint = 0;
  x::real = case double x of x::double = nanp x; _ = 0 end;
  _ = 0;
end;

/* Some common special cases of finite arithmetic sequences are implemented
   here using the runtime for better performance. */

namespace __C;
extern expr* pure_int_seq(int from, int to, int step);
extern expr* pure_double_seq(double from, double to, double step);
namespace;

n::int..m::int		= __C::pure_int_seq n m 1;
n1::int:n2::int..m::int	= __C::pure_int_seq n1 m (n2-n1) if n1~=n2;

n::double..m::double	= __C::pure_double_seq n m 1.0 if ~infp n && ~infp m;
n::int..m::double	= __C::pure_double_seq (double n) m 1.0 if ~infp m;
n::double..m::int	= __C::pure_double_seq n (double m) 1.0 if ~infp n;

n1::double:n2::double..m::double
			= __C::pure_double_seq n1 m (n2-n1)
			    if ~infp n1 && ~infp m && n1~=n2;
n1::int:n2::double..m::double
			= __C::pure_double_seq (double n1) m (n2-n1)
			    if ~infp m && n1~=n2;
n1::double:n2::int..m::double
			= __C::pure_double_seq n1 m (n2-n1)
			    if ~infp n1 && ~infp m && n1~=n2;
n1::double:n2::double..m::int
			= __C::pure_double_seq n1 (double m) (n2-n1)
			    if ~infp n1 && n1~=n2;
n1::int:n2::int..m::double
			= __C::pure_double_seq (double n1) m (double (n2-n1))
			    if ~infp m && n1~=n2;
n1::int:n2::double..m::int
			= __C::pure_double_seq (double n1) (double m) (n2-n1)
			    if n1~=n2;
n1::double:n2::int..m::int
			= __C::pure_double_seq n1 (double m) (n2-n1)
			    if ~infp n1 && n1~=n2;

/* Interface to the C qsort() function. */

extern expr* pure_sort(expr* p, expr *xs) = sort;

/* ..

   Pointer Operations
   ~~~~~~~~~~~~~~~~~~

   The prelude provides a few basic operations on pointers which make it easy
   to interface to external C functions. For more advanced uses, the library
   also includes the :mod:`pointers` module which can be imported explicitly
   if needed, see `Pointer Arithmetic`_ below.

   .. function:: addr symbol

      Get the address of a C symbol (given as a string) at runtime. The
      library containing the symbol must already be loaded. Note that this can
      in fact be any kind of externally visible C symbol, so it's also
      possible to get the addresses of global variables. The result is
      returned as a pointer. The function fails if the symbol was not
      found. */

extern expr *pure_addr(char *s) = addr;

/* .. function:: calloc nmembers size
                 malloc size
                 realloc ptr size
                 free ptr

      Interface to ``malloc``, ``free`` and friends. These let you allocate
      dynamic buffers (represented as Pure pointer values) for various
      purposes. */

extern void* calloc(size_t nmembers, size_t size);
extern void* malloc(size_t size), void* realloc(void* ptr, size_t size);
extern void free(void* ptr);

/* ..

   The following functions perform direct memory accesses through pointers.
   Their primary use is to interface to certain C library functions which take
   or return data through pointers. It goes without saying that these
   operations should be used with utmost care. No checking is done on the
   pointer types, so it is the programmer's responsibility to ensure that the
   pointers actually refer to the corresponding type of data.

   .. function:: get_byte ptr
                 get_short ptr
                 get_int ptr
                 get_int64 ptr
                 get_long ptr
                 get_float ptr
                 get_double ptr
                 get_string ptr
                 get_pointer ptr

      Return the integer, floating point, string or generic pointer value at
      the memory location indicated by ``ptr``.

   .. function:: put_byte ptr x
                 put_short ptr x
                 put_int ptr x
                 put_int64 ptr x
                 put_long ptr x
                 put_float ptr x
                 put_double ptr x
                 put_string ptr x
                 put_pointer ptr x

      Change the integer, floating point, string or generic pointer value at
      the memory location indicated by ``ptr`` to the given value ``x``. */

namespace __C;
extern int pointer_get_byte(void *ptr);
extern int pointer_get_short(void *ptr);
extern int pointer_get_int(void *ptr);
extern long pointer_get_long(void *ptr);
extern int64 pointer_get_int64(void *ptr);
extern double pointer_get_float(void *ptr);
extern double pointer_get_double(void *ptr);
extern char *pointer_get_string(void *ptr);
extern void *pointer_get_pointer(void *ptr);
namespace;

get_byte x::pointer = pointer_get_byte x;
get_short x::pointer = pointer_get_short x;
get_int x::pointer = pointer_get_int x;
get_long x::pointer = pointer_get_long x;
get_int64 x::pointer = pointer_get_int64 x;
get_float x::pointer = pointer_get_float x;
get_double x::pointer = pointer_get_double x;
get_string x::pointer = pointer_get_string x;
get_pointer x::pointer = pointer_get_pointer x;

namespace __C;
extern void pointer_put_byte(void *ptr, int x); // IMPURE!
extern void pointer_put_short(void *ptr, int x); // IMPURE!
extern void pointer_put_int(void *ptr, int x); // IMPURE!
extern void pointer_put_long(void *ptr, long x); // IMPURE!
extern void pointer_put_int64(void *ptr, int64 x); // IMPURE!
extern void pointer_put_float(void *ptr, double x); // IMPURE!
extern void pointer_put_double(void *ptr, double x); // IMPURE!
extern void pointer_put_string(void *ptr, char *x); // IMPURE!
extern void pointer_put_pointer(void *ptr, void *x); // IMPURE!
namespace;

put_byte x::pointer y::int = pointer_put_byte x y;
put_short x::pointer y::int = pointer_put_short x y;
put_int x::pointer y::int = pointer_put_int x y;
put_long x::pointer y::int = pointer_put_long x y;
put_long x::pointer y::bigint = pointer_put_long x y;
put_int64 x::pointer y::int = pointer_put_int64 x y;
put_int64 x::pointer y::bigint = pointer_put_int64 x y;
put_float x::pointer y::double = pointer_put_float x y;
put_double x::pointer y::double = pointer_put_double x y;
put_string x::pointer y::string = pointer_put_string x y;
put_pointer x::pointer y::string = pointer_put_pointer x y;
put_pointer x::pointer y::pointer = pointer_put_pointer x y;

/* ..

   Sentries
   ~~~~~~~~

   Sentries are Pure's flavour of object `finalizers`. A sentry is simply an
   object (usually a function) which gets applied to the target expression
   when it is garbage-collected. This is useful to perform automatic cleanup
   actions on objects with internal state, such as files. Pure's sentries are
   *much* more useful than finalizers in other garbage-collected languages,
   since it is guaranteed that they are called as soon as an object "goes out
   of scope", i.e., becomes inaccessible.

   .. function:: sentry f x

      Places a sentry ``f`` at an expression ``x`` and returns the modified
      expression.

   .. function:: clear_sentry x

      Removes the sentry from an expression ``x``.

   .. function:: get_sentry x

      Returns the sentry of an expression ``x`` (if any, fails otherwise).

   As of Pure 0.45, sentries can be placed on any Pure expression. The sentry
   itself can also be any type of object (but usually it's a function).
   Example::

     > using system;
     > sentry (\_->puts "I'm done for!") (1..3);
     [1,2,3]
     > clear ans
     I'm done for!

   Note that setting a finalizer on a global symbol won't usually be of much
   use since such values are cached by the interpreter. (However, the sentry
   *will* be invoked if the symbol gets recompiled because its definition has
   changed. This may be useful for some purposes.)

   In Pure parlance, we call an expression `cooked` if a sentry has been
   attached to it. The following predicate can be used to check for this
   condition. Also, there is a convenience function to create cooked pointers
   which take care of freeing themselves when they are no longer needed.

   .. function:: cookedp x

      Check whether a given object has a sentry set on it.

   .. function:: cooked ptr

      Create a pointer which disposes itself after use. This is just a
      shorthand for ``sentry free``. The given pointer ``ptr`` must be
      :func:`malloc`\ ed to make this work.

   Example::

     > using system;
     > let p = cooked (malloc 1024);
     > cookedp p;
     1
     > get_sentry p;
     free
     > clear p

   Besides their use as finalizers, sentries can also be handy in other
   circumstances, when you need to associate an expression with another,
   "invisible" value. In this case the sentry is usually some kind of data
   structure instead of a function to be executed at finalization time. For
   instance, here's how we can employ sentries to implement hashing of
   function values::

     using dict;
     hashed f x = case get_sentry f of
                    h::hdict = h!x if member h x;
                    _ = y when y = f x; sentry (update h x y) f
                            when h = case get_sentry f of
                                       h::hdict = h; _ = emptyhdict
                                     end;
                            end;
                          end;
                  end;

   E.g., consider the naive recursive definition of the Fibonacci function::

     fib n::int = if n<=1 then 1 else fib (n-1)+fib (n-2);

   A hashed version of the Fibonacci function can be defined as follows::

     let hfib = hashed f with
       f n::int = if n<=1 then 1 else hfib (n-1)+hfib (n-2)
     end;

   This turns the naive definition of the Fibonacci function (which has
   exponential time complexity) into a linear time operation::

     > stats
     > fib 35;
     14930352
     4.53s
     > hfib 35;
     14930352
     0.25s

   Finally, note that there can be only one sentry per expression but,
   building on the operations provided here, it's easy to design a scheme
   where sentries are chained. For instance::

     chain_sentry f x = sentry (h (get_sentry x)) x with
       h g x = g x $$ f x;
     end;

   This invokes the original sentry before the chained one::

     > using system;
     > f _ = puts "sentry#1"; g _ = puts "sentry#2";
     > let p = chain_sentry g $ sentry f $ malloc 10;
     > clear p
     sentry#1
     sentry#2

   You can chain any number of sentries that way. This scheme should work in
   most cases in which sentries are used just as finalizers. However, there
   are other uses, like the "hashed function" example above, where you'd like
   the original sentry to stay intact. This can be achieved by placing the new
   sentry as a sentry on the *original sentry* rather than the expression
   itself::

     attach_sentry f x = sentry (sentry f (get_sentry x)) x;

   This requires that the sentry will actually be garbage-collected when its
   hosting expression gets freed, so it will *not* work if the original sentry
   is a global::

     > let p = attach_sentry g $ sentry f $ malloc 10;
     > clear p
     sentry#1

   However, the attached sentry will work ok if you can ensure that the
   original sentry is a (partial or constructor) application. E.g.::

     > let p = attach_sentry g $ sentry (f$) $ malloc 10;
     > clear p
     sentry#1
     sentry#2

*/

extern expr* pure_sentry(expr*,expr*) = sentry; // IMPURE!
extern expr* pure_clear_sentry(expr*) = clear_sentry; // IMPURE!
extern expr* pure_get_sentry(expr*) = get_sentry;
extern bool  pure_has_sentry(expr*) = cookedp;

cooked p::pointer = sentry free p;

/* Tagged pointers (experimental). This was added in Pure 0.45. */

/* .. _Tagged Pointers:

   Tagged Pointers
   ~~~~~~~~~~~~~~~

   As of Pure 0.45, the C interface now fully checks pointer parameter types
   at runtime (see the :ref:`C Types` section in the Pure Manual for details).
   To these ends, pointer values are internally tagged to keep track of the
   pointer types. The operations described in this section give you access to
   these tags in Pure programs. At the lowest level, a pointer tag is simply a
   machine int associated with a pointer value. The default tag is 0, which
   denotes a generic pointer value, i.e., ``void*`` in C. The following
   operations are provided to create such tags, and set, get or verify the tag
   of a pointer value.

   .. function:: ptrtag t x

      Places an integer tag ``t`` at an expression ``x`` and returns the
      modified expression. ``x`` must be a pointer value.

   .. function:: get_ptrtag x

      Retrieves the tag associated with ``x``.

   .. function:: check_ptrtag t x

      Compares the tag associated with ``x`` against ``t`` and returns true
      iff the tags match. If ``x`` is a pointer value, this is equivalent to
      ``get_ptrtag x==t || null x && get_ptrtag x==0``.

   .. function:: make_ptrtag

      Returns a new, unique tag each time it is invoked.

   Examples::

     > let p = malloc 10;
     > get_ptrtag p; // zero by default
     0
     > let t = make_ptrtag; t;
     12
     > ptrtag t p;
     #<pointer 0xc42da0>
     > get_ptrtag p;
     12
     > check_ptrtag t p;
     1
     > check_ptrtag 0 p;
     0

   Note that in the case of a non-:const:`NULL` pointer, :func:`check_ptrtag`
   just tests the tags for equality. On the other hand, a generic
   :const:`NULL` pointer, like in C, is considered compatible with all pointer
   types::

     > let t1 = make_ptrtag; t1;
     13
     > check_ptrtag t1 p;
     0
     > check_ptrtag t1 NULL;
     1
     > get_ptrtag NULL;
     0

*/

extern expr *pure_tag(int, expr*) = ptrtag; // IMPURE!
extern int pure_get_tag(expr*) = get_ptrtag;
extern bool pure_check_tag(int, expr*) = check_ptrtag;
extern int pure_make_tag() = make_ptrtag; // IMPURE!

/* ..

   The operations above are provided so that you can design your own, more
   elaborate type systems for pointer values if the need arises. However,
   you'll rarely have to deal with pointer tags at this level yourself. For
   most applications, it's enough to inspect the type of a Pure pointer and
   maybe modify it by "casting" it to a new target type. The following
   high-level operations provide these capabilities.

   .. function:: pointer_tag ty
      		 pointer_tag x

      Returns the pointer tag for the given type ``ty``, denoted as a string,
      or the given pointer value ``x``. In the former case, the type should be
      specified in the C-like syntax used in :keyword:`extern` declarations; a
      new tag will be created using :func:`make_ptrtag` if needed. In the
      latter case, :func:`pointer_tag` simply acts as a frontend for
      :func:`get_ptrtag` above.

   .. function:: pointer_type tag
      		 pointer_type x

      Returns the type name associated with the given int value ``tag`` or
      pointer value ``x``. Please note that this may be :const:`NULL` in the
      case of an "anonymous" tag, which may have been created with
      :func:`make_ptrtag` above, or if the tag is simply unknown because it
      hasn't been created yet.

   .. function:: pointer_cast tag x
      		 pointer_cast ty x

      Casts ``x`` (which must be a pointer value) to the given pointer type,
      which may be specified either as a tag or a string denoting the type
      name. This returns a new pointer value with the appropriate type tag on
      it (the tag on the original pointer value ``x`` isn't affected by this
      operation).

   Example::

     > let p = malloc 10;
     > let q = pointer_cast "char*" p;
     > map pointer_type [p,q];
     ["void*","char*"]
     > map pointer_tag [p,q];
     [0,1]
     > map pointer_type (0..make_ptrtag-1);
     ["void*","char*","void**","char**","short*","short**","int*","int**",
     "float*","float**","double*","double**"]

   (The last command shows a quick and dirty way to retrieve the currently
   defined type tags in the interpreter. This won't work in batch-compiled
   scripts, however, since in this case the range of type tags is in general
   non-contiguous.)

   If you have to do many casts to a given type, you can avoid the overhead of
   repeatedly looking up the type name by assigning the tag to a variable,
   which can then be passed to :func:`pointer_cast` instead::

     > let ty = pointer_tag "long*";
     > pointer_cast ty p, pointer_cast ty q;

   Note that you have to be careful when casting a cooked pointer, because
   :func:`pointer_cast` may have to create a copy of the original pointer
   value in order not to clobber the original type tag. The sentry will then
   still be with the original cooked pointer value, thus you have to ensure
   that this value survives its type-cast duplicate. It's usually best to
   apply the cast right at the spot where the pointer gets passed to an
   external function, e.g.::

     > extern char *gets(char*);
     > let p = cooked $ malloc 1000;
     > gets (pointer_cast "char*" p);

   Such usage is always safe. If this approach isn't possible, you might want
   to use the lowlevel :func:`ptrtag` operation instead. (This will clobber
   the type tag of the pointer, but you can always change it back afterwards.)

*/

namespace __C;
extern int pure_pointer_tag(char *ty);
namespace;
extern char *pure_pointer_type(int tag) = pointer_type;
extern expr *pure_pointer_cast(int tag, expr *x) = pointer_cast;

pointer_tag x::string = __C::pure_pointer_tag x;
pointer_tag x::pointer = get_ptrtag x;
pointer_type x::pointer = pointer_type (get_ptrtag x);
pointer_cast ty::string x::pointer = pointer_cast (pointer_tag ty) x;

/* Some common pointer types. For efficiency, we cache these here so that they
   can be used throughout the library. */

namespace __C;
const voidp_t    = pointer_tag "void*";
const voidpp_t   = pointer_tag "void**";
const charp_t    = pointer_tag "char*";
const charpp_t   = pointer_tag "char**";
const shortp_t   = pointer_tag "short*";
const shortpp_t  = pointer_tag "short**";
const intp_t     = pointer_tag "int*";
const intpp_t    = pointer_tag "int**";
const floatp_t   = pointer_tag "float*";
const floatpp_t  = pointer_tag "float**";
const doublep_t  = pointer_tag "double*";
const doublepp_t = pointer_tag "double**";
namespace;

/* .. _Expression References:

   Expression References
   ~~~~~~~~~~~~~~~~~~~~~

   Expression references provide a kind of mutable data cells which can hold
   any Pure expression. If you need these, then you're doomed. ;-) However,
   they can be useful as a last resort when you need to keep track of some
   local state or interface to the messy imperative world. Pure's references
   are actually implemented as expression pointers so that you can readily
   pass them as pointers to a C function which expects a ``pure_expr**``
   parameter. This may even be useful at times.

   .. function:: ref x

      Create a reference pointing to ``x`` initially.

   .. function:: put r x

      Set a new value ``x``, and return that value.

   .. function:: get r

      Retrieve the current value ``r`` points to.

   .. function:: unref r

      Purge the referenced object and turn the reference into a dangling
      pointer. (This is used as a sentry on reference objects and shouldn't
      normally be called directly.)

   .. function:: refp x

      Predicate to check for reference values.

   Note that manually removing the :func:`unref` sentry of a reference turns
   the reference into just a normal pointer object and renders it unusable as
   a reference. Doing this will also leak memory, so don't! */

namespace __C;
extern expr* pure_new(expr*), expr* pure_expr_pointer();
extern void pure_free(expr*);
extern expr* pointer_get_expr(void*), void pointer_put_expr(void*, expr*);
namespace;

public ref unref refp;

ref x = pointer_put_expr r (pure_new x) $$
	sentry unref r when r::pointer = pure_expr_pointer end;

unref r::pointer = pure_free (pointer_get_expr r) $$
		   clear_sentry r if refp r;

put r::pointer x = pure_free (pointer_get_expr r) $$
		   pointer_put_expr r (pure_new x) $$ x if refp r;

get r::pointer = pointer_get_expr r if refp r;

refp r = case r of _::pointer = get_sentry r===unref; _ = 0 end;
