* module/language/c99/compiler.mes (expr->arg): Handle char arguments.
* doc/examples/cons-mes.c (struct function): Add name field.
* doc/examples/mini-mes.c: Likewise.
(mes_builtins): Update.
* mes.c: Likewise.
* build-aux/mes-snarf.scm: Update.
(string-append
(format #f "SCM ~a (~a);\n" (.name f) (.formals f))
(if GCC?
- (format #f "function_t fun_~a = {.function~a=&~a, .arity=~a};\n" (.name f) arity (.name f) n)
- (format #f "function_t fun_~a = {&~a, ~a};\n" (.name f) (.name f) n))
+ (format #f "function_t fun_~a = {.function~a=&~a, .arity=~a, .name=~s};\n" (.name f) arity (.name f) n (function-scm-name f))
+ (format #f "function_t fun_~a = {&~a, ~a, ~s};\n" (.name f) (.name f) n (function-scm-name f)))
(if GCC?
- (format #f "scm ~a = {FUNCTION, .name=~S, .function=0};\n" (function-builtin-name f) (function-scm-name f))
- (format #f "scm ~a = {FUNCTION, ~S, 0};\n" (function-builtin-name f) (function-scm-name f)))
+ (format #f "scm ~a = {FUNCTION, .name=0, .function=0};\n" (function-builtin-name f))
+ (format #f "scm ~a = {FUNCTION, 0, 0};\n" (function-builtin-name f)))
(format #f "SCM cell_~a;\n\n" (.name f)))))
(define (function->source f i)
(define (function->environment f i)
(string-append
- (format #f "scm_~a.string = cstring_to_list (scm_~a.name);\n" (.name f) (.name f))
+ (format #f "scm_~a.string = cstring_to_list (fun_~a.name);\n" (.name f) (.name f))
(format #f "g_cells[cell_~a].string = MAKE_STRING (scm_~a.string);\n" (.name f) (.name f))
(format #f "a = acons (make_symbol (scm_~a.string), ~a, a);\n\n" (.name f) (function-cell-name f))))
functionn_t functionn;
} NYACC;
int arity;
+ char const *name;
} function_t;
struct scm;
typedef struct scm_struct {
enum type_t type;
union {
- char const *name;
+ char const* name;
SCM string;
SCM car;
SCM ref;
(list (lambda (f g ta t d)
(i386:push-accu)))))))
+
+ ((p-expr (char ,char))
+ (let ((char (char->integer (car (string->list char)))))
+ (clone info
+ #:text (append text
+ (list (lambda (f g ta t d)
+ (append
+ (i386:value->accu char)
+ (i386:push-accu)))))))
+ )
;; f (0 + x)
;;; aargh
;;;((add (p-expr (fixed ,value)) (d-sel (ident cdr) (array-ref (p-expr (ident x)) (p-expr (ident g_cells))))))
(list (lambda (f g ta t d)
(i386:value->accu value)))))))
- ((p-expr (char ,value))
- (let ((value (char->integer (car (string->list value)))))
+ ((p-expr (char ,char))
+ (let ((char (char->integer (car (string->list char)))))
(clone info #:text
(append text
(list (lambda (f g ta t d)
- (i386:value->accu value)))))))
+ (i386:value->accu char)))))))
((p-expr (ident ,name))
(clone info #:text
struct function {
int (*function) (void);
int arity;
+ char *name;
};
struct scm *g_cells = arena;
//FIXME
SCM make_cell (SCM type, SCM car, SCM cdr);
#endif
-struct function fun_make_cell = {&make_cell, 3};
+struct function fun_make_cell = {&make_cell,3,"make-cell"};
struct scm scm_make_cell = {TFUNCTION,0,0};
//, "make-cell", 0};
SCM cell_make_cell;
//FIXME
SCM cons (SCM x, SCM y);
#endif
-struct function fun_cons = {&cons, 2};
+struct function fun_cons = {&cons,2,"cons"};
struct scm scm_cons = {TFUNCTION,0,0};
// "cons", 0};
SCM cell_cons;
//FIXME
SCM car (SCM x);
#endif
-struct function fun_car = {&car, 1};
+struct function fun_car = {&car,1,"car"};
struct scm scm_car = {TFUNCTION,0,0};
// "car", 0};
SCM cell_car;
//FIXME
SCM cdr (SCM x);
#endif
-struct function fun_cdr = {&cdr, 1};
+struct function fun_cdr = {&cdr,1,"cdr"};
struct scm scm_cdr = {TFUNCTION,0,0};
// "cdr", 0};
SCM cell_cdr;
// SCM eq_p (SCM x, SCM y);
-// struct function fun_eq_p = {&eq_p, 2};
-// scm scm_eq_p = {TFUNCTION,0,0};// "eq?", 0};
+// struct function fun_eq_p = {&eq_p,2,"eq?"};
+// scm scm_eq_p = {TFUNCTION,0,0};
// SCM cell_eq_p;
#define TYPE(x) (g_cells[x].type)
return x ? x : make_symbol_ (s);
}
-SCM
-cstring_to_list (char const* s)
-{
- SCM p = cell_nil;
- int i = strlen (s);
- while (i--)
- p = cons (MAKE_CHAR (s[i]), p);
- return p;
-}
-
SCM
acons (SCM key, SCM value, SCM alist)
{
gc_init_cells ()
{
return 0;
-// g_cells = (scm *)malloc (2*ARENA_SIZE*sizeof(scm));
-
-// #if __NYACC__ || FIXME_NYACC
-// TYPE (0) = TVECTOR;
-// // #else
-// // TYPE (0) = VECTOR;
-// #endif
-// LENGTH (0) = 1000;
-// VECTOR (0) = 0;
-// g_cells++;
-// TYPE (0) = CHAR;
-// VALUE (0) = 'c';
}
// INIT NEWS
SCM a = cell_nil;
-#if __GNUC__ && 0
- //#include "mes.symbol-names.i"
-#else
-// g_cells[cell_nil].car = cstring_to_list (scm_nil.name);
-// g_cells[cell_f].car = cstring_to_list (scm_f.name);
-// g_cells[cell_t].car = cstring_to_list (scm_t.name);
-// g_cells[cell_dot].car = cstring_to_list (scm_dot.name);
-// g_cells[cell_arrow].car = cstring_to_list (scm_arrow.name);
-// g_cells[cell_undefined].car = cstring_to_list (scm_undefined.name);
-// g_cells[cell_unspecified].car = cstring_to_list (scm_unspecified.name);
-// g_cells[cell_closure].car = cstring_to_list (scm_closure.name);
-// g_cells[cell_circular].car = cstring_to_list (scm_circular.name);
-// g_cells[cell_begin].car = cstring_to_list (scm_begin.name);
-#endif
-
- // a = acons (cell_symbol_mes_version, MAKE_STRING (cstring_to_list (VERSION)), a);
- // a = acons (cell_symbol_mes_prefix, MAKE_STRING (cstring_to_list (PREFIX)), a);
-
a = acons (cell_symbol_dot, cell_dot, a);
a = acons (cell_symbol_begin, cell_begin, a);
a = acons (cell_closure, a, a);
- // a = acons (cell_symbol_call_with_current_continuation, cell_call_with_current_continuation, a);
- // a = acons (cell_symbol_sc_expand, cell_f, a);
-
return a;
}
// #include "posix.environment.i"
// #include "reader.environment.i"
#else
-
scm_make_cell.cdr = g_function;
g_functions[g_function++] = fun_make_cell;
cell_make_cell = g_free++;
g_functions[g_function++] = fun_cdr;
cell_cdr = g_free++;
g_cells[cell_cdr] = scm_cdr;
-
-// scm_make_cell.string = cstring_to_list (scm_make_cell.name);
-// g_cells[cell_make_cell].string = MAKE_STRING (scm_make_cell.string);
-// a = acons (make_symbol (scm_make_cell.string), cell_make_cell, a);
-
-// scm_cons.string = cstring_to_list (scm_cons.name);
-// g_cells[cell_cons].string = MAKE_STRING (scm_cons.string);
-// a = acons (make_symbol (scm_cons.string), cell_cons, a);
-
-// scm_car.string = cstring_to_list (scm_car.name);
-// g_cells[cell_car].string = MAKE_STRING (scm_car.string);
-// a = acons (make_symbol (scm_car.string), cell_car, a);
-
-// scm_cdr.string = cstring_to_list (scm_cdr.name);
-// g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string);
-// a = acons (make_symbol (scm_cdr.string), cell_cdr, a);
#endif
return a;
}
struct function {
int (*function) (void);
int arity;
+ char *name;
};
struct scm *g_cells = arena;
//FIXME
SCM make_cell (SCM type, SCM car, SCM cdr);
#endif
-struct function fun_make_cell = {&make_cell, 3};
-
-#if 1
-struct scm scm_make_cell = {TFUNCTION,"make-cell",0};
-#else
+struct function fun_make_cell = {&make_cell,3,"make-cell"};
struct scm scm_make_cell = {TFUNCTION,0,0};
-#endif
SCM cell_make_cell;
#if __GNUC__
//FIXME
SCM cons (SCM x, SCM y);
#endif
-struct function fun_cons = {&cons, 2};
-#if __GNUC__
-struct scm scm_cons = {TFUNCTION,"cons",0};
-#else
+struct function fun_cons = {&cons,2,"cons"};
struct scm scm_cons = {TFUNCTION,0,0};
-#endif
SCM cell_cons;
#if __GNUC__
//FIXME
SCM car (SCM x);
#endif
-struct function fun_car = {&car, 1};
-#if __GNUC__
-struct scm scm_car = {TFUNCTION,"car",0};
-#else
+struct function fun_car = {&car,1,"car"};
struct scm scm_car = {TFUNCTION,0,0};
-#endif
SCM cell_car;
#if __GNUC__
//FIXME
SCM cdr (SCM x);
#endif
-struct function fun_cdr = {&cdr, 1};
-#if __GNUC__
-struct scm scm_cdr = {TFUNCTION,"cdr",0};
-#else
+struct function fun_cdr = {&cdr,1,"cdr"};
struct scm scm_cdr = {TFUNCTION,0,0};
-#endif
SCM cell_cdr;
// SCM eq_p (SCM x, SCM y);
SCM
cstring_to_list (char const* s)
{
+ char *x = s;
SCM p = cell_nil;
int i = strlen (s);
while (i--)
- p = cons (MAKE_CHAR (s[i]), p);
+ {
+#if 0
+ //FIXME
+ p = cons (MAKE_CHAR (s[i]), p);
+#else
+ p = cons (MAKE_CHAR (*x), p);
+ x++;
+#endif
+ }
return p;
}
//g_cells[cell_make_cell].string = MAKE_STRING (scm_make_cell.string);
//a = acons (make_symbol (scm_make_cell.string), cell_make_cell, a);
puts ("00\n");
-scm_make_cell.car = cstring_to_list (scm_make_cell.car);
+scm_make_cell.car = cstring_to_list (fun_make_cell.name);
puts ("01\n");
g_cells[cell_make_cell].car = MAKE_STRING (scm_make_cell.car);
puts ("02\n");
//scm_cons.string = cstring_to_list (scm_cons.name);
//g_cells[cell_cons].string = MAKE_STRING (scm_cons.string);
//a = acons (make_symbol (scm_cons.string), cell_cons, a);
-scm_cons.car = cstring_to_list (scm_cons.car);
+scm_cons.car = cstring_to_list (fun_cons.name);
g_cells[cell_cons].car = MAKE_STRING (scm_cons.car);
a = acons (make_symbol (scm_cons.car), cell_cons, a);
//scm_car.string = cstring_to_list (scm_car.name);
//g_cells[cell_car].string = MAKE_STRING (scm_car.string);
//a = acons (make_symbol (scm_cons.string), cell_cons, a);
-scm_car.car = cstring_to_list (scm_car.car);
+scm_car.car = cstring_to_list (fun_car.name);
g_cells[cell_car].car = MAKE_STRING (scm_car.car);
a = acons (make_symbol (scm_cons.car), cell_cons, a);
//scm_cdr.string = cstring_to_list (scm_cdr.name);
//g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string);
//a = acons (make_symbol (scm_cdr.string), cell_cdr, a);
-scm_cdr.car = cstring_to_list (scm_cdr.car);
+scm_cdr.car = cstring_to_list (fun_cdr.name);
g_cells[cell_cdr].car = MAKE_STRING (scm_cdr.car);
a = acons (make_symbol (scm_cdr.car), cell_cdr, a);