Ticket #6781: ecllib.patch

File ecllib.patch, 37.9 KB (added by nbruin, 9 years ago)

Rebased against 4.3, with str -> bytes changes

  • module_list.py

    # HG changeset patch
    # User Nils Bruin <nbruin@sfu.ca>
    # Date 1263632171 28800
    # Node ID 604c0fdf356f0bbfef70253ea04b5ca7a28440af
    # Parent  21efb0b3fc474972b5c7f617d99173536a3d79d0
    Patch to add ECL library access to Python (specifically sage)
    
    diff -r 21efb0b3fc47 -r 604c0fdf356f module_list.py
    a b  
    398398    ##
    399399    ################################
    400400
     401    Extension('sage.libs.ecl',
     402              sources = ["sage/libs/ecl/ecl.pyx"],
     403              libraries = ["ecl"],
     404              include_dirs = [SAGE_ROOT+'/local/include/ecl/'],
     405              depends = [SAGE_ROOT + '/local/include/ecl/ecl.h']),
     406
    401407    Extension('sage.libs.flint.flint',
    402408              sources = ["sage/libs/flint/flint.pyx"],
    403409              libraries = ["csage", "flint", "gmp", "gmpxx", "m", "stdc++"],
  • new file sage/libs/ecl/ecl.pxd

    diff -r 21efb0b3fc47 -r 604c0fdf356f sage/libs/ecl/ecl.pxd
    - +  
     1###############################################################################
     2#   Sage: Open Source Mathematical Software
     3#       Copyright (C) 2009 Nils Bruin <nbruin@sfu.ca>
     4#  Distributed under the terms of the GNU General Public License (GPL),
     5#  version 2 or any later version.  The full text of the GPL is available at:
     6#                  http://www.gnu.org/licenses/
     7###############################################################################
     8
     9#ecl's header files export a very large number of definitions, referred to here
     10#as ecl.h bindings. In reality ecl.h includes a couple of other header files.
     11#We only include the cython translations of the ones we need here.
     12
     13#ecl's naming conventions have been followed as much as possible. These
     14#conventions are not entirely consistently used in ECL itself, though, and
     15#those cases are corrected in the cython bindings.
     16#(see cl_cons and ecl_fixnum)
     17# cl_*  functions are proper common lisp routines. In particular, input and
     18#       return types are cl_object
     19# ecl_* functions provide other interfaces. Arguments or return types might
     20#       include C types.
     21#
     22# In addition, type predicates that return a C boolean are named:
     23# bint_* bindings corresponding to a mix of macros and ecl_* functions in ecl.h
     24
     25cdef extern from "ecl/ecl.h":
     26   
     27    # Typedefs
     28
     29    ctypedef long int cl_fixnum
     30    ctypedef cl_fixnum cl_narg
     31    ctypedef void *cl_object
     32    ctypedef unsigned int cl_index
     33
     34    ctypedef enum ecl_option:
     35        ECL_OPT_INCREMENTAL_GC = 0,
     36        ECL_OPT_TRAP_SIGSEGV,
     37        ECL_OPT_TRAP_SIGFPE,
     38        ECL_OPT_TRAP_SIGINT,
     39        ECL_OPT_TRAP_SIGILL,
     40        ECL_OPT_TRAP_SIGBUS,
     41        ECL_OPT_BOOTED,
     42        ECL_OPT_BIND_STACK_SIZE,
     43        ECL_OPT_BIND_STACK_SAFETY_AREA,
     44        ECL_OPT_FRAME_STACK_SIZE,
     45        ECL_OPT_FRAME_STACK_SAFETY_AREA,
     46        ECL_OPT_LISP_STACK_SIZE,
     47        ECL_OPT_LISP_STACK_SAFETY_AREA,
     48        ECL_OPT_C_STACK_SIZE,
     49        ECL_OPT_C_STACK_SAFETY_AREA,
     50        ECL_OPT_SIGALTSTACK_SIZE,
     51        ECL_OPT_HEAP_SIZE,
     52        ECL_OPT_HEAP_SAFETY_AREA,
     53        ECL_OPT_THREAD_INTERRUPT_SIGNAL,
     54        ECL_OPT_SET_GMP_MEMORY_FUNCTIONS,
     55        ECL_OPT_LIMIT
     56
     57    # boot and shutdown
     58
     59    cl_fixnum ecl_get_option(int option)
     60    void ecl_set_option(int option, cl_fixnum value)
     61    void cl_boot(int argc, char **argv)
     62    void cl_shutdown()
     63
     64    # predefined symbols
     65
     66    cl_object Cnil
     67    cl_object Ct
     68    cl_fixnum MOST_POSITIVE_FIXNUM
     69    cl_fixnum MOST_NEGATIVE_FIXNUM
     70
     71    # Type predicates returning a cl_object
     72
     73    cl_object cl_symbolp(cl_object o)
     74    cl_object cl_numberp(cl_object o)
     75    cl_object cl_integerp(cl_object x)
     76    cl_object cl_rationalp(cl_object x)
     77    cl_object cl_floatp(cl_object x)
     78
     79    # Type predicates returning a C boolean   
     80   
     81    bint bint_floatp "floatp" (cl_object x)
     82    bint bint_numberp "ecl_numberp" (cl_object x)
     83    bint bint_eql "ecl_eql"(cl_object x, cl_object y)
     84    bint bint_equal "ecl_equal"(cl_object x, cl_object y)
     85    bint bint_equalp "ecl_equalp"(cl_object x, cl_object y)
     86    bint bint_stringp "ecl_stringp"(cl_object x)
     87    bint bint_fixnump "FIXNUMP"(cl_object o)
     88    bint bint_characterp "CHARACTERP"(cl_object o)
     89    bint bint_nullp "Null"(cl_object o)
     90    bint bint_listp "LISTP" (cl_object o)
     91    bint bint_consp "CONSP" (cl_object o)
     92    bint bint_atomp "ATOM" (cl_object o)
     93
     94    # Equality tests
     95   
     96    cl_object cl_eq(cl_object x, cl_object y)
     97    cl_object cl_eql(cl_object x, cl_object y)
     98    cl_object cl_equal(cl_object x, cl_object y)
     99
     100    # ECL numeric type conversion
     101
     102    cl_object ecl_make_integer(cl_fixnum i)
     103    cl_object ecl_make_unsigned_integer(cl_index i)
     104    cl_fixnum ecl_fixint "fixint" (cl_object x)
     105
     106    cl_object ecl_make_ratio(cl_object num, cl_object den)
     107    cl_object cl_numerator(cl_object x)
     108    cl_object cl_denominator(cl_object x)
     109
     110    cl_object ecl_make_doublefloat(double f)
     111    double ecl_to_double(cl_object x)
     112
     113    # list manipulation
     114
     115    cl_object cl_cons "ecl_cons" (cl_object a, cl_object d)
     116    cl_object cl_car(cl_object x)
     117    cl_object cl_cdr(cl_object x)
     118    cl_object cl_caar(cl_object x)
     119    cl_object cl_cadr(cl_object x)
     120    cl_object cl_cdar(cl_object x)
     121    cl_object cl_cddr(cl_object x)
     122    cl_object cl_rplaca(cl_object x, cl_object v)
     123    cl_object cl_rplacd(cl_object x, cl_object v)
     124
     125    # string parsing and string IO
     126   
     127    char *ecl_base_string_pointer_safe(cl_object f)
     128    cl_object ecl_read_from_cstring(char *s)
     129    cl_object ecl_read_from_cstring_safe(char *s, cl_object err)
     130    cl_object cl_write_to_string(cl_narg narg, cl_object o)
     131    cl_object ecl_cstring_to_base_string_or_nil(char *s)
     132   
     133    # S-expr evaluation and function calls
     134   
     135    cl_object cl_safe_eval(cl_object form, cl_object env, cl_object value)
     136    cl_object cl_eval(cl_object form)
     137    cl_object cl_funcall(cl_narg narg, cl_object fun, cl_object arg1,...)
     138    cl_object cl_apply(cl_narg narg, cl_object fun, cl_object args)
     139    cl_object cl_set(cl_object var, cl_object val)
     140    int ecl_nvalues "NVALUES"
     141    cl_object ecl_values "VALUES"(int n)
     142
     143    #Common Lisp "EQUAL" compatible hash function
     144       
     145    cl_object cl_sxhash(cl_object key)
  • new file sage/libs/ecl/ecl.pyx

    diff -r 21efb0b3fc47 -r 604c0fdf356f sage/libs/ecl/ecl.pyx
    - +  
     1r"""
     2Library interface to Embeddable Common Lisp (ECL)
     3"""
     4###############################################################################
     5#   Sage: Open Source Mathematical Software
     6#       Copyright (C) 2009 Nils Bruin <nbruin@sfu.ca>
     7#  Distributed under the terms of the GNU General Public License (GPL),
     8#  version 2 or any later version.  The full text of the GPL is available at:
     9#                  http://www.gnu.org/licenses/
     10###############################################################################
     11
     12#This version of the library interface prefers to convert ECL integers and
     13#rationals to SAGE types Integer and Rational. These parts could easily be
     14#adapted to work with pure Python types.
     15
     16cimport sage.rings.integer
     17from sage.rings.integer cimport Integer
     18import sage.rings.integer
     19from sage.rings.integer import Integer
     20cimport sage.rings.rational
     21from sage.rings.rational cimport Rational
     22import sage.rings.rational
     23from sage.rings.rational import Rational
     24
     25#it would be preferrable to let bint_symbolp wrap an efficient macro
     26#but the macro provided in object.h doesn't seem to work
     27cdef bint bint_symbolp(cl_object obj):
     28    return not(cl_symbolp(obj) == Cnil)
     29
     30#these type predicates are only provided in "cl_*" form, so we wrap them
     31#with the proper type cast.
     32
     33cdef bint bint_numberp(cl_object obj):
     34    return not(cl_numberp(obj) == Cnil)
     35cdef bint bint_integerp(cl_object obj):
     36    return not(cl_integerp(obj) == Cnil)
     37cdef bint bint_rationalp(cl_object obj):
     38    return not(cl_rationalp(obj) == Cnil)
     39
     40cdef extern from "signal.h":
     41    #rename of struct is necessary because cython folds the "struct" namespace
     42    #into the normal namespace
     43    struct Sigaction "sigaction":
     44        pass
     45    int sigaction (int sig, Sigaction * act, Sigaction * oact)
     46
     47cdef cl_object string_to_object(char * s):
     48    return ecl_read_from_cstring(s)
     49
     50# We need to keep a list of objects bound to python, to protect them from being
     51# garbage collected. We want a list in which we can quickly add and remove
     52# elements. Lookup is not necessary. A doubly linked list seems
     53# most appropriate. A node looks like
     54#   N = ( value next . prev)
     55# so that car(N)=value, cadr(N)=next, cddr(N)=prev.
     56# we write routines to insert a node after a given node
     57# and to delete a given node. This can all be done with modifying pointers.
     58# note that circular structures are unpleasant for most lisp routines.
     59# perhaps this even puts a strain on the garbage collector?
     60# an alternative data structure would be an array where the free nodes get
     61# chained in a "free list" for quick allocation (and if the free list is empty
     62# upon allocating a node, the array needs to be extended)
     63
     64cdef cl_object insert_node_after(cl_object node,cl_object value):
     65    cdef cl_object next,newnode
     66
     67    next=cl_cadr(node)
     68    newnode=cl_cons(value,cl_cons(next,node))
     69    cl_rplaca(cl_cdr(node),newnode)
     70    if next != Cnil:
     71        cl_rplacd(cl_cdr(next),newnode)
     72    return newnode
     73
     74cdef void remove_node(cl_object node):
     75    cdef cl_object next, prev
     76    next=cl_cadr(node)
     77    prev=cl_cddr(node)
     78    if next != Cnil:
     79        cl_rplacd(cl_cdr(next),prev)
     80    if prev != Cnil:
     81        cl_rplaca(cl_cdr(prev),next)
     82
     83# our global list of pointers. This will be a pointer to a sentinel node,
     84# after which all new nodes can be inserted. list_of_object gets initialised
     85# by init_ecl() and bound to the global ECL variable *SAGE-LIST-OF-OBJECTS*
     86
     87cdef cl_object list_of_objects
     88
     89cdef cl_object safe_eval_clobj         #our own error catching eval
     90cdef cl_object safe_apply_clobj        #our own error catching apply
     91cdef cl_object safe_funcall_clobj      #our own error catching funcall
     92cdef cl_object read_from_string_clobj  #our own error catching reader
     93
     94cdef bint ecl_has_booted = 0
     95   
     96def init_ecl():
     97    r"""
     98    Internal function to initialize ecl. Do not call.
     99   
     100    This function initializes the ECL library for use within Python.
     101    This routine should only be called once and importing the ecl library
     102    interface already does that, so do not call this yourself.
     103   
     104    EXAMPLES::
     105   
     106        sage: from sage.libs.ecl import *
     107 
     108    At this point, init_ecl() has run. Explicitly executing it
     109    gives an error::
     110   
     111        sage: init_ecl()
     112        Traceback (most recent call last):
     113        ...
     114        RuntimeError: ECL is already initialized
     115 
     116    """
     117    global list_of_objects
     118    global safe_eval_clobj
     119    global safe_apply_clobj
     120    global safe_funcall_clobj
     121    global read_from_string_clobj
     122    global ecl_has_booted
     123    cdef char *argv[1]
     124    cdef Sigaction act[33]
     125    cdef int i
     126
     127    if ecl_has_booted:
     128        raise RuntimeError, "ECL is already initialized"
     129
     130    #we keep our own GMP memory functions. ECL should not claim them
     131    ecl_set_option(ECL_OPT_SET_GMP_MEMORY_FUNCTIONS,0);
     132
     133    #we need a dummy argv for cl_boot (we just don't give any parameters)
     134    argv[0]=""
     135   
     136    #get all the signal handlers (does any system have signal numbers above 32?)
     137    for i in range(1,33):
     138        sigaction(i,NULL,&(act[i]))
     139 
     140    #initialize ECL
     141    cl_boot(0, argv)
     142   
     143    #and put the signal handlers back
     144    for i in range(1,33):
     145        sigaction(i,&(act[i]),NULL)
     146   
     147    #initialise list of objects and bind to global variable
     148    # *SAGE-LIST-OF-OBJECTS* to make it rooted in the reachable tree for the GC
     149    list_of_objects=cl_cons(Cnil,cl_cons(Cnil,Cnil))
     150    cl_set(string_to_object("*SAGE-LIST-OF-OBJECTS*"),list_of_objects)
     151
     152    # We define our own error catching eval, apply and funcall/
     153    # Presently these routines are only converted to byte-code. If they
     154    # ever turn out to be a bottle neck, it should be easy to properly
     155    # compile them.
     156
     157    read_from_string_clobj=cl_eval(string_to_object("(symbol-function 'read-from-string)"))
     158
     159    cl_eval(string_to_object("""
     160        (defun sage-safe-eval (form)
     161            (handler-case
     162                (values (eval form))
     163                (serious-condition (cnd)
     164                    (values nil (princ-to-string cnd)))))
     165        """))
     166    safe_eval_clobj=cl_eval(string_to_object("(symbol-function 'sage-safe-eval)"))
     167
     168    cl_eval(string_to_object("""
     169        (defun sage-safe-apply (func args)
     170            (handler-case
     171                (values (apply func args))
     172                (serious-condition (cnd)
     173                    (values nil (princ-to-string cnd)))))
     174        """))
     175
     176    safe_apply_clobj=cl_eval(string_to_object("(symbol-function 'sage-safe-apply)"))
     177    cl_eval(string_to_object("""
     178        (defun sage-safe-funcall (func arg)
     179            (handler-case
     180                (values (funcall func arg))
     181                (serious-condition (cnd)
     182                    (values nil (princ-to-string cnd)))))
     183        """))
     184    safe_funcall_clobj=cl_eval(string_to_object("(symbol-function 'sage-safe-funcall)"))
     185
     186    ecl_has_booted = 1
     187
     188cdef cl_object ecl_safe_eval(cl_object form) except NULL:
     189    cl_funcall(2,safe_eval_clobj,form)
     190    if ecl_nvalues > 1:
     191        raise RuntimeError, "ECL says: "+ecl_base_string_pointer_safe(ecl_values(1))
     192    else:
     193        return ecl_values(0)
     194
     195cdef cl_object ecl_safe_funcall(cl_object func, cl_object arg) except NULL:
     196    cdef cl_object l
     197    l = cl_cons(func,cl_cons(arg,Cnil));
     198    cl_apply(2,safe_funcall_clobj,cl_cons(func,cl_cons(arg,Cnil)))
     199    if ecl_nvalues > 1:
     200        raise RuntimeError, "ECL says: "+ecl_base_string_pointer_safe(ecl_values(1))
     201    else:
     202        return ecl_values(0)
     203
     204cdef cl_object ecl_safe_apply(cl_object func, cl_object args) except NULL:
     205    cl_funcall(3,safe_apply_clobj,func,args)
     206    if ecl_nvalues > 1:
     207        raise RuntimeError, "ECL says: "+ecl_base_string_pointer_safe(ecl_values(1))
     208    else:
     209        return ecl_values(0)
     210
     211cdef cl_object ecl_safe_read_string(char * s) except NULL:
     212    cdef cl_object o
     213    o = ecl_cstring_to_base_string_or_nil(s)
     214    o = ecl_safe_funcall(read_from_string_clobj,o)
     215    return o
     216   
     217def shutdown_ecl():
     218    r"""
     219    Shut down ecl. Do not call.
     220   
     221    Given the way that ECL is used from python, it is very difficult to ensure
     222    that no ECL objects exist at a particular time. Hence, destroying ECL is a
     223    risky proposition.
     224   
     225    EXAMPLE::
     226   
     227        sage: from sage.libs.ecl import *
     228        sage: shutdown_ecl()
     229    """
     230    cl_shutdown()
     231
     232#this prints the objects that sage wants the GC to keep track of.
     233#these should be all non-immediate EclObject wrapped objects
     234def print_objects():
     235    r"""
     236    Print GC-protection list
     237   
     238    Diagnostic function. ECL objects that are bound to Python objects need to
     239    be protected from being garbage collected. We do this by including them
     240    in a doubly linked list bound to the global ECL symbol
     241    *SAGE-LIST-OF-OBJECTS*. Only non-immediate values get included, so
     242    small integers do not get linked in. This routine prints the values
     243    currently stored.
     244   
     245    EXAMPLE::
     246
     247        sage: from sage.libs.ecl import *
     248        sage: a=EclObject("hello")
     249        sage: b=EclObject(10)
     250        sage: c=EclObject("world")
     251        sage: print_objects() #random because previous test runs can have left objects
     252        NIL
     253        WORLD
     254        HELLO
     255    """
     256   
     257    cdef cl_object c
     258    c = list_of_objects
     259    while True:
     260        print ecl_base_string_pointer_safe(cl_write_to_string(1,cl_car(c)))
     261        c=cl_cadr(c)
     262        if c == Cnil:
     263            break
     264
     265cdef cl_object python_to_ecl(pyobj) except NULL:
     266    # conversion of a python object into an ecl object
     267    # most conversions are straightforward. Noteworthy are:
     268    # python lists -> lisp (NIL terminated) lists
     269    # tuples -> dotted lists
     270    # strings ->parsed by lisp reader
     271
     272    cdef bytes s
     273    cdef cl_object L, ptr
     274   
     275    if isinstance(pyobj,bool):
     276        if pyobj:
     277            return Ct
     278        else:
     279            return Cnil
     280    elif pyobj==None:
     281        return Cnil
     282    elif isinstance(pyobj,int):
     283        return ecl_make_integer(pyobj)
     284    elif isinstance(pyobj,long):
     285        if pyobj >= MOST_NEGATIVE_FIXNUM and pyobj < MOST_NEGATIVE_FIXNUM:
     286            return ecl_make_integer(pyobj)
     287        else:
     288            s=str(pyobj)
     289            return string_to_object(s)
     290    elif isinstance(pyobj,float):
     291        return ecl_make_doublefloat(pyobj)
     292    elif isinstance(pyobj,bytes):
     293        s=<bytes>pyobj
     294        return ecl_safe_read_string(s)
     295    elif isinstance(pyobj,Integer):
     296        if pyobj >= MOST_NEGATIVE_FIXNUM and pyobj < MOST_NEGATIVE_FIXNUM:
     297            return ecl_make_integer(pyobj)
     298        else:
     299            #This can be done much more efficiently, since
     300            #ecl bignums are in fact mpz_t's as well, so it should just consist
     301            #of copying some limbs (beware that ECL bignums do not have
     302            #their limbs managed by GMP. Copying via big_register would probably
     303            #be the best way.
     304            s=str(pyobj)
     305            return string_to_object(s)
     306    elif isinstance(pyobj,Rational):
     307        return ecl_make_ratio(
     308                python_to_ecl( (<Rational>pyobj).numerator()  ),
     309                python_to_ecl( (<Rational>pyobj).denominator()))
     310    elif isinstance(pyobj,EclObject):
     311        return (<EclObject>pyobj).obj
     312    elif isinstance(pyobj,list):
     313        if len(pyobj) == 0:
     314            return Cnil
     315        else:
     316            L=cl_cons(python_to_ecl(pyobj[0]),Cnil)
     317            ptr=L
     318            for a in pyobj[1:]:
     319                cl_rplacd(ptr,cl_cons(python_to_ecl(a),Cnil))
     320                ptr=cl_cdr(ptr)
     321            return L
     322    elif isinstance(pyobj,tuple):
     323        if len(pyobj) == 0:
     324            return Cnil
     325        elif len(pyobj) == 1:
     326            return python_to_ecl(pyobj[0])
     327        else:
     328            L=cl_cons(python_to_ecl(pyobj[0]),Cnil)
     329            ptr=L
     330            for a in pyobj[1:-1]:
     331                cl_rplacd(ptr,cl_cons(python_to_ecl(a),Cnil))
     332                ptr=cl_cdr(ptr)
     333            cl_rplacd(ptr,python_to_ecl(pyobj[-1]))
     334            return L
     335    else:
     336        raise TypeError,"Unimplemented type for python_to_ecl"
     337
     338cdef ecl_to_python(cl_object o):
     339    # conversions from an ecl object to a python object.
     340
     341    if o == Cnil:
     342        return None
     343    elif bint_fixnump(o):
     344        #SAGE specific conversion
     345        #return ecl_fixint(o)
     346        return Integer(ecl_fixint(o))
     347    elif bint_integerp(o):
     348        #SAGE specific conversion
     349        #return int(ecl_base_string_pointer_safe(cl_write_to_string(1,o)))
     350        #this routine can be made much more efficient.
     351        return Integer(ecl_base_string_pointer_safe(cl_write_to_string(1,o)))
     352    elif bint_rationalp(o):
     353        #SAGE specific conversion
     354        #vanilla python does not have a class to represent rational numbers
     355        return Rational((ecl_to_python(cl_numerator(o)),ecl_to_python(cl_denominator(o))))
     356    elif bint_floatp(o):
     357        #Python conversion
     358        #Since SAGE mainly uses mpfr, perhaps "double is not an appropriate return type
     359        return ecl_to_double(o)
     360    elif o == Ct:
     361        return True
     362    elif bint_consp(o):
     363        L=[]
     364        while o != Cnil:
     365            L.append(ecl_to_python(cl_car(o)))
     366            o = cl_cdr(o)
     367            if not(bint_listp(o)):
     368                L.append(ecl_to_python(o))
     369                return tuple(L)
     370        return L
     371    else:
     372        return ecl_base_string_pointer_safe(cl_write_to_string(1,o))
     373
     374#Maxima's BFLOAT multiprecision float type can be read with:
     375#def bfloat_to_python(e):
     376#  prec=Integer(str(e.car().cddr().car()))
     377#  mant=Integer(str(e.cdr().car()))
     378#  exp=Integer(str(e.cddr().car()))
     379#  return 2^(exp-prec)*mant
     380
     381cdef class EclObject:
     382    r"""
     383    Python wrapper of ECL objects
     384   
     385    The ``EclObject`` forms a wrapper around ECL objects. The wrapper ensures
     386    that the data structure pointed to is protected from garbage collection in
     387    ECL by installing a pointer to it from a global data structure within the
     388    scope of the ECL garbage collector. This pointer is destroyed upon
     389    destruction of the EclObject.
     390   
     391    EclObject() takes a Python object and tries to find a representation of it
     392    in Lisp.
     393   
     394    EXAMPLES:
     395   
     396    Python lists get mapped to LISP lists. None and Boolean values to
     397    appropriate values in LISP::
     398   
     399        sage: from sage.libs.ecl import *
     400        sage: EclObject([None,true,false])
     401        <ECL: (NIL T NIL)>
     402       
     403    Numerical values are translated to the appropriate type in LISP::
     404   
     405        sage: EclObject(1)
     406        <ECL: 1>
     407        sage: EclObject(10**40)
     408        <ECL: 10000000000000000000000000000000000000000>
     409        sage: EclObject(float(10**40))
     410        <ECL: 9.999999999999999d39>
     411       
     412    Tuples are translated to dotted lists::
     413   
     414        sage: EclObject( (false, true))
     415        <ECL: (NIL . T)>
     416       
     417    Strings are fed to the reader, so a string normally results in a symbol::
     418   
     419        sage: EclObject("Symbol")
     420        <ECL: SYMBOL>
     421       
     422    But with proper quotation one can construct a lisp string object too::
     423   
     424        sage: EclObject('"Symbol"')
     425        <ECL: "Symbol">
     426       
     427    EclObjects translate to themselves, so one can mix::
     428   
     429        sage: EclObject([1,2,EclObject([3])])
     430        <ECL: (1 2 (3))>
     431   
     432    Calling an EclObject translates into the appropriate LISP ``apply'',
     433    where the argument is transformed into an EclObject itself, so one can
     434    flexibly apply LISP functions::
     435   
     436        sage: car=EclObject("car")
     437        sage: cdr=EclObject("cdr")
     438        sage: car(cdr([1,2,3]))
     439        <ECL: 2>
     440       
     441    and even construct and evaluate arbitrary S-expressions::
     442   
     443        sage: eval=EclObject("eval")
     444        sage: quote=EclObject("quote")
     445        sage: eval([car, [cdr, [quote,[1,2,3]]]])
     446        <ECL: 2>
     447       
     448    """
     449    cdef cl_object obj   #the wrapped object
     450    cdef cl_object node  #linked list pointer: car(node) == obj
     451
     452    cdef void set_obj(EclObject self, cl_object o):
     453        if self.node:
     454            remove_node(self.node)
     455            self.node=NULL
     456        self.obj=o
     457        if not(bint_fixnump(o) or bint_characterp(o) or bint_nullp(o)):
     458            self.node=insert_node_after(list_of_objects,o)
     459
     460    def __init__(self,*args):
     461        r"""
     462        Create an EclObject
     463
     464        See EclObject for full documentation.
     465
     466        EXAMPLES::
     467
     468            sage: from sage.libs.ecl import *
     469            sage: EclObject([None,true,false])
     470            <ECL: (NIL T NIL)>
     471
     472        """
     473        if len(args) != 0:
     474            self.set_obj(python_to_ecl(args[0]))
     475
     476    def __reduce__(self):
     477        r"""
     478        This is used for pickling. Not implemented
     479       
     480        Ecl does not natively support serialization of its objects, so the
     481        python wrapper class EclObject does not support pickling. There are
     482        independent efforts for developing serialization for Common Lisp, such as
     483        CL-STORE. Look at those if you need serialization of ECL objects.
     484       
     485        EXAMPLES::
     486
     487            sage: from sage.libs.ecl import *
     488            sage: s=EclObject([1,2,3])
     489            sage: s.__reduce__()
     490            Traceback (most recent call last):
     491            ...
     492            NotImplementedError: EclObjects do not have a pickling method
     493            sage: s==loads(dumps(s))
     494            Traceback (most recent call last):
     495            ...
     496            NotImplementedError: EclObjects do not have a pickling method       
     497        """
     498        raise NotImplementedError, "EclObjects do not have a pickling method"
     499
     500    def python(self):
     501        r"""
     502        Convert an EclObject to a python object.
     503
     504        EXAMPLES::
     505
     506            sage: from sage.libs.ecl import *
     507            sage: L=EclObject([1,2,("three",'"four"')])
     508            sage: L.python()
     509            [1, 2, ('THREE', '"four"')]
     510
     511        """
     512        return ecl_to_python(self.obj)
     513
     514    def __dealloc__(self):
     515        r"""
     516        Deallocate EclObject
     517
     518        It is important to remove the GC preventing reference to the object upon
     519        deletion of the wrapper.
     520
     521        EXAMPLES::
     522
     523            sage: from sage.libs.ecl import *
     524            sage: L=EclObject("symbol")
     525            sage: del L
     526
     527        """
     528        if self.node:
     529            remove_node(self.node)
     530       
     531    def __repr__(self):
     532        r"""
     533        Produce a string representation suitable for interactive printing.
     534
     535        Converts the wrapped LISP object to a string, decorated in such a way that
     536        it can be recognised as a LISP object.
     537
     538        EXAMPLES::
     539
     540            sage: from sage.libs.ecl import *
     541            sage: L=EclObject("symbol")
     542            sage: repr(L)
     543            '<ECL: SYMBOL>'
     544
     545        """
     546        return "<ECL: "+str(self)+">"
     547       
     548    def __str__(self):
     549        r"""
     550        Produce a string representation.
     551
     552        Converts the wrapped LISP object to a string and returns that as a Python
     553        string.
     554
     555        EXAMPLES::
     556
     557            sage: from sage.libs.ecl import *
     558            sage: L=EclObject("symbol")
     559            sage: str(L)
     560            'SYMBOL'
     561
     562        """
     563        cdef cl_object s
     564        s = cl_write_to_string(1,self.obj)
     565        return ecl_base_string_pointer_safe(s)
     566
     567    def __hash__(self):
     568        r"""
     569        Return a hash value of the object
     570
     571        Returns the hash value returned by SXHASH, which is a routine that is
     572        specified in Common Lisp. According to the specification, lisp objects that
     573        are EQUAL have the same SXHASH value. Since two EclObjects are equal if
     574        their wrapped objects are EQUAL according to lisp, this is compatible with
     575        Python's concept of hash values.
     576
     577        It is not possible to enforce immutability of lisp objects, so care should
     578        be taken in using EclObjects as dictionary keys.
     579
     580        EXAMPLES::
     581
     582            sage: from sage.libs.ecl import *
     583            sage: L=EclObject([1,2])
     584            sage: L
     585            <ECL: (1 2)>
     586            sage: hash(L) #random
     587            463816586
     588            sage: L.rplacd(EclObject(3))
     589            sage: L
     590            <ECL: (1 . 3)>
     591            sage: hash(L) #random
     592            140404060
     593
     594        """
     595        return ecl_fixint(cl_sxhash(self.obj))
     596
     597    def __call__(self, *args):
     598        r"""
     599        Apply self to arguments.
     600
     601        EXAMPLES::
     602
     603            sage: from sage.libs.ecl import *
     604            sage: sqr=EclObject("(lambda (x) (* x x))").eval()
     605            sage: sqr(10)
     606            <ECL: 100>
     607
     608        """
     609        lispargs = EclObject(list(args))
     610        return ecl_wrap(ecl_safe_apply(self.obj,(<EclObject>lispargs).obj))
     611
     612    def __richcmp__(left, right, int op):
     613        r"""
     614        Comparison test.
     615
     616        An EclObject is not equal to any non-EclObject. Two EclObjects are equal
     617        if their wrapped lisp objects are EQUAL. Since LISP has no univeral ordering,
     618        less than and greater than tests are not implemented for EclObjects.
     619
     620        EXAMPLES::
     621
     622            sage: from sage.libs.ecl import *
     623            sage: a=EclObject(1)
     624            sage: b=EclObject(2)
     625            sage: a==b
     626            False
     627            sage: a<b
     628            Traceback (most recent call last):
     629            ...
     630            NotImplementedError: EclObjects can only be compared for equality
     631            sage: EclObject("<")(a,b)
     632            <ECL: T>
     633
     634        """
     635   
     636        if   op == 2: # "=="
     637            if not(isinstance(left,EclObject)) or not(isinstance(right,EclObject)):
     638                return False
     639            else:
     640                return bint_equal((<EclObject>left).obj,(<EclObject>right).obj)
     641        elif op == 3: # "!="
     642            if not(isinstance(left,EclObject)) or not(isinstance(right,EclObject)):
     643                return True
     644            else:
     645                return not(bint_equal((<EclObject>left).obj,(<EclObject>right).obj))
     646
     647        #Common lisp only seems to be able to compare numeric and string types
     648        #and does not have generic routines for doing that.
     649        #we could dispatch based on type here, but that seems
     650        #inappropriate for an *interface*.
     651        raise NotImplementedError,"EclObjects can only be compared for equality"
     652 
     653        if not(isinstance(left,EclObject)) or not(isinstance(right,EclObject)):
     654            raise TypeError,"Can only compare EclObjects"
     655        if op == 0: # "<"
     656            pass
     657        elif op == 1: # "<="
     658            pass
     659        elif op == 4: # ">"
     660            pass
     661        elif op == 5: # ">="
     662            pass
     663        else:
     664            raise ValueError,"richcmp received operation code %d"%op
     665
     666    def eval(self):
     667        r"""
     668        Evaluate object as an S-Expression
     669
     670        EXAMPLES::
     671
     672            sage: from sage.libs.ecl import *
     673            sage: S=EclObject("(+ 1 2)")
     674            sage: S
     675            <ECL: (+ 1 2)>
     676            sage: S.eval()
     677            <ECL: 3>
     678
     679        """
     680        cdef cl_object o
     681        o=ecl_safe_eval(self.obj)
     682        if o == NULL:
     683            raise RuntimeError,"ECL runtime error"
     684        return ecl_wrap(o)
     685
     686    def cons(self,EclObject d):
     687        r"""
     688        apply cons to self and argument and return the result.
     689
     690        EXAMPLES::
     691
     692            sage: from sage.libs.ecl import *
     693            sage: a=EclObject(1)
     694            sage: b=EclObject(2)
     695            sage: a.cons(b)
     696            <ECL: (1 . 2)>
     697
     698        """
     699        return ecl_wrap(cl_cons(self.obj,d.obj))
     700
     701    def rplaca(self,EclObject d):
     702        r"""
     703        Destructively replace car(self) with d.
     704
     705        EXAMPLES::
     706
     707            sage: from sage.libs.ecl import *
     708            sage: L=EclObject((1,2))
     709            sage: L
     710            <ECL: (1 . 2)>
     711            sage: a=EclObject(3)
     712            sage: L.rplaca(a)
     713            sage: L
     714            <ECL: (3 . 2)>
     715
     716        """
     717        if not(bint_consp(self.obj)):
     718            raise TypeError,"rplaca can only be applied to a cons"
     719        cl_rplaca(self.obj, d.obj)
     720       
     721       
     722    def rplacd(self,EclObject d):
     723        r"""
     724        Destructively replace cdr(self) with d.
     725
     726        EXAMPLES::
     727
     728            sage: from sage.libs.ecl import *
     729            sage: L=EclObject((1,2))
     730            sage: L
     731            <ECL: (1 . 2)>
     732            sage: a=EclObject(3)
     733            sage: L.rplacd(a)
     734            sage: L
     735            <ECL: (1 . 3)>
     736
     737        """
     738        if not(bint_consp(self.obj)):
     739            raise TypeError,"rplacd can only be applied to a cons"
     740        cl_rplacd(self.obj, d.obj)
     741
     742    def car(self):
     743        r"""
     744        Return the car of self
     745
     746        EXAMPLES::
     747
     748            sage: from sage.libs.ecl import *
     749            sage: L=EclObject([[1,2],[3,4]])
     750            sage: L.car()
     751            <ECL: (1 2)>
     752            sage: L.cdr()
     753            <ECL: ((3 4))>
     754            sage: L.caar()
     755            <ECL: 1>
     756            sage: L.cadr()
     757            <ECL: (3 4)>
     758            sage: L.cdar()
     759            <ECL: (2)>
     760            sage: L.cddr()
     761            <ECL: NIL>   
     762        """
     763        if not(bint_consp(self.obj)):
     764            raise TypeError,"car can only be applied to a cons"
     765        return ecl_wrap(cl_car(self.obj))
     766
     767    def cdr(self):
     768        r"""
     769        Return the cdr of self
     770
     771        EXAMPLES::
     772
     773            sage: from sage.libs.ecl import *
     774            sage: L=EclObject([[1,2],[3,4]])
     775            sage: L.car()
     776            <ECL: (1 2)>
     777            sage: L.cdr()
     778            <ECL: ((3 4))>
     779            sage: L.caar()
     780            <ECL: 1>
     781            sage: L.cadr()
     782            <ECL: (3 4)>
     783            sage: L.cdar()
     784            <ECL: (2)>
     785            sage: L.cddr()
     786            <ECL: NIL>   
     787        """
     788        if not(bint_consp(self.obj)):
     789            raise TypeError,"cdr can only be applied to a cons"
     790        return ecl_wrap(cl_cdr(self.obj))
     791
     792    def caar(self):
     793        r"""
     794        Return the caar of self
     795
     796        EXAMPLES::
     797
     798            sage: from sage.libs.ecl import *
     799            sage: L=EclObject([[1,2],[3,4]])
     800            sage: L.car()
     801            <ECL: (1 2)>
     802            sage: L.cdr()
     803            <ECL: ((3 4))>
     804            sage: L.caar()
     805            <ECL: 1>
     806            sage: L.cadr()
     807            <ECL: (3 4)>
     808            sage: L.cdar()
     809            <ECL: (2)>
     810            sage: L.cddr()
     811            <ECL: NIL>   
     812        """
     813        if not(bint_consp(self.obj) and bint_consp(cl_car(self.obj))):
     814            raise TypeError,"caar can only be applied to a cons"
     815        return ecl_wrap(cl_caar(self.obj))
     816
     817    def cadr(self):
     818        r"""
     819        Return the cadr of self
     820
     821        EXAMPLES::
     822
     823            sage: from sage.libs.ecl import *
     824            sage: L=EclObject([[1,2],[3,4]])
     825            sage: L.car()
     826            <ECL: (1 2)>
     827            sage: L.cdr()
     828            <ECL: ((3 4))>
     829            sage: L.caar()
     830            <ECL: 1>
     831            sage: L.cadr()
     832            <ECL: (3 4)>
     833            sage: L.cdar()
     834            <ECL: (2)>
     835            sage: L.cddr()
     836            <ECL: NIL>   
     837        """
     838        if not(bint_consp(self.obj) and bint_consp(cl_cdr(self.obj))):
     839            raise TypeError,"cadr can only be applied to a cons"
     840        return ecl_wrap(cl_cadr(self.obj))
     841
     842    def cdar(self):
     843        r"""
     844        Return the cdar of self
     845
     846        EXAMPLES::
     847
     848            sage: from sage.libs.ecl import *
     849            sage: L=EclObject([[1,2],[3,4]])
     850            sage: L.car()
     851            <ECL: (1 2)>
     852            sage: L.cdr()
     853            <ECL: ((3 4))>
     854            sage: L.caar()
     855            <ECL: 1>
     856            sage: L.cadr()
     857            <ECL: (3 4)>
     858            sage: L.cdar()
     859            <ECL: (2)>
     860            sage: L.cddr()
     861            <ECL: NIL>   
     862        """
     863        if not(bint_consp(self.obj) and bint_consp(cl_car(self.obj))):
     864            raise TypeError,"cdar can only be applied to a cons"
     865        return ecl_wrap(cl_cdar(self.obj))
     866
     867    def cddr(self):
     868        r"""
     869        Return the cddr of self
     870
     871        EXAMPLES::
     872
     873            sage: from sage.libs.ecl import *
     874            sage: L=EclObject([[1,2],[3,4]])
     875            sage: L.car()
     876            <ECL: (1 2)>
     877            sage: L.cdr()
     878            <ECL: ((3 4))>
     879            sage: L.caar()
     880            <ECL: 1>
     881            sage: L.cadr()
     882            <ECL: (3 4)>
     883            sage: L.cdar()
     884            <ECL: (2)>
     885            sage: L.cddr()
     886            <ECL: NIL>   
     887        """
     888        if not(bint_consp(self.obj) and bint_consp(cl_cdr(self.obj))):
     889            raise TypeError,"cddr can only be applied to a cons"
     890        return ecl_wrap(cl_cddr(self.obj))       
     891
     892    def fixnump(self):
     893        r"""
     894        Return True if self is a fixnum, False otherwise
     895
     896        EXAMPLES::
     897
     898            sage: from sage.libs.ecl import *
     899            sage: EclObject(2**3).fixnump()
     900            True
     901            sage: EclObject(2**200).fixnump()
     902            False
     903
     904        """
     905        return bint_fixnump(self.obj)
     906
     907    def characterp(self):
     908        r"""
     909        Return True if self is a character, False otherwise
     910
     911        Strings are not characters
     912
     913        EXAMPLES:
     914
     915            sage: from sage.libs.ecl import *
     916            sage: EclObject('"a"').characterp()
     917            False
     918
     919        """
     920        return bint_characterp(self.obj)
     921
     922    def nullp(self):
     923        r"""
     924        Return True if self is NIL, False otherwise
     925
     926        EXAMPLES::
     927
     928            sage: from sage.libs.ecl import *
     929            sage: EclObject([]).nullp()
     930            True
     931            sage: EclObject([[]]).nullp()
     932            False
     933        """
     934        return bint_nullp(self.obj)
     935   
     936    def listp(self):
     937        r"""
     938        Return True if self is a list, False otherwise. NIL is a list.
     939
     940        EXAMPLES::
     941
     942            sage: from sage.libs.ecl import *
     943            sage: EclObject([]).listp()
     944            True
     945            sage: EclObject([[]]).listp()
     946            True
     947        """
     948        return bint_listp(self.obj)
     949   
     950    def consp(self):
     951        r"""
     952        Return True if self is a cons, False otherwise. NIL is not a cons.
     953
     954        EXAMPLES::
     955
     956            sage: from sage.libs.ecl import *
     957            sage: EclObject([]).consp()
     958            False
     959            sage: EclObject([[]]).consp()
     960            True
     961        """
     962        return bint_consp(self.obj)
     963       
     964    def atomp(self):
     965        r"""
     966        Return True if self is atomic, False otherwise.
     967
     968        EXAMPLES::
     969
     970            sage: from sage.libs.ecl import *
     971            sage: EclObject([]).atomp()
     972            True
     973            sage: EclObject([[]]).atomp()
     974            False
     975
     976        """
     977        return bint_atomp(self.obj)
     978
     979    def symbolp(self):
     980        r"""
     981        Return True if self is a symbol, False otherwise.
     982
     983        EXAMPLES::
     984
     985            sage: from sage.libs.ecl import *
     986            sage: EclObject([]).symbolp()
     987            True
     988            sage: EclObject([[]]).symbolp()
     989            False
     990
     991        """
     992        return bint_symbolp(self.obj)
     993
     994#input: a cl-object. Output: EclObject wrapping that.
     995cdef EclObject ecl_wrap(cl_object o):
     996    cdef EclObject obj
     997    obj = EclObject()
     998    obj.set_obj(o)
     999    return obj
     1000
     1001#convenience routine to more easily evaluate strings
     1002cpdef EclObject ecl_eval(bytes s):
     1003    """
     1004    Read and evaluate string in Lisp and return the result
     1005   
     1006    EXAMPLES::
     1007
     1008        sage: from sage.libs.ecl import *
     1009        sage: ecl_eval("(defun fibo (n)(cond((= n 0) 0)((= n 1) 1)(T (+ (fibo (- n 1)) (fibo (- n 2))))))")
     1010        <ECL: FIBO>
     1011        sage: ecl_eval("(mapcar 'fibo '(1 2 3 4 5 6 7))")
     1012        <ECL: (1 1 2 3 5 8 13)>
     1013
     1014    """
     1015    cdef cl_object o
     1016    o=ecl_safe_read_string(s)
     1017    o=ecl_safe_eval(o)
     1018    return ecl_wrap(o)
     1019
     1020init_ecl()