/* -----------------------------------------------------------------------------
 * clisp.cxx
 *
 *     clisp module.
 *
 * Author(s) : Surendra Singhi (surendra@asu.edu)
 *
 * See the file LICENSE for information on usage and redistribution.
 * ----------------------------------------------------------------------------- */

char cvsroot_clisp_cxx[] = "$Header$";

#include "swigmod.h"

class CLISP : public Language {
public:
  File *f_cl;
  String *module;
  virtual void main(int argc, char *argv[]);
  virtual int top(Node *n);
  virtual int functionWrapper(Node *n);
  virtual int variableWrapper(Node *n); 
  virtual int constantWrapper(Node *n);
  virtual int classDeclaration(Node *n);
  virtual int enumDeclaration(Node *n);
  virtual int typedefHandler(Node *n);
  List *entries;
private:
  String* get_ffi_type(SwigType *ty);
  String* convert_literal(String *num_param, String *type);
  String* strip_parens(String *string);
  int extern_all_flag;
  int generate_typedef_flag;
  int is_function;
};

void CLISP :: main(int argc, char *argv[]) {
  int i;

  SWIG_library_directory("clisp"); 
  SWIG_config_file("clisp.swg");
  generate_typedef_flag = 0;
  extern_all_flag=0;
  
  for(i=1; i<argc; i++) {
    if (!strcmp(argv[i], "-help")) {
      Printf(stdout, "clisp Options (available with -clisp)\n");
      Printf(stdout, 
	     " -extern-all\n"
	     "\t If this option is given then clisp definitions for all the functions\n"
	     "and global variables will be created otherwise only definitions for \n"
	     "externed functions and variables are created.\n"
	     " -generate-typedef\n"
	     "\t If this option is given then def-c-type will be used to generate shortcuts\n"
	     "according to the typedefs in the input.\n"
	     );
    }
    else if ( (Strcmp(argv[i],"-extern-all") == 0)) {
      extern_all_flag = 1;
      Swig_mark_arg(i);
    }
    else if ( (Strcmp(argv[i],"-generate-typedef") == 0)) {
      generate_typedef_flag = 1;
      Swig_mark_arg(i);
    }
  }
}

int CLISP :: top(Node *n) {

  File *f_null=NewString("");
  module=Getattr(n, "name");
  String *output_filename;
  entries = NewList();
  
  /* Get the output file name */
  String *outfile = Getattr(n,"outfile");
    
  if(!outfile)
    output_filename=outfile;
  else  {
    output_filename=NewString("");
    Printf(output_filename, "%s%s.lisp", SWIG_output_directory(), module);
  }

  f_cl=NewFile(output_filename, "w+");
  if (!f_cl) {
    FileErrorDisplay(output_filename);
    SWIG_exit(EXIT_FAILURE);
  }

  Swig_register_filebyname("header",f_null);
  Swig_register_filebyname("runtime",f_null);
  Swig_register_filebyname("wrapper", f_null);
 
  String *header=NewStringf(";; This is an automatically generated file. \n;;Make changes as you feel are necessary (but remember if you try to regenerate this file, your changes will be lost). \n\n(defpackage :%s\n  (:use :common-lisp :ffi)", module);

  Language::top(n);

  Iterator i;

  long len=Len(entries);
  if(len > 0) {
    Printf(header,"\n  (:export");
  }
  //else nothing to export
    
  for (i = First(entries); i.item; i = Next(i)) {
    Printf(header,"\n\t:%s", i.item);
  }
  
  if(len > 0) {
    Printf(header,")");
  }
  
  Printf(header, ")\n");
  Printf(header,"\n(in-package :%s)\n",module);
  Printf(header,"\n(default-foreign-language :stdc)\n");
  
  len= Tell(f_cl);

  Printf(f_cl,"%s",header);

  long end = Tell(f_cl);

  for(len--;len >=0 ; len --) {
    end--;
    Seek(f_cl,len,SEEK_SET);
    int ch=Getc(f_cl);
    Seek(f_cl,end,SEEK_SET);
    Putc(ch,f_cl);
  }
  
  Seek(f_cl,0,SEEK_SET);
  Write(f_cl,Char(header), Len(header));

  Close(f_cl);
  Delete(f_cl); // Deletes the handle, not the file

  return SWIG_OK;
}


int CLISP :: functionWrapper(Node *n) {
  is_function=1;
  String *storage=Getattr(n,"storage");
  if(!extern_all_flag && (!storage || (Strcmp(storage,"extern") && Strcmp(storage,"externc"))))
    return SWIG_OK;
     
  String *func_name=Getattr(n, "sym:name");

  ParmList *pl=Getattr(n, "parms");

  int argnum=0, first=1;

  Printf(f_cl, "\n(ffi:def-call-out %s\n\t(:name \"%s\")\n", func_name,func_name);
  
  Append(entries,func_name);

  if (ParmList_len(pl) != 0) {
    Printf(f_cl, "\t(:arguments ");
  }
  for (Parm *p=pl; p; p=nextSibling(p), argnum++) {

    String *argname=Getattr(p, "name");
    //    SwigType *argtype;
    
    String *ffitype=get_ffi_type(Getattr(p, "type"));
    
    int tempargname=0;
      
    if (!argname) {
      argname=NewStringf("arg%d", argnum);
      tempargname=1;
    }
      
    if (!first) {
      Printf(f_cl, "\n\t\t");
    }
    Printf(f_cl, "(%s %s)", argname, ffitype);
    first=0;
      
    Delete(ffitype);

    if (tempargname) 
      Delete(argname);
  }
  if (ParmList_len(pl) != 0) {
    Printf(f_cl, ")\n"); /* finish arg list */
  }
  String *ffitype=get_ffi_type(Getattr(n, "type"));
  if(Strcmp(ffitype,"NIL")) { //when return type is not nil
    Printf(f_cl, "\t(:return-type %s)\n", ffitype);
  }
  Printf(f_cl, "\t(:library +library-name+))\n");
   
  return SWIG_OK;
}


int CLISP :: constantWrapper(Node *n) {
  is_function=0;
  String *type=Getattr(n, "type");
  String *converted_value=convert_literal(Getattr(n, "value"), type);
  String *name=Getattr(n, "sym:name");

  Printf(f_cl, "\n(defconstant %s %s)\n", name, converted_value);
  Append(entries,name);
  Delete(converted_value);
 
  return SWIG_OK;
}

int CLISP :: variableWrapper(Node *n) {
  is_function=0;
  //  SwigType *type=;
  String *storage=Getattr(n,"storage");
  
  if(!extern_all_flag && (!storage || (Strcmp(storage,"extern") && Strcmp(storage,"externc"))))
    return SWIG_OK;

  String *var_name=Getattr(n, "sym:name");
  String *lisp_type=get_ffi_type(Getattr(n, "type"));
  Printf(f_cl,"\n(ffi:def-c-var %s\n (:name \"%s\")\n (:type %s)\n",var_name,var_name,lisp_type);
  Printf(f_cl, "\t(:library +library-name+))\n");
  Append(entries,var_name);

  Delete(lisp_type);
  return SWIG_OK;
}

int CLISP :: typedefHandler(Node *n) {
  if(generate_typedef_flag) {
    is_function=0;
    Printf(f_cl,"\n(ffi:def-c-type %s %s)\n",Getattr(n,"name"),get_ffi_type(Getattr(n,"type")));
  }
  
  return Language::typedefHandler(n);
}

int CLISP :: enumDeclaration(Node *n) {
  is_function=0;
  String *name=Getattr(n, "sym:name");
  
  Printf(f_cl,"\n(ffi:def-c-enum %s ",name);

  for (Node *c=firstChild(n); c; c=nextSibling(c)) {

    String *slot_name = Getattr(c, "name");
    String *value = Getattr(c, "enumvalue");
	
    Printf(f_cl,"(%s %s)",slot_name,value);

    Append(entries,slot_name);
      
    Delete(value);
  }
 
  Printf(f_cl, ")\n");
  return SWIG_OK;
}


// Includes structs
int CLISP :: classDeclaration(Node *n) {
  is_function=0;
  String *name=Getattr(n, "sym:name");
  String *kind = Getattr(n,"kind");
  
  if (Strcmp(kind, "struct")) {
    Printf(stderr, "Don't know how to deal with %s kind of class yet.\n",
	   kind);
    Printf(stderr, " (name: %s)\n", name);
    SWIG_exit(EXIT_FAILURE);
  }

  
  Printf(f_cl,"\n(ffi:def-c-struct %s",name);

  Append(entries,NewStringf("make-%s",name));
	 
  for (Node *c=firstChild(n); c; c=nextSibling(c)) {

    if (Strcmp(nodeType(c), "cdecl")) {
      Printf(stderr, "Structure %s has a slot that we can't deal with.\n",
	     name);
      Printf(stderr, "nodeType: %s, name: %s, type: %s\n", 
	     nodeType(c),
	     Getattr(c, "name"),
	     Getattr(c, "type"));
      SWIG_exit(EXIT_FAILURE);
    }

    String *temp=Copy(Getattr(c,"decl"));
    Append(temp,Getattr(c,"type")); //appending type to the end, otherwise wrong type
    String *lisp_type=get_ffi_type(temp);
    Delete(temp);

    String *slot_name = Getattr(c, "sym:name");
    Printf(f_cl, 
	   "\n\t(%s %s)", 
	   slot_name,
	   lisp_type);

    Append(entries,NewStringf("%s-%s",name,slot_name));
      
    Delete(lisp_type);
  }
  
  Printf(f_cl, ")\n");

  /* Add this structure to the known lisp types */
  //Printf(stdout, "Adding %s foreign type\n", name);
  //  add_defined_foreign_type(name);
  
  return SWIG_OK;
}

/* utilities */
/* returns new string w/ parens stripped */
String* CLISP::strip_parens(String *string) {
  char *s=Char(string), *p;
  int len=Len(string);
  String *res;
	
  if (len==0 || s[0] != '(' || s[len-1] != ')') {
    return NewString(string);
  }
	
  p=(char *)malloc(len-2+1);
  if (!p) {
    Printf(stderr, "Malloc failed\n");
    SWIG_exit(EXIT_FAILURE);
  }
	
  strncpy(p, s+1, len-1);
  p[len-2]=0; /* null terminate */
	
  res=NewString(p);
  free(p);
	
  return res;
}

String* CLISP::convert_literal(String *num_param, String *type) {
  String *num=strip_parens(num_param), *res;
  char *s=Char(num);
	
  /* Make sure doubles use 'd' instead of 'e' */
  if (!Strcmp(type, "double")) {
    String *updated=Copy(num);
    if (Replace(updated, "e", "d", DOH_REPLACE_ANY) > 1) {
      Printf(stderr, "Weird!! number %s looks invalid.\n", num);
      SWIG_exit(EXIT_FAILURE);
    }
    Delete(num);
    return updated;
  }

  if (SwigType_type(type) == T_CHAR) {
    /* Use CL syntax for character literals */
    return NewStringf("#\\%s", num_param);
  }
  else if (SwigType_type(type) == T_STRING) {
    /* Use CL syntax for string literals */
    return NewStringf("\"%s\"", num_param);
  }
	
  if (Len(num) < 2 || s[0] != '0') {
    return num;
  }
	
  /* octal or hex */
	
  res=NewStringf("#%c%s", 
		 s[1] == 'x' ? 'x' : 'o', 
		 s+2);
  Delete(num);

  return res;
}

String* CLISP::get_ffi_type(SwigType *ty) {
  Hash *typemap =Swig_typemap_search("in", ty,"", 0);
  if (typemap) {
    String *typespec = Getattr(typemap, "code");
    return NewString(typespec);
  }
  else if(SwigType_ispointer(ty)) {
    SwigType *cp = Copy(ty);
    SwigType_del_pointer(cp);
    String *inner_type=get_ffi_type(cp);

    if(SwigType_isfunction(cp)) {
      return inner_type;
    }
    
    SwigType *base=SwigType_base(ty);
    String *base_name=SwigType_str(base,0);

    String *str;
    if(!Strcmp(base_name,"int") || !Strcmp(base_name,"float") || !Strcmp(base_name,"short")
       || !Strcmp(base_name,"double") || !Strcmp(base_name,"long") || !Strcmp(base_name,"char")) {
    
      str = NewStringf("(ffi:c-ptr %s)",inner_type);
    }
    else {
      str = NewStringf("(ffi:c-pointer %s)",inner_type);
    }
    Delete(base_name);
    Delete(base);
    Delete(cp);
    Delete(inner_type);
    return str;
  }
  else if(SwigType_isarray(ty)) {
    SwigType *cp = Copy(ty);
    String *array_dim=SwigType_array_getdim(ty,0);

    if(!Strcmp(array_dim,""))  { //dimension less array convert to pointer
      Delete(array_dim);
      SwigType_del_array(cp);
      SwigType_add_pointer(cp);
      String *str =get_ffi_type(cp);
      Delete(cp);
      return str;
    }
    else {
      SwigType_pop_arrays(cp);
      String *inner_type = get_ffi_type(cp);
      Delete(cp);
	     
      int ndim=SwigType_array_ndim(ty);
      String *dimension;
      if(ndim == 1) {
	dimension=array_dim;
      }
      else {
	dimension = array_dim;
	for(int i=1;i<ndim;i++)	  {
	  array_dim=SwigType_array_getdim(ty,i);
	  Append(dimension," ");
	  Append(dimension,array_dim);
	  Delete(array_dim);
	}
	String *temp=dimension;
	dimension=NewStringf("(%s)",dimension);
	Delete(temp);
      }
      String *str;
      if(is_function)
	str=NewStringf("(ffi:c-ptr (ffi:c-array %s %s))",inner_type,dimension);
      else
	str=NewStringf("(ffi:c-array %s %s)",inner_type,dimension);
      
      Delete(inner_type);
      Delete(dimension);
      return str;
    }
  }
  else if(SwigType_isfunction(ty)) {
    SwigType *cp = Copy(ty);
    SwigType *fn=SwigType_pop_function(cp);
    String *args=NewString("");
    ParmList *pl= SwigType_function_parms(fn);
    if (ParmList_len(pl) != 0) {
      Printf(args, "(:arguments ");
    }
    int argnum=0, first=1;
    for (Parm *p=pl; p; p=nextSibling(p), argnum++) {
      String *argname=Getattr(p, "name");
      SwigType *argtype=Getattr(p, "type");
      String *ffitype=get_ffi_type(argtype);
    
      int tempargname=0;
      
      if (!argname) {
 	argname=NewStringf("arg%d", argnum);
 	tempargname=1;
      }
      if (!first) {
 	Printf(args, "\n\t\t");
      }
      Printf(args, "(%s %s)", argname, ffitype);
      first=0;
      Delete(ffitype);
      if (tempargname) 
 	Delete(argname);
    }
    if (ParmList_len(pl) != 0) {
      Printf(args, ")\n"); /* finish arg list */
    }
    String *ffitype = get_ffi_type(cp);
    String *str=NewStringf("(ffi:c-function %s \t\t\t\t(:return-type %s))",args,ffitype);
    Delete(fn);
    Delete(args);
    Delete(cp);
    Delete(ffitype);
    return str;
  }
  String *str=SwigType_str(ty,0);
  if(str) {
    char *st = Strstr(str,"struct");
    if(st) {
      st+=7;
      return NewString(st);
    }
    char *cl = Strstr(str,"class");
    if(cl) {
      cl+=6;
      return NewString(cl);
    }
  }
  return str;
}

extern "C" Language *swig_clisp(void) {
  return new CLISP();
}