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

Joe Groff 2009-08-26 21:18:19 -05:00
parent d5bc08cdea
commit 629e8bc89b
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