-\ ---- Primitives ---- {{{
-
-: make-primitive ( cfa -- )
- bl word
- count
-
- \ 2dup ." Defining primitive " type ." ..." cr
-
- cstr>charlist
- drop symbol-type
-
- 2dup
-
- symbol-table obj@
- cons
- symbol-table obj!
-
- rot primitive-proc-type ( var prim )
- global-env obj@ define-var
-;
-
-: arg-count-error
- bold fg red ." Incorrect argument count." reset-term cr
- abort
-;
-
-: ensure-arg-count ( args n -- )
- dup 0= if
- drop nil objeq? false = if
- arg-count-error
- then
- else
- -rot 2dup nil objeq? if
- arg-count-error
- then
-
- cdr rot 1- recurse
- then
-;
-
-: arg-type-error
- bold fg red ." Incorrect argument type." reset-term cr
- abort
-;
-
-: ensure-arg-type ( arg type -- arg )
- istype? false = if
- arg-type-error
- then
-;
-
-include scheme-primitives.4th
-
-\ }}}
-