Commit: ace2af3ce3df84623f9fb29d568786088bea1ed0 - sapphire_lisp (git)

Baremetal Lisp interpreter and compiler for low-resource devices

Commit MetaInfo

• Revisão: ace2af3ce3df84623f9fb29d568786088bea1ed0 (tree)
• Hora: 2020-09-13 06:41:33
• Autor: AlaskanEmily <emily@alas...>
• Commiter: AlaskanEmily

Mensagem de Log

Add partial type-hint checking for args in calls

Mudança Sumário

• modified: sl_i.c
• add: sli
• modified: tests/hint.lsp
• add: tests/hint_bad2.lsp
• delete: tests/{hint_bad.lsp => hint_bad1.lsp}

Diff

--- a/sl_i.c
+++ b/sl_i.c
@@ -135,8 +135,53 @@ static void sl_i_defun(struct SL_I_Runtime *rt,
     sl_s_len_t arity;
     void *old;
     const struct SL_S_List *arg_pair, *iter;
-    
-    arity = SL_S_Length(args);
+    const struct SL_S_Atom *atom;
+
+    arity = 0;
+    iter = args;
+    while(iter != SL_S_NIL){
+        arg_pair = SL_S_PTR_FROM_TAG(iter->head);
+        atom = SL_S_PTR_FROM_TAG(arg_pair->head);
+        if(SL_I_LIKELY(SL_S_COMPARE_ATOMS(atom, &sl_x_nil)))
+            goto type_hint_ok;
+        /* Validate that we know what this type hint is. */
+#define SL_I_TYPE_HINT_CHECK(X) \
+    if(SL_S_COMPARE_ATOMS(atom, &sl_x_ ## X ## _hint)) \
+        goto type_hint_ok;
+        SL_X_INTEGRAL_TYPES(SL_I_TYPE_HINT_CHECK)
+#undef SL_I_TYPE_HINT_CHECK
+
+#ifdef SL_S_ENABLE_POINTERS
+# define SL_I_TYPE_PTR_HINT_CHECK(X) \
+    if(SL_S_COMPARE_ATOMS(atom, &sl_x_ptr_ ## X ## _hint)) \
+        goto type_hint_ok;
+        SL_X_INTEGRAL_TYPES(SL_I_TYPE_PTR_HINT_CHECK)
+# undef SL_I_TYPE_PTR_HINT_CHECK
+#endif
+        /* Not a builtin, check for a defrec. */
+        for(i = 0; i < rt->num_recs; i++){
+            if(SL_S_COMPARE_ATOMS(rt->recs[i].name, atom))
+                goto type_hint_ok;
+        }
+        
+        /* Not OK! We don't know what this hint means. */
+#define SL_I_HINT_ERROR "Unknown type "
+        rt->pending_error =
+        rt->error_free_ptr =
+            SL_S_Malloc(sizeof(SL_I_HINT_ERROR) + atom->len);
+        SL_S_MemCopy(((char*)(rt->pending_error)),
+            SL_I_HINT_ERROR,
+            sizeof(SL_I_HINT_ERROR) - 1);
+        SL_S_MemCopy(((char*)(rt->pending_error)) + sizeof(SL_I_HINT_ERROR) - 1,
+            atom->text,
+            atom->len);
+        ((char*)(rt->pending_error))[sizeof(SL_I_HINT_ERROR) + atom->len - 1] = '\0';
+        return;
+#undef SL_I_HINT_ERROR
+type_hint_ok:
+        arity++;
+        iter = iter->tail;
+    }
     
     /* Search for an existing function of this name. */
     i = sl_i_find_bind(rt, name);
@@ -926,9 +971,11 @@ SL_S_FUNC(void) *SL_I_Call(struct SL_I_Runtime *rt,
     const struct SL_I_Bind *bind,
     const struct SL_S_List *args){
     
-    sl_s_len_t i;
+    sl_s_len_t i, e;
+    int l;
     struct SL_I_Frame frame;
     const struct SL_S_List *code;
+    const struct SL_S_Atom *hint;
     void *value;
     
     if(bind->is_native){
@@ -945,7 +992,104 @@ SL_S_FUNC(void) *SL_I_Call(struct SL_I_Runtime *rt,
         frame.num_defs = frame.cap_defs = bind->arity;
         for(i = 0; i < bind->arity; i++){
             frame.defs[i].name = bind->args[i].name;
-            frame.defs[i].value = SL_I_Execute(rt, args->head);
+            value = SL_I_Execute(rt, args->head);
+            hint = bind->args[i].hint;
+            if(!SL_S_COMPARE_ATOMS(hint, &sl_x_nil)){
+                /* Validate the type. */
+#define SL_I_TYPE_ERROR "Invalid argument type for func "
+#define SL_I_SET_TYPE_ERROR do{ \
+    rt->pending_error = \
+    rt->error_free_ptr = \
+        SL_S_Malloc(sizeof(SL_I_TYPE_ERROR) + bind->name->len); \
+    SL_S_MemCopy(((char*)(rt->pending_error)), \
+        SL_I_TYPE_ERROR, \
+        sizeof(SL_I_TYPE_ERROR) - 1); \
+    SL_S_MemCopy(((char*)(rt->pending_error)) + sizeof(SL_I_TYPE_ERROR) - 1, \
+        bind->name->text, \
+        bind->name->len); \
+    ((char*)(rt->pending_error))[ \
+        sizeof(SL_I_TYPE_ERROR) + bind->name->len - 1]; \
+    goto type_hint_done; \
+}while(0)
+
+#define SL_I_TEST_INTEGER do{ \
+    if((!SL_S_IS_ATOM(value)) || SL_X_IsInt(SL_S_PTR_FROM_TAG(value)) != 0){ \
+        SL_I_SET_TYPE_ERROR; \
+    } \
+    l = SL_X_ParseInt(value); \
+}while(0)
+
+#define SL_I_SET_UNSIGNED(SIZE) do{ \
+    if((l & ((1 << (SIZE))-1)) != l){ \
+        SL_S_DECREF(value); \
+        value = SL_S_IntToAtom(l & ((1 << (SIZE))-1), 10); \
+    } \
+}while(0)
+
+#define SL_I_INT_BITS (sizeof(int) << 3)
+#define SL_I_SET_SIGNED(SIZE) do{ \
+    if((l << (SL_I_INT_BITS - (SIZE))) >> (SL_I_INT_BITS - (SIZE)) != l) { \
+        SL_S_DECREF(value); \
+        value = SL_S_IntToAtom( \
+            (l << (SL_I_INT_BITS - (SIZE))) >> (SL_I_INT_BITS - (SIZE)), \
+            10); \
+    } \
+}while(0)
+
+                if(SL_S_COMPARE_ATOMS(hint, &sl_x_atom_hint)){
+                    if(!SL_S_IS_ATOM(value))
+                        SL_I_SET_TYPE_ERROR;
+                }
+                else if(SL_S_COMPARE_ATOMS(hint, &sl_x_list_hint)){
+                    if(!SL_S_IS_LIST(value))
+                        SL_I_SET_TYPE_ERROR;
+                }
+                else if(SL_S_COMPARE_ATOMS(hint, &sl_x_u8_hint)){
+                    SL_I_TEST_INTEGER;
+                    SL_I_SET_UNSIGNED(8);
+                }
+                else if(SL_S_COMPARE_ATOMS(hint, &sl_x_s8_hint)){
+                    SL_I_TEST_INTEGER;
+                    SL_I_SET_SIGNED(8);
+                }
+                else if(SL_S_COMPARE_ATOMS(hint, &sl_x_u16_hint)){
+                    SL_I_TEST_INTEGER;
+                    SL_I_SET_UNSIGNED(16);
+                }
+                else if(SL_S_COMPARE_ATOMS(hint, &sl_x_s16_hint)){
+                    SL_I_TEST_INTEGER;
+                    SL_I_SET_SIGNED(16);
+                }
+                else if(SL_S_COMPARE_ATOMS(hint, &sl_x_u32_hint) ||
+                    SL_S_COMPARE_ATOMS(hint, &sl_x_s32_hint) ||
+                    SL_S_COMPARE_ATOMS(hint, &sl_x_char_hint)){
+                    
+                    SL_I_TEST_INTEGER;
+                }
+                else if(hint->len >= 4 &&
+                    SL_S_MemComp(hint->text, "^ptr", 4) == 0){
+                    
+                    if(!SL_S_IS_NIL(value) || SL_S_IS_PTR(value))
+                        SL_I_SET_TYPE_ERROR;
+                }
+                else{
+                    /* Check for a record. */
+                    for(e = 0; e < rt->num_recs; e++){
+                        if(hint->len - 1 == rt->recs[e].name->len &&
+                            SL_S_MemComp(hint->text + 1,
+                                rt->recs[e].name->text,
+                                hint->len - 1) == 0){
+                            /* Done. */
+                            if(!(SL_S_IS_NIL(value) || SL_S_IS_PTR(value)))
+                                SL_I_SET_TYPE_ERROR;
+                            
+                            goto type_hint_done;
+                        }
+                    }
+                }
+            }
+type_hint_done:
+            frame.defs[i].value = value;
             if(rt->pending_error){
                 do{
                     SL_S_DECREF(frame.defs[i].value);

Binary files /dev/null and b/sli differ

--- a/tests/hint.lsp
+++ b/tests/hint.lsp
@@ -1,3 +1,5 @@
 
 (defun foo (^char c) nil)
 
+(foo 32)
+

--- /dev/null
+++ b/tests/hint_bad2.lsp
@@ -0,0 +1,5 @@
+
+(defun foo (^char c) nil)
+
+(foo xyz)
+