"""Generates the wrapper for derived types.
"""
import sys
import fvars
import string
if sys.hexversion >= 0x20501f0:
    import hashlib
else:
    # --- hashlib was not available in python earlier than 2.5.
    import md5 as hashlib
from cfinterface import *

class ForthonDerivedType:
    def __init__(self,typelist,pname,c,f,isz,writemodules,fcompname):
        if not typelist: return

        self.cfile = open(c,'a')
        self.ffile = open(f,'a')
        self.wrapderivedtypes(typelist,pname,isz,writemodules,fcompname)
        self.cfile.close()
        self.ffile.close()

    transtable = (10*string.ascii_lowercase)[:256]
    def fsub(self,type,prefix,suffix='',dohash=1):
        """
        The fortran standard limits routine names to 31 characters. If the
        routine name is longer than that, this routine takes the first 15
        characters and and creates a hashed string based on the full name to get
        the next 16. This does not guarantee uniqueness, but the nonuniqueness
        should be minute.
        """
        name = type.name+prefix+suffix
        if len(name) < 32 or not dohash: return name
        transtable = ForthonDerivedType.transtable
        if sys.hexversion >= 0x03000000:
            hashbytes = hashlib.md5(name.encode()).digest()
            hash = ''.join([transtable[d] for d in hashbytes])
        else:
            hash = hashlib.md5(name).digest().translate(transtable)
        return name[:15] + hash

    def dimisparameter(self,dim):
        # --- Convert fortran variable name into reference from list of variables
        # --- and check if it is a parameter.
        sl=re.split('[ ()/\*\+\-]',dim)
        for ss in sl:
            if re.search('[a-zA-Z]',ss) != None:
                try:
                    v = self.slist[self.sdict[ss]]
                    if v.parameter:
                        return True
                except KeyError:
                    pass
        return False

    def prefixdimsc(self,dim):
        # --- Convert fortran variable name into reference from list of variables.
        sl=re.split('[ ()/\*\+\-]',dim)
        for ss in sl:
            if re.search('[a-zA-Z]',ss) != None:
                if ss in self.sdict:
                    dim = re.sub(ss,'*(long *)obj->fscalars['+repr(self.sdict[ss])+'].data',
                                 dim,count=1)
                else:
                    raise SyntaxError('%s from dim %s is not declared in a .v file'%(ss,dim))
        return dim.lower()

    # --- Convert variable names in to type elements
    def prefixdimsf(self,dim):
        sl=re.split('[ ()/\*\+\-:,]',dim)
        # --- Loop over the list of items twice. The first time, add in the 'obj%'
        # --- prefix but overwrite the item with '=='. Then go back again and
        # --- overwrite the '==' with the item. This is done in case one name
        # --- has another in it or a item is repeated. Note that this could also
        # --- be done instead by using re syntax in the substring being searched
        # --- for, by forcing complete words to be found, without a leading % sign.
        # --- But this works as is and is fast enough.
        for ss in sl:
            if re.search('[a-zA-Z]',ss) != None:
                if ss in self.sdict:
                    dim = re.sub(ss,'fobj__%==',dim,count=1)
        for ss in sl:
            if re.search('[a-zA-Z]',ss) != None:
                if ss in self.sdict:
                    dim = re.sub('==',ss,dim,count=1)
        # --- Check for any unspecified dimensions and replace it with an element
        # --- from the dims array.
        sl = re.split(',',dim[1:-1])
        for i in range(len(sl)):
            if sl[i] == ':': sl[i] = 'dims__(%d)'%(i+1)
        dim = '(' + ','.join(sl) + ')'
        return dim.lower()

    # --------------------------------------------
    def cw(self,text,noreturn=0):
        if noreturn:
            self.cfile.write(text)
        else:
            self.cfile.write(text+'\n')
    def fw(self,text,noreturn=0):
        i = 0
        while len(text[i:]) > 132 and text[i:].find('&') == -1:
            # --- If the line is too long, then break it up, adding line
            # --- continuation marks in between any variable names.
            # --- This is the same as \W, but also skips %, since PG compilers
            # --- don't seem to like a line continuation mark just before a %.
            ss = re.search('[^a-zA-Z0-9_%]',text[i+130::-1])
            assert ss is not None,\
                   "Forthon can't find a place to break up this line:\n"+text
            text = text[:i+130-ss.start()] + '&\n' + text[i+130-ss.start():]
            i += 130 - ss.start() + 1
        if noreturn:
            self.ffile.write(text)
        else:
            self.ffile.write(text+'\n')

    # --- This is the routine that does all of the work for derived types
    def wrapderivedtypes(self,typelist,pname,isz,writemodules,fcompname):

        for t in typelist:
            self.cw('')
            vlist = t.vlist[:]

            self.cw('static char* %spointee__ = "%s";'%(t.name,t.name))

            # --- Select out all of the scalars and build a dictionary
            # --- The dictionary is used to get number of the variables use as
            # --- dimensions for arrays.
            slist = []
            self.sdict = {}
            i = 0
            temp = vlist[:]
            for v in temp:
                if not v.dims and not v.function:
                    slist.append(v)
                    self.sdict[v.name] = i
                    i = i + 1
                    vlist.remove(v)

            # --- Select out all of the arrays
            alist = []
            i = 0
            temp = vlist[:]
            for v in temp:
                if not v.function:
                    alist.append(v)
                    i = i + 1
                    vlist.remove(v)
            temp = []

            self.slist = slist

            #########################################################################
            # --- Print out the external commands
            self.cw('extern void '+fname(self.fsub(t,'passpointers'))+'(char *fobj,'+
                                                             'long *setinitvalues);')
            self.cw('extern void '+fname(self.fsub(t,'nullifypointers'))+
                                                             '(char *fobj);')
            self.cw('extern PyObject *'+fname(self.fsub(t,'newf'))+'(void);')
            self.cw('extern void '+fname(self.fsub(t,'deallocatef'))+'(char *);')
            self.cw('extern void '+fname(self.fsub(t,'nullifycobjf'))+'(char *);')

            # --- setpointer and getpointer routine
            # --- Note that setpointer get written out for all derived types -
            # --- for non-dynamic derived types, the setpointer routine does a copy.
            for s in slist:
                if (s.dynamic or s.derivedtype) and not s.parameter:
                    self.cw('extern void '+fname(self.fsub(t,'setscalarpointer',s.name))+
                            '(char *p,char *fobj__,npy_intp *nullit__);')
                if s.dynamic:
                    self.cw('extern void '+fname(self.fsub(t,'getscalarpointer',s.name))+
                            '(ForthonObject **cobj__,char *fobj__,int *createnew__);')
            for a in alist:
                self.cw('extern void '+fname(self.fsub(t,'setarraypointer',a.name))+
                          '(char *p,char *fobj__,npy_intp *dims__);')
                if a.dynamic or re.search('fassign',a.attr):
                    self.cw('extern void '+fname(self.fsub(t,'getarraypointer',a.name))+
                            '(Fortranarray *farray__,char* fobj__);')
            self.cw('')

            # --- setaction and getaction routines
            for s in slist:
                if s.setaction is not None:
                    self.cw('extern void '+fname(self.fsub(t,'setaction',s.name))+
                            '(char *fobj,'+fvars.ftoc_dict[s.type]+' *v);')
                if s.getaction is not None:
                    self.cw('extern void '+fname(self.fsub(t,'getaction',s.name))+
                            '(char *fobj);')
            for a in alist:
                if a.setaction is not None:
                    self.cw('extern void '+fname(self.fsub(t,'setaction',a.name))+
                            '(char *fobj,'+fvars.ftoc_dict[a.type]+' *v);')
                if a.getaction is not None:
                    self.cw('extern void '+fname(self.fsub(t,'getaction',a.name))+
                            '(char *fobj);')
            self.cw('')

            #########################################################################
            # --- Write declarations of c pointers to fortran variables
            self.cw('void '+t.name+'declarevars(ForthonObject *obj) {')

            # --- Scalars
            self.cw('obj->nscalars = '+repr(len(slist))+';')
            if len(slist) > 0:
                self.cw('obj->fscalars = PyMem_Malloc(obj->nscalars*sizeof(Fortranscalar));')
            else:
                self.cw('obj->fscalars = NULL;')
            for i in range(len(slist)):
                s = slist[i]
                if (s.dynamic or s.derivedtype) and not s.parameter:
                    setscalarpointer = '*'+fname(self.fsub(t,'setscalarpointer',s.name))
                else:
                    setscalarpointer = 'NULL'
                if s.dynamic: getscalarpointer = '*'+fname(self.fsub(t,'getscalarpointer',s.name))
                else:         getscalarpointer = 'NULL'
                if s.setaction is None:
                    setaction = 'NULL'
                else:
                    setaction = '*'+fname(self.fsub(t,'setaction',s.name))
                if s.getaction is None:
                    getaction = 'NULL'
                else:
                    getaction = '*'+fname(self.fsub(t,'getaction',s.name))
                self.cw('obj->fscalars[%d].type = NPY_%s;'%(i,fvars.ftop(s.type)))
                self.cw('obj->fscalars[%d].typename = "%s";'%(i,s.type))
                self.cw('obj->fscalars[%d].name = "%s";'%(i,s.name))
                self.cw('obj->fscalars[%d].data = NULL;'%i)
                self.cw('obj->fscalars[%d].group = "%s";'%(i,t.name))
                self.cw('obj->fscalars[%d].attributes = "%s";'%(i,s.attr))
                self.cw('obj->fscalars[%d].comment = "%s";'%(i,
                                     repr(s.comment)[1:-1].replace('"','\\"')))
                                     # The repr is used so newlines get written out
                                     # as \n.
                self.cw('obj->fscalars[%d].dynamic = %d;'%(i,s.dynamic))
                self.cw('obj->fscalars[%d].parameter = %d;'%(i,s.parameter))
                self.cw('obj->fscalars[%d].setscalarpointer = %s;'%(i,setscalarpointer))
                self.cw('obj->fscalars[%d].getscalarpointer = %s;'%(i,getscalarpointer))
                self.cw('obj->fscalars[%d].setaction = %s;'%(i,setaction))
                self.cw('obj->fscalars[%d].getaction = %s;'%(i,getaction))

            # --- Arrays
            self.cw('obj->narrays = '+repr(len(alist))+';')
            if len(alist) > 0:
                self.cw('obj->farrays = PyMem_Malloc(obj->narrays*sizeof(Fortranarray));')
            else:
                self.cw('obj->farrays = NULL;')
            for i in range(len(alist)):
                a = alist[i]
                if a.dynamic:
                    setarraypointer = '*'+fname(self.fsub(t,'setarraypointer',a.name))
                else:
                    setarraypointer = 'NULL'
                if a.dynamic or re.search('fassign',a.attr):
                    getarraypointer = '*'+fname(self.fsub(t,'getarraypointer',a.name))
                else:
                    getarraypointer = 'NULL'
                if a.setaction is None:
                    setaction = 'NULL'
                else:
                    setaction = '*'+fname(self.fsub(t,'setaction',a.name))
                if a.getaction is None:
                    getaction = 'NULL'
                else:
                    getaction = '*'+fname(self.fsub(t,'getaction',a.name))
                if a.data and a.dynamic: initvalue = a.data[1:-1]
                else:                    initvalue = '0'
                self.cw('obj->farrays[%d].type = NPY_%s;'%(i,fvars.ftop(a.type)))
                self.cw('obj->farrays[%d].dynamic = %d;'%(i,a.dynamic))
                self.cw('obj->farrays[%d].nd = %d;'%(i,len(a.dims)))
                self.cw('obj->farrays[%d].dimensions = (npy_intp*)NULL;'%i)
                self.cw('obj->farrays[%d].name = "%s";'%(i,a.name))
                self.cw('obj->farrays[%d].data.s = (char *)NULL;'%i)
                self.cw('obj->farrays[%d].setarraypointer = %s;'%(i,setarraypointer))
                self.cw('obj->farrays[%d].getarraypointer = %s;'%(i,getarraypointer))
                self.cw('obj->farrays[%d].setaction = %s;'%(i,setaction))
                self.cw('obj->farrays[%d].getaction = %s;'%(i,getaction))
                self.cw('obj->farrays[%d].initvalue = %s;'%(i,initvalue))
                self.cw('obj->farrays[%d].pya = NULL;'%i)
                self.cw('obj->farrays[%d].group = "%s";'%(i,a.group))
                self.cw('obj->farrays[%d].attributes = "%s";'%(i,a.attr))
                self.cw('obj->farrays[%d].comment = "%s";'%(i,
                                    repr(a.comment)[1:-1].replace('"','\\"')))
                self.cw('obj->farrays[%d].dimstring = "%s";'%(i,repr(a.dimstring)[1:-1]))
            self.cw('}')

#     # --- Write out the table of getset routines
#     self.cw('')
#     self.cw('static PyGetSetDef '+t.name+'_getseters[] = {')
#     for i in range(len(slist)):
#       s = slist[i]
#       if s.type == 'real': gstype = 'double'
#       elif s.type == 'double': gstype = 'double'
#       elif s.type == 'float': gstype = 'float'
#       elif s.type == 'integer': gstype = 'integer'
#       elif s.type == 'complex': gstype = 'cdouble'
#       else:                    gstype = 'derivedtype'
#       self.cw('{"'+s.name+'",(getter)Forthon_getscalar'+gstype+
#                            ',(setter)Forthon_setscalar'+gstype+
#                      ',"%s"'%repr(s.comment)[1:-1].replace('"','\\"') +
#                           ',(void *)'+repr(i)+'},')
#     for i in range(len(alist)):
#       a = alist[i]
#       self.cw('{"'+a.name+'",(getter)Forthon_getarray'+
#                            ',(setter)Forthon_setarray'+
#                      ',"%s"'%repr(a.comment)[1:-1].replace('"','\\"') +
#                           ',(void *)'+repr(i)+'},')
#     self.cw('{"scalardict",(getter)Forthon_getscalardict,'+
#                           '(setter)Forthon_setscalardict,'+
#             '"internal scalar dictionary",NULL},')
#     self.cw('{"arraydict",(getter)Forthon_getarraydict,'+
#                          '(setter)Forthon_setarraydict,'+
#             '"internal array dictionary",NULL},')
#     self.cw('{NULL}};')

            #########################################################################
            # --- Write static array initialization routines
            self.cw('void '+t.name+'setstaticdims(ForthonObject *obj)')
            self.cw('{')

            i = -1
            for a in alist:
                i = i + 1
                vname = 'obj->farrays[%d]'%i
                if a.dims and not a.dynamic:
                    j = 0
                    for d in a.dims:
                        if d.high == '': continue
                        self.cw('   '+vname+'.dimensions['+repr(j)+']=(npy_intp)((int)',
                                noreturn=1)
                        j = j + 1
                        if re.search('[a-zA-Z]',d.high) == None:
                            self.cw('('+d.high+')-',noreturn=1)
                        else:
                            if not self.dimisparameter(d.high):
                                raise SyntaxError('%s: static dims must be constants or parameters'%a.name)
                            self.cw('('+self.prefixdimsc(d.high)+')-',noreturn=1)
                        if re.search('[a-zA-Z]',d.low) == None:
                            self.cw('('+d.low+')+1);')
                        else:
                            if not self.dimisparameter(d.low):
                                raise SyntaxError('%s: static dims must be constants or parameters'%a.name)
                            self.cw('('+self.prefixdimsc(d.low)+')+1);')
            self.cw('}')

            #########################################################################
            # --- Write routine which sets the dimensions of the dynamic arrays.
            # --- This is done in a seperate routine so it only appears once.
            # --- A routine is written out for each group which has dynamic arrays.
            # --- Then a routine is written which calls all of the individual group
            # --- routines. That is done to reduce the strain on the compiler by
            # --- reducing the size of the routines. (In fact, in one case, with
            # --- everything in one routine, the cc compiler was giving a core dump!)
            # --- Loop over the variables. This assumes that the variables are sorted
            # --- by group.
            self.cw('static void '+t.name+'setdims(char *name,ForthonObject *obj,long i)')
            self.cw('{')

            i = -1
            for a in alist:
                i = i + 1
                vname = 'obj->farrays[%d]'%i
                if a.dynamic == 1 or a.dynamic == 2:
                    j = 0
                    self.cw('  if (i == -1 || i == %d) {'%i)
                    # --- create lines of the form dims[1] = high - low + 1
                    for d in a.dims:
                        if d.high == '': continue
                        self.cw('   '+vname+'.dimensions['+repr(j)+']=(npy_intp)((int)',
                                noreturn=1)
                        j = j + 1
                        if re.search('[a-zA-Z]',d.high) == None:
                            self.cw('('+d.high+')-',noreturn=1)
                        else:
                            self.cw('('+self.prefixdimsc(d.high)+')-',noreturn=1)
                        if re.search('[a-zA-Z]',d.low) == None:
                            self.cw('('+d.low+')+1);')
                        else:
                            self.cw('('+self.prefixdimsc(d.low)+')+1);')
                    self.cw('  }')
            self.cw('}')

            #########################################################################
            # --- Routines to deal with garbage collection. This is only needed
            # --- if a derived type contains pointers to objects of its own type.
            garbagecollected = 0
            # --- Check if type contains pointers to its own type
            for s in slist:
                if s.dynamic and s.type == t.name:
                    garbagecollected = 1

            #########################################################################
            #########################################################################
            self.cw('PyObject *'+pname+'_'+t.name+
                    'New(PyObject *self, PyObject *args)')
            self.cw('{')
            self.cw('  return '+fname(self.fsub(t,'newf'))+'();')
            self.cw('}')
            #########################################################################
            # --- Write out an empty list of methods
            self.cw('static struct PyMethodDef '+t.name+'_methods[]={{NULL,NULL}};')
            #########################################################################
            # --- And finally, the initialization function
            self.cw('void '+fname('init'+t.name+'py')+
                         '(long *i,char *fobj,ForthonObject **cobj__,'+
                          'long *setinitvalues,long *deallocatable)')
            self.cw('{')
            self.cw('  ForthonObject *obj;')
            self.cw('  obj=(ForthonObject *) PyObject_GC_New(ForthonObject,'+
                       '&ForthonType);')
            self.cw('  if (*i > 0) {obj->name = '+pname+'_fscalars[*i].name;}')
            self.cw('  else        {obj->name = %spointee__;}'%t.name)
            self.cw('  obj->typename = "'+t.name+'";')
            self.cw('  '+t.name+'declarevars(obj);')
            self.cw('  obj->setdims = *'+t.name+'setdims;')
            self.cw('  obj->setstaticdims = *'+t.name+'setstaticdims;')
            self.cw('  obj->fmethods = '+t.name+'_methods;')
            self.cw('  obj->__module__ = Py_BuildValue("s","'+pname+'py");')
            self.cw('  obj->fobj = fobj;')
            self.cw('  if (*deallocatable==1)')
            self.cw('    obj->fobjdeallocate=*'+fname(self.fsub(t,'deallocatef'))+';')
            self.cw('  else')
            self.cw('    obj->fobjdeallocate = NULL;')
            self.cw('  obj->nullifycobj=*'+fname(self.fsub(t,'nullifycobjf'))+';')
            self.cw('  obj->allocated = 0;')
            self.cw('  obj->garbagecollected = %d;'%garbagecollected)
            self.cw('  *cobj__ = obj;')
            self.cw('  if (PyErr_Occurred()) {')
            self.cw('    PyErr_Print();')
            self.cw('    Py_FatalError("can not initialize type '+t.name+'");')
            self.cw('    }')
            self.cw('  Forthon_BuildDicts(obj);')
            self.cw('  ForthonPackage_allotdims(obj);')
            self.cw('  '+fname(self.fsub(t,'passpointers'))+'(fobj,setinitvalues);')
            self.cw('  '+fname(self.fsub(t,'nullifypointers'))+'(fobj);')
            self.cw('  ForthonPackage_staticarrays(obj);')
            if garbagecollected:
                self.cw('  PyObject_GC_Track((PyObject *)obj);')
            self.cw('}')

            #########################################################################
            # --- increments the python reference counter
            # --- Note that if the python object associated with the derived type
            # --- instance had not been created, then do so. In that case, an
            # --- INCREF is not needed since the creation itself effectively
            # --- increments the counter from 0 to 1.
            self.cw('void '+fname('incref'+t.name+'py')+
                            '(ForthonObject **cobj__,char *fobj)')
            self.cw('{')
            self.cw('  if (*cobj__ == NULL) {')
            self.cw('    long i=-1,s=0,d=0;')
            self.cw('    '+fname('init'+t.name+'py')+'(&i,fobj,cobj__,&s,&d);}')
            self.cw('  else {')
            self.cw('    Py_INCREF(*cobj__);}')
            self.cw('}')
            # --- decrements the python reference counter
            self.cw('void '+fname('decref'+t.name+'py')+'(ForthonObject **cobj__)')
            self.cw('{')
            self.cw('  Py_XDECREF(*cobj__);')
            self.cw('}')

            # --- This is called when an object is released by fortran. It is then
            # --- up to any python reference holder to deallocate the object.
            self.cw('void '+fname(self.fsub(t,'makedeallocable'))+
                                                 '(ForthonObject **cobj)')
            self.cw('{')
            self.cw('  (*cobj)->fobjdeallocate=*'+fname(self.fsub(t,'deallocatef'))+';')
            self.cw('}')

            #########################################################################
            # --- Write set pointers routine which gets all of the fortran pointers
            self.cw('void '+fname(self.fsub(t,'grabscalarpointers'))+
                    '(long *i,char *p,ForthonObject **obj)')
            self.cw('{')
            self.cw('  /* Grabs pointer for the scalar */')
            self.cw('  (*obj)->fscalars[*i].data = (char *)p;')
            self.cw('}')

            self.cw('void '+fname(self.fsub(t,'setderivedtypepointers'))+
                    '(long *i,char **p,ForthonObject **obj)')
            self.cw('{')
            self.cw('  /* Grabs pointer for the derived type */')
            self.cw('  (*obj)->fscalars[*i].data = (char *)(*p);')
            self.cw('}')

            self.cw('void '+fname(self.fsub(t,'grabarraypointers'))+
                    '(long *i,char *p,ForthonObject **obj)')
            self.cw('{')
            self.cw('  /* Grabs pointer for the array */')
            self.cw('  (*obj)->farrays[*i].data.s = (char *)p;')
            self.cw('}')

            self.cw('void '+fname(self.fsub(t,'grabarraypointersobj'))+
                    '(Fortranarray *farray,char *p)')
            self.cw('{')
            self.cw('  /* Grabs pointer for the array */')
            self.cw('  farray->data.s = (char *)p;')
            self.cw('}')

            # --- This routine gets the dimensions from an array. It is called from
            # --- fortran and the last argument should be shape(array).
            # --- This is only used for routines with the fassign attribute.
            # --- I should check the fortran standard - for the dims argument, the
            # --- fortran is passing in shape(x). Apparently, it is the same length
            # --- as longs.
            self.cw('void '+fname(self.fsub(t,'setarraydims'))+
                    '(Fortranarray *farray,long *dims)')
            self.cw('{')
            self.cw('  int id;')
            self.cw('  for (id=0;id<farray->nd;id++)')
            self.cw('    farray->dimensions[id] = (npy_intp)(dims[id]);')
            self.cw('}')

            #########################################################################
            #########################################################################

            #########################################################################
            # --- Write out f90 modules, including any data statements
            if writemodules:
                self.fw('')
                g = t.name
                self.fw('MODULE '+t.name+'module')

                # --- Check if any variables are derived types. If so, the module
                # --- containing the type must be used. This module though does not
                # --- need to include itself of course.
                printedtypes = [t.name]
                for v in slist + alist:
                    if v.derivedtype:
                        if v.type not in printedtypes:
                            self.fw('  USE '+v.type+'module')
                            printedtypes.append(v.type)

                self.fw('  SAVE')
                self.fw('  TYPE '+t.name+'')
                self.fw('    INTEGER('+isz+'):: cobj__ = 0')
                for s in slist:
                    self.fw('    '+fvars.ftof(s.type),noreturn=1)
                    if s.dynamic: self.fw(',POINTER',noreturn=1)
                    self.fw(':: '+s.name)
                    # --- data statement is handle by the passpointer routine
                for a in alist:
                    if a.dynamic:
                        if a.type == 'character':
                            self.fw('    CHARACTER(LEN='+a.dims[0].high+'),POINTER:: '+
                                    a.name,noreturn=1)
                            ndims = len(a.dims) - 1
                        else:
                            self.fw('    '+fvars.ftof(a.type)+',POINTER:: '+a.name,noreturn=1)
                            ndims = len(a.dims)
                        if ndims > 0:
                            self.fw('('+(ndims*':,')[:-1]+')',noreturn=1)
                        self.fw('')
                    else:
                        if a.type == 'character':
                            self.fw('    CHARACTER(LEN='+a.dims[0].high+'):: '+
                                    a.name+re.sub('[ \t\n]','',a.dimstring),noreturn=1)
                        else:
                            self.fw('    '+fvars.ftof(a.type)+':: '+
                                    a.name+re.sub('[ \t\n]','',a.dimstring))
                        # --- data statement is handle by the passpointer routine
                        #if a.data:
                        #  # --- Add line continuation marks if the data line extends over
                        #  # --- multiple lines.
                        #  dd = re.sub(r'\n','&',a.data)
                        #  self.fw(' = ('+dd+')',noreturn=1)
                        #self.fw('')

                self.fw('  END TYPE '+t.name+'')

                # --- These functions must be in the module so that its return type
                # --- is defined.
                # --- Note that the body of the New function is replicated below in
                # --- the NewF function. Any changes here should be made there.
                self.fw('CONTAINS')
                self.fw('  FUNCTION New'+t.name+'(deallocatable) RESULT(newobj__)')
                self.fw('    TYPE('+t.name+'),pointer:: newobj__')
                self.fw('    INTEGER('+isz+'),OPTIONAL:: deallocatable')
                self.fw('    INTEGER('+isz+'):: d')
                self.fw('    integer:: error')
                self.fw('    ALLOCATE(newobj__,STAT=error)')
                self.fw('    if (error /= 0) then')
                self.fw('      print*,"ERROR during allocation of '+t.name+'"')
                self.fw('      stop')
                self.fw('    endif')
                for s in slist:
                    if s.dynamic:
                        self.fw('    NULLIFY(newobj__%'+s.name+')')
                self.fw('    If (PRESENT(deallocatable)) THEN')
                self.fw('      d = deallocatable')
                self.fw('    ELSE')
                self.fw('      d = 0')
                self.fw('    ENDIF')
                self.fw('    call init'+t.name+'py(int(-1,'+isz+'),newobj__,newobj__%cobj__,int(1,'+isz+'),d)')
                self.fw('    RETURN')
                self.fw('  END FUNCTION New'+t.name+'')
                self.fw('  SUBROUTINE Del'+t.name+'(oldobj__)')
                self.fw('    TYPE('+t.name+'),pointer:: oldobj__')
                self.fw('    call DecRef'+t.name+'(oldobj__)')
                self.fw('    RETURN')
                self.fw('  END SUBROUTINE Del'+t.name+'')
                # --- This routine should be called by fortran instead of deallocate.
                # --- The first decref accounts for the reference "owned" by the
                # --- fortran object itself. If there are no further existing python
                # --- references to the object, then it is just deallocated. If there
                # --- are references, it is made deallocatable by python, so that
                # --- when all of those references are deleted, the object can finally
                # --- be deallocated. The fortran pointer to the instance
                # --- is in all cases nullified. This is necessary so that future
                # --- accesses to the object can detect that the pointer is now
                # --- unassociated. Similarly, all pointers to derived types that this
                # --- object refers to are nullified. This isolates the object,
                # --- breaking its connections to other objects. As far as the fortran
                # --- is concerned, this object no longer exists and should not have
                # --- references to other objects.
                self.fw('  SUBROUTINE Release'+t.name+'(oldobj__)')
                self.fw('    TYPE('+t.name+'),pointer:: oldobj__')
                self.fw('    integer:: error')
                self.fw('    if (oldobj__%cobj__ /= 0) then')
                self.fw('      call decref'+t.name+'py(oldobj__)')
                self.fw('    endif')
                for s in slist:
                    if s.dynamic:
                        self.fw('    if (ASSOCIATED(oldobj__%'+s.name+'))'+
                                                    'NULLIFY(oldobj__%'+s.name+')')
                self.fw('    if (oldobj__%cobj__ == 0) then')
                self.fw('      DEALLOCATE(oldobj__,STAT=error)')
                self.fw('      if (error /= 0) then')
                self.fw('        print*,"ERROR during deallocation of '+t.name+'"')
                self.fw('        stop')
                self.fw('      endif')
                self.fw('    else')
                self.fw('      call '+self.fsub(t,'makedeallocable')+'(oldobj__%cobj__)')
                self.fw('    endif')
                self.fw('    NULLIFY(oldobj__)')
                self.fw('    RETURN')
                self.fw('  END SUBROUTINE Release'+t.name+'')
                # --- This routine is needed to get around limitations
                # --- on subroutine arguments. A variable must be a pointer (or
                # --- allocatable) to be deallocated, but for a pointer or target
                # --- to be passed into a subroutine, its signature must be defined.
                # --- This can't be done from C, so this must be inside a module.
                # --- Furthermore, only a pointer can be passed into a pointer.
                # --- To get around that, the input argument is declared a target,
                # --- then an explicit pointer assignment gives a pointer that can
                # --- be deallocated.
                # --- Note that this fails with the IBM xlf compiler. It takes a
                # --- strict interpretation of the Fortran standard - an error value
                # --- is returned from the deallocate since the pointer points to
                # --- (what appears to be) a static object. So, for now, the
                # --- the error is ignored and the object (probably) left allocated.
                self.fw('  SUBROUTINE '+t.name+'dealloc(oldobj__)')
                self.fw('    TYPE('+t.name+'),target:: oldobj__')
                self.fw('    TYPE('+t.name+'),pointer:: poldobj__')
                self.fw('    integer:: error')
                self.fw('    poldobj__ => oldobj__')
                self.fw('    DEALLOCATE(poldobj__,STAT=error)')
                if fcompname != 'xlf':
                    self.fw('    if (error /= 0) then')
                    self.fw('      print*,"ERROR during deallocation of '+t.name+'"')
                    self.fw('      stop')
                    self.fw('    endif')
                self.fw('    RETURN')
                self.fw('  END SUBROUTINE '+t.name+'dealloc')

                self.fw('END MODULE '+t.name+'module')

            # --- These subroutines are written outside of the module in case
            # --- write module is false. This way, they are always created.
            # --- The InitPyRef and DecRef are called by the New and Del routines
            # --- if the modules are written. They are also meant to be explicitly
            # --- called from the users Fortran code if the creation and deletion
            # --- of derived type instances is done there.
            # --- The deallocatable should be false whenever the variable is not
            # --- a pointer or allocatable.  Otherwise the deallocate can result
            # --- in a memory error.
            self.fw('SUBROUTINE InitPyRef'+t.name+'(newobj__,setinitvalues,'+
                                                   'deallocatable)')
            self.fw('  USE '+t.name+'module')
            self.fw('  TYPE('+t.name+'):: newobj__')
            self.fw('  INTEGER('+isz+'),OPTIONAL:: setinitvalues,deallocatable')
            self.fw('  INTEGER('+isz+'):: s,d')
            self.fw('  If (PRESENT(setinitvalues)) THEN')
            self.fw('    s = setinitvalues')
            self.fw('  ELSE')
            self.fw('    s = 1')
            self.fw('  ENDIF')
            self.fw('  If (PRESENT(deallocatable)) THEN')
            self.fw('    d = deallocatable')
            self.fw('  ELSE')
            self.fw('    d = 1')
            self.fw('  ENDIF')
            self.fw('  call init'+t.name+'py(int(-1,'+isz+'),newobj__,newobj__%cobj__,s,d)')
            self.fw('  RETURN')
            self.fw('END SUBROUTINE InitPyRef'+t.name)
            self.fw('SUBROUTINE IncRef'+t.name+'(fobj__)')
            self.fw('  USE '+t.name+'module')
            self.fw('  TYPE('+t.name+'):: fobj__')
            self.fw('  call incref'+t.name+'py(fobj__%cobj__,fobj__)')
            self.fw('  RETURN')
            self.fw('END SUBROUTINE IncRef'+t.name)
            self.fw('SUBROUTINE DecRef'+t.name+'(oldobj__)')
            self.fw('  USE '+t.name+'module')
            self.fw('  TYPE('+t.name+'):: oldobj__')
            self.fw('  INTEGER('+isz+'):: cobj__')
            self.fw('  cobj__ = oldobj__%cobj__')
            # --- Note that during the decreftypepy call, this object may become
            # --- deallocated (if there are no other references to it). So, this
            # --- assignment must be done first.
            #self.fw('  oldobj__%cobj__ = 0')
            self.fw('  call decref'+t.name+'py(cobj__)')
            self.fw('  RETURN')
            self.fw('END SUBROUTINE DecRef'+t.name)
            # --- This should be called by fortran to check if the object can be
            # --- explicitly deallocated.
            # --- If there are no existing python references to the object, then
            # --- it can be deallocated. If there are references, it can not
            # --- be deallocated yet. It is made deallocatable by python, so
            # --- that when all of those references are deleted, the object can
            # --- be deallocated.
            self.fw('FUNCTION '+t.name+'deallocatable(oldobj__) result(d)')
            self.fw('  USE '+t.name+'module')
            self.fw('  TYPE('+t.name+'),pointer:: oldobj__')
            self.fw('  LOGICAL:: d')
            self.fw('  if (oldobj__%cobj__ == 0) then')
            self.fw('    d = .true.')
            self.fw('  else')
            self.fw('    call '+self.fsub(t,'makedeallocable')+'(oldobj__%cobj__)')
            self.fw('    d = .false.')
            self.fw('  endif')
            self.fw('  RETURN')
            self.fw('END FUNCTION '+t.name+'deallocatable')

            # --- The memory handling routines check if the cobj__ has been
            # --- set - if not, then set it.
            # --- XXX
            # --- It may not be a good idea to call IncRef if the cobj does not
            # --- already exist. This is a hidden reference that may lead to
            # --- memory leaks. A better way would be to force the coder to
            # --- either explicitly call IncRef or use the New routine to allocate
            # --- the instance (which also creates a python object).
            self.fw('SUBROUTINE '+t.name+'allot(fobj__)')
            self.fw('  USE '+t.name+'module')
            self.fw('  TYPE('+t.name+'):: fobj__')
            self.fw('  if (fobj__%cobj__ == 0) CALL IncRef'+t.name+'(fobj__)')
            self.fw('  CALL tallot(fobj__%cobj__)')
            self.fw('  RETURN')
            self.fw('END SUBROUTINE '+t.name+'allot')
            self.fw('SUBROUTINE '+t.name+'change(fobj__)')
            self.fw('  USE '+t.name+'module')
            self.fw('  TYPE('+t.name+'):: fobj__')
            self.fw('  if (fobj__%cobj__ == 0) CALL IncRef'+t.name+'(fobj__)')
            self.fw('  CALL tchange(fobj__%cobj__)')
            self.fw('  RETURN')
            self.fw('END SUBROUTINE '+t.name+'change')
            self.fw('SUBROUTINE '+t.name+'free(fobj__)')
            self.fw('  USE '+t.name+'module')
            self.fw('  TYPE('+t.name+'):: fobj__')
            self.fw('  if (fobj__%cobj__ == 0) CALL IncRef'+t.name+'(fobj__)')
            self.fw('  CALL tfree(fobj__%cobj__)')
            self.fw('  RETURN')
            self.fw('END SUBROUTINE '+t.name+'free')

            #########################################################################
            self.fw('! '+self.fsub(t,'passpointers',dohash=0))
            self.fw('SUBROUTINE '+self.fsub(t,'passpointers')+'(fobj__,setinitvalues)')

            # --- Write out the Use statements
            self.fw('  USE '+t.name+'module')
            self.fw('  TYPE('+t.name+'):: fobj__')
            self.fw('  INTEGER('+isz+'):: setinitvalues')

            # --- This is for legacy code that directly referenced obj__ in the initial values
            self.fw('  TARGET:: fobj__')
            self.fw('  TYPE('+t.name+'),pointer:: obj__')
            self.fw('  obj__ => fobj__')

            # --- Write out calls to c routine passing down pointers to scalars
            for i in range(len(slist)):
                s = slist[i]
                if s.dynamic: continue
                if s.derivedtype:
                    # --- This is only called for static instances, so deallocatable is
                    # --- set to false (the last argument).
                    self.fw('  CALL init'+s.type+'py(int(-1,'+isz+'),fobj__%'+s.name+
                            ',fobj__%'+s.name+'%cobj__,setinitvalues,int(0,'+isz+'))')
                    self.fw('  CALL '+self.fsub(t,'setderivedtypepointers')+'('+
                            'int('+repr(i)+','+isz+'),fobj__%'+s.name+'%cobj__,fobj__%cobj__)')
                else:
                    self.fw('  CALL '+self.fsub(t,'grabscalarpointers')+'('+
                            'int('+repr(i)+','+isz+'),fobj__%'+s.name+',fobj__%cobj__)')

            # --- Write out calls to c routine passing down pointers to arrays
            for i in range(len(alist)):
                a = alist[i]
                if not a.dynamic:
                    if not a.derivedtype:
                        # --- This assumes that a scalar is given which is broadcasted
                        # --- to fill the array.
                        #if a.data: self.fw('  fobj__%'+a.name+' = '+a.data[1:-1])
                        self.fw('  CALL '+self.fsub(t,'grabarraypointers')+'('+'int('+repr(i)+','+isz+')'+
                                ',fobj__%'+a.name+',fobj__%cobj__)')

            # --- Set the initial values only if the input flag is 1.
            self.fw('  if (setinitvalues == 1) then')
            for s in slist:
                if s.dynamic or s.derivedtype or not s.data: continue
                self.fw('    fobj__%'+s.name+' = '+s.data[1:-1])
            for a in alist:
                if a.dynamic or a.derivedtype or not a.data: continue
                self.fw('    fobj__%'+a.name+' = '+a.data[1:-1])
            self.fw('  endif')

            # --- Finish the routine
            self.fw('  RETURN')
            self.fw('END')

            #########################################################################
            # --- Nullifies the pointers of all dynamic variables. This is needed
            # --- since in some compilers, the associated routine returns
            # --- erroneous information if the status of a pointer is undefined.
            # --- Pointers must be explicitly nullified in order to get
            # --- associated to return a false value.
            self.fw('! '+self.fsub(t,'nullifypointers',dohash=0))
            self.fw('SUBROUTINE '+self.fsub(t,'nullifypointers')+'(fobj__)')

            # --- Write out the Use statements
            self.fw('  USE '+t.name+'module')
            self.fw('  TYPE('+t.name+'):: fobj__')

            for i in range(len(slist)):
                s = slist[i]
                if s.dynamic: self.fw('  NULLIFY(fobj__%'+s.name+')')
            for i in range(len(alist)):
                a = alist[i]
                if a.dynamic: self.fw('  NULLIFY(fobj__%'+a.name+')')

            self.fw('  return')
            self.fw('end')

            #########################################################################
            # --- Write routine for each dynamic variable which gets the pointer
            # --- from the wrapper
            for s in slist:
                if (s.dynamic or s.derivedtype) and not s.parameter:
                    self.fw('! '+self.fsub(t,'setscalarpointer',s.name,dohash=0))
                    self.fw('SUBROUTINE '+self.fsub(t,'setscalarpointer',s.name)+'(p__,fobj__,nullit__)')
                    self.fw('  USE '+t.name+'module')
                    self.fw('  TYPE('+t.name+'):: fobj__')
                    self.fw('  '+fvars.ftof(s.type)+',target:: p__')
                    self.fw('  INTEGER('+isz+'):: nullit__')
                    if s.dynamic:
                        self.fw('  if (nullit__ == 0) then')
                        self.fw('    fobj__%'+s.name+' => p__')
                        self.fw('  else')
                        self.fw('    NULLIFY(fobj__%'+s.name+')')
                        self.fw('  endif')
                    else:
                        self.fw('  fobj__%'+s.name+' = p__')
                    self.fw('  RETURN')
                    self.fw('END')
                if s.dynamic:
                    self.fw('SUBROUTINE '+self.fsub(t,'getscalarpointer',s.name)+
                                    '(cobj__,fobj__,createnew__)')
                    self.fw('  USE '+t.name+'module')
                    self.fw('  integer('+isz+'):: cobj__')
                    self.fw('  integer(4):: createnew__')
                    self.fw('  TYPE('+t.name+'):: fobj__')
                    self.fw('  if (ASSOCIATED(fobj__%'+s.name+')) then')
                    self.fw('    if (fobj__%'+s.name+'%cobj__ == 0 .and. createnew__==1) then')
                    self.fw('      call init'+s.type+'py(int(-1,'+isz+'),fobj__%'+s.name+','+
                                                         'fobj__%'+s.name+'%cobj__,int(0,'+isz+'),int(0,'+isz+'))')
                    self.fw('    endif')
                    self.fw('    cobj__ = fobj__%'+s.name+'%cobj__')
                    self.fw('  else')
                    self.fw('    cobj__ = 0')
                    self.fw('  endif')
                    self.fw('  RETURN')
                    self.fw('END')

            for a in alist:
                if a.dynamic:
                    self.fw('! '+self.fsub(t,'setarraypointer',a.name,dohash=0))
                    self.fw('SUBROUTINE '+self.fsub(t,'setarraypointer',a.name)+'(p__,fobj__,dims__)')
                    self.fw('  USE '+t.name+'module')
                    self.fw('  TYPE('+t.name+'):: fobj__')
                    self.fw('  integer('+isz+'):: dims__('+repr(len(a.dims))+')')
                    if a.type == 'character':
                        self.fw('  character(len='+a.dims[0].high+'),target:: '+
                                'p__'+self.prefixdimsf(re.sub('[ \t\n]','',a.dimstring))+'')
                    else:
                        self.fw('  '+fvars.ftof(a.type)+',target:: '+
                                'p__'+self.prefixdimsf(re.sub('[ \t\n]','',a.dimstring))+'')
                    self.fw('  fobj__%'+a.name+' => p__')
                    self.fw('  RETURN')
                    self.fw('END')
                    if a.dynamic or re.search('fassign',a.attr):
                        self.fw('! '+self.fsub(t,'getarraypointer',a.name,dohash=0))
                        self.fw('SUBROUTINE '+self.fsub(t,'getarraypointer',a.name)+'(farray__,fobj__)')
                        self.fw('  USE '+t.name+'module')
                        self.fw('  integer('+isz+'):: farray__')
                        self.fw('  integer('+isz+'):: ss(%d)'%(len(a.dims)))
                        self.fw('  TYPE('+t.name+'):: fobj__')
                        self.fw('  if (.not. associated(fobj__%'+a.name+')) return ')
                        self.fw('  call '+self.fsub(t,'grabarraypointersobj')+
                                                               '(farray__,fobj__%'+a.name+')')
                        if a.type == 'character':
                            self.fw('  ss(1:%d)'%(len(a.dims)-1)+' = shape(fobj__%'+a.name+')')
                            self.fw('  ss(%d)'%(len(a.dims))+' = %s'%a.dims[0].high)
                        else:
                            self.fw('  ss = shape(fobj__%'+a.name+')')
                        self.fw('  call '+self.fsub(t,'setarraydims')+ '(farray__,ss)')
                        self.fw('  return')
                        self.fw('end')

            #########################################################################
            # --- Write the routine which creates a new instance of the derived type
            # --- Note that part of the body of this routine is taken from the New
            # --- routine above. Any change in one should be copied to the other.
            # --- The body is copied from New since in cases where the modules
            # --- are not written out, the New routine will not exist.
            self.fw('FUNCTION '+self.fsub(t,'NewF')+'() RESULT(cobj__)')
            self.fw('  USE '+t.name+'module')
            self.fw('  integer('+isz+'):: cobj__')
            self.fw('  integer:: error')
            self.fw('  TYPE('+t.name+'),pointer:: newobj__')
            self.fw('  ALLOCATE(newobj__,STAT=error)')
            self.fw('  if (error /= 0) then')
            self.fw('    print*,"ERROR during allocation of '+t.name+'"')
            self.fw('    stop')
            self.fw('  endif')
            for s in slist:
                if s.dynamic:
                    self.fw('  NULLIFY(newobj__%'+s.name+')')
            #self.fw('  call InitPyRef'+t.name+'(newobj__,1,1)')
            self.fw('  call init'+t.name+'py(int(-1,'+isz+'),newobj__,newobj__%cobj__,int(1,'+isz+'),int(1,'+isz+'))')
            self.fw('  cobj__ = newobj__%cobj__')
            self.fw('  RETURN')
            self.fw('END')

            self.fw('SUBROUTINE '+self.fsub(t,'deallocatef')+'(oldobj__)')
            self.fw('  USE '+t.name+'module')
            self.fw('  TYPE('+t.name+'):: oldobj__')
            self.fw('  CALL '+t.name+'dealloc(oldobj__)')
            self.fw('  RETURN')
            self.fw('END SUBROUTINE '+self.fsub(t,'deallocatef'))
            self.fw('SUBROUTINE '+self.fsub(t,'nullifycobjf')+'(fobj__)')
            self.fw('  USE '+t.name+'module')
            self.fw('  TYPE('+t.name+'):: fobj__')
            self.fw('  fobj__%cobj__ = 0')
            self.fw('  RETURN')
            self.fw('END SUBROUTINE '+self.fsub(t,'nullifycobjf'))

#     self.fw('SUBROUTINE '+self.fsub(t,'DelF')+'(oldobj__)')
#     self.fw('  USE '+t.name+'module')
#     self.fw('  TYPE('+t.name+'),pointer:: oldobj__')
#     self.fw('  integer:: error')
#     self.fw('  call DecRef'+t.name+'(oldobj__)')
#     self.fw('  DEALLOCATE(oldobj__,STAT=error)')
#     self.fw('  if (error /= 0) then')
#     self.fw('    print*,"ERROR during deallocation of '+t.name+'"')
#     self.fw('    stop')
#     self.fw('  endif')
#     self.fw('  RETURN')
#     self.fw('END SUBROUTINE '+self.fsub(t,'DelF'))
