LispObj.h

   1
   2 #ifndef H_LISP_OBJ
   3 #define H_LISP_OBJ
   4
   5 #include <cassert>
   6 #include <ostream>
   7 #include <vector>
   8 #include <string>
   9 #include <algorithm>
  10
  11 namespace Lisp
  12 {
  13
  14
  15
  16 enum eObjectType
  17 {
  18         eBaseObj  = 0,
  19         eNullObj,
  20         eStringObj,
  21         eConsObj,
  22         eFixnumObj,
  23         eFloatnumObj,
  24         eSymbolObj,
  25         ePackageObj,
  26         eFunctionObj
  27 };
  28
  29
  30 typedef signed char s8;
  31 typedef signed short s16;
  32 typedef signed int s32;
  33 typedef signed long s64;
  34 typedef signed long long s128;
  35
  36 typedef unsigned char u8;
  37 typedef unsigned short u16;
  38 typedef unsigned int u32;
  39 typedef unsigned long u64;
  40 typedef unsigned long long u128;
  41
  42 typedef float f32;
  43 typedef double f64;
  44
  45 typedef u8 CharType;
  46 typedef u32 FixnumType;
  47 typedef f32 FloatnumType;
  48 typedef void * (*PrimitivePtr)(void *);
  49
  50 struct LispObj;
  51
  52 // smart pointer for pointing at lisp objects
  53 template <typename T> class ObjPtr
  54 {
  55 public:
  56         typedef T* ActualPtrType;
  57         explicit ObjPtr( T* o ) : p_(o) {};
  58 //      ~ObjPtr( ) { delete p_; }
  59         T* operator->() { return get(); };
  60         T& operator*() { return *get(); };
  61
  62         template class<D>
  63         operator ObjPtr<D>()
  64         {
  65                 return ObjPtr<D>(p_);
  66         }
  67
  68 private:
  69         T* get()
  70         {
  71                 return p_;
  72         }
  73
  74         void set(void *p)
  75         {
  76                 p_ = reinterpret_cast<T*>(p);
  77         }
  78
  79         T* p_;
  80
  81         template <typename ActualT, typename CharT, typename FixnumT, typename FloatnumT, typename PrimType, typename PtrType>
  82         friend class TLispValue;
  83 };
  84
  85 // this is what we use to point at a lisp object
  86 typedef ObjPtr<LispObj> PointerType;
  87
  88 // straight primitive call with no environment / args
  89 class PrimitiveType
  90 {
  91 public:
  92         explicit Primitive(PrimitivePtr f) : fn_(f) {}
  93         PointerType operator()(PointerType**p)
  94         {
  95                 return fn_(p):
  96         }
  97 private:
  98         PrimitivePtr fn_;
  99 };
 100
 101 // object data with a tag
 102 template <typename T, typename D, template <typename> class C>
 103 class TaggedObjData
 104 {
 105 public:
 106
 107         typedef T TagType;
 108         typedef D ValueType;
 109         typedef C<D> ValueContainerType;
 110
 111         T tag;
 112         ValueContainerType values;
 113
 114
 115         // T needs to implement sthing which will transform a tag to a
 116         // object type
 117         eObjectType getType()
 118         {
 119                 return T::getType(tag);
 120         }
 121
 122         // Container needs to be sanely indexable
 123         D& operator[](std::size_t i)
 124         {
 125                 return values[i];
 126         }
 127
 128         const D& operator[](std::size_t i) const
 129         {
 130                 return values[i];
 131         }
 132
 133         // container must have capacity
 134         void resize(std::size_t s)
 135         {
 136                 values.reserve(s);
 137                 values.resize(s);
 138         }
 139
 140         // must be able to tell what that capacity is
 141         std::size_t size() const
 142         {
 143                 return values.size();
 144         }
 145
 146 };
 147
 148
 149 // Primitive unboxed values (this must be POD)
 150 template <typename ActualT, typename CharT, typename FixnumT, typename FloatnumT, typename PrimT, typename PtrT, typename ActualPtrT> class TLispValue
 151 {
 152 public:
 153         ActualT value;
 154
 155         // need to be ablue to convert between ActualType and these types
 156         operator PtrT()
 157         {
 158                 // pure evil!
 159                 ActualPtrT* ptr = reinterpret_cast<ActualPtrT*>(&value);
 160                 return PtrT(*ptr);
 161         }
 162
 163                         // we can't overload by return type, so we use value conversion instead
 164         operator FixnumT()
 165         {
 166                 return value;
 167         };
 168
 169         operator FloatnumT()
 170         {
 171                 return *(static_cast<FloatnumT*>(&value));
 172         }
 173
 174         operator CharT()
 175         {
 176                 return *(static_cast<CharT*>(&value));
 177         };
 178
 179         operator PrimT()
 180         {
 181                 return *(static_cast<PrimT*>(&value));
 182         }
 183
 184         // operator=, but then is this POD ?
 185         TLispValue& operator=(PtrT ptr)
 186         {
 187                 ActualPtrT* lhsptr = static_cast<ActualPtrT*>(&value);
 188                 *lhsptr = ptr.get();
 189                 return *this;
 190         }
 191
 192         TLispValue& operator=(FixnumT fn)
 193         {
 194                 value = fn;
 195                 return *this;
 196         }
 197
 198         TLispValue& set(FloatnumT fn)
 199         {
 200                 (*static_cast<FloatnumT*>(&value))  = fn;
 201                 return *this;
 202         }
 203
 204         TLispValue& operator=(CharT ch)
 205         {
 206                 (*static_cast<CharT*>(&value))  = ch;
 207                 return *this;
 208         }
 209
 210         TLispValue& operator=(PrimT prim)
 211         {
 212                 (*static_cast<PrimT*>(&value))  = prim;
 213                 return *this;
 214         }
 215
 216 };
 217
 218
 219
 220
 221 // tag types (this doesn't have to be POD, but its advisable)
 222 template <typename T> class Tag
 223 {
 224         T tagValue;
 225
 226         void setType(eObjectType tag)
 227         {
 228                 tagValue = static_cast<eObjectType>(tagValue);
 229         }
 230
 231         eObjectType getType()
 232         {
 233                 static_cast<eObjectType>(tagValue);
 234         }
 235 };
 236
 237 typedef Tag<u8> LispTag;
 238 typedef TLispValue<u128, CharType, FixnumType, FloatnumType, PrimitiveType, PointerType, LispObj*> LispValue;
 239
 240
 241 // TO DO -- template template parameters?
 242
 243 struct LispObj {
 244         TaggedObjData<Tag<unsigned char>, LispValue, std::vector>  object;
 245 };
 246
 247
 248
 249
 250
 251
 252 } // end namespace lisp
 253
 254
 255 #endif
 256
 257