]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' into new_ui
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Fri, 6 Feb 2009 17:10:55 +0000 (11:10 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Fri, 6 Feb 2009 17:10:55 +0000 (11:10 -0600)
16 files changed:
basis/alien/c-types/c-types.factor
basis/io/sockets/secure/openssl/openssl.factor
basis/macros/macros-docs.factor
basis/macros/macros.factor
basis/pack/pack.factor
basis/stack-checker/known-words/known-words.factor
basis/stack-checker/stack-checker-docs.factor
basis/stack-checker/stack-checker-tests.factor
basis/stack-checker/transforms/transforms-docs.factor
basis/stack-checker/transforms/transforms-tests.factor
basis/stack-checker/transforms/transforms.factor
basis/stack-checker/values/values.factor
core/kernel/kernel-docs.factor
vm/ffi_test.c
vm/ffi_test.h
vm/master.h

index ff9d4cefc455f6ac9ff5bdcae2ee4c4d399db724..cf5daa1562c0fc95b5ea39152ac9cfad55160324 100644 (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 ]
index 0326969e4fbc0bca3543b9e867043738ad38f16d..f78f61ef3bbbaedc2dd219de2a88f6f7feaab308 100644 (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>> [
index 704cae459a268683ab32063b00a1ea5c6010044b..acd2c3383f2e6ca7ba5a552f7773272fa3d4ebfb 100644 (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"
index 1481e6eea57d832bc177a0207e26e156d1c5feb7..4fba7efba3890be862ea629c0acc5f97e78f18cf 100644 (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 ]
index aec4414c71410f00a2d7fa46831fed8ae8b2fe23..3cf7dbab4c9fc534876940b5ec42044106e59a90 100755 (executable)
@@ -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>
 
index 7cdce301b5cf296d231522941417ccd0ba180003..56aebb20e7ed931095298f84767e35d706a50ab9 100644 (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>  ]
-    if-empty ;
+: infer-3slip ( -- ) 3 infer-nslip ;
 
-: infer-2dip ( -- )
-    literals get
-    [ \ 2dip def>> infer-quot-here ]
-    [ pop 2 infer->r infer-quot-here 2 infer-r>  ]
+: 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-3dip ( -- )
-    literals get
-    [ \ 3dip def>> infer-quot-here ]
-    [ pop 3 infer->r infer-quot-here 3 infer-r>  ]
-    if-empty ;
+: infer-dip ( -- ) \ dip 1 infer-ndip ;
+
+: infer-2dip ( -- ) \ 2dip 2 infer-ndip ;
+
+: infer-3dip ( -- ) \ 3dip 3 infer-ndip ;
+
+: 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-curry ( -- )
-    2 consume-d
-    dup first2 <curried> make-known
-    [ push-d ] [ 1array ] bi
-    \ curry #call, ;
-
-: infer-compose ( -- )
-    2 consume-d
-    dup first2 <composed> make-known
-    [ push-d ] [ 1array ] bi
-    \ compose #call, ;
+: infer-compose ( -- ) [ <composed> ] \ compose infer-builder ;
 
 : infer-execute ( -- )
     pop-literal nip
index 5b67cd9adc0970598213f2899fc434846633fce8..5926f08d8c91ee2a5477fb63c768714e194227ae 100644 (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"
index 4d7295042c09c3a57624b0df80936bd9e1205b64..bc6eb9f09276c1327b010eee299023d8bc331694 100644 (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
\ No newline at end of file
index a1786695957ced5a7a719a59914c3efff01c57cf..de0edc452820cb64db6cdccb4cc60965e4d29840 100644 (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" } } ;
index 2e2dccd6c4204db1bc5fe8cc8e52b33aff4ad6aa..fe580084c06977e77d0d7ec39b988d269eceb6b6 100644 (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
\ No newline at end of file
index e5c2f05d72bd89246f96ca59640bbd24d1ff56f0..a2f616480a96c4d045386f604687ef2232cb85e3 100755 (executable)
@@ -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 ]
index 97aa774e55cff1dd4f22ac12278fd26f919d15d0..19db441381d021f51ce2db78b63ee6d26af184d4 100644 (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 ;
\ No newline at end of file
index d85a51edffa272c769ae912d6fb4bbe3c4ba321d..71183093ee14357e037099ce494c8fc0cabb123e 100644 (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" } ;
 
index 36147795d13bb56c0a51dba6e68c69e2d6c6169a..c7a9f7d8905e45e49867be41d3104177f74a2601 100755 (executable)
@@ -303,7 +303,7 @@ 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(_Complex float x, _Complex double y)
 {
        return x + 2 * y;
 }
index de48d6dc5b5bbbd76f29295175aa5b02c15e13a7..42ab8d71d10aaadfc88ebb4ce531094a06ef2282 100755 (executable)
@@ -89,4 +89,4 @@ 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(_Complex float x, _Complex double y);
index 01b2335841cad4bba7a24f74607b77040a8a4d88..86b5223eaa51e6038efdc0a85828044af9033714 100644 (file)
@@ -8,7 +8,6 @@
 #include <fcntl.h>
 #include <limits.h>
 #include <math.h>
-#include <complex.h>
 #include <stdbool.h>
 #include <setjmp.h>