]> gitweb.factorcode.org Git - factor.git/commitdiff
merge
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 12 Jun 2009 01:22:24 +0000 (21:22 -0400)
committerDoug Coleman <doug.coleman@gmail.com>
Fri, 12 Jun 2009 01:22:24 +0000 (21:22 -0400)
basis/game-input/dinput/dinput.factor
basis/io/servers/connection/connection.factor
core/bootstrap/syntax.factor
core/classes/tuple/parser/parser-tests.factor
core/classes/tuple/tuple.factor
core/slots/slots.factor
core/syntax/syntax.factor

index 0ecf543baa3af001569e254dcf08b34b00aad55c..8540907db911afbdde8651d62c697ac698b24242 100755 (executable)
@@ -1,13 +1,14 @@
-USING: accessors alien alien.c-types alien.strings arrays
-assocs byte-arrays combinators continuations game-input
-game-input.dinput.keys-array io.encodings.utf16
-io.encodings.utf16n kernel locals math math.bitwise
-math.rectangles namespaces parser sequences shuffle
-struct-arrays ui.backend.windows vectors windows.com
-windows.dinput windows.dinput.constants windows.errors
-windows.kernel32 windows.messages windows.ole32
-windows.user32 ;
+USING: windows.dinput windows.dinput.constants parser
+alien.c-types windows.ole32 namespaces assocs kernel arrays
+vectors windows.kernel32 windows.com windows.dinput shuffle
+windows.user32 windows.messages sequences combinators locals
+math.rectangles accessors math alien alien.strings
+io.encodings.utf16 io.encodings.utf16n continuations
+byte-arrays game-input.dinput.keys-array game-input
+ui.backend.windows windows.errors struct-arrays
+math.bitwise ;
 IN: game-input.dinput
+
 CONSTANT: MOUSE-BUFFER-SIZE 16
 
 SINGLETON: dinput-game-input-backend
index de75165c7a6a36ebff194c6aa4cf079cf320a601..df6c21e7cce39beda7a4f303ccb406d0ad0ec84e 100644 (file)
@@ -11,17 +11,17 @@ combinators.short-circuit ;
 IN: io.servers.connection
 
 TUPLE: threaded-server
-{ name initial: "server" }
-{ log-level initial: DEBUG }
+name
+log-level
 secure insecure
-{ secure-config initial-quot: [ <secure-config> ] }
-{ sockets initial-quot: [ V{ } clone ] }
+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,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 ;
index 24538229c69dc53b93f07133723c84604a74272f..f5182a02100b548208c4e4355870680eee642b51 100644 (file)
@@ -80,7 +80,6 @@ IN: bootstrap.syntax
     ">>"
     "call-next-method"
     "initial:"
-    "initial-quot:"
     "read-only"
     "call("
     "execute("
index 350b5942748e18bc6f98ace0b7e24835884ea0b3..b95507c78b346a794275b80375055bab7dab4620 100644 (file)
@@ -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
index 55fbdf725fe543b5db0a7826bf6dac96b5d62130..225176f4e5939dfaf10a629a2aa279f800935b40 100755 (executable)
@@ -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 )
index 9db26846d0548d5a4fa6330722fdfcc2d2461b8f..304ded0adbb5e836fb05732c9d5f4a8290735604 100755 (executable)
@@ -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?
index 8093b6345b6ccf0c53ab73c3140916737587dc62..56ac9fa36e1ba5880a11d359535a1dd5f8b949f0 100644 (file)
@@ -245,9 +245,7 @@ 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