record field selection

interpreter/code.c

@@ -140,6 +140,7 @@ void set_create_thunk_fun(Code* code)
         case CT_SELECT_ADT:
         case CT_SELECT_LIT:    
         case CT_SELECT_STR:
+        case CT_SELECT_REC:
         case CT_IF:
         case CT_LET:
             code->create_thunk = NULL;
@@ -702,6 +703,28 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
             
             abort("no match");
         }
+        case CT_SELECT_REC:
+        {                        
+            SelectEntry* select = (SelectEntry*) expr;
+            
+            push_a(NULL);
+            exec(select->expr, frame_ptr, stack_top_a);
+            Thunk* cons = pop_a();            
+            
+            expr = select->bodies[0];
+            
+            if(expr != NULL)
+            {
+                for (int i = 0; i < cons->desc->arity; i++) {
+                    push_a(cons->_args[i]);
+                }                  
+                
+                continue;
+            }
+            
+            // This cannot happen in record field selection            
+            abort("no match");
+        }
         case CT_IF:
         {        
             placeholder();

interpreter/code.h

@@ -19,6 +19,7 @@ enum CodeType {
     CT_SELECT_ADT, 
     CT_SELECT_LIT, 
     CT_SELECT_STR,
+    CT_SELECT_REC,  // Record field selection
     CT_IF, 
     CT_LET, 
     CT_THUNK        // constant, always fits the B stack

interpreter/parse.c

@@ -541,30 +541,48 @@ SelectEntry* parseSelect(char **ptr, Code* fallback, int fallback_nrargs) {
     if(isADT)
     {
         (*ptr)++;
+                
+        int nrConses = 1;
         
-        ADTEntry* firstCase = (ADTEntry*) parseFunName(ptr);
-        Code* firstBody = (Code*) parseSelectBody(ptr, child_fallback, 
-            child_fallback_base_nrargs + firstCase->base.arity);   
+        Desc* firstCase = (Desc*) parseFunName(ptr);
         
-        entry = (SelectEntry*) alloc_code(sizeof (SelectEntry) + sizeof (Code*) * firstCase->nrConses);
-        entry->base.type = CT_SELECT_ADT;
-        entry->base.nr_cases = firstCase->nrConses;
-                
-        // set the default case for all the entries
-        for (int i = 0; i < firstCase->nrConses; i++) {
-            entry->bodies[i] = defaultBody;
+        if(firstCase->type == FT_ADT)
+        {
+            nrConses = ((ADTEntry*) firstCase)->nrConses;
         }
         
-        if(isDefault) nrCases--;
+        Code* firstBody = (Code*) parseSelectBody(ptr, child_fallback, 
+            child_fallback_base_nrargs + firstCase->arity);   
         
-        nrCases--; // firstCase
-        entry->bodies[firstCase->idx] = firstBody;
+        entry = (SelectEntry*) alloc_code(sizeof (SelectEntry) + sizeof (Code*) * nrConses);
         
-        for (int i = 0; i < nrCases; i++) {
-            (*ptr)++; // skip type
-            ADTEntry* nextCase = (ADTEntry*) parseFunName(ptr);
-            entry->bodies[nextCase->idx] = (Code*) parseSelectBody(ptr, child_fallback, 
-                child_fallback_base_nrargs + nextCase->base.arity);
+        if(firstCase->type == FT_ADT)
+        {
+            entry->base.type = CT_SELECT_ADT;
+            entry->base.nr_cases = nrConses;
+                
+            // set the default case for all the entries
+            for (int i = 0; i < nrConses; i++) {
+                entry->bodies[i] = defaultBody;
+            }
+
+            if(isDefault) nrCases--;
+
+            nrCases--; // firstCase
+            entry->bodies[((ADTEntry*)firstCase)->idx] = firstBody;
+
+            for (int i = 0; i < nrCases; i++) {
+                (*ptr)++; // skip type
+                ADTEntry* nextCase = (ADTEntry*) parseFunName(ptr);
+                entry->bodies[nextCase->idx] = (Code*) parseSelectBody(ptr, child_fallback, 
+                    child_fallback_base_nrargs + nextCase->base.arity);
+            }
+        }
+        else
+        {
+            entry->base.type = CT_SELECT_REC;
+            entry->base.nr_cases = 1;
+            entry->bodies[0] = firstBody;
         }
     }
     else

tests/record_select.sapl

+main = record.Start
+record.Start = _Tuple2 (record.sel1 record.rec) (record.sel2 record.rec)
+record.rec = record._R 9 "nine"
+:: record._R = {record.f1::I, record.f2}
+record.sel2 !_x_0 = select _x_0 (record._R f1_1_0 f2_1_1 -> f2_1_1) 
+record.sel1::I !_x_0 = select _x_0 (record._R f1_1_0 f2_1_1 -> f1_1_0)