From fee0953cc4733b96ad5c5354e590aaa386e4f40b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 31 Aug 2009 18:51:47 -0500
Subject: [PATCH 1/5] make-mirror method on structs. fix typo on struct-slots
stack effect. don't filter initial values in struct>assoc because structs
are more low-level and you want to see the entire layout of the struct you're
working with, imo.
---
basis/classes/struct/prettyprint/prettyprint.factor | 2 +-
basis/classes/struct/struct.factor | 2 +-
basis/mirrors/mirrors.factor | 9 +++++----
3 files changed, 7 insertions(+), 6 deletions(-)
diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor
index 1769fafe06..0334b19ddd 100644
--- a/basis/classes/struct/prettyprint/prettyprint.factor
+++ b/basis/classes/struct/prettyprint/prettyprint.factor
@@ -12,7 +12,7 @@ IN: classes.struct.prettyprint
[ drop \ STRUCT: ] if ;
: struct>assoc ( struct -- assoc )
- [ class struct-slots ] [ struct-slot-values ] bi zip filter-tuple-assoc ;
+ [ class struct-slots ] [ struct-slot-values ] bi zip ;
: pprint-struct-slot ( slot -- )
<flow \ { pprint-word
diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index 87813f792f..731f305748 100644
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -23,7 +23,7 @@ TUPLE: struct-slot-spec < slot-spec
PREDICATE: struct-class < tuple-class
{ [ \ struct subclass-of? ] [ all-slots length 1 = ] } 1&& ;
-: struct-slots ( struct -- slots )
+: struct-slots ( struct-class -- slots )
"struct-slots" word-prop ;
! struct allocation
diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor
index 25486d127d..effcc51caa 100644
--- a/basis/mirrors/mirrors.factor
+++ b/basis/mirrors/mirrors.factor
@@ -1,9 +1,9 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs hashtables kernel sequences generic words
-arrays classes slots slots.private classes.tuple
-classes.tuple.private math vectors quotations accessors
-combinators ;
+USING: accessors arrays assocs classes classes.struct
+classes.struct.prettyprint.private classes.tuple
+classes.tuple.private combinators generic hashtables kernel
+math quotations sequences slots slots.private vectors words ;
IN: mirrors
TUPLE: mirror { object read-only } ;
@@ -55,3 +55,4 @@ M: array make-mirror <enum> ;
M: vector make-mirror <enum> ;
M: quotation make-mirror <enum> ;
M: object make-mirror <mirror> ;
+M: struct make-mirror struct>assoc [ [ class>> ] dip ] assoc-map ;
From 1732bd730a2a1bd437a0a48a287b00f45418656c Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 31 Aug 2009 18:57:03 -0500
Subject: [PATCH 2/5] better keys in sturct mirrors
---
basis/mirrors/mirrors.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor
index effcc51caa..4e4e97942a 100644
--- a/basis/mirrors/mirrors.factor
+++ b/basis/mirrors/mirrors.factor
@@ -55,4 +55,4 @@ M: array make-mirror <enum> ;
M: vector make-mirror <enum> ;
M: quotation make-mirror <enum> ;
M: object make-mirror <mirror> ;
-M: struct make-mirror struct>assoc [ [ class>> ] dip ] assoc-map ;
+M: struct make-mirror struct>assoc [ [ [ name>> ] [ class>> ] bi 2array ] dip ] assoc-map ;
From 80e2feacd95a7472ecdfbb23f0c3eff485125d58 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 31 Aug 2009 18:58:42 -0500
Subject: [PATCH 3/5] show c-type instead of factor type
---
basis/mirrors/mirrors.factor | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor
index 4e4e97942a..c081e1015e 100644
--- a/basis/mirrors/mirrors.factor
+++ b/basis/mirrors/mirrors.factor
@@ -55,4 +55,6 @@ M: array make-mirror <enum> ;
M: vector make-mirror <enum> ;
M: quotation make-mirror <enum> ;
M: object make-mirror <mirror> ;
-M: struct make-mirror struct>assoc [ [ [ name>> ] [ class>> ] bi 2array ] dip ] assoc-map ;
+
+M: struct make-mirror struct>assoc
+ [ [ [ name>> ] [ c-type>> ] bi 2array ] dip ] assoc-map ;
From 3d975ea7ab97ee7d6b19798c7c9879ca98676feb Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 31 Aug 2009 19:10:48 -0500
Subject: [PATCH 4/5] struct mirrors were not ready yet
---
basis/mirrors/mirrors.factor | 6 ++----
1 file changed, 2 insertions(+), 4 deletions(-)
diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor
index c081e1015e..7190d61240 100644
--- a/basis/mirrors/mirrors.factor
+++ b/basis/mirrors/mirrors.factor
@@ -3,7 +3,8 @@
USING: accessors arrays assocs classes classes.struct
classes.struct.prettyprint.private classes.tuple
classes.tuple.private combinators generic hashtables kernel
-math quotations sequences slots slots.private vectors words ;
+math quotations sequences slots slots.private vectors words
+continuations fry ;
IN: mirrors
TUPLE: mirror { object read-only } ;
@@ -55,6 +56,3 @@ M: array make-mirror <enum> ;
M: vector make-mirror <enum> ;
M: quotation make-mirror <enum> ;
M: object make-mirror <mirror> ;
-
-M: struct make-mirror struct>assoc
- [ [ [ name>> ] [ c-type>> ] bi 2array ] dip ] assoc-map ;
From f0e14d1c3c5176df3d0c03a254a2641fcf168f3c Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 31 Aug 2009 19:27:29 -0500
Subject: [PATCH 5/5] mirrors on structs again, add summary method for structs
---
basis/mirrors/mirrors.factor | 10 ++++++++++
basis/summary/summary.factor | 11 ++++++++++-
2 files changed, 20 insertions(+), 1 deletion(-)
diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor
index 7190d61240..d9120da9dc 100644
--- a/basis/mirrors/mirrors.factor
+++ b/basis/mirrors/mirrors.factor
@@ -56,3 +56,13 @@ M: array make-mirror <enum> ;
M: vector make-mirror <enum> ;
M: quotation make-mirror <enum> ;
M: object make-mirror <mirror> ;
+
+M: struct make-mirror
+ [
+ [ drop "underlying" ] [ (underlying)>> ] bi 2array 1array
+ ] [
+ '[
+ _ struct>assoc
+ [ [ [ name>> ] [ c-type>> ] bi 2array ] dip ] assoc-map
+ ] [ drop { } ] recover
+ ] bi append ;
diff --git a/basis/summary/summary.factor b/basis/summary/summary.factor
index 44e5374dc5..d8542c7f83 100644
--- a/basis/summary/summary.factor
+++ b/basis/summary/summary.factor
@@ -1,7 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors classes sequences kernel namespaces
-make words math math.parser assocs ;
+make words math math.parser assocs classes.struct
+alien.c-types ;
IN: summary
GENERIC: summary ( object -- string )
@@ -31,3 +32,11 @@ M: assoc summary
M: f summary object-summary ;
M: integer summary object-summary ;
+
+M: struct summary
+ [
+ dup class name>> %
+ " struct of " %
+ byte-length #
+ " bytes " %
+ ] "" make ;