Merge branch 'master' into c-type-words
commit
ab8abeaee4
|
@ -1,11 +1,11 @@
|
||||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.strings alien.c-types alien.accessors alien.structs
|
USING: alien alien.strings alien.c-types alien.accessors
|
||||||
arrays words sequences math kernel namespaces fry libc cpu.architecture
|
arrays words sequences math kernel namespaces fry libc cpu.architecture
|
||||||
io.encodings.utf8 accessors ;
|
io.encodings.utf8 accessors ;
|
||||||
IN: alien.arrays
|
IN: alien.arrays
|
||||||
|
|
||||||
UNION: value-type array struct-type ;
|
INSTANCE: array value-type
|
||||||
|
|
||||||
M: array c-type ;
|
M: array c-type ;
|
||||||
|
|
||||||
|
@ -40,15 +40,6 @@ M: array c-type-boxer-quot
|
||||||
|
|
||||||
M: array c-type-unboxer-quot drop [ >c-ptr ] ;
|
M: array c-type-unboxer-quot drop [ >c-ptr ] ;
|
||||||
|
|
||||||
M: value-type c-type-rep drop int-rep ;
|
|
||||||
|
|
||||||
M: value-type c-type-getter
|
|
||||||
drop [ swap <displaced-alien> ] ;
|
|
||||||
|
|
||||||
M: value-type c-type-setter ( type -- quot )
|
|
||||||
[ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
|
|
||||||
'[ @ swap @ _ memcpy ] ;
|
|
||||||
|
|
||||||
PREDICATE: string-type < pair
|
PREDICATE: string-type < pair
|
||||||
first2 [ char* = ] [ word? ] bi* and ;
|
first2 [ char* = ] [ word? ] bi* and ;
|
||||||
|
|
||||||
|
|
|
@ -99,6 +99,13 @@ M: string c-type ( name -- type )
|
||||||
M: word c-type
|
M: word c-type
|
||||||
"c-type" word-prop resolve-typedef ;
|
"c-type" word-prop resolve-typedef ;
|
||||||
|
|
||||||
|
GENERIC: c-struct? ( type -- ? )
|
||||||
|
|
||||||
|
M: object c-struct?
|
||||||
|
drop f ;
|
||||||
|
M: string c-struct?
|
||||||
|
dup "void" = [ drop f ] [ c-type c-struct? ] if ;
|
||||||
|
|
||||||
! These words being foldable means that words need to be
|
! These words being foldable means that words need to be
|
||||||
! recompiled if a C type is redefined. Even so, folding the
|
! recompiled if a C type is redefined. Even so, folding the
|
||||||
! size facilitates some optimizations.
|
! size facilitates some optimizations.
|
||||||
|
@ -243,6 +250,17 @@ M: c-type-name stack-size c-type stack-size ;
|
||||||
|
|
||||||
M: c-type stack-size size>> cell align ;
|
M: c-type stack-size size>> cell align ;
|
||||||
|
|
||||||
|
MIXIN: value-type
|
||||||
|
|
||||||
|
M: value-type c-type-rep drop int-rep ;
|
||||||
|
|
||||||
|
M: value-type c-type-getter
|
||||||
|
drop [ swap <displaced-alien> ] ;
|
||||||
|
|
||||||
|
M: value-type c-type-setter ( type -- quot )
|
||||||
|
[ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
|
||||||
|
'[ @ swap @ _ memcpy ] ;
|
||||||
|
|
||||||
GENERIC: byte-length ( seq -- n ) flushable
|
GENERIC: byte-length ( seq -- n ) flushable
|
||||||
|
|
||||||
M: byte-array byte-length length ; inline
|
M: byte-array byte-length length ; inline
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.c-types alien.structs alien.complex.functor accessors
|
USING: alien.c-types alien.complex.functor accessors
|
||||||
sequences kernel ;
|
sequences kernel ;
|
||||||
IN: alien.complex
|
IN: alien.complex
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien alien.structs alien.c-types classes.struct math
|
USING: accessors alien alien.c-types classes.struct math
|
||||||
math.functions sequences arrays kernel functors vocabs.parser
|
math.functions sequences arrays kernel functors vocabs.parser
|
||||||
namespaces quotations ;
|
namespaces quotations ;
|
||||||
IN: alien.complex.functor
|
IN: alien.complex.functor
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2009 Joe Groff
|
! Copyright (C) 2009 Joe Groff
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: help.markup help.syntax kernel quotations sequences strings words.symbol ;
|
USING: help.markup help.syntax kernel quotations sequences strings words.symbol classes.struct ;
|
||||||
QUALIFIED-WITH: alien.syntax c
|
QUALIFIED-WITH: alien.syntax c
|
||||||
IN: alien.fortran
|
IN: alien.fortran
|
||||||
|
|
||||||
|
@ -25,7 +25,7 @@ ARTICLE: "alien.fortran-types" "Fortran types"
|
||||||
{ { $snippet "DOUBLE-COMPLEX" } " specifies a double-precision floating-point complex value. The alias " { $snippet "COMPLEX*16" } " is also recognized." }
|
{ { $snippet "DOUBLE-COMPLEX" } " specifies a double-precision floating-point complex value. The alias " { $snippet "COMPLEX*16" } " is also recognized." }
|
||||||
{ { $snippet "CHARACTER(n)" } " specifies a character string of length " { $snippet "n" } ". The Fortran 77 syntax " { $snippet "CHARACTER*n" } " is also recognized." }
|
{ { $snippet "CHARACTER(n)" } " specifies a character string of length " { $snippet "n" } ". The Fortran 77 syntax " { $snippet "CHARACTER*n" } " is also recognized." }
|
||||||
{ "Fortran arrays can be specified by suffixing a comma-separated set of dimensions in parentheses, e.g. " { $snippet "REAL(2,3,4)" } ". Arrays of unspecified length can be specified using " { $snippet "*" } " as a dimension. Arrays are passed in as flat " { $link "specialized-arrays" } "." }
|
{ "Fortran arrays can be specified by suffixing a comma-separated set of dimensions in parentheses, e.g. " { $snippet "REAL(2,3,4)" } ". Arrays of unspecified length can be specified using " { $snippet "*" } " as a dimension. Arrays are passed in as flat " { $link "specialized-arrays" } "." }
|
||||||
{ "Fortran records defined by " { $link POSTPONE: RECORD: } " and C structs defined by " { $link POSTPONE: c:C-STRUCT: } " are also supported as parameter and return types." }
|
{ "Struct classes defined by " { $link POSTPONE: STRUCT: } " are also supported as parameter and return types." }
|
||||||
}
|
}
|
||||||
"When declaring the parameters of Fortran functions, an output argument can be specified by prefixing an exclamation point to the type name. This will cause the function word to leave the final value of the parameter on the stack." ;
|
"When declaring the parameters of Fortran functions, an output argument can be specified by prefixing an exclamation point to the type name. This will cause the function word to leave the final value of the parameter on the stack." ;
|
||||||
|
|
||||||
|
@ -42,10 +42,6 @@ HELP: LIBRARY:
|
||||||
{ $values { "name" "a logical library name" } }
|
{ $values { "name" "a logical library name" } }
|
||||||
{ $description "Sets the logical library for subsequent " { $link POSTPONE: FUNCTION: } " and " { $link POSTPONE: SUBROUTINE: } " definitions. The given library name must have been opened with a previous call to " { $link add-fortran-library } "." } ;
|
{ $description "Sets the logical library for subsequent " { $link POSTPONE: FUNCTION: } " and " { $link POSTPONE: SUBROUTINE: } " definitions. The given library name must have been opened with a previous call to " { $link add-fortran-library } "." } ;
|
||||||
|
|
||||||
HELP: RECORD:
|
|
||||||
{ $syntax "RECORD: NAME { \"TYPE\" \"SLOT\" } ... ;" }
|
|
||||||
{ $description "Defines a Fortran record type with the given slots. The record is defined as the corresponding C struct and can be used as a type for subsequent Fortran or C function declarations." } ;
|
|
||||||
|
|
||||||
HELP: add-fortran-library
|
HELP: add-fortran-library
|
||||||
{ $values { "name" string } { "soname" string } { "fortran-abi" symbol } }
|
{ $values { "name" string } { "soname" string } { "fortran-abi" symbol } }
|
||||||
{ $description "Opens the shared library in the file specified by " { $snippet "soname" } " under the logical name " { $snippet "name" } " so that it may be used in subsequent " { $link POSTPONE: LIBRARY: } " and " { $link fortran-invoke } " calls. Functions and subroutines from the library will be defined using the specified " { $snippet "fortran-abi" } ", which must be one of the supported " { $link "alien.fortran-abis" } "." }
|
{ $description "Opens the shared library in the file specified by " { $snippet "soname" } " under the logical name " { $snippet "name" } " so that it may be used in subsequent " { $link POSTPONE: LIBRARY: } " and " { $link fortran-invoke } " calls. Functions and subroutines from the library will be defined using the specified " { $snippet "fortran-abi" } ", which must be one of the supported " { $link "alien.fortran-abis" } "." }
|
||||||
|
@ -66,7 +62,6 @@ ARTICLE: "alien.fortran" "Fortran FFI"
|
||||||
{ $subsection POSTPONE: LIBRARY: }
|
{ $subsection POSTPONE: LIBRARY: }
|
||||||
{ $subsection POSTPONE: FUNCTION: }
|
{ $subsection POSTPONE: FUNCTION: }
|
||||||
{ $subsection POSTPONE: SUBROUTINE: }
|
{ $subsection POSTPONE: SUBROUTINE: }
|
||||||
{ $subsection POSTPONE: RECORD: }
|
|
||||||
{ $subsection fortran-invoke }
|
{ $subsection fortran-invoke }
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! (c) 2009 Joe Groff, see BSD license
|
! (c) 2009 Joe Groff, see BSD license
|
||||||
USING: accessors alien alien.c-types alien.complex
|
USING: accessors alien alien.c-types alien.complex
|
||||||
alien.fortran alien.fortran.private alien.strings alien.structs
|
alien.fortran alien.fortran.private alien.strings classes.struct
|
||||||
arrays assocs byte-arrays combinators fry
|
arrays assocs byte-arrays combinators fry
|
||||||
generalizations io.encodings.ascii kernel macros
|
generalizations io.encodings.ascii kernel macros
|
||||||
macros.expander namespaces sequences shuffle tools.test ;
|
macros.expander namespaces sequences shuffle tools.test ;
|
||||||
|
@ -8,10 +8,10 @@ IN: alien.fortran.tests
|
||||||
|
|
||||||
<< intel-unix-abi "(alien.fortran-tests)" (add-fortran-library) >>
|
<< intel-unix-abi "(alien.fortran-tests)" (add-fortran-library) >>
|
||||||
LIBRARY: (alien.fortran-tests)
|
LIBRARY: (alien.fortran-tests)
|
||||||
RECORD: FORTRAN_TEST_RECORD
|
STRUCT: FORTRAN_TEST_RECORD
|
||||||
{ "INTEGER" "FOO" }
|
{ FOO int }
|
||||||
{ "REAL(2)" "BAR" }
|
{ BAR double[2] }
|
||||||
{ "CHARACTER*4" "BAS" } ;
|
{ BAS char[4] } ;
|
||||||
|
|
||||||
intel-unix-abi fortran-abi [
|
intel-unix-abi fortran-abi [
|
||||||
|
|
||||||
|
@ -168,29 +168,6 @@ intel-unix-abi fortran-abi [
|
||||||
[ "complex" { "character*17" "character" "integer" } fortran-sig>c-sig ]
|
[ "complex" { "character*17" "character" "integer" } fortran-sig>c-sig ]
|
||||||
unit-test
|
unit-test
|
||||||
|
|
||||||
! fortran-record>c-struct
|
|
||||||
|
|
||||||
[ {
|
|
||||||
{ "double" "ex" }
|
|
||||||
{ "float" "wye" }
|
|
||||||
{ "int" "zee" }
|
|
||||||
{ "char[20]" "woo" }
|
|
||||||
} ] [
|
|
||||||
{
|
|
||||||
{ "DOUBLE-PRECISION" "EX" }
|
|
||||||
{ "REAL" "WYE" }
|
|
||||||
{ "INTEGER" "ZEE" }
|
|
||||||
{ "CHARACTER(20)" "WOO" }
|
|
||||||
} fortran-record>c-struct
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
! RECORD:
|
|
||||||
|
|
||||||
[ 16 ] [ "fortran_test_record" heap-size ] unit-test
|
|
||||||
[ 0 ] [ "foo" "fortran_test_record" offset-of ] unit-test
|
|
||||||
[ 4 ] [ "bar" "fortran_test_record" offset-of ] unit-test
|
|
||||||
[ 12 ] [ "bas" "fortran_test_record" offset-of ] unit-test
|
|
||||||
|
|
||||||
! (fortran-invoke)
|
! (fortran-invoke)
|
||||||
|
|
||||||
[ [
|
[ [
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! (c) 2009 Joe Groff, see BSD license
|
! (c) 2009 Joe Groff, see BSD license
|
||||||
USING: accessors alien alien.c-types alien.complex alien.parser
|
USING: accessors alien alien.c-types alien.complex alien.parser
|
||||||
alien.strings alien.structs alien.syntax arrays ascii assocs
|
alien.strings alien.syntax arrays ascii assocs
|
||||||
byte-arrays combinators combinators.short-circuit fry generalizations
|
byte-arrays combinators combinators.short-circuit fry generalizations
|
||||||
kernel lexer macros math math.parser namespaces parser sequences
|
kernel lexer macros math math.parser namespaces parser sequences
|
||||||
splitting stack-checker vectors vocabs.parser words locals
|
splitting stack-checker vectors vocabs.parser words locals
|
||||||
|
@ -415,14 +415,6 @@ PRIVATE>
|
||||||
: fortran-sig>c-sig ( fortran-return fortran-args -- c-return c-args )
|
: fortran-sig>c-sig ( fortran-return fortran-args -- c-return c-args )
|
||||||
[ fortran-ret-type>c-type ] [ fortran-arg-types>c-types ] bi* append ;
|
[ fortran-ret-type>c-type ] [ fortran-arg-types>c-types ] bi* append ;
|
||||||
|
|
||||||
: fortran-record>c-struct ( record -- struct )
|
|
||||||
[ first2 [ fortran-type>c-type ] [ >lower ] bi* 2array ] map ;
|
|
||||||
|
|
||||||
: define-fortran-record ( name vocab fields -- )
|
|
||||||
[ >lower ] [ ] [ fortran-record>c-struct ] tri* define-struct ;
|
|
||||||
|
|
||||||
SYNTAX: RECORD: scan current-vocab parse-definition define-fortran-record ;
|
|
||||||
|
|
||||||
: set-fortran-abi ( library -- )
|
: set-fortran-abi ( library -- )
|
||||||
library-fortran-abis get-global at fortran-abi set ;
|
library-fortran-abis get-global at fortran-abi set ;
|
||||||
|
|
||||||
|
|
|
@ -8,6 +8,8 @@ IN: alien.structs
|
||||||
|
|
||||||
TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
|
TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
|
||||||
|
|
||||||
|
INSTANCE: struct-type value-type
|
||||||
|
|
||||||
M: struct-type c-type ;
|
M: struct-type c-type ;
|
||||||
|
|
||||||
M: struct-type c-type-stack-align? drop f ;
|
M: struct-type c-type-stack-align? drop f ;
|
||||||
|
@ -33,7 +35,7 @@ M: struct-type box-return
|
||||||
M: struct-type stack-size
|
M: struct-type stack-size
|
||||||
[ heap-size ] [ stack-size ] if-value-struct ;
|
[ heap-size ] [ stack-size ] if-value-struct ;
|
||||||
|
|
||||||
: c-struct? ( type -- ? ) (c-type) struct-type? ;
|
M: struct-type c-struct? drop t ;
|
||||||
|
|
||||||
: (define-struct) ( name size align fields class -- )
|
: (define-struct) ( name size align fields class -- )
|
||||||
[ [ align ] keep ] 2dip new
|
[ [ align ] keep ] 2dip new
|
||||||
|
|
|
@ -73,10 +73,12 @@ HELP: C-ENUM:
|
||||||
{ $syntax "C-ENUM: words... ;" }
|
{ $syntax "C-ENUM: words... ;" }
|
||||||
{ $values { "words" "a sequence of word names" } }
|
{ $values { "words" "a sequence of word names" } }
|
||||||
{ $description "Creates a sequence of word definitions in the current vocabulary. Each word pushes an integer according to its index in the enumeration definition. The first word pushes 0." }
|
{ $description "Creates a sequence of word definitions in the current vocabulary. Each word pushes an integer according to its index in the enumeration definition. The first word pushes 0." }
|
||||||
{ $notes "This word emulates a C-style " { $snippet "enum" } " in Factor. While this feature can be used for any purpose, using integer constants is discouraged unless it is for interfacing with C libraries. Factor code should use symbolic constants instead." }
|
{ $notes "This word emulates a C-style " { $snippet "enum" } " in Factor. While this feature can be used for any purpose, using integer constants is discouraged unless it is for interfacing with C libraries. Factor code should use " { $link "words.symbol" } " or " { $link "singletons" } " instead." }
|
||||||
{ $examples
|
{ $examples
|
||||||
"The following two lines are equivalent:"
|
"Here is an example enumeration definition:"
|
||||||
{ $code "C-ENUM: red green blue ;" ": red 0 ; : green 1 ; : blue 2 ;" }
|
{ $code "C-ENUM: red green blue ;" }
|
||||||
|
"It is equivalent to the following series of definitions:"
|
||||||
|
{ $code "CONSTANT: red 0" "CONSTANT: green 1" "CONSTANT: blue 2" }
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: &:
|
HELP: &:
|
||||||
|
|
|
@ -1,13 +1,18 @@
|
||||||
! (c)Joe Groff bsd license
|
! (c)Joe Groff bsd license
|
||||||
USING: accessors alien alien.c-types arrays assocs classes
|
USING: accessors alien alien.c-types arrays assocs classes
|
||||||
classes.struct combinators combinators.short-circuit continuations
|
classes.struct combinators combinators.short-circuit continuations
|
||||||
definitions fry kernel libc make math math.parser mirrors
|
fry kernel libc make math math.parser mirrors prettyprint.backend
|
||||||
prettyprint.backend prettyprint.custom prettyprint.sections
|
prettyprint.custom prettyprint.sections see.private sequences
|
||||||
see see.private sequences slots strings summary words ;
|
slots strings summary words ;
|
||||||
IN: classes.struct.prettyprint
|
IN: classes.struct.prettyprint
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
: struct-definer-word ( class -- word )
|
||||||
|
struct-slots dup length 2 >=
|
||||||
|
[ second offset>> 0 = \ UNION-STRUCT: \ STRUCT: ? ]
|
||||||
|
[ drop \ STRUCT: ] if ;
|
||||||
|
|
||||||
: struct>assoc ( struct -- assoc )
|
: struct>assoc ( struct -- assoc )
|
||||||
[ class struct-slots ] [ struct-slot-values ] bi zip ;
|
[ class struct-slots ] [ struct-slot-values ] bi zip ;
|
||||||
|
|
||||||
|
@ -15,7 +20,7 @@ IN: classes.struct.prettyprint
|
||||||
<flow \ { pprint-word
|
<flow \ { pprint-word
|
||||||
f <inset {
|
f <inset {
|
||||||
[ name>> text ]
|
[ name>> text ]
|
||||||
[ c-type>> dup string? [ text ] [ pprint* ] if ]
|
[ type>> dup string? [ text ] [ pprint* ] if ]
|
||||||
[ read-only>> [ \ read-only pprint-word ] when ]
|
[ read-only>> [ \ read-only pprint-word ] when ]
|
||||||
[ initial>> [ \ initial: pprint-word pprint* ] when* ]
|
[ initial>> [ \ initial: pprint-word pprint* ] when* ]
|
||||||
} cleave block>
|
} cleave block>
|
||||||
|
@ -34,14 +39,8 @@ IN: classes.struct.prettyprint
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
M: struct-class definer
|
|
||||||
struct-slots dup length 2 >=
|
|
||||||
[ second offset>> 0 = \ UNION-STRUCT: \ STRUCT: ? ]
|
|
||||||
[ drop \ STRUCT: ] if
|
|
||||||
\ ; ;
|
|
||||||
|
|
||||||
M: struct-class see-class*
|
M: struct-class see-class*
|
||||||
<colon dup definer drop pprint-word dup pprint-word
|
<colon dup struct-definer-word pprint-word dup pprint-word
|
||||||
<block struct-slots [ pprint-struct-slot ] each
|
<block struct-slots [ pprint-struct-slot ] each
|
||||||
block> pprint-; block> ;
|
block> pprint-; block> ;
|
||||||
|
|
||||||
|
@ -112,7 +111,7 @@ M: struct-mirror >alist ( mirror -- alist )
|
||||||
] [
|
] [
|
||||||
'[
|
'[
|
||||||
_ struct>assoc
|
_ struct>assoc
|
||||||
[ [ [ name>> ] [ c-type>> ] bi 2array ] dip ] assoc-map
|
[ [ [ name>> ] [ type>> ] bi 2array ] dip ] assoc-map
|
||||||
] [ drop { } ] recover
|
] [ drop { } ] recover
|
||||||
] bi append ;
|
] bi append ;
|
||||||
|
|
||||||
|
|
|
@ -1,11 +1,11 @@
|
||||||
! (c)Joe Groff bsd license
|
! (c)Joe Groff bsd license
|
||||||
USING: accessors alien alien.c-types alien.structs.fields ascii
|
USING: accessors alien alien.c-types ascii
|
||||||
assocs byte-arrays classes.struct classes.tuple.private
|
assocs byte-arrays classes.struct classes.tuple.private
|
||||||
combinators compiler.tree.debugger compiler.units destructors
|
combinators compiler.tree.debugger compiler.units destructors
|
||||||
io.encodings.utf8 io.pathnames io.streams.string kernel libc
|
io.encodings.utf8 io.pathnames io.streams.string kernel libc
|
||||||
literals math mirrors multiline namespaces prettyprint
|
literals math mirrors multiline namespaces prettyprint
|
||||||
prettyprint.config see sequences specialized-arrays system
|
prettyprint.config see sequences specialized-arrays system
|
||||||
tools.test parser lexer eval ;
|
tools.test parser lexer eval layouts ;
|
||||||
SPECIALIZED-ARRAY: char
|
SPECIALIZED-ARRAY: char
|
||||||
SPECIALIZED-ARRAY: int
|
SPECIALIZED-ARRAY: int
|
||||||
SPECIALIZED-ARRAY: ushort
|
SPECIALIZED-ARRAY: ushort
|
||||||
|
@ -196,43 +196,43 @@ UNION-STRUCT: struct-test-float-and-bits
|
||||||
[ [ struct-test-float-and-bits see ] with-string-writer ] unit-test
|
[ [ struct-test-float-and-bits see ] with-string-writer ] unit-test
|
||||||
|
|
||||||
[ {
|
[ {
|
||||||
T{ field-spec
|
T{ struct-slot-spec
|
||||||
{ name "x" }
|
{ name "x" }
|
||||||
{ offset 0 }
|
{ offset 0 }
|
||||||
|
{ initial 0 }
|
||||||
|
{ class fixnum }
|
||||||
{ type "char" }
|
{ type "char" }
|
||||||
{ reader x>> }
|
|
||||||
{ writer (>>x) }
|
|
||||||
}
|
}
|
||||||
T{ field-spec
|
T{ struct-slot-spec
|
||||||
{ name "y" }
|
{ name "y" }
|
||||||
{ offset 4 }
|
{ offset 4 }
|
||||||
|
{ initial 123 }
|
||||||
|
{ class integer }
|
||||||
{ type "int" }
|
{ type "int" }
|
||||||
{ reader y>> }
|
|
||||||
{ writer (>>y) }
|
|
||||||
}
|
}
|
||||||
T{ field-spec
|
T{ struct-slot-spec
|
||||||
{ name "z" }
|
{ name "z" }
|
||||||
{ offset 8 }
|
{ offset 8 }
|
||||||
|
{ initial f }
|
||||||
{ type "bool" }
|
{ type "bool" }
|
||||||
{ reader z>> }
|
{ class object }
|
||||||
{ writer (>>z) }
|
|
||||||
}
|
}
|
||||||
} ] [ "struct-test-foo" c-type fields>> ] unit-test
|
} ] [ "struct-test-foo" c-type fields>> ] unit-test
|
||||||
|
|
||||||
[ {
|
[ {
|
||||||
T{ field-spec
|
T{ struct-slot-spec
|
||||||
{ name "f" }
|
{ name "f" }
|
||||||
{ offset 0 }
|
{ offset 0 }
|
||||||
{ type "float" }
|
{ type "float" }
|
||||||
{ reader f>> }
|
{ class float }
|
||||||
{ writer (>>f) }
|
{ initial 0.0 }
|
||||||
}
|
}
|
||||||
T{ field-spec
|
T{ struct-slot-spec
|
||||||
{ name "bits" }
|
{ name "bits" }
|
||||||
{ offset 0 }
|
{ offset 0 }
|
||||||
{ type "uint" }
|
{ type "uint" }
|
||||||
{ reader bits>> }
|
{ class integer }
|
||||||
{ writer (>>bits) }
|
{ initial 0 }
|
||||||
}
|
}
|
||||||
} ] [ "struct-test-float-and-bits" c-type fields>> ] unit-test
|
} ] [ "struct-test-float-and-bits" c-type fields>> ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -1,14 +1,12 @@
|
||||||
! (c)Joe Groff bsd license
|
! (c)Joe Groff bsd license
|
||||||
USING: accessors alien alien.c-types alien.structs
|
USING: accessors alien alien.c-types arrays byte-arrays classes
|
||||||
alien.structs.fields arrays byte-arrays classes classes.parser
|
classes.parser classes.tuple classes.tuple.parser
|
||||||
classes.tuple classes.tuple.parser classes.tuple.private
|
classes.tuple.private combinators combinators.short-circuit
|
||||||
combinators combinators.short-circuit combinators.smart
|
combinators.smart cpu.architecture definitions functors.backend
|
||||||
definitions functors.backend fry generalizations generic.parser
|
fry generalizations generic.parser kernel kernel.private lexer
|
||||||
kernel kernel.private lexer libc locals macros make math
|
libc locals macros make math math.order parser quotations
|
||||||
math.order parser quotations sequences slots slots.private
|
sequences slots slots.private specialized-arrays vectors words
|
||||||
specialized-arrays vectors words summary namespaces assocs
|
summary namespaces assocs ;
|
||||||
compiler.tree.propagation.transforms ;
|
|
||||||
FROM: slots => reader-word writer-word ;
|
|
||||||
IN: classes.struct
|
IN: classes.struct
|
||||||
|
|
||||||
SPECIALIZED-ARRAY: uchar
|
SPECIALIZED-ARRAY: uchar
|
||||||
|
@ -22,7 +20,7 @@ TUPLE: struct
|
||||||
{ (underlying) c-ptr read-only } ;
|
{ (underlying) c-ptr read-only } ;
|
||||||
|
|
||||||
TUPLE: struct-slot-spec < slot-spec
|
TUPLE: struct-slot-spec < slot-spec
|
||||||
c-type ;
|
type ;
|
||||||
|
|
||||||
PREDICATE: struct-class < tuple-class
|
PREDICATE: struct-class < tuple-class
|
||||||
superclass \ struct eq? ;
|
superclass \ struct eq? ;
|
||||||
|
@ -86,11 +84,11 @@ MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) )
|
||||||
[ struct-slots [ initial>> ] map over length tail append ] keep ;
|
[ struct-slots [ initial>> ] map over length tail append ] keep ;
|
||||||
|
|
||||||
: (reader-quot) ( slot -- quot )
|
: (reader-quot) ( slot -- quot )
|
||||||
[ c-type>> c-type-getter-boxer ]
|
[ type>> c-type-getter-boxer ]
|
||||||
[ offset>> [ >c-ptr ] swap suffix ] bi prepend ;
|
[ offset>> [ >c-ptr ] swap suffix ] bi prepend ;
|
||||||
|
|
||||||
: (writer-quot) ( slot -- quot )
|
: (writer-quot) ( slot -- quot )
|
||||||
[ c-type>> c-setter ]
|
[ type>> c-setter ]
|
||||||
[ offset>> [ >c-ptr ] swap suffix ] bi prepend ;
|
[ offset>> [ >c-ptr ] swap suffix ] bi prepend ;
|
||||||
|
|
||||||
: (boxer-quot) ( class -- quot )
|
: (boxer-quot) ( class -- quot )
|
||||||
|
@ -117,6 +115,39 @@ M: struct-class writer-quot
|
||||||
|
|
||||||
! c-types
|
! c-types
|
||||||
|
|
||||||
|
TUPLE: struct-c-type < abstract-c-type
|
||||||
|
fields
|
||||||
|
return-in-registers? ;
|
||||||
|
|
||||||
|
INSTANCE: struct-c-type value-type
|
||||||
|
|
||||||
|
M: struct-c-type c-type ;
|
||||||
|
|
||||||
|
M: struct-c-type c-type-stack-align? drop f ;
|
||||||
|
|
||||||
|
: if-value-struct ( ctype true false -- )
|
||||||
|
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
|
||||||
|
|
||||||
|
M: struct-c-type unbox-parameter
|
||||||
|
[ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
|
||||||
|
|
||||||
|
M: struct-c-type box-parameter
|
||||||
|
[ %box-large-struct ] [ box-parameter ] if-value-struct ;
|
||||||
|
|
||||||
|
: if-small-struct ( c-type true false -- ? )
|
||||||
|
[ dup return-struct-in-registers? ] 2dip '[ f swap @ ] if ; inline
|
||||||
|
|
||||||
|
M: struct-c-type unbox-return
|
||||||
|
[ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ;
|
||||||
|
|
||||||
|
M: struct-c-type box-return
|
||||||
|
[ %box-small-struct ] [ %box-large-struct ] if-small-struct ;
|
||||||
|
|
||||||
|
M: struct-c-type stack-size
|
||||||
|
[ heap-size ] [ stack-size ] if-value-struct ;
|
||||||
|
|
||||||
|
M: struct-c-type c-struct? drop t ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
: struct-slot-values-quot ( class -- quot )
|
: struct-slot-values-quot ( class -- quot )
|
||||||
struct-slots
|
struct-slots
|
||||||
|
@ -139,47 +170,31 @@ M: struct-class writer-quot
|
||||||
[ \ clone-underlying swap literalize \ memory>struct [ ] 3sequence ] bi
|
[ \ clone-underlying swap literalize \ memory>struct [ ] 3sequence ] bi
|
||||||
define-inline-method ;
|
define-inline-method ;
|
||||||
|
|
||||||
: slot>field ( slot -- field )
|
: c-type-for-class ( class -- c-type )
|
||||||
field-spec new swap {
|
struct-c-type new swap {
|
||||||
[ name>> >>name ]
|
[ drop byte-array >>class ]
|
||||||
[ offset>> >>offset ]
|
[ >>boxed-class ]
|
||||||
[ c-type>> >>type ]
|
[ struct-slots >>fields ]
|
||||||
[ name>> reader-word >>reader ]
|
[ "struct-size" word-prop >>size ]
|
||||||
[ name>> writer-word >>writer ]
|
[ "struct-align" word-prop >>align ]
|
||||||
} cleave ;
|
|
||||||
|
|
||||||
: define-struct-for-class ( class -- )
|
|
||||||
[
|
|
||||||
{
|
|
||||||
[ name>> ]
|
|
||||||
[ "struct-size" word-prop ]
|
|
||||||
[ "struct-align" word-prop ]
|
|
||||||
[ struct-slots [ slot>field ] map ]
|
|
||||||
} cleave
|
|
||||||
struct-type (define-struct)
|
|
||||||
] [
|
|
||||||
{
|
|
||||||
[ name>> c-type ]
|
|
||||||
[ (unboxer-quot) >>unboxer-quot ]
|
[ (unboxer-quot) >>unboxer-quot ]
|
||||||
[ (boxer-quot) >>boxer-quot ]
|
[ (boxer-quot) >>boxer-quot ]
|
||||||
[ >>boxed-class ]
|
} cleave ;
|
||||||
} cleave drop
|
|
||||||
] bi ;
|
|
||||||
|
|
||||||
: align-offset ( offset class -- offset' )
|
: align-offset ( offset class -- offset' )
|
||||||
c-type-align align ;
|
c-type-align align ;
|
||||||
|
|
||||||
: struct-offsets ( slots -- size )
|
: struct-offsets ( slots -- size )
|
||||||
0 [
|
0 [
|
||||||
[ c-type>> align-offset ] keep
|
[ type>> align-offset ] keep
|
||||||
[ (>>offset) ] [ c-type>> heap-size + ] 2bi
|
[ (>>offset) ] [ type>> heap-size + ] 2bi
|
||||||
] reduce ;
|
] reduce ;
|
||||||
|
|
||||||
: union-struct-offsets ( slots -- size )
|
: union-struct-offsets ( slots -- size )
|
||||||
[ 0 >>offset c-type>> heap-size ] [ max ] map-reduce ;
|
[ 0 >>offset type>> heap-size ] [ max ] map-reduce ;
|
||||||
|
|
||||||
: struct-align ( slots -- align )
|
: struct-align ( slots -- align )
|
||||||
[ c-type>> c-type-align ] [ max ] map-reduce ;
|
[ type>> c-type-align ] [ max ] map-reduce ;
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
M: struct-class c-type name>> c-type ;
|
M: struct-class c-type name>> c-type ;
|
||||||
|
@ -228,7 +243,7 @@ M: struct byte-length class "struct-size" word-prop ; foldable
|
||||||
[ (struct-methods) ] tri ;
|
[ (struct-methods) ] tri ;
|
||||||
|
|
||||||
: check-struct-slots ( slots -- )
|
: check-struct-slots ( slots -- )
|
||||||
[ c-type>> c-type drop ] each ;
|
[ type>> c-type drop ] each ;
|
||||||
|
|
||||||
: redefine-struct-tuple-class ( class -- )
|
: redefine-struct-tuple-class ( class -- )
|
||||||
[ dup class? [ forget-class ] [ drop ] if ] [ struct f define-tuple-class ] bi ;
|
[ dup class? [ forget-class ] [ drop ] if ] [ struct f define-tuple-class ] bi ;
|
||||||
|
@ -244,7 +259,7 @@ M: struct byte-length class "struct-size" word-prop ; foldable
|
||||||
[ check-struct-slots ] _ [ struct-align [ align ] keep ] tri
|
[ check-struct-slots ] _ [ struct-align [ align ] keep ] tri
|
||||||
(struct-word-props)
|
(struct-word-props)
|
||||||
]
|
]
|
||||||
[ drop define-struct-for-class ] 2tri ; inline
|
[ drop [ c-type-for-class ] [ name>> ] bi typedef ] 2tri ; inline
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: define-struct-class ( class slots -- )
|
: define-struct-class ( class slots -- )
|
||||||
|
@ -265,7 +280,7 @@ ERROR: invalid-struct-slot token ;
|
||||||
: <struct-slot-spec> ( name c-type attributes -- slot-spec )
|
: <struct-slot-spec> ( name c-type attributes -- slot-spec )
|
||||||
[ struct-slot-spec new ] 3dip
|
[ struct-slot-spec new ] 3dip
|
||||||
[ >>name ]
|
[ >>name ]
|
||||||
[ [ >>c-type ] [ struct-slot-class >>class ] bi ]
|
[ [ >>type ] [ struct-slot-class >>class ] bi ]
|
||||||
[ [ dup empty? ] [ peel-off-attributes ] until drop ] tri* ;
|
[ [ dup empty? ] [ peel-off-attributes ] until drop ] tri* ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors kernel namespaces make math sequences layouts
|
USING: accessors kernel namespaces make math sequences layouts
|
||||||
alien.c-types alien.structs cpu.architecture ;
|
alien.c-types cpu.architecture ;
|
||||||
IN: compiler.alien
|
IN: compiler.alien
|
||||||
|
|
||||||
: large-struct? ( ctype -- ? )
|
: large-struct? ( ctype -- ? )
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays assocs combinators hashtables kernel
|
USING: accessors arrays assocs combinators hashtables kernel
|
||||||
math fry namespaces make sequences words byte-arrays
|
math fry namespaces make sequences words byte-arrays
|
||||||
layouts alien.c-types alien.structs
|
layouts alien.c-types
|
||||||
stack-checker.inlining cpu.architecture
|
stack-checker.inlining cpu.architecture
|
||||||
compiler.tree
|
compiler.tree
|
||||||
compiler.tree.builder
|
compiler.tree.builder
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: namespaces make math math.order math.parser sequences accessors
|
USING: namespaces make math math.order math.parser sequences accessors
|
||||||
kernel kernel.private layouts assocs words summary arrays
|
kernel kernel.private layouts assocs words summary arrays
|
||||||
combinators classes.algebra alien alien.c-types alien.structs
|
combinators classes.algebra alien alien.c-types
|
||||||
alien.strings alien.arrays alien.complex alien.libraries sets libc
|
alien.strings alien.arrays alien.complex alien.libraries sets libc
|
||||||
continuations.private fry cpu.architecture classes locals
|
continuations.private fry cpu.architecture classes locals
|
||||||
source-files.errors slots parser generic.parser
|
source-files.errors slots parser generic.parser
|
||||||
|
@ -16,6 +16,8 @@ compiler.cfg.registers
|
||||||
compiler.cfg.builder
|
compiler.cfg.builder
|
||||||
compiler.codegen.fixup
|
compiler.codegen.fixup
|
||||||
compiler.utilities ;
|
compiler.utilities ;
|
||||||
|
QUALIFIED: classes.struct
|
||||||
|
QUALIFIED: alien.structs
|
||||||
IN: compiler.codegen
|
IN: compiler.codegen
|
||||||
|
|
||||||
SYMBOL: insn-counts
|
SYMBOL: insn-counts
|
||||||
|
@ -316,7 +318,10 @@ GENERIC: flatten-value-type ( type -- types )
|
||||||
|
|
||||||
M: object flatten-value-type 1array ;
|
M: object flatten-value-type 1array ;
|
||||||
|
|
||||||
M: struct-type flatten-value-type ( type -- types )
|
M: alien.structs:struct-type flatten-value-type ( type -- types )
|
||||||
|
stack-size cell align (flatten-int-type) ;
|
||||||
|
|
||||||
|
M: classes.struct:struct-c-type flatten-value-type ( type -- types )
|
||||||
stack-size cell align (flatten-int-type) ;
|
stack-size cell align (flatten-int-type) ;
|
||||||
|
|
||||||
M: long-long-type flatten-value-type ( type -- types )
|
M: long-long-type flatten-value-type ( type -- types )
|
||||||
|
|
|
@ -81,7 +81,10 @@ IN: compiler.tree.propagation.known-words
|
||||||
class>> dup null-class? [ drop null ] [ math-closure ] if ;
|
class>> dup null-class? [ drop null ] [ math-closure ] if ;
|
||||||
|
|
||||||
: unary-op-interval ( info quot -- newinterval )
|
: unary-op-interval ( info quot -- newinterval )
|
||||||
[ interval>> ] dip call ; inline
|
[
|
||||||
|
dup class>> real classes-intersect?
|
||||||
|
[ interval>> ] [ drop full-interval ] if
|
||||||
|
] dip call ; inline
|
||||||
|
|
||||||
: unary-op ( word interval-quot post-proc-quot -- )
|
: unary-op ( word interval-quot post-proc-quot -- )
|
||||||
'[
|
'[
|
||||||
|
|
|
@ -186,6 +186,10 @@ IN: compiler.tree.propagation.tests
|
||||||
|
|
||||||
[ t ] [ [ { complex } declare absq ] final-info first interval>> [0,inf] = ] unit-test
|
[ t ] [ [ { complex } declare absq ] final-info first interval>> [0,inf] = ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ [ { float float } declare rect> C{ 0.0 0.0 } + absq ] final-info first interval>> [0,inf] = ] unit-test
|
||||||
|
|
||||||
|
[ V{ float } ] [ [ { float float } declare rect> C{ 0.0 0.0 } + absq ] final-classes ] unit-test
|
||||||
|
|
||||||
[ t ] [ [ [ - absq ] [ + ] 2map-reduce ] final-info first interval>> [0,inf] = ] unit-test
|
[ t ] [ [ [ - absq ] [ + ] 2map-reduce ] final-info first interval>> [0,inf] = ] unit-test
|
||||||
|
|
||||||
[ t ] [ [ { double-array double-array } declare [ - absq ] [ + ] 2map-reduce ] final-info first interval>> [0,inf] = ] unit-test
|
[ t ] [ [ { double-array double-array } declare [ - absq ] [ + ] 2map-reduce ] final-info first interval>> [0,inf] = ] unit-test
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2005, 2009 Slava Pestov.
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays kernel math namespaces make sequences system
|
USING: accessors arrays kernel math namespaces make sequences system
|
||||||
layouts alien alien.c-types alien.accessors alien.structs slots
|
layouts alien alien.c-types alien.accessors slots
|
||||||
splitting assocs combinators locals compiler.constants
|
splitting assocs combinators locals compiler.constants
|
||||||
compiler.codegen compiler.codegen.fixup compiler.cfg.instructions
|
compiler.codegen compiler.codegen.fixup compiler.cfg.instructions
|
||||||
compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.stack-frame
|
compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.stack-frame
|
||||||
|
|
|
@ -1,9 +1,11 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays sequences math splitting make assocs kernel
|
USING: accessors arrays sequences math splitting make assocs kernel
|
||||||
layouts system alien.c-types alien.structs cpu.architecture
|
layouts system alien.c-types cpu.architecture
|
||||||
cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 compiler.codegen
|
cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 compiler.codegen
|
||||||
compiler.cfg.registers ;
|
compiler.cfg.registers ;
|
||||||
|
QUALIFIED: alien.structs
|
||||||
|
QUALIFIED: classes.struct
|
||||||
IN: cpu.x86.64.unix
|
IN: cpu.x86.64.unix
|
||||||
|
|
||||||
M: int-regs param-regs
|
M: int-regs param-regs
|
||||||
|
@ -39,13 +41,18 @@ stack-params \ (stack-value) c-type (>>rep) >>
|
||||||
heap-size cell align
|
heap-size cell align
|
||||||
cell /i \ (stack-value) c-type <repetition> ;
|
cell /i \ (stack-value) c-type <repetition> ;
|
||||||
|
|
||||||
M: struct-type flatten-value-type ( type -- seq )
|
: flatten-struct ( c-type -- seq )
|
||||||
dup heap-size 16 > [
|
dup heap-size 16 > [
|
||||||
flatten-large-struct
|
flatten-large-struct
|
||||||
] [
|
] [
|
||||||
flatten-small-struct
|
flatten-small-struct
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
|
M: alien.structs:struct-type flatten-value-type ( type -- seq )
|
||||||
|
flatten-struct ;
|
||||||
|
M: classes.struct:struct-c-type flatten-value-type ( type -- seq )
|
||||||
|
flatten-struct ;
|
||||||
|
|
||||||
M: x86.64 return-struct-in-registers? ( c-type -- ? )
|
M: x86.64 return-struct-in-registers? ( c-type -- ? )
|
||||||
heap-size 2 cells <= ;
|
heap-size 2 cells <= ;
|
||||||
|
|
||||||
|
|
|
@ -252,14 +252,14 @@ ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial"
|
||||||
"Here's an example usage where we'll make a book table, insert some objects, and query them." $nl
|
"Here's an example usage where we'll make a book table, insert some objects, and query them." $nl
|
||||||
"First, let's set up a custom combinator for using our database. See " { $link "db-custom-database-combinators" } " for more details."
|
"First, let's set up a custom combinator for using our database. See " { $link "db-custom-database-combinators" } " for more details."
|
||||||
{ $code <"
|
{ $code <"
|
||||||
USING: db.sqlite db io.files ;
|
USING: db.sqlite db io.files io.files.temp ;
|
||||||
: with-book-db ( quot -- )
|
: with-book-db ( quot -- )
|
||||||
"book.db" temp-file <sqlite-db> swap with-db ; inline"> }
|
"book.db" temp-file <sqlite-db> swap with-db ; inline"> }
|
||||||
"Now let's create the table manually:"
|
"Now let's create the table manually:"
|
||||||
{ $code <" "create table books
|
{ $code <" "create table books
|
||||||
(id integer primary key, title text, author text, date_published timestamp,
|
(id integer primary key, title text, author text, date_published timestamp,
|
||||||
edition integer, cover_price double, condition text)"
|
edition integer, cover_price double, condition text)"
|
||||||
[ sql-command ] with-book-db" "> }
|
[ sql-command ] with-book-db"> }
|
||||||
"Time to insert some books:"
|
"Time to insert some books:"
|
||||||
{ $code <"
|
{ $code <"
|
||||||
"insert into books
|
"insert into books
|
||||||
|
|
|
@ -1,6 +1,12 @@
|
||||||
USING: help.html tools.test help.topics kernel ;
|
USING: help.html tools.test help.topics kernel sequences vocabs ;
|
||||||
IN: help.html.tests
|
IN: help.html.tests
|
||||||
|
|
||||||
[ ] [ "xml" >link help>html drop ] unit-test
|
[ ] [ "xml" >link help>html drop ] unit-test
|
||||||
|
|
||||||
[ "article-foobar.html" ] [ "foobar" >link topic>filename ] unit-test
|
[ "article-foobar.html" ] [ "foobar" >link topic>filename ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ all-vocabs-really [ vocab-spec? ] all? ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ all-vocabs-really [ vocab-name "sequences.private" = ] any? ] unit-test
|
||||||
|
|
||||||
|
[ f ] [ all-vocabs-really [ vocab-name "scratchpad" = ] any? ] unit-test
|
||||||
|
|
|
@ -73,7 +73,8 @@ M: topic url-of topic>filename ;
|
||||||
dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
|
dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
|
||||||
|
|
||||||
: all-vocabs-really ( -- seq )
|
: all-vocabs-really ( -- seq )
|
||||||
all-vocabs-recursive >hashtable f over delete-at no-roots remove-redundant-prefixes ;
|
all-vocabs-recursive >hashtable no-roots remove-redundant-prefixes
|
||||||
|
[ vocab-name "scratchpad" = not ] filter ;
|
||||||
|
|
||||||
: all-topics ( -- topics )
|
: all-topics ( -- topics )
|
||||||
[
|
[
|
||||||
|
|
|
@ -48,6 +48,7 @@ ARTICLE: "power-functions" "Powers and logarithms"
|
||||||
{ $subsection exp }
|
{ $subsection exp }
|
||||||
{ $subsection cis }
|
{ $subsection cis }
|
||||||
{ $subsection log }
|
{ $subsection log }
|
||||||
|
"Other logarithms:"
|
||||||
{ $subsection log1+ }
|
{ $subsection log1+ }
|
||||||
{ $subsection log10 }
|
{ $subsection log10 }
|
||||||
"Raising a number to a power:"
|
"Raising a number to a power:"
|
||||||
|
|
|
@ -6,7 +6,7 @@ ARTICLE: "math.libm" "C standard library math functions"
|
||||||
{ $warning
|
{ $warning
|
||||||
"These functions are unsafe. The compiler special-cases them to operate on floats only. They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:"
|
"These functions are unsafe. The compiler special-cases them to operate on floats only. They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:"
|
||||||
{ $example "USE: math.functions" "2.0 acos ." "C{ 0.0 1.316957896924817 }" }
|
{ $example "USE: math.functions" "2.0 acos ." "C{ 0.0 1.316957896924817 }" }
|
||||||
{ $unchecked-example "USE: math.libm" "2 facos ." "0/0." } }
|
{ $unchecked-example "USE: math.libm" "2.0 facos ." "0/0." } }
|
||||||
"Trigonometric functions:"
|
"Trigonometric functions:"
|
||||||
{ $subsection fcos }
|
{ $subsection fcos }
|
||||||
{ $subsection fsin }
|
{ $subsection fsin }
|
||||||
|
@ -20,6 +20,7 @@ ARTICLE: "math.libm" "C standard library math functions"
|
||||||
"Exponentials and logarithms:"
|
"Exponentials and logarithms:"
|
||||||
{ $subsection fexp }
|
{ $subsection fexp }
|
||||||
{ $subsection flog }
|
{ $subsection flog }
|
||||||
|
{ $subsection flog10 }
|
||||||
"Powers:"
|
"Powers:"
|
||||||
{ $subsection fpow }
|
{ $subsection fpow }
|
||||||
{ $subsection fsqrt } ;
|
{ $subsection fsqrt } ;
|
||||||
|
@ -66,6 +67,10 @@ HELP: flog
|
||||||
{ $values { "x" real } { "y" real } }
|
{ $values { "x" real } { "y" real } }
|
||||||
{ $description "Calls the natural logarithm function from the C standard library. User code should call " { $link log } " instead." } ;
|
{ $description "Calls the natural logarithm function from the C standard library. User code should call " { $link log } " instead." } ;
|
||||||
|
|
||||||
|
HELP: flog10
|
||||||
|
{ $values { "x" real } { "y" real } }
|
||||||
|
{ $description "Calls the base 10 logarithm function from the C standard library. User code should call " { $link log10 } " instead." } ;
|
||||||
|
|
||||||
HELP: fpow
|
HELP: fpow
|
||||||
{ $values { "x" real } { "y" real } { "z" real } }
|
{ $values { "x" real } { "y" real } { "z" real } }
|
||||||
{ $description "Calls the power function (" { $snippet "z=x^y" } ") from the C standard library. User code should call " { $link ^ } " instead." } ;
|
{ $description "Calls the power function (" { $snippet "z=x^y" } ") from the C standard library. User code should call " { $link ^ } " instead." } ;
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
! (c)2009 Joe Groff bsd license
|
! (c)2009 Joe Groff bsd license
|
||||||
USING: accessors alien alien.c-types alien.structs arrays
|
USING: accessors alien alien.c-types arrays
|
||||||
assocs classes classes.mixin classes.parser classes.singleton
|
assocs classes classes.mixin classes.parser classes.singleton
|
||||||
classes.tuple classes.tuple.private combinators combinators.tuple destructors fry
|
classes.tuple classes.tuple.private combinators combinators.tuple destructors fry
|
||||||
generic generic.parser gpu gpu.buffers gpu.framebuffers
|
generic generic.parser gpu gpu.buffers gpu.framebuffers
|
||||||
|
|
|
@ -9,7 +9,7 @@ IN: irc.client
|
||||||
[ (connect-irc) (do-login) spawn-irc ] with-irc ;
|
[ (connect-irc) (do-login) spawn-irc ] with-irc ;
|
||||||
|
|
||||||
: attach-chat ( irc-chat irc-client -- ) [ (attach-chat) ] with-irc ;
|
: attach-chat ( irc-chat irc-client -- ) [ (attach-chat) ] with-irc ;
|
||||||
: detach-chat ( irc-chat -- ) dup [ client>> remove-chat ] with-irc ;
|
: detach-chat ( irc-chat -- ) dup client>> [ remove-chat ] with-irc ;
|
||||||
: speak ( message irc-chat -- ) dup client>> [ (speak) ] with-irc ;
|
: speak ( message irc-chat -- ) dup client>> [ (speak) ] with-irc ;
|
||||||
: hear ( irc-chat -- message ) in-messages>> mailbox-get ;
|
: hear ( irc-chat -- message ) in-messages>> mailbox-get ;
|
||||||
: terminate-irc ( irc-client -- ) [ (terminate-irc) ] with-irc ;
|
: terminate-irc ( irc-client -- ) [ (terminate-irc) ] with-irc ;
|
||||||
|
|
Loading…
Reference in New Issue