lac : 4cc76bd9dfe670998d24a9cb05a9a0dc09e9bff3

     1: /*
     2:     lac -- a lisp interpreter library
     3:    Copyright (C) 2010 Gianluca Guida
     4: 
     5:    This program is free software; you can redistribute it and/or modify
     6:    it under the terms of the GNU General Public License as published by
     7:    the Free Software Foundation; either version 2 of the License, or
     8:    (at your option) any later version.
     9: 
    10:    This program is distributed in the hope that it will be useful,
    11:    but WITHOUT ANY WARRANTY; without even the implied warranty of
    12:    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    13:    GNU General Public License for more details.
    14: 
    15:    You should have received a copy of the GNU General Public License along
    16:    with this program; if not, write to the Free Software Foundation, Inc.,
    17:    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    18: */
    19: 
    20: #ifndef __PRIVATE_H
    21: #define __PRIVATE_H
    22: 
    23: #include <stdio.h>
    24: #include <stdint.h>
    25: #include <string.h>
    26: #include <setjmp.h>
    27: #include <gc/gc.h>
    28: #include "lac.h"
    29: 
    30: #ifdef NO_ASSERT
    31: #define assert(...)
    32: #else
    33: #include <assert.h>
    34: #endif
    35: 
    36: #define is_llproc(lr) (lreg_raw_type(lr) == LREG_LLPROC)
    37: #define is_symbol(lr) (lreg_raw_type(lr) == LREG_SYMBOL)
    38: #define is_cons(lr) (lreg_raw_type(lr) == LREG_CONS)
    39: #define is_lambda(lr) (lreg_raw_type(lr) == LREG_LAMBDA)
    40: #define is_macro(lr) (lreg_raw_type(lr) == LREG_MACRO)
    41: 
    42: int lacint_extty_equal(lreg_t arg1, lreg_t arg2);
    43: 
    44: #define HT_SIZE 32
    45: 
    46: struct ht_entry {
    47: 	lreg_t key;
    48: 	lreg_t value;
    49: 	struct ht_entry *next;
    50: };
    51: 
    52: struct ht_cache {
    53: 	lreg_t key;
    54: 	lreg_t value;
    55: };
    56: 
    57: typedef struct ht {
    58: 	struct ht_entry *table[HT_SIZE];
    59: } ht_t;
    60: 
    61: struct env {
    62: 	ht_t htable;
    63: };
    64: 
    65: /*
    66:  * Embedded procedures
    67:  */
    68: 
    69: #define lreg_to_llproc(lr) lreg_to_cfunc(lr)
    70: #define llproc_to_lreg(llproc) cfunc_to_lreg(llproc, LREG_LLPROC)
    71: 
    72: static inline lac_function_t lreg_to_cfunc(lreg_t lr)
    73: {
    74: 	assert(is_llproc(lr));
    75: 	return (lac_function_t) lreg_raw_ptr(lr);
    76: }
    77: 
    78: static inline lreg_t cfunc_to_lreg(lac_function_t llproc, unsigned type)
    79: {
    80: 	assert(((uintptr_t) llproc & LREG_TYPE_MASK) == 0);
    81: 	return lreg_raw(llproc, type);
    82: }
    83: 
    84: /*
    85:  * Macro/Lambda procedures
    86:  */
    87: 
    88: static inline lreg_t get_closure_proc(lreg_t lr)
    89: {
    90: 	lreg_t c = lreg_raw(lreg_raw_ptr(lr), LREG_CONS);
    91: 	assert((lreg_raw_type(lr) == LREG_LAMBDA)
    92: 	       || (lreg_raw_type(lr) == LREG_MACRO));
    93: 
    94: 	return car(c);
    95: }
    96: 
    97: static inline lenv_t *get_closure_env(lreg_t lr)
    98: {
    99: 	lreg_t c = lreg_raw(lreg_raw_ptr(lr), LREG_CONS);
   100: 	assert((lreg_raw_type(lr) == LREG_LAMBDA)
   101: 	       || (lreg_raw_type(lr) == LREG_MACRO));
   102: 
   103: 	return (lenv_t *) lreg_raw_ptr(cdr(c));
   104: }
   105: 
   106: static inline lreg_t get_proc_binds(lreg_t lr)
   107: {
   108: 	return car(lr);
   109: }
   110: 
   111: static inline lreg_t get_proc_body(lreg_t lr)
   112: {
   113: 	return cdr(lr);
   114: }
   115: 
   116: 
   117: /*
   118:  * Private exception management. 
   119:  */
   120: 
   121: #define _throw() do {				\
   122: 	struct _lac_xcpt *p = _lac_xcpt;	\
   123: 	_lac_xcpt = p->next;			\
   124: 	siglongjmp(p->buf, 1);			\
   125:     } while(0)
   126: 
   127: /*
   128:  * Environment management.
   129:  */
   130: 
   131: void env_init(lenv_t * env);
   132: lreg_t env_lookup(lenv_t * env, lreg_t key);
   133: int env_define(lenv_t * env, lreg_t key, lreg_t value);
   134: int env_set(lenv_t * env, lreg_t key, lreg_t value);
   135: void env_pushnew(lenv_t * env, lenv_t * new);
   136: 
   137: 
   138: #endif				/* PRIVATE_H */