Fix conflict

db4
Slava Pestov 2009-06-30 20:16:09 -05:00
parent 5c6c3ecd85
commit 1acf243cce
5 changed files with 67 additions and 41 deletions

View File

@ -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 ;

View File

@ -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 ] }

View File

@ -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

View File

@ -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 ;
: <uploaded-image-action> ( -- action )
<page-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 ;
: <upload-image-action> ( -- action )
<page-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" <redirect>
] >>submit ;
: <imagebin> ( -- responder )
: <imagebin> ( image-directory -- responder )
imagebin new-dispatcher
swap [ make-directories ] [ >>path ] bi
0 >>n
<upload-image-action> "" add-responder
<upload-image-action> "upload-image" add-responder
<uploaded-image-action> "uploaded-image" add-responder ;
"resource:images" <imagebin> main-responder set-global

View File

@ -2,6 +2,6 @@
<html>
<head><title>Uploaded</title></head>
<body>
hi from uploaded-image
You uploaded something!
</body>
</html>