Changeset 1772

Timestamp:

Jun 9, 2005, 7:13:32 AM (16 years ago)

Author:

orlov

Message:

• A lot of runtime changes towards interfaces simplification.

Location:

to-imperative/trunk/runtime

Files:

• Makefile (modified) (2 diffs)
• file_list (modified) (2 diffs)
• rf_arg.hh (modified) (1 diff)
• rf_box.cc (deleted)
• rf_box.hh (modified) (1 diff)
• rf_box.ih (deleted)
• rf_char.cc (modified) (3 diffs)
• rf_common.cc (modified) (1 diff)
• rf_common.hh (modified) (1 diff)
• rf_core.cc (modified) (4 diffs)
• rf_core.hh (modified) (3 diffs)
• rf_expr.hh (modified) (1 diff)
• rf_expr.ih (modified) (9 diffs)
• rf_integer.cc (modified) (2 diffs)
• rf_macros.cc (modified) (1 diff)
• rf_macros.hh (modified) (1 diff)
• rf_object_ref.cc (modified) (2 diffs)
• rf_parenth.cc (deleted)
• rf_parenth.hh (modified) (2 diffs)
• rf_parenth.ih (deleted)
• rf_result.hh (modified) (1 diff)
• rf_retval.cc (modified) (1 diff)
• rf_retval.hh (modified) (2 diffs)
• rf_retval.ih (added)
• rf_short_int.cc (modified) (2 diffs)
• rf_stack.cc (modified) (1 diff)
• rf_stack.hh (modified) (3 diffs)
• rf_stack.ih (added)
• rf_symbol.hh (modified) (2 diffs)
• rf_symbol.ih (modified) (3 diffs)
• rf_term.hh (modified) (1 diff)
• rf_term.ih (modified) (6 diffs)
• rf_types.hh (modified) (3 diffs)
• rf_types.ih (modified) (1 diff)
• rf_word.cc (modified) (2 diffs)

to-imperative/trunk/runtime/Makefile

@@ -16 +16 @@
   rf_memory_chunk \
   rf_types \
-  rf_parenth \
   rf_char \
   rf_word \
@@ -25 +24 @@
   rf_static_object \
   rf_object_ref \
-  rf_box \
   rf_vector \
   rf_string \

to-imperative/trunk/runtime/file_list

@@ -11 +11 @@
 rf_memory_chunk
 rf_types
-rf_parenth
 rf_char
 rf_word
@@ -20 +19 @@
 rf_static_object
 rf_object_ref
-rf_box
 rf_vector
 rf_string

to-imperative/trunk/runtime/rf_arg.hh

@@ -25 +25 @@
 
 #include "rf_expr.ih"
-#include "rf_stack.hh"
+#include "rf_stack.ih"
 
 namespace rfrt

to-imperative/trunk/runtime/rf_box.hh

@@ -2 +2 @@
 #define __rf_box_hh__
 
-#include "rf_types.hh"
-#include "rf_object.hh"
-#include "rf_expr.hh"
+#include "rf_symbol.ih"
+#include "rf_expr.ih"
 
 namespace rftype
 {
 
-using namespace rfrt ;
+class BoxContents : public Expr
+{
+  public:
 
-class Box :
-  public Object
-{
+    BoxContents () : Expr()
+    {}
+    
+    BoxContents (Expr const& _e) : Expr(_e)
+    {}
+    
+    Expr& operator = (Expr const& _e)
+    {
+      return Expr::operator=(_e);
+    };
+};
 
-private:
+RF_NEW_SYMBOL(BoxContents, ObjectTerm);
+RF_NEW_SYMBOL(NamedObject<BoxContents>, ObjectTerm);
 
-  Expr content ;
-
-  static ObjectRegister reg ;
-
-  NO_COPY_CTOR(Box)
-
-public:
-
-  inline Box () ;
-  inline Box (Expr const& _expr) ;
-  inline Box& operator = (Box const& _box) ;
-
-  inline unsigned get_type () const ;
-  inline uint32_t hash () const ;
-
-  inline void put (Expr const& _expr) ;
-  inline Expr get () const ;
-
-  inline pxx::WString to_string () const ;
-
-};
+inline pxx::WString RF_SYMBOL(BoxContents)::to_string (RF_SYMBOL(BoxContents) const* _s)
+{ 
+  size_t max_len = hex_ptr_len + 10;
+  wchar_t* str = static_cast<wchar_t*>(alloca(max_len * sizeof(wchar_t)));
+  Expr* ptr = _s->get_obj_ptr();
+  int len = swprintf(str, max_len, L"<Box|%p|", ptr);
+  if (-1 == len)
+    FATAL("<Box|%p| is more then %u wide characters", ptr, max_len);
+  return pxx::WString(str, len) + pxx::WString(*ptr) + pxx::WString(L">");
+}
 
 }

to-imperative/trunk/runtime/rf_char.cc

@@ -65 +65 @@
   {
     if (p->is_ref())
-      e = e + lp + to_chars(static_cast<Parenth*>(p)->get_expr()) + rp;
+      e = e + lp + to_chars(*p->get_obj_ptr<Expr>()) + rp;
     else
       e = e + Char::create_expr(WString(*p));
@@ -140 +140 @@
 
 short_type_funcs_t Char::funcs = {
+  0,
   null, // Char::ctor,
   null, // Char::dtor,
@@ -145 +146 @@
   null, // (int (*)(Term const*, Term const*))(Char::compare),
   null, // (uint32_t (*)(Term const*))(Char::hash),
-  (pxx::WString (*)(Term const*))(Char::to_string)
+  (pxx::WString (*)(Term const*))(Char::to_string),
+  null
 };
 

to-imperative/trunk/runtime/rf_common.cc

@@ -30 +30 @@
 void* stack_start = (void*)0;
 uintptr_t stack_size = default_stack_size ;
+bool init_done = false;
 bool use_rts = true;
 bool trap_stack_on = false;

to-imperative/trunk/runtime/rf_common.hh

@@ -27 +27 @@
 extern uintptr_t stack_size ;
 extern void* stack_start ;
+extern bool init_done ;
 extern bool use_rts ;
 extern bool trap_stack_on ;

to-imperative/trunk/runtime/rf_core.cc

@@ -186 +186 @@
 using namespace rfrt;
 
-TypeRegister rftype::Parenth::reg(&Parenth::funcs, type_parenth) ;
+RF_REGISTER_SYMBOL(Expr);
+//TypeRegister rftype::Parenth::reg(&Parenth::funcs, type_parenth) ;
 TypeRegister rftype::ObjectRef::reg(&ObjectRef::funcs, type_object) ;
 TypeRegister rftype::Char::reg(&Char::funcs, type_char) ;
@@ -197 +198 @@
 #endif // !defined RFRT_WITHOUT_GMP
 
-ObjectRegister rftype::Box::reg(type_box) ;
 ObjectRegister rftype::Vector::reg(type_vector) ;
 ObjectRegister rftype::Channel::reg(type_channel) ;
@@ -203 +203 @@
 ObjectRegister rftype::Table::reg(type_table) ;
 ObjectRegister rftype::Func::reg(type_func) ;
+
+RF_REGISTER_SYMBOL(BoxContents);
+RF_REGISTER_SYMBOL_VARIANT(NamedObject<BoxContents>, BoxContents);
 
 int main (int _argc, char* _argv[])
@@ -246 +249 @@
   }
   if (init_StdIn) init_StdIn();
+  init_done = true;
+  D( printf("=== Init is done! ===\n"); )
   Expr res;
   try {

to-imperative/trunk/runtime/rf_core.hh

@@ -27 +27 @@
 #include "rf_term.ih"
 #include "rf_expr.ih"
-#include "rf_stack.hh"
+#include "rf_stack.ih"
 #include "rf_arg.hh"
 #include "rf_result.hh"
-#include "rf_retval.hh"
+#include "rf_retval.ih"
 #include "rf_macros.hh"
 #include "rf_memory_chunk.hh"
@@ -38 +38 @@
 #include "rf_integer.ih"
 #include "rf_word.ih"
-#include "rf_box.ih"
 #include "rf_vector.ih"
 #include "rf_channel.ih"
@@ -46 +45 @@
 #include "rf_static_object.ih"
 #include "rf_symbol.ih"
+#include "rf_box.hh"
 
 #include "pxx_heap_allocator.ih"

to-imperative/trunk/runtime/rf_expr.hh

@@ -237 +237 @@
   template <class ObjClass, class CppType1, class CppType2>
   static inline Expr create_sym (const CppType1& _arg1, const CppType2& _arg2) ;
+  
+  template <class ObjClass>
+  static inline Expr create_static_sym (wchar_t const* _name) ;
 
 private:

to-imperative/trunk/runtime/rf_expr.ih

@@ -14 +14 @@
 #include "rf_expr.hh"
 #include "rf_term.ih"
-#include "rf_parenth.ih"
+#include "rf_parenth.hh"
 #include "rf_object_ref.ih"
+#include "rf_static_object.ih"
 #include "rf_integer.ih"
 #include "rf_short_int.ih"
@@ -111 +112 @@
   // If we really have a reference term...
   if (_cp->is_ref()) {
-    const Parenth* p = static_cast<const Parenth*>(_cp);
-    new(this) Expr(p->get_expr());
+//    const Parenth* p = static_cast<const Parenth*>(_cp);
+    new(this) Expr(*_cp->get_obj_ptr<Expr>());
   }
   //
@@ -162 +163 @@
 inline Expr& Expr::operator = (Expr const& _expr)
 {
-  D(printf("%p(%p,%p,%p) = %p(%p,%p,%p), ",
+  D(printf("%p(%p,%p,%p) = %p(%p,%p,%p)",
            this, first, last, mem_chunk,
            &_expr, _expr.first, _expr.last, _expr.mem_chunk);
-    _expr.writeln(stdout);
-   )
+    if (init_done) {
+      printf(", ");
+      _expr.writeln(stdout);
+    }
+    else
+      printf("\n");
+  )
   //
   // If we are not assigning to self
@@ -185 +191 @@
 {
 //  return Expr(Term(self));
-  Expr res(1, 0);
-  new(res.first) Parenth(self);
-  return res;
+//  Expr res(1, 0);
+//  new(res.first) Parenth(self);
+//  return res;
+  return create_sym<Expr>(self);
 }
 
@@ -497 +504 @@
 {
   Expr e(1);
-  new (e.first) Symbol<ObjClass, typename SymbolType<ObjClass>::type>();
-  e.set_flat_bit<typename SymbolType<ObjClass>::type>();
+  new (e.first) Symbol<ObjClass, typename SymbolType<ObjClass>::Type>();
+  e.set_flat_bit<typename SymbolType<ObjClass>::Type>();
   return e;
 }
+
+template <class ObjClass>
+inline Expr Expr::create_static_sym (wchar_t const* _name)
+{
+  Expr e(1);
+  new (e.first) Symbol<NamedObject<ObjClass>, ObjectTerm>(_name);
+  e.set_flat_bit<ObjectTerm>();
+  return e;
+}
+
 
 template <class ObjClass, class CppType1>
@@ -506 +523 @@
 {
   Expr e(1);
-  new (e.first) Symbol<ObjClass, typename SymbolType<ObjClass>::type>(_arg1);
-  e.set_flat_bit<typename SymbolType<ObjClass>::type>();
+  new (e.first) Symbol<ObjClass, typename SymbolType<ObjClass>::Type>(_arg1);
+  e.set_flat_bit<typename SymbolType<ObjClass>::Type>();
   return e;
 }
@@ -516 +533 @@
   Expr e(1);
   new (e.first)
-    Symbol<ObjClass, typename SymbolType<ObjClass>::type>(_arg1, _arg2);
-  e.set_flat_bit<typename SymbolType<ObjClass>::type>();
+    Symbol<ObjClass, typename SymbolType<ObjClass>::Type>(_arg1, _arg2);
+  e.set_flat_bit<typename SymbolType<ObjClass>::Type>();
   return e;
 }
@@ -928 +945 @@
       }
       if (p != first) fputc(' ', _fp);
-      if (p->get_type() == type_parenth) {
+      if (p->is_ref()) {
         if (fputc('(', _fp) == EOF) return false;
         Expr e(p);
@@ -992 +1009 @@
     if (p->is_sym()) {
       res = res + (WString)(*p);
-    } else if (p->is_ref()) {
+    }
+    else {
       res = res + WString(L"(") + (WString)(Expr(p)) + WString(L")");
-    } else {
-      FATAL("Not supported yet");
     }
   }

to-imperative/trunk/runtime/rf_integer.cc

@@ -52 +52 @@
 
 short_type_funcs_t Integer::funcs = {
+  0,
   (void (*)(Term*, Term const*))(Integer::ctor),
   (void (*)(Term*))(Integer::dtor),
@@ -57 +58 @@
   (int (*)(Term const*, Term const*))(Integer::compare),
   (uint32_t (*)(Term const*))(Integer::hash),
-  (pxx::WString (*)(Term const*))(Integer::to_string)
+  (pxx::WString (*)(Term const*))(Integer::to_string),
+  null
 };
 

to-imperative/trunk/runtime/rf_macros.cc

@@ -1 @@
-#include "rf_retval.hh"
-#include "rf_expr.hh"
 #include "rf_macros.hh"
-#include "rf_func.ih"
 
 namespace rfrt

to-imperative/trunk/runtime/rf_macros.hh

@@ -275 +275 @@
 #endif
 
-#define RF_NEW_SYMBOL(t, c) \
+#define RF_NEW_SYMBOL(CppType, TermClass) \
   template<> \
-  struct SymbolType<t> \
+  struct SymbolType< CppType > \
   { \
     /*enum { type = c };*/ \
-    typedef c type; \
+    typedef TermClass Type; \
   };
 
-#define RF_SYMBOL(t) Symbol<t, SymbolType<t>::type>
+#define RF_SYMBOL(CppType) Symbol<CppType, SymbolType< CppType >::Type>
+
+#define RF_REGISTER_SYMBOL(CppType) \
+  template <> \
+  const TypeRegister RF_SYMBOL(CppType)::reg(&RF_SYMBOL(CppType)::funcs)
+
+#define RF_REGISTER_SYMBOL_VARIANT(CppType, InstCppType) \
+  template <> \
+  const TypeRegister RF_SYMBOL(CppType)::reg( \
+      RF_SYMBOL(InstCppType)::get_type(), \
+      &RF_SYMBOL(CppType)::funcs \
+  )
 
 }

to-imperative/trunk/runtime/rf_object_ref.cc

@@ -30 +30 @@
 
 short_type_funcs_t ObjectRef::funcs = {
+  0,
   (void (*)(Term*, Term const*))(ObjectRef::ctor),
   (void (*)(Term*))(ObjectRef::dtor),
@@ -35 +36 @@
   null, // (int (*)(Term const*, Term const*))(ObjectRef::compare), FIXME:
   null, // (uint32_t (*)(Term const*))(ObjectRef::hash), FIXME:
-  (pxx::WString (*)(Term const*))(ObjectRef::to_string)
+  (pxx::WString (*)(Term const*))(ObjectRef::to_string),
+  null
 };
 

to-imperative/trunk/runtime/rf_parenth.hh

@@ -2 +2 @@
 #define __rf_parenth_hh__
 
-#include "rf_types.hh"
+#include "rf_symbol.ih"
 #include "rf_expr.hh"
 
@@ -10 +10 @@
 using namespace rfrt ;
 
-class Parenth :
-  public Term
+RF_NEW_SYMBOL(Expr, ObjectTerm);
+
+inline bool RF_SYMBOL(Expr)::eq (
+    RF_SYMBOL(Expr) const* _s1, RF_SYMBOL(Expr) const* _s2
+)
 {
+  return (*_s1->get_obj_ptr()) == (*_s2->get_obj_ptr());
+}
 
-  struct Content
-  {
-    uintptr_t ref_count;
-    Expr expr;
-  };
+inline int RF_SYMBOL(Expr)::compare (
+    RF_SYMBOL(Expr) const* _s1, RF_SYMBOL(Expr) const* _s2
+)
+{
+  return Expr::compare(*_s1->get_obj_ptr(), *_s2->get_obj_ptr());
+}
 
-  NO_COPY_CTOR(Parenth)
-  NO_ASSIGN(Parenth)
-
-public:
-
-  inline Parenth (const Expr& _expr) ;
-
-  inline ~Parenth () ;
-
-  inline const Expr& get_expr () const ;
-
-  static void ctor (Parenth* _to, Parenth const* _from) ;
-  static void dtor (Parenth* _parenth) ;
-  static bool eq (Parenth const* _parenth1, Parenth const* _parenth2) ;
-  static int compare (Parenth const* _parenth1, Parenth const* _parenth2) ;
-  static uint32_t hash (Parenth const* _parenth) ;
-  static pxx::WString to_string (Parenth const* _parenth) ;
-  static short_type_funcs_t funcs ;
-  static TypeRegister reg ;
-  
-};
-
-
+inline pxx::WString RF_SYMBOL(Expr)::to_string (RF_SYMBOL(Expr) const* _s)
+{
+  return pxx::WString(L"(")
+       + pxx::WString(*_s->get_obj_ptr())
+       + pxx::WString(L")");
+}
 
 }

to-imperative/trunk/runtime/rf_result.hh

@@ -25 +25 @@
 
 #include "rf_stack.hh"
+#include "rf_expr.ih"
 
 namespace rfrt

to-imperative/trunk/runtime/rf_retval.cc

@@ -1 @@
-#include "rf_retval.hh"
+#include "rf_retval.ih"
 
 //

to-imperative/trunk/runtime/rf_retval.hh

@@ -25 +25 @@
 
 #include "rf_expr.hh"
-#include "rf_stack.hh"
 
 namespace rftype {
@@ -50 +49 @@
   {}
 
-  inline RetVal (bool _b = true)
-  {
-    if (_b)
-      data = 0;
-    else {
-      data = 1;
-      stack->destroy_results();
-    }
-  }
+  inline RetVal (bool _b = true) ;
 
-  inline RetVal (Expr* _saved_top) :
-    data (1)
-  {
-    stack->destroy_results(_saved_top, stack->get_depth() - 1);
-  }
+  inline RetVal (Expr* _saved_top) ;
 
   inline ~RetVal ()
   {}
 
-  inline operator bool () const
-  {
-    return (data & uintptr_t(0x01)) == 0;
-  }
+  inline operator bool () const ;
 
-  inline bool is_tail () const
-  {
-    return data > 1;
-  }
+  inline bool is_tail () const ;
 
-  inline rftype::Func* get_ptr () const
-  {
-//    return (rf_func_t)(data & ~(uintptr_t(0x01)));
-    return reinterpret_cast<rftype::Func*>(data);
-  }
+  inline rftype::Func* get_ptr () const ;
 
 };

to-imperative/trunk/runtime/rf_short_int.cc

@@ -122 +122 @@
 
 short_type_funcs_t Int32::funcs = {
+  0,
   null, // (void (*)(Term*, Term const*))(Int32::ctor),
   null, // ShortInt::dtor,
@@ -127 +128 @@
   (int (*)(Term const*, Term const*))(Int32::compare),
   (uint32_t (*)(Term const*))(Int32::hash),
-  (pxx::WString (*)(Term const*))(Int32::to_string)
+  (pxx::WString (*)(Term const*))(Int32::to_string),
+  null
 };
 

to-imperative/trunk/runtime/rf_stack.cc

@@ -21 +21 @@
 // Author: Andrey Slepuhin <pooh@msu.ru>
 
-#include "rf_stack.hh"
+#include "rf_stack.ih"
 
 namespace rfrt

to-imperative/trunk/runtime/rf_stack.hh

@@ -19 +19 @@
 // $Revision$
 // $Date$
-// Author: Andrey Slepuhin <pooh@msu.ru>
 
 #ifndef __rf_stack_hh__
 #define __rf_stack_hh__
 
-#include "rf_expr.ih"
-#include "rf_integer.ih"
+#include "rf_expr.hh"
 #include "pxx_heap.ih"
 
@@ -64 +62 @@
   {}
 
-  inline void push (Expr const& _expr)
-  {
-    if (top > last) FATAL("Stack exhausted");
-    new (top++) Expr(_expr);
-  }
+  inline void push (Expr const& _expr) ;
 
   inline void pop ()
   {}
   
-  inline void pop (Expr& _expr)
-  {
-    _expr.~Expr();
-    new (&_expr) Expr(top++);
-  }
+  inline void pop (Expr& _expr) ;
 
-  inline void pop (Result& _res);
+  inline void pop (Result& _res) ;
 
-  inline Expr const* get ()
-  {
-    return top++;
-  }
+  inline Expr const* get () ;
 
-  inline Expr* get_top ()
-  {
-    args_num = -1;
-    return top;
-  }
+  inline Expr* get_top () ;
 
-  inline void set_top (Expr* _top)
-  {
-    top = _top;
-  }
+  inline void set_top (Expr* _top) ;
 
-  inline void destroy_results (Expr* _saved_top, size_t _saved_depth)
-  {
-    while (top > _saved_top) {
-      top--;
-      D( printf("destroy_results: %p(%p,%p,%p)\n",
-            top, top->get_first(), top->get_last(), top->get_mem_chunk()); )
-      top->~Expr();
-    }
-    depth = _saved_depth;
-  }
+  inline void destroy_results (Expr* _saved_top, size_t _saved_depth) ;
 
-  inline void destroy_results ()
-  {
-    top--;
-    Expr* ress = top  - *(reinterpret_cast<uintptr_t*>(top));
-    Expr* args = ress - *(reinterpret_cast<uintptr_t*>(top) + 1);
-    while (top > ress)
-      (--top)->~Expr();
-    top = args;
-    dec_depth();
-  }
+  inline void destroy_results () ;
 
-  inline void cleanup (size_t _saved_depth)
-  {
-    if (trap_stack_on) trap_stack = get_part(0, depth - _saved_depth);
-    while (depth > _saved_depth) {
-      destroy_results();
-    }
-  }
+  inline void cleanup (size_t _saved_depth) ;
 
-  inline void start_push_mode ()
-  {
-    args_num = -1;
-    saved_top = top;
-  }
+  inline void start_push_mode () ;
 
-  inline void stop_push_mode ()
-  {
-    args_num = top - saved_top;
-    top = saved_top;
-  };
+  inline void stop_push_mode () ;
 
-  inline void start_ress_mode ()
-  {
-    saved_top = top;
-  }
+  inline void start_ress_mode () ;
 
-  inline void stop_ress_mode (rftype::Object const* _f)
-  {
-    if (top > last) FATAL("Stack exhausted");
-    uintptr_t* p = reinterpret_cast<uintptr_t*>(top);
-    *p++ = top - saved_top;
-    *p++ = args_num;
-    *p = reinterpret_cast<uintptr_t>(_f);
-    top++;
-    inc_depth();
-  }
+  inline void stop_ress_mode (rftype::Object const* _f) ;
 
-  inline void start_pop_mode ()
-  {
-    top--;
-    top -= *reinterpret_cast<uintptr_t*>(top);
-  }
+  inline void start_pop_mode () ;
 
-  inline void start_pop_mode (Expr* const __rf_call_saved_top)
-  {
-    top = __rf_call_saved_top;
-    args_num = 0;
-  }
+  inline void start_pop_mode (Expr* const __rf_call_saved_top) ;
 
-  inline void stop_pop_mode ()
-  {
-    uintptr_t* p = reinterpret_cast<uintptr_t*>(top);
-    top -= *p + *(p + 1);
-    dec_depth();
-  }
+  inline void stop_pop_mode () ;
 
-  inline bool is_in_push_mode () const
-  {
-    return args_num == -1;
-  }
+  inline bool is_in_push_mode () const ;
 
-  inline Expr* get_upper (size_t _offset) const
-  {
-    Expr* node = top;
-    while (_offset--)
-    {
-      node--;
-      uintptr_t* p = reinterpret_cast<uintptr_t*>(node);
-      node -= *p + *(p + 1);
-    }
-    return node;
-  }
+  inline Expr* get_upper (size_t _offset) const ;
 
-  inline void up ()
-  {
-    top = get_upper(1);
-    dec_depth();
-  }
+  inline void up () ;
 
-  inline void inc_depth ()
-  {
-    depth++;
-  }
+  inline void inc_depth () ;
 
-  inline void dec_depth ()
-  {
-    depth--;
-  }
+  inline void dec_depth () ;
 
-  inline size_t get_depth () const
-  {
-    return depth;
-  }
+  inline size_t get_depth () const ;
 
-  inline rftype::Object* get_func (size_t _depth) const
-  {
-    uintptr_t* p = reinterpret_cast<uintptr_t*>(get_upper(depth - _depth) - 1);
-    return reinterpret_cast<rftype::Object*>(*(p + 2));
-  }
+  inline rftype::Object* get_func (size_t _depth) const ;
 
-  inline int get_args (size_t _depth, Expr** _args) const
-  {
-    uintptr_t* p = reinterpret_cast<uintptr_t*>(get_upper(depth - _depth) - 1);
-    *_args = reinterpret_cast<Expr*>(p) - *p - *(p + 1);
-    return *(p + 1);
-  }
+  inline int get_args (size_t _depth, Expr** _args) const ;
 
-  inline static rftype::Object* getf (Expr const* _p)
-  {
-    return reinterpret_cast<rftype::Object*>(
-        *(reinterpret_cast<uintptr_t const*>(_p) + 2));
-  }
+  inline static rftype::Object* getf (Expr const* _p) ;
 
-  inline static int getn (Expr const* _p)
-  {
-    return *(reinterpret_cast<uintptr_t const*>(_p) + 1);
-  }
+  inline static int getn (Expr const* _p) ;
 
-  inline static Expr const* geta (Expr const* _p)
-  {
-    return _p - *reinterpret_cast<uintptr_t const*>(_p)
-              - *(reinterpret_cast<uintptr_t const*>(_p) + 1);
-  }
+  inline static Expr const* geta (Expr const* _p) ;
 
-  inline static Expr const* getup (Expr const* _p)
-  {
-    return geta(_p) - 1;
-  }
+  inline static Expr const* getup (Expr const* _p) ;
 
-  inline Expr get_part (size_t _offset, size_t _len) const
-  {
-    size_t depth = get_depth() - _offset;
-    if (!_len) _len = depth;
-    Expr const* p = get_upper(_offset) - 1;
-    Expr e;
-    while (_len--)
-    {
-      Expr s_f(getf(p));
-      int  n   = getn(p);
-      Expr const* ap = geta(p);
-      Expr e_args;
-      while (n--) e_args = e_args + (*ap++)();
-      e = e + (Expr::create<Integer>(depth--) + s_f + e_args)();
-      p = getup(p);
-    }
-    return e;
-  }
+  inline Expr get_part (size_t _offset, size_t _len) const ;
 
 };
@@ -270 +127 @@
 extern Stack* stack ;
 
-inline Expr const& Expr::operator , (Expr const& _expr) const
-{
-  stack->push(*this);
-  return _expr;
-}
-
-inline Expr const& Expr::operator , (Expr const& _expr)
-{
-  stack->push(*this);
-  return _expr;
-}
-
-inline Expr& Expr::operator , (Expr& _expr)
-{
-  if (stack->is_in_push_mode())
-    stack->push(*this);
-  else
-    stack->pop(*this);
-  return _expr;
-}
-
-inline Result& Expr::operator , (Result& _res)
-{
-  stack->pop(*this);
-  return _res;
-}
-
 }
 

to-imperative/trunk/runtime/rf_symbol.hh

@@ -85 +85 @@
 
   static short_type_funcs_t funcs ;
+
   static const TypeRegister reg ;
 
@@ -94 +95 @@
 struct SymbolType;
 
+template<class C>
+class NamedObject :
+  public C
+{
+public:
+  pxx::WString name;
+  inline NamedObject (wchar_t const* _name) : C(), name(_name) {};
+};
+
+template<class C>
+class Symbol<NamedObject<C>, ObjectTerm> :
+  public Term
+{
+
+  struct Wrapper
+  {
+    size_t ref_count;
+    NamedObject<C> object;
+  };
+
+  NO_COPY_CTOR(Symbol)
+  NO_ASSIGN(Symbol)
+
+public:
+
+  inline Symbol () ;
+
+  template<typename CppType1>
+  inline Symbol (CppType1 _arg1) ;
+
+  template<typename CppType1, typename CppType2>
+  inline Symbol (CppType1 _arg1, CppType2 _arg2) ;
+
+  inline NamedObject<C>* get_obj_ptr () const ;
+
+  static void ctor (Symbol* _to, Symbol const* _from) ;
+  static void dtor (Symbol* _term) ;
+  static bool eq (Symbol const* _term1, Symbol const* _term2) ;
+  static int compare (Symbol const* _term1, Symbol const* _term2) ;
+  static uint32_t hash (Symbol const* _term) ;
+  static pxx::WString to_string (Symbol const* _term) ;
+  static size_t get_name (Symbol const* _s, wchar_t const** _np) ;
+
+  static short_type_funcs_t funcs ;
+
+  static const TypeRegister reg ;
+
+  static inline unsigned get_type() ;
+
+};
+
 }
 

to-imperative/trunk/runtime/rf_symbol.ih

@@ -8 +8 @@
 
 #include "rf_symbol.hh"
+#include "rf_macros.hh"
 
 namespace rftype
@@ -86 +87 @@
     allocator->deallocate(w);
   }
+}
+
+template <class C>
+bool Symbol<C, ObjectTerm>::eq (
+    Symbol<C, ObjectTerm> const* _s1, Symbol<C, ObjectTerm> const* _s2
+)
+{
+  return _s1->get_obj_ptr() == _s2->get_obj_ptr();
+}
+
+template <class C>
+int Symbol<C, ObjectTerm>::compare (
+    Symbol<C, ObjectTerm> const* _s1, Symbol<C, ObjectTerm> const* _s2
+)
+{
+  if (_s1->get_obj_ptr() > _s2->get_obj_ptr()) return 1;
+  if (_s1->get_obj_ptr() < _s2->get_obj_ptr()) return -1;
+  return 0;
 }
 
@@ -104 +123 @@
 template <class C>
 short_type_funcs_t Symbol<C, ObjectTerm>::funcs = {
+  0,
   (void (*)(Term*, Term const*))   (Symbol<C, ObjectTerm>::ctor),
   (void (*)(Term*))                (Symbol<C, ObjectTerm>::dtor),
-  null, // (bool (*)(Term const*, Term const*))   (Symbol<C, ObjectTerm>::eq),
-  null, // (int  (*)(Term const*, Term const*))   (Symbol<C, ObjectTerm>::compare),
+  (bool (*)(Term const*, Term const*))   (Symbol<C, ObjectTerm>::eq),
+  (int  (*)(Term const*, Term const*))   (Symbol<C, ObjectTerm>::compare),
   null, // (uint32_t (*)(Term const*))            (Symbol<C, ObjectTerm>::hash),
-  (pxx::WString (*)(Term const*))  (Symbol<C, ObjectTerm>::to_string)
+  (pxx::WString (*)(Term const*))  (Symbol<C, ObjectTerm>::to_string),
+  null
 };
 
+
+template <class C>
+inline Symbol<NamedObject<C>, ObjectTerm>::Symbol () :
+  Term (reg.get_type())
+{
+  Wrapper* w = static_cast<Wrapper*>(allocator->allocate(sizeof(Wrapper)));
+  new (&(w->object)) NamedObject<C>();
+  w->ref_count = 1;
+  ptr_data2 = w;
+}
+
+template <class C>
+template <typename CppType1>
+inline Symbol<NamedObject<C>, ObjectTerm>::Symbol (CppType1 _arg1) :
+  Term (reg.get_type())
+{
+  Wrapper* w = static_cast<Wrapper*>(allocator->allocate(sizeof(Wrapper)));
+  new (&(w->object)) NamedObject<C>(_arg1);
+  w->ref_count = 1;
+  ptr_data2 = w;
+}
+
+template <class C>
+template <typename CppType1, typename CppType2>
+inline Symbol<NamedObject<C>, ObjectTerm>::Symbol (CppType1 _arg1, CppType2 _arg2) :
+  Term (reg.get_type())
+{
+  Wrapper* w = static_cast<Wrapper*>(allocator->allocate(sizeof(Wrapper)));
+  new (&(w->object)) NamedObject<C>(_arg1, _arg2);
+  w->ref_count = 1;
+  ptr_data2 = w;
+}
+
+template <class C>
+inline NamedObject<C>* Symbol<NamedObject<C>, ObjectTerm>::get_obj_ptr () const
+{
+  return &static_cast<Wrapper*>(ptr_data2)->object;
+}
+
+template <class C>
+void Symbol<NamedObject<C>, ObjectTerm>::dtor (Symbol<NamedObject<C>, ObjectTerm>* _s)
+{
+  Wrapper* w = static_cast<Wrapper*>(_s->ptr_data2);
+  if (--(w->ref_count) == 0) {
+    w->object.~NamedObject<C>();
+    allocator->deallocate(w);
+  }
+}
+
+template <class C>
+pxx::WString Symbol<NamedObject<C>, ObjectTerm>::to_string (
+    Symbol<NamedObject<C>, ObjectTerm> const* _s
+)
+{ 
+  NamedObject<C>* ptr = _s->get_obj_ptr();
+  return ptr->name;
+}
+
+template <class C>
+size_t Symbol<NamedObject<C>, ObjectTerm>::get_name (
+    Symbol<NamedObject<C>, ObjectTerm> const* _s, wchar_t const** _np
+)
+{ 
+  NamedObject<C>* ptr = _s->get_obj_ptr();
+  *_np = ptr->name.get_data();
+  return ptr->name.get_length();
+}
+
+template <class C>
+short_type_funcs_t Symbol<NamedObject<C>, ObjectTerm>::funcs = {
+  0,
+  (void (*)(Term*, Term const*))   (Symbol<C, ObjectTerm>::ctor),
+  (void (*)(Term*))                (Symbol<NamedObject<C>, ObjectTerm>::dtor),
+  (bool (*)(Term const*, Term const*))   (Symbol<C, ObjectTerm>::eq),
+  (int  (*)(Term const*, Term const*))   (Symbol<C, ObjectTerm>::compare),
+  null, // (uint32_t (*)(Term const*))            (Symbol<C, ObjectTerm>::hash),
+  (pxx::WString (*)(Term const*))  (Symbol<NamedObject<C>, ObjectTerm>::to_string),
+  (size_t (*)(Term const*, wchar_t const**)) (Symbol<NamedObject<C>, ObjectTerm>::get_name)
+};
+
+/*
 template <class C>
 const TypeRegister Symbol<C, ObjectTerm>::reg(&Symbol<C, ObjectTerm>::funcs);
+*/
 
 template <class C>

to-imperative/trunk/runtime/rf_term.hh

@@ -163 +163 @@
 
   inline operator pxx::WString () const ;
+  ///
+  /// If term has a name then make _np point to it and return its length.
+  /// Else return (size_t)-1.
+  inline size_t get_name (wchar_t const** _np) const ;
 
   static inline int compare (Term const& _t1, Term const& _t2) ;

to-imperative/trunk/runtime/rf_term.ih

@@ -15 +15 @@
 #include "rf_types.ih"
 #include "rf_expr.hh"
-#include "rf_symbol.ih"
+#include "rf_parenth.hh"
 #include "rf_object_ref.ih"
 #include "rf_word.ih"
@@ -76 +76 @@
 inline bool Term::is_sym () const
 {
-  return get_short_type() > type_parenth;
+//  return get_short_type() > type_parenth;
+  return !is_ref();
 }
 
 inline bool Term::is_ref () const
 {
-  return get_short_type() == type_parenth;
+//  return get_short_type() == type_parenth;
+  return is_instance_of<Expr>();
 }
 
@@ -102 +104 @@
 {
   unsigned type = get_short_type();
-  if (type != type_object) return type;
+  if (type != type_object) return short_type_funcs[type]->type;
   return static_cast<const ObjectRef*>(this)->get_obj_ptr()->get_type();
 }
@@ -185 +187 @@
 {
   return
-    static_cast<Symbol<C, typename SymbolType<C>::type> const*>(this)->
+    static_cast<Symbol<C, typename SymbolType<C>::Type> const*>(this)->
       get_obj_ptr();
 }
@@ -193 +195 @@
 {
   return
-    get_short_type() == Symbol<C, typename SymbolType<C>::type>::get_type();
+    short_type_funcs[get_short_type()]->type ==
+    Symbol<C, typename SymbolType<C>::Type>::get_type();
 }
 
@@ -210 +213 @@
 }
 
+inline size_t Term::get_name (wchar_t const** _np) const
+{
+  size_t (*fp)(Term const*, wchar_t const**) =
+    short_type_funcs[get_short_type()]->get_name;
+  if (fp) return (*fp)(this, _np);
+  return (size_t)-1;
+}
+
 inline int Term::compare (Term const& _t1, Term const& _t2)
 {
-  unsigned type1 = _t1.get_short_type();
-  unsigned type2 = _t2.get_short_type();
+  unsigned t1 = _t1.get_short_type();
+  unsigned t2 = _t2.get_short_type();
+  unsigned type1 = short_type_funcs[t1]->type;
+  unsigned type2 = short_type_funcs[t2]->type;
   if (type1 == type_parenth && type2 != type_parenth) return 1;
   if (type1 != type_parenth && type2 == type_parenth) return -1;
   if (type1 > type2) return 1;
   if (type1 < type2) return -1;
-  int (*cmp)(Term const*, Term const*) = short_type_funcs[type1]->compare;
+  int (*cmp)(Term const*, Term const*) = short_type_funcs[t1]->compare;
   if (cmp) return (*cmp)(&_t1, &_t2);
   if (_t1.uint_data2 > _t2.uint_data2) return 1;

to-imperative/trunk/runtime/rf_types.hh

@@ -39 +39 @@
 typedef struct
 {
+  unsigned type ;
   ///
   /// Copy constructor for short symbol
@@ -57 +58 @@
   /// Conversion to string.
   pxx::WString (*to_string)(Term const*) ;
+  ///
+  /// If the term has a name then set pointer to it and return its length.
+  /// Else return (size_t)-1.
+  size_t (*get_name)(Term const*, wchar_t const**) ;
 } short_type_funcs_t ;
 
@@ -66 +71 @@
 public:
   inline TypeRegister (short_type_funcs_t* _funcs, unsigned _typenum = 0) ;
+  inline TypeRegister (unsigned _type, short_type_funcs_t* _funcs) ;
   inline unsigned get_type () const ;
 };

to-imperative/trunk/runtime/rf_types.ih

@@ -15 +15 @@
   }
   short_type_funcs[_typenum] = _funcs;
+  short_type_funcs[_typenum]->type = _typenum;
   type = _typenum;
+}
+
+inline TypeRegister::TypeRegister (
+  unsigned _type, short_type_funcs_t* _funcs
+)
+{
+  type = current_short_type++;
+  short_type_funcs[type] = _funcs;
+  short_type_funcs[type]->type = _type;
 }
 

to-imperative/trunk/runtime/rf_word.cc

@@ -98 +98 @@
 
 short_type_funcs_t Word::funcs = {
+  0,
   (void (*)(Term*, Term const*))(Word::ctor),
   (void (*)(Term*))(Word::dtor),
@@ -103 +104 @@
   (int (*)(Term const*, Term const*))(Word::compare),
   (uint32_t (*)(Term const*))(Word::hash),
-  (pxx::WString (*)(Term const*))(Word::to_string)
+  (pxx::WString (*)(Term const*))(Word::to_string),
+  null
 };