void define_primitives(Env *env, Obj *root) {
add_primitive(env, root, "quote", prim_quote);
add_primitive(env, root, "list", prim_list);
add_primitive(env, root, "car", prim_car);
add_primitive(env, root, "cdr", prim_cdr);
add_primitive(env, root, "cons", prim_cons);
add_primitive(env, root, "setq", prim_setq);
add_primitive(env, root, "+", prim_plus);
add_primitive(env, root, "negate", prim_negate);
add_primitive(env, root, "define", prim_define);
add_primitive(env, root, "defun", prim_defun);
add_primitive(env, root, "defmacro", prim_defmacro);
add_primitive(env, root, "macroexpand", prim_macroexpand);
add_primitive(env, root, "lambda", prim_lambda);
add_primitive(env, root, "if", prim_if);
add_primitive(env, root, "=", prim_num_eq);
add_primitive(env, root, "prim-lt", prim_num_lt);
add_primitive(env, root, "println", prim_println);
add_primitive(env, root, "gc", prim_gc);
add_primitive(env, root, "exit", prim_exit);
}
static void define_primitives(void *root, Obj **env) {
add_primitive(root, env, "quote", prim_quote);
add_primitive(root, env, "cons", prim_cons);
add_primitive(root, env, "car", prim_car);
add_primitive(root, env, "cdr", prim_cdr);
add_primitive(root, env, "setq", prim_setq);
add_primitive(root, env, "setcar", prim_setcar);
add_primitive(root, env, "while", prim_while);
add_primitive(root, env, "begin", prim_begin);
add_primitive(root, env, "gensym", prim_gensym);
add_primitive(root, env, "+", prim_plus);
add_primitive(root, env, "-", prim_minus);
add_primitive(root, env, "<", prim_lt);
add_primitive(root, env, "<=", prim_lte);
add_primitive(root, env, ">", prim_gt);
add_primitive(root, env, ">=", prim_gte);
add_primitive(root, env, "define", prim_define);
add_primitive(root, env, "defun", prim_defun);
add_primitive(root, env, "defmacro", prim_defmacro);
add_primitive(root, env, "macroexpand", prim_macroexpand);
add_primitive(root, env, "lambda", prim_lambda);
add_primitive(root, env, "if", prim_if);
add_primitive(root, env, "=", prim_num_eq);
add_primitive(root, env, "eq", prim_eq);
add_primitive(root, env, "print", prim_print);
}
void init_stack_manipulation_words(context_t *ctx)
{
hashtable_t *htbl = ctx->exe_tok;
add_primitive(htbl, "DROP", __DROP, "( x -- )", "drop top stack element.");
add_primitive(htbl, "SWAP", __SWAP, "( x1 x2 -- x2 x1)", "swap top two stack elements.");
add_primitive(htbl, "OVER", __OVER, "( x1 x2 -- x1 x2 x1)", "copy NOS (next of stack) to top of stack.");
add_primitive(htbl, "DUP", __DUP, "( x -- x x )", "duplicate top stack element.");
add_primitive(htbl, "?DUP", __QDUP, "( x -- 0 | x x )", "duplicate top stack element if it is non-zero.");
add_primitive(htbl, "2DROP", __2DROP, "( x1 x2 -- )", "drop cell pair x1 x2 from the stack.");
add_primitive(htbl, "2SWAP", __2SWAP, "( x1 x2 x3 x4 -- x3 x4 x2 x1)", "exchange the top two cell pairs.");
add_primitive(htbl, "2OVER", __2OVER, "( x1 x2 x3 x4-- x1 x2 x3 x4 x1 x2)", "copy cell pai x1 x2 to the top of the stack.");
add_primitive(htbl, "2DUP", __2DUP, "( x1 x2 -- x1 x2 x1 x2 )", "duplicate cell pair x1 x2.");
add_primitive(htbl, "NIP", __NIP, "( x1 x2 -- x2 )", "remove NOS.");
add_primitive(htbl, "TUCK", __TUCK, "( x1 x2 -- x2 x1 x2 )", "copy the first (top) stack item below the second stack item.");
add_primitive(htbl, "ROT", __ROT, "( x1 x2 x3 -- x2 x3 x1 )", "rotate the top three stack entries.");
add_primitive(htbl, "-ROT", __MINROT, "( x1 x2 x3 -- x3 x1 x2 )", "rotate the top three stack entries.");
add_primitive(htbl, "DEPTH", __DEPTH, "( -- n )", "the number of single-cell values contained in the data stack before n was placed on the stack.");
add_primitive(htbl, "RDEPTH", __RDEPTH, "( -- n )", "the number of single-cell values contained in the return stack.");
add_primitive(htbl, ">R", __TOR, "( x -- ) ( R: -- x)", "move x to the return stack.");
add_primitive(htbl, "R>", __RFROM, "( -- x ) ( R: x -- )", "move x from the return stack to the data stack.");
add_primitive(htbl, "R@", __RFETCH, "( -- x ) ( R: x -- x)", "copy x from the return stack to the data stack.");
add_primitive(htbl, "RDROP", __RDROP, "( -- ) ( R: x -- )", "drop top return stack element.");
add_primitive(htbl, "PICK", __PICK, "( xu ... x1 x0 u -- xu ... x1 x0 xu )", "remove u. Copy the xu to the top of the stack.");
}
void
HomPose2d::register_primitives()
{
add_primitive( m_position );
add_primitive( m_orientation );
}
static void define_primitives(void *root, Obj **env) {
add_primitive(root, env, "QUOTE", (void **)prim_quote);
add_primitive(root, env, "CONS", (void **)prim_cons);
add_primitive(root, env, "CAR", (void **)prim_car);
add_primitive(root, env, "CDR", (void **)prim_cdr);
add_primitive(root, env, "SETQ", (void **)prim_setq);
add_primitive(root, env, "SETCHAR", (void **)prim_setcar);
add_primitive(root, env, "WHILE", (void **)prim_while);
add_primitive(root, env, "GENSYM", (void **)prim_gensym);
add_primitive(root, env, "+", (void **)prim_plus);
add_primitive(root, env, "-", (void **)prim_minus);
add_primitive(root, env, "<", (void **)prim_lt);
add_primitive(root, env, "DEFINE", (void **)prim_define);
add_primitive(root, env, "DEFUN", (void **)prim_defun);
add_primitive(root, env, "DEFMACRO", (void **)prim_defmacro);
add_primitive(root, env, "MACROEXPAND", (void **)prim_macroexpand);
add_primitive(root, env, "LAMBDA", (void **)prim_lambda);
add_primitive(root, env, "ID", (void **)prim_if);
add_primitive(root, env, "=", (void **)prim_num_eq);
add_primitive(root, env, "EQ", (void **)prim_eq);
add_primitive(root, env, "PRINTLN", (void **)prim_println);
}
void init_comparison_words(context_t *ctx)
{
hashtable_t *htbl = ctx->exe_tok;
add_primitive(htbl, "=", __EQ, "( x1 x2 -- f )", "compares top two stack elements, returns true flag if equal, false otherwise.");
add_primitive(htbl, "<>", __NEQ, "( x1 x2 -- f )", "compares top two stack elements, returns true flag if different, false otherwise.");
add_primitive(htbl, "<", __LT, "( n1 n2 -- f )", "compares signed numbers n1 with n2, returns true if n1 is less then n2.");
add_primitive(htbl, ">", __GT, "( n1 n2 -- f )", "compares signed numbers n1 with n2, returns true if n1 is greater then n2.");
add_primitive(htbl, "U<", __ULT, "( u1 u2 -- f )", "compares unsigned numbers u1 with u2, returns true if n1 is lower then n2.");
add_primitive(htbl, "U>", __UGT, "( u1 u2 -- f )", "compares unsigned numbers u1 with u2, returns true if n1 is higher then n2.");
add_primitive(htbl, "0<", __ISNEG, "( n -- f )", "return a true flag if value of n is negative.");
add_primitive(htbl, "0=", __ISZERO, "( x -- f )", "return a true flag if value of x is zero.");
add_primitive(htbl, "0<>", __ISNOTZERO, "( x -- f )", "return a true flag if value of x is not zero.");
add_primitive(htbl, "0>", __ISPOS, "( n -- f )", "return a true flag if value of x is greater than zero.");
add_primitive(htbl, "WITHIN", __WITHIN, "( x1 x2 x3 -- f )", "return a true flag if x1 is in the range of x2 ... x3-1.");
// TODO: Move into system.fth
add_constant(ctx, "FALSE", 0);
add_constant(ctx, "TRUE", -1);
}
void c_audio_register(void* root, Obj** env)
{
add_primitive(root, env, "audio-newSource", c_audio_newSource);
add_primitive(root, env, "audio-play", c_audio_play);
add_primitive(root, env, "audio-stop", c_audio_stop);
add_primitive(root, env, "audio-setPitch", c_audio_setPitch);
add_primitive(root, env, "audio-setVolume", c_audio_setVolume);
add_primitive(root, env, "audio-setLooping", c_audio_setLooping);
add_primitive(root, env, "audio-isStopped", c_audio_isStopped);
add_primitive(root, env, "audio-isPlaying", c_audio_isPlaying);
add_primitive(root, env, "audio-isPaused", c_audio_isPaused);
add_primitive(root, env, "audio-pause", c_audio_pause);
add_primitive(root, env, "audio-resume", c_audio_resume);
add_primitive(root, env, "audio-getVolume", c_audio_getVolume);
add_primitive(root, env, "audio-getPitch", c_audio_getPitch);
add_primitive(root, env, "audio-getType", c_audio_getType);
add_primitive(root, env, "audio-setGlobalVolume", c_audio_setGlobalVolume);
add_primitive(root, env, "audio-setPosition", c_audio_setPosition);
add_primitive(root, env, "audio-setVelocity", c_audio_setVelocity);
add_primitive(root, env, "audio-gc", c_audio_gc);
add_primitive(root, env, "audio-free", c_audio_gc);
}