steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add a partial eval for memory>struct so that it compiles efficiently when the struct class is known

db4
Joe Groff 2009-08-26 21:18:19 -05:00
parent 5376263984
commit 4b56fa8009
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/classes/struct/struct.factor
View File

@ -5,7 +5,8 @@ classes.tuple classes.tuple.parser classes.tuple.private
combinators combinators.short-circuit combinators.smart fry combinators combinators.short-circuit combinators.smart fry
generalizations generic.parser kernel kernel.private lexer generalizations generic.parser kernel kernel.private lexer
libc macros make math math.order parser quotations sequences libc macros make math math.order parser quotations sequences
slots slots.private struct-arrays vectors words ; slots slots.private struct-arrays vectors words
compiler.tree.propagation.transforms ;
FROM: slots => reader-word writer-word ; FROM: slots => reader-word writer-word ;
IN: classes.struct IN: classes.struct
@ -18,7 +19,7 @@ TUPLE: struct-slot-spec < slot-spec
c-type ; c-type ;
PREDICATE: struct-class < tuple-class PREDICATE: struct-class < tuple-class
\ struct subclass-of? ; { [ \ struct subclass-of? ] [ all-slots length 1 = ] } 1&& ;
: struct-slots ( struct -- slots ) : struct-slots ( struct -- slots )
"struct-slots" word-prop ; "struct-slots" word-prop ;
@ -35,8 +36,11 @@ M: struct equal?
} 2&& ; } 2&& ;
: memory>struct ( ptr class -- struct ) : memory>struct ( ptr class -- struct )
over c-ptr? [ swap \ c-ptr bad-slot-value ] unless [ 1array ] dip slots>tuple ;
tuple-layout <tuple> [ 2 set-slot ] keep ; inline
\ memory>struct [
dup struct-class? [ '[ _ boa ] ] [ drop f ] if
] 1 define-partial-eval
: malloc-struct ( class -- struct ) : malloc-struct ( class -- struct )
[ heap-size malloc ] keep memory>struct ; inline [ heap-size malloc ] keep memory>struct ; inline