adding more of the primitives needed to run the scheme benchmark

compiler/kernel-primitives.rkt

@@ -29,16 +29,25 @@
                                     '>=
                                     'cons
                                     'car
-				    'caar
-                                    'cdar
                                     'cdr
+				    'caar
 				    'cadr
+                                    'cdar
                                     'cddr
-				    'caddr
+                                    'caaar
                                     'caadr
-                                    'cdddr
+                                    'cadar
+				    'caddr
+                                    'cdaar
                                     'cdadr
+                                    'cddar
+                                    'cdddr
+                                    'caaaar
+                                    'caaadr
+                                    'caadar
+                                    'caaddr
 				    'cadddr
+                                    'caddar
                                     'list
                                     'list?
                                     'list*

js-assembler/runtime-src/baselib-primitives.js

@@ -121,7 +121,47 @@
 	    return isPair(x) && isPair(x.rest) && isPair(x.rest.rest);
 	},
 	'caddrable value');
-    var checkCadddrPair = baselib.check.makeCheckArgumentType(
+   var checkCaaarPair = baselib.check.makeCheckArgumentType(
+	function(x) {
+	    return isPair(x) && isPair(x.first) && isPair(x.first.first);
+	},
+       'caaarable value'); 
+   var checkCdaarPair = baselib.check.makeCheckArgumentType(
+	function(x) {
+	    return isPair(x) && isPair(x.first) && isPair(x.first.first);
+	},
+       'cdaarable value'); 
+   var checkCddarPair = baselib.check.makeCheckArgumentType(
+	function(x) {
+	    return isPair(x) && isPair(x.first) && isPair(x.first.rest);
+	},
+       'cddarable value'); 
+   var checkCadarPair = baselib.check.makeCheckArgumentType(
+	function(x) {
+	    return isPair(x) && isPair(x.first) && isPair(x.first.rest);
+	},
+       'cadarable value'); 
+   var checkCaaaarPair = baselib.check.makeCheckArgumentType(
+	function(x) {
+	    return isPair(x) && isPair(x.first) && isPair(x.first.first) && isPair(x.first.first.first);
+	},
+	'caaaarable value');
+   var checkCaadarPair = baselib.check.makeCheckArgumentType(
+	function(x) {
+	    return isPair(x) && isPair(x.first) && isPair(x.first.rest) && isPair(x.first.rest.first);
+	},
+	'caadarable value');
+   var checkCaaddrPair = baselib.check.makeCheckArgumentType(
+	function(x) {
+	    return isPair(x) && isPair(x.rest) && isPair(x.rest.rest) && isPair(x.rest.rest.first);
+	},
+	'caaddrable value');
+   var checkCaaadrPair = baselib.check.makeCheckArgumentType(
+	function(x) {
+	    return isPair(x) && isPair(x.rest) && isPair(x.rest.first) && isPair(x.rest.first.first);
+	},
+	'caaadrable value');
+   var checkCadddrPair = baselib.check.makeCheckArgumentType(
 	function(x) {
 	    return isPair(x) && isPair(x.rest) && isPair(x.rest.rest) && isPair(x.rest.rest.rest);
 	},
@@ -141,6 +181,12 @@
 	    return isPair(x) && isPair(x.rest) && isPair(x.rest.first);
 	},
 	'cdadrable value');
+    var checkCaddarPair = baselib.check.makeCheckArgumentType(
+	function(x) {
+	    return isPair(x) && isPair(x.first) && isPair(x.first.rest) && isPair(x.first.rest.rest);
+	},
+	'caddarable value');
+
     var checkList = baselib.check.checkList;
     var checkListofChars = baselib.check.makeCheckListofArgumentType(isChar, 'character');
     var checkListofPairs = baselib.check.makeCheckListofArgumentType(isPair, 'pair');
@@ -685,6 +731,34 @@
             var firstArg = checkCaddrPair(M, 'caddr', 0);
             return firstArg.rest.rest.first;
         });
+    installPrimitiveProcedure(
+        'caaar',
+        1,
+        function (M) {
+            var firstArg = checkCaaarPair(M, 'caaar', 0);
+            return firstArg.first.first.first;
+        });
+    installPrimitiveProcedure(
+        'cdaar',
+        1,
+        function (M) {
+            var firstArg = checkCdaarPair(M, 'cdaar', 0);
+            return firstArg.first.first.rest;
+        });
+    installPrimitiveProcedure(
+        'cddar',
+        1,
+        function (M) {
+            var firstArg = checkCddarPair(M, 'cddar', 0);
+            return firstArg.first.rest.rest;
+        });
+    installPrimitiveProcedure(
+        'cadar',
+        1,
+        function (M) {
+            var firstArg = checkCadarPair(M, 'cadar', 0);
+            return firstArg.first.rest.first;
+        });
     installPrimitiveProcedure(
         'caadr',
         1,
@@ -706,6 +780,34 @@
             var firstArg = checkCdadrPair(M, 'cdadr', 0);
             return firstArg.rest.first.rest;
         });
+    installPrimitiveProcedure(
+        'caaaar',
+        1,
+        function (M) {
+            var firstArg = checkCaaaarPair(M, 'caaaar', 0);
+            return firstArg.first.first.first.first;
+        });
+    installPrimitiveProcedure(
+        'caaadr',
+        1,
+        function (M) {
+            var firstArg = checkCaaadrPair(M, 'caaadr', 0);
+            return firstArg.rest.first.first.first;
+        });
+    installPrimitiveProcedure(
+        'caadar',
+        1,
+        function (M) {
+            var firstArg = checkCaadarPair(M, 'caadar', 0);
+            return firstArg.first.rest.first.first;
+        });
+    installPrimitiveProcedure(
+        'caaddr',
+        1,
+        function (M) {
+            var firstArg = checkCaaddrPair(M, 'caaddr', 0);
+            return firstArg.rest.rest.first.first;
+        });
     installPrimitiveProcedure(
         'cadddr',
         1,
@@ -713,6 +815,13 @@
             var firstArg = checkCadddrPair(M, 'cadddr', 0);
             return firstArg.rest.rest.rest.first;
         });
+    installPrimitiveProcedure(
+        'caddar',
+        1,
+        function (M) {
+            var firstArg = checkCaddarPair(M, 'caddar', 0);
+            return firstArg.first.rest.rest.first;
+        });
     installPrimitiveProcedure(
         'pair?',
         1,

lang/kernel.rkt

@@ -384,15 +384,20 @@ box?
   cadr
 ;;  cdar
   cddr
-;;  caaar
+  caaar
   caadr
-;;  cadar
+  cadar
-;;  cdaar
+  cdaar
   cdadr
-;;  cddar
+  cddar
   caddr
   cdddr
   cadddr
+  caaaar
+  caaadr
+  caadar
+  caaddr
+  caddar
   length
   list*
   list-ref