From 626bfe7886bad75093d013c0db2d706e419b8b1f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 24 Feb 2015 13:24:02 -0500 Subject: [PATCH] Added autogenerated primitive sections --- eval.scm | 100 +++++++++++++++++++++++++++++++++++++++++++++++------- runtime.h | 100 ++++++++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 173 insertions(+), 27 deletions(-) diff --git a/eval.scm b/eval.scm index e91284af..2115eacc 100644 --- a/eval.scm +++ b/eval.scm @@ -182,19 +182,93 @@ (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures - (list (list 'car car) - (list 'cdr cdr) - (list 'cons cons) - (list 'eq? eq?) - (list 'equal? equal?) - (list 'set-car! set-car!) - (list 'set-cdr! set-cdr!) - (list 'null? null?) - (list 'has-cycle? has-cycle?) - (list 'Cyc-global-vars Cyc-global-vars) - (list '+ +) - ; TODO: - )) + (list + (list 'Cyc-global-vars Cyc-global-vars) + (list 'Cyc-get-cvar Cyc-get-cvar) + (list 'Cyc-set-cvar! Cyc-set-cvar!) + (list 'Cyc-cvar? Cyc-cvar?) + (list 'has-cycle? has-cycle?) + (list '+ +) + (list '- -) + (list '* *) + (list '/ /) + (list '= =) + (list '> >) + (list '< <) + (list '>= >=) + (list '<= <=) + (list 'apply apply) + (list '%halt %halt) + (list 'error error) + (list 'cons cons) + (list 'cell-get cell-get) + (list 'set-global! set-global!) + (list 'set-cell! set-cell!) + (list 'cell cell) + (list 'eq? eq?) + (list 'eqv? eqv?) + (list 'equal? equal?) + (list 'assoc assoc) + (list 'assq assq) + (list 'member member) + (list 'length length) + (list 'set-car! set-car!) + (list 'set-cdr! set-cdr!) + (list 'car car) + (list 'cdr cdr) + (list 'caar caar) + (list 'cadr cadr) + (list 'cdar cdar) + (list 'cddr cddr) + (list 'caaar caaar) + (list 'caadr caadr) + (list 'cadar cadar) + (list 'caddr caddr) + (list 'cdaar cdaar) + (list 'cdadr cdadr) + (list 'cddar cddar) + (list 'cdddr cdddr) + (list 'caaaar caaaar) + (list 'caaadr caaadr) + (list 'caadar caadar) + (list 'caaddr caaddr) + (list 'cadaar cadaar) + (list 'cadadr cadadr) + (list 'caddar caddar) + (list 'cadddr cadddr) + (list 'cdaaar cdaaar) + (list 'cdaadr cdaadr) + (list 'cdadar cdadar) + (list 'cdaddr cdaddr) + (list 'cddaar cddaar) + (list 'cddadr cddadr) + (list 'cdddar cdddar) + (list 'cddddr cddddr) + (list 'char->integer char->integer) + (list 'integer->char integer->char) + (list 'string->number string->number) + (list 'string-append string-append) + (list 'string->list string->list) + (list 'list->string list->string) + (list 'string->symbol string->symbol) + (list 'symbol->string symbol->string) + (list 'number->string number->string) + (list 'boolean? boolean?) + (list 'char? char?) + (list 'eof-object? eof-object?) + (list 'null? null?) + (list 'number? number?) + (list 'pair? pair?) + (list 'procedure? procedure?) + (list 'string? string?) + (list 'symbol? symbol?) + (list 'current-input-port current-input-port) + (list 'open-input-file open-input-file) + (list 'close-input-port close-input-port) + (list 'read-char read-char) + (list 'peek-char peek-char) + (list 'write write) + (list 'display display))) (define (primitive-procedure-names) (map car diff --git a/runtime.h b/runtime.h index c4c2a890..2d6d1a2c 100644 --- a/runtime.h +++ b/runtime.h @@ -969,20 +969,92 @@ static const object primitive_##name = &name##_primitive #define prim(x) (x && ((primitive)x)->tag == primitive_tag) -// TODO: there has to be a better way: -defprimitive(cons /*, Cyc_length*/); -defprimitive(length /*, Cyc_length*/); -defprimitive(car); -defprimitive(cdr); -defprimitive(cadr); -defprimitive(set_91car_67); -defprimitive(set_91cdr_67); -defprimitive(eq_127); -defprimitive(equal_127); -defprimitive(null_127); -defprimitive(_87); // The plus symbol: + -defprimitive(Cyc_91global_91vars); -defprimitive(has_91cycle_127); +defprimitive(Cyc_91global_91vars); /* Cyc-global-vars */ +defprimitive(Cyc_91get_91cvar); /* Cyc-get-cvar */ +defprimitive(Cyc_91set_91cvar_67); /* Cyc-set-cvar! */ +defprimitive(Cyc_91cvar_127); /* Cyc-cvar? */ +defprimitive(has_91cycle_127); /* has-cycle? */ +defprimitive(_87); /* + */ +defprimitive(_91); /* - */ +defprimitive(_85); /* * */ +defprimitive(_95); /* / */ +defprimitive(_123); /* = */ +defprimitive(_125); /* > */ +defprimitive(_121); /* < */ +defprimitive(_125_123); /* >= */ +defprimitive(_121_123); /* <= */ +defprimitive(apply); /* apply */ +defprimitive(_75halt); /* %halt */ +defprimitive(error); /* error */ +defprimitive(cons); /* cons */ +defprimitive(cell_91get); /* cell-get */ +defprimitive(set_91global_67); /* set-global! */ +defprimitive(set_91cell_67); /* set-cell! */ +defprimitive(cell); /* cell */ +defprimitive(eq_127); /* eq? */ +defprimitive(eqv_127); /* eqv? */ +defprimitive(equal_127); /* equal? */ +defprimitive(assoc); /* assoc */ +defprimitive(assq); /* assq */ +defprimitive(member); /* member */ +defprimitive(length); /* length */ +defprimitive(set_91car_67); /* set-car! */ +defprimitive(set_91cdr_67); /* set-cdr! */ +defprimitive(car); /* car */ +defprimitive(cdr); /* cdr */ +defprimitive(caar); /* caar */ +defprimitive(cadr); /* cadr */ +defprimitive(cdar); /* cdar */ +defprimitive(cddr); /* cddr */ +defprimitive(caaar); /* caaar */ +defprimitive(caadr); /* caadr */ +defprimitive(cadar); /* cadar */ +defprimitive(caddr); /* caddr */ +defprimitive(cdaar); /* cdaar */ +defprimitive(cdadr); /* cdadr */ +defprimitive(cddar); /* cddar */ +defprimitive(cdddr); /* cdddr */ +defprimitive(caaaar); /* caaaar */ +defprimitive(caaadr); /* caaadr */ +defprimitive(caadar); /* caadar */ +defprimitive(caaddr); /* caaddr */ +defprimitive(cadaar); /* cadaar */ +defprimitive(cadadr); /* cadadr */ +defprimitive(caddar); /* caddar */ +defprimitive(cadddr); /* cadddr */ +defprimitive(cdaaar); /* cdaaar */ +defprimitive(cdaadr); /* cdaadr */ +defprimitive(cdadar); /* cdadar */ +defprimitive(cdaddr); /* cdaddr */ +defprimitive(cddaar); /* cddaar */ +defprimitive(cddadr); /* cddadr */ +defprimitive(cdddar); /* cdddar */ +defprimitive(cddddr); /* cddddr */ +defprimitive(char_91_125integer); /* char->integer */ +defprimitive(integer_91_125char); /* integer->char */ +defprimitive(string_91_125number); /* string->number */ +defprimitive(string_91append); /* string-append */ +defprimitive(string_91_125list); /* string->list */ +defprimitive(list_91_125string); /* list->string */ +defprimitive(string_91_125symbol); /* string->symbol */ +defprimitive(symbol_91_125string); /* symbol->string */ +defprimitive(number_91_125string); /* number->string */ +defprimitive(boolean_127); /* boolean? */ +defprimitive(char_127); /* char? */ +defprimitive(eof_91object_127); /* eof-object? */ +defprimitive(null_127); /* null? */ +defprimitive(number_127); /* number? */ +defprimitive(pair_127); /* pair? */ +defprimitive(procedure_127); /* procedure? */ +defprimitive(string_127); /* string? */ +defprimitive(symbol_127); /* symbol? */ +defprimitive(current_91input_91port); /* current-input-port */ +defprimitive(open_91input_91file); /* open-input-file */ +defprimitive(close_91input_91port); /* close-input-port */ +defprimitive(read_91char); /* read-char */ +defprimitive(peek_91char); /* peek-char */ +defprimitive(write); /* write */ +defprimitive(display); /* display */ /* All constant-size objects */ typedef union {