Remove initial-quot feature

diff --git a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
index 2688f7f8f1044eb24bd09eedcd85bb70f58e63f2..4fb01608f0270b321dde330d91c3c6732407ab98 100644 (file)
--- a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
+++ b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor
@@ -328,10 +328,3 @@ C: <ro-box> ro-box
 TUPLE: empty-tuple ;
 
 [ ] [ [ empty-tuple boa layout-of ] count-unboxed-allocations drop ] unit-test
-
-! Make sure that initial-quot: doesn't inhibit unboxing
-TUPLE: initial-quot-tuple { x read-only initial-quot: [ 0 ] } ;
-
-[ 1 ] [
-    [ initial-quot-tuple new x>> ] count-unboxed-allocations
-] unit-test
\ No newline at end of file

diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor
index de75165c7a6a36ebff194c6aa4cf079cf320a601..345b739b613eb2bd28f550229e68c05c7b754658 100644 (file)
--- a/basis/io/servers/connection/connection.factor
+++ b/basis/io/servers/connection/connection.factor
@@ -11,17 +11,18 @@ combinators.short-circuit ;
 IN: io.servers.connection
 
 TUPLE: threaded-server
-{ name initial: "server" }
-{ log-level initial: DEBUG }
-secure insecure
-{ secure-config initial-quot: [ <secure-config> ] }
-{ sockets initial-quot: [ V{ } clone ] }
+name
+log-level
+secure
+insecure
+secure-config
+sockets
 max-connections
 semaphore
-{ timeout initial-quot: [ 1 minutes ] }
+timeout
 encoding
-{ handler initial: [ "No handler quotation" throw ] }
-{ ready initial-quot: [ <flag> ] } ;
+handler
+ready ;
 
 : local-server ( port -- addrspec ) "localhost" swap <inet> ;
 
@@ -29,6 +30,13 @@ encoding
 
 : new-threaded-server ( encoding class -- threaded-server )
     new
+        "server" >>name
+        DEBUG >>log-level
+        <secure-config> >>secure-config
+        V{ } clone >>sockets
+        1 minutes >>timeout
+        [ "No handler quotation" throw ] >>handler
+        <flag> >>ready
         swap >>encoding ;
 
 : <threaded-server> ( encoding -- threaded-server )

diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor
index 24538229c69dc53b93f07133723c84604a74272f..f5182a02100b548208c4e4355870680eee642b51 100644 (file)
--- a/core/bootstrap/syntax.factor
+++ b/core/bootstrap/syntax.factor
@@ -80,7 +80,6 @@ IN: bootstrap.syntax
     ">>"
     "call-next-method"
     "initial:"
-    "initial-quot:"
     "read-only"
     "call("
     "execute("

diff --git a/core/classes/tuple/parser/parser-tests.factor b/core/classes/tuple/parser/parser-tests.factor
index 350b5942748e18bc6f98ace0b7e24835884ea0b3..72457ff97431fcd9099d0867bc9e137dd9b3a0cb 100644 (file)
--- a/core/classes/tuple/parser/parser-tests.factor
+++ b/core/classes/tuple/parser/parser-tests.factor
@@ -141,12 +141,4 @@ TUPLE: parsing-corner-case x ;
         "USE: classes.tuple.parser.tests T{ parsing-corner-case {"
         "    x 3 }"
     } "\n" join eval( -- tuple )
-] [ error>> unexpected-eof? ] must-fail-with
-
-
-[ ] [
-    <" USE: sequences
-    IN: classes.tuple.tests
-    TUPLE: book { name initial-quot: [ "Lord of the " "Rings" append ] } ;">
-    eval( -- )
-] unit-test
+] [ error>> unexpected-eof? ] must-fail-with
\ No newline at end of file

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 4b23578a297ca8dfb655dac7f5a2fe89fd81ae27..191ec75544a58c1a8e877e575e0a4271b3b22d57 100644 (file)
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -729,50 +729,3 @@ DEFER: redefine-tuple-twice
 [ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
 
 [ t ] [ \ redefine-tuple-twice symbol? ] unit-test
-
-TUPLE: lucky-number { n initial-quot: [ 64 random-bits ] } ;
-SLOT: winner?
-
-[ t ] [ lucky-number new n>> integer? ] unit-test
-
-: compiled-lucky-number ( -- tuple ) lucky-number new ;
-
-[ t ] [ compiled-lucky-number n>> integer? ] unit-test
-
-! Reshaping initial-quot:
-lucky-number new dup n>> 2array "luckiest-number" set
-
-[ t ] [ "luckiest-number" get first2 [ n>> ] dip = ] unit-test
-
-[ ] [ "USING: accessors random ; IN: classes.tuple.tests TUPLE: lucky-number { n initial-quot: [ 64 random-bits ] } { winner? initial-quot: [ t ] } ;" eval( -- ) ] unit-test
-
-[ t ] [ "luckiest-number" get first2 [ n>> ] dip = ] unit-test
-[ t ] [ "luckiest-number" get first winner?>> ] unit-test
-
-! invalid-quot: together with type declaration
-TUPLE: decl-initial-quot { x integer initial-quot: [ 1 ] } ;
-
-[ t ] [ decl-initial-quot new x>> integer? ] unit-test
-
-: compiled-decl-initial-quot ( -- tuple ) decl-initial-quot new ;
-
-[ t ] [ compiled-decl-initial-quot x>> integer? ] unit-test
-
-! invalid-quot: with read-only
-TUPLE: read-only-initial-quot { x integer read-only initial-quot: [ 1 ] } ;
-
-[ t ] [ read-only-initial-quot new x>> integer? ] unit-test
-
-: compiled-read-only-initial-quot ( -- tuple ) read-only-initial-quot new ;
-
-[ t ] [ compiled-read-only-initial-quot x>> integer? ] unit-test
-
-! Specifying both initial: and initial-quot: should fail
-2 [
-    [
-        "IN: classes.tuple.test TUPLE: redundant-decl { x initial: 0 initial-quot: [ 0 ] } ;"
-        eval( -- )
-    ]
-    [ error>> duplicate-initial-values? ]
-    must-fail-with
-] times

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 4ca57a59ed1d1b448e07f2afd1a7380ff3d2f629..7633f9b4c82bfa0c5bb61a0857e4166f798a4213 100755 (executable)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -50,9 +50,6 @@ M: tuple class layout-of 2 slot { word } declare ;
 
 PRIVATE>
 
-: initial-quots? ( class -- ? )
-    all-slots [ initial-quot>> ] any? ;
-
 : initial-values ( class -- slots )
     all-slots [ initial>> ] map ;
 
@@ -149,21 +146,12 @@ ERROR: bad-superclass class ;
 : define-boa-check ( class -- )
     dup boa-check-quot "boa-check" set-word-prop ;
 
-: tuple-initial-quots-quot ( class -- quot )
-    all-slots [ initial-quot>> ] filter
-    [
-        [
-            [ initial-quot>> % \ over , ] [ offset>> , ] bi \ set-slot ,
-        ] each
-    ] [ ] make f like ;
-
 : tuple-prototype ( class -- prototype )
-    [ initial-values ] [ over [ ] any? ] [ initial-quots? or ] tri
+    [ initial-values ] keep over [ ] any?
     [ slots>tuple ] [ 2drop f ] if ;
 
 : define-tuple-prototype ( class -- )
-    dup [ tuple-prototype ] [ tuple-initial-quots-quot ] bi 2array
-    dup [ ] any? [ drop f ] unless "prototype" set-word-prop ;
+    dup tuple-prototype "prototype" set-word-prop ;
 
 : prepare-slots ( slots superclass -- slots' )
     [ make-slots ] [ class-size 2 + ] bi* finalize-slots ;
@@ -185,16 +173,10 @@ ERROR: bad-superclass class ;
 : define-tuple-layout ( class -- )
     dup make-tuple-layout "layout" set-word-prop ;
 
-: calculate-initial-value ( slot-spec -- value )
-    dup initial>> [ ] [
-        dup initial-quot>>
-        [ call( -- obj ) ] [ drop f ] ?if
-    ] ?if ;
-
 : compute-slot-permutation ( new-slots old-slots -- triples )
     [ [ [ name>> ] map ] bi@ [ index ] curry map ]
     [ drop [ class>> ] map ]
-    [ drop [ calculate-initial-value ] map ]
+    [ drop [ initial>> ] map ]
     2tri 3array flip ;
 
 : update-slot ( old-values n class initial -- value )
@@ -358,11 +340,7 @@ M: tuple tuple-hashcode
 M: tuple hashcode* tuple-hashcode ;
 
 M: tuple-class new
-    dup "prototype" word-prop [
-        first2 [ (clone) ] dip [ call( obj -- obj ) ] when*
-    ] [
-        tuple-layout <tuple>
-    ] ?if ;
+    dup "prototype" word-prop [ (clone) ] [ tuple-layout <tuple> ] ?if ;
 
 M: tuple-class boa
     [ "boa-check" word-prop [ call ] when* ]

diff --git a/core/slots/slots.factor b/core/slots/slots.factor
index c8be08e79bd7bc62e49834a31add72af1cc283d5..304ded0adbb5e836fb05732c9d5f4a8290735604 100755 (executable)
--- a/core/slots/slots.factor
+++ b/core/slots/slots.factor
@@ -6,7 +6,7 @@ classes classes.algebra slots.private combinators accessors
 words sequences.private assocs alien quotations hashtables ;
 IN: slots
 
-TUPLE: slot-spec name offset class initial initial-quot read-only ;
+TUPLE: slot-spec name offset class initial read-only ;
 
 PREDICATE: reader < word "reader" word-prop ;
 
@@ -190,7 +190,6 @@ ERROR: bad-slot-attribute key ;
     dup empty? [
         unclip {
             { initial: [ [ first >>initial ] [ rest ] bi ] }
-            { initial-quot: [ [ first >>initial-quot ] [ rest ] bi ] }
             { read-only [ [ t >>read-only ] dip ] }
             [ bad-slot-attribute ]
         } case
@@ -198,14 +197,7 @@ ERROR: bad-slot-attribute key ;
 
 ERROR: bad-initial-value name ;
 
-ERROR: duplicate-initial-values slot ;
-
-: check-duplicate-initial-values ( slot-spec -- slot-spec )
-    dup [ initial>> ] [ initial-quot>> ] bi and
-    [ duplicate-initial-values ] when ;
-
 : check-initial-value ( slot-spec -- slot-spec )
-    check-duplicate-initial-values
     dup initial>> [
         [ ] [
             dup [ initial>> ] [ class>> ] bi instance?

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index 8093b6345b6ccf0c53ab73c3140916737587dc62..7b9a0d36efc93512d32d466f3318dbbbcb2616e6 100644 (file)
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.factor
@@ -246,8 +246,6 @@ IN: bootstrap.syntax
     
     "initial:" "syntax" lookup define-symbol
 
-    "initial-quot:" "syntax" lookup define-symbol
-
     "read-only" "syntax" lookup define-symbol
 
     "call(" [ \ call-effect parse-call( ] define-core-syntax