klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

kpair.h (2915B)


      1 /*
      2 ** kpair.h
      3 ** Kernel Pairs
      4 ** See Copyright Notice in klisp.h
      5 */
      6 
      7 #ifndef kpair_h
      8 #define kpair_h
      9 
     10 #include "kobject.h"
     11 #include "kstate.h"
     12 #include "klimits.h"
     13 #include "kgc.h"
     14 
     15 /* can't be inlined... */
     16 bool kpairp(TValue obj);
     17 bool kimmutable_pairp(TValue obj);
     18 bool kmutable_pairp(TValue obj);
     19 
     20 static inline TValue kcar(TValue p)
     21 {
     22     klisp_assert(kpairp(p));
     23     return tv2pair(p)->car;
     24 }
     25 
     26 static inline TValue kcdr(TValue p)
     27 {
     28     klisp_assert(kpairp(p));
     29     return tv2pair(p)->cdr;
     30 }
     31 
     32 #define kcaar(p_) (kcar(kcar(p_)))
     33 #define kcadr(p_) (kcar(kcdr(p_)))
     34 #define kcdar(p_) (kcdr(kcar(p_)))
     35 #define kcddr(p_) (kcdr(kcdr(p_)))
     36 
     37 #define kcaaar(p_) (kcar(kcar(kcar(p_))))
     38 #define kcaadr(p_) (kcar(kcar(kcdr(p_))))
     39 #define kcadar(p_) (kcar(kcdr(kcar(p_))))
     40 #define kcaddr(p_) (kcar(kcdr(kcdr(p_))))
     41 #define kcdaar(p_) (kcdr(kcar(kcar(p_))))
     42 #define kcdadr(p_) (kcdr(kcar(kcdr(p_))))
     43 #define kcddar(p_) (kcdr(kcdr(kcar(p_))))
     44 #define kcdddr(p_) (kcdr(kcdr(kcdr(p_))))
     45 
     46 #define kcaaaar(p_) (kcar(kcar(kcar(kcar(p_)))))
     47 #define kcaaadr(p_) (kcar(kcar(kcar(kcdr(p_)))))
     48 #define kcaadar(p_) (kcar(kcar(kcdr(kcar(p_)))))
     49 #define kcaaddr(p_) (kcar(kcar(kcdr(kcdr(p_)))))
     50 #define kcadaar(p_) (kcar(kcdr(kcar(kcar(p_)))))
     51 #define kcadadr(p_) (kcar(kcdr(kcar(kcdr(p_)))))
     52 #define kcaddar(p_) (kcar(kcdr(kcdr(kcar(p_)))))
     53 #define kcadddr(p_) (kcar(kcdr(kcdr(kcdr(p_)))))
     54 
     55 #define kcdaaar(p_) (kcdr(kcar(kcar(kcar(p_)))))
     56 #define kcdaadr(p_) (kcdr(kcar(kcar(kcdr(p_)))))
     57 #define kcdadar(p_) (kcdr(kcar(kcdr(kcar(p_)))))
     58 #define kcdaddr(p_) (kcdr(kcar(kcdr(kcdr(p_)))))
     59 #define kcddaar(p_) (kcdr(kcdr(kcar(kcar(p_)))))
     60 #define kcddadr(p_) (kcdr(kcdr(kcar(kcdr(p_)))))
     61 #define kcdddar(p_) (kcdr(kcdr(kcdr(kcar(p_)))))
     62 #define kcddddr(p_) (kcdr(kcdr(kcdr(kcdr(p_)))))
     63 
     64 static inline void kset_car(TValue p, TValue v)
     65 {
     66     klisp_assert(kmutable_pairp(p));
     67     tv2pair(p)->car = v;
     68 }
     69 
     70 static inline void kset_cdr(TValue p, TValue v)
     71 {
     72     klisp_assert(kmutable_pairp(p));
     73     tv2pair(p)->cdr = v;
     74 }
     75 
     76 /* These two are the same but can write immutable pairs,
     77    use with care */
     78 static inline void kset_car_unsafe(klisp_State *K, TValue p, TValue v)
     79 {
     80     klisp_assert(kpairp(p));
     81     UNUSED(K);
     82 /*    klispC_barrier(K, gcvalue(p), v); */
     83     tv2pair(p)->car = v;
     84 }
     85 
     86 static inline void kset_cdr_unsafe(klisp_State *K, TValue p, TValue v)
     87 {
     88     klisp_assert(kpairp(p));
     89     UNUSED(K);
     90 /*    klispC_barrier(K, gcvalue(p), v); */
     91     tv2pair(p)->cdr = v;
     92 }
     93 
     94 /* GC: assumes car & cdr are rooted */
     95 TValue kcons_g(klisp_State *K, bool m, TValue car, TValue cdr);
     96 
     97 /* GC: assumes all argps are rooted */
     98 TValue klist_g(klisp_State *K, bool m, int32_t n, ...);
     99 
    100 #define kcons(K_, car_, cdr_) (kcons_g(K_, true, car_, cdr_))
    101 #define kimm_cons(K_, car_, cdr_) (kcons_g(K_, false, car_, cdr_))
    102 #define klist(K_, n_, ...) (klist_g(K_, true, n_, __VA_ARGS__))
    103 #define kimm_list(K_, n_, ...) (klist_g(K_, false, n_, __VA_ARGS__))
    104 
    105 #endif