From c6b28c0b3fddee08c77868ba30a682c622e4aa45 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 29 Aug 2008 10:29:11 -0500
Subject: [PATCH] new accessors

---
 basis/alien/c-types/c-types.factor | 44 ++++++++++++++++++------------
 basis/alien/strings/strings.factor |  6 ++--
 2 files changed, 29 insertions(+), 21 deletions(-)

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index a9b39f80ab..5184a06bc2 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
 namespaces parser sequences strings words assocs splitting
 math.parser cpu.architecture alien alien.accessors quotations
 layouts system compiler.units io.files io.encodings.binary
-accessors combinators effects continuations ;
+accessors combinators effects continuations summary ;
 IN: alien.c-types
 
 DEFER: <int>
@@ -62,17 +62,19 @@ M: string c-type ( name -- type )
         ] ?if
     ] if ;
 
+ERROR: no-boxer ;
+M: no-boxer summary drop "No boxer" ;
 : c-type-box ( n type -- )
-    dup c-type-reg-class
-    swap c-type-boxer [ "No boxer" throw ] unless*
-    %box ;
+    [ reg-class>> ]
+    [ boxer>> [ no-boxer ] unless* ] bi %box ;
 
+ERROR: no-unboxer ;
+M: no-unboxer summary drop "No unboxer" ;
 : c-type-unbox ( n ctype -- )
-    dup c-type-reg-class
-    swap c-type-unboxer [ "No unboxer" throw ] unless*
-    %unbox ;
+    [ reg-class>> ]
+    [ unboxer>> [ no-unboxer ] unless* ] bi %unbox ;
 
-M: string c-type-align c-type c-type-align ;
+M: string c-type-align c-type align>> ;
 
 M: string c-type-stack-align? c-type c-type-stack-align? ;
 
@@ -107,27 +109,33 @@ GENERIC: heap-size ( type -- size ) foldable
 
 M: string heap-size c-type heap-size ;
 
-M: c-type heap-size c-type-size ;
+M: c-type heap-size size>> ;
 
 GENERIC: stack-size ( type -- size ) foldable
 
 M: string stack-size c-type stack-size ;
 
-M: c-type stack-size c-type-size ;
+M: c-type stack-size size>> ;
 
 GENERIC: byte-length ( seq -- n ) flushable
 
 M: byte-array byte-length length ;
 
+ERROR: c-struct-reader ;
+
+M: c-struct-reader summary
+    drop "Cannot read struct fields with type" ;
+
 : c-getter ( name -- quot )
-    c-type c-type-getter [
-        [ "Cannot read struct fields with type" throw ]
-    ] unless* ;
+    c-type c-type-getter [ c-struct-reader ] unless* ;
+
+ERROR: c-struct-writer ;
+
+M: c-struct-writer summary
+    drop "Cannot write struct fields with type" ;
 
 : c-setter ( name -- quot )
-    c-type c-type-setter [
-        [ "Cannot write struct fields with type" throw ]
-    ] unless* ;
+    c-type c-type-setter [ c-struct-writer ] unless* ;
 
 : <c-array> ( n type -- array )
     heap-size * <byte-array> ; inline
@@ -178,13 +186,13 @@ TUPLE: long-long-type < c-type ;
     long-long-type new-c-type ;
 
 M: long-long-type unbox-parameter ( n type -- )
-    c-type-unboxer %unbox-long-long ;
+    unboxer>> %unbox-long-long ;
 
 M: long-long-type unbox-return ( type -- )
     f swap unbox-parameter ;
 
 M: long-long-type box-parameter ( n type -- )
-    c-type-boxer %box-long-long ;
+    boxer>> %box-long-long ;
 
 M: long-long-type box-return ( type -- )
     f swap box-parameter ;
diff --git a/basis/alien/strings/strings.factor b/basis/alien/strings/strings.factor
index 70bbe773ee..ceddb8407e 100755
--- a/basis/alien/strings/strings.factor
+++ b/basis/alien/strings/strings.factor
@@ -44,7 +44,7 @@ M: string-type heap-size
     drop "void*" heap-size ;
 
 M: string-type c-type-align
-    drop "void*" c-type-align ;
+    drop "void*" align>> ;
 
 M: string-type c-type-stack-align?
     drop "void*" c-type-stack-align? ;
@@ -68,10 +68,10 @@ M: string-type c-type-reg-class
     drop int-regs ;
 
 M: string-type c-type-boxer
-    drop "void*" c-type-boxer ;
+    drop "void*" boxer>> ;
 
 M: string-type c-type-unboxer
-    drop "void*" c-type-unboxer ;
+    drop "void*" unboxer>> ;
 
 M: string-type c-type-boxer-quot
     second [ alien>string ] curry [ ] like ;