Added range function

Reimplemented iota via range
Added global *args* variable that contains program/script arguments
This commit is contained in:
Sanel Zukan 2008-07-18 12:34:35 +00:00
parent 192b61316b
commit 98b109176a
2 changed files with 39 additions and 9 deletions

View File

@ -83,15 +83,27 @@
(else (else
(throw "Unsupported type in 'for' loop")))))) (throw "Unsupported type in 'for' loop"))))))
;;
;; range function; returns a list of numbers in form [start end)
;;
;; Althought we could wrote this function cleanly without decrementors
;; using recursion call after 'cons', we would loose tail call optimization
;; yielding much slower function.
;;
(define (range start end)
(let loop ((s (- start 1))
(e (- end 1))
(lst '()))
(if (>= s e)
lst
(loop s (- e 1) (cons e lst)))))
;; ;;
;; iota function; returns a list of numbers ;; iota function; returns a list of numbers
;; ;;
(define (iota n) (define (iota n)
(let loop ((n n) (range 0 n))
(lst '()))
(if (= n 0)
lst
(loop (- n 1) (cons n lst)))))
;; ;;
;; function for easier timing ;; function for easier timing

View File

@ -15,6 +15,8 @@ extern "C" {
#define BASE_FILE "capone.init" #define BASE_FILE "capone.init"
#define CHECK_ARGV(argv, pshort, plong) ((strcmp(argv, pshort) == 0) || (strcmp(argv, plong) == 0)) #define CHECK_ARGV(argv, pshort, plong) ((strcmp(argv, pshort) == 0) || (strcmp(argv, plong) == 0))
extern pointer reverse_in_place(scheme *sc, pointer term, pointer list);
const char* next_param(int curr, char** argv, int argc) { const char* next_param(int curr, char** argv, int argc) {
int j = curr + 1; int j = curr + 1;
if(j >= argc) if(j >= argc)
@ -33,7 +35,21 @@ void help(void) {
puts(" -e, --eval [str] Evaluate given expression\n"); puts(" -e, --eval [str] Evaluate given expression\n");
} }
void do_file_or_expr(FILE* f, const char* expr, const char* dir) { void register_args_var(scheme* sc, int argc, char** argv) {
pointer args = sc->NIL;
for(int i = 0; i < argc; i++) {
pointer v = mk_string(sc, argv[i]);
args = cons(sc, v, args);
}
args = reverse_in_place(sc, sc->NIL, args);
scheme_define(sc,
sc->global_env,
mk_symbol(sc, "*args*"),
args);
}
void do_file_or_expr(FILE* f, const char* expr, const char* dir, int argc, char** argv) {
scheme sc; scheme sc;
if(!scheme_init(&sc)) { if(!scheme_init(&sc)) {
puts("Unable to load interpreter!"); puts("Unable to load interpreter!");
@ -61,6 +77,8 @@ void do_file_or_expr(FILE* f, const char* expr, const char* dir) {
/* define 'load-extension' function first */ /* define 'load-extension' function first */
scheme_define(&sc, sc.global_env, mk_symbol(&sc,"load-extension"), mk_foreign_func(&sc, scm_load_ext)); scheme_define(&sc, sc.global_env, mk_symbol(&sc,"load-extension"), mk_foreign_func(&sc, scm_load_ext));
register_args_var(&sc, argc, argv);
register_dbus_functions(&sc); register_dbus_functions(&sc);
register_re_functions(&sc); register_re_functions(&sc);
register_sys_functions(&sc); register_sys_functions(&sc);
@ -120,7 +138,7 @@ int main(int argc, char** argv) {
} }
if(expr) { if(expr) {
do_file_or_expr(NULL, expr, l); do_file_or_expr(NULL, expr, l, argc, argv);
} else if(filename) { } else if(filename) {
FILE* f = fopen(filename, "r"); FILE* f = fopen(filename, "r");
if(!f) { if(!f) {
@ -128,12 +146,12 @@ int main(int argc, char** argv) {
return 1; return 1;
} }
do_file_or_expr(f, NULL, l); do_file_or_expr(f, NULL, l, argc, argv);
fclose(f); fclose(f);
} else { } else {
printf("\033[33mcapone " VERSION "\033[0m (based on tinyscheme 1.39)\n"); printf("\033[33mcapone " VERSION "\033[0m (based on tinyscheme 1.39)\n");
printf("Type \"(quit)\" or press Ctrl-C to exit interpreter when you are done."); printf("Type \"(quit)\" or press Ctrl-C to exit interpreter when you are done.");
do_file_or_expr(stdin, NULL, l); do_file_or_expr(stdin, NULL, l, argc, argv);
} }
return 0; return 0;