Revert "merge"

This reverts commit c2a03d259a.

basis/game-input/dinput/dinput.factor

@@ -1,14 +1,13 @@
-USING: windows.dinput windows.dinput.constants parser
+USING: accessors alien alien.c-types alien.strings arrays
-alien.c-types windows.ole32 namespaces assocs kernel arrays
+assocs byte-arrays combinators continuations game-input
-vectors windows.kernel32 windows.com windows.dinput shuffle
+game-input.dinput.keys-array io.encodings.utf16
-windows.user32 windows.messages sequences combinators locals
+io.encodings.utf16n kernel locals math math.bitwise
-math.rectangles accessors math alien alien.strings
+math.rectangles namespaces parser sequences shuffle
-io.encodings.utf16 io.encodings.utf16n continuations
+struct-arrays ui.backend.windows vectors windows.com
-byte-arrays game-input.dinput.keys-array game-input
+windows.dinput windows.dinput.constants windows.errors
-ui.backend.windows windows.errors struct-arrays
+windows.kernel32 windows.messages windows.ole32
-math.bitwise ;
+windows.user32 ;
 IN: game-input.dinput
-
 CONSTANT: MOUSE-BUFFER-SIZE 16
 
 SINGLETON: dinput-game-input-backend

basis/io/servers/connection/connection.factor

@@ -11,17 +11,17 @@ combinators.short-circuit ;
 IN: io.servers.connection
 
 TUPLE: threaded-server
-name
+{ name initial: "server" }
-log-level
+{ log-level initial: DEBUG }
 secure insecure
-secure-config
+{ secure-config initial-quot: [ <secure-config> ] }
-sockets
+{ sockets initial-quot: [ V{ } clone ] }
 max-connections
 semaphore
-timeout
+{ timeout initial-quot: [ 1 minutes ] }
 encoding
-handler
+{ handler initial: [ "No handler quotation" throw ] }
-ready ;
+{ ready initial-quot: [ <flag> ] } ;
 
 : local-server ( port -- addrspec ) "localhost" swap <inet> ;
 
@@ -29,14 +29,7 @@ ready ;
 
 : new-threaded-server ( encoding class -- threaded-server )
     new
-        swap >>encoding
+        swap >>encoding ;
-        "server" >>name
-        DEBUG >>log-level
-        1 minutes >>timeout
-        V{ } clone >>sockets
-        <secure-config> >>secure-config
-        [ "No handler quotation" throw ] >>handler
-        <flag> >>ready ; inline
 
 : <threaded-server> ( encoding -- threaded-server )
     threaded-server new-threaded-server ;

core/bootstrap/syntax.factor

@@ -80,6 +80,7 @@ IN: bootstrap.syntax
     ">>"
     "call-next-method"
     "initial:"
+    "initial-quot:"
     "read-only"
     "call("
     "execute("

core/classes/tuple/parser/parser-tests.factor

@@ -1,7 +1,7 @@
 IN: classes.tuple.parser.tests
 USING: accessors classes.tuple.parser lexer words classes
 sequences math kernel slots tools.test parser compiler.units
-arrays classes.tuple eval ;
+arrays classes.tuple eval multiline ;
 
 TUPLE: test-1 ;
 
@@ -142,3 +142,11 @@ TUPLE: parsing-corner-case x ;
         "    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

core/classes/tuple/tuple.factor

@@ -50,8 +50,19 @@ M: tuple class layout-of 2 slot { word } declare ;
 
 PRIVATE>
 
+: initial-value ( slot -- obj )
+    dup initial>> [
+        nip
+    ] [
+        dup initial-quot>> [
+            nip call( -- obj )
+        ] [
+            drop f
+        ] if*
+    ] if* ;
+
 : initial-values ( class -- slots )
-    all-slots [ initial>> ] map ;
+    all-slots [ initial-value ] map ;
 
 : pad-slots ( slots class -- slots' class )
     [ initial-values over length tail append ] keep ; inline
@@ -64,9 +75,7 @@ PRIVATE>
 : tuple-slots ( tuple -- seq )
     prepare-tuple>array drop copy-tuple-slots ;
 
-GENERIC: slots>tuple ( seq class -- tuple )
+: slots>tuple ( seq class -- tuple )
-
-M: tuple-class slots>tuple
     check-slots pad-slots
     tuple-layout <tuple> [
         [ tuple-size ]
@@ -176,7 +185,7 @@ ERROR: bad-superclass class ;
 : compute-slot-permutation ( new-slots old-slots -- triples )
     [ [ [ name>> ] map ] bi@ [ index ] curry map ]
     [ drop [ class>> ] map ]
-    [ drop [ initial>> ] map ]
+    [ drop [ initial-value ] map ]
     2tri 3array flip ;
 
 : update-slot ( old-values n class initial -- value )

core/slots/slots.factor

@@ -3,10 +3,10 @@
 USING: arrays byte-arrays kernel kernel.private math namespaces
 make sequences strings effects generic generic.standard
 classes classes.algebra slots.private combinators accessors
-words sequences.private assocs alien quotations hashtables ;
+words sequences.private assocs alien quotations hashtables summary ;
 IN: slots
 
-TUPLE: slot-spec name offset class initial read-only ;
+TUPLE: slot-spec name offset class initial initial-quot read-only ;
 
 PREDICATE: reader < word "reader" word-prop ;
 
@@ -190,6 +190,7 @@ 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
@@ -197,7 +198,17 @@ ERROR: bad-slot-attribute key ;
 
 ERROR: bad-initial-value name ;
 
+ERROR: duplicate-initial-values slot ;
+
+M: duplicate-initial-values summary
+    drop "Slots can either define initial: or initial-quot:, but not both" ;
+
+: 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?

core/syntax/syntax.factor

@@ -245,7 +245,9 @@ IN: bootstrap.syntax
     ] define-core-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