Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
6b55cd55ef
1
Makefile
1
Makefile
|
|
@ -11,6 +11,7 @@ IMAGE = factor.image
|
|||
BUNDLE = Factor.app
|
||||
LIBPATH = -L/usr/X11R6/lib
|
||||
CFLAGS = -Wall
|
||||
FFI_TEST_CFLAGS = -fPIC
|
||||
|
||||
ifdef DEBUG
|
||||
CFLAGS += -g
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ IN: compiler.tests
|
|||
{
|
||||
{ [ os winnt? ] [ "libfactor-ffi-test.dll" ] }
|
||||
{ [ os macosx? ] [ "libfactor-ffi-test.dylib" ] }
|
||||
{ [ os unix? ] [ "libfactor-ffi-test.so" ] }
|
||||
{ [ os unix? ] [ "libfactor-ffi-test.a" ] }
|
||||
} cond append-path ;
|
||||
|
||||
"f-cdecl" libfactor-ffi-tests-path "cdecl" add-library
|
||||
|
|
@ -124,8 +124,6 @@ unit-test
|
|||
"int" { "int" "int" "int" "int" } "stdcall" alien-indirect
|
||||
gc ;
|
||||
|
||||
LIBRARY: f-stdcall
|
||||
|
||||
[ f ] [ "f-stdcall" load-library f = ] unit-test
|
||||
[ "stdcall" ] [ "f-stdcall" library abi>> ] unit-test
|
||||
|
||||
|
|
@ -166,7 +164,7 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3,
|
|||
|
||||
: ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result y )
|
||||
"int"
|
||||
"f-stdcall" "ffi_test_31"
|
||||
"f-cdecl" "ffi_test_31"
|
||||
{ "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" }
|
||||
alien-invoke gc 3 ;
|
||||
|
||||
|
|
@ -174,7 +172,7 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3,
|
|||
|
||||
: ffi_test_31_point_5 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result )
|
||||
"float"
|
||||
"f-stdcall" "ffi_test_31_point_5"
|
||||
"f-cdecl" "ffi_test_31_point_5"
|
||||
{ "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" }
|
||||
alien-invoke ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax kernel math ;
|
||||
USING: help.markup help.syntax kernel math strings ;
|
||||
IN: roman
|
||||
|
||||
HELP: >roman
|
||||
|
|
@ -39,7 +39,7 @@ HELP: roman>
|
|||
{ >roman >ROMAN roman> } related-words
|
||||
|
||||
HELP: roman+
|
||||
{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } }
|
||||
{ $values { "string" string } { "string" string } { "string" string } }
|
||||
{ $description "Adds two Roman numerals." }
|
||||
{ $examples
|
||||
{ $example "USING: io roman ;"
|
||||
|
|
@ -49,7 +49,7 @@ HELP: roman+
|
|||
} ;
|
||||
|
||||
HELP: roman-
|
||||
{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } }
|
||||
{ $values { "string" string } { "string" string } { "string" string } }
|
||||
{ $description "Subtracts two Roman numerals." }
|
||||
{ $examples
|
||||
{ $example "USING: io roman ;"
|
||||
|
|
@ -61,7 +61,7 @@ HELP: roman-
|
|||
{ roman+ roman- } related-words
|
||||
|
||||
HELP: roman*
|
||||
{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } }
|
||||
{ $values { "string" string } { "string" string } { "string" string } }
|
||||
{ $description "Multiplies two Roman numerals." }
|
||||
{ $examples
|
||||
{ $example "USING: io roman ;"
|
||||
|
|
@ -71,7 +71,7 @@ HELP: roman*
|
|||
} ;
|
||||
|
||||
HELP: roman/i
|
||||
{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } }
|
||||
{ $values { "string" string } { "string" string } { "string" string } }
|
||||
{ $description "Computes the integer division of two Roman numerals." }
|
||||
{ $examples
|
||||
{ $example "USING: io roman ;"
|
||||
|
|
@ -81,7 +81,7 @@ HELP: roman/i
|
|||
} ;
|
||||
|
||||
HELP: roman/mod
|
||||
{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } { "str4" "a string" } }
|
||||
{ $values { "string" string } { "string" string } { "string" string } { "string" string } }
|
||||
{ $description "Computes the quotient and remainder of two Roman numerals." }
|
||||
{ $examples
|
||||
{ $example "USING: kernel io roman ;"
|
||||
|
|
|
|||
|
|
@ -38,3 +38,9 @@ USING: arrays kernel math roman roman.private sequences tools.test ;
|
|||
[ "iii" "iii" roman- ] must-fail
|
||||
|
||||
[ 30 ] [ ROMAN: xxx ] unit-test
|
||||
|
||||
[ roman+ ] must-infer
|
||||
[ roman- ] must-infer
|
||||
[ roman* ] must-infer
|
||||
[ roman/i ] must-infer
|
||||
[ roman/mod ] must-infer
|
||||
|
|
|
|||
|
|
@ -1,18 +1,19 @@
|
|||
! Copyright (C) 2007 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs kernel math math.order math.vectors
|
||||
namespaces make quotations sequences splitting.monotonic
|
||||
sequences.private strings unicode.case lexer parser
|
||||
grouping ;
|
||||
USING: accessors arrays assocs fry generalizations grouping
|
||||
kernel lexer macros make math math.order math.vectors
|
||||
namespaces parser quotations sequences sequences.private
|
||||
splitting.monotonic stack-checker strings unicode.case
|
||||
words effects ;
|
||||
IN: roman
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: roman-digits ( -- seq )
|
||||
{ "m" "cm" "d" "cd" "c" "xc" "l" "xl" "x" "ix" "v" "iv" "i" } ;
|
||||
CONSTANT: roman-digits
|
||||
{ "m" "cm" "d" "cd" "c" "xc" "l" "xl" "x" "ix" "v" "iv" "i" }
|
||||
|
||||
: roman-values ( -- seq )
|
||||
{ 1000 900 500 400 100 90 50 40 10 9 5 4 1 } ;
|
||||
CONSTANT: roman-values
|
||||
{ 1000 900 500 400 100 90 50 40 10 9 5 4 1 }
|
||||
|
||||
ERROR: roman-range-error n ;
|
||||
|
||||
|
|
@ -40,38 +41,33 @@ ERROR: roman-range-error n ;
|
|||
PRIVATE>
|
||||
|
||||
: >roman ( n -- str )
|
||||
dup roman-range-check
|
||||
[ (>roman) ] "" make ;
|
||||
dup roman-range-check [ (>roman) ] "" make ;
|
||||
|
||||
: >ROMAN ( n -- str ) >roman >upper ;
|
||||
|
||||
: roman> ( str -- n )
|
||||
>lower [ roman<= ] monotonic-split
|
||||
[ (roman>) ] sigma ;
|
||||
>lower [ roman<= ] monotonic-split [ (roman>) ] sigma ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: 2roman> ( str1 str2 -- m n )
|
||||
[ roman> ] bi@ ;
|
||||
|
||||
: binary-roman-op ( str1 str2 quot -- str3 )
|
||||
[ 2roman> ] dip call >roman ; inline
|
||||
MACRO: binary-roman-op ( quot -- quot' )
|
||||
dup infer [ in>> swap ] [ out>> ] bi
|
||||
'[ [ roman> ] _ napply @ [ >roman ] _ napply ] ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: roman+ ( str1 str2 -- str3 )
|
||||
[ + ] binary-roman-op ;
|
||||
<<
|
||||
SYNTAX: ROMAN-OP:
|
||||
scan-word [ name>> "roman" prepend create-in ] keep
|
||||
1quotation '[ _ binary-roman-op ]
|
||||
dup infer [ in>> ] [ out>> ] bi
|
||||
[ "string" <repetition> ] bi@ <effect> define-declared ;
|
||||
>>
|
||||
|
||||
: roman- ( str1 str2 -- str3 )
|
||||
[ - ] binary-roman-op ;
|
||||
|
||||
: roman* ( str1 str2 -- str3 )
|
||||
[ * ] binary-roman-op ;
|
||||
|
||||
: roman/i ( str1 str2 -- str3 )
|
||||
[ /i ] binary-roman-op ;
|
||||
|
||||
: roman/mod ( str1 str2 -- str3 str4 )
|
||||
[ /mod ] binary-roman-op [ >roman ] dip ;
|
||||
ROMAN-OP: +
|
||||
ROMAN-OP: -
|
||||
ROMAN-OP: *
|
||||
ROMAN-OP: /i
|
||||
ROMAN-OP: /mod
|
||||
|
||||
SYNTAX: ROMAN: scan roman> parsed ;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
include vm/Config.linux
|
||||
include vm/Config.x86.64
|
||||
LIBPATH = -L/usr/X11R6/lib64 -L/usr/X11R6/lib
|
||||
FFI_TEST_CFLAGS = -fPIC
|
||||
|
|
|
|||
Loading…
Reference in New Issue