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
  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 <typename D>
  63         operator ObjPtr<D>()
  64         {
  65                 return ObjPtr<D>(p_);
  66         }
  67
  68 private:
  69         explicit ObjPtr( void* o ) : p_(static_cast<T*>(o)) {};
  70
  71         T* get() const
  72         {
  73                 return p_;
  74         }
  75
  76         void set(const void *p)
  77         {
  78                 p_ = reinterpret_cast<T*>(p);
  79         }
  80
  81         T* p_;
  82
  83         template <typename ActualT, typename CharT, typename FixnumT, typename FloatnumT, typename PrimType, typename PtrType>
  84         friend class TLispValue;
  85 };
  86
  87 // this is what we use to point at a lisp object
  88 typedef ObjPtr<LispObj> PointerType;
  89
  90
  91 // straight primitive call with no environment / args
  92 template <typename ArgPointer, template <typename> class ArgContainer>
  93 class PrimitiveT
  94 {
  95 public:
  96     // err..what does a smart pointer to a pointer look like?
  97         typedef PointerType (*PrimitivePtr)(ArgContainer<ArgPointer>& args);
  98
  99         explicit PrimitiveT(PrimitivePtr f) : fn_(f) {}
 100         PointerType operator()(ArgContainer<ArgPointer>& p)
 101         {
 102                 return fn_(p);
 103         }
 104  private:
 105         PrimitivePtr fn_;
 106 };
 107
 108 typedef PrimitiveT< ObjPtr<LispObj>, std::vector > PrimitiveType;
 109
 110
 111
 112 // Primitive unboxed values (this must be POD)
 113 template <typename ActualT, typename CharT, typename FixnumT, typename FloatnumT, typename PrimT, typename PtrT> class TLispValue
 114 {
 115 public:
 116         ActualT value;
 117
 118         TLispValue()
 119         {
 120         }
 121
 122         // need to be ablue to convert between ActualType and these types
 123         operator PtrT() const
 124         {
 125                 // convert it to a void * and construct a PtrT() around it
 126                 return PtrT(reinterpret_cast<void*>(value));
 127         }
 128
 129
 130         // we can't overload by return type, so we use value conversion instead
 131         operator FixnumT() const
 132         {
 133                 return value;
 134         };
 135
 136         operator FloatnumT() const
 137         {
 138                 return *(static_cast<FloatnumT*>(&value));
 139         }
 140
 141         operator CharT() const
 142         {
 143                 return *(static_cast<CharT*>(&value));
 144         };
 145
 146         operator PrimT() const
 147         {
 148                 return *(static_cast<PrimT*>(&value));
 149         }
 150
 151         TLispValue(const PtrT& ptr)
 152         {
 153                 value = reinterpret_cast<ActualT>(reinterpret_cast<void*>(ptr.get()));
 154         }
 155
 156         TLispValue& operator=(const PtrT& ptr)
 157         {
 158                 value = reinterpret_cast<ActualT>(reinterpret_cast<void*>(ptr.get()));
 159                 return *this;
 160         }
 161
 162         TLispValue(const FixnumT& fn)
 163         {
 164                 value = fn;
 165         }
 166
 167         TLispValue& operator=(const FixnumT& fn)
 168         {
 169                 value = fn;
 170                 return *this;
 171         }
 172
 173         TLispValue(const FloatnumT& fn)
 174         {
 175                 (*static_cast<FloatnumT*>(&value))  = fn;
 176         }
 177
 178         TLispValue& set(const FloatnumT& fn)
 179         {
 180                 (*static_cast<FloatnumT*>(&value))  = fn;
 181                 return *this;
 182         }
 183
 184         TLispValue(const CharT& ch)
 185         {
 186                 (*static_cast<FloatnumT*>(&value))  = ch;
 187         }
 188
 189         TLispValue& operator=(const CharT& ch)
 190         {
 191                 (*static_cast<CharT*>(&value))  = ch;
 192                 return *this;
 193         }
 194
 195         TLispValue(const PrimT& prim)
 196         {
 197                 (*static_cast<FloatnumT*>(&value))  = prim;
 198         }
 199
 200         TLispValue& operator=(const PrimT& prim)
 201         {
 202                 (*static_cast<PrimT*>(&value))  = prim;
 203                 return *this;
 204         }
 205
 206 };
 207
 208
 209 // tag types (this doesn't have to be POD, but its advisable)
 210 template <typename T> class Tag
 211 {
 212 private:
 213         T tagValue;
 214
 215 public:
 216         void setType(eObjectType tag)
 217         {
 218                 tagValue = static_cast<eObjectType>(tagValue);
 219         }
 220
 221         eObjectType getType()
 222         {
 223                 static_cast<eObjectType>(tagValue);
 224         }
 225 };
 226
 227 typedef Tag<u8> LispTag;
 228 typedef TLispValue<u128, CharType, FixnumType, FloatnumType, PrimitiveType, PointerType> LispValue;
 229
 230
 231 // container of object data with a tag
 232 template <typename T, typename D, template <typename> class C>
 233 class TaggedObjData
 234 {
 235 public:
 236
 237         typedef T TagType;
 238         typedef D ValueType;
 239         typedef C<D> ValueContainerType;
 240
 241         T tag;
 242         ValueContainerType values;
 243
 244         // T needs to implement sthing which will transform a tag to a
 245         // object type
 246         eObjectType getType()
 247         {
 248                 return tag.getType(tag);
 249         }
 250
 251         void setType(eObjectType type)
 252         {
 253                 return tag.setType(type);
 254         }
 255
 256         // container must have capacity
 257         void resize(std::size_t s)
 258         {
 259                 values.reserve(s);
 260                 values.resize(s);
 261         }
 262
 263         // must be able to tell what that capacity is
 264         std::size_t size() const
 265         {
 266                 return values.size();
 267         }
 268
 269 };
 270
 271 // TO DO -- template template parameters?
 272
 273 struct LispObj {
 274         TaggedObjData<Tag<unsigned char>, LispValue, std::vector>  object;
 275 };
 276
 277
 278
 279
 280
 281
 282 } // end namespace lisp
 283
 284
 285 #endif
 286
 287