1 /* pair.h -*- mode:c; coding:utf-8; -*- 2 * 3 * Copyright (c) 2010-2021 Takashi Kato <ktakashi@ymail.com> 4 * 5 * Redistribution and use in source and binary forms, with or without 6 * modification, are permitted provided that the following conditions 7 * are met: 8 * 9 * 1. Redistributions of source code must retain the above copyright 10 * notice, this list of conditions and the following disclaimer. 11 * 12 * 2. Redistributions in binary form must reproduce the above copyright 13 * notice, this list of conditions and the following disclaimer in the 14 * documentation and/or other materials provided with the distribution. 15 * 16 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 17 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 18 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 19 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 20 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 21 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 22 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 23 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 24 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 25 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 */ 28 #ifndef SAGITTARIUS_PRIVATE_PAIR_H_ 29 #define SAGITTARIUS_PRIVATE_PAIR_H_ 30 31 #include "sagittariusdefs.h" 32 #include "clos.h" 33 #include <sagittarius/lists.h> 34 35 struct SgPairRec 36 { 37 SgObject car; 38 SgObject cdr; 39 /* 40 alist of pair info. 41 FIXME 42 We can't depends on Boehm GC's GC_size. Default build puts some 43 extra information to memory so that size would be the same as 44 annotated pair and usual pair. 45 So we make pair always 3 words... 46 */ 47 SgObject info; 48 }; 49 50 SG_CLASS_DECL(Sg_ListClass); 51 SG_CLASS_DECL(Sg_PairClass); 52 SG_CLASS_DECL(Sg_NullClass); 53 54 #define SG_CLASS_LIST (&Sg_ListClass) 55 #define SG_CLASS_PAIR (&Sg_PairClass) 56 #define SG_CLASS_NULL (&Sg_NullClass) 57 58 #define SG_PAIRP(obj) (SG_HPTRP(obj)&&SG_HTAG(obj)!=0x7) 59 #define SG_PAIR(obj) ((SgPair*)obj) 60 #define SG_CAR(obj) (SG_PAIR(obj)->car) 61 #define SG_CDR(obj) (SG_PAIR(obj)->cdr) 62 #define SG_CAAR(obj) (SG_CAR(SG_CAR(obj))) 63 #define SG_CADR(obj) (SG_CAR(SG_CDR(obj))) 64 #define SG_CDAR(obj) (SG_CDR(SG_CAR(obj))) 65 #define SG_CDDR(obj) (SG_CDR(SG_CDR(obj))) 66 #define SG_SET_CAR(obj, value) (SG_CAR(obj) = (value)) 67 #define SG_SET_CDR(obj, value) (SG_CDR(obj) = (value)) 68 69 #define SG_LISTP(obj) (SG_NULLP(obj) || SG_PAIRP(obj)) 70 71 #define SG_FOR_EACH(p, list) \ 72 for ((p) = (list); SG_PAIRP(p); (p) = SG_CDR(p)) 73 74 #define SG_APPEND1(start, last, obj) \ 75 do { \ 76 if (SG_NULLP(start)) { \ 77 (start) = (last) = Sg_Cons((obj), SG_NIL); \ 78 } else { \ 79 SG_SET_CDR((last), Sg_Cons((obj), SG_NIL)); \ 80 (last) = SG_CDR(last); \ 81 } \ 82 } while(0) \ 83 84 #define SG_APPEND(start, last, obj) \ 85 do { \ 86 SgObject list_SCM_GLS = (obj); \ 87 if (SG_NULLP(start)) { \ 88 (start) = (list_SCM_GLS); \ 89 if (!SG_NULLP(list_SCM_GLS)) { \ 90 (last) = Sg_LastPair(list_SCM_GLS); \ 91 } \ 92 } else { \ 93 SG_SET_CDR((last), (list_SCM_GLS)); \ 94 (last) = Sg_LastPair(last); \ 95 } \ 96 } while(0) \ 97 98 99 #define SG_LIST1(a) Sg_Cons(a, SG_NIL) 100 #define SG_LIST2(a,b) Sg_Cons(a, SG_LIST1(b)) 101 #define SG_LIST3(a,b,c) Sg_Cons(a, SG_LIST2(b, c)) 102 #define SG_LIST4(a,b,c,d) Sg_Cons(a, SG_LIST3(b, c, d)) 103 #define SG_LIST5(a,b,c,d,e) Sg_Cons(a, SG_LIST4(b, c, d, e)) 104 105 enum { 106 SG_LIST_DOTTED = -1, /* dotted list */ 107 SG_LIST_CIRCULAR = -2 /* circular list */ 108 }; 109 110 #define SG_PROPER_LISTP(obj) (Sg_Length(obj) >= 0) 111 #define SG_DOTTED_LISTP(obj) (Sg_Length(obj) == SG_LIST_DOTTED) 112 #define SG_CIRCULAR_LISTP(obj) (Sg_Length(obj) == SG_LIST_CIRCULAR) 113 114 SG_CDECL_BEGIN 115 116 SG_EXTERN SgObject Sg_Acons(SgObject caar, SgObject cdar, SgObject cdr); 117 SG_EXTERN SgObject Sg_List(SgObject elt, ...); 118 SG_EXTERN SgObject Sg_VaList(va_list elts); 119 SG_EXTERN SgObject Sg_ArrayToList(SgObject *array, int nelts); 120 SG_EXTERN SgObject Sg_ArrayToListWithTail(SgObject *array, int nelts, SgObject tail); 121 SG_EXTERN SgObject* Sg_ListToArray(SgObject list, int nullTermP); 122 123 SG_EXTERN SgObject Sg_Caar(SgObject obj); 124 SG_EXTERN SgObject Sg_Cadr(SgObject obj); 125 SG_EXTERN SgObject Sg_Cdar(SgObject obj); 126 SG_EXTERN SgObject Sg_Cddr(SgObject obj); 127 SG_EXTERN long Sg_Length(SgObject obj); 128 SG_EXTERN SgObject Sg_CopyList(SgObject list); 129 SG_EXTERN SgObject Sg_Append2X(SgObject list, SgObject obj); 130 SG_EXTERN SgObject Sg_Append2(SgObject list, SgObject obj); 131 SG_EXTERN SgObject Sg_ReverseX(SgObject list); 132 SG_EXTERN SgObject Sg_LastPair(SgObject list); 133 SG_EXTERN SgObject Sg_ListTail(SgObject list, long i, SgObject fallback); 134 SG_EXTERN SgObject Sg_ListRef(SgObject list, long i, SgObject fallback); 135 136 SG_EXTERN SgObject Sg_Memq(SgObject obj, SgObject list); 137 SG_EXTERN SgObject Sg_Memv(SgObject obj, SgObject list); 138 SG_EXTERN SgObject Sg_Assq(SgObject obj, SgObject alist); 139 SG_EXTERN SgObject Sg_Assv(SgObject obj, SgObject alist); 140 141 SG_EXTERN SgObject Sg_GetPairAnnotation(SgObject pair, SgObject name); 142 SG_EXTERN SgObject Sg_SetPairAnnotation(SgObject pair, SgObject name, 143 SgObject v); 144 145 SG_CDECL_END 146 147 #endif /* SAGITTARIUS_PAIR_HPP_ */ 148 149 /* 150 end of file 151 Local Variables: 152 coding: utf-8-unix 153 End: 154 */ 155