Merge branch 'master' of git://factorcode.org/git/factor into fortran

db4
Joe Groff 2009-02-06 19:05:25 -06:00
commit 6ff37d2951
54 changed files with 456 additions and 221 deletions

View File

@ -178,6 +178,8 @@ GENERIC: byte-length ( seq -- n ) flushable
M: byte-array byte-length length ;
M: f byte-length drop 0 ;
: c-getter ( name -- quot )
c-type-getter [
[ "Cannot read struct fields with this type" throw ]

View File

@ -559,9 +559,17 @@ FUNCTION: test_struct_14 ffi_test_44 ( ) ; inline
[ ] [ stack-frame-bustage 2drop ] unit-test
FUNCTION: complex-float ffi_test_45 ( complex-float x, complex-double y ) ;
FUNCTION: complex-float ffi_test_45 ( int x ) ;
[ C{ 3.0 0.0 } ] [ 3 ffi_test_45 ] unit-test
FUNCTION: complex-double ffi_test_46 ( int x ) ;
[ C{ 3.0 0.0 } ] [ 3 ffi_test_46 ] unit-test
FUNCTION: complex-float ffi_test_47 ( complex-float x, complex-double y ) ;
[ C{ 4.0 4.0 } ] [
C{ 1.0 2.0 }
C{ 1.5 1.0 } ffi_test_45
] unit-test
C{ 1.5 1.0 } ffi_test_47
] unit-test

View File

@ -10,7 +10,6 @@ xml.writer
xml.traversal
xml.syntax
html.components
html.elements
html.forms
html.templates
html.templates.chloe
@ -20,6 +19,7 @@ http
http.server
http.server.redirection
http.server.responses
io.streams.string
furnace.utilities ;
IN: furnace.chloe-tags
@ -58,62 +58,67 @@ CHLOE: write-atom drop [ write-atom-feeds ] [code] ;
#! Side-effects current namespace.
'[ [ [ _ ] dip link-attr ] each-responder ] [code] ;
: a-start-tag ( tag -- )
[ <a ] [code]
[ attrs>> non-chloe-attrs-only compile-attrs ]
[ compile-link-attrs ]
[ compile-a-url ]
tri
[ =href a> ] [code] ;
: process-attrs ( assoc -- newassoc )
[ "@" ?head [ value present ] when ] assoc-map ;
: a-end-tag ( tag -- )
drop [ </a> ] [code] ;
: non-chloe-attrs ( tag -- )
attrs>> non-chloe-attrs-only [ process-attrs ] [code-with] ;
: a-attrs ( tag -- )
[ non-chloe-attrs ]
[ compile-link-attrs ]
[ compile-a-url ] tri
[ present swap "href" swap [ set-at ] keep ] [code] ;
CHLOE: a
[
[ a-start-tag ] [ compile-children ] [ a-end-tag ] tri
[ a-attrs ]
[ compile-children>string ] bi
[ <unescaped> [XML <a><-></a> XML] second swap >>attrs ]
[xml-code]
] compile-with-scope ;
CHLOE: base
compile-a-url [ <base =href base/> ] [code] ;
compile-a-url [ [XML <base href=<->/> XML] ] [xml-code] ;
: compile-hidden-form-fields ( for -- )
'[
<div "display: none;" =style div>
_ [ "," split [ hidden render ] each ] when*
nested-forms get " " join f like nested-forms-key hidden-form-field
[ modify-form ] each-responder
</div>
_ [ "," split [ hidden render>xml ] map ] [ f ] if*
nested-forms get " " join f like nested-forms-key hidden-form-field>xml
[ [ modify-form ] each-responder ] with-string-writer <unescaped>
[XML <div style="display: none;"><-><-><-></div> XML]
] [code] ;
: compile-form-attrs ( method action attrs -- )
[ <form ] [code]
[ compile-attr [ =method ] [code] ]
[ compile-attr [ resolve-base-path =action ] [code] ]
[ compile-attrs ]
tri*
[ form> ] [code] ;
: (compile-form-attrs) ( method action -- )
! Leaves an assoc on the stack at runtime
[ compile-attr [ "method" pick set-at ] [code] ]
[ compile-attr [ resolve-base-path "action" pick set-at ] [code] ]
bi* ;
: form-start-tag ( tag -- )
[
[ "method" optional-attr "post" or ]
[ "action" required-attr ]
[ attrs>> non-chloe-attrs-only ] tri
compile-form-attrs
]
[ "for" optional-attr compile-hidden-form-fields ] bi ;
: compile-method/action ( tag -- )
! generated code is ( assoc -- assoc )
[ "method" optional-attr "post" or ]
[ "action" required-attr ] bi
(compile-form-attrs) ;
: form-end-tag ( tag -- )
drop [ </form> ] [code] ;
: compile-form-attrs ( tag -- )
[ non-chloe-attrs ]
[ compile-link-attrs ]
[ compile-method/action ] tri ;
: hidden-fields ( tag -- )
"for" optional-attr compile-hidden-form-fields ;
CHLOE: form
[
{
[ compile-link-attrs ]
[ form-start-tag ]
[ compile-children ]
[ form-end-tag ]
} cleave
[ compile-form-attrs ]
[ hidden-fields ]
[ compile-children>string ] tri
[
<unescaped> [XML <form><-><-></form> XML] second
swap >>attrs
write-xml
] [code]
] compile-with-scope ;
: button-tag-markup ( -- xml )
@ -121,13 +126,13 @@ CHLOE: form
<t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
<div style="display: inline;"><button type="submit"></button></div>
</t:form>
XML> ;
XML> body>> clone ;
: add-tag-attrs ( attrs tag -- )
attrs>> swap update ;
CHLOE: button
button-tag-markup body>>
button-tag-markup
{
[ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ]
[ [ attrs>> non-chloe-attrs-only ] dip "button" deep-tag-named add-tag-attrs ]

View File

@ -30,7 +30,7 @@ M: base-path-check-responder call-responder*
"a/b/c" split-path main-responder get call-responder body>>
] unit-test
[ "<input type='hidden' name='foo' value='&amp;&amp;&amp;'/>" ]
[ "<input type=\"hidden\" value=\"&amp;&amp;&amp;\" name=\"foo\"/>" ]
[ [ "&&&" "foo" hidden-form-field ] with-string-writer ]
unit-test

View File

@ -5,7 +5,7 @@ strings random accessors quotations hashtables sequences
continuations fry calendar combinators combinators.short-circuit
destructors alarms io.sockets db db.tuples db.types
http http.server http.server.dispatchers http.server.filters
html.elements furnace.cache furnace.scopes furnace.utilities ;
furnace.cache furnace.scopes furnace.utilities ;
IN: furnace.sessions
TUPLE: session < scope user-agent client ;

View File

@ -27,7 +27,7 @@ HELP: hidden-form-field
{ $example
"USING: furnace.utilities io ;"
"\"bar\" \"foo\" hidden-form-field nl"
"<input type='hidden' name='foo' value='bar'/>"
"<input type=\"hidden\" name=\"foo\" value=\"bar\"/>"
}
} ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces make assocs sequences kernel classes splitting
words vocabs.loader accessors strings combinators arrays
continuations present fry urls html.elements http http.server
continuations present fry urls http http.server xml.syntax xml.writer
http.server.redirection http.server.remapping ;
IN: furnace.utilities
@ -81,14 +81,13 @@ GENERIC: modify-form ( responder -- )
M: object modify-form drop ;
: hidden-form-field ( value name -- )
: hidden-form-field>xml ( value name -- xml )
over [
<input
"hidden" =type
=name
present =value
input/>
] [ 2drop ] if ;
[XML <input type="hidden" value=<-> name=<->/> XML]
] [ drop ] if ;
: hidden-form-field ( value name -- )
hidden-form-field>xml write-xml ;
: nested-forms-key "__n" ;

View File

@ -11,7 +11,7 @@ IN: html.components
GENERIC: render* ( value name renderer -- xml )
: render ( name renderer -- )
: render>xml ( name renderer -- xml )
prepare-value
[
dup validation-error?
@ -20,7 +20,10 @@ GENERIC: render* ( value name renderer -- xml )
if
] 2dip
render*
swap 2array write-xml ;
swap 2array ;
: render ( name renderer -- )
render>xml write-xml ;
SINGLETON: label

View File

@ -128,7 +128,7 @@ ARTICLE: "html.templates.chloe.tags.form" "Chloe link and form tags"
"<a href=\"http://mysite.org/wiki/view/Factor\""
" class=\"small-link\">"
" View"
"s</a>"
"</a>"
}
} }
{ { $snippet "t:base" } { "Outputs an HTML " { $snippet "<base>" } " tag. The attributes are interpreted in the same manner as the attributes of " { $snippet "t:a" } "." } }
@ -261,8 +261,8 @@ $nl
ARTICLE: "html.templates.chloe.extend.components.example" "An example of a custom Chloe component"
"As an example, let's develop a custom Chloe component which renders an image stored in a form value. Since the component does not require any configuration, we can define a singleton class:"
{ $code "SINGLETON: image" }
"Now we define a method on the " { $link render* } " generic word which renders the image using " { $vocab-link "html.elements" } ":"
{ $code "M: image render* 2drop <img =src img/> ;" }
"Now we define a method on the " { $link render* } " generic word which renders the image using " { $link { "xml.syntax" "literals" } } ":"
{ $code "M: image render* 2drop [XML <img src=<-> /> XML] ;" }
"Finally, we can define a Chloe component:"
{ $code "COMPONENT: image" }
"We can use it as follows, assuming the current form has a value named " { $snippet "image" } ":"

View File

@ -135,7 +135,7 @@ TUPLE: person first-name last-name ;
[ ] [ H{ { "a" H{ { "b" "c" } } } } values set ] unit-test
[ "<form method='post' action='foo'><div style='display: none;'><input type='hidden' name='__n' value='a'/></div></form>" ] [
[ "<form method=\"post\" action=\"foo\"><div style=\"display: none;\"><input type=\"hidden\" value=\"a\" name=\"__n\"/></div></form>" ] [
[
"test10" test-template call-template
] run-template

View File

@ -8,7 +8,6 @@ logging continuations
xml.data xml.writer xml.syntax strings
html.forms
html
html.elements
html.components
html.templates
html.templates.chloe.compiler
@ -28,7 +27,9 @@ CHLOE: write-title
drop
"head" tag-stack get member?
"title" tag-stack get member? not and
[ <title> write-title </title> ] [ write-title ] ? [code] ;
[ get-title [XML <title><-></title> XML] ]
[ get-title ] ?
[xml-code] ;
CHLOE: style
dup "include" optional-attr [
@ -39,10 +40,9 @@ CHLOE: style
CHLOE: write-style
drop [
<style "text/css" =type style>
write-style
</style>
] [code] ;
get-style
[XML <style type="text/css"> <-> </style> XML]
] [xml-code] ;
CHLOE: even
[ "index" value even? swap when ] process-children ;

View File

@ -42,6 +42,9 @@ DEFER: compile-element
: [code-with] ( obj quot -- )
reset-buffer [ , ] [ % ] bi* ;
: [xml-code] ( quot -- )
[ write-xml ] compose [code] ;
: expand-attr ( value -- )
[ value present write ] [code-with] ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel fry io io.encodings.utf8 io.files
debugger prettyprint continuations namespaces boxes sequences
arrays strings html io.streams.string
arrays strings html io.streams.string assocs
quotations xml.data xml.writer xml.syntax ;
IN: html.templates
@ -34,8 +34,11 @@ SYMBOL: title
: set-title ( string -- )
title get >box ;
: get-title ( -- string )
title get value>> ;
: write-title ( -- )
title get value>> write ;
get-title write ;
SYMBOL: style
@ -43,24 +46,30 @@ SYMBOL: style
"\n" style get push-all
style get push-all ;
: get-style ( -- string )
style get >string ;
: write-style ( -- )
style get >string write ;
get-style write ;
SYMBOL: atom-feeds
: add-atom-feed ( title url -- )
2array atom-feeds get push ;
: write-atom-feeds ( -- )
: get-atom-feeds ( -- xml )
atom-feeds get [
first2 [XML
[XML
<link
rel="alternate"
type="application/atom+xml"
title=<->
href=<->/>
XML] write-xml
] each ;
XML]
] { } assoc>map ;
: write-atom-feeds ( -- )
get-atom-feeds write-xml ;
SYMBOL: nested-template?

View File

@ -84,8 +84,8 @@ M: fd refill
fd>> over buffer>> [ buffer-end ] [ buffer-capacity ] bi read
{
{ [ dup 0 >= ] [ swap buffer>> n>buffer f ] }
{ [ err_no EINTR = ] [ 2drop +retry+ ] }
{ [ err_no EAGAIN = ] [ 2drop +input+ ] }
{ [ errno EINTR = ] [ 2drop +retry+ ] }
{ [ errno EAGAIN = ] [ 2drop +input+ ] }
[ (io-error) ]
} cond ;
@ -104,8 +104,8 @@ M: fd drain
over buffer>> buffer-consume
buffer>> buffer-empty? f +output+ ?
] }
{ [ err_no EINTR = ] [ 2drop +retry+ ] }
{ [ err_no EAGAIN = ] [ 2drop +output+ ] }
{ [ errno EINTR = ] [ 2drop +retry+ ] }
{ [ errno EAGAIN = ] [ 2drop +output+ ] }
[ (io-error) ]
} cond ;
@ -143,7 +143,7 @@ M: stdin dispose*
stdin data>> handle-fd buffer buffer-end size read
dup 0 < [
drop
err_no EINTR = [ buffer stdin size refill-stdin ] [ (io-error) ] if
errno EINTR = [ buffer stdin size refill-stdin ] [ (io-error) ] if
] [
size = [ "Error reading stdin pipe" throw ] unless
size buffer n>buffer
@ -177,7 +177,7 @@ TUPLE: mx-port < port mx ;
: multiplexer-error ( n -- n )
dup 0 < [
err_no [ EAGAIN = ] [ EINTR = ] bi or
errno [ EAGAIN = ] [ EINTR = ] bi or
[ drop 0 ] [ (io-error) ] if
] when ;

View File

@ -46,11 +46,13 @@ TUPLE: openssl-context < secure-context aliens sessions ;
[ push ] [ drop ] 2bi ;
: set-default-password ( ctx -- )
[ handle>> password-callback SSL_CTX_set_default_passwd_cb ]
[
[ handle>> ] [ default-pasword ] bi
SSL_CTX_set_default_passwd_cb_userdata
] bi ;
dup config>> password>> [
[ handle>> password-callback SSL_CTX_set_default_passwd_cb ]
[
[ handle>> ] [ default-pasword ] bi
SSL_CTX_set_default_passwd_cb_userdata
] bi
] [ drop ] if ;
: use-private-key-file ( ctx -- )
dup config>> key-file>> [

View File

@ -15,7 +15,7 @@ M: ssl-handle handle-fd file>> handle-fd ;
ERR_get_error dup zero? [
drop
{
{ -1 [ err_no ECONNRESET = [ premature-close ] [ (io-error) ] if ] }
{ -1 [ errno ECONNRESET = [ premature-close ] [ (io-error) ] if ] }
{ 0 [ premature-close ] }
} case
] [ nip (ssl-error) ] if ;

View File

@ -37,8 +37,8 @@ M: object (get-remote-address) ( handle local -- sockaddr )
dup handle>> handle-fd f 0 write
{
{ [ 0 = ] [ drop ] }
{ [ err_no EAGAIN = ] [ dup +output+ wait-for-port wait-to-connect ] }
{ [ err_no EINTR = ] [ wait-to-connect ] }
{ [ errno EAGAIN = ] [ dup +output+ wait-for-port wait-to-connect ] }
{ [ errno EINTR = ] [ wait-to-connect ] }
[ (io-error) ]
} cond ;
@ -46,7 +46,7 @@ M: object establish-connection ( client-out remote -- )
[ drop ] [ [ handle>> handle-fd ] [ make-sockaddr/size ] bi* connect ] 2bi
{
{ [ 0 = ] [ drop ] }
{ [ err_no EINPROGRESS = ] [
{ [ errno EINPROGRESS = ] [
[ +output+ wait-for-port ] [ wait-to-connect ] bi
] }
[ (io-error) ]
@ -78,8 +78,8 @@ M: object (accept) ( server addrspec -- fd sockaddr )
2dup do-accept
{
{ [ over 0 >= ] [ [ 2nip <fd> init-fd ] dip ] }
{ [ err_no EINTR = ] [ 2drop (accept) ] }
{ [ err_no EAGAIN = ] [
{ [ errno EINTR = ] [ 2drop (accept) ] }
{ [ errno EAGAIN = ] [
2drop
[ drop +input+ wait-for-port ]
[ (accept) ]
@ -121,10 +121,10 @@ M: unix (receive) ( datagram -- packet sockaddr )
:: do-send ( packet sockaddr len socket datagram -- )
socket handle-fd packet dup length 0 sockaddr len sendto
0 < [
err_no EINTR = [
errno EINTR = [
packet sockaddr len socket datagram do-send
] [
err_no EAGAIN = [
errno EAGAIN = [
datagram +output+ wait-for-port
packet sockaddr len socket datagram do-send
] [

View File

@ -2,10 +2,16 @@
! Copyright (C) 2007, 2008 Slava Pestov
! Copyright (C) 2007, 2008 Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
USING: alien assocs continuations destructors kernel
namespaces accessors sets summary ;
USING: alien assocs continuations destructors
kernel namespaces accessors sets summary ;
IN: libc
: errno ( -- int )
"int" "factor" "err_no" { } alien-invoke ;
: clear-errno ( -- )
"void" "factor" "clear_err_no" { } alien-invoke ;
<PRIVATE
: (malloc) ( size -- alien )

View File

@ -1,27 +1,54 @@
USING: help.markup help.syntax quotations kernel ;
USING: help.markup help.syntax quotations kernel
stack-checker.transforms sequences ;
IN: macros
HELP: MACRO:
{ $syntax "MACRO: word ( inputs... -- ) definition... ;" }
{ $description "Defines a compile-time code transformation. If all inputs to the word are literal and the word calling the macro has a static stack effect, then the macro body is invoked at compile-time to produce a quotation; this quotation is then spliced into the compiled code. If the inputs are not literal, or if the word is invoked from a word which does not have a static stack effect, the macro body will execute every time and the result will be passed to " { $link call } "."
$nl
"The stack effect declaration must be present because it tells the compiler how many literal inputs to expect."
}
{ $description "Defines a code transformation. The definition must have stack effect " { $snippet "( inputs... -- quot )" } "." }
{ $notes
"Semantically, the following two definitions are equivalent:"
"A call of a macro inside a word definition is replaced with the quotation expansion at compile-time if precisely the following conditions hold:"
{ $list
{ "All inputs to the macro call are literal" }
{ "The word calling the macro has a static stack effect" }
{ "The expansion quotation produced by the macro has a static stack effect" }
}
"If any of these conditions fail to hold, the macro will still work, but expansion will be performed at run-time."
$nl
"Other than possible compile-time expansion, the following two definition styles are equivalent:"
{ $code "MACRO: foo ... ;" }
{ $code ": foo ... call ;" }
"However, the compiler folds in macro definitions at compile-time where possible; if the macro body performs an expensive calculation, it can lead to a performance boost."
"Conceptually, macros allow computation to be moved from run-time to compile-time, splicing the result of this computation into the generated quotation."
}
{ $examples
"A macro that calls a quotation but preserves any values it consumes off the stack:"
{ $code
"USING: fry generalizations ;"
"MACRO: preserving ( quot -- )"
" [ infer in>> length ] keep '[ _ ndup @ ] ;"
}
"Using this macro, we can define a variant of " { $link if } " which takes a predicate quotation instead of a boolean; any values consumed by the predicate quotation are restored immediately after:"
{ $code
": ifte ( pred true false -- ) [ preserving ] 2dip if ; inline"
}
"Note that " { $snippet "ifte" } " is an ordinary word, and it passes one of its inputs to the macro. If another word calls " { $snippet "ifte" } " with all three input quotations literal, then " { $snippet "ifte" } " will be inlined and " { $snippet "preserving" } " will expand at compile-time, and the generated machine code will be exactly the same as if the inputs consumed by the predicate were duplicated by hand."
$nl
"The " { $snippet "ifte" } " combinator presented here has similar semantics to the " { $snippet "ifte" } " combinator of the Joy programming language."
} ;
HELP: macro
{ $class-description "Class of words defined with " { $link POSTPONE: MACRO: } "." } ;
ARTICLE: "macros" "Macros"
"The " { $vocab-link "macros" } " vocabulary implements macros in the Lisp sense; compile-time code transformers and generators. Macros can be used to calculate lookup tables and generate code at compile time, which can improve performance, the level of abstraction and simplify code."
"The " { $vocab-link "macros" } " vocabulary implements " { $emphasis "macros" } ", which are code transformations that may run at compile-time under the right circumstances."
$nl
"Macros can be used to give static stack effects to combinators that otherwise would not have static stack effects. Macros can be used to calculate lookup tables and generate code at compile time, which can improve performance, the level of abstraction and simplify code."
$nl
"Factor macros are similar to Lisp macros; they are not like C preprocessor macros."
$nl
"Defining new macros:"
{ $subsection POSTPONE: MACRO: }
"Macros are really just a very thin layer of syntax sugar over " { $link "compiler-transforms" } "." ;
"A slightly lower-level facility, " { $emphasis "compiler transforms" } ", allows an ordinary word definition to co-exist with a version that performs compile-time expansion."
{ $subsection define-transform }
"An example is the " { $link member? } " word. If the input sequence is a literal, the compile transform kicks in and converts the " { $link member? } " call into a series of conditionals. Otherwise, if the input sequence is not literal, a call to the definition of " { $link member? } " is generated." ;
ABOUT: "macros"

View File

@ -4,9 +4,13 @@ USING: parser kernel sequences words effects combinators assocs
definitions quotations namespaces memoize accessors ;
IN: macros
<PRIVATE
: real-macro-effect ( word -- effect' )
"declared-effect" word-prop in>> 1 <effect> ;
PRIVATE>
: define-macro ( word definition -- )
[ "macro" set-word-prop ]
[ over real-macro-effect memoize-quot [ call ] append define ]

View File

@ -6,3 +6,4 @@ USING: math.primes.factors tools.test ;
{ { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test
{ 999967000236000612 } [ 999969000187000867 totient ] unit-test
{ 0 } [ 1 totient ] unit-test
{ { 425612003 } } [ 425612003 factors ] unit-test

View File

@ -16,7 +16,11 @@ IN: math.primes.factors
PRIVATE>
: group-factors ( n -- seq )
[ 2 [ over 1 > ] [ write-factor next-prime ] [ ] while 2drop ] { } make ;
[
2
[ 2dup sq < ] [ write-factor next-prime ] [ ] until
drop dup 2 < [ drop ] [ 1 2array , ] if
] { } make ;
: unique-factors ( n -- seq ) group-factors [ first ] map ;

View File

@ -113,9 +113,7 @@ CONSTANT: packed-length-table
MACRO: pack ( str -- quot )
[ pack-table at '[ _ execute ] ] { } map-as
'[ _ spread ]
'[ _ input<sequence ]
'[ _ B{ } append-outputs-as ] ;
'[ [ [ _ spread ] input<sequence ] B{ } append-outputs-as ] ;
PRIVATE>
@ -143,7 +141,7 @@ MACRO: unpack ( str -- quot )
[ [ ch>packed-length ] { } map-as start/end ]
[ [ unpack-table at '[ @ ] ] { } map-as ] bi
[ '[ [ _ _ ] dip <slice> @ ] ] 3map
'[ _ cleave ] '[ _ output>array ] ;
'[ [ _ cleave ] output>array ] ;
PRIVATE>

View File

@ -89,44 +89,37 @@ M: composed infer-call*
M: object infer-call*
\ literal-expected inference-warning ;
: infer-slip ( -- )
1 infer->r infer-call 1 infer-r> ;
: infer-nslip ( n -- )
[ infer->r infer-call ] [ infer-r> ] bi ;
: infer-2slip ( -- )
2 infer->r infer-call 2 infer-r> ;
: infer-slip ( -- ) 1 infer-nslip ;
: infer-3slip ( -- )
3 infer->r infer-call 3 infer-r> ;
: infer-2slip ( -- ) 2 infer-nslip ;
: infer-dip ( -- )
literals get
[ \ dip def>> infer-quot-here ]
[ pop 1 infer->r infer-quot-here 1 infer-r> ]
: infer-3slip ( -- ) 3 infer-nslip ;
: infer-ndip ( word n -- )
[ literals get ] 2dip
[ '[ _ def>> infer-quot-here ] ]
[ '[ _ [ pop ] dip [ infer->r infer-quot-here ] [ infer-r> ] bi ] ] bi*
if-empty ;
: infer-2dip ( -- )
literals get
[ \ 2dip def>> infer-quot-here ]
[ pop 2 infer->r infer-quot-here 2 infer-r> ]
if-empty ;
: infer-dip ( -- ) \ dip 1 infer-ndip ;
: infer-3dip ( -- )
literals get
[ \ 3dip def>> infer-quot-here ]
[ pop 3 infer->r infer-quot-here 3 infer-r> ]
if-empty ;
: infer-2dip ( -- ) \ 2dip 2 infer-ndip ;
: infer-curry ( -- )
2 consume-d
dup first2 <curried> make-known
[ push-d ] [ 1array ] bi
\ curry #call, ;
: infer-3dip ( -- ) \ 3dip 3 infer-ndip ;
: infer-compose ( -- )
2 consume-d
dup first2 <composed> make-known
[ push-d ] [ 1array ] bi
\ compose #call, ;
: infer-builder ( quot word -- )
[
[ 2 consume-d ] dip
[ dup first2 ] dip call make-known
[ push-d ] [ 1array ] bi
] dip #call, ; inline
: infer-curry ( -- ) [ <curried> ] \ curry infer-builder ;
: infer-compose ( -- ) [ <composed> ] \ compose infer-builder ;
: infer-execute ( -- )
pop-literal nip

View File

@ -80,13 +80,6 @@ $nl
"[ [ 5 ] t foo ] infer."
} ;
ARTICLE: "compiler-transforms" "Compiler transforms"
"Compiler transforms can be used to allow words to compile which would otherwise not have a stack effect, and to expand combinators into more efficient code at compile time."
{ $subsection define-transform }
"An example is the " { $link cond } " word. If the association list of quotations it is given is literal, the entire form is expanded into a series of nested calls to " { $link if } "."
$nl
"The " { $vocab-link "macros" } " vocabulary defines some nice syntax sugar which makes compiler transforms easier to work with." ;
ARTICLE: "inference" "Stack effect inference"
"The stack effect inference tool is used to check correctness of code before it is run. It is also used by the optimizing compiler to build the high-level SSA representation on which optimizations can be performed. Only words for which a stack effect can be inferred will compile with the optimizing compiler; all other words will be compiled with the non-optimizing compiler (see " { $link "compiler" } ")."
$nl
@ -103,7 +96,6 @@ $nl
{ $subsection "inference-recursive-combinators" }
{ $subsection "inference-branches" }
{ $subsection "inference-errors" }
{ $subsection "compiler-transforms" }
{ $see-also "effects" } ;
ABOUT: "inference"

View File

@ -577,3 +577,8 @@ DEFER: eee'
[ bogus-error ] must-infer
[ [ clear ] infer. ] [ inference-error? ] must-fail-with
: debugging-curry-folding ( quot -- )
[ debugging-curry-folding ] curry call ; inline recursive
[ [ ] debugging-curry-folding ] must-infer

View File

@ -3,12 +3,11 @@ USING: help.markup help.syntax combinators words kernel ;
HELP: define-transform
{ $values { "word" word } { "quot" "a quotation taking " { $snippet "n" } " inputs from the stack and producing another quotation as output" } { "n" "a non-negative integer" } }
{ $description "Defines a compiler transform for the optimizing compiler. When a call to " { $snippet "word" } " is being compiled, the compiler ensures that the top " { $snippet "n" } " stack values are literal; if they are not, compilation fails. The literal values are passed to the quotation, which is expected to produce a new quotation. The call to the word is then replaced by this quotation." }
{ $examples "Here is a word which pops " { $snippet "n" } " values from the stack:"
{ $code ": ndrop ( n -- ) [ drop ] times ;" }
"This word is inefficient; it does not have a static stack effect. This means that words calling " { $snippet "ndrop" } " cannot be compiled by the optimizing compiler, and additionally, a call to this word will always involve a loop with arithmetic, even if the value of " { $snippet "n" } " is known at compile time. A compiler transform can fix this:"
{ $code "\\ ndrop [ \\ drop <repetition> >quotation ] 1 define-transform" }
"Now, a call like " { $snippet "4 ndrop" } " is replaced with " { $snippet "drop drop drop drop" } " at compile time; the optimizer then ensures that this compiles as a single machine instruction, which is a lot cheaper than an actual call to " { $snippet "ndrop" } "."
{ $description "Defines a compiler transform for the optimizing compiler."
"When a call to " { $snippet "word" } " is being compiled, the compiler first checks that the top " { $snippet "n" } " stack values are literal, and if so, calls the quotation with those inputs at compile time. The quotation can output a new quotation, or " { $link f } "."
$nl
"The " { $link cond } " word compiles to efficient code because it is transformed using " { $link cond>quot } ":"
"If the quotation outputs " { $link f } ", or if not all inputs are literal, a call to the word is compiled as usual, or compilation fails if the word does not have a static stack effect."
$nl
"Otherwise, if the transform output a new quotation, the quotation replaces the word's call site." }
{ $examples "The " { $link cond } " word compiles to efficient code because it is transformed using " { $link cond>quot } ":"
{ $code "\\ cond [ cond>quot ] 1 define-transform" } } ;

View File

@ -57,3 +57,12 @@ DEFER: smart-combo ( quot -- )
[ [ "a" "b" "c" ] very-smart-combo ] must-infer
[ [ [ "a" "b" ] very-smart-combo "c" ] very-smart-combo ] must-infer
! Caveat found by Doug
DEFER: curry-folding-test ( quot -- )
\ curry-folding-test [ length \ drop <repetition> >quotation ] 1 define-transform
{ 3 0 } [ [ 1 2 3 ] curry-folding-test ] must-infer-as
{ 3 0 } [ 1 [ 2 3 ] curry curry-folding-test ] must-infer-as
{ 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as

View File

@ -24,8 +24,10 @@ IN: stack-checker.transforms
rstate infer-quot
] [ word give-up-transform ] if* ;
: literals? ( values -- ? ) [ literal-value? ] all? ;
: (apply-transform) ( word quot n -- )
ensure-d dup [ known literal? ] all? [
ensure-d dup literals? [
dup empty? [ dup recursive-state get ] [
[ ]
[ [ literal value>> ] map ]

View File

@ -26,27 +26,51 @@ SYMBOL: known-values
: copy-values ( values -- values' )
[ copy-value ] map ;
GENERIC: (literal-value?) ( value -- ? )
M: object (literal-value?) drop f ;
GENERIC: (literal) ( value -- literal )
! Literal value
TUPLE: literal < identity-tuple value recursion hashcode ;
: literal ( value -- literal ) known (literal) ;
: literal-value? ( value -- ? ) known (literal-value?) ;
M: literal hashcode* nip hashcode>> ;
: <literal> ( obj -- value )
recursive-state get over hashcode \ literal boa ;
GENERIC: (literal) ( value -- literal )
M: literal (literal-value?) drop t ;
M: literal (literal) ;
: literal ( value -- literal )
known (literal) ;
: curried/composed-literal ( input1 input2 quot -- literal )
[ [ literal ] bi@ ] dip
[ [ [ value>> ] bi@ ] dip call ] [ drop nip recursion>> ] 3bi
over hashcode \ literal boa ; inline
! Result of curry
TUPLE: curried obj quot ;
C: <curried> curried
: >curried< ( curried -- obj quot )
[ obj>> ] [ quot>> ] bi ; inline
M: curried (literal-value?) >curried< [ literal-value? ] both? ;
M: curried (literal) >curried< [ curry ] curried/composed-literal ;
! Result of compose
TUPLE: composed quot1 quot2 ;
C: <composed> composed
: >composed< ( composed -- quot1 quot2 )
[ quot1>> ] [ quot2>> ] bi ; inline
M: composed (literal-value?) >composed< [ literal-value? ] both? ;
M: composed (literal) >composed< [ compose ] curried/composed-literal ;

View File

@ -1,4 +1,7 @@
USING: unicode.case tools.test namespaces ;
! Copyright (C) 2008, 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: unicode.case unicode.case.private tools.test namespaces strings unicode.normalize ;
IN: unicode.case.tests
\ >upper must-infer
\ >lower must-infer
@ -9,12 +12,21 @@ USING: unicode.case tools.test namespaces ;
[ "\u0003C3a\u0003C2 \u0003C3\u0003C2 \u0003C3a\u0003C2" ] [ "\u0003A3A\u0003A3 \u0003A3\u0003A3 \u0003A3A\u0003A3" >lower ] unit-test
[ t ] [ "hello how are you?" lower? ] unit-test
[
[ f ] [ i-dot? ] unit-test
[ f ] [ lt? ] unit-test
"tr" locale set
[ t ] [ i-dot? ] unit-test
[ f ] [ lt? ] unit-test
[ "i\u000131i \u000131jj" ] [ "i\u000131I\u000307 IJj" >lower ] unit-test
[ "I\u000307\u000131i Ijj" ] [ "i\u000131I\u000307 IJj" >title ] unit-test
[ "I\u000307II\u000307 IJJ" ] [ "i\u000131I\u000307 IJj" >upper ] unit-test
"lt" locale set
! Lithuanian casing tests
[ f ] [ i-dot? ] unit-test
[ t ] [ lt? ] unit-test
[ "i\u000307\u000300" ] [ HEX: CC 1string nfd >lower ] unit-test
[ "\u00012f\u000307" ] [ HEX: 12E 1string nfd >lower nfc ] unit-test
[ "I\u000300" ] [ "i\u000307\u000300" >upper ] unit-test
! [ "I\u000300" ] [ "i\u000307\u000300" >title ] unit-test
] with-scope
[ t ] [ "asdf" lower? ] unit-test

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Daniel Ehrenberg.
! Copyright (C) 2008, 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: unicode.data sequences namespaces
sbufs make unicode.syntax unicode.normalize math hints
unicode.categories combinators unicode.syntax assocs
unicode.categories combinators unicode.syntax assocs combinators.short-circuit
strings splitting kernel accessors unicode.breaks fry locals ;
QUALIFIED: ascii
IN: unicode.case
@ -26,6 +26,9 @@ SYMBOL: locale ! Just casing locale, or overall?
: i-dot? ( -- ? )
locale get { "tr" "az" } member? ;
: lt? ( -- ? )
locale get "lt" = ;
: lithuanian? ( -- ? ) locale get "lt" = ;
: dot-over ( -- ch ) HEX: 307 ;
@ -37,18 +40,21 @@ SYMBOL: locale ! Just casing locale, or overall?
: mark-above? ( ch -- ? )
combining-class 230 = ;
: with-rest ( seq quot: ( seq -- seq ) -- seq )
[ unclip ] dip swap slip prefix ; inline
:: with-rest ( seq quot: ( seq -- seq ) -- seq )
seq unclip quot dip prefix ; inline
: add-dots ( seq -- seq )
[ [ "" ] [
dup first mark-above?
[ CHAR: combining-dot-above prefix ] when
[ [ { } ] [
[
dup first
{ [ mark-above? ] [ CHAR: combining-ogonek = ] } 1||
[ CHAR: combining-dot-above prefix ] when
] map
] if-empty ] with-rest ; inline
: lithuanian>lower ( string -- lower )
"i" split add-dots "i" join
"j" split add-dots "i" join ; inline
"I" split add-dots "I" join
"J" split add-dots "J" join ; inline
: turk>upper ( string -- upper-i )
"i" "I\u000307" replace ; inline
@ -88,13 +94,16 @@ SYMBOL: locale ! Just casing locale, or overall?
PRIVATE>
: >lower ( string -- lower )
i-dot? [ turk>lower ] when final-sigma
i-dot? [ turk>lower ] when
lt? [ lithuanian>lower ] when
final-sigma
[ lower>> ] [ ch>lower ] map-case ;
HINTS: >lower string ;
: >upper ( string -- upper )
i-dot? [ turk>upper ] when
lt? [ lithuanian>upper ] when
[ upper>> ] [ ch>upper ] map-case ;
HINTS: >upper string ;
@ -103,6 +112,7 @@ HINTS: >upper string ;
: (>title) ( string -- title )
i-dot? [ turk>upper ] when
lt? [ lithuanian>upper ] when
[ title>> ] [ ch>title ] map-case ; inline
: title-word ( string -- title )

View File

@ -37,18 +37,13 @@ C-STRUCT: group
{ "int" "gr_gid" }
{ "char**" "gr_mem" } ;
LIBRARY: factor
FUNCTION: void clear_err_no ( ) ;
FUNCTION: int err_no ( ) ;
LIBRARY: libc
FUNCTION: char* strerror ( int errno ) ;
ERROR: unix-error errno message ;
: (io-error) ( -- * ) err_no dup strerror unix-error ;
: (io-error) ( -- * ) errno dup strerror unix-error ;
: io-error ( n -- ) 0 < [ (io-error) ] when ;
@ -61,7 +56,7 @@ MACRO:: unix-system-call ( quot -- )
n ndup quot call dup 0 < [
drop
n narray
err_no dup strerror
errno dup strerror
word unix-system-call-error
] [
n nnip

1
basis/zlib/authors.txt Executable file
View File

@ -0,0 +1 @@
Doug Coleman

1
basis/zlib/ffi/authors.txt Executable file
View File

@ -0,0 +1 @@
Doug Coleman

30
basis/zlib/ffi/ffi.factor Executable file
View File

@ -0,0 +1,30 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax combinators system ;
IN: zlib.ffi
<< "zlib" {
{ [ os winnt? ] [ "zlib1.dll" ] }
{ [ os macosx? ] [ "libz.dylib" ] }
{ [ os unix? ] [ "libz.so" ] }
} cond "cdecl" add-library >>
LIBRARY: zlib
CONSTANT: Z_OK 0
CONSTANT: Z_STREAM_END 1
CONSTANT: Z_NEED_DICT 2
CONSTANT: Z_ERRNO -1
CONSTANT: Z_STREAM_ERROR -2
CONSTANT: Z_DATA_ERROR -3
CONSTANT: Z_MEM_ERROR -4
CONSTANT: Z_BUF_ERROR -5
CONSTANT: Z_VERSION_ERROR -6
TYPEDEF: void Bytef
TYPEDEF: ulong uLongf
TYPEDEF: ulong uLong
FUNCTION: int compress ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen ) ;
FUNCTION: int compress2 ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen, int level ) ;
FUNCTION: int uncompress ( Bytef* dest, uLongf* destLen, Bytef* source, uLong sourceLen ) ;

9
basis/zlib/zlib-tests.factor Executable file
View File

@ -0,0 +1,9 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel tools.test zlib classes ;
IN: zlib.tests
: compress-me ( -- byte-array ) B{ 1 2 3 4 5 } ;
[ t ] [ compress-me [ compress uncompress ] keep = ] unit-test
[ t ] [ compress-me compress compressed instance? ] unit-test

48
basis/zlib/zlib.factor Executable file
View File

@ -0,0 +1,48 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax byte-arrays combinators
kernel math math.functions sequences system accessors
libc ;
QUALIFIED: zlib.ffi
IN: zlib
TUPLE: compressed data length ;
: <compressed> ( data length -- compressed )
compressed new
swap >>length
swap >>data ;
ERROR: zlib-failed n string ;
: zlib-error-message ( n -- * )
dup zlib.ffi:Z_ERRNO = [
drop errno "native libc error"
] [
dup {
"no error" "libc_error"
"stream error" "data error"
"memory error" "buffer error" "zlib version error"
} ?nth
] if zlib-failed ;
: zlib-error ( n -- )
dup zlib.ffi:Z_OK = [ drop ] [ dup zlib-error-message zlib-failed ] if ;
: compressed-size ( byte-array -- n )
length 1001/1000 * ceiling 12 + ;
: compress ( byte-array -- compressed )
[
[ compressed-size <byte-array> dup length <ulong> ] keep [
dup length zlib.ffi:compress zlib-error
] 3keep drop *ulong head
] keep length <compressed> ;
: uncompress ( compressed -- byte-array )
[
length>> [ <byte-array> ] keep <ulong> 2dup
] [
data>> dup length
zlib.ffi:uncompress zlib-error
] bi *ulong head ;

View File

@ -949,6 +949,13 @@ ARTICLE: "assertions" "Assertions"
{ $subsection assert }
{ $subsection assert= } ;
ARTICLE: "dataflow-combinators" "Data flow combinators"
"Data flow combinators pass values between quotations:"
{ $subsection "slip-keep-combinators" }
{ $subsection "cleave-combinators" }
{ $subsection "spread-combinators" }
{ $subsection "apply-combinators" } ;
ARTICLE: "dataflow" "Data and control flow"
{ $subsection "evaluator" }
{ $subsection "words" }
@ -956,16 +963,9 @@ ARTICLE: "dataflow" "Data and control flow"
{ $subsection "booleans" }
{ $subsection "shuffle-words" }
"A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input."
$nl
"Data flow combinators:"
{ $subsection "slip-keep-combinators" }
{ $subsection "cleave-combinators" }
{ $subsection "spread-combinators" }
{ $subsection "apply-combinators" }
"Control flow combinators:"
{ $subsection "dataflow-combinators" }
{ $subsection "conditionals" }
{ $subsection "looping-combinators" }
"Additional combinators:"
{ $subsection "compositional-combinators" }
{ $subsection "combinators" }
"More combinators are defined for working on data structures, such as " { $link "sequences-combinators" } " and " { $link "assocs-combinators" } "."
@ -973,6 +973,7 @@ $nl
"Advanced topics:"
{ $subsection "assertions" }
{ $subsection "implementing-combinators" }
{ $subsection "macros" }
{ $subsection "errors" }
{ $subsection "continuations" } ;

View File

@ -107,7 +107,7 @@ $nl
{ { { $snippet "\"help\"" } ", " { $snippet "\"help-loc\"" } ", " { $snippet "\"help-parent\"" } } { "Where word help is stored - " { $link "writing-help" } } }
{ { $snippet "\"infer\"" } { $link "compiler-transforms" } }
{ { $snippet "\"infer\"" } { $link "macros" } }
{ { { $snippet "\"inferred-effect\"" } } { $link "inference" } }

View File

@ -15,7 +15,8 @@ SYMBOL: commands
{ nop rot -rot swap spin swapd } amb-execute ;
: makes-24? ( a b c d -- ? )
[
2 [ some-rots do-something ] times
some-rots do-something
some-rots do-something
maybe-swap do-something
24 =
]
@ -60,4 +61,4 @@ DEFER: check-status
: 24-able ( -- vector ) build-quad dup 24-able? [ drop build-quad ] unless ;
: set-commands ( -- ) { + - * / rot swap q } commands set ;
: play-game ( -- ) set-commands 24-able repeat ;
MAIN: play-game
MAIN: play-game

View File

@ -1,15 +1,30 @@
USING: graphics.bitmap graphics.viewer ;
USING: graphics.bitmap graphics.viewer io.encodings.binary
io.files io.files.unique kernel tools.test ;
IN: graphics.bitmap.tests
: test-bitmap24 ( -- )
"resource:extra/graphics/bitmap/test-images/thiswayup24.bmp" bitmap. ;
: test-bitmap32-alpha ( -- path )
"resource:extra/graphics/bitmap/test-images/32alpha.bmp" ;
: test-bitmap8 ( -- )
"resource:extra/graphics/bitmap/test-images/rgb8bit.bmp" bitmap. ;
: test-bitmap24 ( -- path )
"resource:extra/graphics/bitmap/test-images/thiswayup24.bmp" ;
: test-bitmap4 ( -- )
"resource:extra/graphics/bitmap/test-images/rgb4bit.bmp" bitmap. ;
: test-bitmap16 ( -- path )
"resource:extra/graphics/bitmap/test-images/rgb16bit.bmp" ;
: test-bitmap1 ( -- )
"resource:extra/graphics/bitmap/test-images/1bit.bmp" bitmap. ;
: test-bitmap8 ( -- path )
"resource:extra/graphics/bitmap/test-images/rgb8bit.bmp" ;
: test-bitmap4 ( -- path )
"resource:extra/graphics/bitmap/test-images/rgb4bit.bmp" ;
: test-bitmap1 ( -- path )
"resource:extra/graphics/bitmap/test-images/1bit.bmp" ;
[ t ]
[
test-bitmap24
[ binary file-contents ] [ load-bitmap ] bi
"test-bitmap24" unique-file
[ save-bitmap ] [ binary file-contents ] bi =
] unit-test

View File

@ -1,11 +1,10 @@
! Copyright (C) 2007 Doug Coleman.
! Copyright (C) 2007, 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien arrays byte-arrays combinators summary
io io.binary io.files kernel libc math
math.functions math.bitwise namespaces opengl opengl.gl
prettyprint sequences strings ui ui.gadgets.panes fry
io.encodings.binary accessors grouping macros alien.c-types ;
USING: accessors alien alien.c-types arrays byte-arrays columns
combinators fry grouping io io.binary io.encodings.binary
io.files kernel libc macros math math.bitwise math.functions
namespaces opengl opengl.gl prettyprint sequences strings
summary ui ui.gadgets.panes ;
IN: graphics.bitmap
! Currently can only handle 24/32bit bitmaps.
@ -14,6 +13,7 @@ IN: graphics.bitmap
TUPLE: bitmap magic size reserved offset header-length width
height planes bit-count compression size-image
x-pels y-pels color-used color-important rgb-quads color-index
alpha-channel-zero?
array ;
: array-copy ( bitmap array -- bitmap array' )
@ -39,20 +39,18 @@ MACRO: (nbits>bitmap) ( bits -- )
[ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]
[ color-index>> >array ] bi [ swap nth ] with map concat ;
: 4bit>array ( bitmap -- array )
[ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]
[ color-index>> >array ] bi [ swap nth ] with map concat ;
ERROR: bmp-not-supported n ;
: raw-bitmap>array ( bitmap -- array )
dup bit-count>>
{
{ 32 [ color-index>> ] }
{ 24 [ color-index>> ] }
{ 16 [ "16bit" throw ] }
{ 16 [ bmp-not-supported ] }
{ 8 [ 8bit>array ] }
{ 4 [ 4bit>array ] }
{ 2 [ "2bit" throw ] }
{ 1 [ "1bit" throw ] }
{ 4 [ bmp-not-supported ] }
{ 2 [ bmp-not-supported ] }
{ 1 [ bmp-not-supported ] }
} case >byte-array ;
ERROR: bitmap-magic ;
@ -97,12 +95,19 @@ M: bitmap-magic summary
dup rgb-quads-length read >>rgb-quads
dup color-index-length read >>color-index ;
: load-bitmap ( path -- bitmap )
: (load-bitmap) ( path -- bitmap )
binary [
bitmap new
parse-file-header parse-bitmap-header parse-bitmap
] with-file-reader
dup raw-bitmap>array >>array ;
] with-file-reader ;
: alpha-channel-zero? ( bitmap -- ? )
array>> 4 <sliced-groups> 3 <column> [ 0 = ] all? ;
: load-bitmap ( path -- bitmap )
(load-bitmap)
dup raw-bitmap>array >>array
dup alpha-channel-zero? >>alpha-channel-zero? ;
: write2 ( n -- ) 2 >le write ;
: write4 ( n -- ) 4 >le write ;

View File

@ -3,7 +3,6 @@
USING: kernel sequences accessors namespaces combinators words
assocs db.tuples arrays splitting strings validators urls
html.forms
html.elements
html.components
furnace
furnace.boilerplate

View File

@ -303,7 +303,17 @@ struct test_struct_14 ffi_test_44(void)
return retval;
}
complex float ffi_test_45(complex float x, complex double y)
_Complex float ffi_test_45(int x)
{
return x;
}
_Complex double ffi_test_46(int x)
{
return x;
}
_Complex float ffi_test_47(_Complex float x, _Complex double y)
{
return x + 2 * y;
}

View File

@ -89,4 +89,8 @@ DLLEXPORT struct test_struct_16 ffi_test_43(float x, int a);
DLLEXPORT struct test_struct_14 ffi_test_44();
complex float ffi_test_45(complex float x, complex double y);
DLLEXPORT _Complex float ffi_test_45(int x);
DLLEXPORT _Complex double ffi_test_46(int x);
DLLEXPORT _Complex float ffi_test_47(_Complex float x, _Complex double y);

View File

@ -1,7 +1,7 @@
void init_c_io(void);
void io_error(void);
int err_no(void);
void clear_err_no(void);
DLLEXPORT int err_no(void);
DLLEXPORT void clear_err_no(void);
void primitive_fopen(void);
void primitive_fgetc(void);

View File

@ -8,7 +8,6 @@
#include <fcntl.h>
#include <limits.h>
#include <math.h>
#include <complex.h>
#include <stdbool.h>
#include <setjmp.h>