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

trying to fix all the silly c...r functions

Browse Source
This commit is contained in:
Danny Yoo 2012-02-20 16:49:37 -05:00
parent ce56e96aeb
commit 3d34c22b97
4 changed files with 329 additions and 195 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
compiler/kernel-primitives.rkt
View File

@ -30,25 +30,39 @@
'cons 'cons
'car 'car
'cdr 'cdr
'caar
'cadr
'caar
'cdar 'cdar
'cadr
'cddr 'cddr
'caaar 'caaar
'caadr
'cadar
'caddr
'cdaar 'cdaar
'cdadr 'cadar
'cddar 'cddar
'caadr
'cdadr
'caddr
'cdddr 'cdddr
'caaaar 'caaaar
'caaadr 'cdaaar
'cadaar
'cddaar
'caadar 'caadar
'caaddr 'cdadar
'cadddr
'caddar 'caddar
'list 'cdddar
'caaadr
'cdaadr
'cadadr
'cddadr
'caaddr
'cdaddr
'cadddr
'cddddr
'list
'list? 'list?
'list* 'list*
'list->vector 'list->vector

23
generate-c-star-d.rkt
View File

@ -7,7 +7,7 @@
(define (make-c*r (n 4)) (define (make-c*r (n 4))
(define template #<<EOF (define template #<<EOF
installPrimitiveProcedure( installPrimitiveProcedure(
~s, '~a',
1, 1,
function(M) { function(M) {
var x = M.e[M.e.length-1]; var x = M.e[M.e.length-1];
@ -38,15 +38,18 @@ EOF
(define (combinations n) (define (combinations n)
(let loop ([n n]) (define (helper n)
(cond (let loop ([n n])
[(= n 2) (cond
(list "aa" "ad" "da" "dd")] [(= n 1)
[else (list "a" "d")]
(define sub-answers (loop (sub1 n))) [else
(append sub-answers (define sub-answers (loop (sub1 n)))
(map (lambda (x) (string-append x "a")) sub-answers) (append (map (lambda (x) (string-append x "a")) sub-answers)
(map (lambda (x) (string-append x "d")) sub-answers))]))) (map (lambda (x) (string-append x "d")) sub-answers))])))
(apply append (for/list ([n (in-range 2 (add1 n))])
(helper n))))
(define (accessor s) (define (accessor s)
(string-join (string-join

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

@ -96,97 +96,6 @@
); );
var checkRational = baselib.check.checkRational; var checkRational = baselib.check.checkRational;
var checkPair = baselib.check.checkPair; var checkPair = baselib.check.checkPair;
var checkCaarPair = baselib.check.makeCheckArgumentType(
function(x) {
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 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);
},
'cadddrable 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 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 checkList = baselib.check.checkList;
var checkListofChars = baselib.check.makeCheckListofArgumentType(isChar, 'character'); var checkListofChars = baselib.check.makeCheckListofArgumentType(isChar, 'character');
var checkListofPairs = baselib.check.makeCheckListofArgumentType(isPair, 'pair'); var checkListofPairs = baselib.check.makeCheckListofArgumentType(isPair, 'pair');
@ -696,132 +605,330 @@
var firstArg = checkPair(M, 'cdr', 0); var firstArg = checkPair(M, 'cdr', 0);
return firstArg.rest; return firstArg.rest;
}); });
//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////
// The code from this point up to the end of the c**r functions
// is autogenerated by whalesong/generate-c-star-d.rkt.
//
// Don't modify this code manually: rather, edit the generator and
// inject the content back in here.
// Too bad we don't have macros in JavaScript...
installPrimitiveProcedure( installPrimitiveProcedure(
'caar', 'caar',
1, 1,
function (M) { function(M) {
var firstArg = checkCaarPair(M, 'caar', 0); var x = M.e[M.e.length-1];
return firstArg.first.first; if (isPair(x)&&isPair(x.first)) {
}); return x.first.first;
installPrimitiveProcedure( } else {
'cadr', raiseArgumentTypeError(M, "caar", "caarable value", 0, x);
1, }
function (M) {
var firstArg = checkCadrPair(M, 'cadr', 0);
return firstArg.rest.first;
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'cdar', 'cdar',
1, 1,
function (M) { function(M) {
var firstArg = checkCdarPair(M, 'cdar', 0); var x = M.e[M.e.length-1];
return firstArg.first.rest; if (isPair(x)&&isPair(x.first)) {
return x.first.rest;
} else {
raiseArgumentTypeError(M, "cdar", "cdarable value", 0, x);
}
});
installPrimitiveProcedure(
'cadr',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.rest)) {
return x.rest.first;
} else {
raiseArgumentTypeError(M, "cadr", "cadrable value", 0, x);
}
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'cddr', 'cddr',
1, 1,
function (M) { function(M) {
var firstArg = checkCddrPair(M, 'cddr', 0); var x = M.e[M.e.length-1];
return firstArg.rest.rest; if (isPair(x)&&isPair(x.rest)) {
}); return x.rest.rest;
installPrimitiveProcedure( } else {
'caddr', raiseArgumentTypeError(M, "cddr", "cddrable value", 0, x);
1, }
function (M) {
var firstArg = checkCaddrPair(M, 'caddr', 0);
return firstArg.rest.rest.first;
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'caaar', 'caaar',
1, 1,
function (M) { function(M) {
var firstArg = checkCaaarPair(M, 'caaar', 0); var x = M.e[M.e.length-1];
return firstArg.first.first.first; if (isPair(x)&&isPair(x.first)&&isPair(x.first.first)) {
return x.first.first.first;
} else {
raiseArgumentTypeError(M, "caaar", "caaarable value", 0, x);
}
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'cdaar', 'cdaar',
1, 1,
function (M) { function(M) {
var firstArg = checkCdaarPair(M, 'cdaar', 0); var x = M.e[M.e.length-1];
return firstArg.first.first.rest; if (isPair(x)&&isPair(x.first)&&isPair(x.first.first)) {
}); return x.first.first.rest;
installPrimitiveProcedure( } else {
'cddar', raiseArgumentTypeError(M, "cdaar", "cdaarable value", 0, x);
1, }
function (M) {
var firstArg = checkCddarPair(M, 'cddar', 0);
return firstArg.first.rest.rest;
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'cadar', 'cadar',
1, 1,
function (M) { function(M) {
var firstArg = checkCadarPair(M, 'cadar', 0); var x = M.e[M.e.length-1];
return firstArg.first.rest.first; if (isPair(x)&&isPair(x.first)&&isPair(x.first.rest)) {
return x.first.rest.first;
} else {
raiseArgumentTypeError(M, "cadar", "cadarable value", 0, x);
}
});
installPrimitiveProcedure(
'cddar',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.first)&&isPair(x.first.rest)) {
return x.first.rest.rest;
} else {
raiseArgumentTypeError(M, "cddar", "cddarable value", 0, x);
}
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'caadr', 'caadr',
1, 1,
function (M) { function(M) {
var firstArg = checkCaadrPair(M, 'caadr', 0); var x = M.e[M.e.length-1];
return firstArg.rest.first.first; if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.first)) {
}); return x.rest.first.first;
installPrimitiveProcedure( } else {
'cdddr', raiseArgumentTypeError(M, "caadr", "caadrable value", 0, x);
1, }
function (M) {
var firstArg = checkCdddrPair(M, 'cdddr', 0);
return firstArg.rest.rest.rest;
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'cdadr', 'cdadr',
1, 1,
function (M) { function(M) {
var firstArg = checkCdadrPair(M, 'cdadr', 0); var x = M.e[M.e.length-1];
return firstArg.rest.first.rest; if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.first)) {
return x.rest.first.rest;
} else {
raiseArgumentTypeError(M, "cdadr", "cdadrable value", 0, x);
}
});
installPrimitiveProcedure(
'caddr',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.rest)) {
return x.rest.rest.first;
} else {
raiseArgumentTypeError(M, "caddr", "caddrable value", 0, x);
}
});
installPrimitiveProcedure(
'cdddr',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.rest)) {
return x.rest.rest.rest;
} else {
raiseArgumentTypeError(M, "cdddr", "cdddrable value", 0, x);
}
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'caaaar', 'caaaar',
1, 1,
function (M) { function(M) {
var firstArg = checkCaaaarPair(M, 'caaaar', 0); var x = M.e[M.e.length-1];
return firstArg.first.first.first.first; if (isPair(x)&&isPair(x.first)&&isPair(x.first.first)&&isPair(x.first.first.first)) {
return x.first.first.first.first;
} else {
raiseArgumentTypeError(M, "caaaar", "caaaarable value", 0, x);
}
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'caaadr', 'cdaaar',
1, 1,
function (M) { function(M) {
var firstArg = checkCaaadrPair(M, 'caaadr', 0); var x = M.e[M.e.length-1];
return firstArg.rest.first.first.first; if (isPair(x)&&isPair(x.first)&&isPair(x.first.first)&&isPair(x.first.first.first)) {
return x.first.first.first.rest;
} else {
raiseArgumentTypeError(M, "cdaaar", "cdaaarable value", 0, x);
}
});
installPrimitiveProcedure(
'cadaar',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.first)&&isPair(x.first.first)&&isPair(x.first.first.rest)) {
return x.first.first.rest.first;
} else {
raiseArgumentTypeError(M, "cadaar", "cadaarable value", 0, x);
}
});
installPrimitiveProcedure(
'cddaar',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.first)&&isPair(x.first.first)&&isPair(x.first.first.rest)) {
return x.first.first.rest.rest;
} else {
raiseArgumentTypeError(M, "cddaar", "cddaarable value", 0, x);
}
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'caadar', 'caadar',
1, 1,
function (M) { function(M) {
var firstArg = checkCaadarPair(M, 'caadar', 0); var x = M.e[M.e.length-1];
return firstArg.first.rest.first.first; if (isPair(x)&&isPair(x.first)&&isPair(x.first.rest)&&isPair(x.first.rest.first)) {
return x.first.rest.first.first;
} else {
raiseArgumentTypeError(M, "caadar", "caadarable value", 0, x);
}
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'caaddr', 'cdadar',
1, 1,
function (M) { function(M) {
var firstArg = checkCaaddrPair(M, 'caaddr', 0); var x = M.e[M.e.length-1];
return firstArg.rest.rest.first.first; if (isPair(x)&&isPair(x.first)&&isPair(x.first.rest)&&isPair(x.first.rest.first)) {
}); return x.first.rest.first.rest;
installPrimitiveProcedure( } else {
'cadddr', raiseArgumentTypeError(M, "cdadar", "cdadarable value", 0, x);
1, }
function (M) {
var firstArg = checkCadddrPair(M, 'cadddr', 0);
return firstArg.rest.rest.rest.first;
}); });
installPrimitiveProcedure( installPrimitiveProcedure(
'caddar', 'caddar',
1, 1,
function (M) { function(M) {
var firstArg = checkCaddarPair(M, 'caddar', 0); var x = M.e[M.e.length-1];
return firstArg.first.rest.rest.first; if (isPair(x)&&isPair(x.first)&&isPair(x.first.rest)&&isPair(x.first.rest.rest)) {
return x.first.rest.rest.first;
} else {
raiseArgumentTypeError(M, "caddar", "caddarable value", 0, x);
}
}); });
installPrimitiveProcedure(
'cdddar',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.first)&&isPair(x.first.rest)&&isPair(x.first.rest.rest)) {
return x.first.rest.rest.rest;
} else {
raiseArgumentTypeError(M, "cdddar", "cdddarable value", 0, x);
}
});
installPrimitiveProcedure(
'caaadr',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.first)&&isPair(x.rest.first.first)) {
return x.rest.first.first.first;
} else {
raiseArgumentTypeError(M, "caaadr", "caaadrable value", 0, x);
}
});
installPrimitiveProcedure(
'cdaadr',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.first)&&isPair(x.rest.first.first)) {
return x.rest.first.first.rest;
} else {
raiseArgumentTypeError(M, "cdaadr", "cdaadrable value", 0, x);
}
});
installPrimitiveProcedure(
'cadadr',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.first)&&isPair(x.rest.first.rest)) {
return x.rest.first.rest.first;
} else {
raiseArgumentTypeError(M, "cadadr", "cadadrable value", 0, x);
}
});
installPrimitiveProcedure(
'cddadr',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.first)&&isPair(x.rest.first.rest)) {
return x.rest.first.rest.rest;
} else {
raiseArgumentTypeError(M, "cddadr", "cddadrable value", 0, x);
}
});
installPrimitiveProcedure(
'caaddr',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.rest)&&isPair(x.rest.rest.first)) {
return x.rest.rest.first.first;
} else {
raiseArgumentTypeError(M, "caaddr", "caaddrable value", 0, x);
}
});
installPrimitiveProcedure(
'cdaddr',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.rest)&&isPair(x.rest.rest.first)) {
return x.rest.rest.first.rest;
} else {
raiseArgumentTypeError(M, "cdaddr", "cdaddrable value", 0, x);
}
});
installPrimitiveProcedure(
'cadddr',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.rest)&&isPair(x.rest.rest.rest)) {
return x.rest.rest.rest.first;
} else {
raiseArgumentTypeError(M, "cadddr", "cadddrable value", 0, x);
}
});
installPrimitiveProcedure(
'cddddr',
1,
function(M) {
var x = M.e[M.e.length-1];
if (isPair(x)&&isPair(x.rest)&&isPair(x.rest.rest)&&isPair(x.rest.rest.rest)) {
return x.rest.rest.rest.rest;
} else {
raiseArgumentTypeError(M, "cddddr", "cddddrable value", 0, x);
}
});
// End autogenerated code.
//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////
installPrimitiveProcedure( installPrimitiveProcedure(
'pair?', 'pair?',
1, 1,

26
lang/kernel.rkt
View File

@ -378,26 +378,36 @@ box?
equal? equal?
eqv? eqv?
caar caar
cdar cdar
cadr cadr
;; cdar
cddr cddr
caaar caaar
caadr
cadar
cdaar cdaar
cdadr cadar
cddar cddar
caadr
cdadr
caddr caddr
cdddr cdddr
cadddr
caaaar caaaar
caaadr cdaaar
cadaar
cddaar
caadar caadar
caaddr cdadar
caddar caddar
cdddar
caaadr
cdaadr
cadadr
cddadr
caaddr
cdaddr
cadddr
cddddr
length length
list* list*
list-ref list-ref