From 1acf243ccec6e40c817126ad0e1566878f461018 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 30 Jun 2009 20:16:09 -0500 Subject: [PATCH] Fix conflict --- .../cfg/intrinsics/fixnum/fixnum.factor | 45 +++++++++++++------ .../compiler/cfg/intrinsics/intrinsics.factor | 12 ++--- .../cfg/optimizer/optimizer-tests.factor | 7 +-- extra/webapps/imagebin/imagebin.factor | 42 +++++++++-------- extra/webapps/imagebin/uploaded-image.xml | 2 +- 5 files changed, 67 insertions(+), 41 deletions(-) diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor index 0b391b7de9..e09c80ba39 100644 --- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor +++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: sequences accessors layouts kernel math namespaces combinators fry locals @@ -17,13 +17,14 @@ IN: compiler.cfg.intrinsics.fixnum 0 cc= ^^compare-imm ds-push ; -: (emit-fixnum-imm-op) ( infos insn -- dst ) - ds-drop - [ ds-pop ] - [ second literal>> [ tag-fixnum ] [ \ f tag-number ] if* ] - [ ] - tri* - call ; inline +: tag-literal ( n -- tagged ) + literal>> [ tag-fixnum ] [ \ f tag-number ] if* ; + +: emit-fixnum-imm-op1 ( infos insn -- dst ) + [ ds-pop ds-drop ] [ first tag-literal ] [ ] tri* call ; inline + +: emit-fixnum-imm-op2 ( infos insn -- dst ) + [ ds-drop ds-pop ] [ second tag-literal ] [ ] tri* call ; inline : (emit-fixnum-op) ( insn -- dst ) [ 2inputs ] dip call ; inline @@ -31,9 +32,22 @@ IN: compiler.cfg.intrinsics.fixnum :: emit-fixnum-op ( node insn imm-insn -- ) [let | infos [ node node-input-infos ] | infos second value-info-small-tagged? - [ infos imm-insn (emit-fixnum-imm-op) ] - [ insn (emit-fixnum-op) ] - if + [ infos imm-insn emit-fixnum-imm-op2 ] + [ insn (emit-fixnum-op) ] if + ds-push + ] ; inline + +:: emit-commutative-fixnum-op ( node insn imm-insn -- ) + [let | infos [ node node-input-infos ] | + infos first value-info-small-tagged? + [ infos imm-insn emit-fixnum-imm-op1 ] + [ + infos second value-info-small-tagged? [ + infos imm-insn emit-fixnum-imm-op2 + ] [ + insn (emit-fixnum-op) + ] if + ] if ds-push ] ; inline @@ -68,9 +82,14 @@ IN: compiler.cfg.intrinsics.fixnum [ (emit-fixnum*fast-imm) ] [ drop (emit-fixnum*fast) ] if ds-push ; +: (emit-fixnum-comparison) ( cc -- quot1 quot2 ) + [ ^^compare ] [ ^^compare-imm ] bi-curry ; inline + +: emit-eq ( node -- ) + cc= (emit-fixnum-comparison) emit-commutative-fixnum-op ; + : emit-fixnum-comparison ( node cc -- ) - [ ^^compare ] [ ^^compare-imm ] bi-curry - emit-fixnum-op ; + (emit-fixnum-comparison) emit-fixnum-op ; : emit-bignum>fixnum ( -- ) ds-pop ^^bignum>integer ^^tag-fixnum ds-push ; diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index 3bf54b837b..df01bba89b 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: words sequences kernel combinators cpu.architecture compiler.cfg.hats @@ -102,11 +102,11 @@ IN: compiler.cfg.intrinsics { \ math.private:fixnum+ [ drop [ ##fixnum-add ] emit-fixnum-overflow-op ] } { \ math.private:fixnum- [ drop [ ##fixnum-sub ] emit-fixnum-overflow-op ] } { \ math.private:fixnum* [ drop [ i i ##fixnum-mul ] emit-fixnum-overflow-op ] } - { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-fixnum-op ] } + { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-commutative-fixnum-op ] } { \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op ] } - { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-fixnum-op ] } - { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-fixnum-op ] } - { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-fixnum-op ] } + { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-commutative-fixnum-op ] } + { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-commutative-fixnum-op ] } + { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-commutative-fixnum-op ] } { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] } { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] } { \ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] } @@ -115,7 +115,7 @@ IN: compiler.cfg.intrinsics { \ math.private:fixnum<= [ cc<= emit-fixnum-comparison ] } { \ math.private:fixnum>= [ cc>= emit-fixnum-comparison ] } { \ math.private:fixnum> [ cc> emit-fixnum-comparison ] } - { \ kernel:eq? [ cc= emit-fixnum-comparison ] } + { \ kernel:eq? [ emit-eq ] } { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum ] } { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum ] } { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op ] } diff --git a/basis/compiler/cfg/optimizer/optimizer-tests.factor b/basis/compiler/cfg/optimizer/optimizer-tests.factor index b95a8c79ea..ee601f2337 100644 --- a/basis/compiler/cfg/optimizer/optimizer-tests.factor +++ b/basis/compiler/cfg/optimizer/optimizer-tests.factor @@ -1,6 +1,7 @@ -USING: arrays sequences tools.test compiler.cfg.checker compiler.cfg.debugger -compiler.cfg.def-use sets kernel kernel.private fry slots.private vectors -sequences.private math sbufs math.private slots.private strings ; +USING: arrays sequences tools.test compiler.cfg.checker +compiler.cfg.debugger compiler.cfg.def-use sets kernel +kernel.private fry slots.private vectors sequences.private +math sbufs math.private strings ; IN: compiler.cfg.optimizer.tests ! Miscellaneous tests diff --git a/extra/webapps/imagebin/imagebin.factor b/extra/webapps/imagebin/imagebin.factor index f347377d95..bb8720466c 100755 --- a/extra/webapps/imagebin/imagebin.factor +++ b/extra/webapps/imagebin/imagebin.factor @@ -1,39 +1,45 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel furnace.actions html.forms -http.server.dispatchers db db.tuples db.types urls -furnace.redirection multiline http namespaces ; +USING: accessors furnace.actions furnace.redirection +html.forms http http.server http.server.dispatchers +io.directories io.encodings.utf8 io.files io.pathnames +kernel math.parser multiline namespaces sequences urls ; IN: webapps.imagebin -TUPLE: imagebin < dispatcher ; - -TUPLE: image id path ; - -image "IMAGE" { - { "id" "ID" INTEGER +db-assigned-id+ } - { "path" "PATH" { VARCHAR 256 } +not-null+ } -} define-persistent +TUPLE: imagebin < dispatcher path n ; : ( -- action ) { imagebin "uploaded-image" } >>template ; -SYMBOL: my-post-data +: next-image-path ( -- path ) + imagebin get + [ path>> ] [ n>> number>string ] bi append-path ; + +M: imagebin call-responder* + [ imagebin set ] [ call-next-method ] bi ; + +: move-image ( mime-file -- ) + next-image-path + [ [ temporary-path>> ] dip move-file ] + [ [ filename>> ] dip ".txt" append utf8 set-file-contents ] 2bi ; + : ( -- action ) { imagebin "upload-image" } >>template [ - - ! request get post-data>> my-post-data set-global - ! image new - ! "file" value - ! insert-tuple + "file1" param [ move-image ] when* + "file2" param [ move-image ] when* + "file3" param [ move-image ] when* "uploaded-image" ] >>submit ; -: ( -- responder ) +: ( image-directory -- responder ) imagebin new-dispatcher + swap [ make-directories ] [ >>path ] bi + 0 >>n "" add-responder "upload-image" add-responder "uploaded-image" add-responder ; +"resource:images" main-responder set-global diff --git a/extra/webapps/imagebin/uploaded-image.xml b/extra/webapps/imagebin/uploaded-image.xml index 903be5cca4..79dfabc924 100644 --- a/extra/webapps/imagebin/uploaded-image.xml +++ b/extra/webapps/imagebin/uploaded-image.xml @@ -2,6 +2,6 @@ Uploaded -hi from uploaded-image +You uploaded something!