From: Joe Groff <arcata@gmail.com>
Date: Thu, 6 May 2010 06:26:54 +0000 (-0700)
Subject: windows.directx.dinput: redo constant generation yet again to get compile time under... 
X-Git-Tag: 0.97~4241^2~1^2~59
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=98db8b5e782bb3dad7122e36ca2630409516a104

windows.directx.dinput: redo constant generation yet again to get compile time under control
---

diff --git a/basis/windows/directx/dinput/constants/constants.factor b/basis/windows/directx/dinput/constants/constants.factor
index c77364ccde..bd4ac93feb 100755
--- a/basis/windows/directx/dinput/constants/constants.factor
+++ b/basis/windows/directx/dinput/constants/constants.factor
@@ -3,7 +3,7 @@ windows.com windows.com.syntax alien alien.c-types alien.data
 alien.syntax kernel system namespaces combinators sequences fry
 math accessors macros words quotations libc continuations
 generalizations splitting locals assocs init specialized-arrays
-classes.struct strings arrays literals ;
+classes.struct strings arrays literals sequences.generalizations ;
 SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
 IN: windows.directx.dinput.constants
 
@@ -46,27 +46,27 @@ M: array array-base-type first ;
 : (flags) ( array -- n )
     0 [ (flag) bitor ] reduce ;
 
-: <DIOBJECTDATAFORMAT>-quot ( struct {pguid-var,field,index,dwType-flags,dwFlags} -- quot )
+: <DIOBJECTDATAFORMAT> ( struct {pguid-var,field,index,dwType-flags,dwFlags} -- object )
     {
         [ drop f ]
         [ second rot [ (offsetof) ] [ (sizeof) ] 2bi ]
         [ third * + ]
         [ fourth (flags) ]
         [ 4 swap nth (flag) ]
-        [ first dup word? [ '[ _ get ] ] [ drop [ f ] ] if ]
     } cleave
-    [ DIOBJECTDATAFORMAT <struct-boa> ] dip
-    curry ;
+    DIOBJECTDATAFORMAT <struct-boa> ;
 
-: set-DIOBJECTDATAFORMAT ( array struct pguid n -- array )
-    [ [ clone ] dip >>pguid ] dip pick set-nth ;
+: make-DIOBJECTDATAFORMAT-arrays ( struct array -- values vars )
+    [ [ <DIOBJECTDATAFORMAT> ] [ first ] bi ] with
+    DIOBJECTDATAFORMAT-array{ } { } 1 2 mnmap-as ;
 
-:: make-DIOBJECTDATAFORMAT-array-quot ( struct array -- quot )
-    array length '[ _ malloc-DIOBJECTDATAFORMAT-array ]
-    array [| args i |
-        struct args <DIOBJECTDATAFORMAT>-quot
-        i '[ @ _ set-DIOBJECTDATAFORMAT ]
-    ] map-index [ ] join compose ;
+: make-DIOBJECTDATAFORMAT-array-quot ( struct arr -- quot )
+    [ nip length ] [ make-DIOBJECTDATAFORMAT-arrays ] 2bi '[
+        _ malloc-DIOBJECTDATAFORMAT-array
+        [ _ dup byte-length memcpy ]
+        [ _ [ get >>pguid drop ] 2each ]
+        [ ] tri
+    ] ;
 
 >>