[, [ dup can-compile? [ , ] [ drop ] ifte ] each-word ,] ;
: cannot-compile ( word -- )
- "verbose-compile" get [ "Cannot compile " write . ] when ;
+ "verbose-compile" get [
+ "Cannot compile " write .
+ ] [
+ drop
+ ] ifte ;
: init-compiler ( -- )
#! Compile all words.
cons
car
cdr
- set-car
- set-cdr
<vector>
vector-length
set-vector-length
: attrs>string ( alist -- string )
#! Convert the attrs alist to a string
#! suitable for embedding in an html tag.
- nreverse <% [ dup car % "='" % cdr % "'" % ] each %> ;
+ reverse <% [ dup car % "='" % cdr % "'" % ] each %> ;
: write-attributes ( n: namespace -- )
#! With the attribute namespace on the stack, get the attributes
: print-prompt ( -- )
<% " ( " % history# unparse % " )" % %>
- [ "prompt" ] get-style write-attr
+ "prompt" get-style write-attr
! Print the space without a style, to workaround a bug in
! the GUI listener where the style from the prompt carries
! over to the input
USE: namespaces
USE: stack
-: append@ ( [ list ] var -- )
- #! Append a proper list stored in a variable with another
- #! list, storing the result back in the variable.
- #! given variable using 'append'.
- tuck get swap append put ;
-
-: add@ ( elem var -- )
- #! Add an element at the end of a proper list stored in a
- #! variable, storing the result back in the variable.
- tuck get swap add put ;
-
: cons@ ( x var -- )
#! Prepend x to the list stored in var.
tuck get cons put ;
#! if the object does not already occur in the list.
"list-buffer" unique@ ;
-: list, ( list -- )
- #! Append each element to the currently constructing list.
- [ , ] each ;
-
: ,] ( -- list )
#! Finish constructing a list and push it on the stack.
- "list-buffer" get nreverse n> drop ;
+ "list-buffer" get reverse n> drop ;
#! Construct a proper list of 3 elements.
2list cons ;
-: 2rlist ( a b -- [ b a ] )
- #! Construct a proper list of 2 elements in reverse stack order.
- swap unit cons ;
-
-: copy-cons ( accum cons -- accum cdr )
- uncons >r unit dup rot set-cdr r> ;
-
-: (clone-list) ( accum list -- last )
- dup cons? [ copy-cons (clone-list) ] [ over set-cdr ] ifte ;
-
-: clone-list* ( list -- list last )
- #! Push the cloned list, and the last cons cell of the
- #! cloned list.
- uncons >r unit dup r> (clone-list) ;
-
-: clone-list ( list -- list )
- #! Push a shallow copy of a list.
- dup [ clone-list* drop ] when ;
-
: append ( [ list1 ] [ list2 ] -- [ list1 list2 ] )
- #! Append two lists. A new list is constructed by copying
- #! the first list and setting its tail to the second.
- over [ >r clone-list* r> swap set-cdr ] [ nip ] ifte ;
-
-: add ( [ list1 ] elem -- [ list1 elem ] )
- #! Push a new proper list with an element added to the end.
- unit append ;
-
-: caar ( list -- caar )
- car car ; inline
-
-: cdar ( list -- cadr )
- cdr car ; inline
-
-: cadr ( list -- cdar )
- car cdr ; inline
-
-: cddr ( list -- cddr )
- cdr cdr ; inline
+ #! Append two lists.
+ over [ >r uncons r> append cons ] [ nip ] ifte ;
: contains? ( element list -- remainder )
#! If the proper list contains the element, push the
: list? ( list -- boolean )
#! Proper list test. A proper list is either f, or a cons
#! cell whose cdr is a proper list.
- dup [
- dup cons? [
- cdr list?
- ] [
- drop f
- ] ifte
- ] [
- drop t
- ] ifte ;
-
-: nappend ( [ list1 ] [ list2 ] -- [ list1 list2 ] )
- #! DESTRUCTIVE. Append two lists. The last node of the first
- #! list is destructively modified to point to the second
- #! list, unless the first list is f, in which case the
- #! second list is returned.
- over [ over last* set-cdr ] [ nip ] ifte ;
-
-: first ( list -- obj )
- #! Push the head of the list, or f if the list is empty.
- dup [ car ] when ;
-
-: next ( obj list -- obj )
- #! Push the next object in the list after an object. Wraps
- #! around to beginning of list if object is at the end.
- tuck contains? dup [
- ! Is there another entry in the list?
- cdr dup [
- nip car
- ] [
- ! No. Pick first
- drop first
- ] ifte
- ] [
- drop first
- ] ifte ;
-
-: nreverse-iter ( list cons -- list cons )
- [ dup dup cdr 2swap set-cdr nreverse-iter ] when* ;
-
-: nreverse ( list -- list )
- #! DESTRUCTIVE. Reverse the given list, without consing.
- f swap nreverse-iter ;
+ [ dup cons? [ cdr list? ] [ drop f ] ifte ] [ t ] ifte* ;
: partition-add ( obj ? ret1 ret2 -- ret1 ret2 )
>r >r [ r> cons r> ] [ r> r> swapd cons ] ifte ; inline
! Recurse
tuck sort >r sort r>
! Combine
- swapd cons nappend
+ swapd cons append
] [
drop
] ifte ; inline interpret-only
DEFER: tree-contains?
: =-or-contains? ( element obj -- ? )
- dup cons? [
- tree-contains?
- ] [
- =
- ] ifte ;
+ dup cons? [ tree-contains? ] [ = ] ifte ;
: tree-contains? ( element tree -- ? )
dup [
f transp [
! accum code elem -- accum code
transp over >r >r call r> cons r>
- ] each drop nreverse ; inline interpret-only
+ ] each drop reverse ; inline interpret-only
: 2uncons ( list1 list2 -- car1 car2 cdr1 cdr2 )
uncons >r >r uncons r> swap r> ;
#! two lists in turn, collecting the return value into a
#! new list. The quotation must have stack effect
#! ( x y -- z ).
- <2map [ pick >r 2map-step r> ] 2each drop nreverse ;
+ <2map [ pick >r 2map-step r> ] 2each drop reverse ;
inline interpret-only
-: substitute ( new old list -- list )
- [ 2dup = [ drop over ] when ] map nip nip ;
-
-: (head) ( accum list n -- last list )
- dup 1 = [ drop ] [ pred >r copy-cons r> (head) ] ifte ;
-
-: head* ( n list -- head last rest )
- #! Push the head of the list, the last cons cell of the
- #! head, and the rest of the list.
- uncons >r unit tuck r> rot (head) ;
-
-: head ( n list -- head )
- #! Push a new list containing the first n elements.
- over 0 = [ 2drop f ] [ head* 2drop ] ifte ;
-
-: set-nth ( value index list -- list )
- over 0 = [
- nip cdr cons
- ] [
- rot >r head* cdr r> swons swap set-cdr
- ] ifte ;
-
: subset-add ( car pred accum -- accum )
>r over >r call r> r> rot [ cons ] [ nip ] ifte ;
#!
#! In order to compile, the quotation must consume as many
#! values as it produces.
- f -rot subset-iter nreverse ; inline interpret-only
+ f -rot subset-iter reverse ; inline interpret-only
: remove ( obj list -- list )
#! Remove all occurrences of the object from the list.
[ dupd = not ] subset nip ;
-: remove-nth ( n list -- list )
- #! Push a new list with the nth element removed.
- over 0 = [ nip cdr ] [ head* cdr swap set-cdr ] ifte ;
-
: length ( list -- length )
#! Pushes the length of the given proper list.
0 swap [ drop succ ] each ;
-: leaves ( list -- length )
- #! Like length, but counts each sub-list recursively.
- 0 swap [ dup list? [ leaves + ] [ drop succ ] ifte ] each ;
-
: reverse ( list -- list )
#! Push a new list that is the reverse of a proper list.
[ ] swap [ swons ] each ;
[ ] swap [ swons ] vector-each ;
: vector>list ( vector -- list )
- stack>list nreverse ;
+ stack>list reverse ;
! bind ( namespace quot -- ) executes a quotation with a
! namespace pushed on the namespace stack.
-: namestack ( -- stack )
- #! Push a copy of the namespace stack; same naming
- #! convention as the primitives datastack and callstack.
- namestack* clone ; inline
-
-: set-namestack ( stack -- )
- #! Set the namespace stack to a copy of another stack; same
- #! naming convention as the primitives datastack and
- #! callstack.
- clone set-namestack* ; inline
-
: >n ( namespace -- n:namespace )
#! Push a namespace on the namespace stack.
namestack* vector-push ; inline
#! result of evaluating [ a ].
over get [ drop get ] [ swap >r call dup r> set ] ifte ;
-: alist> ( alist namespace -- )
- #! Set each key in the alist to its value in the
- #! namespace.
- [ [ unswons set ] each ] bind ;
-
-: alist>namespace ( alist -- namespace )
- <namespace> tuck alist> ;
-
: traverse-path ( name object -- object )
dup has-namespace? [ get* ] [ 2drop f ] ifte ;
: cons? ( list -- boolean )
#! Test for cons cell type.
"factor.Cons" is ; inline
-
-: deep-clone ( cons -- cons )
- [ "factor.Cons" ] "factor.Cons" "deepClone" jinvoke-static ;
-
-: set-car ( A [ B | C ] -- )
- #! DESTRUCTIVE. Replace the head of a list.
- "factor.Cons" "car" jvar-set ; inline
-
-: set-cdr ( A [ B | C ] -- )
- #! DESTRUCTIVE. Replace the tail of a list.
- "factor.Cons" "cdr" jvar-set ; inline
interpreter
"factor.FactorInterpreter" "namestack" jvar-set ; inline
+: namestack ( -- stack )
+ namestack* clone ; inline
+
+: set-namestack ( stack -- )
+ clone set-namestack* ; inline
+
: global ( -- namespace )
interpreter "factor.FactorInterpreter" "global" jvar-get ;
DEFER: compilable-words
DEFER: compilable-word-list
-[ warm-boot ] set-boot
+IN: init
+DEFER: init-interpreter
+
+[
+ warm-boot
+ "interactive" get [ init-interpreter ] when
+ 0 exit*
+] set-boot
compilable-words compilable-word-list set
! This is a very lightweight exception handling system.
: catchstack* ( -- cs ) 6 getenv ;
-: catchstack ( -- cs ) catchstack* clone ;
+: catchstack ( -- cs ) catchstack* vector-clone ;
: set-catchstack* ( cs -- ) 6 setenv ;
-: set-catchstack ( cs -- ) clone set-catchstack* ;
+: set-catchstack ( cs -- ) vector-clone set-catchstack* ;
t "ansi" set
t "compile" set
+ "ansi" get [ "stdio" get <ansi-stream> "stdio" set ] when
+
! The first CLI arg is the image name.
cli-args uncons parse-command-line "image" set
"compile" get [ init-compiler ] when
- run-user-init
-
- "ansi" get [ "stdio" get <ansi-stream> "stdio" set ] when
- "interactive" get [ init-interpreter ] when
-
- 0 exit* ;
+ run-user-init ;
: clone ( obj -- obj )
[
- [ cons? ] [ clone-list ]
[ vector? ] [ vector-clone ]
[ sbuf? ] [ sbuf-clone ]
[ drop t ] [ ( return the object ) ]
! No compiler...
: inline ;
: interpret-only ;
-
-! HACKS
-
-IN: strings
-: char? drop f ;
-: >char ;
-: >upper ;
-: >lower ;
: namestack* ( -- ns ) 3 getenv ;
: set-namestack* ( ns -- ) 3 setenv ;
+: namestack ( -- stack ) namestack* vector-clone ;
+: set-namestack ( stack -- ) vector-clone set-namestack* ;
+
: global ( -- g ) 4 getenv ;
: set-global ( g -- ) 4 setenv ;
: (parse-stream) ( name stream -- quot )
#! Uses the current namespace for temporary variables.
>r "file" set f r>
- [ (parse) ] read-lines nreverse
+ [ (parse) ] read-lines reverse
"file" off
"line-number" off ;
! Lists
: [ [ ] ; parsing
-: ] nreverse parsed ; parsing
+: ] reverse parsed ; parsing
: | ( syntax: | cdr ] )
#! See the word 'parsed'. We push a special sentinel, and
! Vectors
: { f ; parsing
-: } nreverse list>vector parsed ; parsing
+: } reverse list>vector parsed ; parsing
! Do not execute parsing word
: POSTPONE: ( -- ) scan-word parsed ; parsing
: ;
#! End a word definition.
"in-definition" off
- nreverse
+ reverse
;-hook ; parsing
! Symbols
] ifte
] when ;
-: parsed| ( obj -- )
+: parsed| ( parsed parsed obj -- parsed )
#! Some ugly ugly code to handle [ a | b ] expressions.
- >r nreverse dup last* r> swap set-cdr swons ;
+ >r unswons r> cons swap [ swons ] each swons ;
: expect ( word -- )
dup scan = not [
: parse ( str -- code )
#! Parse the string into a parse tree that can be executed.
- f swap (parse) nreverse ;
+ f swap (parse) reverse ;
: eval ( "X" -- X )
parse call ;
[ cons | " car cdr -- [ car | cdr ] " ]
[ car | " [ car | cdr ] -- car " ]
[ cdr | " [ car | cdr ] -- cdr " ]
- [ set-car | " car cons -- " ]
- [ set-cdr | " cdr cons -- " ]
[ <vector> | " capacity -- vector" ]
[ vector-length | " vector -- n " ]
[ set-vector-length | " n vector -- " ]
dup >r sbuf-append r>
dup >r sbuf-append r>
sbuf>str ;
+
+! HACKS
+: char? drop f ;
+: >char ;
+: >upper ;
+: >lower ;
dup ends-with-newline? dup [ nip ] [ drop ] ifte ;
: prettyprint-comment ( comment -- )
- trim-newline [ "comments" ] get-style write-attr ;
+ trim-newline "comments" get-style write-attr ;
: word-link ( word -- link )
<%
! significance to the 'fwrite-attr' word when applied to a
! stream that supports attributed string output.
-: default-style ( -- style )
- #! Push the default style object.
- "styles" get [ "default" get ] bind ;
-
-: paragraph ( -- style )
- #! Push the paragraph break meta-style.
- "styles" get [ "paragraph" get ] bind ;
-
-: <style> ( alist -- )
- #! Create a new style object, cloned from the default
- #! style.
- default-style clone tuck alist> ;
-
-: get-style ( obj-path -- style )
- #! Push a style named by an object path, for example
- #! [ "prompt" ] or [ "vocabularies" "math" ].
- dup [
- "styles" get [ object-path ] bind
- [ default-style ] unless*
- ] [
- drop default-style
- ] ifte ;
-
-: set-style ( style name -- )
- ! XXX: use object path...
- "styles" get [ set ] bind ;
+: (get-style) ( name -- style ) "styles" get get* ;
+: default-style ( -- style ) "default" (get-style) ;
+: get-style ( name -- style )
+ (get-style) [ default-style ] unless* ;
+: set-style ( style name -- ) "styles" get set* ;
<namespace> "styles" set
[ [ 1 1 0 0 ] ] [ [ system-property ] ] [ balance>list ] test-word
-! Make sure callstack only clones callframes, and not
-! everything on the callstack.
-[ ] [ ] [ f unit dup dup set-cdr >r callstack r> 2drop ] test-word
-
[ t ] [ "ifte" intern dup worddef word-of-worddef = ] unit-test
! jvar-get
"car" must-compile
-! jvar-set
-"set-car" must-compile
-
! jvar-get-static
"version" must-compile
[ [ 1 2 ] ] [ 1 2 2list ] unit-test
[ [ 1 2 3 ] ] [ 1 2 3 3list ] unit-test
-[ [ 2 1 ] ] [ 1 2 2rlist ] unit-test
+++ /dev/null
-IN: scratchpad
-USE: lists
-USE: namespaces
-USE: stack
-USE: test
-
-[ "a" | "b" ] clone-list "x" set
-[ [ 1 | "b" ] ] [ 1 "x" get set-car "x" get ] unit-test
-
-[ "a" | "b" ] clone-list "x" set
-[ [ "a" | 2 ] ] [ 2 "x" get set-cdr "x" get ] unit-test
-
-: clone-and-nappend ( list list -- list )
- swap clone-list swap clone-list nappend ;
-
-[ [ ] ] [ [ ] [ ] clone-and-nappend ] unit-test
-[ [ 1 ] ] [ [ 1 ] [ ] clone-and-nappend ] unit-test
-[ [ 2 ] ] [ [ ] [ 2 ] clone-and-nappend ] unit-test
-[ [ 1 2 3 4 ] ] [ [ 1 2 3 ] [ 4 ] clone-and-nappend ] unit-test
-
-: clone-and-nreverse ( list -- list )
- clone-list nreverse ;
-
-[ [ ] ] [ [ ] clone-and-nreverse ] unit-test
-[ [ 1 ] ] [ [ 1 ] clone-and-nreverse ] unit-test
-[ [ 3 2 1 ] ] [ [ 1 2 3 ] clone-and-nreverse ] unit-test
-
-[ 1 2 3 ] clone-list "x" set [ 4 5 6 ] clone-list "y" set
-
-[ [ 4 5 6 ] ] [ "x" get "y" get nappend drop "y" get ] unit-test
-
-[ 1 2 3 ] clone-list "x" set [ 4 5 6 ] clone-list "y" set
-
-[ [ 1 2 3 4 5 6 ] ] [ "x" get "y" get ] [ nappend drop "x" get ] test-word
[ [ 2 1 0 0 ] ] [ [ 2list ] ] [ balance>list ] test-word
[ [ 3 1 0 0 ] ] [ [ 3list ] ] [ balance>list ] test-word
-[ [ 2 1 0 0 ] ] [ [ 2rlist ] ] [ balance>list ] test-word
[ [ 2 1 0 0 ] ] [ [ append ] ] [ balance>list ] test-word
-[ [ 2 0 0 0 ] ] [ [ append@ ] ] [ balance>list ] test-word
[ [ 1 1 0 0 ] ] [ [ array>list ] ] [ balance>list ] test-word
[ [ 2 0 0 0 ] ] [ [ add@ ] ] [ balance>list ] test-word
[ [ 1 1 0 0 ] ] [ [ car ] ] [ balance>list ] test-word
[ [ 1 1 0 0 ] ] [ [ cdr ] ] [ balance>list ] test-word
-[ [ 1 1 0 0 ] ] [ [ clone-list ] ] [ balance>list ] test-word
[ [ 2 1 0 0 ] ] [ [ cons ] ] [ balance>list ] test-word
[ [ 2 1 0 0 ] ] [ [ contains? ] ] [ balance>list ] test-word
[ [ 2 0 0 0 ] ] [ [ cons@ ] ] [ balance>list ] test-word
[ [ 1 1 0 0 ] ] [ [ length ] ] [ balance>list ] test-word
[ [ 1 1 0 0 ] ] [ [ list? ] ] [ balance>list ] test-word
[ [ 1 1 0 0 ] ] [ [ nreverse ] ] [ balance>list ] test-word
-[ [ 2 1 0 0 ] ] [ [ nappend ] ] [ balance>list ] test-word
[ [ 1 1 0 0 ] ] [ [ cons? ] ] [ balance>list ] test-word
[ [ 2 1 0 0 ] ] [ [ remove ] ] [ balance>list ] test-word
[ [ 1 1 0 0 ] ] [ [ reverse ] ] [ balance>list ] test-word
-[ [ 2 0 0 0 ] ] [ [ set-car ] ] [ balance>list ] test-word
-[ [ 2 0 0 0 ] ] [ [ set-cdr ] ] [ balance>list ] test-word
[ [ 2 2 0 0 ] ] [ [ [ < ] partition ] ] [ balance>list ] test-word
[ [ 2 2 0 0 ] ] [ [ [ nip string? ] partition ] ] [ balance>list ] test-word
[ [ 1 1 0 0 ] ] [ [ num-sort ] ] [ balance>list ] test-word
[ [ 2 1 0 0 ] ] [ [ unique ] ] [ balance>list ] test-word
[ [ 1 1 0 0 ] ] [ [ unit ] ] [ balance>list ] test-word
[ [ 1 2 0 0 ] ] [ [ unswons ] ] [ balance>list ] test-word
-[ [ 1 1 0 0 ] ] [ [ deep-clone ] ] [ balance>list ] test-word
[ [ ] ] [ [ ] ] [ array>list ] test-word
[ [ 1 2 3 ] ] [ [ 1 2 3 ] ] [ array>list ] test-word
[ [ 1 2 3 4 ] ] [ [ 1 2 3 ] [ 4 ] append ] unit-test
[ [ 1 2 3 | 4 ] ] [ [ 1 2 3 ] 4 append ] unit-test
-[ [ ] ] [ [ ] clone-list ] unit-test
-[ [ 1 2 | 3 ] ] [ [ 1 2 | 3 ] clone-list ] unit-test
-[ [ 1 2 3 4 ] ] [ [ 1 2 3 4 ] clone-list ] unit-test
-
-: clone-list-actually-clones? ( list1 list2 -- )
- >r clone-list ! we don't want to mutate literals
- dup clone-list r> nappend = not ;
-
-[ t ] [ [ 1 2 ] [ 3 4 ] clone-list-actually-clones? ] unit-test
-
[ f ] [ 3 [ ] contains? ] unit-test
[ f ] [ 3 [ 1 2 ] contains? ] unit-test
[ [ 1 2 ] ] [ 1 [ 1 2 ] contains? ] unit-test
[ t ] [ [ 1 2 ] list? ] unit-test
[ f ] [ [ 1 | 2 ] list? ] unit-test
-[ 2 ] [ 1 [ 1 2 3 ] next ] unit-test
-[ 1 ] [ 3 [ 1 2 3 ] next ] unit-test
-[ 1 ] [ 4 [ 1 2 3 ] next ] unit-test
-
[ [ ] ] [ 1 [ ] remove ] unit-test
[ [ ] ] [ 1 [ 1 ] remove ] unit-test
[ [ 3 1 1 ] ] [ 2 [ 3 2 1 2 1 ] remove ] unit-test
[ [ 0 1 2 3 ] ] [ 4 count ] unit-test
[ [ 1 2 3 ] ] [ [ 1 4 2 5 3 6 ] [ 4 < ] subset ] unit-test
-
-[ [ t f t f ] ] [ f 1 [ t 1 t 1 ] substitute ] unit-test
-
-[ [ 0 1 2 4 5 6 7 8 9 ] ] [ 3 10 count remove-nth ] unit-test
-[ [ 1 2 3 4 5 6 7 8 9 ] ] [ 0 10 count remove-nth ] unit-test
-[ [ 0 1 2 3 4 5 6 7 8 ] ] [ 9 10 count remove-nth ] unit-test
-
-[ [ 1 2 3 ] ] [ 2 1 [ 1 3 3 ] set-nth ] unit-test
-[ [ 1 2 3 ] ] [ 1 0 [ 2 2 3 ] set-nth ] unit-test
-[ [ 1 2 3 ] ] [ 3 2 [ 1 2 2 ] set-nth ] unit-test
USE: namespaces
USE: test
-[ [ 1 2 3 4 ] ] [ [ 3 4 ] [ 1 2 ] ] [ "x" set "x" append@ "x" get ] test-word
-
-[ [ 1 2 3 4 ] ] [ 4 [ 1 2 3 ] ] [ "x" set "x" add@ "x" get ] test-word
-
[ [ 1 ] ] [ 1 f ] [ "x" set "x" cons@ "x" get ] test-word
[ [ 1 | 2 ] ] [ 1 2 ] [ "x" set "x" cons@ "x" get ] test-word
[ [ 1 2 ] ] [ 1 [ 2 ] ] [ "x" set "x" cons@ "x" get ] test-word
1/5 , 1/5 unique,
[, { } unique, ,] , ,]
] unit-test
-
-[ [ 1 2 3 4 ] ] [ [, 1 , [ 2 3 ] list, 4 , ,] ] unit-test
"lists/cons"
"lists/lists"
"lists/assoc"
- "lists/destructive"
"lists/namespaces"
"combinators"
"continuations"
USE: stack
USE: styles
-: get-vocab-style ( vocab -- style )
+: vocab-style ( vocab -- style )
#! Each vocab has a style object specifying how words are
#! to be printed.
- "vocabularies" 2rlist get-style ;
+ "vocabularies" get-style get* ;
: set-vocab-style ( style vocab -- )
- swap default-style append swap
- [ "styles" "vocabularies" ] object-path set* ;
+ >r default-style append r> "vocabularies" get-style set* ;
: word-style ( word -- style )
- word-vocabulary dup [
- get-vocab-style
- ] [
- drop default-style
- ] ifte ;
+ word-vocabulary [ vocab-style ] [ default-style ] ifte* ;
-"styles" get [ <namespace> "vocabularies" set ] bind
+<namespace> "vocabularies" set-style
[
[ "ansi-fg" | "1" ]
{
drepl(cdr(dpeek()));
}
-
-void primitive_set_car(void)
-{
- CELL cons = dpop();
- CELL car = dpop();
- untag_cons(cons)->car = car;
-}
-
-void primitive_set_cdr(void)
-{
- CELL cons = dpop();
- CELL cdr = dpop();
- untag_cons(cons)->cdr = cdr;
-}
void primitive_cons(void);
void primitive_car(void);
void primitive_cdr(void);
-void primitive_set_car(void);
-void primitive_set_cdr(void);
primitive_cons,
primitive_car,
primitive_cdr,
- primitive_set_car,
- primitive_set_cdr,
primitive_vector,
primitive_vector_length,
primitive_set_vector_length,
extern XT primitives[];
-#define PRIMITIVE_COUNT 196
+#define PRIMITIVE_COUNT 194
CELL primitive_to_xt(CELL primitive);
projects / factor.git / commitdiff