From 709ebce4fe2edcec1935c9eb23f428eebb4cc967 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Mon, 20 Feb 2012 15:59:19 -0500 Subject: [PATCH] adding more of the primitives needed to run the scheme benchmark --- compiler/kernel-primitives.rkt | 17 ++- .../runtime-src/baselib-primitives.js | 111 +++++++++++++++++- lang/kernel.rkt | 13 +- 3 files changed, 132 insertions(+), 9 deletions(-) diff --git a/compiler/kernel-primitives.rkt b/compiler/kernel-primitives.rkt index f210cae..490cc25 100644 --- a/compiler/kernel-primitives.rkt +++ b/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* diff --git a/js-assembler/runtime-src/baselib-primitives.js b/js-assembler/runtime-src/baselib-primitives.js index 25f1a13..e880d6d 100644 --- a/js-assembler/runtime-src/baselib-primitives.js +++ b/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, diff --git a/lang/kernel.rkt b/lang/kernel.rkt index 97ce1dd..3e0066e 100644 --- a/lang/kernel.rkt +++ b/lang/kernel.rkt @@ -384,15 +384,20 @@ box? cadr ;; cdar cddr -;; caaar + caaar caadr -;; cadar -;; cdaar + cadar + cdaar cdadr -;; cddar + cddar caddr cdddr cadddr + caaaar + caaadr + caadar + caaddr + caddar length list* list-ref