suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adding more of the primitives needed to run the scheme benchmark

Browse Source
This commit is contained in:
Danny Yoo 2012-02-20 15:59:19 -05:00
parent b8971417b2
commit 709ebce4fe
3 changed files with 132 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
compiler/kernel-primitives.rkt
View File

@ -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*

111
js-assembler/runtime-src/baselib-primitives.js
View File

@ -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,

13
lang/kernel.rkt
View File

@ -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