Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-19 13:49:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Added function parameter to primitive type

Browse source
This commit is contained in:
Justin Ethier 2015-02-24 22:57:15 -05:00
parent 6694007924
commit 2909343c47
2 changed files with 144 additions and 117 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
cgen.scm
View file

@ -1065,7 +1065,7 @@
(string-append (string-append
"defprimitive(" "defprimitive("
(mangle p) (mangle p)
"); /* " ", &missing_prim); /* "
(symbol->string p) (symbol->string p)
" */\n") " */\n")
fp)) fp))

259
runtime.h
View file

@ -320,7 +320,16 @@ static void Cyc_apply(int argc, closure cont, object prim, ...);
static list mcons(object,object); static list mcons(object,object);
static object terpri(void); static object terpri(void);
static object Cyc_display(object); static object Cyc_display(object);
static object Cyc_is_boolean(object o);
static object Cyc_is_cons(object o); static object Cyc_is_cons(object o);
static object Cyc_is_null(object o);
static object Cyc_is_number(object o);
static object Cyc_is_symbol(object o);
static object Cyc_is_string(object o);
static object Cyc_is_char(object o);
static object Cyc_is_procedure(object o);
static object Cyc_is_eof_object(object o);
static object Cyc_is_cvar(object o);
static int equal(object,object); static int equal(object,object);
static list assq(object,list); static list assq(object,list);
static object get(object,object); static object get(object,object);
@ -963,101 +972,130 @@ static object Cyc_io_peek_char(object port) {
/* Primitive types */ /* Primitive types */
//typedef common_type (*prim_function_type)(); //typedef common_type (*prim_function_type)();
//typedef void (*prim_function_type)(); //typedef void (*prim_function_type)();
typedef struct {tag_type tag; const char *pname; /*prim_function_type fn;*/} primitive_type; typedef struct {tag_type tag; const char *pname; function_type fn;} primitive_type;
typedef primitive_type *primitive; typedef primitive_type *primitive;
#define defprimitive(name/*, fnc*/) \ #define defprimitive(name, fnc) \
static primitive_type name##_primitive = {primitive_tag, #name /*, &fnc*/}; \ static primitive_type name##_primitive = {primitive_tag, #name, fnc}; \
static const object primitive_##name = &name##_primitive static const object primitive_##name = &name##_primitive
#define prim(x) (x && ((primitive)x)->tag == primitive_tag) #define prim(x) (x && ((primitive)x)->tag == primitive_tag)
defprimitive(Cyc_91global_91vars); /* Cyc-global-vars */ static void missing_prim(object cont, object args) {
defprimitive(Cyc_91get_91cvar); /* Cyc-get-cvar */ printf("Primitive is not implemented\n");
defprimitive(Cyc_91set_91cvar_67); /* Cyc-set-cvar! */ exit(1);
defprimitive(Cyc_91cvar_127); /* Cyc-cvar? */ }
defprimitive(has_91cycle_127); /* has-cycle? */ static void _Cyc_91global_91vars(object cont, object args){ return_funcall1(cont, Cyc_global_variables); }
defprimitive(_87); /* + */ static void _car(object cont, object args) { return_funcall1(cont, car(car(args))); }
defprimitive(_91); /* - */ static void _cdr(object cont, object args) { return_funcall1(cont, cdr(car(args))); }
defprimitive(_85); /* * */ static void _cadr(object cont, object args) { return_funcall1(cont, cadr(car(args))); }
defprimitive(_95); /* / */ static void _cons(object cont, object args) {
defprimitive(_123); /* = */ make_cons(c, car(args), cadr(args));
defprimitive(_125); /* > */ return_funcall1(cont, &c); }
defprimitive(_121); /* < */ static void _eq_127(object cont, object args){ return_funcall1(cont, Cyc_eq(car(args), cadr(args))); }
defprimitive(_125_123); /* >= */ static void _eqv_127(object cont, object args){ _eq_127(cont, args); }
defprimitive(_121_123); /* <= */ static void _equal_127(object cont, object args){ return_funcall1(cont, equalp(car(args), cadr(args))); }
defprimitive(apply); /* apply */ static void _length(object cont, object args){
defprimitive(_75halt); /* %halt */ integer_type i = Cyc_length(car(args));
defprimitive(error); /* error */ return_funcall1(cont, &i); }
defprimitive(cons); /* cons */ static void _null_127(object cont, object args) {
defprimitive(cell_91get); /* cell-get */ return_funcall1(cont, Cyc_is_null(car(args))); }
defprimitive(set_91global_67); /* set-global! */ static void _set_91_car_67(object cont, object args) {
defprimitive(set_91cell_67); /* set-cell! */ return_funcall1(cont, Cyc_set_car(car(args), cadr(args))); }
defprimitive(cell); /* cell */ static void _set_91_cdr_67(object cont, object args) {
defprimitive(eq_127); /* eq? */ return_funcall1(cont, Cyc_set_cdr(car(args), cadr(args))); }
defprimitive(eqv_127); /* eqv? */ static void _has_91cycle_127(object cont, object args) {
defprimitive(equal_127); /* equal? */ return_funcall1(cont, Cyc_has_cycle(car(args))); }
defprimitive(assoc); /* assoc */
defprimitive(assq); /* assq */
defprimitive(member); /* member */ /* This section is auto-generated via --autogen */
defprimitive(length); /* length */ defprimitive(Cyc_91global_91vars, &_Cyc_91global_91vars); /* Cyc-global-vars */
defprimitive(set_91car_67); /* set-car! */ defprimitive(Cyc_91get_91cvar, &missing_prim); /* Cyc-get-cvar */
defprimitive(set_91cdr_67); /* set-cdr! */ defprimitive(Cyc_91set_91cvar_67, &missing_prim); /* Cyc-set-cvar! */
defprimitive(car); /* car */ defprimitive(Cyc_91cvar_127, &missing_prim); /* Cyc-cvar? */
defprimitive(cdr); /* cdr */ defprimitive(has_91cycle_127, &_has_91cycle_127); /* has-cycle? */
defprimitive(caar); /* caar */ defprimitive(_87, &missing_prim); /* + */
defprimitive(cadr); /* cadr */ defprimitive(_91, &missing_prim); /* - */
defprimitive(cdar); /* cdar */ defprimitive(_85, &missing_prim); /* * */
defprimitive(cddr); /* cddr */ defprimitive(_95, &missing_prim); /* / */
defprimitive(caaar); /* caaar */ defprimitive(_123, &missing_prim); /* = */
defprimitive(caadr); /* caadr */ defprimitive(_125, &missing_prim); /* > */
defprimitive(cadar); /* cadar */ defprimitive(_121, &missing_prim); /* < */
defprimitive(caddr); /* caddr */ defprimitive(_125_123, &missing_prim); /* >= */
defprimitive(cdaar); /* cdaar */ defprimitive(_121_123, &missing_prim); /* <= */
defprimitive(cdadr); /* cdadr */ defprimitive(apply, &missing_prim); /* apply */
defprimitive(cddar); /* cddar */ defprimitive(_75halt, &missing_prim); /* %halt */
defprimitive(cdddr); /* cdddr */ defprimitive(error, &missing_prim); /* error */
defprimitive(caaaar); /* caaaar */ defprimitive(cons, &_cons); /* cons */
defprimitive(caaadr); /* caaadr */ defprimitive(cell_91get, &missing_prim); /* cell-get */
defprimitive(caadar); /* caadar */ defprimitive(set_91global_67, &missing_prim); /* set-global! */
defprimitive(caaddr); /* caaddr */ defprimitive(set_91cell_67, &missing_prim); /* set-cell! */
defprimitive(cadaar); /* cadaar */ defprimitive(cell, &missing_prim); /* cell */
defprimitive(cadadr); /* cadadr */ defprimitive(eq_127, &_eq_127); /* eq? */
defprimitive(caddar); /* caddar */ defprimitive(eqv_127, &_eqv_127); /* eqv? */
defprimitive(cadddr); /* cadddr */ defprimitive(equal_127, &_equal_127); /* equal? */
defprimitive(cdaaar); /* cdaaar */ defprimitive(assoc, &missing_prim); /* assoc */
defprimitive(cdaadr); /* cdaadr */ defprimitive(assq, &missing_prim); /* assq */
defprimitive(cdadar); /* cdadar */ defprimitive(member, &missing_prim); /* member */
defprimitive(cdaddr); /* cdaddr */ defprimitive(length, &_length); /* length */
defprimitive(cddaar); /* cddaar */ defprimitive(set_91car_67, &_set_91_car_67); /* set-car! */
defprimitive(cddadr); /* cddadr */ defprimitive(set_91cdr_67, &_set_91_cdr_67); /* set-cdr! */
defprimitive(cdddar); /* cdddar */ defprimitive(car, &_car); /* car */
defprimitive(cddddr); /* cddddr */ defprimitive(cdr, &_cdr); /* cdr */
defprimitive(char_91_125integer); /* char->integer */ defprimitive(caar, &missing_prim); /* caar */
defprimitive(integer_91_125char); /* integer->char */ defprimitive(cadr, &_cadr); /* cadr */
defprimitive(string_91_125number); /* string->number */ defprimitive(cdar, &missing_prim); /* cdar */
defprimitive(string_91append); /* string-append */ defprimitive(cddr, &missing_prim); /* cddr */
defprimitive(string_91_125list); /* string->list */ defprimitive(caaar, &missing_prim); /* caaar */
defprimitive(list_91_125string); /* list->string */ defprimitive(caadr, &missing_prim); /* caadr */
defprimitive(string_91_125symbol); /* string->symbol */ defprimitive(cadar, &missing_prim); /* cadar */
defprimitive(symbol_91_125string); /* symbol->string */ defprimitive(caddr, &missing_prim); /* caddr */
defprimitive(number_91_125string); /* number->string */ defprimitive(cdaar, &missing_prim); /* cdaar */
defprimitive(boolean_127); /* boolean? */ defprimitive(cdadr, &missing_prim); /* cdadr */
defprimitive(char_127); /* char? */ defprimitive(cddar, &missing_prim); /* cddar */
defprimitive(eof_91object_127); /* eof-object? */ defprimitive(cdddr, &missing_prim); /* cdddr */
defprimitive(null_127); /* null? */ defprimitive(caaaar, &missing_prim); /* caaaar */
defprimitive(number_127); /* number? */ defprimitive(caaadr, &missing_prim); /* caaadr */
defprimitive(pair_127); /* pair? */ defprimitive(caadar, &missing_prim); /* caadar */
defprimitive(procedure_127); /* procedure? */ defprimitive(caaddr, &missing_prim); /* caaddr */
defprimitive(string_127); /* string? */ defprimitive(cadaar, &missing_prim); /* cadaar */
defprimitive(symbol_127); /* symbol? */ defprimitive(cadadr, &missing_prim); /* cadadr */
defprimitive(current_91input_91port); /* current-input-port */ defprimitive(caddar, &missing_prim); /* caddar */
defprimitive(open_91input_91file); /* open-input-file */ defprimitive(cadddr, &missing_prim); /* cadddr */
defprimitive(close_91input_91port); /* close-input-port */ defprimitive(cdaaar, &missing_prim); /* cdaaar */
defprimitive(read_91char); /* read-char */ defprimitive(cdaadr, &missing_prim); /* cdaadr */
defprimitive(peek_91char); /* peek-char */ defprimitive(cdadar, &missing_prim); /* cdadar */
defprimitive(write); /* write */ defprimitive(cdaddr, &missing_prim); /* cdaddr */
defprimitive(display); /* display */ defprimitive(cddaar, &missing_prim); /* cddaar */
defprimitive(cddadr, &missing_prim); /* cddadr */
defprimitive(cdddar, &missing_prim); /* cdddar */
defprimitive(cddddr, &missing_prim); /* cddddr */
defprimitive(char_91_125integer, &missing_prim); /* char->integer */
defprimitive(integer_91_125char, &missing_prim); /* integer->char */
defprimitive(string_91_125number, &missing_prim); /* string->number */
defprimitive(string_91append, &missing_prim); /* string-append */
defprimitive(string_91_125list, &missing_prim); /* string->list */
defprimitive(list_91_125string, &missing_prim); /* list->string */
defprimitive(string_91_125symbol, &missing_prim); /* string->symbol */
defprimitive(symbol_91_125string, &missing_prim); /* symbol->string */
defprimitive(number_91_125string, &missing_prim); /* number->string */
defprimitive(boolean_127, &missing_prim); /* boolean? */
defprimitive(char_127, &missing_prim); /* char? */
defprimitive(eof_91object_127, &missing_prim); /* eof-object? */
defprimitive(null_127, &_null_127); /* null? */
defprimitive(number_127, &missing_prim); /* number? */
defprimitive(pair_127, &missing_prim); /* pair? */
defprimitive(procedure_127, &missing_prim); /* procedure? */
defprimitive(string_127, &missing_prim); /* string? */
defprimitive(symbol_127, &missing_prim); /* symbol? */
defprimitive(current_91input_91port, &missing_prim); /* current-input-port */
defprimitive(open_91input_91file, &missing_prim); /* open-input-file */
defprimitive(close_91input_91port, &missing_prim); /* close-input-port */
defprimitive(read_91char, &missing_prim); /* read-char */
defprimitive(peek_91char, &missing_prim); /* peek-char */
defprimitive(write, &missing_prim); /* write */
defprimitive(display, &missing_prim); /* display */
/* -------------------------------------------- */
/* All constant-size objects */ /* All constant-size objects */
typedef union { typedef union {
@ -1098,12 +1136,11 @@ static void dispatch(int argc, closure func, object cont, object args) {
* Execute primitive function using given args, and pass result to cont * Execute primitive function using given args, and pass result to cont
*/ */
static void dispatch_primitive(object func, object cont, object args) { static void dispatch_primitive(object func, object cont, object args) {
object result; ((primitive_type *)func)->fn(cont, args);
common_type buf; }
// TODO: should probably check arg counts and error out if needed // TODO: should probably check arg counts and error out if needed
// TODO: use *primitives* to make a list of all missing prims below // TODO: use *primitives* to make a list of all missing prims below
/*
if (func == primitive_cons) { if (func == primitive_cons) {
make_cons(c, car(args), cadr(args)); make_cons(c, car(args), cadr(args));
buf.cons_t = c; buf.cons_t = c;
@ -1111,6 +1148,8 @@ static void dispatch_primitive(object func, object cont, object args) {
} else if (func == primitive_length) { } else if (func == primitive_length) {
buf.integer_t = Cyc_length(car (args)); buf.integer_t = Cyc_length(car (args));
result = &buf; result = &buf;
} else if (func == primitive_eqv_127) {
result = Cyc_eq(car(args), cadr(args));
} else if (func == primitive_eq_127) { } else if (func == primitive_eq_127) {
result = Cyc_eq(car(args), cadr(args)); result = Cyc_eq(car(args), cadr(args));
} else if (func == primitive_equal_127) { } else if (func == primitive_equal_127) {
@ -1118,6 +1157,15 @@ static void dispatch_primitive(object func, object cont, object args) {
} else if (func == primitive_null_127) { } else if (func == primitive_null_127) {
object tmp = car(args); object tmp = car(args);
result = Cyc_is_null(tmp); result = Cyc_is_null(tmp);
} else if (func == primitive_pair_127) { result = Cyc_is_cons(car(args));
} else if (func == primitive_boolean_127) { result = Cyc_is_boolean(car(args));
} else if (func == primitive_char_127) { result = Cyc_is_char(car(args));
} else if (func == primitive_eof_91object_127) { result = Cyc_is_eof_object(car(args));
} else if (func == primitive_number_127) { result = Cyc_is_number(car(args));
} else if (func == primitive_procedure_127) { result = Cyc_is_procedure(car(args));
} else if (func == primitive_string_127) { result = Cyc_is_string(car(args));
} else if (func == primitive_symbol_127) { result = Cyc_is_symbol(car(args));
} else if (func == primitive_Cyc_91cvar_127) { result = Cyc_is_cvar(car(args));
} else if (func == primitive__87) { } else if (func == primitive__87) {
__sum(i, car(args), cadr(args)); __sum(i, car(args), cadr(args));
buf.integer_t = i; buf.integer_t = i;
@ -1140,12 +1188,8 @@ static void dispatch_primitive(object func, object cont, object args) {
printf("Unrecognized primitive function: %s\n", ((symbol_type *)func)->pname); printf("Unrecognized primitive function: %s\n", ((symbol_type *)func)->pname);
exit(1); exit(1);
} }
// Cyc-global-vars
// Cyc-get-cvar // Cyc-get-cvar
// Cyc-set-cvar! // Cyc-set-cvar!
// Cyc-cvar? ;; Cyclone-specific
// has-cycle?
// +
// - // -
// * // *
// / // /
@ -1157,23 +1201,14 @@ static void dispatch_primitive(object func, object cont, object args) {
// apply // apply
// %halt // %halt
// error // error
// cons
// cell-get // cell-get
// set-global! // set-global!
// set-cell! // set-cell!
// cell // cell
// eq?
// eqv?
// equal?
// assoc // assoc
// assq // assq
// member // member
// length // caar cdar cddr
// set-car!
// set-cdr!
// car
// cdr
// caar cadr cdar cddr
// caaar caadr cadar caddr cdaar cdadr cddar cdddr // caaar caadr cadar caddr cdaar cdadr cddar cdddr
// caaaar caaadr caadar caaddr cadaar cadadr // caaaar caaadr caadar caaddr cadaar cadadr
// caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr // caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
@ -1186,15 +1221,6 @@ static void dispatch_primitive(object func, object cont, object args) {
// string->symbol // string->symbol
// symbol->string // symbol->string
// number->string // number->string
// boolean?
// char?
// eof-object?
// null?
// number?
// pair?
// procedure?
// string?
// symbol?
// current-input-port // current-input-port
// open-input-file // open-input-file
// close-input-port // close-input-port
@ -1204,6 +1230,7 @@ static void dispatch_primitive(object func, object cont, object args) {
// display)) // display))
return_funcall1(cont, result); return_funcall1(cont, result);
} }
*/
/* /*
* *