merge

basis/game-input/dinput/dinput.factor

@@ -1,13 +1,14 @@
-USING: accessors alien alien.c-types alien.strings arrays
+USING: windows.dinput windows.dinput.constants parser
-assocs byte-arrays combinators continuations game-input
+alien.c-types windows.ole32 namespaces assocs kernel arrays
-game-input.dinput.keys-array io.encodings.utf16
+vectors windows.kernel32 windows.com windows.dinput shuffle
-io.encodings.utf16n kernel locals math math.bitwise
+windows.user32 windows.messages sequences combinators locals
-math.rectangles namespaces parser sequences shuffle
+math.rectangles accessors math alien alien.strings
-struct-arrays ui.backend.windows vectors windows.com
+io.encodings.utf16 io.encodings.utf16n continuations
-windows.dinput windows.dinput.constants windows.errors
+byte-arrays game-input.dinput.keys-array game-input
-windows.kernel32 windows.messages windows.ole32
+ui.backend.windows windows.errors struct-arrays
-windows.user32 ;
+math.bitwise ;
 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 initial: "server" }
+name
-{ log-level initial: DEBUG }
+log-level
 secure insecure
-{ secure-config initial-quot: [ <secure-config> ] }
+secure-config
-{ sockets initial-quot: [ V{ } clone ] }
+sockets
 max-connections
 semaphore
-{ timeout initial-quot: [ 1 minutes ] }
+timeout
 encoding
-{ handler initial: [ "No handler quotation" throw ] }
+handler
-{ ready initial-quot: [ <flag> ] } ;
+ready ;
 
 : local-server ( port -- addrspec ) "localhost" swap <inet> ;
 
@@ -29,7 +29,14 @@ encoding
 
 : 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,7 +80,6 @@ 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 multiline ;
+arrays classes.tuple eval ;
 
 TUPLE: test-1 ;
 
@@ -142,11 +142,3 @@ 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,19 +50,8 @@ 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-value ] map ;
+    all-slots [ initial>> ] map ;
 
 : pad-slots ( slots class -- slots' class )
     [ initial-values over length tail append ] keep ; inline
@@ -75,7 +64,9 @@ PRIVATE>
 : tuple-slots ( tuple -- seq )
     prepare-tuple>array drop copy-tuple-slots ;
 
-: slots>tuple ( seq class -- tuple )
+GENERIC: slots>tuple ( seq class -- tuple )
+
+M: tuple-class slots>tuple
     check-slots pad-slots
     tuple-layout <tuple> [
         [ tuple-size ]
@@ -185,7 +176,7 @@ ERROR: bad-superclass class ;
 : compute-slot-permutation ( new-slots old-slots -- triples )
     [ [ [ name>> ] map ] bi@ [ index ] curry map ]
     [ drop [ class>> ] map ]
-    [ drop [ initial-value ] map ]
+    [ drop [ initial>> ] 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 summary ;
+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,17 +197,7 @@ 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

@@ -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