LambLisp.h

#ifndef LL_LAMB_H
#define LL_LAMB_H
 
#include "ll_platform_generic.h"


class LL_Port;                  
typedef LL_Port Port_t;         
typedef Port_t *Portst_t;       

typedef void CPPDeleter(void *cpp_obj);
typedef CPPDeleter *CPPDeleterPtr;
 
class Cell;             //forward
typedef Cell *Sexpr_t;  

extern Sexpr_t NIL;             
extern Sexpr_t HASHT;           
extern Sexpr_t HASHF;           
extern Sexpr_t OBJ_EOF;         
extern Sexpr_t OBJ_UNDEF;       
extern Sexpr_t OBJ_VOID;        
extern Sexpr_t OBJ_SYSERROR;    

class Cell {
public:
  Cell() {}
  
  Cell(Word_t typ, Word_t  w1, Word_t  w2)      { type(typ);  rplaca(w1);  rplacd(w2); }
  Cell(Word_t typ, Int_t   w1, Sexpr_t w2)      { type(typ);  rplaca((Word_t) w1);  rplacd((Word_t) w2); }
  Cell(Word_t typ, Sexpr_t w1, Sexpr_t w2)      { type(typ);  rplaca((Word_t) w1);  rplacd((Word_t) w2); }

  enum {
    //Complex atoms first
    T_SVEC_HEAP=0,      
    T_SVEC2N_HEAP,      
    
    T_ANY_HEAP_SVEC = T_SVEC2N_HEAP,    
    
    T_SYM_HEAP,         
    T_BVEC_HEAP,        
    T_STR_HEAP,         
    T_CPP_HEAP,         
 
    T_PORT_HEAP,        
    T_NEEDS_FINALIZING = T_PORT_HEAP,   
    
    T_BVEC_EXT,         
    T_STR_EXT,          
 
    T_BVEC_IMM,         
    T_STR_IMM,          
    T_GENSYM,           
 
    //Simple atoms next
    T_BOOL,             
    T_CHAR,             
    T_INT,              
    T_REAL,             
    T_RATIONAL,         
 
    //Interface atoms to C++ functions.  No garbage collection finalization required.
    T_MOP3_PROC,        
    T_MOP3_NPROC,       
 
    //T_VOID and T_UNDEF are singletons
    T_VOID,             
    T_UNDEF,            

    T_NIL,              

    T_PAIR,             
    T_SVEC_IMM,         
    T_PROC,             
    T_NPROC,            
    T_MACRO,            
    T_DICT,             
    T_THUNK_SEXPR,      
    T_THUNK_BODY,       
    T_ERROR,            
 
    Ntypes      
  };
  
  static const int F_GC01 = 0x01;       
  static const int F_GC02 = 0x02;       
  static const int F_GC04 = 0x04;       
  static const int F_TAIL = 0x08;       
  static const int F_0x10 = 0x10;       
  static const int F_0x20 = 0x20;       
  static const int F_0x40 = 0x40;       
  static const int F_0x80 = 0x80;       
  static const int GC_STATE_MASK  = F_GC01 | F_GC02 | F_GC04;   
  
#define _type_          (_contents._byte[0])
#define _flags_         (_contents._byte[1])
#define _car_           (_contents._word[1])
#define _cdr_           (_contents._word[2])
#define _car_addr_      (&(_car_))
#define _int_ptr_       ((Int_t *) _car_addr_)
#define _real_ptr_      ((Real_t *) _car_addr_)
#define _byte2_ptr_     (&(_contents._byte[2]))
 
  void  zero()                  { _contents._word[0] = _contents._word[1] = _contents._word[2] = 0; }   
  Int_t type(void)              { return _type_; }      
  void  type(Int_t t)           { _type_  = t; }        
 
  Int_t flags(void)             { return _flags_; }     
  void  flags_set(Int_t f)      { _flags_ |= f; }       
  void  flags_clr(Int_t f)      { _flags_ &= ~f; }      
 
  void  rplaca(Word_t p)        { _car_ = p; }          
  void  rplacd(Word_t p)        { _cdr_ = p; }          

 
  typedef struct {
    Int_t typ;
    bool is_any_pair, is_any_svec, is_any_svec2n, is_any_str, is_any_sym, is_any_bvec;
    const char *type_name;
  } CellFeatures;
  
  static const CellFeatures features[Ntypes];
 
  void init_static_data();
  
  Bool_t is_atom(void)                  { return _type_ <= T_NIL; }                             
  Bool_t is_pair(void)                  { return _type_ == T_PAIR; }                            
 
  //Note sometimes faster to check the features, other times faster to check the type directly.  For 3 checks the feature table wins, but for 2 it is not always obvious.
  Bool_t is_any_pair(void)              { return _type_ > T_NIL; }                                              
  Bool_t is_any_svec_atom()             { return features[_type_].is_any_svec; }                                
  Bool_t is_any_svec2n_atom()           { return (_type_ == T_SVEC2N_HEAP) || (_type_ == T_SVEC_IMM); }         
  Bool_t is_any_str_atom(void)          { return features[_type_].is_any_str; }                                 
  Bool_t is_any_sym_atom(void)          { return (_type_ == T_SYM_HEAP) || (_type_ == T_GENSYM); }              
  Bool_t is_any_bvec_atom(void)         { return features[_type_].is_any_bvec; }                                
  

  enum { gcst_idle, gcst_issued, gcst_stacked, gcst_marked, gcst_free, Ngcstates };
  
  Int_t   gc_state(void)        { return _flags_ & GC_STATE_MASK; }                                                     
  Sexpr_t gc_state(Int_t st)    { _flags_ =  (_flags_ & ~GC_STATE_MASK) | (st & GC_STATE_MASK);  return this; }         
  Int_t   tail_state(void)      { return _flags_ & F_TAIL; }                                                            
  Sexpr_t tail_state_set(void)  { _flags_ |=  F_TAIL;  return this; }                                                   
  Sexpr_t tail_state_clr(void)  { _flags_ &= ~F_TAIL;  return this; }                                                   
  
  Ptr_t  get_car_addr()         { return _car_addr_; }                  
  Word_t get_car(void)          { return _car_; }                       
  Word_t get_cdr(void)          { return _cdr_; }                       
 
  Bool_t as_Bool_t()            { return (Bool_t) _car_; }              
  Char_t as_Char_t()            { return (Char_t) _car_; }              
  Int_t  as_Int_t()             { return *_int_ptr_; }                  
  Real_t as_Real_t()            { return *_real_ptr_; }                 
 
  Ptr_t     as_Ptr_t()          { return (Ptr_t)     _cdr_; }           
  Charst_t  as_Charst_t()       { return (Charst_t)  as_Ptr_t(); }      
  Bytest_t  as_Bytest_t()       { return (Bytest_t)  as_Ptr_t(); }      
  CharVec_t as_CharVec_t()      { return (CharVec_t) as_Ptr_t(); }      
  ByteVec_t as_ByteVec_t()      { return (ByteVec_t) as_Ptr_t(); }      
  Portst_t  as_Portst_t()       { return (Portst_t)  as_Ptr_t(); }      
  
  Int_t as_numerator()          { return (Int_t) _car_; }               
  Int_t as_denominator()        { return (Int_t) _cdr_; }               


  Int_t hash_sexpr(void);       
  Int_t hash_contents(void);    
  Int_t hash(void)      { return (type() == T_SYM_HEAP) ? prechecked_sym_heap_get_hash() : hash_sexpr(); }      
  
  Sexpr_t set(Int_t typ, Word_t w1, Word_t w2)  { _type_ = typ;  _car_ = w1;  _cdr_ = w2;  return this; }                       
  Sexpr_t set(Int_t typ, Int_t a,   Sexpr_t b)  { _type_ = typ;  _car_ = (Word_t) a;  _cdr_ = (Word_t) b;  return this; }       
  Sexpr_t set(Int_t typ, Sexpr_t a, Sexpr_t b)  { _type_ = typ;  _car_ = (Word_t) a;  _cdr_ = (Word_t) b;  return this; }       
  
  Sexpr_t set(Bool_t b)                         { return set(T_BOOL, (Word_t) b, (Word_t) 0); }         
  Sexpr_t set(Char_t c)                         { return set(T_CHAR, (Word_t) c, (Word_t) 0); }         
  Sexpr_t set(Int_t i)                          { _type_ = T_INT;  _car_ = _cdr_ = 0;  *_int_ptr_  = i;  return this; } 
  Sexpr_t set(Real_t r)                         { _type_ = T_REAL; _car_ = _cdr_ = 0;  *_real_ptr_ = r;  return this; } 
  Sexpr_t set(Port_t &p)                        { return set(T_PORT_HEAP, (Word_t) 0, (Word_t) &p); }   
  //Sexpr_t set(Sexpr_t a, Sexpr_t b)           { return set(T_PAIR, a, b); }                           //!<Set cell as pair
  
  Sexpr_t set(Int_t typ, Int_t a, Charst_t b)   { return set(typ, (Word_t) a, (Word_t) b); }    
  Sexpr_t set(Int_t typ, Int_t a, Bytest_t b)   { return set(typ, (Word_t) a, (Word_t) b); }    
  Sexpr_t set(Int_t typ, Int_t a, CharVec_t b)  { return set(typ, (Word_t) a, (Word_t) b); }    
  Sexpr_t set(Int_t typ, Int_t a, ByteVec_t b)  { return set(typ, (Word_t) a, (Word_t) b); }    
  
  Sexpr_t mk_error(const char *fmt, ...) CHECKPRINTF_pos2;                      
  Sexpr_t mk_error(Sexpr_t irritants, const char *fmt, ...) CHECKPRINTF_pos3;   
  
  Sexpr_t   prechecked_anypair_get_car()                { return (Sexpr_t) get_car(); }
  Sexpr_t   prechecked_anypair_get_cdr()                { return (Sexpr_t) get_cdr(); }
  
  Int_t     prechecked_sym_heap_get_hash()                              { return as_Int_t(); }
  Charst_t  prechecked_sym_heap_get_chars()                             { return (Charst_t) as_Ptr_t(); }
  void      prechecked_sym_heap_get_info(Int_t &hsh, Charst_t &chars)   { hsh = as_Int_t();  chars = (Charst_t) as_Ptr_t(); }
 
  CharVec_t prechecked_str_heap_get_chars()                             { return as_CharVec_t(); }              
  CharVec_t prechecked_str_ext_get_chars()                              { return as_CharVec_t(); }              
  CharVec_t prechecked_str_imm_get_chars()                              { return (CharVec_t) _byte2_ptr_; }     
 
  void      prechecked_bvec_imm_set_length(Int_t l)                     { _contents._byte[2] = l; }
  
  Charst_t  prechecked_gensym_get_chars()                               { static String s = "";  s = toString("G%s", ascii.hex(_cdr_));  return s.c_str(); }
  void      prechecked_gensym_get_info(Int_t &hsh, Charst_t &chars)     { hsh = as_Int_t();  chars = prechecked_gensym_get_chars(); }
  
  Sexpr_t   prechecked_error_get_irritants()                            { return (Sexpr_t) get_cdr(); }
  Sexpr_t   prechecked_error_get_str()                                  { return (Sexpr_t) get_car(); }
  Charst_t  prechecked_error_get_chars()                                { return prechecked_error_get_str()->any_str_get_chars(); }

#define THROW_BAD_TYPE { throw mk_error("%s Bad type %s", me, dump().c_str()); }
  Bool_t  mustbe_Bool_t()       { ME("Cell::mustbe_Bool_t()");    if (type() == T_BOOL)  return as_Bool_t(); THROW_BAD_TYPE; }          
  Char_t  mustbe_Char_t()       { ME("Cell::mustbe_Char_t()");    if (type() == T_CHAR)  return as_Char_t(); THROW_BAD_TYPE; }          
  Int_t   mustbe_Int_t()        { ME("Cell::mustbe_Int_t()");     if (type() == T_INT)   return as_Int_t();  THROW_BAD_TYPE; }          
  Real_t  mustbe_Real_t()       { ME("Cell::mustbe_Real_t()");    if (type() == T_REAL)  return as_Real_t(); THROW_BAD_TYPE; }          
 
  Sexpr_t mustbe_any_str_t()    { ME("Cell::mustbe_any_str_t()"); if (is_any_str_atom()) return this;        THROW_BAD_TYPE; }          
  Sexpr_t mustbe_cppobj_t()     { ME("Cell::mustbe_cppobj_t()");  if (type() == T_CPP_HEAP) return this;     THROW_BAD_TYPE; }          
 
  CPPDeleterPtr prechecked_cppobj_get_deleter()         { return (CPPDeleterPtr) _car_; }       
  Ptr_t prechecked_cppobj_get_ptr()                     { return as_Ptr_t(); }                  
 
  CPPDeleterPtr any_cppobj_get_deleter()                { return mustbe_cppobj_t()->prechecked_cppobj_get_deleter(); }
  Ptr_t any_cppobj_get_ptr()                            { return mustbe_cppobj_t()->prechecked_cppobj_get_ptr(); }
  void any_cppobj_get_info(CPPDeleterPtr &d, Ptr_t &p)  { Sexpr_t o = mustbe_cppobj_t();  d = o->prechecked_cppobj_get_deleter();  p = o->prechecked_cppobj_get_ptr(); }
 
  Real_t coerce_Real_t()        
  {
    ME("Cell::coerce_Real_t()");
    Int_t typ = type();
    if (typ == T_REAL) return as_Real_t();
    else if (typ == T_INT) return (Real_t) as_Int_t();
    else if (typ == T_CHAR) return (Real_t) as_Char_t();
    THROW_BAD_TYPE;
  }
 
  Real_t coerce_Int_t()         
  {
    ME("Cell::coerce_Int_t()");
    Int_t typ = type();
    if (typ == T_INT) return as_Int_t();
    else if (typ == T_REAL) return (Int_t) as_Real_t();
    else if (typ == T_CHAR) return (Int_t) as_Char_t();
    THROW_BAD_TYPE;
  }
 
  Sexpr_t   anypair_get_car()           { ME("Cell::anypair_get_car()");      if (is_any_pair()) return prechecked_anypair_get_car(); THROW_BAD_TYPE; }
  Sexpr_t   anypair_get_cdr()           { ME("Cell::anypair_get_cdr()");      if (is_any_pair()) return prechecked_anypair_get_cdr(); THROW_BAD_TYPE; }
 
  Sexpr_t   error_get_str()             { ME("Cell::error_get_str()");        if (_type_ == T_ERROR) return prechecked_error_get_str(); THROW_BAD_TYPE; }
  Sexpr_t   error_get_irritants()       { ME("Cell::error_get_irritants()");  if (_type_ == T_ERROR) return prechecked_error_get_irritants(); THROW_BAD_TYPE; }
  Charst_t  error_get_chars()           { ME("Cell::error_get_chars()");      if (_type_ == T_ERROR) return prechecked_error_get_chars(); THROW_BAD_TYPE; }
 
  Int_t any_sym_get_hash()              { ME("any_sym_get_hash()");           if (is_any_sym_atom()) return as_Int_t(); THROW_BAD_TYPE; }
  
  Charst_t any_sym_get_chars() {
    ME("Cell::any_sym_get_chars()");
    if (_type_ == T_SYM_HEAP) return prechecked_sym_heap_get_chars();
    else if (_type_ == T_GENSYM) return prechecked_gensym_get_chars();
    else THROW_BAD_TYPE;
  }
  
  void any_sym_get_info(Int_t &hsh, Charst_t &chars) {
    ME("Cell::any_sym_get_info()");
    if (_type_ == T_SYM_HEAP) prechecked_sym_heap_get_info(hsh, chars);
    else if (_type_ == T_GENSYM) prechecked_gensym_get_info(hsh, chars);
    else THROW_BAD_TYPE;
  }
  

  
  CharVec_t any_str_get_chars() {
    ME("Cell::anystring_get_chars()");
    if (_type_ == T_STR_IMM) return prechecked_str_imm_get_chars();
    else if (_type_ == T_STR_HEAP) return prechecked_str_heap_get_chars();
    else if (_type_ == T_STR_EXT) return prechecked_str_ext_get_chars();
    else THROW_BAD_TYPE;
  }
 
  Int_t any_str_get_length()                            { return strlen(any_str_get_chars()); }
  void any_str_get_info(Int_t &len, CharVec_t &chars)   { len = strlen(chars = any_str_get_chars()); }

  
  void any_svec_get_info(Int_t &Nelems, Sexpr_t *&elems) {
    ME("Cell::any_svec_get_info()");
    Int_t typ = _type_;
    if (typ <= T_SVEC2N_HEAP) {
      Nelems = as_Int_t();
      elems  = (Sexpr_t *) as_Ptr_t();
    }
    else if (typ == T_SVEC_IMM) {       //could be 0, 1 or 2 elems
      Nelems = 2;       //assume
      if (prechecked_anypair_get_cdr() == OBJ_VOID) Nelems--;
      if (prechecked_anypair_get_car() == OBJ_VOID) Nelems--;
      elems  = (Sexpr_t *) _car_addr_;
    }
    else THROW_BAD_TYPE;
  }
 
  Sexpr_t *any_svec_get_elems()
  {
    ME("Cell::any_svec_get_elems()");
    Sexpr_t *res = 0;
    Int_t typ    = _type_;
 
    if (typ <= T_SVEC2N_HEAP) res = (Sexpr_t *) as_Ptr_t();
    else if (typ == T_SVEC_IMM) res  = (Sexpr_t *) _car_addr_;
    else THROW_BAD_TYPE;
 
    return res;
  }
  
  Int_t any_bvec_get_length()
  {
    ME("Cell::any_bvec_get_length()");
    Int_t Nelems = -1;
    if (_type_ == T_BVEC_IMM) {
      ByteVec_t b = (ByteVec_t) _byte2_ptr_;
      Nelems = b[0];
    }
    else if ((_type_ == T_BVEC_HEAP) || (_type_ == T_BVEC_EXT)) Nelems = as_Int_t();
    else THROW_BAD_TYPE;
 
    return Nelems;
  }
  
  ByteVec_t any_bvec_get_elems()
  {
    ME("Cell::any_bvec_get_elems()");
    ByteVec_t res = 0;
    if (_type_ == T_BVEC_IMM) {
      ByteVec_t b = (ByteVec_t) _byte2_ptr_;
      res = (ByteVec_t) &(b[1]);
    }
    else if ((_type_ == T_BVEC_HEAP) || (_type_ == T_BVEC_EXT)) res  = as_ByteVec_t();
    else THROW_BAD_TYPE;
    return res;
  }
  
  void any_bvec_get_info(Int_t &Nelems, ByteVec_t &elems)
  {
    ME("Cell::any_bvec_get_info()");
    if (_type_ == T_BVEC_IMM) {
      ByteVec_t b = (ByteVec_t) _byte2_ptr_;
      Nelems      = b[0];
      elems       = (ByteVec_t) &(b[1]);
    }
    else if ((_type_ == T_BVEC_HEAP) || (_type_ == T_BVEC_EXT)) {
      Nelems = as_Int_t();
      elems  = as_ByteVec_t();
    }
    else THROW_BAD_TYPE;
  }
    
#undef THROW_BAD_TYPE
#undef _type_
#undef _flags_
#undef _car_
#undef _cdr_
#undef _car_addr_
#undef _int_ptr_
#undef _real_ptr_
#undef _byte2_ptr_
    
  String   cell_name(void);             
 
  Charst_t type_name(Int_t typ);        
  Charst_t type_name(void) { return type_name(this->type()); }
  Charst_t gcstate_name(void);          
 
  String dump();                        
 
  String str(Sexpr_t sx, Bool_t as_write_or_display, Int_t env_depth, Int_t max_depth);
  String str(Bool_t as_write_or_display, Int_t env_depth, Int_t max_depth)      { return str(this, as_write_or_display, env_depth, max_depth); }
  String str(Bool_t as_write_or_display, Int_t env_depth)                       { return str(this, as_write_or_display, env_depth, 10); }
  String str(Bool_t as_write_or_display)                                        { return str(this, as_write_or_display, 1, 10); }
  String str(Int_t env_depth)                                                   { return str(this, true, env_depth, 10); }
  String str(void)                                                              { return str(this, true, 1, 10); }
  
private:
  union {
    Byte_t _byte[3 * sizeof(Word_t)];
    Word_t _word[3];
  } _contents;
 
};
 
static_assert(sizeof(Cell) == 3*sizeof(Word_t), "Cell size != 3*Word_t size\n");
static_assert(sizeof(Cell) == 3*sizeof(Ptr_t),  "Cell size != 3*Ptr_t size\n");

extern Sexpr_t LAMB_INPUT;      
extern Sexpr_t LAMB_OUTPUT;     
 
class LambMemoryManager;

class Lamb {
public:
 
  Lamb();
  
  typedef Sexpr_t (*Mop3st_t)(Lamb &lamb, Sexpr_t sexpr, Sexpr_t env_exec);

  Sexpr_t setup(void);  
  Sexpr_t loop(void);   
  void end(void);       

  void log(const char *fmt, ...) CHECKPRINTF_pos2;      
  void printf(const char *fmt, ...) CHECKPRINTF_pos2;   
  bool debug(void);                                     
  void debug(bool onoff);                               

  bool build_isDebug();                 
  unsigned long build_version();        
  unsigned long build_UTC();            
  unsigned long build_pushUTC();        
  const char *build_buildRelease();     
  const char *build_buildDate();        
  const char *build_pushDate();         

  void expand();                                                        
  Sexpr_t tcons(Int_t typ, Word_t a,  Word_t  b, Sexpr_t env_exec);     
  Sexpr_t tcons(Int_t typ, Sexpr_t a, Sexpr_t b, Sexpr_t env_exec);     
 
  Sexpr_t cons(Sexpr_t a,  Sexpr_t b, Sexpr_t env_exec) { return tcons(Cell::T_PAIR, a, b, env_exec); } 
 
  Sexpr_t gensym(Sexpr_t env_exec);     
  
  void  gc_root_push(Sexpr_t p);        
  void  gc_root_pop(Int_t n=1);         
  
  Sexpr_t car(Sexpr_t l);
  Sexpr_t cdr(Sexpr_t l);
  Sexpr_t caar(Sexpr_t l)       { return car(car(l)); }
  Sexpr_t cadr(Sexpr_t l)       { return car(cdr(l)); }
  Sexpr_t cdar(Sexpr_t l)       { return cdr(car(l)); }
  Sexpr_t cddr(Sexpr_t l)       { return cdr(cdr(l)); }
  Sexpr_t caddr(Sexpr_t l)      { return car(cddr(l)); }
  Sexpr_t cdddr(Sexpr_t l)      { return cdr(cddr(l)); }
  Sexpr_t cadddr(Sexpr_t l)     { return car(cdddr(l)); }
  Sexpr_t cddddr(Sexpr_t l)     { return cdr(cdddr(l)); }
  
  void set_car_bang(Sexpr_t c, Sexpr_t val);                    
  void set_cdr_bang(Sexpr_t c, Sexpr_t val);                    
  void vector_set_bang(Sexpr_t vec, Int_t k, Sexpr_t val);      
  Sexpr_t reverse_bang(Sexpr_t l);                              
  
  Sexpr_t eq_q(Sexpr_t obj1, Sexpr_t obj2);     
  Sexpr_t eqv_q(Sexpr_t obj1, Sexpr_t obj2);    
  Sexpr_t equal_q(Sexpr_t obj1, Sexpr_t obj2);  
  Sexpr_t assq(Sexpr_t obj, Sexpr_t alist);     

  
  Sexpr_t oblist_query(Sexpr_t oblist, const char *identifier, Bool_t force, Sexpr_t env_exec);
  Sexpr_t oblist_test(Sexpr_t oblist, const char *identifier, Sexpr_t env_exec)         { return oblist_query(oblist, identifier, false, env_exec); }
  Sexpr_t oblist_intern(Sexpr_t oblist, const char *identifier, Sexpr_t env_exec)       { return oblist_query(oblist, identifier, true, env_exec); }
  Sexpr_t oblist_analyze(Sexpr_t oblist, Int_t verbosity, Sexpr_t env_exec);

  Sexpr_t dict_new(Int_t framesize, Sexpr_t env_exec)                           { return dict_add_empty_frame(NIL, framesize, env_exec); }      
  Sexpr_t dict_new(Sexpr_t env_exec)                                            { return dict_add_empty_frame(NIL, 0, env_exec); }              
 
  Sexpr_t dict_add_empty_frame(Sexpr_t dict, Int_t framesize, Sexpr_t env_exec);        
  Sexpr_t dict_add_empty_frame(Sexpr_t dict, Sexpr_t env_exec)                  { return dict_add_empty_frame(dict, 0, env_exec); }     
  
  Sexpr_t dict_add_keyval_frame(Sexpr_t dict, Sexpr_t keys, Sexpr_t vals, Sexpr_t env_exec);                                            
  Sexpr_t dict_add_alist_frame(Sexpr_t dict, Sexpr_t alist, Sexpr_t env_exec)   { return mk_dict(alist, dict, env_exec); }              
  
  void    dict_bind_bang(Sexpr_t dict, Sexpr_t key, Sexpr_t value, Sexpr_t env_exec);   
  void    dict_rebind_bang(Sexpr_t dict, Sexpr_t key, Sexpr_t value, Sexpr_t env_exec); 
  void    dict_bind_alist_bang(Sexpr_t dict, Sexpr_t alist, Sexpr_t env_exec);          
  void    dict_rebind_alist_bang(Sexpr_t dict, Sexpr_t alist, Sexpr_t env_exec);        
 
  Sexpr_t dict_ref_q(Sexpr_t dict, Sexpr_t key);                                        
  Sexpr_t dict_ref(Sexpr_t dict, Sexpr_t key);                                          

  Sexpr_t dict_keys(Sexpr_t dict, Sexpr_t env_exec);                            
  Sexpr_t dict_values(Sexpr_t dict, Sexpr_t env_exec);                          
  
  Sexpr_t dict_to_alist(Sexpr_t dict, Sexpr_t env_exec);        
  Sexpr_t dict_to_2list(Sexpr_t dict, Sexpr_t env_exec);        
  Sexpr_t alist_to_dict(Sexpr_t alist, Sexpr_t env_exec);       
  Sexpr_t twolist_to_dict(Sexpr_t twolist, Sexpr_t env_exec);   
 
  Sexpr_t dict_analyze(Sexpr_t dict, Int_t verbosity = 0);      

  Sexpr_t read(LL_Port &src, Sexpr_t env_exec)  { return read_sexpr(src, env_exec, false); }
 
  Sexpr_t write_or_display(Sexpr_t sexpr, Bool_t do_write);
  Sexpr_t write_simple(Sexpr_t sexpr);
 
  String  sprintf(Charst_t fmt, Sexpr_t sexpr, Sexpr_t env_exec);
 
  Sexpr_t printf(Sexpr_t args, LL_Port &outp);
  Sexpr_t printf(Sexpr_t args);
  
  Sexpr_t eval(Sexpr_t sexpr, Sexpr_t env_exec);                                
  Sexpr_t eval_list(Sexpr_t args, Sexpr_t env_exec);                            
  Sexpr_t apply_proc_partial(Sexpr_t proc, Sexpr_t sexpr, Sexpr_t env_exec);    
  Sexpr_t map_proc(Sexpr_t proc, Sexpr_t lists, Sexpr_t env_exec);              

  Sexpr_t r5_base_environment()         { return _r5_base_environment; }
  Sexpr_t r5_interaction_environment()  { return _r5_interaction_environment; }
  Sexpr_t lamb_oblist()                 { return _lamb_oblist; }
  
  Sexpr_t current_input_port()          { return _r5_current_input_port; }
  Sexpr_t current_output_port()         { return _r5_current_output_port; }
  Sexpr_t current_error_port()          { return _r5_current_error_port; }
  
  Sexpr_t load(Charst_t name, Sexpr_t env_exec, Int_t verbosity = 0);           
  
  Sexpr_t append(Sexpr_t sexpr, Sexpr_t env_exec);
  Sexpr_t append2(Sexpr_t lis, Sexpr_t obj, Sexpr_t env_exec);  
  Sexpr_t list_copy(Sexpr_t sexpr, Sexpr_t env_exec);
  Sexpr_t list_analyze(Sexpr_t sexpr, Sexpr_t env_exec);        
  Sexpr_t list_to_vector(Sexpr_t l, Sexpr_t env_exec);
  Sexpr_t vector_to_list(Sexpr_t v, Sexpr_t env_exec);
  Sexpr_t vector_copy(Sexpr_t from, Sexpr_t env_exec);

  Sexpr_t vector_to_sparsevec(Sexpr_t vec, Sexpr_t skip, Sexpr_t env_exec);
  Sexpr_t sparsevec_to_vector(Sexpr_t alist, Sexpr_t fill, Sexpr_t env_exec);

  Sexpr_t mk_error(Sexpr_t env_exec, Sexpr_t irritants, const char *fmt, ...) CHECKPRINTF_pos4; 
  Sexpr_t mk_error(Sexpr_t env_exec, const char *fmt, ...) CHECKPRINTF_pos3;                    
  Sexpr_t mk_syserror(const char *fmt, ...) CHECKPRINTF_pos2;                                   
  Sexpr_t mk_syserror(Sexpr_t irritants, const char *fmt, ...) CHECKPRINTF_pos3;                
  
  Sexpr_t mk_bool(Bool_t b, Sexpr_t env_exec)                           { return tcons(Cell::T_PAIR, NIL, NIL, env_exec)->set(b);  }
  Sexpr_t mk_character(Char_t ch, Sexpr_t env_exec)                     { return tcons(Cell::T_PAIR, NIL, NIL, env_exec)->set(ch); }
  Sexpr_t mk_integer(Int_t i, Sexpr_t env_exec)                         { return tcons(Cell::T_PAIR, NIL, NIL, env_exec)->set(i);  }
  Sexpr_t mk_real(Real_t r, Sexpr_t env_exec)                           { return tcons(Cell::T_PAIR, NIL, NIL, env_exec)->set(r);  }
 
  Sexpr_t mk_number(Charst_t str, Sexpr_t env_exec);
  Sexpr_t mk_sharp_const(Charst_t name, Sexpr_t env_exec);
  
  Sexpr_t mk_string(Sexpr_t env_exec, const char *fmt, ...) CHECKPRINTF_pos3;
  Sexpr_t mk_string(Int_t k, Charst_t src, Sexpr_t env_exec);
  Sexpr_t mk_string(String s, Sexpr_t env_exec)                 { return mk_string(s.length(), s.c_str(), env_exec); }
  
  Sexpr_t mk_symbol_or_number(Charst_t str, Sexpr_t env_exec);
  Sexpr_t mk_symbol(Charst_t str, Sexpr_t env_exec)             { return oblist_intern(_lamb_oblist, str, env_exec);  }
  
  Sexpr_t mk_bytevector(Int_t k, Sexpr_t env_exec);                     
  Sexpr_t mk_bytevector(Int_t k, Bytest_t src, Sexpr_t env_exec);       
  Sexpr_t mk_bytevector(Int_t k, Int_t fill, Sexpr_t env_exec);         

  Sexpr_t mk_bytevector_ext(Int_t k, Bytest_t ext, Sexpr_t env_exec)    { return tcons(Cell::T_BVEC_EXT, (Word_t) k, (Word_t) ext, env_exec); }  

  Sexpr_t mk_intvector(Int_t k, Sexpr_t env_exec);              
  Sexpr_t mk_realvector(Int_t k, Sexpr_t env_exec);             
  Sexpr_t mk_intvector(Int_t k, Int_t fill, Sexpr_t env_exec);
  Sexpr_t mk_realvector(Int_t k, Real_t fill, Sexpr_t env_exec);
 
  Sexpr_t mk_vector(Int_t len, Sexpr_t fill, Sexpr_t env_exec);
  Sexpr_t mk_hashtbl(Int_t len, Sexpr_t fill, Sexpr_t env_exec);
 
  Sexpr_t mk_serial_port(Sexpr_t env_exec);
  Sexpr_t mk_input_file_port(Charst_t name, Sexpr_t env_exec);
  Sexpr_t mk_output_file_port(Charst_t name, Sexpr_t env_exec);
  Sexpr_t mk_input_string_port(Charst_t inp, Sexpr_t env_exec);
  Sexpr_t mk_output_string_port(Sexpr_t env_exec);

  Sexpr_t mk_Mop3_procst_t(Mop3st_t f, Sexpr_t env_exec)                { return tcons(Cell::T_MOP3_PROC,  (Word_t) NIL, (Word_t) f, env_exec);  }
  Sexpr_t mk_Mop3_nprocst_t(Mop3st_t f, Sexpr_t env_exec)               { return tcons(Cell::T_MOP3_NPROC, (Word_t) NIL, (Word_t) f, env_exec); }
  Sexpr_t mk_cppobj(void *obj, CPPDeleterPtr deleter, Sexpr_t env_exec) { return tcons(Cell::T_CPP_HEAP,   (Word_t) deleter, (Word_t) obj, env_exec); }

  Sexpr_t mk_macro(Sexpr_t nlam, Sexpr_t env_nlam, Sexpr_t env_exec)                            { return tcons(Cell::T_MACRO, nlam, env_nlam, env_exec); }
  Sexpr_t mk_procedure(Sexpr_t formals, Sexpr_t body, Sexpr_t env_proc, Sexpr_t env_exec)       { return tcons(Cell::T_PROC, cons(formals, body, env_proc), env_proc, env_exec); }
  Sexpr_t mk_nprocedure(Sexpr_t formals, Sexpr_t body, Sexpr_t env_nproc, Sexpr_t env_exec)     { return tcons(Cell::T_NPROC, cons(formals, body, env_nproc), env_nproc, env_exec); }
  Sexpr_t mk_thunk_sexpr(Sexpr_t sexpr, Sexpr_t env_thunk, Sexpr_t env_exec)    { return tcons(Cell::T_THUNK_SEXPR, sexpr, env_thunk, env_exec); }
  Sexpr_t mk_thunk_body(Sexpr_t body, Sexpr_t env_thunk, Sexpr_t env_exec)      { return tcons(Cell::T_THUNK_BODY, body, env_thunk, env_exec); }
  Sexpr_t mk_dict(Sexpr_t frame, Sexpr_t base, Sexpr_t env_exec)                { return tcons(Cell::T_DICT, frame, base, env_exec); }
  Sexpr_t mk_dict(Int_t framesize, Sexpr_t env_exec);

  Sexpr_t macroexpand(Sexpr_t form, Sexpr_t env_exec);
  Sexpr_t macroexpand1(Sexpr_t form, Sexpr_t env_exec);
 
  Sexpr_t macroexpand(Sexpr_t proc, Sexpr_t args, Sexpr_t env_exec);
  Sexpr_t macroexpand1(Sexpr_t proc, Sexpr_t args, Sexpr_t env_exec);
 
  /* put this comment after the last documented member to start new page in doxygen detailed section.
     \latexonly \newpage \endlatexonly
  */
  
private:
 
  LambMemoryManager *mem;
 
  bool _debug_in_progress;
  Int_t _verbosity;
  
  //Symbols and bindings
  static const Int_t _lamb_oblist_size          = 2048;
  static const Int_t _r5_base_frame_size        = 1024;
  static const Int_t _r5_interaction_frame_size = 512;
 
  Sexpr_t _lamb_oblist;
  Sexpr_t _r5_base_environment;
  Sexpr_t _r5_interaction_environment;
 
  Sexpr_t _r5_current_input_port;
  Sexpr_t _r5_current_output_port;
  Sexpr_t _r5_current_error_port;
  
  //Reader
  const char *DELIMITERS = "()\";\f\t\v\n\r ";
  
  enum {
    TOK_EOF,
    TOK_LPAREN,
    TOK_RPAREN,
    TOK_DOT,
    TOK_ATOM,
    TOK_SQUOTE,
    TOK_DQUOTE,
    TOK_BQUOTE,
    TOK_COMMA,
    TOK_COMMA_AT,
    TOK_SHARP,
    TOK_SHARP_CONST,
    TOK_VECTOR,
    TOK_DCOLON,
    Ntokens
  };
 
  void report();
  
  Int_t produce_token(LL_Port &src);
  Sexpr_t consume_token(Int_t tok, LL_Port &src, Sexpr_t env_exec, bool quoted);
 
  //Tokens that the reader recognizes and converts directly to symbols.
  Sexpr_t sym_squote;           //single quote '
  Sexpr_t sym_qquote;           //backquote `
  Sexpr_t sym_unquote;          //comma ,
  Sexpr_t sym_uqsplice;         //comma-at ,@
 
  //Symbols inserted into the reader output to complete multi-step operations
  //e.g., a quoted vector '#(a b c) becomes (apply vector (quote (a b c)))
  Sexpr_t sym_apply;
  Sexpr_t sym_vector;
 
  //Magic reader tokens that turn into magic symbols.
  Sexpr_t sym_colon_hook;       //double colon ::
  Sexpr_t sym_sharp_hook;       //sharp # (not constant or vector)
 
  Sexpr_t sym_ellipsis;         //three dot ellipsis ...
  Sexpr_t sym_fatarrow;         //aka "feed through" =>
  
  //Loop-based control
  Sexpr_t sym_loop;
  
  Sexpr_t vector_eqv_q(Sexpr_t obj1, Sexpr_t obj2);
  Sexpr_t hashtbl_eqv_q(Sexpr_t obj1, Sexpr_t obj2);
  Sexpr_t bytevector_eqv_q(Sexpr_t obj1, Sexpr_t obj2);
  
  //Bindings: Symbols, Variables and Environments
  Sexpr_t dump_frame(Sexpr_t frame);
  Sexpr_t dump_env_stack(Sexpr_t env_stack);

  const char *token2name(Int_t tok);
 
  Sexpr_t read_sexpr(LL_Port &src, Sexpr_t &env_exec, bool quoted);
  Sexpr_t read_atom(LL_Port &src, Sexpr_t &env_exec);
 
  Sexpr_t read_any_quote(Sexpr_t symbol, LL_Port &src, Sexpr_t &env_exec);
  Sexpr_t read_squote(LL_Port &src, Sexpr_t env_exec)   { return read_any_quote(sym_squote, src, env_exec); }
  Sexpr_t read_qquote(LL_Port &src, Sexpr_t env_exec)   { return read_any_quote(sym_qquote, src, env_exec); }
  Sexpr_t read_unquote(LL_Port &src, Sexpr_t env_exec)  { return read_any_quote(sym_unquote, src, env_exec); }
  Sexpr_t read_uqsplice(LL_Port &src, Sexpr_t env_exec) { return read_any_quote(sym_uqsplice, src, env_exec); }
 
  Sexpr_t read_sharp_const(LL_Port &src, Sexpr_t &env_exec);
  Sexpr_t read_sharp(LL_Port &src, Sexpr_t &env_exec);
  Sexpr_t read_vector(LL_Port &src, Sexpr_t &env_exec);
  Sexpr_t read_quotedvector(LL_Port &src, Sexpr_t &env_exec);  
  Sexpr_t read_list(LL_Port &src, Sexpr_t &env_exec, bool quoted);
  Sexpr_t read_string(LL_Port &src, Sexpr_t &env_exec);  
 
};
 
//With error check, inlined for speed.
inline Sexpr_t Lamb::car(Sexpr_t c)     {
  ME("Lamb::car()");
  if (c->type() >= Cell::T_PAIR) return c->prechecked_anypair_get_car();
  embedded_debug_catcher();
  throw mk_syserror("%s Bad type %s", me, c->dump().c_str());
}
 
inline Sexpr_t Lamb::cdr(Sexpr_t c)     {
  ME("Lamb::cdr()");
  if (c->type() >= Cell::T_PAIR) return c->prechecked_anypair_get_cdr();
  embedded_debug_catcher();
  throw mk_syserror("%s Bad type %s", me, c->dump().c_str());
}
 
#endif