steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

release
Eduardo Cavazos 2007-11-25 15:44:13 -06:00
parent e167a6b9d5 1f2001143c
commit 9ada5aad82
5 changed files with 17 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
core/cpu/arm/intrinsics/intrinsics.factor
View File

@ -418,17 +418,6 @@ IN: cpu.arm.intrinsics
{ +output+ { "out" } } { +output+ { "out" } }
} define-intrinsic } define-intrinsic
\ curry [
\ curry 3 cells %allot
"obj" operand 1 %set-slot
"quot" operand 2 %set-slot
"out" get object %store-tagged
] H{
{ +input+ { { f "obj" } { f "quot" } } }
{ +scratch+ { { f "out" } } }
{ +output+ { "out" } }
} define-intrinsic
! Alien intrinsics ! Alien intrinsics
: %alien-accessor ( quot -- ) : %alien-accessor ( quot -- )
"offset" operand dup %untag-fixnum "offset" operand dup %untag-fixnum

12
core/cpu/ppc/intrinsics/intrinsics.factor
View File

@ -580,18 +580,6 @@ IN: cpu.ppc.intrinsics
{ +output+ { "vector" } } { +output+ { "vector" } }
} define-intrinsic } define-intrinsic
\ curry [
\ curry 3 cells %allot
"obj" operand 11 1 cells STW
"quot" operand 11 2 cells STW
! Store tagged ptr in reg
"curry" get object %store-tagged
] H{
{ +input+ { { f "obj" } { f "quot" } } }
{ +scratch+ { { f "curry" } } }
{ +output+ { "curry" } }
} define-intrinsic
! Alien intrinsics ! Alien intrinsics
: %alien-accessor ( quot -- ) : %alien-accessor ( quot -- )
"offset" operand dup %untag-fixnum "offset" operand dup %untag-fixnum

13
core/cpu/x86/intrinsics/intrinsics.factor
View File

@ -485,19 +485,6 @@ IN: cpu.x86.intrinsics
{ +output+ { "vector" } } { +output+ { "vector" } }
} define-intrinsic } define-intrinsic
\ curry [
\ curry 3 cells [
1 object@ "obj" operand MOV
2 object@ "quot" operand MOV
! Store tagged ptr in reg
"curry" get object %store-tagged
] %allot
] H{
{ +input+ { { f "obj" } { f "quot" } } }
{ +scratch+ { { f "curry" } } }
{ +output+ { "curry" } }
} define-intrinsic
! Alien intrinsics ! Alien intrinsics
: %alien-accessor ( quot -- ) : %alien-accessor ( quot -- )
"offset" operand %untag-fixnum "offset" operand %untag-fixnum

6
core/quotations/quotations-tests.factor
View File

@ -1,8 +1,8 @@
USING: math kernel quotations tools.test sequences ; USING: math kernel quotations tools.test sequences ;
IN: temporary IN: temporary
[ [ 3 ] ] [ 3 f curry ] unit-test [ [ 3 ] ] [ 3 [ ] curry ] unit-test
[ [ \ + ] ] [ \ + f curry ] unit-test [ [ \ + ] ] [ \ + [ ] curry ] unit-test
[ [ \ + = ] ] [ \ + [ = ] curry ] unit-test [ [ \ + = ] ] [ \ + [ = ] curry ] unit-test
[ [ 1 + 2 + 3 + ] ] [ [ [ 1 + 2 + 3 + ] ] [
@ -14,3 +14,5 @@ IN: temporary
[ [ 3 1 2 ] ] [ [ 1 2 ] 3 add* ] unit-test [ [ 3 1 2 ] ] [ [ 1 2 ] 3 add* ] unit-test
[ [ "hi" ] ] [ "hi" 1quotation ] unit-test [ [ "hi" ] ] [ "hi" 1quotation ] unit-test
[ 1 \ + curry ] unit-test-fails

16
vm/quotations.c Normal file → Executable file
View File

@ -192,9 +192,19 @@ XT quot_offset_to_pc(F_QUOTATION *quot, F_FIXNUM offset)
DEFINE_PRIMITIVE(curry) DEFINE_PRIMITIVE(curry)
{ {
F_CURRY *curry = allot_object(CURRY_TYPE,sizeof(F_CURRY)); F_CURRY *curry = allot_object(CURRY_TYPE,sizeof(F_CURRY));
curry->quot = dpop();
curry->obj = dpop(); switch(type_of(dpeek()))
dpush(tag_object(curry)); {
case QUOTATION_TYPE:
case CURRY_TYPE:
curry->quot = dpop();
curry->obj = dpop();
dpush(tag_object(curry));
break;
default:
type_error(QUOTATION_TYPE,dpeek());
break;
}
} }
void uncurry(CELL obj) void uncurry(CELL obj)