417 lines
22 KiB
C
417 lines
22 KiB
C
|
/* Built-in primitives, Define_Primitive().
|
||
|
|
*/
|
||
|
|
|
||
|
|
#include "kernel.h"
|
||
|
|
|
||
|
|
struct Prim_Init {
|
||
|
|
Object (*fun)();
|
||
|
|
char *name;
|
||
|
|
int minargs, maxargs;
|
||
|
|
enum discipline disc;
|
||
|
|
} Primitives[] = {
|
||
|
|
|
||
|
|
/* autoload.c:
|
||
|
|
*/
|
||
|
|
P_Autoload, "autoload", 2, 2, EVAL,
|
||
|
|
|
||
|
|
/* bool.c:
|
||
|
|
*/
|
||
|
|
P_Booleanp, "boolean?", 1, 1, EVAL,
|
||
|
|
P_Not, "not", 1, 1, EVAL,
|
||
|
|
P_Eq, "eq?", 2, 2, EVAL,
|
||
|
|
P_Eqv, "eqv?", 2, 2, EVAL,
|
||
|
|
P_Equal, "equal?", 2, 2, EVAL,
|
||
|
|
P_Empty_List_Is_False, "empty-list-is-false-for-backward-compatibility",
|
||
|
|
1, 1, EVAL,
|
||
|
|
|
||
|
|
/* char.c:
|
||
|
|
*/
|
||
|
|
P_Charp, "char?", 1, 1, EVAL,
|
||
|
|
P_Char_To_Integer, "char->integer", 1, 1, EVAL,
|
||
|
|
P_Integer_To_Char, "integer->char", 1, 1, EVAL,
|
||
|
|
P_Char_Upper_Casep, "char-upper-case?", 1, 1, EVAL,
|
||
|
|
P_Char_Lower_Casep, "char-lower-case?", 1, 1, EVAL,
|
||
|
|
P_Char_Alphabeticp, "char-alphabetic?", 1, 1, EVAL,
|
||
|
|
P_Char_Numericp, "char-numeric?", 1, 1, EVAL,
|
||
|
|
P_Char_Whitespacep, "char-whitespace?", 1, 1, EVAL,
|
||
|
|
P_Char_Upcase, "char-upcase", 1, 1, EVAL,
|
||
|
|
P_Char_Downcase, "char-downcase", 1, 1, EVAL,
|
||
|
|
P_Char_Eq, "char=?", 2, 2, EVAL,
|
||
|
|
P_Char_Less, "char<?", 2, 2, EVAL,
|
||
|
|
P_Char_Greater, "char>?", 2, 2, EVAL,
|
||
|
|
P_Char_Eq_Less, "char<=?", 2, 2, EVAL,
|
||
|
|
P_Char_Eq_Greater, "char>=?", 2, 2, EVAL,
|
||
|
|
P_Char_CI_Eq, "char-ci=?", 2, 2, EVAL,
|
||
|
|
P_Char_CI_Less, "char-ci<?", 2, 2, EVAL,
|
||
|
|
P_Char_CI_Greater, "char-ci>?", 2, 2, EVAL,
|
||
|
|
P_Char_CI_Eq_Less, "char-ci<=?", 2, 2, EVAL,
|
||
|
|
P_Char_CI_Eq_Greater,"char-ci>=?", 2, 2, EVAL,
|
||
|
|
|
||
|
|
/* cont.c:
|
||
|
|
*/
|
||
|
|
P_Control_Pointp, "control-point?", 1, 1, EVAL,
|
||
|
|
P_Call_With_Current_Continuation,
|
||
|
|
"call-with-current-continuation", 1, 1, EVAL,
|
||
|
|
P_Dynamic_Wind, "dynamic-wind", 3, 3, EVAL,
|
||
|
|
P_Control_Point_Environment,
|
||
|
|
"control-point-environment", 1, 1, EVAL,
|
||
|
|
|
||
|
|
/* debug.c:
|
||
|
|
*/
|
||
|
|
P_Backtrace_List, "backtrace-list", 0, 1, VARARGS,
|
||
|
|
|
||
|
|
/* dump.c:
|
||
|
|
*/
|
||
|
|
#ifdef CAN_DUMP
|
||
|
|
P_Dump, "dump", 1, 1, EVAL,
|
||
|
|
#endif
|
||
|
|
|
||
|
|
/* env.c:
|
||
|
|
*/
|
||
|
|
P_Environmentp, "environment?", 1, 1, EVAL,
|
||
|
|
P_The_Environment, "the-environment", 0, 0, EVAL,
|
||
|
|
P_Global_Environment,"global-environment", 0, 0, EVAL,
|
||
|
|
P_Define, "define", 1, MANY, NOEVAL,
|
||
|
|
P_Define_Macro, "define-macro", 1, MANY, NOEVAL,
|
||
|
|
P_Set, "set!", 2, 2, NOEVAL,
|
||
|
|
P_Environment_To_List,
|
||
|
|
"environment->list", 1, 1, EVAL,
|
||
|
|
P_Boundp, "bound?", 1, 1, EVAL,
|
||
|
|
|
||
|
|
/* error.c:
|
||
|
|
*/
|
||
|
|
P_Error, "error", 2, MANY, VARARGS,
|
||
|
|
P_Reset, "reset", 0, 0, EVAL,
|
||
|
|
|
||
|
|
/* exception.c:
|
||
|
|
*/
|
||
|
|
P_Disable_Interrupts,"disable-interrupts", 0, 0, EVAL,
|
||
|
|
P_Enable_Interrupts, "enable-interrupts", 0, 0, EVAL,
|
||
|
|
|
||
|
|
/* feature.c:
|
||
|
|
*/
|
||
|
|
P_Features, "features", 0, 0, EVAL,
|
||
|
|
P_Featurep, "feature?", 1, 1, EVAL,
|
||
|
|
P_Provide, "provide", 1, 1, EVAL,
|
||
|
|
P_Require, "require", 1, 3, VARARGS,
|
||
|
|
|
||
|
|
/* heap.c:
|
||
|
|
*/
|
||
|
|
P_Collect, "collect", 0, 0, EVAL,
|
||
|
|
P_Garbage_Collect_Status, "garbage-collect-status", 0, 2, VARARGS,
|
||
|
|
#ifdef GENERATIONAL_GC
|
||
|
|
P_Collect_Incremental, "collect-incremental", 0, 0, EVAL,
|
||
|
|
#endif
|
||
|
|
|
||
|
|
|
||
|
|
/* io.c:
|
||
|
|
*/
|
||
|
|
P_Port_File_Name, "port-file-name", 1, 1, EVAL,
|
||
|
|
P_Port_Line_Number, "port-line-number", 1, 1, EVAL,
|
||
|
|
P_Eof_Objectp, "eof-object?", 1, 1, EVAL,
|
||
|
|
P_Current_Input_Port,
|
||
|
|
"current-input-port", 0, 0, EVAL,
|
||
|
|
P_Current_Output_Port,
|
||
|
|
"current-output-port", 0, 0, EVAL,
|
||
|
|
P_Input_Portp, "input-port?", 1, 1, EVAL,
|
||
|
|
P_Output_Portp, "output-port?", 1, 1, EVAL,
|
||
|
|
P_Open_Input_File, "open-input-file", 1, 1, EVAL,
|
||
|
|
P_Open_Output_File, "open-output-file", 1, 1, EVAL,
|
||
|
|
P_Open_Input_Output_File, "open-input-output-file", 1, 1, EVAL,
|
||
|
|
P_Close_Input_Port, "close-input-port", 1, 1, EVAL,
|
||
|
|
P_Close_Output_Port, "close-output-port", 1, 1, EVAL,
|
||
|
|
P_With_Input_From_File, "with-input-from-file", 2, 2, EVAL,
|
||
|
|
P_With_Output_To_File, "with-output-to-file", 2, 2, EVAL,
|
||
|
|
P_Call_With_Input_File, "call-with-input-file", 2, 2, EVAL,
|
||
|
|
P_Call_With_Output_File, "call-with-output-file", 2, 2, EVAL,
|
||
|
|
P_Open_Input_String, "open-input-string", 1, 1, EVAL,
|
||
|
|
P_Open_Output_String,"open-output-string", 0, 0, EVAL,
|
||
|
|
P_Tilde_Expand, "tilde-expand", 1, 1, EVAL,
|
||
|
|
P_File_Existsp, "file-exists?", 1, 1, EVAL,
|
||
|
|
|
||
|
|
/* load.c:
|
||
|
|
*/
|
||
|
|
P_Load, "load", 1, 2, VARARGS,
|
||
|
|
|
||
|
|
/* list.c:
|
||
|
|
*/
|
||
|
|
P_Cons, "cons", 2, 2, EVAL,
|
||
|
|
P_Car, "car", 1, 1, EVAL,
|
||
|
|
P_Cdr, "cdr", 1, 1, EVAL,
|
||
|
|
P_Caar, "caar", 1, 1, EVAL,
|
||
|
|
P_Cadr, "cadr", 1, 1, EVAL,
|
||
|
|
P_Cdar, "cdar", 1, 1, EVAL,
|
||
|
|
P_Cddr, "cddr", 1, 1, EVAL,
|
||
|
|
|
||
|
|
P_Caaar, "caaar", 1, 1, EVAL,
|
||
|
|
P_Caadr, "caadr", 1, 1, EVAL,
|
||
|
|
P_Cadar, "cadar", 1, 1, EVAL,
|
||
|
|
P_Caddr, "caddr", 1, 1, EVAL,
|
||
|
|
P_Cdaar, "cdaar", 1, 1, EVAL,
|
||
|
|
P_Cdadr, "cdadr", 1, 1, EVAL,
|
||
|
|
P_Cddar, "cddar", 1, 1, EVAL,
|
||
|
|
P_Cdddr, "cdddr", 1, 1, EVAL,
|
||
|
|
|
||
|
|
P_Caaaar, "caaaar", 1, 1, EVAL,
|
||
|
|
P_Caaadr, "caaadr", 1, 1, EVAL,
|
||
|
|
P_Caadar, "caadar", 1, 1, EVAL,
|
||
|
|
P_Caaddr, "caaddr", 1, 1, EVAL,
|
||
|
|
P_Cadaar, "cadaar", 1, 1, EVAL,
|
||
|
|
P_Cadadr, "cadadr", 1, 1, EVAL,
|
||
|
|
P_Caddar, "caddar", 1, 1, EVAL,
|
||
|
|
P_Cadddr, "cadddr", 1, 1, EVAL,
|
||
|
|
P_Cdaaar, "cdaaar", 1, 1, EVAL,
|
||
|
|
P_Cdaadr, "cdaadr", 1, 1, EVAL,
|
||
|
|
P_Cdadar, "cdadar", 1, 1, EVAL,
|
||
|
|
P_Cdaddr, "cdaddr", 1, 1, EVAL,
|
||
|
|
P_Cddaar, "cddaar", 1, 1, EVAL,
|
||
|
|
P_Cddadr, "cddadr", 1, 1, EVAL,
|
||
|
|
P_Cdddar, "cdddar", 1, 1, EVAL,
|
||
|
|
P_Cddddr, "cddddr", 1, 1, EVAL,
|
||
|
|
|
||
|
|
P_Cxr, "cxr", 2, 2, EVAL,
|
||
|
|
P_Nullp, "null?", 1, 1, EVAL,
|
||
|
|
P_Pairp, "pair?", 1, 1, EVAL,
|
||
|
|
P_Listp, "list?", 1, 1, EVAL,
|
||
|
|
P_Set_Car, "set-car!", 2, 2, EVAL,
|
||
|
|
P_Set_Cdr, "set-cdr!", 2, 2, EVAL,
|
||
|
|
P_Assq, "assq", 2, 2, EVAL,
|
||
|
|
P_Assv, "assv", 2, 2, EVAL,
|
||
|
|
P_Assoc, "assoc", 2, 2, EVAL,
|
||
|
|
P_Memq, "memq", 2, 2, EVAL,
|
||
|
|
P_Memv, "memv", 2, 2, EVAL,
|
||
|
|
P_Member, "member", 2, 2, EVAL,
|
||
|
|
P_Make_List, "make-list", 2, 2, EVAL,
|
||
|
|
P_List, "list", 0, MANY, VARARGS,
|
||
|
|
P_Length, "length", 1, 1, EVAL,
|
||
|
|
P_Append, "append", 0, MANY, VARARGS,
|
||
|
|
P_Append_Set, "append!", 0, MANY, VARARGS,
|
||
|
|
P_Last_Pair, "last-pair", 1, 1, EVAL,
|
||
|
|
P_Reverse, "reverse", 1, 1, EVAL,
|
||
|
|
P_Reverse_Set, "reverse!", 1, 1, EVAL,
|
||
|
|
P_List_Tail, "list-tail", 2, 2, EVAL,
|
||
|
|
P_List_Ref, "list-ref", 2, 2, EVAL,
|
||
|
|
|
||
|
|
/* main.c:
|
||
|
|
*/
|
||
|
|
P_Command_Line_Args, "command-line-args", 0, 0, EVAL,
|
||
|
|
P_Exit, "exit", 0, 1, VARARGS,
|
||
|
|
|
||
|
|
/* math.c:
|
||
|
|
*/
|
||
|
|
P_Number_To_String, "number->string", 1, 2, VARARGS,
|
||
|
|
P_Numberp, "number?", 1, 1, EVAL,
|
||
|
|
P_Complexp, "complex?", 1, 1, EVAL,
|
||
|
|
P_Realp, "real?", 1, 1, EVAL,
|
||
|
|
P_Rationalp, "rational?", 1, 1, EVAL,
|
||
|
|
P_Integerp, "integer?", 1, 1, EVAL,
|
||
|
|
P_Zerop, "zero?", 1, 1, EVAL,
|
||
|
|
P_Positivep, "positive?", 1, 1, EVAL,
|
||
|
|
P_Negativep, "negative?", 1, 1, EVAL,
|
||
|
|
P_Oddp, "odd?", 1, 1, EVAL,
|
||
|
|
P_Evenp, "even?", 1, 1, EVAL,
|
||
|
|
P_Exactp, "exact?", 1, 1, EVAL,
|
||
|
|
P_Inexactp, "inexact?", 1, 1, EVAL,
|
||
|
|
P_Exact_To_Inexact, "exact->inexact", 1, 1, EVAL,
|
||
|
|
P_Inexact_To_Exact, "inexact->exact", 1, 1, EVAL,
|
||
|
|
P_Generic_Less, "<", 1, MANY, VARARGS,
|
||
|
|
P_Generic_Greater, ">", 1, MANY, VARARGS,
|
||
|
|
P_Generic_Equal, "=", 1, MANY, VARARGS,
|
||
|
|
P_Generic_Eq_Less, "<=", 1, MANY, VARARGS,
|
||
|
|
P_Generic_Eq_Greater,">=", 1, MANY, VARARGS,
|
||
|
|
P_Inc, "1+", 1, 1, EVAL,
|
||
|
|
P_Dec, "-1+", 1, 1, EVAL,
|
||
|
|
P_Dec, "1-", 1, 1, EVAL,
|
||
|
|
P_Generic_Plus, "+", 0, MANY, VARARGS,
|
||
|
|
P_Generic_Minus, "-", 1, MANY, VARARGS,
|
||
|
|
P_Generic_Multiply, "*", 0, MANY, VARARGS,
|
||
|
|
P_Generic_Divide, "/", 1, MANY, VARARGS,
|
||
|
|
P_Abs, "abs", 1, 1, EVAL,
|
||
|
|
P_Quotient, "quotient", 2, 2, EVAL,
|
||
|
|
P_Remainder, "remainder", 2, 2, EVAL,
|
||
|
|
P_Modulo, "modulo", 2, 2, EVAL,
|
||
|
|
P_Gcd, "gcd", 0, MANY, VARARGS,
|
||
|
|
P_Lcm, "lcm", 0, MANY, VARARGS,
|
||
|
|
P_Floor, "floor", 1, 1, EVAL,
|
||
|
|
P_Ceiling, "ceiling", 1, 1, EVAL,
|
||
|
|
P_Truncate, "truncate", 1, 1, EVAL,
|
||
|
|
P_Round, "round", 1, 1, EVAL,
|
||
|
|
P_Sqrt, "sqrt", 1, 1, EVAL,
|
||
|
|
P_Exp, "exp", 1, 1, EVAL,
|
||
|
|
P_Log, "log", 1, 1, EVAL,
|
||
|
|
P_Sin, "sin", 1, 1, EVAL,
|
||
|
|
P_Cos, "cos", 1, 1, EVAL,
|
||
|
|
P_Tan, "tan", 1, 1, EVAL,
|
||
|
|
P_Asin, "asin", 1, 1, EVAL,
|
||
|
|
P_Acos, "acos", 1, 1, EVAL,
|
||
|
|
P_Atan, "atan", 1, 2, VARARGS,
|
||
|
|
P_Min, "min", 1, MANY, VARARGS,
|
||
|
|
P_Max, "max", 1, MANY, VARARGS,
|
||
|
|
P_Random, "random", 0, 0, EVAL,
|
||
|
|
P_Srandom, "srandom", 1, 1, EVAL,
|
||
|
|
|
||
|
|
/* prim.c:
|
||
|
|
*/
|
||
|
|
|
||
|
|
/* print.c:
|
||
|
|
*/
|
||
|
|
P_Write, "write", 1, 2, VARARGS,
|
||
|
|
P_Display, "display", 1, 2, VARARGS,
|
||
|
|
P_Write_Char, "write-char", 1, 2, VARARGS,
|
||
|
|
P_Newline, "newline", 0, 1, VARARGS,
|
||
|
|
P_Print, "print", 1, 2, VARARGS,
|
||
|
|
P_Clear_Output_Port, "clear-output-port", 0, 1, VARARGS,
|
||
|
|
P_Flush_Output_Port, "flush-output-port", 0, 1, VARARGS,
|
||
|
|
P_Get_Output_String, "get-output-string", 1, 1, EVAL,
|
||
|
|
P_Format, "format", 2, MANY, VARARGS,
|
||
|
|
|
||
|
|
/* proc.c:
|
||
|
|
*/
|
||
|
|
P_Procedurep, "procedure?", 1, 1, EVAL,
|
||
|
|
P_Primitivep, "primitive?", 1, 1, EVAL,
|
||
|
|
P_Compoundp, "compound?", 1, 1, EVAL,
|
||
|
|
P_Macrop, "macro?", 1, 1, EVAL,
|
||
|
|
P_Eval, "eval", 1, 2, VARARGS,
|
||
|
|
P_Apply, "apply", 2, MANY, VARARGS,
|
||
|
|
P_Lambda, "lambda", 2, MANY, NOEVAL,
|
||
|
|
P_Procedure_Environment,
|
||
|
|
"procedure-environment", 1, 1, EVAL,
|
||
|
|
P_Procedure_Lambda, "procedure-lambda", 1, 1, EVAL,
|
||
|
|
P_Map, "map", 2, MANY, VARARGS,
|
||
|
|
P_For_Each, "for-each", 2, MANY, VARARGS,
|
||
|
|
P_Macro, "macro", 2, MANY, NOEVAL,
|
||
|
|
P_Macro_Body, "macro-body", 1, 1, EVAL,
|
||
|
|
P_Macro_Expand, "macro-expand", 1, 1, EVAL,
|
||
|
|
|
||
|
|
/* promise.c:
|
||
|
|
*/
|
||
|
|
P_Delay, "delay", 1, 1, NOEVAL,
|
||
|
|
P_Force, "force", 1, 1, EVAL,
|
||
|
|
P_Promisep, "promise?", 1, 1, EVAL,
|
||
|
|
P_Promise_Environment,
|
||
|
|
"promise-environment", 1, 1, EVAL,
|
||
|
|
|
||
|
|
/* read.c:
|
||
|
|
*/
|
||
|
|
P_Clear_Input_Port, "clear-input-port", 0, 1, VARARGS,
|
||
|
|
P_Read, "read", 0, 1, VARARGS,
|
||
|
|
P_Read_Char, "read-char", 0, 1, VARARGS,
|
||
|
|
P_Read_String, "read-string", 0, 1, VARARGS,
|
||
|
|
P_Unread_Char, "unread-char", 1, 2, VARARGS,
|
||
|
|
P_Peek_Char, "peek-char", 0, 1, VARARGS,
|
||
|
|
P_Char_Readyp, "char-ready?", 0, 1, VARARGS,
|
||
|
|
|
||
|
|
/* special.c:
|
||
|
|
*/
|
||
|
|
P_Quote, "quote", 1, 1, NOEVAL,
|
||
|
|
P_Quasiquote, "quasiquote", 1, 1, NOEVAL,
|
||
|
|
P_Begin, "begin", 1, MANY, NOEVAL,
|
||
|
|
P_Begin1, "begin1", 1, MANY, NOEVAL,
|
||
|
|
P_If, "if", 2, MANY, NOEVAL,
|
||
|
|
P_Case, "case", 2, MANY, NOEVAL,
|
||
|
|
P_Cond, "cond", 1, MANY, NOEVAL,
|
||
|
|
P_Do, "do", 2, MANY, NOEVAL,
|
||
|
|
P_Let, "let", 2, MANY, NOEVAL,
|
||
|
|
P_Letseq, "let*", 2, MANY, NOEVAL,
|
||
|
|
P_Letrec, "letrec", 2, MANY, NOEVAL,
|
||
|
|
P_Fluid_Let, "fluid-let", 2, MANY, NOEVAL,
|
||
|
|
P_And, "and", 0, MANY, NOEVAL,
|
||
|
|
P_Or, "or", 0, MANY, NOEVAL,
|
||
|
|
|
||
|
|
/* string.c:
|
||
|
|
*/
|
||
|
|
P_String, "string", 0, MANY, VARARGS,
|
||
|
|
P_Stringp, "string?", 1, 1, EVAL,
|
||
|
|
P_Make_String, "make-string", 1, 2, VARARGS,
|
||
|
|
P_String_Length, "string-length", 1, 1, EVAL,
|
||
|
|
P_String_To_Number, "string->number", 1, 2, VARARGS,
|
||
|
|
P_String_Ref, "string-ref", 2, 2, EVAL,
|
||
|
|
P_String_Set, "string-set!", 3, 3, EVAL,
|
||
|
|
P_Substring, "substring", 3, 3, EVAL,
|
||
|
|
P_String_Copy, "string-copy", 1, 1, EVAL,
|
||
|
|
P_String_Append, "string-append", 0, MANY, VARARGS,
|
||
|
|
P_List_To_String, "list->string", 1, 1, EVAL,
|
||
|
|
P_String_To_List, "string->list", 1, 1, EVAL,
|
||
|
|
P_String_Fill, "string-fill!", 2, 2, EVAL,
|
||
|
|
P_Substring_Fill, "substring-fill!", 4, 4, EVAL,
|
||
|
|
P_String_Eq, "string=?", 2, 2, EVAL,
|
||
|
|
P_String_Less, "string<?", 2, 2, EVAL,
|
||
|
|
P_String_Greater, "string>?", 2, 2, EVAL,
|
||
|
|
P_String_Eq_Less, "string<=?", 2, 2, EVAL,
|
||
|
|
P_String_Eq_Greater, "string>=?", 2, 2, EVAL,
|
||
|
|
P_String_CI_Eq, "string-ci=?", 2, 2, EVAL,
|
||
|
|
P_String_CI_Less, "string-ci<?", 2, 2, EVAL,
|
||
|
|
P_String_CI_Greater, "string-ci>?", 2, 2, EVAL,
|
||
|
|
P_String_CI_Eq_Less, "string-ci<=?", 2, 2, EVAL,
|
||
|
|
P_String_CI_Eq_Greater,
|
||
|
|
"string-ci>=?", 2, 2, EVAL,
|
||
|
|
P_Substringp, "substring?", 2, 2, EVAL,
|
||
|
|
P_CI_Substringp, "substring-ci?", 2, 2, EVAL,
|
||
|
|
|
||
|
|
/* symbol.c:
|
||
|
|
*/
|
||
|
|
P_String_To_Symbol, "string->symbol", 1, 1, EVAL,
|
||
|
|
P_Oblist, "oblist", 0, 0, EVAL,
|
||
|
|
P_Symbolp, "symbol?", 1, 1, EVAL,
|
||
|
|
P_Symbol_To_String, "symbol->string", 1, 1, EVAL,
|
||
|
|
P_Put, "put", 2, 3, VARARGS,
|
||
|
|
P_Get, "get", 2, 2, EVAL,
|
||
|
|
P_Symbol_Plist, "symbol-plist", 1, 1, EVAL,
|
||
|
|
|
||
|
|
/* type.c:
|
||
|
|
*/
|
||
|
|
P_Type, "type", 1, 1, EVAL,
|
||
|
|
|
||
|
|
/* vector.c:
|
||
|
|
*/
|
||
|
|
P_Vectorp, "vector?", 1, 1, EVAL,
|
||
|
|
P_Make_Vector, "make-vector", 1, 2, VARARGS,
|
||
|
|
P_Vector, "vector", 0, MANY, VARARGS,
|
||
|
|
P_Vector_Length, "vector-length", 1, 1, EVAL,
|
||
|
|
P_Vector_Ref, "vector-ref", 2, 2, EVAL,
|
||
|
|
P_Vector_Set, "vector-set!", 3, 3, EVAL,
|
||
|
|
P_Vector_To_List, "vector->list", 1, 1, EVAL,
|
||
|
|
P_List_To_Vector, "list->vector", 1, 1, EVAL,
|
||
|
|
P_Vector_Fill, "vector-fill!", 2, 2, EVAL,
|
||
|
|
P_Vector_Copy, "vector-copy", 1, 1, EVAL,
|
||
|
|
|
||
|
|
0
|
||
|
|
};
|
||
|
|
|
||
|
|
/* The C-compiler can't initialize unions, thus the primitive procedures
|
||
|
|
* must be created during run-time (the problem actually is that one can't
|
||
|
|
* provide an intializer for the "tag" component of an S_Primitive).
|
||
|
|
*/
|
||
|
|
|
||
|
|
Init_Prim () {
|
||
|
|
register struct Prim_Init *p;
|
||
|
|
Object frame, prim, sym;
|
||
|
|
|
||
|
|
for (frame = Car (The_Environment), p = Primitives; p->fun; p++) {
|
||
|
|
prim = Make_Primitive (p->fun, p->name, p->minargs, p->maxargs,
|
||
|
|
p->disc);
|
||
|
|
sym = Intern (p->name);
|
||
|
|
frame = Add_Binding (frame, sym, prim);
|
||
|
|
}
|
||
|
|
Car (The_Environment) = frame;
|
||
|
|
Memoize_Frame (frame);
|
||
|
|
}
|
||
|
|
|
||
|
|
Define_Primitive (fun, name, min, max, disc) Object (*fun)(); const char *name;
|
||
|
|
enum discipline disc; {
|
||
|
|
Object prim, sym, frame;
|
||
|
|
GC_Node2;
|
||
|
|
|
||
|
|
Set_Error_Tag ("define-primitive");
|
||
|
|
prim = Make_Primitive (fun, name, min, max, disc);
|
||
|
|
sym = Null;
|
||
|
|
GC_Link2 (prim, sym);
|
||
|
|
sym = Intern (name);
|
||
|
|
if (disc == EVAL && min != max)
|
||
|
|
Primitive_Error ("~s: number of arguments must be fixed", sym);
|
||
|
|
frame = Add_Binding (Car (The_Environment), sym, prim);
|
||
|
|
SYMBOL(sym)->value = prim;
|
||
|
|
Car (The_Environment) = frame;
|
||
|
|
GC_Unlink;
|
||
|
|
}
|