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

adding more of the c*r functions

Browse Source
This commit is contained in:
Danny Yoo 2012-02-19 21:27:07 -05:00
parent 5f3f94a8ae
commit a0b708c799
3 changed files with 89 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
compiler/kernel-primitives.rkt
View File

@ -30,9 +30,14 @@
'cons
'car
'caar
'cdar
'cdr
'cadr
'cddr
'caddr
'caadr
'cdddr
'cdadr
'list
'list?
'list*

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

@ -101,11 +101,41 @@
return isPair(x) && isPair(x.first);
},
'caarable value');
var checkCdarPair = baselib.check.makeCheckArgumentType(
function(x) {
return isPair(x) && isPair(x.first);
},
'cdarable value');
var checkCadrPair = baselib.check.makeCheckArgumentType(
function(x) {
return isPair(x) && isPair(x.rest);
},
'cadrable value');
var checkCddrPair = baselib.check.makeCheckArgumentType(
function(x) {
return isPair(x) && isPair(x.rest);
},
'cddrable value');
var checkCaddrPair = baselib.check.makeCheckArgumentType(
function(x) {
return isPair(x) && isPair(x.rest) && isPair(x.rest.rest);
},
'caddrable value');
var checkCaadrPair = baselib.check.makeCheckArgumentType(
function(x) {
return isPair(x) && isPair(x.rest) && isPair(x.rest.first);
},
'caadrable value');
var checkCdddrPair = baselib.check.makeCheckArgumentType(
function(x) {
return isPair(x) && isPair(x.rest) && isPair(x.rest.rest);
},
'cdddrable value');
var checkCdadrPair = baselib.check.makeCheckArgumentType(
function(x) {
return isPair(x) && isPair(x.rest) && isPair(x.rest.first);
},
'cdadrable value');
var checkList = baselib.check.checkList;
var checkListofChars = baselib.check.makeCheckListofArgumentType(isChar, 'character');
var checkListofPairs = baselib.check.makeCheckListofArgumentType(isPair, 'pair');
@ -594,7 +624,13 @@
var firstArg = checkAny(M, 'unsafe-car', 0);
return firstArg.first;
});
installPrimitiveProcedure(
'unsafe-cdr',
1,
function (M) {
var firstArg = checkAny(M, 'unsafe-cdr', 0);
return firstArg.rest;
});
installPrimitiveProcedure(
'car',
1,
@ -602,7 +638,13 @@
var firstArg = checkPair(M, 'car', 0);
return firstArg.first;
});
installPrimitiveProcedure(
'cdr',
1,
function (M) {
var firstArg = checkPair(M, 'cdr', 0);
return firstArg.rest;
});
installPrimitiveProcedure(
'caar',
1,
@ -617,23 +659,48 @@
var firstArg = checkCadrPair(M, 'cadr', 0);
return firstArg.rest.first;
});
installPrimitiveProcedure(
'unsafe-cdr',
'cdar',
1,
function (M) {
var firstArg = checkAny(M, 'unsafe-cdr', 0);
return firstArg.rest;
var firstArg = checkCdarPair(M, 'cdar', 0);
return firstArg.first.rest;
});
installPrimitiveProcedure(
'cdr',
'cddr',
1,
function (M) {
var firstArg = checkPair(M, 'cdr', 0);
return firstArg.rest;
var firstArg = checkCddrPair(M, 'cddr', 0);
return firstArg.rest.rest;
});
installPrimitiveProcedure(
'caddr',
1,
function (M) {
var firstArg = checkCaddrPair(M, 'caddr', 0);
return firstArg.rest.rest.first;
});
installPrimitiveProcedure(
'caadr',
1,
function (M) {
var firstArg = checkCaadrPair(M, 'caadr', 0);
return firstArg.rest.first.first;
});
installPrimitiveProcedure(
'cdddr',
1,
function (M) {
var firstArg = checkCdddrPair(M, 'cdddr', 0);
return firstArg.rest.rest.rest;
});
installPrimitiveProcedure(
'cdadr',
1,
function (M) {
var firstArg = checkCdadrPair(M, 'cdadr', 0);
return firstArg.rest.first.rest;
});
installPrimitiveProcedure(
'pair?',
1,

11
lang/kernel.rkt
View File

@ -380,17 +380,18 @@ box?
eqv?
caar
cdar
cadr
;; cdar
;; cddr
cddr
;; caaar
;; caadr
caadr
;; cadar
;; cdaar
;; cdadr
cdadr
;; cddar
;; caddr
;; cdddr
caddr
cdddr
;; cadddr
length
list*