genLisp.c File Reference

#include <stdio.h>
#include "newgen_include.h"

Include dependency graph for genLisp.c:

Go to the source code of this file.

Macros
#define	TYPE(bp)   (bp-Domains-Number_imports-Current_start)
#define	NEWGEN_IMPL   "#+akcl lisp:vector #-akcl (lisp:vector lisp:t)"
#define	OR_VALUE_INDEX   3
	Unused in Lisp. More...

Functions
char *	init_member (dp)
	INIT_MEMBER returns the initialization code for a value in the domain DP. More...
void	gen_external (bp)
	GEN_EXTERNAL generates the type code for external type BP. More...
int	gen_external_member (dp, offset)
	GEN_EXTERNAL_MEMBER generates the manipulation functions for a possible external member (either and or or) in domain DP and OFFSET. More...
static void	gen_prelude (bp)
	GEN_PRELUDE generates prelude declarations for potentially tabulated domain BP. More...
static void	gen_postlude (bp)
	GEN_POSTLUDE generates tabulation table updates. More...
static	generate_type_member (bp)
	GEN_TYPE generates the type member for potentially tabulated BP domain. More...
void	gen_and (bp)
	GEN_AND generates the manipulation functions for an AND type BP. More...
void	gen_or (bp)
	GEN_OR generates the manipulation function for an OR_OP type BP. More...
void	gen_list (bp)
	GEN_LIST defines the manipulation functions for a list type BP. More...
void	gen_array (bp)
	GEN_ARRAY defines the manipulation functions for an array type BP. More...
void	gen_set (bp)
	GEN_SET defines the manipulation functions for a set type BP. More...
void	gen_domain (bp)
	GEN_DOMAIN generates the manipulation functions for a type BP. More...
void	gencode (file)
	GENCODE generates the code necessary to manipulate every non-inlinable type in the Domains table. More...

Variables
static char	start [1024]
	The name of the variable from which to start counting domain numbers. More...
static char *	package
	The package name in which functions will be defined. More...
struct gen_binding *	Tabulated_bp
int	Read_spec_mode
	extern int Current_first ; More...
static int	or_counter

Macro Definition Documentation

NEWGEN_IMPL

#define NEWGEN_IMPL   "#+akcl lisp:vector #-akcl (lisp:vector lisp:t)"

Definition at line 51 of file genLisp.c.

OR_VALUE_INDEX

#define OR_VALUE_INDEX   3

Unused in Lisp.

Definition at line 65 of file genLisp.c.

TYPE

#define TYPE

(

bp

)

(bp-Domains-Number_imports-Current_start)

Definition at line 50 of file genLisp.c.

Function Documentation

gen_and()

void gen_and

(

bp

)

GEN_AND generates the manipulation functions for an AND type BP.

Definition at line 211 of file genLisp.c.

{
    union domain *dom = bp->domain ;
    struct domainlist *dlp = dom->co.components ;
    int size ;
 
    gen_prelude( bp ) ;
    printf( "(lisp:defstruct (%s (:type %s))\n", bp->name, NEWGEN_IMPL ) ;
    generate_type_member( bp ) ;
 
    for( ; dlp != NULL ; dlp=dlp->cdr ) {
        union domain *dp = dlp->domain ;
 
        printf( " (%s %s)\n", dp->ba.constructor, init_member( dp )) ;
    }
    printf( ")\n" ) ;
 
    for( size=2, dlp=dom->co.components; dlp != NULL ; dlp=dlp->cdr, size++ ) {
        gen_external_member( dlp->domain, size ) ;
    }
    gen_postlude( bp ) ;
}

References domain::ba, domain::co, domain::components, domain::constructor, gen_binding::domain, gen_external_member(), gen_postlude(), gen_prelude(), generate_type_member(), init_member(), gen_binding::name, NEWGEN_IMPL, and printf().

Referenced by gen_domain().

Here is the call graph for this function:

Here is the caller graph for this function:

gen_array()

void gen_array

(

bp

)

GEN_ARRAY defines the manipulation functions for an array type BP.

Definition at line 305 of file genLisp.c.

{
    union domain *dom = bp->domain ;
 
    gen_prelude( bp ) ;
    printf( "(lisp:defstruct (%s (:type %s))\n", bp->name, NEWGEN_IMPL ) ;
    generate_type_member( bp ) ;
    printf( " (%s %))\n", 
           dom->ar.constructor, init_member( dom->ar.element->domain )) ;
    gen_postlude( bp ) ;
}

References domain::ar, domain::constructor, gen_binding::domain, domain::element, gen_postlude(), gen_prelude(), generate_type_member(), init_member(), gen_binding::name, NEWGEN_IMPL, and printf().

Referenced by gen_domain().

Here is the call graph for this function:

Here is the caller graph for this function:

gen_domain()

void gen_domain

(

bp

)

GEN_DOMAIN generates the manipulation functions for a type BP.

This is manily a dispatching function.

Definition at line 338 of file genLisp.c.

{
  union domain *dp = bp->domain ;
 
  if( !IS_INLINABLE( bp ) && !IS_EXTERNAL( bp )) {
      printf( "(lisp:defmacro write-%s (fd obj) `(gen-write ,fd ,obj))\n",
                bp->name, bp->name ) ;
      printf("(lisp:defmacro read-%s (lisp:&optional (fd *standard-input*))\n",
             bp->name ) ;
      printf("  `(gen-read ,fd))\n");
  }
  switch( dp->ba.type ) {
  case CONSTRUCTED_DT:
    if( dp->co.op == AND_OP ) gen_and( bp ) ;
    else if( dp->co.op == OR_OP ) gen_or( bp ) ;
    else fatal( "gen_domain: Unknown constructed %s\n", i2a( dp->co.op )) ;
    break ;
  case LIST_DT:
    gen_list( bp ) ;
    break ;
  case ARRAY_DT:
    gen_array( bp ) ;
    break ;
 case SET_DT:
    gen_set( bp ) ;
    break ;
  case EXTERNAL_DT:
    gen_external( bp ) ;
    break ;
  default:
    fatal( "gen_domain: Unknown type %s\n", i2a( dp->ba.type )) ;
  }
}

References AND_OP, ARRAY_DT, domain::ba, domain::co, CONSTRUCTED_DT, gen_binding::domain, EXTERNAL_DT, fatal(), gen_and(), gen_array(), gen_external(), gen_list(), gen_or(), gen_set(), i2a(), IS_EXTERNAL, IS_INLINABLE, LIST_DT, gen_binding::name, domain::op, OR_OP, printf(), SET_DT, and domain::type.

Referenced by gencode().

Here is the call graph for this function:

Here is the caller graph for this function:

gen_external()

void gen_external

(

bp

)

GEN_EXTERNAL generates the type code for external type BP.

Definition at line 117 of file genLisp.c.

{
    printf( "(lisp:defvar %s (lisp:+ %s %d))\n", bp->name, start, TYPE( bp )) ;
}

References gen_binding::name, printf(), start, and TYPE.

Referenced by gen_domain().

Here is the call graph for this function:

Here is the caller graph for this function:

gen_external_member()

int gen_external_member	(	dp	,
		offset
	)

GEN_EXTERNAL_MEMBER generates the manipulation functions for a possible external member (either and or or) in domain DP and OFFSET.

It returns whether some code has been generated or not.

See INIT_MEMBER to understand mutation code.

Definition at line 130 of file genLisp.c.

{
    if( dp->ba.type == BASIS_DT ) {
        struct gen_binding *bp = dp->ba.constructand ;
        
        if( !IS_INLINABLE( bp ) && IS_EXTERNAL( bp )) {
            printf( "(lisp:defun %s-%s (and)\n", bp->name, dp->ba.constructor ) ;
            printf( "  (lisp:caddr (lisp:svref and %d)))\n", offset ) ;
            
            printf( "(lisp:defsetf %s-%s (and) (new-and)\n", 
                   bp->name, dp->ba.constructor ) ;
            printf( "  `(lisp:setf (lisp:caddr (lisp:svref ,and %d)) ", offset ) ;
            printf( ",new-and))\n" ) ;
            return( 1 ) ;
        }
    }
    return( 0 ) ;
}

References domain::ba, BASIS_DT, domain::constructand, domain::constructor, IS_EXTERNAL, IS_INLINABLE, gen_binding::name, offset, printf(), and domain::type.

Referenced by gen_and(), and gen_or().

Here is the call graph for this function:

Here is the caller graph for this function:

gen_list()

void gen_list

(

bp

)

GEN_LIST defines the manipulation functions for a list type BP.

Definition at line 292 of file genLisp.c.

{
    gen_prelude( bp ) ;
    printf( "(lisp:defstruct (%s (:type %s))\n", bp->name, NEWGEN_IMPL ) ;
    generate_type_member( bp ) ;
    printf( " (%s '()))\n", bp->domain->li.constructor ) ;
    gen_postlude( bp ) ;
}

References domain::constructor, gen_binding::domain, gen_postlude(), gen_prelude(), generate_type_member(), domain::li, gen_binding::name, NEWGEN_IMPL, and printf().

Referenced by gen_domain().

Here is the call graph for this function:

Here is the caller graph for this function:

gen_or()

void gen_or

(

bp

)

GEN_OR generates the manipulation function for an OR_OP type BP.

Note that for a UNIT_TYPE_NAME, no access function is defined since the value is meaningless.

Definition at line 240 of file genLisp.c.

{
    char *name = bp->name ;
    union domain *dom = bp->domain ;
    struct domainlist *dlp ;
    char *or_impl = (IS_TABULATED( bp )) ? "tabular-or" : "or" ;
 
    gen_prelude( bp ) ;
    printf( "(lisp:defun make-%s ", name ) ;
    printf( "(tag lisp:&optional (val :unit))\n" );
    printf( " (lisp:let ((node (newgen::make-%s)))\n", or_impl) ;
    printf( "   (lisp:setf (newgen::%s-type node) `(:newgen ,(lisp:+ %s %d)))\n", 
           or_impl, start, TYPE( bp ) ) ;
 
    if( IS_TABULATED( bp )) {
        printf( "   (lisp:setf (newgen::%s-tabular node) ", or_impl ) ;
        printf( "(newgen::find-free-tabulated (lisp:+ %s %d)))\n", 
                start, TYPE( bp )) ;
    }
    printf( "   (lisp:setf (newgen::%s-tag node) tag)\n", or_impl ) ;
    printf( "   (lisp:setf (newgen::%s-val node) val)\n", or_impl ) ;
    printf( "   node))\n" ) ;
    printf( "(lisp:defmacro %s-tag(node) `(newgen::%s-tag ,node))\n", 
            name, or_impl ) ;
 
    for( dlp=dom->co.components ; dlp != NULL ; dlp=dlp->cdr, or_counter++ ){
        union domain *dp = dlp->domain ;
 
        printf( "(lisp:defconstant is-%s-%s %d)\n",
               name, dp->ba.constructor, or_counter ) ;
        printf( "(lisp:setf newgen::*tag-names* " ) ;
        printf( "(lisp:acons %d 'is-%s-%s newgen::*tag-names*))\n",
               or_counter, name, dp->ba.constructor ) ;
        printf( "(lisp:defmacro %s-%s-p (or) ", name, dp->ba.constructor ) ;
        printf( "`(lisp:= (%s-tag ,or) is-%s-%s))\n", 
               name, name, dp->ba.constructor ) ;
 
        if( dp->ba.type == BASIS && 
           strcmp( dp->ba.constructand->name, UNIT_TYPE_NAME ) == 0 ||
           gen_external_member( dp, OR_VALUE_INDEX )) 
                continue ;
 
        printf( "(lisp:defmacro %s-%s (or) `(newgen::%s-val ,or))\n", 
               name, dp->ba.constructor, or_impl ) ;
    }
    gen_postlude( bp ) ;
}

References domain::ba, domain::co, domain::components, domain::constructand, domain::constructor, gen_binding::domain, gen_external_member(), gen_postlude(), gen_prelude(), IS_TABULATED, gen_binding::name, or_counter, OR_VALUE_INDEX, printf(), start, TYPE, domain::type, and UNIT_TYPE_NAME.

Referenced by gen_domain().

Here is the call graph for this function:

Here is the caller graph for this function:

gen_postlude()

static void gen_postlude ( bp  )

static

GEN_POSTLUDE generates tabulation table updates.

Definition at line 173 of file genLisp.c.

{
    if( IS_TABULATED( bp )) {
        printf( "(lisp:defvar old-make-%s)\n", bp->name ) ;
        printf( "(lisp:setf old-make-%s (lisp:symbol-function 'make-%s))\n",
                bp->name, bp->name ) ;
        printf( "(lisp:fmakunbound 'make-%s)\n", bp->name) ;
        printf( "(lisp:setf (lisp:symbol-function 'make-%s)\n", bp->name ) ;
        printf( " #'(lisp:lambda (lisp:&rest args)\n", bp->name ) ;
        printf( " (lisp:let ((node (lisp:apply old-make-%s args)))\n", bp->name ) ;
        printf( "  (newgen::enter-tabulated-def\n" ) ;
        printf( "   (lisp:aref newgen::*gen-tabulated-index* %s-domain)\n",
                bp->name ) ;
        printf( "  %s-domain\n", bp->name ) ;
        printf( "  (lisp:aref node %d)\n", HASH_OFFSET ) ;
        printf( "  node\n" ) ;
        printf( "  :allow-ref-p lisp:nil)\n" ) ;
        printf( "  node)))\n" ) ;
    }
}

References HASH_OFFSET, IS_TABULATED, gen_binding::name, and printf().

Referenced by gen_and(), gen_array(), gen_list(), gen_or(), and gen_set().

Here is the call graph for this function:

Here is the caller graph for this function:

gen_prelude()

static void gen_prelude ( bp  )

static

GEN_PRELUDE generates prelude declarations for potentially tabulated domain BP.

Definition at line 155 of file genLisp.c.

{
    printf( "(lisp:setf (lisp:aref newgen::*gen-tabulated-alloc*" ) ;
    printf( " (lisp:+ %s %d)) %d)\n",
           start, TYPE( bp ), (IS_TABULATED( bp )) ? 0 : -1 ) ;
    printf( "(lisp:defvar %s::%s-domain (lisp:+ %s %d))\n",
           package, bp->name, start, TYPE( bp )) ;
 
    if( IS_TABULATED( bp )) {
        printf( "(lisp:setf (lisp:aref newgen::*gen-tabulated-index* " ) ;
        printf( "%s::%s-domain) %d)\n", package, bp->name, bp->index ) ;
    }
}

References IS_TABULATED, gen_binding::name, package, printf(), start, and TYPE.

Referenced by gen_and(), gen_array(), gen_list(), gen_or(), and gen_set().

Here is the call graph for this function:

Here is the caller graph for this function:

gen_set()

void gen_set

(

bp

)

GEN_SET defines the manipulation functions for a set type BP.

Definition at line 321 of file genLisp.c.

{
    union domain *dom = bp->domain ;
 
    gen_prelude( bp ) ;
    printf( "(lisp:defstruct (%s (:type %s))\n", bp->name, NEWGEN_IMPL ) ;
    generate_type_member( bp ) ;
    printf( " (%s %))\n", 
           dom->se.constructor, init_member( dom->se.element->domain )) ;
    gen_postlude( bp ) ;
}

References domain::constructor, gen_binding::domain, domain::element, gen_postlude(), gen_prelude(), generate_type_member(), init_member(), gen_binding::name, NEWGEN_IMPL, printf(), and domain::se.

Referenced by gen_domain().

Here is the call graph for this function:

Here is the caller graph for this function:

gencode()

void gencode

(

file

)

GENCODE generates the code necessary to manipulate every non-inlinable type in the Domains table.

Definition at line 377 of file genLisp.c.

{
    struct gen_binding *bp ;
    int domain_count = 0 ;
  
    or_counter = 0 ;
    package = file ;
    sprintf( start, "newgen::*gen-%s-start*", file ) ;
 
    for( bp = Domains ; bp < &Domains[ MAX_DOMAIN ] ; bp++ ) {
        if( bp->name == NULL ||
            IS_INLINABLE( bp ) || IS_IMPORT( bp ) || bp == Tabulated_bp ) 
                continue ;
 
        gen_domain( bp ) ;      
    }
}

References Domains, gen_domain(), IS_IMPORT, IS_INLINABLE, MAX_DOMAIN, gen_binding::name, or_counter, start, and Tabulated_bp.

Here is the call graph for this function:

generate_type_member()

static generate_type_member ( bp  )

static

GEN_TYPE generates the type member for potentially tabulated BP domain.

Definition at line 197 of file genLisp.c.

{
    printf( " (-type- `(:newgen ,(lisp:+ %s %d)))\n", start, TYPE( bp ) ) ;
 
    if( IS_TABULATED( bp )) {
        printf( " (-tabular- (newgen::find-free-tabulated %d))\n", 
                TYPE( bp )) ;
    }
}

References IS_TABULATED, printf(), start, and TYPE.

Referenced by gen_and(), gen_array(), gen_list(), and gen_set().

Here is the call graph for this function:

Here is the caller graph for this function:

init_member()

char* init_member

(

dp

)

INIT_MEMBER returns the initialization code for a value in the domain DP.

OTREACHED

Definition at line 72 of file genLisp.c.

{
  static char buffer[ 1024 ] ;
 
  switch( dp->ba.type ) {
  case BASIS_DT: {
    struct gen_binding *bp = dp->ba.constructand ;
 
    if( IS_INLINABLE( bp ))
            sprintf( buffer, "%s", bp->inlined->Lisp_value ) ;
    else if( IS_EXTERNAL( bp ))
            sprintf( buffer, "`(:external ,(lisp:+ %s %d) %s)", 
                     start, TYPE( bp ), ":external-undefined" ) ;
    else sprintf( buffer, ":undefined", bp->name ) ;
    break ;
  }
  case LIST_DT:
    sprintf( buffer, ":list-undefined" ) ;
    break ;
  case ARRAY_DT: {
    struct intlist *ilp ;
 
    sprintf( buffer, "(lisp:make-array '(" ) ;
 
    for( ilp = dp->ar.dimensions ; ilp != NULL ; ilp = ilp->cdr ) {
      strcat( buffer, i2a( ilp->val )) ;
      strcat( buffer, " " ) ;
    }
    strcat( buffer, ") :initial-element '--no-value--)" ) ;
    break ;
  }
  case SET_DT:
      sprintf( buffer, "(set:set-make)" ) ;
      break ;
  default:
    fatal( "init_member: Unknown type %s\n", i2a( dp->ba.type )) ;
    /*NOTREACHED*/
  }
  return( buffer ) ;
}

References domain::ar, ARRAY_DT, domain::ba, BASIS_DT, buffer, domain::constructand, domain::dimensions, fatal(), i2a(), gen_binding::inlined, IS_EXTERNAL, IS_INLINABLE, inlinable::Lisp_value, LIST_DT, gen_binding::name, SET_DT, start, TYPE, and domain::type.

Referenced by gen_and(), gen_array(), and gen_set().

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

or_counter

int or_counter

static

Definition at line 67 of file genLisp.c.

Referenced by gen_or(), and gencode().

package

char* package

static

The package name in which functions will be defined.

Definition at line 59 of file genLisp.c.

Referenced by FindEntity(), FindEntityFromUserName(), FindOrCreateEntity(), FindOrCreateEntityLikeModel(), gen_prelude(), gfc2pips_char2entity(), make_complexity_unknown(), and SafeFindOrCreateEntity().

Read_spec_mode

int Read_spec_mode

extern int Current_first ;

Definition at line 63 of file genLisp.c.

start

char start[1024]

static

The name of the variable from which to start counting domain numbers.

Definition at line 55 of file genLisp.c.

Referenced by address_of_variable_is_taken(), addStatementToSequence(), clear_log_subwindow(), fun_completion(), gen_external(), gen_or(), gen_prelude(), gencode(), generate_type_member(), gfc2pips_array_ref2indices(), gfc2pips_truncate_useless_zeroes(), init_member(), init_reachable(), main(), save_edited_file(), and str_sub().

Tabulated_bp

struct gen_binding* Tabulated_bp

Definition at line 61 of file genLisp.c.

Referenced by gencode().