/*
  Matlab-interface
  Copyright (c) 2002 Sebastian Seidel

  This 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 2.1 of the License, or (at your option) any later version.

  This library 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 library; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  
  Contact me by mail: Sebastian.H.Seidel@med.uni-giessen.de
*/

/* 
   This file - primitive.c - provides the core procedures of
   matlab-interface.
   
   Use matlab-interface to control matlab (www.mathworks.com) via 
   interprocess-communication from within the fantastic open-source 
   scheme-interpreters/compilers mzscheme and drscheme that are 
   distributed by plt (www.plt-scheme.org).
*/

/* primitive.c
 * -----------
 *
 * First-edition:      2002-02-20  SSeidel
 * Latest-revision:    2002-05-20  SSeidel
 *
 * (This file is best viewed with emacs which is available from www.gnu.org ;^)
 *
 * Tested with PLT-Scheme version: 200 201 202
 * -------------------------------
 *
 * Modules?
 * --------
 * yes -> compile with  #define PLTMOD  set below, standard setup.
 * no  -> compile with  #define PLTRAW  set below, difficult setup.
 *            use (load-extension <absolute-path>) to load the interface.
 *
 * Usage-example:
 * --------------
 *     (current-namespace (make-namespace))               
 *     (require (lib "primitive.ss" "matlab-interface")) 
 *     (require (lib "highlevel.ss" "matlab-interface"))  
 *     (engine-open)
 *     (display (engine-eval "2 + 2"))
 *     (engine-close)                                     
 *
 * Scheme-primitives, defined below:
 * ---------------------------------
 *         <index>         vector of fixnums
 *         <shape>         vector of fixnums
 *         <type>          symbol, one of '(cell char double int32)
 *                         default: 'double
 *         <complexity>    symbol, one of '(real complex)
 *                         default: 'real
 *         <matrix>        nested vectors, that implement multidimensional
 *                         array in scheme
 *
 *     Make Array
 *         (make-cell-array <shape> [object]) -> array
 *         (make-char-array <shape> [object]) -> array
 *         (make-array <shape> [type] [complexity] [object]) -> array
 *         (array-clone <array>) -> array
 *
 *     array-name -rank -size -shape -set! -ref and -fill!
 *         (array-name <array> [string]) -> string
 *         (array-rank <array>) -> integer
 *         (array-size <array>) -> integer
 *         (array-shape <array>) -> shape
 *         (array-set! <array> <vector> <value>) -> unspecified
 *         (array-ref <array> <vector) -> value
 *         (array-fill! <array> <object>) -> unspecified
 *
 *     Array-type and complexity
 *         (array-type <array>) -> symbol
 *         (array-complexity <array>) -> symbol
 *
 *     Predicates
 *         (array? <object>) -> boolean
 *         (empty-array? <array>) -> boolean
 *         (real-array? <object>) -> boolean
 *         (complex-array? <object>) -> boolean
 *         (cell-array? <object>) -> boolean
 *         (char-array? <object>) -> boolean
 *         (double-array? <object>) -> boolean
 *         (int32-array? <object>) -> boolean
 *         (numeric-array? <object>) -> boolean
 *
 *     Communicate with matlab-'engine'-process
 *         (engine-open) -> unspecified
 *         (engine-close) -> unspecified            
 *         (engine-eval <string>) -> string | void
 *         (engine-put <array> [string]) -> unspecified
 *         (engine-get <string>) -> array
 *
 *     Convert string<->array vector<->array object<->array
 *         (array->string <array>) -> string
 *         (string->array <string>) -> array
 *         (array->object <array>) -> object
 *         (object->array <object> [type] [complexity]) -> array
 *         (array->vector <array>) -> vector
 *         (vector->array <vector> [type] [complexity]) -> array
 *         (array->matrix <array>) -> matrix
 *         (matrix->array <matrix> [type] [complexity]) -> array
 *
 *     Info
 *         (print-matlab-array-info) -> unspecified
 *
 * Additional Scheme-Primitives in debug-mode, defined very below:
 * ---------------------------------------------------------------
 *
 *     Debug
 *         (array-index->offset <array> <vector>) -> integer
 *         (array-index->elnum <array> <vector>) -> integer
 *         (array-bytes-per-element <array>) -> integer
 *         (array-element-ref <array> <integer>) -> value
 *         (array-element-set! <array> <integer> <value>) -> unspecified
 *         (matlab-eps) -> flonum
 *         (compatible-array? <type> <complexity>) -> boolean
 *         (type-symbol->id <symbol>) -> fixnum
 *         (complexity-symbol->id <symbol>) -> fixnum
 *         (array-type-id <array>) -> integer
 *         (array-type-string <array>) -> string
 *         (array-complexity-id <array>) -> integer
 *         (array-complexity-string <array>) -> string
 *         (matrix-shape <matrix>) -> vector
 *
 *     Playground
 *         (playground-eat-memory <bytes>) -> unspecified
 *
 * Exceptions in matlab-environment:
 * ---------------------------------
 *     Exceptions in matlab-environment do _not_ interrupt scheme:
 *         (begin  (engine-eval "value = <error>") 
 *                 "continued")
 *         => "continued"
 *     Interruption provides for better error-checking and can be
 *     implemented by verifying assignement, like this:
 *         (begin  (engine-eval "clear value; value = <error>;")
 *                 (engine-get "value")
 *                 "continued")
 *         => eng_get_array: 
 *             No mxArray of name 'value' exists in matlab-environment.
 *
 * Anatomy of scheme-representation of mxArray:
 * --------------------------------------------
 *
 *     - homogenous: all elements are of the same type. 
 *     - stored in one (if real) or two (if complex) long vectors in memory.
 *     - characterized by shape, complexity and element-type.
 *
 *     Shape is represented by a vector.
 *     - matlab-strings are 2-dimensional 1-by-n row-vectors of mxChar
 *     - matlab-vectors are 2-dimensional n-by-1 column-vectors.
 *
 *     Complexity is specified with a symbol, complexity-symbol, that 
 *     internally corresponds to a bool ,complexity-id:
 *
 *     complexity-symbol   complexity-id
 *     -----------------   -------------
 *     real                0
 *     complex             1
 *
 *     Type is specified with a symbol, type-name, that internally
 *     corresponds to an int, type-id. Currently, values of those (+)
 *     matlab-types are accessible in Scheme:
 *
 *     type-id     type-name   stored-data         real    complex
 *     -------     ---------   -----------         ----    -------
 *     1           cell        mxArray*            +       non-existent
 *     4           char        mxChar              +       non-existent
 *     6           double      double              +       +
 *     12          int32       int                 +       -
 *
 *
 * Array in memory:
 * ----------------
 *         
 *     Picture 1:      24 28 32                
 *     ----------     /25 29 /3 
 *                   / 26 30/34 
 *                  /  27 3/ 35 
 *                 /  /   /   / 
 *                /  /   /   /  
 *               12 16 20   /   
 *              /13 17 /1  /   Picture 2:      3rd dimension             
 *             / 14 18/22 /    ----------     /                          
 *            /  15 1/ 23/                   /                      
 *           /  /   /   /                   /________ 2nd dimension: row 
 *          /  /   /   /                   |                             
 *         00 04 08   /                    |                             
 *         01 05 09  /                     |                             
 *         02 06 10 /                      |                             
 *         03 07 11/                       1st dimension: column
 *
 *
 *     Picture 3:
 *     ----------
 *
 *      -----------------------------------------------------------------
 *     | 00 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | ... | 33 | 34 | 35 |
 *      -----------------------------------------------------------------
 *
 *     Picture 1 shows a 3-dimensionsal-#(4 3 3)-array consisting of 36
 *     elements.
 *
 *     Picture 3 shows that in memory, all elements are stored in one 
 *     long vector. The first element in memory is 00, followed by 01, 
 *     02, ... .
 *
 *     Picture 2 shows how picture 1 corresponds to column, row and
 *     third dimension. For example:
 *
 *     Element 00 can be addressed #(0 0 0)  -->  col: 0, row: 0, 3rd: 0
 *             07                  #(3 1 0)  -->       3       1       0
 *             35                  #(3 2 2)  -->       3       2       2
 *
 *     Conclusion:
 *
 *     -> Column-elements are stored together:
 *         (00 01 02 03)   (04 05 06 07)   (16 17 18 19)
 *
 *     -> If you want all elements of one row, you have to jump a bit:
 *         (00 04 08)   (01 05 09)   (24 28 32)   (14 18 22)
 *
 *     -> If you want all elements of one third dimension, you must jump 
 *         even wider:   (00 12 24)   (05 17 29)   (11 23 35)
 *         
 *     -> 4th, 5th, ... dimension: Elements are further away. To get them
 *         you must jump wider.
 *
 * Abbreviations:
 * --------------
 *     mx          matrix
 *     ss          Scheme, Mzscheme
 *     mxArray     Matlab-array-type. Many matlab-procedures work on
 *                 instances of mxArray. All mxArrays always have at least 
 *                 2 dimensions:
 *                 (array-rank (make-char-array #(1 1 1 1 1))) 
 *                 => 2 !!!  This is poor behaviour of matlab.
 *     ssArray     Scheme-array-type. Represented by a c-struct.
 *                 Encapsulates the mxArray. Is a Scheme_Object, 
 *                 characterized by its type: ssArray_type.
 *                 Inside scheme, ssArrays are just called 'array'.
 *     mx_array    Pointer on an instance of mxArray.
 *     ss_array    Pointer on an instance of ssArray. 
 *                 Like (all?) other Scheme_Objects, it is a first-class 
 *                 scheme-value, that is: it may be given to and returned
 *                 from scheme-procedures.
 *     arrayel     Array-element. Precisely: struct that contains pointers
 *                 to the real and (optional: imaginary) value of one 
 *                 particular element of an mx_array.
 *                 Pass the access-to-a-particular-array-element around
 *                 between procedures by passing around the arrayel.
 *     elnum       Element-number. For a particular array-element: 
 *                 number of storage-places that its storage-place comes 
 *                 after the storage-place of the first element of the 
 *                 array.
 *     offset      For a particular array-element: number of bytes that its
 *                 storage-place comes after the storage-place of the
 *                 first element of the array.
 *                 offset = bytes-per-element * elnum;
 *     dimarray    Array of int with each int beeing the number of 
 *                 possible different indexes in one particular dimension.
 *                 dimarray [0] = 5; says that there are 5 different
 *                 possibilities to index the first dimension, for
 *                 example.
 *                 dimarray as a whole corresponds to the SHAPE of an 
 *                 array.
 *     idxarray    Array of int with each int specifying the index of a
 *                 value in a particular dimension.
 *                 idxarray [0] = 1; says that - in the first dimension -
 *                 the value has index 1, for example.
 *                 idxarray as a whole corresponds to particular VALUE 
 *                 inside of the array.
 *
 * Supported:
 * ----------
 *     Multidimensional non-sparse non-complex arrays with
 *     those storage-classes:
 *         cell    - Each element of a cell-array is a mxArray.
 *         char    -                   char            char
 *         double  -                   double          double
 *         int32   -                   int32           32-bit signed int
 *     Multidimensional non-sparse complex arrays with
 *     those storage-classes:
 *         double
 *     IEEE inf (infinity) and NaN (Not-a-Number) - numbers:
 *         Natively supported by charming Miss Scheme.
 *     Empty arrays. Supported because r5rs allows empty vectors creatable
 *         with (make-vector 0) and matlab allows empty arrays. Useful???
 *     Standard initializing after creation. Newly created mxArrays are
 *     initialized like this:
 *
 *         Array-type          Initial-value-of-each-element
 *         ----------          -----------------------------
 *         cell:               no-initialization!
 *         char:               #\nul
 *         int32:              0
 *         double:             0.0
 *         complex-double:     0.0+0.0i
 *
 * Not supported:
 * --------------
 *     Sparse arrays. Should be supported someday, if there is any need.
 *     Special logical arrays. Its just a flag. Use zero/nonzero 
 *         int32-matrices instead and flag them logical/nonlogical inside 
 *         matlab-environment.
 *     Structure arrays. No structures needed in true scheme.
 *         No structures in r5rs, either.
 *     Variable origin. Bad idea!
 *     Array-reshaping. Bad idea!
 *     Arrays of more than max_number_of_dimensions - currently 1024 - 
 *         dimensions require recompilation.
 *     Arbitrary initializing after creation.
 *
 * Multibyte <-> unibyte - character-conversion:
 * ---------------------------------------------
 *     Matlab uses 2-byte-characters of type mxChar.
 *     No multibyte-character-support in plt-scheme.
 *     Thus, the first byte of mxChar is converted to scheme-character-data
 *     whereas the second byte of mxChar is ignored.
 *     Since the entire ascii-character-set maps to the first characters 
 *     in unicode/ucs, they should be correctly converted.
 *     Same with iso-8859-1, synonym: latin-1. See [1].
 *
 * Ideas concerning definition of arrays in scheme:
 * ------------------------------------------------
 *
 * Problem and motivation: 
 *     Arrays of arbitrary number of dimensions (rank) are painfully 
 *     missing from scheme-standard. Following some thoughts about how a 
 *     definition of scheme-arrays might look like.
 *
 * Should multidimensional arrays be part of scheme-standard at all?
 *     Contra:
 *         Arrays can be build from vectors. Scheme defines primitive
 *             datatypes. We do not have lists neither, only pairs.
 *         We do not need arrays as a generalisation of pairs!
 *         We do not need generalisations of anything.
 *             See discussion about operator-overloading in case of
 *                 generalised set! .
 *             See that strings are not specialised vectors.
 *             See that pairs are not specialised vectors.
 *         Arrays with more than 2 dimensions are rarely needed, more
 *             than 3 dimensions almost never!
 *         There are too many different possibilities of defining an 
 *             array-type. This shows that there is no such thing like a 
 *             'general' multidimensional array.
 *             What about sparse-arrays? They just make it impossible to 
 *             define *one* general array-type, do they not?
 *         The current scheme-standard would have to be fundamentally 
 *             changed to get arrays without sacrificing consistency. 
 *             Old programs would not run anymore. There is no way of 
 *             dealing with arrays like a simple add-on to the current 
 *             standard.
 *     Pro:
 *         Convinience. Why should everybody invent his own little 
 *             special-purpose array-language ever and ever again?
 *         Better interfacing to foreign array-based languages and 
 *             libraries like Matlab.
 *         Array is the natural abstraction of many things including
 *             vectors, strings and pairs. Pairs could be special-purpose 
 *             length-2-vectors and 1-dimensional #(2)-Arrays.
 *         Backward compatibility is a problem but consistency and keeping 
 *             up with the 'state-of-the-art' is a nobler goal to long for 
 *             and makes scheme a computer-language not only of the past, 
 *             but also adept at dealing with the future.
 *     Neither:
 *         Since the primary goal should be consistency: what is the
 *             philosophy behind the current setup of scheme-types?
 *             Is this philosophy not damaged by the existence of an 
 *             independent string-type, anyway?
 *             Is this philosophy simplifying or complicating things?
 *         Is  the existence of arrays coupled with the discussion about 
 *             argument-types in scheme? In which way?
 *
 * Variable origin:
 *     Specify origin to move array through space. Enable negative 
 *     indexing. Bad idea?
 *     Pro:
 *         If negative indexing is allowed one can have funny index-spaces.
 *     Contra:
 *         Adds confusion. Origin-zero should be something
 *             to depend on, like index-zero of scheme-vectors is always
 *             the first element.
 *
 * Incremental real indexing:
 *     Contra:
 *         The incremental factor could be specified through a constant
 *             factor, a function or a set of vectors. This means that
 *             the indexes would contain information that would have to
 *             be stored somewhere. 
 *             In fact they'd represent just another dimension: 
 *             length-x-vector with incremental indexing equals 
 *             #(x 2)-plane.
 *
 * Automatic adapting shape:
 *     Instead of an error if array-set! or array-ref is called on
 *     an element that is outside the array, the array-shape could adjust.
 *     Same for dimensions. Bad idea?
 *     Pro:
 *         Convenient because the number of elements or dimensions might 
 *             not been known in advance.
 *         Convenient because array-shape must not be specified when
 *             creating an array.
 *         Automatic reshaping makes tedious manual reshaping superfluous.
 *             -> Many ugly work-arounds are rooted out from the beginning.
 *         Arrays might shrink, too, if there were procedures that
 *             delete elements/dimensions/areas.
 *     Contra:
 *         Array operations like addition require arrays of the same shape.
 *             This might be handled in at least three ways:
 *             -> the arrays are automatically resized / redimensioned in 
 *                 a way that in the end they have the same shape.
 *             -> the arrays have to be reshaped by the programmer.
 *                 Therefore the shapes of *both* arrays eventually have
 *                 to be adjusted. A simple procedure that assigns the
 *                 shape of the one to the other won't work in all possible
 *                 cases.
 *             -> an error is signaled.
 *         Arrays would only grow and never shrink. Always true?
 *             No (see above).
 *         Abuse of normal arrays as sparse arrays would be easy.
 *         Array-boundaries should be respected just like
 *             scheme-vectors do not allow over/under-indexing.
 *             -> Better error-checking.
 *             -> If the array is able to grow in all directions,
 *                  negative indexing (see above) would be required.
 *         Some cases of use of automatic shape-adaption may be resolved
 *             by lists of arrays.
 *     Neither:
 *         What is easier: to implement shape-adapting arrays on top
 *             of boundary-checking ones or vice-versa?
 *         What is more useful: 
 *             boundary-checking or automatic-shape-adaption?
 *         What is more efficient? Depends on combination of
 *             problem-space and implementation. Tendency?
 *         Automatic-shape-adaption requires specification (automatic or
 *             manual) of a value which is assigned to newly allocated
 *             elements.
 *         What about mathematics? Mathematica?
 *
 * Shape dense, sparse, ragged ...
 *     Should dense and sparse arrays be different types?
 *
 * Types
 *     Arrays are abstraction of vectors?
 *         Vectors be 1-dimensional column-arrays.
 *         Arrays are vectors: No? 
 *         Vectors are arrays: Yes?
 *         Primitive array-operations must work on vectors? Yes?
 *         Primitive vector-operations must work on 1-dimensional arrays? Maybe?
 *         Primitive array-operations return 1-dimensional array or vector,
 *         0-dimensional array or scalar? Arrays in both cases?
 *     Arrays are abstraction of strings?
 *         Strings be row-arrays of multibyte-characters.
 *         -> typed arrays
 *     r5rs-disjointness-of-types:
 *         Each of these types is different from each other:
 *             (boolean pair symbol number char string vector port procedure)
 *             -> Vector and string are not of the same type. 
 *                 Why is a string not a specialised vector?
 *             -> Arrays be disjoint or generalisations of string and vector?
 *
 * Arrays passed by reference?
 *     Arrays and parts of arrays are passed by reference? by value? when?
 *
 * Indexing
 *     Array bounds included or excluded?
 *         Lower bound included, upper bound excluded.
 *
 * Operating on arrays: share array-data.
 *
 * Operating on arrays: 
 *     - Loops and indexing / operating-on individual array-elements 
 *         corrupt parralel processing (and elegance).
 *     Facilitate parallel processing of data by avoiding loops.
 *     Use high-level-operations like map, map! and for-each instead. 
 *     No chance to avoid loops if information flows from one element to 
 *     another next element? Wrong. See array-max, array-min, array-all,
 *     array-any, array-sum.
 *     No chance if the order in which the elements are processed is 
 *     important?
 *     Loop-killers:
 *         Elementwise data-parallel operations:
 *             for-each -> specify subarray, shared-array
 *             map -> dito
 *             array-addition, - subtraction, number-to-array-addition ...
 *             elementwise array-multiplication, -division
 *         Reductive data-parallel operations:
 *             add, min, max, all, any, sum, ...
 *             One reduction-operator is enough. It may take a binary
 *             procedure and the array as argument. Also, the dimension(s)
 *             where the reduction should take place has/have to be 
 *             specified.
 *     Good practice to create a multidimensional array by means of
 *     elementwise operations:
 *         Create a vector 1:n and map a function on the result.
 *         Flood the array vector-1:n-like and map a function on the result.
 *         How to create such a vector in scheme without loops?
 *     Lazy-evaluation? Lazy-arrays?
 *
 * Shared arrays should be immutable?
 *
 * Operator - possible short names:
 *     Allocate: make-array array-clone -copy
 *     Inquire: array-shape -rank -size
 *     Selection / Referencing: array-ref
 *     Single mutation: array-set! 
 *     General mutation: array-spread -pack -reshape
 *     Operate elementwise: array-map array-map! -for-each
 *     Operate reductive: array-max -min -std -all -any -or -and
 *     Sharing data: array-share -use
 *
 * Operator overloading?
 *     + - * / min max set! ref
 *
 * Index-object
 *     Vector or rank-1-array or both? Since a rank-1-array is a
 *     genaralisation of a vector, maybe specifying a vector, 
 *     which may also be a rank-1-array, is better because a string would
 *     not be possible (but is a rank-1-array, too).
 *
 * Strings are rank-1 or rank-2 - array?
 *     Rank-1
 *         because they are a sequence of characters, arranged in one
 *         dimension.
 *     Rank-2
 *         because they have to be row-arrays and rows are the second
 *         dimension of an array.
 *
 * Strings are vectors with specialised type?
 *
 * Ideas concerning the interface:
 * -------------------------------
 *
 * Possible next-generation-wrapper:
 *     Make it possible to call EVERY Matlab-function from within Scheme.
 *     Wrap int, double, char, ... and the function-pointers.
 *     C-function-pointers be bound to scheme-symbols, saved in an
 *     array where they are accessible from within c by index.
 *     Hash tables bind symbol-names to function-pointer.
 *     Look at eli barzilays ffi for inspiration.
 *     MzScheme has a FFI, too?
 *     ==> Too much work for now.
 *
 * Implementation of ...
 *     Sparse arrays, some premature thoughts:
 *         Design sparse-maker, -set!-ter and -ref-erencer as usual.
 *         Invent scheme-representation of multidimensional
 *             sparse matrices. Associative lists?
 *         Design scheme-sparse <-> scheme-matlab-sparse - mappers.
 *         Conversion?
 *     Logical arrays, some premature thoughts:
 *         Special conversion between #f/#t - scheme-matrices and logical
 *         matlab-arrays could be implemented if anybody needed.
 *
 * Max number-of-elements
 *     Configurable parameter in scheme. Purpose: do not allow bigger
 *     matrices because they result in errors because the necessary memory
 *     can not be allocated.
 *
 * Efficiency
 *     Array_Element global.
 *
 * Add new type:
 * -------------
 *     Type-maker:
 *     Type-converter and converter-switch:
 *     Type-checker-Macro:
 *         is_compatible_mxarray  
 *     highlevel.ss
 *
 * Add new primitive:
 * ------------------
 *     Document at the top of this file.
 *     Declare.
 *     Deposit in scheme-environment -> scheme_reload.
 *     Define.
 *
 * 16-bit-systems, long and int
 * ----------------------------
 *     Maybe, long<->int - type-conversion-errors may be hidden because
 *     they don't show up in a 32-bit-system, where long and int are
 *     stored alike. How to find out?
 *
 * Type-conversion scheme <-> C == Matlab
 * Safety vs. Efficiency - Examples
 * --------------------------------------
 *
 *     Integer-conversion / Scheme->C
 *         c-integer:      31-bits and 1 sign-bit
 *         scheme-integer: 30-bits and 1 sign-bit and ??
 *         efficient:  scheme_make_integer
 *         safe:       scheme_make_integer_value
 *
 *     Integer-conversion / C->Scheme
 *         scheme-integer may be fixnum that always fits or bignum that
 *         maybe fits (murphy: 'propably not.').
 *         efficient:  scheme_int_val
 *         safe:       get_int_val
 *
 * References:
 * -----------
 *     [0] Explanation of how mxArrays are stored in memory:
 *         matlab-help-desk/external-interfaces/API-reference/mxCalcSingleSubscript
 *     [1] UTF-8 and Unicode FAQ for Unix/Linux by Markus Kuhn:
 *         http://www.cl.cam.ac.uk/~mgk25/unicode.html
 *     [2] Interesting discussion about array-primitives in scheme:
 *         http://srfi.schemers.org/srfi-25/
 *     [3] Jim Weigang's apl-information:
 *         http://www.chilton.com/~jimw/
 *
 * Cell-arrays: referencing vs. copying
 * ------------------------------------
 *     array-ref   should return reference to element,
 *                 not a newly allocated copy of the element.
 *     array-set!  should set element to reference of array, 
 *                 not to a newly allocated copy of array.
 * ----------------------------------------------------------
 * Rationale:  Copying is inefficient.
 * Problem:    Due to garbage-collection, implementation seems difficult.
 *             If referencing is implemented, cell-array must not be 
 *             allocated atomic since it contains pointers to gc-managed 
 *             memory-blocks (mxArray*).
 *             How may I register the array of mxArray* with the gc?
 * Testing:    If the following works with arrays, too, 
 *             it has been done right:
 *             (Tested in plt-scheme and petite-chez-scheme)
 *             1   (define con (vector 1 2 3))
 *                     con ;; ==> #3(1 2 3)
 *                 (define vec (vector 4 5 6))
 *                 (vector-set! con 2 vec)
 *                     con ;; ==> #3(1 2 #3(4 5 6))
 *                 (vector-set! vec 2 666)
 *                     con ;; ==> #3(1 2 #3(4 5 666))
 *             2   (define con (vector 1 2 (vector 4 5 6)))
 *                     con ;; ==> #3(1 2 #3(4 5 6))
 *                 (vector-set! (vector-ref con 2) 2 666)
 *                     con ;; ==> #3(1 2 #3(4 5 666))
 *             Is this behaviour of scheme something to depend on?
 *             What about r5rs?
 * Ergo:       Take care of that later.
 * Change:     FIXME-REF.
 * Read:       Implementation of vectors in scheme. vector_ref
 *
 * To do:
 * ------
 *     make-cell-array: Initialize to something? Currently initialized to
 *     NULL, so (array-ref <fresh-cell-array>) could either result in an
 *     error or return scheme_void, or scheme_false.
 *     New name: matlab-remote ?
 *     Thread safe? See globals dimarray and idxarray.
 *     engine-open: If it works on unix/linux, make communication with remote
 *     hosts possible. How to check for os-type from within the extension.
 *     Shape-comparison. matrix-shape.
 *
 * To do 2002-10-27:
 * -----------------
 *     attach engine-session to current custodian
 *         must end with drscheme/execute
 *         multiple sessions?
 *     complain to mathworks
 *         a second call to engOpen
 *             does not start a new engine
 *             returnes a new handle to the already opened engine
 *         sometimes - as if by miracle - engOpen 
 *             starts a new engine!
 *             returns a handle to that new engine!
 *             enables one to
 *                 evaluate expressions in a certain engine
 *                 close a certain engine
 *         one must call engClose on all handles to kill the engine-process.
 */

/* PLT-with-modules?:
   yes -> PLTRAW or
   no  -> PLTMOD */
#define PLTMOD

/* Debug-mode includes additional functions and
   array-offset-boundary-check that is neccessary
   when referencing array-elements by
   raw memory offset rather than by index. */
/* #define DEBUG */
#undef DEBUG

#include <string.h>
#include "escheme.h" /* access to MzScheme-types and -functions */
#include "engine.h"  /* access to Matlab-engine-types and -functions */

#define MAX_NUMBER_OF_DIMENSIONS 1024
#define STRING_BUFFER_SIZE 4096
static int dimarray [MAX_NUMBER_OF_DIMENSIONS];
static int idxarray [MAX_NUMBER_OF_DIMENSIONS];
static char stringbuf [STRING_BUFFER_SIZE];
static Engine* ep = NULL;

/* Encapsulate mxArray in a Scheme_Object. */
typedef struct {
  Scheme_Type type;
  mxArray *mx_array;
} ssArray;

/* Not a Scheme_Object. Use this struct to pass mxArray-elements
   of various types around between extension-internal functions.
   When set to an array-element, it contains all information needed to:
   - convert the value of the array-element from C to Scheme.
   - convert a Scheme-value, so that it will fit into the mxArray.
   - set the mxArray-Element to a different value. */
typedef struct {
  mxClassID storage_class;
  bool complex_p;
  void* real;
  void* imag;
} Array_Element;

static Scheme_Type ssArray_type = 0;
static Scheme_Type ssZombieArray_type = 0;

/* mxArray-Pointer: Return pointer on mxArray. */
#define MXARRAY_PTR(obj) ((mxArray*) (((ssArray*) obj)->mx_array))

/* mxArray-Predicate: True if obj contains mxArray. */
#define MXARRAY_P(obj) (\
(SCHEME_TYPE (obj) == ssArray_type) && \
(MXARRAY_PTR (obj) != NULL))

/* True, if an mx_array of certain type and complexity may be created or
   imported. True, if the conversion to and from scheme-values is 
   supported by the interface. */
#define IS_COMPATIBLE_MXARRAY(id,complex_p) ((\
(((complex_p) == 1) && ((id) == mxDOUBLE_CLASS)) ||\
(((complex_p) == 0) && (\
((id) == mxCELL_CLASS) ||\
((id) == mxCHAR_CLASS) ||\
((id) == mxDOUBLE_CLASS) ||\
((id) == mxINT32_CLASS))))? 1 : 0)

/***** Create or terminate ss_array. =================================== */
static mxClassID type_symbol_to_id (Scheme_Object *type);
static bool complexity_symbol_to_id (Scheme_Object *complexity);
static mxArray* create_numeric_array (int ndim, int *dimarray, mxClassID type_id, bool complexity_id);
static Scheme_Object* create_ss_array (mxArray *mx_array);
static void terminate_ss_array (Scheme_Object *o);
static void finalise_ss_array (void *o, void *d);
static void engine_atexit (Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *d); /* fixme20021105 */

/***** make-array array-set! and array-ref c-helpers =================== */
static int dimarray_set (Scheme_Object *dimensions);
static int dimarray_take_matrix_shape (Scheme_Object *matrix);
static int dimarray_take_matrix_shape_rec (int n, Scheme_Object *matrix);
static void dimarray_reverse (int n);
static void idxarray_set_and_check (Scheme_Object *index, int ndim, const int* dims);
static int mxarray_index_to_offset (mxArray* mx_array, Scheme_Object *index);
static int mxarray_index_to_elnum (mxArray* mx_array, Scheme_Object *index);
static void arrayel_get_with_offset (mxArray* mx_array, Array_Element* element, int offset);
static void arrayel_get_with_index (mxArray* ss_array, Array_Element* element, Scheme_Object* index);

/***** Convert scheme->matlab ========================================== */
typedef void (*ss_to_mx_setter) (void*, void*, Scheme_Object*);
static ss_to_mx_setter ss_to_mx_setter_switch (int storage_class, int complex_p);
static void arrayel_set_convert (Array_Element* element, Scheme_Object* val);
static void mxarray_set_with_vector (mxArray* mx_array, Scheme_Object* vector);
static void mxarray_fill_with_object (mxArray* mx_array, Scheme_Object* object);
static void scalar_mxarray_set_with_object (mxArray* mx_array, Scheme_Object* object);
static void mxarray_set_with_matrix (mxArray* mx_array, Scheme_Object* matrix, int ndim);
static int mxarray_set_with_matrix_rec (mxArray* mx_array, ss_to_mx_setter setter, Scheme_Object* matrix, int n, int elnum);

/***** Convert matlab->scheme ========================================== */
typedef Scheme_Object* (*mx_to_ss_converter) (void*, void*);
static mx_to_ss_converter mx_to_ss_converter_switch (int storage_class, int complex_p);
static Scheme_Object* convert_arrayel_ref (Array_Element* element);
static Scheme_Object* mxarray_to_vector (mxArray *mx_array);
static Scheme_Object* mxarray_to_object (mxArray *mx_array);
static Scheme_Object* mxarray_to_matrix (mxArray *mx_array);
static int mxarray_to_matrix_rec (mxArray *mx_array, mx_to_ss_converter converter, Scheme_Object **vector, int n, int elnum);

/***** Scheme-Primitives: make-array ================================== */ 
static Scheme_Object* mx_create_cell_array (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_create_char_array (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_create_numeric_array (int argc, Scheme_Object *argv []);
static Scheme_Object* make_double_array (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_duplicate_array (int argc, Scheme_Object *argv []);

/***** Scheme-Primitives: array-name -shape -set! and -ref ============= */
static Scheme_Object* mx_get_or_set_name (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_get_number_of_dimensions (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_get_number_of_elements (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_get_dimensions (int argc, Scheme_Object *argv []);
static Scheme_Object* array_set (int argc, Scheme_Object *argv []);
static Scheme_Object* array_ref (int argc, Scheme_Object* argv []);
static Scheme_Object* array_fill (int argc, Scheme_Object *argv []);

/***** Scheme-Primitives: array-type and complexity ==================== */
static Scheme_Object* mx_get_class_symbol (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_get_class_id (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_get_class_name (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_complexity_symbol (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_complexity_id (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_complexity_name (int argc, Scheme_Object *argv []);

/***** Scheme-Primitives: predicates =================================== */
static Scheme_Object* mx_is_array (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_is_complex (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_is_real (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_is_numeric (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_is_cell (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_is_char (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_is_int32 (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_is_double (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_is_empty (int argc, Scheme_Object *argv []);

/***** Scheme-Primitives: communicate with matlab-'engine'-process ===== */
static Scheme_Object* eng_open (int argc, Scheme_Object *argv []);
static Scheme_Object* eng_close (int argc, Scheme_Object *argv []);
static Scheme_Object* eng_eval_string (int argc, Scheme_Object *argv []);
static Scheme_Object* eng_put_array (int argc, Scheme_Object *argv []);
static Scheme_Object* eng_get_array (int argc, Scheme_Object *argv []);

/***** Scheme-Primitives: convert string<->array vector<->array object<->array */
static Scheme_Object* mx_array_to_string (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_create_string (int argc, Scheme_Object *argv []);
static Scheme_Object* array_to_vector (int argc, Scheme_Object *argv []);
static Scheme_Object* vector_to_array (int argc, Scheme_Object *argv []);
static Scheme_Object* vector_to_double_array (int argc, Scheme_Object *argv []);
static Scheme_Object* array_to_object (int argc, Scheme_Object *argv []);
static Scheme_Object* mx_create_scalar_double (int argc, Scheme_Object *argv []);
static Scheme_Object* object_to_array (int argc, Scheme_Object *argv []);
static Scheme_Object* matrix_to_double_array (int argc, Scheme_Object *argv []);
static Scheme_Object* matrix_to_array (int argc, Scheme_Object *argv []);
static Scheme_Object* array_to_matrix (int argc, Scheme_Object *argv []);

/***** Scheme-Primitives: info ========================================= */
static Scheme_Object* my_apply (char proc [], int argc, Scheme_Object *argv []);
static Scheme_Object* print_matlab_array_info (int argc, Scheme_Object *argv []);


#ifdef DEBUG

/***** Scheme-Primitives: debug ======================================== */
static Scheme_Object* array_index_to_offset (int argc, Scheme_Object *argv []);
static Scheme_Object* array_index_to_elnum (int argc, Scheme_Object *argv []);
static Scheme_Object* array_bytes_per_element (int argc, Scheme_Object *argv []);
static Scheme_Object* array_element_ref (int argc, Scheme_Object *argv []);
static Scheme_Object* array_element_set (int argc, Scheme_Object *argv []);
static Scheme_Object* matlab_eps (int argc, Scheme_Object *argv []);
static Scheme_Object* is_compatible_array (int argc, Scheme_Object *argv []);
static Scheme_Object* debug_type_symbol_to_id (int argc, Scheme_Object *argv []);
static Scheme_Object* debug_complexity_symbol_to_id (int argc, Scheme_Object *argv []);
static Scheme_Object* matrix_shape (int argc, Scheme_Object *argv []);

/***** Scheme-Primitives: playground =================================== */
static void playground_visible_finaliser (void* obj, void* nbytes);
static Scheme_Object* playground_eat_memory (int argc, Scheme_Object *argv []);

#endif

/**** INITIALIZE SCHEME ================================================ */

Scheme_Object*
scheme_initialize (Scheme_Env *env)
{
  ssArray_type = scheme_make_type ("<array>");
  ssZombieArray_type = scheme_make_type ("<zombie-array>");

  /* fixme20021105
     Just a practical hack to kill any open matlab-engine-process
     when kissing mzscheme goodbye. */
  scheme_add_atexit_closer (engine_atexit);

  return scheme_reload (env);
}

Scheme_Object*
scheme_reload (Scheme_Env *env) 
{
  Scheme_Env* environment = NULL;
#ifdef PLTMOD
  environment = scheme_primitive_module (scheme_intern_symbol ("primitive"),
                                         env);
#endif
#ifdef PLTRAW
  environment = env;
#endif

  /***** SCHEME-PRIMITIVES: MAKE-ARRAY ================================= */
  scheme_add_global ("make-cell-array",
                     scheme_make_prim_w_arity (mx_create_cell_array, 
                                               "create-cell-array", 1, 2),
                     environment);
  scheme_add_global ("make-char-array",
                     scheme_make_prim_w_arity (mx_create_char_array, 
                                               "create-char-array", 1, 2),
                     environment);
  scheme_add_global ("make-array",
                     scheme_make_prim_w_arity (mx_create_numeric_array, 
                                               "make-array", 1, 4),
                     environment);
  scheme_add_global ("array-clone",
                     scheme_make_prim_w_arity (mx_duplicate_array, 
                                               "array-clone", 1, 1),
                     environment);

  /***** SCHEME-PRIMITIVES: ARRAY-NAME -RANK -SIZE -SHAPE -SET! AND -REF */
  scheme_add_global ("array-name",
                     scheme_make_prim_w_arity (mx_get_or_set_name, 
                                               "array-name", 1, 2),
                     environment);
  scheme_add_global ("array-rank",
                     scheme_make_prim_w_arity (mx_get_number_of_dimensions, 
                                               "array-rank", 1, 1),
                     environment);
  scheme_add_global ("array-size",
                     scheme_make_prim_w_arity (mx_get_number_of_elements, 
                                               "array-size", 1, 1),
                     environment);
  scheme_add_global ("array-shape",
                     scheme_make_prim_w_arity (mx_get_dimensions, 
                                               "array-shape", 1, 1),
                     environment);
  scheme_add_global ("array-set!",
                     scheme_make_prim_w_arity (array_set, 
                                               "array-set!", 3, 3),
                     environment);
  scheme_add_global ("array-ref",
                     scheme_make_prim_w_arity (array_ref, 
                                               "array-ref", 2, 2),
                     environment);
  scheme_add_global ("array-fill!",
                     scheme_make_prim_w_arity (array_fill, 
                                               "array-fill!", 2, 2),
                     environment);

  /***** SCHEME-PRIMITIVES: ARRAY-TYPE AND COMPLEXITY ================== */
  scheme_add_global ("array-type",
                     scheme_make_prim_w_arity (mx_get_class_symbol, 
                                               "array-type", 1, 1),
                     environment);
  scheme_add_global ("array-complexity",
                     scheme_make_prim_w_arity (mx_complexity_symbol, 
                                               "array-complexity", 1, 1),
                     environment);

  /***** SCHEME-PRIMITIVES: PREDICATES ================================= */
  scheme_add_global ("array?",
                     scheme_make_prim_w_arity (mx_is_array, 
                                               "array?", 1, 1),
                     environment);
  scheme_add_global ("complex-array?",
                     scheme_make_prim_w_arity (mx_is_complex, 
                                               "complex-array?", 1, 1),
                     environment);
  scheme_add_global ("real-array?",
                     scheme_make_prim_w_arity (mx_is_real, 
                                               "real-array?", 1, 1),
                     environment);
  scheme_add_global ("numeric-array?",
                     scheme_make_prim_w_arity (mx_is_numeric, 
                                               "numeric-array?", 1, 1),
                     environment);
  scheme_add_global ("cell-array?",
                     scheme_make_prim_w_arity (mx_is_cell, 
                                               "cell-array?", 1, 1),
                     environment);
  scheme_add_global ("char-array?",
                     scheme_make_prim_w_arity (mx_is_char, 
                                               "char-array?", 1, 1),
                     environment);
  scheme_add_global ("int32-array?",
                     scheme_make_prim_w_arity (mx_is_int32, 
                                               "int32-array?", 1, 1),
                     environment);
  scheme_add_global ("double-array?",
                     scheme_make_prim_w_arity (mx_is_double, 
                                               "double-array?", 1, 1),
                     environment);
  scheme_add_global ("empty-array?",
                     scheme_make_prim_w_arity (mx_is_empty, 
                                               "empty-array?", 1, 1),
                     environment);

  /***** SCHEME-PRIMITIVES: COMMUNICATE WITH MATLAB-'ENGINE'-PROCESS === */
  scheme_add_global ("engine-open",
                     scheme_make_prim_w_arity (eng_open, 
                                               "engine-open", 0, 0),
                     environment);
  scheme_add_global ("engine-close",
                     scheme_make_prim_w_arity (eng_close, 
                                               "engine-close", 0, 0),
                     environment);
  scheme_add_global ("engine-eval",
                     scheme_make_prim_w_arity (eng_eval_string, 
                                               "engine-eval", 1, 1),
                     environment);
  scheme_add_global ("engine-put",
                     scheme_make_prim_w_arity (eng_put_array, 
                                               "engine-put", 1, 2),
                     environment);
  scheme_add_global ("engine-get",
                     scheme_make_prim_w_arity (eng_get_array, 
                                               "engine-get", 1, 1),
                     environment);

  /***** SCHEME-PRIMITIVES: CONVERT STRING<->ARRAY VECTOR<->ARRAY OBJECT<->ARRAY */
  scheme_add_global ("array->string",
                     scheme_make_prim_w_arity (mx_array_to_string, 
                                               "array->string", 1, 1),
                     environment);
  scheme_add_global ("string->array",
                     scheme_make_prim_w_arity (mx_create_string, 
                                               "string->array", 1, 1),
                     environment);
  scheme_add_global ("array->vector",
                     scheme_make_prim_w_arity (array_to_vector, 
                                               "array->vector", 1, 1),
                     environment);
  scheme_add_global ("vector->array",
                     scheme_make_prim_w_arity (vector_to_array, 
                                               "vector->array", 1, 3),
                     environment);
  scheme_add_global ("array->object",
                     scheme_make_prim_w_arity (array_to_object, 
                                               "array->object", 1, 1),
                     environment);
  scheme_add_global ("object->array",
                     scheme_make_prim_w_arity (object_to_array, 
                                               "object->array", 1, 3),
                     environment);
  scheme_add_global ("matrix->array",
                     scheme_make_prim_w_arity (matrix_to_array, 
                                               "matrix->array", 1, 3),
                     environment);
  scheme_add_global ("array->matrix",
                     scheme_make_prim_w_arity (array_to_matrix, 
                                               "array->matrix", 1, 1),
                     environment);
  
  /***** SCHEME-PRIMITIVES: INFO ======================================= */
  scheme_add_global ("print-matlab-array-info",
                     scheme_make_prim_w_arity (print_matlab_array_info,
                                               "print-matlab-array-info", 0, 0),
                     environment);

#ifdef DEBUG

  /***** DEBUG ========================================================= */
  scheme_add_global ("array-index->offset",
                     scheme_make_prim_w_arity (array_index_to_offset, 
                                               "array-index->offset", 2, 2),
                     environment);
  scheme_add_global ("array-index->elnum",
                     scheme_make_prim_w_arity (array_index_to_elnum, 
                                               "array-index->elnum", 2, 2),
                     environment);
  scheme_add_global ("array-bytes-per-element",
                     scheme_make_prim_w_arity (array_bytes_per_element, 
                                               "array-bytes-per-element", 1, 1),
                     environment);
  scheme_add_global ("array-element-ref",
                     scheme_make_prim_w_arity (array_element_ref, 
                                               "array-element-ref", 2, 2),
                     environment);
  scheme_add_global ("array-element-set!",
                     scheme_make_prim_w_arity (array_element_set, 
                                               "array-element-set!", 3, 3),
                     environment);
  scheme_add_global ("matlab-eps",
                     scheme_make_prim_w_arity (matlab_eps, 
                                               "matlab-eps", 0, 0),
                     environment);
  scheme_add_global ("compatible-array?",
                     scheme_make_prim_w_arity (is_compatible_array, 
                                               "compatible-array?", 2, 2),
                     environment);
  scheme_add_global ("type-symbol->id",
                     scheme_make_prim_w_arity (debug_type_symbol_to_id, 
                                               "type-symbol->id", 1, 1),
                     environment);
  scheme_add_global ("complexity-symbol->id",
                     scheme_make_prim_w_arity (debug_complexity_symbol_to_id, 
                                               "complexity-symbol->id", 1, 1),
                     environment);
  scheme_add_global ("array-type-id",
                     scheme_make_prim_w_arity (mx_get_class_id, 
                                               "array-type-id", 1, 1),
                     environment);
  scheme_add_global ("array-type-string",
                     scheme_make_prim_w_arity (mx_get_class_name, 
                                               "array-type-string", 1, 1),
                     environment);
  scheme_add_global ("array-complexity-id",
                     scheme_make_prim_w_arity (mx_complexity_id, 
                                               "array-complexity-id", 1, 1),
                     environment);
  scheme_add_global ("array-complexity-string",
                     scheme_make_prim_w_arity (mx_complexity_name,
                                               "array-complexity-string", 1, 1),
                     environment);
  scheme_add_global ("matrix-shape",
                     scheme_make_prim_w_arity (matrix_shape,
                                               "matrix-shape", 1, 1),
                     environment);
  
  
  /***** PLAYGROUND ==================================================== */
  scheme_add_global ("playground-eat-memory",
                     scheme_make_prim_w_arity (playground_eat_memory, 
                                               "playground-eat-memory", 1, 1),
                     environment);
#endif

#ifdef PLTMOD
  scheme_finish_primitive_module (environment);
#endif

  return scheme_void;
}

Scheme_Object*
scheme_module_name ()
{
#ifdef PLTMOD
  return scheme_intern_symbol ("primitive");
#endif
#ifdef PLTRAW
  return scheme_void;
#endif
}


/***** CREATE OR TERMINATE SCHEME-ARRAY ================================ */

/* (type-symbol-to-id <symbol>) -> int */
static mxClassID
type_symbol_to_id (Scheme_Object *type)
{
  if (scheme_eq (type, scheme_intern_symbol ("cell"))) return mxCELL_CLASS;
  else if (scheme_eq (type, scheme_intern_symbol ("char"))) return mxCHAR_CLASS;
  else if (scheme_eq (type, scheme_intern_symbol ("double"))) return mxDOUBLE_CLASS;
  else if (scheme_eq (type, scheme_intern_symbol ("int32"))) return mxINT32_CLASS;
  /* Unknown type, but this must be checked safely elsewhere. */
  else return mxUNKNOWN_CLASS;
}

/* (complexity-symbol-to-id <symbol>) -> bool */
static bool
complexity_symbol_to_id (Scheme_Object *complexity)
{
  if (scheme_eq (complexity, scheme_intern_symbol ("real"))) return mxREAL;
  else if (scheme_eq (complexity, scheme_intern_symbol ("complex"))) return mxCOMPLEX;
  /* Unknown complexity, but this must be checked safely elsewhere. */
  else return -1;
}

/* (create_numeric_array <ndim> <dimarray> <type_id> <complexity_id>) -> mx_array */
static mxArray*
create_numeric_array (int ndim, 
                      int *dimarray, 
                      mxClassID type_id, 
                      bool complexity_id)
{
  mxArray *mx_array;
  
  if (! IS_COMPATIBLE_MXARRAY (type_id, complexity_id))
    scheme_signal_error ("create_numeric_array: " 
                         "arrays with type-id %d and complexity-id %d "
                         "are not yet interfaced.",
                         type_id, complexity_id);
  /* mxArray-CREATOR */
  mx_array = mxCreateNumericArray (ndim, dimarray, type_id, complexity_id);
  if (mx_array == NULL)
    scheme_signal_error ("create_numeric_array: " 
                         "Not enough memory to allocate mxArray.");
  return mx_array;
}

/* (create_ss_array <mxArray>)
   Allocate and return ssArray that contains <mxArray>. */
static Scheme_Object*
create_ss_array (mxArray* mx_array)
{
  Scheme_Object *o;
  mxClassID mx_type;
  bool mx_complexity;

  /* Finale Qualitaetssicherung. 
     Reject interface-uncompatible mxArrays here. */
  if (mx_array == NULL)
    scheme_signal_error ("create_ss_array: " 
                         "called with void array.");
  mx_type = mxGetClassID (mx_array);
  mx_complexity = mxIsComplex (mx_array);
  if (! IS_COMPATIBLE_MXARRAY (mx_type, mx_complexity))
    scheme_signal_error ("create_ss_array: " 
                         "called with uncompatible array.");

  o = (Scheme_Object*) scheme_malloc_fail_ok (scheme_malloc_atomic,
                                              sizeof (ssArray));
  o->type = ssArray_type;
  ((ssArray*) o)->mx_array = mx_array;
  scheme_register_finalizer (o, finalise_ss_array, NULL, NULL, NULL);
  return o;
}

/* (terminate_ss_array <ssArray>)
   Before ssArray is garbage-collected, free memory of mxArray in
   <ssArray>. */
static void
terminate_ss_array (Scheme_Object *o)
{
  if (MXARRAY_P (o)) {
#ifdef DEBUG
    scheme_warning ("terminate_ss_array: Free mxArray.");
#endif
    mxDestroyArray (MXARRAY_PTR (o));
    MXARRAY_PTR (o) = NULL;
    o->type = ssZombieArray_type;
  }
  else scheme_warning ("terminate_ss_array: "
                       "Attempt to finalise non-existent mxArray.");
}

/* (finalise_ss_array <object> <data>)
   General finaliser: Pass ssArray <object> on to terminate_ss_array. */
static void
finalise_ss_array (void *o, void *d)
{
  terminate_ss_array ((Scheme_Object *) o);
}

/* (engine_atexit) 
   fixme20021105 */
void
engine_atexit (Scheme_Object *o, Scheme_Close_Custodian_Client *f, void *d) 
{
  if (ep != NULL) {
    engClose (ep);
    ep = NULL;
  }
}


/***** MAKE-ARRAY ARRAY-SET! AND ARRAY-REF C-HELPERS =================== */

/* (dimarray_set <shape>) -> -
   Convert each element of <shape> to an int and save the result in
   the extension-global variable dimarray. Return number-of-dimensions.
   <shape> is a vector of scheme-integers.
   Signal an error if:
   - (1) <shape> contains more elements than MAX_NUMBER_OF_DIMENSIONS.
   or for any element of <shape>:
   - (2) the element is not an integer.
   - (3) the conversion is not possible.
   - (4) the result of the conversion is lesser than one. */
static int
dimarray_set (Scheme_Object *shape)
{
  int i, ndim;
  Scheme_Object **ss_dims;
  
  if (! SCHEME_VECTORP (shape))
    scheme_wrong_type ("dimarray_set", "vector", 0, 1, &shape);

  ndim = SCHEME_VEC_SIZE (shape);
  ss_dims = SCHEME_VEC_ELS (shape);

  /* (1) */
  if (ndim > MAX_NUMBER_OF_DIMENSIONS)
    scheme_signal_error ("dimarray_set: Wanted %d dimensions. "
                         "Not more than %d dimensions possible. "
                         "You may want to adjust 'MAX_NUMBER_OF_DIMENSIONS' "
                         "and recompile.",
                         ndim, MAX_NUMBER_OF_DIMENSIONS);
  
  for (i = 0; i < ndim; i++) {

    /* (2) (3) */
    if (! SCHEME_INTP (ss_dims [i]))
      scheme_wrong_type ("dimarray_set", 
                         "Fixnum-Integer.", 0, 1, &shape);
    dimarray [i] = SCHEME_INT_VAL (ss_dims [i]);
    
    /* (4) */
    if (dimarray [i] < 0)
      scheme_signal_error ("dimarray_set: Dimension %d negative.", 
                           i + 1);
  }

  return ndim;
}

/* (dimarray_take_matrix_shape <matrix>) -> integer
   Set dimarray to the shape of <matrix> and return number-of-dimensions 
   of <matrix>.
   <matrix> is a nesting of vectors that implements a multidimensional 
   matrix in scheme. The innermost vector corresponds to the first
   dimension.
   Nesting-depth must not exceed MAX_NUMBER_OF_DIMENSIONS.
   Vectors of one dimension must be of the same length. */
static int
dimarray_take_matrix_shape (Scheme_Object *matrix)
{
  if (! SCHEME_VECTORP (matrix)) 
    scheme_wrong_type ("dimarray_take_matrix_shape", "vector", 0, 1, &matrix);

  return dimarray_take_matrix_shape_rec (0, matrix);
}

/* Recursive helper-function of 'dimarray_take_matrix_shape'. */
static int
dimarray_take_matrix_shape_rec (int n, Scheme_Object *matrix)
{
  if (SCHEME_VECTORP (matrix))
    if (0 <= n < MAX_NUMBER_OF_DIMENSIONS) {
      dimarray [n] = SCHEME_VEC_SIZE (matrix);
      return dimarray_take_matrix_shape_rec (n + 1, SCHEME_VEC_ELS (matrix) [0]);
    }
    else scheme_signal_error ("dimarray_take_matrix_shape_rec: "
                              "Not more than %d dimensions possible. "
                              "You may want to adjust 'MAX_NUMBER_OF_DIMENSIONS' "
                              "and recompile.",
                              MAX_NUMBER_OF_DIMENSIONS);
  dimarray_reverse (n);
  return n;
}

/* (dimarray_reverse <len>)
   Reverse the first <len> integers of dimarray. */
static void
dimarray_reverse (int n)
{
  int 
    rising = 0, 
    falling = n - 1, 
    tmp = 0;
  
  while (rising < falling) {
    tmp = dimarray [rising];
    dimarray [rising] = dimarray [falling];
    dimarray [falling] = tmp;
    ++ rising;
    -- falling;
  }
}

/* (idxarray_set_and_check <index> <number-of-dimensions> <dimarray>) -> -
   Convert each element of <index> to an int and save the result
   in the extension-global variable idxarray. The result must not be
   equal-to or greater-than the corresponding element of <dimarray>.
   <index> is a vector of scheme-integers.
   <number-of-dimensions> is an int.
   <dimarray> is a vector of int.
   Signal an error if:
   - (1a) <index> does not contain <number-of-dimensions> elements.
   or for any element of <index>:
   - (1b) <index> contains more elements than MAX_NUMBER_OF_DIMENSIONS.
   - (2) the element is not an integer.
   - (3) the conversion is not possible.
   - (4) the result of the conversion is lesser-than zero or equal-to or 
   greater-than the corresponding element of <dimarray>. */
static void
idxarray_set_and_check (Scheme_Object *index, int ndim, const int* dims)
{
  int i, nidx;
  Scheme_Object **ss_idxv;
  
  if (! SCHEME_VECTORP (index))
    scheme_wrong_type ("idxarray_set_and_check", "vector", 0, 1, &index);

  nidx = SCHEME_VEC_SIZE (index);
  ss_idxv = SCHEME_VEC_ELS (index);

  /* (1a) */
  if (nidx != ndim)
    scheme_signal_error ("idxarray_set_and_check: " 
                         "Number of index-dimensions: %d is not equal to "
                         "number of array-dimensions: %d.", 
                         nidx, ndim);
  /* (1b) */
  if (nidx > MAX_NUMBER_OF_DIMENSIONS)
    scheme_signal_error ("idxarray_set_and_check: Wanted %d dimensions. "
                         "Not more than %d dimensions possible. "
                         "You may want to adjust 'MAX_NUMBER_OF_DIMENSIONS' "
                         "and recompile.",
                         nidx, MAX_NUMBER_OF_DIMENSIONS);
  
  for (i = 0; i < nidx; i++) {
    
    /* (2) (3) */
    if (! SCHEME_INTP (ss_idxv [i]))
      scheme_wrong_type ("idxarray_set_and_check: ", 
                         "Fixnum-Integer", 0, 1, &index);
    idxarray [i] = SCHEME_INT_VAL (ss_idxv [i]);
 
    /* (4) */
    if (idxarray [i] < 0 || dims [i] <= idxarray [i])
      scheme_signal_error ("idxarray_set_and_check: "
                           "Dimension %d: Index outside array-boundaries. "
                           "Index: %d. Legal index-range:  0 ... %d.",
                           i + 1, idxarray [i], dims [i] - 1);
  }
}

/* (mxarray_index_to_offset <array> <index>)
   Offset: Number of storage-bytes in memory that the <index>ed element
   of <array> is away from the first element of <array>. */
static int
mxarray_index_to_offset (mxArray* mx_array, Scheme_Object *index)
{
  int ndim = mxGetNumberOfDimensions (mx_array);
  idxarray_set_and_check (index, ndim, mxGetDimensions (mx_array));
  return mxGetElementSize (mx_array) * mxCalcSingleSubscript (mx_array, ndim, idxarray);
}

/* (mxarray_index_to_elnum <array> <index>)
   Elnum: Number of storage-places in memory that the <index>ed element
   of <array> is away from the first element of <array>. */
static int
mxarray_index_to_elnum (mxArray* mx_array, Scheme_Object *index)
{
  int ndim = mxGetNumberOfDimensions (mx_array);
  idxarray_set_and_check (index, ndim, mxGetDimensions (mx_array));
  return mxCalcSingleSubscript (mx_array, ndim, idxarray);
}

/* (arrayel_get_with_offset <array> <arrayel-struct> <offset>) -> -
   Set pointers of <arrayel-struct> to real and (optional: imaginary) 
   values of the element of <array> that - in memory - is <offset> 
   storage-bytes away from the first element of <array>.
   Then, any mutation of the references of these pointers will result in a
   mutation of the element itself. */
static void
arrayel_get_with_offset (mxArray* mx_array, 
                         Array_Element* element, 
                         int offset)
{
#ifdef DEBUG
  /* Access by index: idxarray_set_and_check is secure enough. */
  /* This check is needed for access by raw memory-offset, only */
  if (offset < 0 || 
      mxGetElementSize (mx_array) * mxGetNumberOfElements (mx_array)
      <= offset)
    scheme_signal_error ("arrayel_get_with_offset: "
                         "Value outside of array-storage. "
                         "Offset of value: %d. "
                         "Offset of last array-element: %d.",
                         offset,
                         mxGetElementSize (mx_array) 
                         * (mxGetNumberOfElements (mx_array) - 1));
#endif

  /* SET POINTERS HERE */
  element->real = (void*) ((long) mxGetData (mx_array) + offset);
  if (mxIsComplex (mx_array))
    element->imag = (void*) ((long) mxGetImagData (mx_array) + offset);
  else
    element->imag = NULL;
  element->storage_class = mxGetClassID (mx_array);
  element->complex_p = mxIsComplex (mx_array);
}

/* (arrayel_get_with_index <array> <arrayel-struct> <index>) -> -
   Set pointers of <arrayel-struct> to real and (optional: imaginary) 
   values of the <index>ed element of <array>. 
   Then, any mutation of the references of these pointers will result in a
   mutation of the element itself. */
static void
arrayel_get_with_index (mxArray* mx_array,
                        Array_Element* element,
                        Scheme_Object* index)
{
  arrayel_get_with_offset (mx_array,
                           element,
                           mxarray_index_to_offset (mx_array, index));
}


/***** CONVERT SCHEME->MATLAB ========================================== */

void
set_dummy (void* dum, void* dumm, Scheme_Object* dummy)
{}

/* (set_(complexity)_(type) <real-ptr> <imag-ptr> <scheme-value>)
   Switcher checks complexity and type of matlab-array and returns one of 
   the following converter-setters which convert a <scheme-value> to a
   the real and (optionally) complex part of a matlab-value which are then
   injected into the array. */

void
set_real_cell (void* real, void* imag, Scheme_Object* value)
{ 
  if (SCHEME_COMPLEXP (value))
    scheme_wrong_type ("set_real_cell", "non-complex value", 0, 1, &value);
  if (MXARRAY_P (value)) {
    /* FIXME-REF */
    /* mxArray-CREATOR: destroy old array, create copy of new, don't pass a
       reference. Reason: Two objects would point to one array. If one
       of them (object and array) gets garbage-collected, the other 
       points straight into nirvana. */
    mxDestroyArray (*((mxArray**) real)); /* <===O */
    /* FIXME: what happens when duplicate-array fails? */
    *((mxArray**) real) = mxDuplicateArray (MXARRAY_PTR (value)); /* <===O */
  }
  else scheme_wrong_type ("set_real_cell", "array", 0, 1, &value);
}

void
set_real_char (void* real, void* imag, Scheme_Object* value)
{   
  if (SCHEME_COMPLEXP (value))
    scheme_wrong_type ("set_real_char", "non-complex value", 0, 1, &value);
  if (SCHEME_CHARP (value))
    *((mxChar*) real) = (mxChar) SCHEME_CHAR_VAL (value); /* <===O */
  else scheme_wrong_type ("set_real_char", "char", 0, 1, &value);
}

void
set_real_double (void* real, void* imag, Scheme_Object* value)
{ 
  if (SCHEME_COMPLEXP (value))
    scheme_wrong_type ("set_real_double", "non-complex value", 0, 1, &value);
  if (SCHEME_REALP (value))
    *((double*) real) = scheme_real_to_double (value); /* <===O */
  else scheme_wrong_type ("set_real_double", "real", 0, 1, &value);
}

void
set_real_int32 (void* real, void* imag, Scheme_Object* value)
{ 
  if (SCHEME_COMPLEXP (value))
    scheme_wrong_type ("set_real_int32", "non-complex value", 0, 1, &value);
  if (! SCHEME_EXACT_INTEGERP (value))
    scheme_wrong_type ("set_real_int32", "integer", 0, 1, &value);
  if (scheme_get_int_val (value, (long*) real) == 0) /* <===O */
    scheme_signal_error ("Number does not fit into int."); 
}

void
set_complex_double (void* real, void* imag, Scheme_Object* value)
{ 
  if (SCHEME_COMPLEXP (value)) {
    *((double*) real) = scheme_real_to_double (scheme_complex_real_part (value)); /* <===O */
    *((double*) imag) = scheme_real_to_double (scheme_complex_imaginary_part (value)); /* <===O */
  } 
  else if (SCHEME_REALP (value)) {
    *((double*) real) = scheme_real_to_double (value); /* <===O */
    *((double*) imag) = 0.0;
  }
  else
    scheme_wrong_type ("set_complex_double", "number", 0, 1, &value);    
}

ss_to_mx_setter
ss_to_mx_setter_switch (int storage_class, int complex_p)
{
  if (! complex_p) {
    switch (storage_class) {
    case mxCELL_CLASS:      
      return &set_real_cell;
      break;
    case mxCHAR_CLASS:
      return &set_real_char;
      break;
    case mxDOUBLE_CLASS:
      return &set_real_double;
      break;
    case mxINT32_CLASS:
      return &set_real_int32;
      break;
    default:
      scheme_signal_error ("ss_to_mx_setter_switch: "
                           "Noncomplex array must be of type "
                           "'cell', 'char', 'double' or 'int32'.");
    }
    return &set_dummy; /* satisfy compiler */
  }
  else {
    switch (storage_class) {
    case mxDOUBLE_CLASS:
      return &set_complex_double;
      break;
    case mxINT32_CLASS:
    default:
      scheme_signal_error ("ss_to_mx_setter_switch: "
                           "Complex arrays must be of type 'double'.");
    }
    return &set_dummy; /* satisfy compiler */
  }
}

/* (arrayel_set_convert <arrayel-struct>  <value>)
   The pointers of <arrayel-struct> point to the real and
   (optional: imaginary) value of one element of an mxArray.
   Convert <value> from Scheme to C and set the element to the result. 
   Conversion and setting is done by the 'setter'. Several setters exist. 
   Depending on the type of the array 'ss_to_mx_setter_switch' returns
   the appropriate setter-function. */
static void
arrayel_set_convert (Array_Element* element, Scheme_Object* value)
{
  ss_to_mx_setter 
    setter = ss_to_mx_setter_switch (element->storage_class,
                                     element->complex_p);
  (*setter) (element->real, element->imag, value);
  return;
}

/* (mxarray_set_with_vector <mxArray> <vector>) -> unspecified
   The elements of mxArrays are stored in one long vector in memory - no 
   matter how many dimensions mxArray may have.
   Set each element of <mxArray> to the corresponding element of <vector>. */
static void
mxarray_set_with_vector (mxArray* mx_array, Scheme_Object* vector)
{
  ss_to_mx_setter
    setter = ss_to_mx_setter_switch (mxGetClassID (mx_array),
                                     mxIsComplex (mx_array));
  int
    i = 0,
    size = mxGetElementSize (mx_array),
    length = mxGetNumberOfElements (mx_array);

  long
    real = 0,
    imag = 0;

  Scheme_Object
    **vecels = NULL;

  if ((! SCHEME_VECTORP (vector)) ||
      (length != SCHEME_VEC_SIZE (vector)))
    scheme_signal_error ("mxarray_set_with_vector: "
                         "Number of elements in array: %d is not equal to "
                         "number of elements in vector: %d",
                         length, SCHEME_VEC_SIZE (vector));

  vecels = SCHEME_VEC_ELS (vector);

  if (mxIsComplex (mx_array))
    for (i = 0, real = ((long) mxGetData (mx_array)), imag = ((long) mxGetImagData (mx_array));
         i < length;
         i++, real += size, imag += size)
      (*setter) ((void*) real, (void*) imag, vecels [i]);
  else
    for (i = 0, real = ((long) mxGetData (mx_array));
         i < length;
         i++, real += size)
      (*setter) ((void*) real, NULL, vecels [i]);
}

/* (mxarray_fill_with_object <mxArray> <object>) -> unspecified
   The elements of mxArrays are stored in one long vector in memory - no 
   matter how many dimensions mxArray may have.
   Set each element of <mxArray> to <object>. 
   FIXME: unefficient, convert <object> once, only. */
static void
mxarray_fill_with_object (mxArray* mx_array, Scheme_Object* object)
{
  ss_to_mx_setter
    setter = ss_to_mx_setter_switch (mxGetClassID (mx_array),
                                     mxIsComplex (mx_array));
  long
    real = ((long) mxGetData (mx_array)),
    imag = 0,
    size = mxGetElementSize (mx_array),
    brim = real + size * mxGetNumberOfElements (mx_array);
  
  if (mxIsComplex (mx_array))
    for (imag = ((long) mxGetImagData (mx_array));
         real < brim; 
         real += size, imag += size)
      (*setter) ((void*) real, (void*) imag, object);
  else
    for ( ; 
          real < brim; 
          real += size)
      (*setter) ((void*) real, NULL, object);
}

/* (scalar_mxarray_set_with_object <mxArray> <object>) -> unspecified
   <mxArray> contains one element. This element is set to <object>. */
static void
scalar_mxarray_set_with_object (mxArray* mx_array, Scheme_Object* object)
{
  ss_to_mx_setter
    setter = ss_to_mx_setter_switch (mxGetClassID (mx_array),
                                     mxIsComplex (mx_array));
  if (mxIsComplex (mx_array))
    (*setter) (mxGetData (mx_array), mxGetImagData (mx_array), object);
  else
    (*setter) (mxGetData (mx_array), NULL, object);
}

/* (mxarray_set_with_matrix <mxArray> <matrix>) -> unspecified
   Set every value of <mxArray> to the corresponding value of <matrix>.
   <matrix> is a nesting of vectors that implements a multidimensional 
   matrix in scheme. The innermost vector corresponds to the first
   dimension. */
static void
mxarray_set_with_matrix (mxArray* mx_array, Scheme_Object* matrix, int ndim)
{
  ss_to_mx_setter
    setter = ss_to_mx_setter_switch (mxGetClassID (mx_array),
                                     mxIsComplex (mx_array));
  mxarray_set_with_matrix_rec (mx_array, setter, matrix, ndim - 1, 0);
}

/* Recursive helper-function of mxarray_set_with_matrix. */
static int
mxarray_set_with_matrix_rec (mxArray* mx_array,
                             ss_to_mx_setter setter,
                             Scheme_Object* matrix,
                             int n,
                             int elnum)
{
  int i, size;
  long real, imag;

  if (! SCHEME_VECTORP (matrix))
    scheme_signal_error ("mxarray_set_with_matrix_rec: "
                         "The nesting-depth of the nested-vector-matrix "
                         "must not vary.");
  
  if (SCHEME_VEC_SIZE (matrix) != mxGetDimensions (mx_array) [n])
    scheme_signal_error ("mxarray_set_with_matrix_rec: " 
                         "In dimension %d: vector-length = %d, size-of-array = %d. "
                         "There should be no difference between those two.",
                         n, SCHEME_VEC_SIZE (matrix), mxGetDimensions (mx_array) [n]);
  if (n == 0) {
    size = mxGetElementSize (mx_array);
    if (mxIsComplex (mx_array)) {
      for (i = 0, 
             real = ((long) mxGetData (mx_array)) + elnum * size,
             imag = ((long) mxGetImagData (mx_array)) + elnum * size;
           i < SCHEME_VEC_SIZE (matrix);
           i ++, elnum ++, real += size, imag += size)
        (*setter) ((void*) real, (void*) imag, SCHEME_VEC_ELS (matrix) [i]);
      return elnum;
    }
    else {
      for (i = 0, real = ((long) mxGetData (mx_array)) + elnum * size;
           i < SCHEME_VEC_SIZE (matrix);
           i ++, elnum ++, real += size)
        (*setter) ((void*) real, NULL, SCHEME_VEC_ELS (matrix) [i]);
      return elnum;
    }
  }
  else {
    for (i = 0; i < SCHEME_VEC_SIZE (matrix); i++)
      elnum = mxarray_set_with_matrix_rec 
        (mx_array, setter, SCHEME_VEC_ELS (matrix) [i], n - 1, elnum);
    return elnum;
  }
}


/***** CONVERT MATLAB->SCHEME ========================================== */

static Scheme_Object*
convert_dummy (void* dum, void* my)
{ return scheme_void; }

static Scheme_Object*
convert_real_cell (void* real, void* imag)
{ 
  if (*((mxArray**) real) == NULL)
    return scheme_false; /* be forgiving */
  /* mxArray-CREATOR */
  /* FIXME-REF */
  /* FIXME: what happens when duplicate-array fails? */
  return create_ss_array (mxDuplicateArray (*((mxArray**) real))); /* <===O */
}

static Scheme_Object*
convert_real_char (void* real, void* imag)
{ return scheme_make_char (*((char*) real)); /* <===O */
 /* return scheme_make_char ((char) *((mxChar*) real)); */ }

static Scheme_Object*
convert_real_double (void* real, void* imag)
{ return scheme_make_double (*((double*) real)); /* <===O */ }

static Scheme_Object*
convert_real_int32 (void* real, void* imag)
{ return scheme_make_integer_value (*((int*) real)); /* <===O */ }

static Scheme_Object*
convert_complex_double (void* real, void* imag)
{ return scheme_make_complex (scheme_make_double (*((double*) real)),
                              scheme_make_double (*((double*) imag))); /* <===O */}

mx_to_ss_converter
mx_to_ss_converter_switch (int storage_class, int complex_p)
{
  if (!(complex_p)) {
    switch (storage_class) {
    case mxCELL_CLASS:
      return &convert_real_cell;
      break;
    case mxCHAR_CLASS:
      return &convert_real_char;
      break;
    case mxDOUBLE_CLASS:
      return &convert_real_double;
      break;
    case mxINT32_CLASS:
      return &convert_real_int32;
      break;
    default:
      scheme_signal_error ("mx_to_ss_converter_switch: Array is not of type "
                           "'cell', 'char', 'double' or 'int32'.");
      return &convert_dummy; /* satisfy compiler */
    }
  }
  else {
    switch (storage_class) {
    case mxDOUBLE_CLASS:
      return &convert_complex_double;
      break;
    case mxINT32_CLASS:
    default:
      scheme_signal_error ("mx_to_ss_converter_switch: Complex arrays " 
                           "are restricted to type 'double'");
      return &convert_dummy; /* satisfy compiler */
    }
  }
}

/* (convert_arrayel_ref <arrayel-struct) -> <value>
   The pointers of <arrayel-struct> point to the real and
   (optional: imaginary) value of one element of an mxArray.
   Return the Scheme-<value>, that is equal to this element. 
   Conversion is done by the 'converter'.  Several converters exist.
   Depending on the type of the array 'mx_to_ss_converter_switch' returns 
   the appropriate converter. */
static Scheme_Object*
convert_arrayel_ref (Array_Element* element)
{
  mx_to_ss_converter converter;
  converter = mx_to_ss_converter_switch (element->storage_class,
                                         element->complex_p);
  return (*converter) (element->real, element->imag);
}

/* (mxarray_to_vector <mxArray>) -> <vector>
   Each element of <vector> is equal to the corresponding element of
   <mxArray>. */
static Scheme_Object*
mxarray_to_vector (mxArray *mx_array)
{
  mx_to_ss_converter 
    converter = mx_to_ss_converter_switch (mxGetClassID (mx_array),
                                           mxIsComplex (mx_array));
  int
    i = 0,
    size = mxGetElementSize (mx_array),
    length = mxGetNumberOfElements (mx_array);
  
  long
    real = 0,
    imag = 0;
  
  Scheme_Object
    *vector = scheme_make_vector (length, scheme_null),
    **vecels = SCHEME_VEC_ELS (vector);

  if (mxIsComplex (mx_array))
    for (i = 0, real = ((long) mxGetData (mx_array)), imag = ((long) mxGetImagData (mx_array));
         i < length;
         i++, real += size, imag += size)
      vecels [i] = (*converter) ((void*) real, (void*) imag);
  else
    for (i = 0, real = ((long) mxGetData (mx_array));
         i < length;
         i++, real += size)
      vecels [i] = (*converter) ((void*) real, NULL);
  
  return vector;
}

/* (mxarray_to_object <mxArray>) -> object
   Convert and return the single element of <mxArray>. */
static Scheme_Object*
mxarray_to_object (mxArray *mx_array)
{
  mx_to_ss_converter 
    converter = mx_to_ss_converter_switch (mxGetClassID (mx_array),
                                           mxIsComplex (mx_array));
  if (mxIsComplex (mx_array))
    return (*converter) (mxGetData (mx_array), mxGetImagData (mx_array));
  else
    return (*converter) (mxGetData (mx_array), NULL);
}

/* (mxarray_to_matrix <mxArray>) -> matrix */
static Scheme_Object*
mxarray_to_matrix (mxArray *mx_array)
{
  Scheme_Object *vector = NULL;
  
  mx_to_ss_converter 
    converter = mx_to_ss_converter_switch (mxGetClassID (mx_array),
                                           mxIsComplex (mx_array));
  mxarray_to_matrix_rec (mx_array, 
                         converter,
                         &vector,
                         mxGetNumberOfDimensions (mx_array) - 1, 
                         0);
  return vector;
}

/* Recursive helper-function of mxarray_to_matrix. */
static int
mxarray_to_matrix_rec (mxArray *mx_array,
                       mx_to_ss_converter converter,
                       Scheme_Object **vector_ptr,
                       int n,
                       int elnum)
{
  int i, size;
  long real, imag;

  *vector_ptr = scheme_make_vector (mxGetDimensions (mx_array) [n], NULL);

  if (n == 0) {
    size = mxGetElementSize (mx_array);
    if (mxIsComplex (mx_array)) {
      for (i = 0, 
             real = ((long) mxGetData (mx_array)) + elnum * size,
             imag = ((long) mxGetImagData (mx_array)) + elnum * size;
           i < SCHEME_VEC_SIZE (*vector_ptr);
           i ++, elnum ++, real += size, imag += size)
        SCHEME_VEC_ELS (*vector_ptr) [i] = (*converter) ((void*) real, (void*) imag);
      return elnum;
    }
    else {
      for (i = 0, real = ((long) mxGetData (mx_array)) + elnum * size;
           i < SCHEME_VEC_SIZE (*vector_ptr);
           i ++, elnum ++, real += size)
        SCHEME_VEC_ELS (*vector_ptr) [i] = (*converter) ((void*) real, NULL);
      return elnum;
    }
  }
  else {
    for (i = 0; i < SCHEME_VEC_SIZE (*vector_ptr); i++)
      elnum = mxarray_to_matrix_rec
        (mx_array, converter, SCHEME_VEC_ELS (*vector_ptr) + i, n - 1, elnum);
    return elnum;
  }
}


/***** SCHEME-PRIMITIVES: MAKE-ARRAY =================================== */

/* (make-cell-array #(dim-x dim-y ...) [object]) -> array
   (make-cell-array #(2 10)) => 2x10-Array-of-Arrays.*/
static Scheme_Object*
mx_create_cell_array (int argc, Scheme_Object *argv [])
{
  int ndim = dimarray_set (argv [0]);
  
  /* mxArray-CREATOR */
  mxArray* mx_array = mxCreateCellArray (ndim, dimarray);
  if (mx_array == NULL)
    scheme_signal_error ("mx_create_cell_array: " 
                         "Not enough memory to allocate mxArray.");
  if (argc == 2)
    mxarray_fill_with_object (mx_array, argv [1]);

  return create_ss_array (mx_array);
}

/* (make-char-array #(dim-x dim-y ...) [object]) -> array */
static Scheme_Object*
mx_create_char_array (int argc, Scheme_Object *argv [])
{
  int ndim = dimarray_set (argv [0]);
  
  /* mxArray-CREATOR */
  mxArray* mx_array = mxCreateCharArray (ndim, dimarray);
  if (mx_array == NULL)
    scheme_signal_error ("mx_create_char_array: " 
                         "Not enough memory to allocate mxArray.");
  if (argc == 2)
    mxarray_fill_with_object (mx_array, argv [1]);

  return create_ss_array (mx_array);
}

/* (make-array #(dim-x dim-y ...) [type-symbol] [complexity-symbol] [object]) -> array
   (make-array #(3 20) 'double 'real) => 3x20-noncomplex-double-array */
static Scheme_Object*
mx_create_numeric_array (int argc, Scheme_Object *argv []) 
{
  int ndim; 
  mxArray* mx_array;
  mxClassID type_id;
  bool complexity_id;

  ndim = dimarray_set (argv [0]);

  if (argc >= 2)
    if (! SCHEME_SYMBOLP (argv [1]))
      scheme_wrong_type ("mx_create_numeric_array", "symbol", 1, argc, argv);
    else
      type_id = type_symbol_to_id (argv [1]);
  else
    type_id = mxDOUBLE_CLASS;

  if (argc >= 3)
    if (! SCHEME_SYMBOLP (argv [2]))
      scheme_wrong_type ("mx_create_numeric_array", "symbol", 2, argc, argv);
    else
      complexity_id = complexity_symbol_to_id (argv [2]);
  else
    complexity_id = mxREAL;

  /* mxArray-CREATOR */
  mx_array = create_numeric_array (ndim, dimarray, type_id, complexity_id);
  if (mx_array == NULL)
    scheme_signal_error ("mx_create_numeric_array: " 
                         "Not enough memory to allocate mxArray.");
  if (argc == 4)
    mxarray_fill_with_object (mx_array, argv [3]);
  
  return create_ss_array (mx_array);
}

/* (array-clone <array>) -> array */
static Scheme_Object*
mx_duplicate_array (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_duplicate_array", "array", 0, argc, argv);
 
  return create_ss_array (mxDuplicateArray (MXARRAY_PTR (argv [0])));
}


/***** SCHEME-PRIMITIVES: ARRAY-NAME -SHAPE -SET! AND -REF ============= */


/* (array-name <array> [string]) -> string
   If [string] is specified, set name of <array> to [string].
   If [string] is not specified return name of <array>. */
static Scheme_Object*
mx_get_or_set_name (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_get_or_set_name", "array", 0, argc, argv);
  
  if (argc == 1)
    return scheme_make_string (mxGetName (MXARRAY_PTR (argv[0])));
  
  if (! SCHEME_STRINGP (argv[1]))
    scheme_wrong_type ("mx_set_or_set_name", "string", 1, argc, argv);

  mxSetName (MXARRAY_PTR (argv[0]), SCHEME_STR_VAL (argv[1]));
  return (argv[1]);
}

/* (array-rank array): Array -> Integer
   Number of dimensions of array. */
static Scheme_Object*
mx_get_number_of_dimensions (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_get_number_of_dimensions", 
                       "array", 0, argc, argv);
  
  return scheme_make_integer_value
    ((long) mxGetNumberOfDimensions (MXARRAY_PTR (argv [0])));
}

/* (array-size array): Array -> Integer
   Number of elements of array. */
static Scheme_Object*
mx_get_number_of_elements (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_get_number_of_elements", 
                       "array", 0, argc, argv);
    
  return scheme_make_integer_value 
    ((long) mxGetNumberOfElements (MXARRAY_PTR (argv [0])));
}

/* (array-shape <array>): ssArray -> Vector
   Integer-Vector that - for each dimension of array - contains the number 
   of elements. */
static Scheme_Object*
mx_get_dimensions (int argc, Scheme_Object *argv [])
{
  mxArray* mx_array;
  Scheme_Object* vector;
  const int* dims;
  int i, ndim;
  
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_get_dimensions", "array", 0, argc, argv);
  
  mx_array = MXARRAY_PTR (argv [0]);
  ndim = mxGetNumberOfDimensions (mx_array);
  dims = mxGetDimensions (mx_array);

  vector = scheme_make_vector (ndim, scheme_void);
  for (i = 0; i < ndim; i++)
    SCHEME_VEC_ELS (vector) [i] = scheme_make_integer_value ((long) dims [i]);

  return vector;
}

/* (array-set! <array> <index-vector> <value>) -> unspecified */
static Scheme_Object*
array_set (int argc, Scheme_Object *argv []) 
{
  Array_Element element = {0, 0, NULL, NULL};

  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("array_set", "array", 0, argc, argv);

  arrayel_get_with_index (MXARRAY_PTR (argv [0]), &element, argv [1]);
  arrayel_set_convert (&element, argv [2]);
  
  return scheme_void;
}

/* (array-ref <array> <index-vector>) */
static Scheme_Object*
array_ref (int argc, Scheme_Object* argv [])
{
  Array_Element element = {0,0,NULL,NULL};

  if (! MXARRAY_P (argv [0]))
    scheme_wrong_type ("array_ref", "array", 0, argc, argv);
  
  arrayel_get_with_index (MXARRAY_PTR (argv [0]), &element, argv [1]);
  return convert_arrayel_ref (&element);
}

/* (array-fill! <array> <object>) -> unspecified */
static Scheme_Object*
array_fill (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("array_fill", "array", 0, argc, argv);

  mxarray_fill_with_object (MXARRAY_PTR (argv [0]), argv [1]);
  return scheme_void;
}


/***** SCHEME-PRIMITIVES: ARRAY-TYPE AND COMPLEXITY ==================== */

/* (array-type-symbol <array>) -> symbol
   Common symbolic name of the storage-type of each element of <array>. */
static Scheme_Object*
mx_get_class_symbol (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_get_class_name", "array", 0, argc, argv);

  return scheme_intern_symbol (mxGetClassName (MXARRAY_PTR (argv[0])));
}

/* (array-complexity <array>) -> symbol */
static Scheme_Object*
mx_complexity_symbol (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_complexity_symbol", "array", 0, argc, argv);

  if (mxIsComplex (MXARRAY_PTR (argv[0])))
    return scheme_intern_symbol ("complex");
  else
    return scheme_intern_symbol ("real");
}


/***** SCHEME-PRIMITIVES: PREDICATES =================================== */

/* (array? <value>) -> boolean */
static Scheme_Object*
mx_is_array (int argc, Scheme_Object *argv [])
{
  if (MXARRAY_P (argv[0])) return scheme_true;
  else return scheme_false;
}

/* (complex-array? <array>) -> <boolean> */
static Scheme_Object*
mx_is_complex (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_is_complex", "array", 0, argc, argv);

  if (mxIsComplex (MXARRAY_PTR (argv[0]))) return scheme_true;
  else return scheme_false;
}

/* (real-array? <array>) -> <boolean> */
static Scheme_Object*
mx_is_real (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_is_real", "array", 0, argc, argv);

  if (mxIsComplex (MXARRAY_PTR (argv[0]))) return scheme_false;
  else return scheme_true;
}

/* (numeric-array? <array>) -> <boolean>
   True if the array's storage type is one of: 
   '(double sparse single int8 uint8 int16 uint16 int32 uint32)
   False if the array's storage type is one of:
   '(cell char object struct unknown) */
static Scheme_Object*
mx_is_numeric (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_is_numeric", "array", 0, argc, argv);

  if (mxIsNumeric (MXARRAY_PTR (argv[0]))) return scheme_true;
  else return scheme_false;
}

/* (cell-array? <array>) -> <boolean> */
static Scheme_Object*
mx_is_cell (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_is_cell", "array", 0, argc, argv);

  if (mxIsCell (MXARRAY_PTR (argv[0]))) return scheme_true;
  else return scheme_false;
}

/* (char-array? <array>) -> <boolean> */
static Scheme_Object*
mx_is_char (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_is_char", "array", 0, argc, argv);

  if (mxIsChar (MXARRAY_PTR (argv[0]))) return scheme_true;
  else return scheme_false;
}

/* (int32-array? <array>) -> <boolean> */
static Scheme_Object*
mx_is_int32 (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_is_int32", "array", 0, argc, argv);

  if (mxIsInt32 (MXARRAY_PTR (argv[0]))) return scheme_true;
  else return scheme_false;
}

/* (double-array? <array>) -> <boolean> */
static Scheme_Object*
mx_is_double (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_is_double", "array", 0, argc, argv);

  if (mxIsDouble (MXARRAY_PTR (argv[0]))) return scheme_true;
  else return scheme_false;
}

/* (empty-array? <array>) -> <boolean> */
static Scheme_Object*
mx_is_empty (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_is_empty", "array", 0, argc, argv);

  if (mxIsEmpty (MXARRAY_PTR (argv[0]))) return scheme_true;
  else return scheme_false;
}


/***** SCHEME-PRIMITIVES: COMMUNICATE WITH MATLAB-'ENGINE'-PROCESS ===== */

/* (engine-open)
 * Opens connection to matlab-engine.
 * Return true if connection can be established, false otherwise.
 * Other engine - commands can then be used.
 * A second call starts a new engine, and stops the old one. */
static Scheme_Object*
eng_open (int argc, Scheme_Object *argv []) 
{
  Engine* new = engOpen (NULL);   /* ((windows: NULL) . (unix: "\0") */

  if (!ep && new)
    ep = new;
  else if (ep && new) {
    scheme_warning ("eng_open: Engine already open. Restart forced.");
    engClose (ep);
    ep = new;
  }
  else if (ep && !new)
    scheme_warning ("eng_open: Engine already open. Restart failed.");
  else if (!ep && !new)
    scheme_signal_error ("eng_open: Engine start failed.");

  return scheme_void;
}

/* (engine-close)
 * Close the matlab-engine. */
static Scheme_Object*
eng_close (int argc, Scheme_Object *argv []) 
{
  if (ep) {
    engClose (ep);
    ep = NULL;
  }
  else
    scheme_warning ("eng_close: No need to kill engine. It's already dead.");
   
  return scheme_void;
}

/* (engine-eval string): string -> string
 * Evaluate string in matlab-environment and print the result
 * of the evaluation in the scheme-environment.
 * (engine-eval "2 + 2") => 4
 * If there is no output in the matlab-environment, return scheme_void. */
static Scheme_Object*
eng_eval_string (int argc, Scheme_Object *argv [])
{
  if (ep == NULL)
    scheme_signal_error ("eng_eval_string: Engine offline.");
  if (! (SCHEME_STRINGP (argv[0])))
    scheme_wrong_type ("eng_eval_string", "string", 0, argc, argv);
  
  engOutputBuffer (ep, stringbuf, STRING_BUFFER_SIZE - 1);
  engEvalString (ep, SCHEME_STR_VAL (argv[0]));
  if (0 < strlen (stringbuf))
    return scheme_make_string (stringbuf);
  else
    return scheme_void;
}

/* (engine-put <mxArray> [string]) 
   If [string] is specified assign name [string] to <mxArray>.
   Put <mxArray> to the matlab-engine. */
static Scheme_Object*
eng_put_array (int argc, Scheme_Object *argv [])
{
  if (ep == NULL)
    scheme_signal_error ("eng_put_array: Engine offline.");
  if (! MXARRAY_P (argv [0]))
    scheme_wrong_type ("eng_put_array", "array", 0, argc, argv);

  if (argc == 2)
    if (! SCHEME_STRINGP (argv[1]))
      scheme_wrong_type ("eng_put_array", "string", 1, argc, argv);
    else
      mxSetName (MXARRAY_PTR (argv[0]), SCHEME_STR_VAL (argv[1]));

  engPutArray (ep, MXARRAY_PTR (argv[0]));
  return scheme_void;
}

/* (engine-get <string>): string -> array
   Get mxArray named <string> from the matlab-engine and return a newly
   allocated ssArray or signal an error if the attempt fails.
   The attempt fails if the named variable does not exist.
   All numeric arrays are imported as double. */
static Scheme_Object*
eng_get_array (int argc, Scheme_Object *argv [])
{
  mxArray* mx_array;

  if (ep == NULL)
    scheme_signal_error ("eng_get_array: Engine offline.");
  if (! SCHEME_STRINGP (argv[0]))
    scheme_wrong_type ("eng_get_array", "string", 0, argc, argv);

  /* mxArray-CREATOR */
  mx_array = engGetArray (ep, SCHEME_STR_VAL (argv [0]));
  if (mx_array == NULL)
    scheme_signal_error ("eng_get_array: No mxArray of name '%s' " 
                         "exists in matlab-environment.", 
                         SCHEME_STR_VAL (argv [0]));

  if (mxGetNumberOfDimensions (mx_array) > MAX_NUMBER_OF_DIMENSIONS)
    scheme_signal_error ("eng_get_array: Import-Array is %d-dimensional. "
                         "Not more than %d dimensions possible. "
                         "You may want to adjust 'MAX_NUMBER_OF_DIMENSIONS' "
                         "and recompile.",
                         mxGetNumberOfDimensions (mx_array),
                         MAX_NUMBER_OF_DIMENSIONS);

  /* 2002-05-08: Empty arrays are now supported. */
  /*   if (mxIsEmpty (mx_array)) */
  /*     scheme_signal_error ("eng_get_array: Import-Array is empty."); */

  return create_ss_array (mx_array);
}


/***** SCHEME-PRIMITIVES: CONVERT STRING<->ARRAY VECTOR<->ARRAY OBJECT<->ARRAY */

/* (array->string <array>) -> string */
static Scheme_Object*
mx_array_to_string (int argc, Scheme_Object *argv [])
{
  mxArray *mx_array;
  char *string;

  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_array_to_string", "array", 0, argc, argv);

  mx_array = MXARRAY_PTR (argv [0]);

  if ((! mxIsChar (mx_array)) ||
      (mxGetNumberOfDimensions (mx_array) != 2))
    scheme_wrong_type ("mx_array_to_string", 
                       "2-dimensional-char-array", 0, argc, argv);

  string = mxArrayToString (mx_array);
  if (string == NULL)
    scheme_signal_error ("mx_array_to_string: Not enough memory.");
  
  /* ATTENTION: 'string' must be freed, so do NOT return a copy!
     The garbage-collector must free 'string'. */
  return scheme_make_sized_offset_string 
    (string, 0, mxGetNumberOfElements (mx_array), 0);
}

/* (string->array <string>) -> array */
static Scheme_Object*
mx_create_string (int argc, Scheme_Object *argv [])
{
  mxArray *mx_array;
  
  if (! SCHEME_STRINGP (argv [0]))
    scheme_wrong_type ("mx_create_string", "string", 0, argc, argv);

  /* mxArray-CREATOR */
  mx_array = mxCreateString ((const char*) (SCHEME_STR_VAL (argv [0])));
  if (mx_array == NULL)
    scheme_signal_error ("mx_create_string: " 
                         "Not enough memory to allocate mxArray.");
  return create_ss_array (mx_array);
}

/* (array->vector <array>) -> vector */
static Scheme_Object*
array_to_vector (int argc, Scheme_Object *argv [])
{
  mxArray *mx_array;

  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("array_to_vector", "array", 0, argc, argv);

  mx_array = MXARRAY_PTR (argv [0]);
  
  if ((mxGetNumberOfDimensions (mx_array) != 2) ||
      (mxGetDimensions (mx_array) [1] != 1))
    scheme_wrong_type ("array_to_vector", "#(n 1)-column-array", 0, argc, argv);

  return mxarray_to_vector (mx_array);
}

/* (vector->array <vector> [type-symbol] [complexity-symbol]) -> array
   Assign each element of <vector> to the corresponding element of a newly
   created #(<vector>-length 1)-array of type [type-symbol] and complexity
   [complexity-symbol]. Return the array. */
static Scheme_Object*
vector_to_array (int argc, Scheme_Object *argv [])
{
  int dims [2];
  mxArray *mx_array;
  mxClassID type_id;
  bool complexity_id;
  
  if (! SCHEME_VECTORP (argv[0]))
    scheme_wrong_type ("vector_to_array", "vector", 0, argc, argv);
 
  dims [0] = SCHEME_VEC_SIZE (argv [0]);
  dims [1] = 1; /* n-by-1-column-array */

  if (argc >= 2)
    if (! SCHEME_SYMBOLP (argv[1]))
      scheme_wrong_type ("vector_to_array", "symbol", 1, argc, argv);
    else
      type_id = type_symbol_to_id (argv [1]);
  else
    type_id = mxDOUBLE_CLASS;

  if (argc == 3)
    if (! SCHEME_SYMBOLP (argv[2]))
      scheme_wrong_type ("vector_to_array", "symbol", 2, argc, argv);
    else
      complexity_id = complexity_symbol_to_id (argv [2]);
  else
    complexity_id = mxREAL;
  
  /* mxArray-CREATOR */
  mx_array = create_numeric_array (2, dims, type_id, complexity_id);
  if (mx_array == NULL)
    scheme_signal_error ("vector_to_array: " 
                         "Not enough memory to allocate mxArray.");
  mxarray_set_with_vector (mx_array, argv [0]);
  return create_ss_array (mx_array);
}

/* (array->object <array>) -> object */
static Scheme_Object* 
array_to_object (int argc, Scheme_Object *argv [])
{
  mxArray *mx_array;

  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("array_to_object", "array", 0, argc, argv);

  mx_array = MXARRAY_PTR (argv [0]);
  
  if ((mxGetNumberOfDimensions (mx_array) != 2) ||
      (mxGetDimensions (mx_array) [0] != 1) ||
      (mxGetDimensions (mx_array) [1] != 1))
    scheme_wrong_type ("array_to_object", "#(1 1)-scalar-array", 0, argc, argv);

  return mxarray_to_object (mx_array);
}

/* (object->array <object> [type-symbol] [complexity-symbol]) -> array */
static Scheme_Object*
object_to_array (int argc, Scheme_Object *argv [])
{
  int dims [2] = {1, 1};
  mxArray *mx_array;
  mxClassID type_id;
  bool complexity_id;

  if (argc == 1) {
    if (! SCHEME_REALP (argv [0]))
      scheme_wrong_type ("object_to_array", "real", 0, argc, argv);
    
    /* mxArray-CREATOR */
    mx_array = mxCreateScalarDouble (scheme_real_to_double (argv [0]));
    if (mx_array == NULL)
      scheme_signal_error ("object_to_array: " 
                           "Not enough memory to allocate mxArray.");
    return create_ss_array (mx_array);
  }

  if (argc >= 2)
    if (! SCHEME_SYMBOLP (argv [1]))
      scheme_wrong_type ("number_to_array", "symbol", 1, argc, argv);
    else
      type_id = type_symbol_to_id (argv [1]);
  else
    type_id = mxDOUBLE_CLASS;

  if (argc == 3)
    if (! SCHEME_SYMBOLP (argv [2]))
      scheme_wrong_type ("number_to_array", "symbol", 2, argc, argv);
    else
      complexity_id = complexity_symbol_to_id (argv [2]);
  else
    complexity_id = mxREAL;

  /* mxArray-CREATOR */
  mx_array = create_numeric_array (2, dims, type_id, complexity_id);
  if (mx_array == NULL)
    scheme_signal_error ("object_to_array: " 
                         "Not enough memory to allocate mxArray.");
  scalar_mxarray_set_with_object (mx_array, argv [0]);
  return create_ss_array (mx_array);
}

/* (matrix->array <matrix> [type-symbol] [complexity-symbol]) -> array
   Assign each element of <matrix> to the corresponding element of a newly
   created array of the same dimensions, type [type-symbol] and complexity
   [complexity-symbol].
   <matrix> is a nesting of vectors that implements a multidimensional 
   matrix in scheme. The innermost vector corresponds to the first
   dimension. */
static Scheme_Object*
matrix_to_array (int argc, Scheme_Object *argv [])
{
  int ndim;
  mxArray *mx_array;
  mxClassID type_id;
  bool complexity_id;

  ndim = dimarray_take_matrix_shape (argv [0]);
  if (ndim == 1)
    scheme_wrong_type ("matrix_to_array", "nested-vectors", 0, argc, argv);

   if (argc >= 2)
     if (! SCHEME_SYMBOLP (argv [1]))
       scheme_wrong_type ("matrix_to_array", "symbol", 1, argc, argv);
     else
       type_id = type_symbol_to_id (argv [1]);
   else
     type_id = mxDOUBLE_CLASS;

   if (argc == 3)
     if (! SCHEME_SYMBOLP (argv [2]))
       scheme_wrong_type ("matrix_to_array", "symbol", 2, argc, argv);
     else
       complexity_id = complexity_symbol_to_id (argv [2]);
   else
     complexity_id = mxREAL;
  
   /* mxArray-CREATOR */
   mx_array = create_numeric_array (ndim, dimarray, type_id, complexity_id);
   if (mx_array == NULL)
     scheme_signal_error ("matrix_to_array: " 
                          "Not enough memory to allocate mxArray.");
   mxarray_set_with_matrix (mx_array, argv [0], ndim);

   return create_ss_array (mx_array); 
}

/* (array->matrix <array>) */
static Scheme_Object*
array_to_matrix (int argc, Scheme_Object *argv [])
{
  mxArray *mx_array;

  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("array_to_matrix", "array", 0, argc, argv);
  
  mx_array = MXARRAY_PTR (argv [0]);
  
  return mxarray_to_matrix (mx_array);
}


/***** SCHEME-PRIMITIVES: INFO ========================================= */

/* Demonstrate use of _scheme_apply. */
static Scheme_Object*
my_apply (char proc [], int argc, Scheme_Object *argv [])
{
  /* _scheme_apply (<procedure>, <number-of-arguments>, <argument-vector>) */
  return _scheme_apply (scheme_lookup_global (scheme_intern_symbol (proc),
                                              scheme_get_env (scheme_config)),
                        argc,
                        argv);
}

/* In Scheme, say: (playground-print-matlab-array-info)
   Demonstrate use of _scheme_apply.
   Demonstrate printing in Scheme.
   Print some info about matlab-arrays. */
static Scheme_Object*
print_matlab_array_info (int argc, Scheme_Object *argv [])
{
  Scheme_Object **args;

  args = (Scheme_Object**) scheme_malloc (32 * sizeof (Scheme_Object*));

  args [0] = scheme_make_string ("\
mxArrays are homogenous: all elements of the array share one single type.\n\
Internally, types are identified by their ID which is a number.\n\
Following a table of corresponding ID and number:\n\
     <ID>          <Number>\n\
mxUNKNOWN_CLASS  = ~s\n\
mxCELL_CLASS     = ~s\n\
mxSTRUCT_CLASS   = ~s\n\
mxOBJECT_CLASS   = ~s\n\
mxCHAR_CLASS     = ~s\n\
mxSPARSE_CLASS   = ~s\n\
mxDOUBLE_CLASS   = ~s\n\
mxSINGLE_CLASS   = ~s\n\
mxINT8_CLASS     = ~s\n\
mxUINT8_CLASS    = ~s\n\
mxINT16_CLASS    = ~s\n\
mxUINT16_CLASS   = ~s\n\
mxINT32_CLASS    = ~s\n\
mxUINT32_CLASS   = ~s\n\
mxINT64_CLASS    = ~s\n\
mxUINT64_CLASS   = ~s\n\
mxREAL           = ~s\n\
mxCOMPLEX        = ~s\n\
");

  args [1]  = scheme_make_integer ((int) mxUNKNOWN_CLASS);
  args [2]  = scheme_make_integer ((int) mxCELL_CLASS);
  args [3]  = scheme_make_integer ((int) mxSTRUCT_CLASS);
  args [4]  = scheme_make_integer ((int) mxOBJECT_CLASS);
  args [5]  = scheme_make_integer ((int) mxCHAR_CLASS);
  args [6]  = scheme_make_integer ((int) mxSPARSE_CLASS);
  args [7]  = scheme_make_integer ((int) mxDOUBLE_CLASS);
  args [8]  = scheme_make_integer ((int) mxSINGLE_CLASS);
  args [9]  = scheme_make_integer ((int) mxINT8_CLASS);
  args [10] = scheme_make_integer ((int) mxUINT8_CLASS);
  args [11] = scheme_make_integer ((int) mxINT16_CLASS);
  args [12] = scheme_make_integer ((int) mxUINT16_CLASS);
  args [13] = scheme_make_integer ((int) mxINT32_CLASS);
  args [14] = scheme_make_integer ((int) mxUINT32_CLASS);
  args [15] = scheme_make_integer ((int) mxINT64_CLASS);
  args [16] = scheme_make_integer ((int) mxUINT64_CLASS);
  args [17] = scheme_make_integer ((int) mxREAL);
  args [18] = scheme_make_integer ((int) mxCOMPLEX);      

  return my_apply ("printf", 19, args);
}




#ifdef DEBUG

/***** DEBUG =========================================================== */


/* (array-index->offset <array> <index>): ssArray Vector -> Integer
   Element-Number: Number of storage-places in memory that the <index>ed
   element of <array> is away from the first element of <array>. */
static Scheme_Object*
array_index_to_offset (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv [0]))
    scheme_wrong_type ("array_index_to_offset", "Array", 0, argc, argv);

  return scheme_make_integer_value
    ((long) (mxarray_index_to_offset (MXARRAY_PTR (argv [0]), argv [1])));
}

/* (array-index->elnum <array> <index>): ssArray Vector -> Integer
   Element-Number: Number of storage-places in memory that the <index>ed
   element of <array> is away from the first element of <array>. */
static Scheme_Object*
array_index_to_elnum (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv [0]))
    scheme_wrong_type ("array_index_to_elnum", "Array", 0, argc, argv);

  return scheme_make_integer_value
    ((long) (mxarray_index_to_elnum (MXARRAY_PTR (argv [0]), argv [1])));
}

/* (array-bytes-per-element <array>): ssArray -> Integer
   Bytes used to store each single element of <array>. */
static Scheme_Object*
array_bytes_per_element (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv [0]))
    scheme_wrong_type ("array_bytes_per_element", "Array", 0, argc, argv);

  return scheme_make_integer
    ((long) mxGetElementSize (MXARRAY_PTR (argv [0])));
}

/* (array-element-ref <array> <number>) -> value */
static Scheme_Object*
array_element_ref (int argc, Scheme_Object *argv [])
{
  mxArray *mx_array;
  Array_Element element = {0, 0, NULL, NULL};
  
  if (! MXARRAY_P (argv [0]))
    scheme_wrong_type ("array_element_ref", "array", 0, argc, argv);
  if (! SCHEME_INTP (argv [1]))
    scheme_wrong_type ("array_element_ref", "fixnum", 1, argc, argv);

  mx_array = MXARRAY_PTR (argv [0]);
  arrayel_get_with_offset (mx_array, &element,
                           mxGetElementSize (mx_array) * SCHEME_INT_VAL (argv [1]));
  return convert_arrayel_ref (&element);
}

/* (array-element-set! <array> <number> <value>) */
static Scheme_Object*
array_element_set (int argc, Scheme_Object *argv [])
{
  mxArray *mx_array;
  Array_Element element = {0, 0, NULL, NULL};
  
  if (! MXARRAY_P (argv [0]))
    scheme_wrong_type ("array_element_set", "Array", 0, argc, argv);
  if (! SCHEME_INTP (argv [1]))
    scheme_wrong_type ("array_element_set", "Fixnum-Integer", 1, argc, argv);

  mx_array = MXARRAY_PTR (argv [0]);
  arrayel_get_with_offset (mx_array, &element,
                           mxGetElementSize (mx_array) * SCHEME_INT_VAL (argv [1]));
  arrayel_set_convert (&element, argv [2]);
  
  return scheme_void;
}

/* (matlab-eps) -> flonum
   Eps is equal to the distance from 1.0 to the next largest 
   floating-point number. Thus, it is a measure of floating-point 
   accuracy. */
static Scheme_Object*
matlab_eps (int argc, Scheme_Object *argv [])
{
  return scheme_make_double (mxGetEps ());
}

/* (compatible-array? <type-symbol> <complexity-symbol>) -> boolean */
static Scheme_Object*
is_compatible_array (int argc, Scheme_Object *argv [])
{
  if (! SCHEME_SYMBOLP (argv [0]))
    scheme_wrong_type ("is_compatible_array", "symbol", 0, argc, argv);
  if (! SCHEME_SYMBOLP (argv [1]))
    scheme_wrong_type ("is_compatible_array", "symbol", 1, argc, argv);

  if (IS_COMPATIBLE_MXARRAY (type_symbol_to_id (argv [0]),
                             complexity_symbol_to_id (argv [1])))
    return scheme_true;
  else
    return scheme_false;
}

/* (type-symbol->id <symbol>) -> fixnum */
static Scheme_Object* 
debug_type_symbol_to_id (int argc, Scheme_Object *argv [])
{
  if (! SCHEME_SYMBOLP (argv [0]))
    scheme_wrong_type ("debug_type_symbol_to_id", "symbol", 0, argc, argv);

  return scheme_make_integer ((long) type_symbol_to_id (argv [0]));
}

/* (complexity-symbol->id <symbol>) -> fixnum */
static Scheme_Object*
debug_complexity_symbol_to_id (int argc, Scheme_Object *argv [])
{
  if (! SCHEME_SYMBOLP (argv [0]))
    scheme_wrong_type ("debug_complexity_symbol_to_id", "symbol", 0, argc, argv);

  return scheme_make_integer ((long) complexity_symbol_to_id (argv [0]));
}

/* (array-type-id <array>) -> <integer>
   Common id-integer of the storage-type of each element of <array>. */
static Scheme_Object*
mx_get_class_id (int argc, Scheme_Object *argv []) 
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_get_class_id", "array", 0, argc, argv);

  return scheme_make_integer ((long) mxGetClassID (MXARRAY_PTR (argv[0])));
}

/* (array-type-string <array>) -> <string>
   Common name of the storage-type of each element of <array>. */
static Scheme_Object*
mx_get_class_name (int argc, Scheme_Object *argv []) 
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_get_class_name", "array", 0, argc, argv);

  return scheme_make_string (mxGetClassName (MXARRAY_PTR (argv[0])));
}

/* (array-complexity-id <array>) -> integer */
static Scheme_Object*
mx_complexity_id (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_complexity_id", "array", 0, argc, argv);
 
  return scheme_make_integer ((long) mxIsComplex (MXARRAY_PTR (argv[0])));
}

/* (array-complexity-string <array>) -> string */
static Scheme_Object*
mx_complexity_name (int argc, Scheme_Object *argv [])
{
  if (! MXARRAY_P (argv[0]))
    scheme_wrong_type ("mx_complexity_name", "array", 0, argc, argv);

  if (mxIsComplex (MXARRAY_PTR (argv[0])))
    return scheme_make_string ("complex");
  else
    return scheme_make_string ("real");
}

/* (matrix-shape <matrix>) -> vector
   Shape of <matrix>.
   <matrix> is a nesting of vectors that implements a multidimensional 
   matrix in scheme. The innermost vector corresponds to the first
   dimension. */
static Scheme_Object*
matrix_shape (int argc, Scheme_Object *argv [])
{
  int i, ndim;
  Scheme_Object* shape;
  
  ndim = dimarray_take_matrix_shape (argv [0]);
  shape = scheme_make_vector (ndim, NULL);

  for (i = 0; i < ndim; i ++)
    SCHEME_VEC_ELS (shape) [i] = scheme_make_integer (dimarray [i]);

  return shape;
}



/***** PLAYGROUND ====================================================== */

/* (visible_finaliser <object> <data>)
   Make finalization visible. 
   Interacts with playground_eat_memory. */
static void
playground_visible_finaliser (void* obj, void* nbytes)
{
  scheme_warning ("visible-finaliser: %d bytes freed.", *((int*) nbytes));
}

/* (playground-eat-memory <bytes>)
   Check if finalization ever happens. */
static Scheme_Object*
playground_eat_memory (int argc, Scheme_Object *argv [])
{
  void* memory;
  int nbytes;
  
  if (! SCHEME_INTP (argv [0]))
    scheme_wrong_type ("playground_eat_memory", "fixnum", 0, argc, argv);

  nbytes = SCHEME_INT_VAL (argv [0]);
  
  if (nbytes < 0) scheme_wrong_type ("playground_eat_memory", 
                                     "non-negative fixnum", 0, argc, argv);
  
  memory = scheme_malloc_fail_ok (scheme_malloc_atomic, nbytes);
  scheme_warning ("Mmmmmhhhhh, %d bytes of memory. That was delicioussss.",
                  nbytes);
  scheme_register_finalizer 
    (memory, playground_visible_finaliser, (void*) &nbytes, NULL, NULL);
  
  return scheme_void;
}

#endif