Debugging subclassing

TODO.FACTOR.txt

@@ -2,6 +2,11 @@
 
 - win64 port
 - get factor running on mac intel
+- amd64 %unbox-struct
+- amd64 %write-barrier
+- amd64 %box-struct
+- x86 %box-struct
+- x86 %write-barrier
 
 + io:
 
@@ -14,6 +19,7 @@
 + objective C/cocoa:
 
 - autoload frameworks in cocoa class words
+- auto-define classes in obj-c class words
 - subclassing
 - super message sends
 
@@ -38,16 +44,12 @@
 + compiler/ffi:
 
 - inform-compile dies with funny error
-- amd64 %unbox-struct
-- amd64 %write-barrier
 - float intrinsics
 - complex float type
 - complex float intrinsics
 - out of memory from overflow check
 - remove literal table
-- value type struct inputs to callbacks
 - C functions returning structs by value
-- signal handler should not lose stack pointers
 - FIELD: char key_vector[32];
 - FIELD: union { char b[20]; short s[10]; long l[5]; } data;
 - MEMBER: long pad[24];
@@ -56,7 +58,6 @@
 - the invalid recursion form case needs to be fixed, for inlines too
 - code gc
 - compiled gc check slows things down
-- new x86 write barrier
 
 + misc:
 
@@ -64,3 +65,4 @@
 - slice: if sequence or seq start is changed, abstraction violation
 - make 3.4 bits>double an error
 - colorcoded prettyprinting for vocabularies
+- signal handler should not lose stack pointers

examples/cocoa/opengl.factor

@@ -1,14 +1,21 @@
 IN: cocoa-opengl
-USING: alien cocoa compiler io kernel math objc objc-NSObject
+USING: alien cocoa compiler io kernel math objc objc-NSObject objc-NSOpenGLView objc-NSWindow parser sequences
-objc-NSOpenGLView objc-NSWindow parser sequences threads ;
+threads ;
 
-{
+: init-FactorView-class
-    { "drawRect:" "void" { "int" "int" "int" "int" } [ drop ] }
+    {
-} { }
+        {
-"NSOpenGLView" "FactorView" define-objc-class
+            "drawRect:" "void" { "NSRect" }
-"FactorView" import-objc-class
+            [ 3drop "drawRect: called" print ]
+        }
+    } { } "NSOpenGLView" "FactorView" define-objc-class drop
+    "FactorView" import-objc-class ; parsing
 
-: <NSOpenGLView>
+init-FactorView-class
+
+USE: objc-FactorView
+
+: <FactorView>
     NSOpenGLView [alloc]
     0 0 100 100 <NSRect> NSOpenGLView [defaultPixelFormat]
     [initWithFrame:pixelFormat:] ;
@@ -16,10 +23,10 @@ objc-NSOpenGLView objc-NSWindow parser sequences threads ;
 "OpenGL demo" 10 10 600 600 <NSRect> <NSWindow>
 dup
 
-<NSOpenGLView>
+<FactorView>
 
 [setContentView:]
 
-dup f [makeKeyAndOrderFront:]
+f [makeKeyAndOrderFront:]
 
 event-loop

library/cocoa/init-cocoa.factor

@@ -29,6 +29,7 @@ USING: cocoa compiler io kernel objc sequences words ;
     "NSOpenGLView"
     "NSSpeechSynthesizer"
     "NSURLRequest"
+    "NSView"
     "NSWindow"
     "PDFDocument"
     "PDFView"

library/cocoa/subclassing.factor

@@ -5,8 +5,8 @@ USING: alien arrays compiler hashtables kernel kernel-internals
 libc math namespaces sequences strings ;
 
 : encode-types ( return types -- encoding )
-    >r 1array r> append
+    [ swap , { "id" "SEL" } % % ] { } make
-    [ [ alien>objc-types get hash , CHAR: 0 , ] each ] "" make ;
+    [ [ alien>objc-types get hash % CHAR: 0 , ] each ] "" make ;
 
 : prepare-method ( { name return types quot } -- sel type imp )
     [ first3 encode-types >r sel_registerName r> ] keep

library/cocoa/utilities.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: objc
 USING: alien arrays errors hashtables kernel lists math
-namespaces parser sequences words ;
+namespaces parser sequences strings words ;
 
 TUPLE: selector name object ;
 
@@ -29,30 +29,34 @@ C: selector ( name -- sel ) [ set-selector-name ] keep ;
 SYMBOL: objc>alien-types
 
 H{
-    { CHAR: c "char" }
+    { "c" "char" }
-    { CHAR: i "int" }
+    { "i" "int" }
-    { CHAR: s "short" }
+    { "s" "short" }
-    { CHAR: l "long" }
+    { "l" "long" }
-    { CHAR: q "longlong" }
+    { "q" "longlong" }
-    { CHAR: C "uchar" }
+    { "C" "uchar" }
-    { CHAR: I "uint" }
+    { "I" "uint" }
-    { CHAR: S "ushort" }
+    { "S" "ushort" }
-    { CHAR: L "ulong" }
+    { "L" "ulong" }
-    { CHAR: Q "ulonglong" }
+    { "Q" "ulonglong" }
-    { CHAR: f "float" }
+    { "f" "float" }
-    { CHAR: d "double" }
+    { "d" "double" }
-    { CHAR: B "bool" }
+    { "B" "bool" }
-    { CHAR: v "void" }
+    { "v" "void" }
-    { CHAR: * "char*" }
+    { "*" "char*" }
-    { CHAR: @ "id" }
+    { "@" "id" }
-    { CHAR: # "id" }
+    { "#" "id" }
-    { CHAR: : "SEL" }
+    { ":" "SEL" }
 } objc>alien-types set-global
 
 SYMBOL: alien>objc-types
 
 objc>alien-types get hash>alist [ reverse ] map alist>hash
-alien>objc-types set-global
+H{
+    { "NSPoint" "{_NSPoint=ff}" }
+    { "NSRect" "{_NSRect=ffff}" }
+    { "NSSize" "{_NSSize=ff}" }
+} hash-union alien>objc-types set-global
 
 : objc-struct-type ( i string -- ctype )
     2dup CHAR: = -rot index* swap subseq ;
@@ -63,7 +67,7 @@ alien>objc-types set-global
         { [ dup CHAR: ^ = ] [ 3drop "void*" ] }
         { [ dup CHAR: { = ] [ drop objc-struct-type ] }
         { [ dup CHAR: [ = ] [ 3drop "void*" ] }
-        { [ t ] [ 2nip objc>alien-types get hash ] }
+        { [ t ] [ 2nip ch>string objc>alien-types get hash ] }
     } cond ;
 
 : parse-objc-type ( string -- ctype ) 0 swap (parse-objc-type) ;