possibly controversial: removed destructive list manipulation; other cleanups

library/compiler/compile-all.factor

@@ -110,7 +110,11 @@ SYMBOL: compilable-word-list
     [, [ 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.

library/cross-compiler.factor

@@ -198,8 +198,6 @@ IN: image
         cons
         car
         cdr
-        set-car
-        set-cdr
         <vector>
         vector-length
         set-vector-length

library/httpd/html-tags.factor

@@ -78,7 +78,7 @@ USE: logic
 : 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

library/interpreter.factor

@@ -81,7 +81,7 @@ USE: vectors
 
 : 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

library/list-namespaces.factor

@@ -31,17 +31,6 @@ USE: kernel
 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 ;
@@ -78,10 +67,6 @@ USE: stack
     #! 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 ;

library/lists.factor

@@ -41,45 +41,9 @@ USE: vectors
     #! 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
+    #! Append two lists.
-    #! the first list and setting its tail to the second.
+    over [ >r uncons r> append cons ] [ nip ] ifte ;
-    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
 
 : contains? ( element list -- remainder )
     #! If the proper list contains the element, push the
@@ -115,48 +79,7 @@ USE: vectors
 : 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 ] [ t ] ifte* ;
-        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 ;
 
 : partition-add ( obj ? ret1 ret2 -- ret1 ret2 )
     >r >r [ r> cons r> ] [ r> r> swapd cons ] ifte ; inline
@@ -196,7 +119,7 @@ USE: vectors
         ! Recurse
         tuck sort >r sort r>
         ! Combine
-        swapd cons nappend
+        swapd cons append
     ] [
         drop
     ] ifte ; inline interpret-only
@@ -209,11 +132,7 @@ USE: vectors
 DEFER: tree-contains?
 
 : =-or-contains? ( element obj -- ? )
-    dup cons? [
+    dup cons? [ tree-contains? ] [ = ] ifte ;
-        tree-contains?
-    ] [
-        =
-    ] ifte ;
 
 : tree-contains? ( element tree -- ? )
     dup [
@@ -254,7 +173,7 @@ DEFER: tree-contains?
     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> ;
@@ -283,31 +202,9 @@ DEFER: tree-contains?
     #! 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 ;
 
@@ -326,24 +223,16 @@ DEFER: tree-contains?
     #!
     #! 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 ;
@@ -401,4 +290,4 @@ DEFER: tree-contains?
     [ ] swap [ swons ] vector-each ;
 
 : vector>list ( vector -- list )
-    stack>list nreverse ;
+    stack>list reverse ;

library/namespaces.factor

@@ -53,17 +53,6 @@ USE: vectors
 ! 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
@@ -98,14 +87,6 @@ USE: vectors
     #! 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 ;
 

library/platform/jvm/cons.factor

@@ -51,14 +51,3 @@ IN: lists USE: kernel USE: stack
 : 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

library/platform/jvm/namespaces.factor

@@ -45,6 +45,12 @@ DEFER: namespace
     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 ;
 

library/platform/native/boot-stage2.factor

@@ -179,7 +179,14 @@ IN: compiler
 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
 

library/platform/native/errors.factor

@@ -32,6 +32,6 @@ USE: vectors
 ! 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* ;

library/platform/native/init-stage2.factor

@@ -64,14 +64,11 @@ USE: words
     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
+    run-user-init ;
-
-    "ansi" get [ "stdio" get <ansi-stream> "stdio" set ] when
-    "interactive" get [ init-interpreter ] when
-
-    0 exit* ;

library/platform/native/kernel.factor

@@ -114,7 +114,6 @@ IN: kernel
 
 : clone ( obj -- obj )
     [
-        [ cons? ] [ clone-list ]
         [ vector? ] [ vector-clone ]
         [ sbuf? ] [ sbuf-clone ]
         [ drop t ] [ ( return the object ) ]
@@ -130,11 +129,3 @@ IN: kernel
 ! No compiler...
 : inline ;
 : interpret-only ;
-
-! HACKS
-
-IN: strings
-: char? drop f ;
-: >char ;
-: >upper ;
-: >lower ;

library/platform/native/namespaces.factor

@@ -41,6 +41,9 @@ DEFER: >n
 : 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 ;
 

library/platform/native/parse-stream.factor

@@ -69,7 +69,7 @@ USE: strings
 : (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 ;
 

library/platform/native/parse-syntax.factor

@@ -124,7 +124,7 @@ IN: syntax
 
 ! Lists
 : [ [ ] ; parsing
-: ] nreverse parsed ; parsing
+: ] reverse parsed ; parsing
 
 : | ( syntax: | cdr ] )
     #! See the word 'parsed'. We push a special sentinel, and
@@ -133,7 +133,7 @@ IN: syntax
 
 ! Vectors
 : { f ; parsing
-: } nreverse list>vector parsed ; parsing
+: } reverse list>vector parsed ; parsing
 
 ! Do not execute parsing word
 : POSTPONE: ( -- ) scan-word parsed ; parsing
@@ -149,7 +149,7 @@ IN: syntax
 : ;
     #! End a word definition.
     "in-definition" off
-    nreverse
+    reverse
     ;-hook ; parsing
 
 ! Symbols

library/platform/native/parser.factor

@@ -135,9 +135,9 @@ USE: unparser
         ] 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 [
@@ -158,7 +158,7 @@ USE: unparser
 
 : 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 ;

library/platform/native/primitives.factor

@@ -51,8 +51,6 @@ USE: words
     [ 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 -- " ]

library/platform/native/strings.factor

@@ -37,3 +37,9 @@ USE: stack
     dup >r sbuf-append r>
     dup >r sbuf-append r>
     sbuf>str ;
+
+! HACKS
+: char? drop f ;
+: >char ;
+: >upper ;
+: >lower ;

library/prettyprint.factor

@@ -141,7 +141,7 @@ DEFER: prettyprint*
     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 )
     <%

library/styles.factor

@@ -36,32 +36,11 @@ USE: stack
 ! significance to the 'fwrite-attr' word when applied to a
 ! stream that supports attributed string output.
 
-: default-style ( -- style )
+: (get-style) ( name -- style ) "styles" get get* ;
-    #! Push the default style object.
+: default-style ( -- style ) "default" (get-style) ;
-    "styles" get [ "default" get ] bind ;
+: get-style ( name -- style )
-
+    (get-style) [ default-style ] unless* ;
-: paragraph ( -- style )
+: set-style ( style name -- ) "styles" get set* ;
-    #! 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 ;
 
 <namespace> "styles" set
 

library/test/jvm-compiler/miscellaneous.factor

@@ -90,8 +90,4 @@ test-word
 
 [ [ 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

library/test/jvm-compiler/primitives.factor

@@ -7,9 +7,6 @@ USE: test
 ! jvar-get
 "car" must-compile
 
-! jvar-set
-"set-car" must-compile
-
 ! jvar-get-static
 "version" must-compile
 

library/test/lists/cons.factor

@@ -25,4 +25,3 @@ USE: test
 
 [ [ 1 2 ]   ] [ 1 2   2list  ] unit-test
 [ [ 1 2 3 ] ] [ 1 2 3 3list  ] unit-test
-[ [ 2 1 ]   ] [ 1 2   2rlist ] unit-test

library/test/lists/destructive.factor

@@ -1,34 +0,0 @@
-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

library/test/lists/java.factor

@@ -7,14 +7,11 @@ USE: test
 
 [ [ 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
@@ -25,12 +22,9 @@ USE: test
 [ [ 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
@@ -41,7 +35,6 @@ USE: test
 [ [ 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

library/test/lists/lists.factor

@@ -13,16 +13,6 @@ USE: test
 [ [ 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
@@ -48,10 +38,6 @@ USE: 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
@@ -75,13 +61,3 @@ USE: 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

library/test/lists/namespaces.factor

@@ -3,10 +3,6 @@ USE: lists
 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
@@ -42,5 +38,3 @@ USE: test
     1/5 , 1/5 unique,
     [, { } unique, ,] , ,]
 ] unit-test
-
-[ [ 1 2 3 4 ] ] [ [, 1 , [ 2 3 ] list, 4 , ,] ] unit-test

library/test/test.factor

@@ -70,7 +70,6 @@ USE: unparser
         "lists/cons"
         "lists/lists"
         "lists/assoc"
-        "lists/destructive"
         "lists/namespaces"
         "combinators"
         "continuations"

library/vocabulary-style.factor

@@ -33,23 +33,18 @@ USE: namespaces
 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
+    >r default-style append r> "vocabularies" get-style set* ;
-    [ "styles" "vocabularies" ] object-path set* ;
 
 : word-style ( word -- style )
-    word-vocabulary dup [
+    word-vocabulary [ vocab-style ] [ default-style ] ifte* ;
-        get-vocab-style
-    ] [
-        drop default-style
-    ] ifte ;
 
-"styles" get [ <namespace> "vocabularies" set ] bind
+<namespace> "vocabularies" set-style
 
 [
     [ "ansi-fg" | "1" ]

native/cons.c

@@ -24,17 +24,3 @@ void primitive_cdr(void)
 {
 	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;
-}

native/cons.h

@@ -29,5 +29,3 @@ INLINE CELL cdr(CELL cons)
 void primitive_cons(void);
 void primitive_car(void);
 void primitive_cdr(void);
-void primitive_set_car(void);
-void primitive_set_cdr(void);

native/primitives.c

@@ -10,8 +10,6 @@ XT primitives[] = {
 	primitive_cons,
 	primitive_car,
 	primitive_cdr,
-	primitive_set_car,
-	primitive_set_cdr,
 	primitive_vector,
 	primitive_vector_length,
 	primitive_set_vector_length,

native/primitives.h

@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 196
+#define PRIMITIVE_COUNT 194
 
 CELL primitive_to_xt(CELL primitive);