Lichen

templates/ops.c

1048:8b2774ab2500
5 months ago Paul Boddie Merged changes from the default branch. trailing-data
     1 /* Common operations.     2      3 Copyright (C) 2015, 2016, 2017, 2018 Paul Boddie <paul@boddie.org.uk>     4      5 This program is free software; you can redistribute it and/or modify it under     6 the terms of the GNU General Public License as published by the Free Software     7 Foundation; either version 3 of the License, or (at your option) any later     8 version.     9     10 This program is distributed in the hope that it will be useful, but WITHOUT    11 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS    12 FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more    13 details.    14     15 You should have received a copy of the GNU General Public License along with    16 this program.  If not, see <http://www.gnu.org/licenses/>.    17 */    18     19 #include "gc.h" /* GC_MALLOC, GC_REALLOC */    20 #include "types.h"    21 #include "ops.h"    22 #include "progops.h" /* for raising errors */    23 #include "progconsts.h"    24 #include "progtypes.h"    25     26 /* Get object reference from attribute. */    27     28 __ref __VALUE(__attr attr)    29 {    30     if (!__INTEGER(attr))    31         return attr.value;    32     else    33         return (__ref) &__common_integer_obj;    34 }    35     36 /* Basic structure tests. */    37     38 static inline int __HASATTR(__ref obj, int pos, int code)    39 {    40     return (pos < obj->table->size) && (obj->table->attrs[pos] == code);    41 }    42     43 /* Direct access and manipulation of static objects. */    44     45 __attr __load_static_ignore(__ref obj)    46 {    47     return __ATTRVALUE(obj);    48 }    49     50 __attr __load_static_replace(__attr context, __ref obj)    51 {    52     return __update_context(context, __ATTRVALUE(obj));    53 }    54     55 __attr __load_static_test(__attr context, __ref obj)    56 {    57     return __test_context(context, __ATTRVALUE(obj));    58 }    59     60 /* Direct retrieval operations, returning and setting attributes. */    61     62 __attr __load_via_object__(__ref obj, int pos)    63 {    64     return obj->attrs[pos];    65 }    66     67 __attr __load_via_class__(__ref obj, int pos)    68 {    69     return __load_via_object__(__get_class(obj), pos);    70 }    71     72 __attr __get_class_and_load__(__ref obj, int pos)    73 {    74     if (__is_instance(obj))    75         return __load_via_class__(obj, pos);    76     else    77         return __load_via_object__(obj, pos);    78 }    79     80 /* Direct storage operations. */    81     82 int __store_via_object__(__ref obj, int pos, __attr value)    83 {    84     obj->attrs[pos] = value;    85     return 1;    86 }    87     88 int __store_via_class__(__ref obj, int pos, __attr value)    89 {    90     return __store_via_object__(__get_class(obj), pos, value);    91 }    92     93 int __get_class_and_store__(__ref obj, int pos, __attr value)    94 {    95     /* Forbid class-relative assignments. */    96     97     __raise_type_error();    98     return 0;    99 }   100    101 /* Introspection. */   102    103 int __is_instance(__ref obj)   104 {   105     return obj->pos == __INSTANCEPOS;   106 }   107    108 int __is_subclass(__ref obj, __attr cls)   109 {   110     return __HASATTR(obj, __TYPEPOS(__VALUE(cls)), __TYPECODE(__VALUE(cls)));   111 }   112    113 int __is_instance_subclass(__ref obj, __attr cls)   114 {   115     return __is_instance(obj) && __HASATTR(__get_class(obj), __TYPEPOS(__VALUE(cls)), __TYPECODE(__VALUE(cls)));   116 }   117    118 int __is_type_instance(__ref obj)   119 {   120     return __HASATTR(__get_class(obj), __TYPE_CLASS_POS, __TYPE_CLASS_CODE);   121 }   122    123 __ref __get_class(__ref obj)   124 {   125     return __VALUE(__load_via_object(obj, __class__));   126 }   127    128 __attr __get_class_attr(__ref obj)   129 {   130     return __load_via_object(obj, __class__);   131 }   132    133 /* Attribute testing operations. */   134    135 __ref __test_specific_instance(__ref obj, __ref type)   136 {   137     return __get_class(obj) == type ? obj : 0;   138 }   139    140 __ref __test_specific_object(__ref obj, __ref type)   141 {   142     return __test_specific_type(obj, type) || __test_specific_instance(obj, type) ? obj : 0;   143 }   144    145 __ref __test_specific_type(__ref obj, __ref type)   146 {   147     return obj == type ? obj : 0;   148 }   149    150 __ref __test_common_instance__(__ref obj, int pos, int code)   151 {   152     return __HASATTR(__get_class(obj), pos, code) ? obj : 0;   153 }   154    155 __ref __test_common_object__(__ref obj, int pos, int code)   156 {   157     return __test_common_type__(obj, pos, code) || __test_common_instance__(obj, pos, code) ? obj : 0;   158 }   159    160 __ref __test_common_type__(__ref obj, int pos, int code)   161 {   162     return __HASATTR(obj, pos, code) ? obj : 0;   163 }   164    165 /* Attribute testing and retrieval operations. */   166    167 __attr __check_and_load_via_object_null(__ref obj, int pos, int code)   168 {   169     if (__HASATTR(obj, pos, code))   170         return __load_via_object__(obj, pos);   171     else   172         return __NULL;   173 }   174    175 __attr __check_and_load_via_class__(__ref obj, int pos, int code)   176 {   177     return __check_and_load_via_object__(__get_class(obj), pos, code);   178 }   179    180 __attr __check_and_load_via_object__(__ref obj, int pos, int code)   181 {   182     if (__HASATTR(obj, pos, code))   183         return __load_via_object__(obj, pos);   184    185     __raise_type_error();   186     return __NULL;   187 }   188    189 __attr __check_and_load_via_any__(__ref obj, int pos, int code)   190 {   191     __attr out = __check_and_load_via_object_null(obj, pos, code);   192     if (__ISNULL(out))   193         out = __check_and_load_via_class__(obj, pos, code);   194     return out;   195 }   196    197 /* Attribute testing and storage operations. */   198    199 int __check_and_store_via_class__(__ref obj, int pos, int code, __attr value)   200 {   201     /* Forbid class-relative assignments. */   202    203     __raise_type_error();   204     return 0;   205 }   206    207 int __check_and_store_via_object__(__ref obj, int pos, int code, __attr value)   208 {   209     if (__HASATTR(obj, pos, code))   210     {   211         __store_via_object__(obj, pos, value);   212         return 1;   213     }   214    215     /* No suitable attribute. */   216    217     __raise_type_error();   218     return 0;   219 }   220    221 int __check_and_store_via_any__(__ref obj, int pos, int code, __attr value)   222 {   223     if (__check_and_store_via_object__(obj, pos, code, value))   224         return 1;   225    226     /* Forbid class-relative assignments. */   227    228     __raise_type_error();   229     return 0;   230 }   231    232 /* Context-related operations. */   233    234 int __test_context_update(__attr context, __attr attr, int invoke)   235 {   236     /* Return whether the context should be updated for the attribute. */   237    238     __attr attrcontext = __CONTEXT_AS_VALUE(attr);   239     __ref attrcontextvalue = __VALUE(attrcontext);   240    241     /* Preserve any existing null or instance context. */   242    243     if (__ISNULL(attrcontext) || __is_instance(attrcontextvalue))   244         return 0;   245    246     /* Test any instance context against the context employed by the   247        attribute. */   248    249     if (__is_instance(__VALUE(context)))   250     {   251         /* Obtain the special class attribute position and code identifying the   252            attribute context's class, inspecting the context instance for   253            compatibility. */   254    255         if (__test_common_instance__(__VALUE(context), __TYPEPOS(attrcontextvalue), __TYPECODE(attrcontextvalue)))   256             return 1;   257         else   258             __raise_type_error();   259     }   260    261     /* Without a null or instance context, an invocation cannot be performed. */   262    263     if (invoke)   264         __raise_unbound_method_error();   265    266     /* Test for access to a type class attribute using a type instance. */   267    268     if (__test_specific_type(attrcontextvalue, &__TYPE_CLASS_TYPE) && __is_type_instance(__VALUE(context)))   269         return 1;   270    271     /* Otherwise, preserve the attribute as retrieved. */   272    273     return 0;   274 }   275    276 __attr __test_context(__attr context, __attr attr)   277 {   278     /* Update the context or return the unchanged attribute. */   279    280     if (__test_context_update(context, attr, 0))   281         return __update_context(context, attr);   282     else   283         return attr;   284 }   285    286 __attr __update_context(__attr context, __attr attr)   287 {   288     return __new_wrapper(context, attr);   289 }   290    291 __attr __test_context_revert(int target, __attr context, __attr attr, __attr contexts[])   292 {   293     /* Revert the local context to that employed by the attribute if the   294        supplied context is not appropriate. */   295    296     if (!__test_context_update(context, attr, 1))   297         contexts[target] = __CONTEXT_AS_VALUE(attr);   298     return attr;   299 }   300    301 __attr __test_context_static(int target, __attr context, __ref value, __attr contexts[])   302 {   303     /* Set the local context to the specified context if appropriate. */   304    305     if (__test_context_update(context, __ATTRVALUE(value), 1))   306         contexts[target] = context;   307     return __ATTRVALUE(value);   308 }   309    310 /* Context testing for invocations. */   311    312 int __type_method_invocation(__attr context, __attr target)   313 {   314     __attr targetcontext = __CONTEXT_AS_VALUE(target);   315    316     /* Require instances, not classes, where methods are function instances. */   317    318     if (!__is_instance(__VALUE(target)))   319         return 0;   320    321     /* Access the context of the callable and test if it is the type object. */   322    323     return (!__ISNULL(targetcontext) && __test_specific_type(__VALUE(targetcontext), &__TYPE_CLASS_TYPE) && __is_type_instance(__VALUE(context)));   324 }   325    326 __attr __unwrap_callable(__attr callable)   327 {   328     __attr value = __check_and_load_via_object_null(__VALUE(callable), __ATTRPOS(__value__), __ATTRCODE(__value__));   329     return __VALUE(value) ? value : callable;   330 }   331    332 __attr (*__get_function_unchecked(__attr target))()   333 {   334     return __load_via_object(__VALUE(__unwrap_callable(target)), __fn__).fn;   335 }   336    337 __attr (*__get_function(__attr context, __attr target))()   338 {   339     return __get_function_unwrapped(context, __unwrap_callable(target));   340 }   341    342 __attr (*__get_function_unwrapped(__attr context, __attr target))()   343 {   344     /* Require null or instance contexts for functions and methods respectively,   345        or type instance contexts for type methods. */   346    347     if (__ISNULL(context) || __is_instance(__VALUE(context)) || __type_method_invocation(context, target))   348         return __get_function_member(target);   349     else   350         return __unbound_method;   351 }   352    353 __attr (*__get_function_member(__attr target))()   354 {   355     return __load_via_object(__VALUE(target), __fn__).fn;   356 }   357    358 __attr (*__check_and_get_function(__attr context, __attr target))()   359 {   360     return __check_and_get_function_unwrapped(context, __unwrap_callable(target));   361 }   362    363 __attr (*__check_and_get_function_unwrapped(__attr context, __attr target))()   364 {   365     /* Require null or instance contexts for functions and methods respectively,   366        or type instance contexts for type methods. */   367    368     if (__ISNULL(context) || __is_instance(__VALUE(context)) || __type_method_invocation(context, target))   369         return __check_and_load_via_object__(__VALUE(target), __ATTRPOS(__fn__), __ATTRCODE(__fn__)).fn;   370     else   371         return __unbound_method;   372 }   373    374 /* Parameter position operations. */   375    376 int __HASPARAM(const __ptable *ptable, int ppos, int pcode)   377 {   378     __param param;   379    380     if (ppos < ptable->size)   381     {   382         param = ptable->params[ppos];   383         if (param.code == pcode)   384             return param.pos;   385     }   386    387     return -1;   388 }   389    390 /* Conversions. */   391    392 __attr __CONTEXT_AS_VALUE(__attr attr)   393 {   394     return __check_and_load_via_object_null(__VALUE(attr), __ATTRPOS(__context__), __ATTRCODE(__context__));   395 }   396    397 /* Type testing. */   398    399 __ref __ISFUNC(__ref obj)   400 {   401     return __test_specific_instance(obj, &__FUNCTION_TYPE);   402 }   403    404 /* Attribute codes and positions for type objects. */   405    406 unsigned int __TYPECODE(__ref obj)   407 {   408     return obj->table->attrs[obj->pos];   409 }   410    411 unsigned int __TYPEPOS(__ref obj)   412 {   413     return obj->pos;   414 }   415    416 /* Memory allocation. */   417    418 void *__ALLOCATE(size_t nmemb, size_t size)   419 {   420     void *ptr = GC_MALLOC(nmemb * size); /* sets memory to zero */   421     if (ptr == NULL)   422         __raise_memory_error();   423     return ptr;   424 }   425    426 void *__ALLOCATEIM(size_t nmemb, size_t size)   427 {   428     void *ptr = GC_MALLOC_ATOMIC(nmemb * size);   429     if (ptr == NULL)   430         __raise_memory_error();   431     return ptr;   432 }   433    434 void *__REALLOCATE(void *ptr, size_t size)   435 {   436     void *nptr = GC_REALLOC(ptr, size);   437     if (nptr == NULL)   438         __raise_memory_error();   439     return nptr;   440 }   441    442 /* Copying of structures. */   443    444 __ref __COPY(__ref obj, int size)   445 {   446     __ref copy = (__ref) __ALLOCATE(1, size);   447     memcpy(copy, obj, size);   448     return copy;   449 }