modern: fix FOO>bar to \FOO>bar
Doug Coleman
parent
8b2e42300f
commit
b9e2b14cf0
|
|
@ -18,7 +18,7 @@ IN: calendar.windows
|
|||
]
|
||||
} cleave \ SYSTEMTIME <struct-boa> ;
|
||||
|
||||
: SYSTEMTIME>timestamp ( SYSTEMTIME -- timestamp )
|
||||
: \SYSTEMTIME>timestamp ( SYSTEMTIME -- timestamp )
|
||||
{
|
||||
[ wYear>> ]
|
||||
[ wMonth>> ]
|
||||
|
|
@ -38,4 +38,4 @@ M: windows gmt-offset ( -- hours minutes seconds )
|
|||
} case neg 60 /mod 0 ;
|
||||
|
||||
M: windows gmt
|
||||
SYSTEMTIME <struct> [ GetSystemTime ] keep SYSTEMTIME>timestamp ;
|
||||
SYSTEMTIME <struct> [ GetSystemTime ] keep \SYSTEMTIME>timestamp ;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ HELP: <NSString>
|
|||
{ $values { "str" string } { "alien" alien } }
|
||||
{ $description "Allocates an autoreleased " { $snippet "CFString" } "." } ;
|
||||
|
||||
{ <NSString> <CFString> CF>string } related-words
|
||||
{ <NSString> <CFString> CFString>string } related-words
|
||||
|
||||
HELP: with-autorelease-pool
|
||||
{ $values { "quot" quotation } }
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ FUNCTION: void NSBeep ( )
|
|||
: running.app? ( -- ? )
|
||||
! Test if we're running a .app.
|
||||
".app"
|
||||
NSBundle send: mainBundle send: bundlePath CF>string
|
||||
NSBundle send: mainBundle send: bundlePath CFString>string
|
||||
subseq? ;
|
||||
|
||||
: assert.app ( message -- )
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ CONSTANT: NSCancelButton 0
|
|||
|
||||
: (open-panel) ( panel -- paths )
|
||||
dup send: runModal NSOKButton =
|
||||
[ send: filenames CF>string-array ] [ drop f ] if ;
|
||||
[ send: filenames CFString>string-array ] [ drop f ] if ;
|
||||
|
||||
: open-panel ( -- paths ) <NSOpenPanel> (open-panel) ;
|
||||
|
||||
|
|
@ -37,4 +37,4 @@ CONSTANT: NSCancelButton 0
|
|||
: save-panel ( path -- path/f )
|
||||
[ <NSSavePanel> dup ] dip
|
||||
split-path send: \runModalForDirectory:file: NSOKButton =
|
||||
[ send: filename CF>string ] [ drop f ] if ;
|
||||
[ send: filename CFString>string ] [ drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -17,4 +17,4 @@ IN: cocoa.nibs
|
|||
f
|
||||
{ void* } [ send: \instantiateNibWithOwner:topLevelObjects: ]
|
||||
with-out-parameters
|
||||
swap [ CF>array ] [ drop f ] if ;
|
||||
swap [ CFArray>array ] [ drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -8,11 +8,11 @@ IN: cocoa.pasteboard
|
|||
CONSTANT: NSStringPboardType "NSStringPboardType"
|
||||
|
||||
: pasteboard-string? ( pasteboard -- ? )
|
||||
NSStringPboardType swap send: types CF>string-array member? ;
|
||||
NSStringPboardType swap send: types CFString>string-array member? ;
|
||||
|
||||
: pasteboard-string ( pasteboard -- str )
|
||||
NSStringPboardType <NSString> send: \stringForType:
|
||||
dup [ CF>string ] when ;
|
||||
dup [ CFString>string ] when ;
|
||||
|
||||
: set-pasteboard-types ( seq pasteboard -- )
|
||||
swap <CFArray> send: autorelease f send: \declareTypes:owner: drop ;
|
||||
|
|
|
|||
|
|
@ -52,7 +52,7 @@ ERROR: invalid-plist-object object ;
|
|||
|
||||
: plist> ( plist -- value )
|
||||
{
|
||||
{ NSString [ CF>string ] }
|
||||
{ NSString [ CFString>string ] }
|
||||
{ NSNumber [ (plist-NSNumber>) ] }
|
||||
{ NSData [ (plist-NSData>) ] }
|
||||
{ NSArray [ (plist-NSArray>) ] }
|
||||
|
|
|
|||
|
|
@ -286,7 +286,7 @@ generic-comparison-ops [
|
|||
{ numerator denominator }
|
||||
[ [ drop integer <class-info> ] "outputs" set-word-prop ] each
|
||||
|
||||
\ >fraction [
|
||||
\ fraction>parts [
|
||||
drop integer <class-info> dup
|
||||
] "outputs" set-word-prop
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: help.syntax help.markup arrays alien ;
|
||||
IN: core-foundation.arrays
|
||||
|
||||
HELP: CF>array
|
||||
HELP: CFArray>array
|
||||
{ $values { "alien" "a " { $snippet "CFArray" } } { "array" "an array of " { $link alien } " instances" } }
|
||||
{ $description "Creates a Factor array from a Core Foundation array." } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,6 +6,6 @@ core-foundation.strings destructors sequences tools.test ;
|
|||
[
|
||||
{ "1" "2" "3" }
|
||||
[ <CFString> &CFRelease ] map
|
||||
<CFArray> CF>string-array
|
||||
<CFArray> CFString>string-array
|
||||
] with-destructors
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ FUNCTION: void CFArraySetValueAtIndex ( CFArrayRef array, CFIndex index, void* v
|
|||
|
||||
FUNCTION: CFIndex CFArrayGetCount ( CFArrayRef array )
|
||||
|
||||
: CF>array ( alien -- array )
|
||||
: CFArray>array ( alien -- array )
|
||||
dup CFArrayGetCount
|
||||
[ CFArrayGetValueAtIndex ] with { } map-integers ;
|
||||
|
||||
|
|
|
|||
|
|
@ -13,6 +13,6 @@ IN: core-foundation.dictionaries.tests
|
|||
2array 1array <CFDictionary> &CFRelease
|
||||
"key" get
|
||||
CFDictionaryGetValue
|
||||
dup [ CF>string ] when
|
||||
dup [ CFString>string ] when
|
||||
] with-destructors
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -5,10 +5,10 @@ HELP: <CFString>
|
|||
{ $values { "string" string } { "alien" "a " { $snippet "CFString" } } }
|
||||
{ $description "Creates a Core Foundation string from a Factor string." } ;
|
||||
|
||||
HELP: CF>string
|
||||
HELP: CFString>string
|
||||
{ $values { "alien" "a " { $snippet "CFString" } } { "string" string } }
|
||||
{ $description "Creates a Factor string from a Core Foundation string." } ;
|
||||
|
||||
HELP: CF>string-array
|
||||
HELP: CFString>string-array
|
||||
{ $values { "alien" "a " { $snippet "CFArray" } " of " { $snippet "CFString" } " instances" } { "seq" string } }
|
||||
{ $description "Creates an array of Factor strings from a " { $snippet "CFArray" } " of " { $snippet "CFString" } "s." } ;
|
||||
|
|
|
|||
|
|
@ -5,11 +5,11 @@ strings ;
|
|||
IN: core-foundation
|
||||
|
||||
{ } [ "Hello" <CFString> CFRelease ] unit-test
|
||||
{ "Hello" } [ "Hello" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
|
||||
{ "Hello\u003456" } [ "Hello\u003456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
|
||||
{ "Hello\u013456" } [ "Hello\u013456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
|
||||
{ "Hello" } [ "Hello" <CFString> [ CFString>string ] [ CFRelease ] bi ] unit-test
|
||||
{ "Hello\u003456" } [ "Hello\u003456" <CFString> [ CFString>string ] [ CFRelease ] bi ] unit-test
|
||||
{ "Hello\u013456" } [ "Hello\u013456" <CFString> [ CFString>string ] [ CFRelease ] bi ] unit-test
|
||||
{ } [ "\0" <CFString> CFRelease ] unit-test
|
||||
{ "\0" } [ "\0" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
|
||||
{ "\0" } [ "\0" <CFString> [ CFString>string ] [ CFRelease ] bi ] unit-test
|
||||
|
||||
! This shouldn't fail
|
||||
{ } [ { 0x123456 } >string <CFString> CFRelease ] unit-test
|
||||
|
|
|
|||
|
|
@ -79,7 +79,7 @@ FUNCTION: CFStringRef CFCopyTypeIDDescription ( CFTypeID type_id )
|
|||
CFStringCreateWithBytes
|
||||
[ "CFStringCreateWithBytes failed" throw ] unless* ;
|
||||
|
||||
: CF>string ( alien -- string )
|
||||
: CFString>string ( alien -- string )
|
||||
dup CFStringGetLength
|
||||
[ 0 swap <CFRange> kCFStringEncodingUTF8 0 f ] keep
|
||||
4 * 1 + <byte-vector> [
|
||||
|
|
@ -87,16 +87,16 @@ FUNCTION: CFStringRef CFCopyTypeIDDescription ( CFTypeID type_id )
|
|||
{ CFIndex } [ CFStringGetBytes drop ] with-out-parameters
|
||||
] keep swap >>length utf8 decode ;
|
||||
|
||||
: CF>string-array ( alien -- seq )
|
||||
CF>array [ CF>string ] map ;
|
||||
: CFString>string-array ( alien -- seq )
|
||||
CFArray>array [ CFString>string ] map ;
|
||||
|
||||
: <CFStringArray> ( seq -- alien )
|
||||
[ [ <CFString> &CFRelease ] map <CFArray> ] with-destructors ;
|
||||
|
||||
: CF>description ( cf -- description )
|
||||
[ CFCopyDescription &CFRelease CF>string ] with-destructors ;
|
||||
: CFString>description ( cf -- description )
|
||||
[ CFCopyDescription &CFRelease CFString>string ] with-destructors ;
|
||||
: CFType>description ( cf -- description )
|
||||
CFGetTypeID [ CFCopyTypeIDDescription &CFRelease CF>string ] with-destructors ;
|
||||
CFGetTypeID [ CFCopyTypeIDDescription &CFRelease CFString>string ] with-destructors ;
|
||||
|
||||
SYNTAX: \CFSTRING:
|
||||
scan-new-word scan-object
|
||||
|
|
|
|||
|
|
@ -276,7 +276,7 @@ M: iokit-game-input-backend reset-mouse
|
|||
[
|
||||
drop
|
||||
"input callback doesn't know how to deal with "
|
||||
swap CF>description append throw
|
||||
swap CFString>description append throw
|
||||
]
|
||||
} cond ;
|
||||
|
||||
|
|
|
|||
|
|
@ -35,9 +35,9 @@ TUPLE: windows-file-info < file-info-tuple attributes ;
|
|||
[ dwFileAttributes>> win32-file-attributes >>attributes ]
|
||||
[ [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit >>size ]
|
||||
[ dwFileAttributes>> >>permissions ]
|
||||
[ ftCreationTime>> FILETIME>timestamp >>created ]
|
||||
[ ftLastWriteTime>> FILETIME>timestamp >>modified ]
|
||||
[ ftLastAccessTime>> FILETIME>timestamp >>accessed ]
|
||||
[ ftCreationTime>> filetime>timestamp >>created ]
|
||||
[ ftLastWriteTime>> filetime>timestamp >>modified ]
|
||||
[ ftLastAccessTime>> filetime>timestamp >>accessed ]
|
||||
} cleave ;
|
||||
|
||||
: find-first-file-stat ( path -- WIN32_FIND_DATA )
|
||||
|
|
@ -57,9 +57,9 @@ TUPLE: windows-file-info < file-info-tuple attributes ;
|
|||
[ nFileSizeHigh>> ] bi >64bit >>size
|
||||
]
|
||||
[ dwFileAttributes>> >>permissions ]
|
||||
[ ftCreationTime>> FILETIME>timestamp >>created ]
|
||||
[ ftLastWriteTime>> FILETIME>timestamp >>modified ]
|
||||
[ ftLastAccessTime>> FILETIME>timestamp >>accessed ]
|
||||
[ ftCreationTime>> filetime>timestamp >>created ]
|
||||
[ ftLastWriteTime>> filetime>timestamp >>modified ]
|
||||
[ ftLastAccessTime>> filetime>timestamp >>accessed ]
|
||||
! [ nNumberOfLinks>> ]
|
||||
! [
|
||||
! [ nFileIndexLow>> ]
|
||||
|
|
@ -228,7 +228,7 @@ M: windows file-systems ( -- array )
|
|||
{ FILETIME FILETIME FILETIME }
|
||||
[ GetFileTime win32-error=0/f ]
|
||||
with-out-parameters
|
||||
[ FILETIME>timestamp >local-time ] tri@
|
||||
[ filetime>timestamp >local-time ] tri@
|
||||
] with-destructors ;
|
||||
|
||||
: set-file-times ( path timestamp/f timestamp/f timestamp/f -- )
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ CONSTANT: factor-bundle-name "org.factorcode.Factor"
|
|||
PRIVATE>
|
||||
|
||||
M: macosx default-temp-directory
|
||||
NSTemporaryDirectory CF>string factor-bundle-subdir ;
|
||||
NSTemporaryDirectory CFString>string factor-bundle-subdir ;
|
||||
|
||||
M: macosx default-cache-directory
|
||||
NSCachesDirectory NSUserDomainMask 1 NSSearchPathForDirectoriesInDomains
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ M: bignum ^n
|
|||
[ factor-2s ] dip [ (^n) ] keep rot * shift ;
|
||||
|
||||
M: ratio ^n
|
||||
[ >fraction ] dip '[ _ ^n ] bi@ / ;
|
||||
[ fraction>parts ] dip '[ _ ^n ] bi@ / ;
|
||||
|
||||
M: float ^n (^n) ;
|
||||
|
||||
|
|
@ -397,7 +397,7 @@ M: integer round-to-odd ; inline
|
|||
[ >integer even? ] (round-tiebreak?) ; inline
|
||||
|
||||
: (ratio-round) ( x round-quot -- y )
|
||||
[ >fraction [ /mod dup swapd abs 2 * ] keep ] [ call ] bi*
|
||||
[ fraction>parts [ /mod dup swapd abs 2 * ] keep ] [ call ] bi*
|
||||
[ swap 0 < -1 1 ? + ] [ nip ] if ; inline
|
||||
|
||||
: (float-round) ( x round-quot -- y )
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ IN: math.rectangles.prettyprint
|
|||
|
||||
M: rect pprint*
|
||||
[
|
||||
\ rect: [
|
||||
\ rect:: [
|
||||
[ loc>> ] [ dim>> ] bi [ pprint* ] bi@
|
||||
] pprint-prefix
|
||||
] check-recursion ;
|
||||
|
|
|
|||
|
|
@ -2,39 +2,39 @@ USING: tools.test math.rectangles prettyprint io.streams.string
|
|||
kernel accessors ;
|
||||
IN: math.rectangles.tests
|
||||
|
||||
{ rect: { 10 10 } { 20 20 } }
|
||||
{ rect:: { 10 10 } { 20 20 } }
|
||||
[
|
||||
rect: { 10 10 } { 50 50 }
|
||||
rect: { -10 -10 } { 40 40 }
|
||||
rect:: { 10 10 } { 50 50 }
|
||||
rect:: { -10 -10 } { 40 40 }
|
||||
rect-intersect
|
||||
] unit-test
|
||||
|
||||
{ rect: { 200 200 } { 0 0 } }
|
||||
{ rect:: { 200 200 } { 0 0 } }
|
||||
[
|
||||
rect: { 100 100 } { 50 50 }
|
||||
rect: { 200 200 } { 40 40 }
|
||||
rect:: { 100 100 } { 50 50 }
|
||||
rect:: { 200 200 } { 40 40 }
|
||||
rect-intersect
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
rect: { 100 100 } { 50 50 }
|
||||
rect: { 200 200 } { 40 40 }
|
||||
rect:: { 100 100 } { 50 50 }
|
||||
rect:: { 200 200 } { 40 40 }
|
||||
contains-rect?
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
rect: { 100 100 } { 50 50 }
|
||||
rect: { 120 120 } { 40 40 }
|
||||
rect:: { 100 100 } { 50 50 }
|
||||
rect:: { 120 120 } { 40 40 }
|
||||
contains-rect?
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
rect: { 1000 100 } { 50 50 }
|
||||
rect: { 120 120 } { 40 40 }
|
||||
rect:: { 1000 100 } { 50 50 }
|
||||
rect:: { 120 120 } { 40 40 }
|
||||
contains-rect?
|
||||
] unit-test
|
||||
|
||||
{ rect: { 10 20 } { 20 20 } } [
|
||||
{ rect:: { 10 20 } { 20 20 } } [
|
||||
{
|
||||
{ 20 20 }
|
||||
{ 10 40 }
|
||||
|
|
@ -42,5 +42,5 @@ IN: math.rectangles.tests
|
|||
} rect-containing
|
||||
] unit-test
|
||||
|
||||
! Prettyprint for rect: didn't do nesting check properly
|
||||
{ } [ [ rect: f f dup >>dim . ] with-string-writer drop ] unit-test
|
||||
! Prettyprint for rect:: didn't do nesting check properly
|
||||
{ } [ [ rect:: f f dup >>dim . ] with-string-writer drop ] unit-test
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ;
|
|||
|
||||
: <rect> ( loc dim -- rect ) rect boa ; inline
|
||||
|
||||
SYNTAX: \rect: scan-object scan-object <rect> suffix! ;
|
||||
SYNTAX: \rect:: scan-object scan-object <rect> suffix! ;
|
||||
|
||||
: <zero-rect> ( -- rect ) rect new ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -161,7 +161,7 @@ PRIVATE>
|
|||
|
||||
! 2+1/4 frac is 1/4
|
||||
: frac ( x -- x' )
|
||||
>fraction [ /mod nip ] keep / ; inline
|
||||
fraction>parts [ /mod nip ] keep / ; inline
|
||||
|
||||
:: quantile-indices ( seq qs a b -- seq )
|
||||
qs [ [ a b seq length ] dip quantile-x ] map ;
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@ TUPLE: alphanum obj ;
|
|||
|
||||
: <alphanum-insensitive> ( obj -- alphanum )
|
||||
alphanum new
|
||||
swap dup string? [ w/collation-key ] when >>obj ; inline
|
||||
swap dup string? [ collation-key/nfd drop ] when >>obj ; inline
|
||||
|
||||
M: alphanum <=>
|
||||
[ obj>> ] bi@
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ FROM: alien.c-types => int void ;
|
|||
IN: ui.backend.cocoa.tools
|
||||
|
||||
: finder-run-files ( alien -- )
|
||||
CF>string-array listener-run-files
|
||||
CFString>string-array listener-run-files
|
||||
NSApp NSApplicationDelegateReplySuccess
|
||||
send: \replyToOpenOrPrint: ;
|
||||
|
||||
|
|
|
|||
|
|
@ -70,7 +70,7 @@ CONSTANT: key-codes
|
|||
|
||||
: key-code ( event -- string ? )
|
||||
dup send: keyCode key-codes at
|
||||
[ t ] [ send: charactersIgnoringModifiers CF>string f ] ?if ;
|
||||
[ t ] [ send: charactersIgnoringModifiers CFString>string f ] ?if ;
|
||||
|
||||
: event-modifiers ( event -- modifiers )
|
||||
send: modifierFlags modifiers modifier ;
|
||||
|
|
@ -126,7 +126,7 @@ CONSTANT: key-codes
|
|||
] dip add-observer ;
|
||||
|
||||
: string-or-nil? ( NSString -- ? )
|
||||
[ CF>string NSStringPboardType = ] [ t ] if* ;
|
||||
[ CFString>string NSStringPboardType = ] [ t ] if* ;
|
||||
|
||||
: valid-service? ( gadget send-type return-type -- ? )
|
||||
2dup [ string-or-nil? ] [ string-or-nil? ] bi* and
|
||||
|
|
@ -194,7 +194,7 @@ CONSTANT: selector>action H{
|
|||
METHOD: Class makeTouchBar [ default-touchbar self make-touchbar ] ;
|
||||
|
||||
METHOD: Class touchBar: Class touchbar makeItemForIdentifier: Class string [
|
||||
string CF>string
|
||||
string CFString>string
|
||||
{
|
||||
{ "refresh-all-action" [
|
||||
self "refresh-all-action" "refresh-all" "refreshAllAction" make-NSTouchBar-button
|
||||
|
|
@ -317,7 +317,7 @@ CONSTANT: selector>action H{
|
|||
|
||||
METHOD: char writeSelectionToPasteboard: id pboard types: id types
|
||||
[
|
||||
NSStringPboardType types CF>string-array member? [
|
||||
NSStringPboardType types CFString>string-array member? [
|
||||
self window [
|
||||
world-focus gadget-selection
|
||||
[ pboard set-pasteboard-string 1 ] [ 0 ] if*
|
||||
|
|
@ -339,7 +339,7 @@ CONSTANT: selector>action H{
|
|||
[
|
||||
self window :> window
|
||||
window [
|
||||
text CF>string window user-input
|
||||
text CFString>string window user-input
|
||||
] when
|
||||
] ;
|
||||
|
||||
|
|
|
|||
|
|
@ -488,7 +488,7 @@ SYMBOL: nc-buttons
|
|||
4drop forget-rollover ;
|
||||
|
||||
: system-background-color ( -- color )
|
||||
COLOR_BTNFACE GetSysColor RGB>color ;
|
||||
COLOR_BTNFACE GetSysColor \RGB>color ;
|
||||
|
||||
: ?make-glass ( world hwnd -- )
|
||||
over window-controls>> textured-background swap member-eq? [
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ IN: math.approx
|
|||
{ [ r zero? ] [ q ] }
|
||||
{ [ q q' = not ] [ q 1 + ] }
|
||||
[
|
||||
d' r' d r (simplest) >fraction :> ( n'' d'' )
|
||||
d' r' d r (simplest) fraction>parts :> ( n'' d'' )
|
||||
q n'' * d'' + n'' /
|
||||
]
|
||||
} cond ;
|
||||
|
|
@ -23,8 +23,8 @@ IN: math.approx
|
|||
{
|
||||
{ [ x y > ] [ y x simplest ] }
|
||||
{ [ x y = ] [ x ] }
|
||||
{ [ x 0 > ] [ x y [ >fraction ] bi@ (simplest) ] }
|
||||
{ [ y 0 < ] [ y x [ neg >fraction ] bi@ (simplest) neg ] }
|
||||
{ [ x 0 > ] [ x y [ fraction>parts ] bi@ (simplest) ] }
|
||||
{ [ y 0 < ] [ y x [ neg fraction>parts ] bi@ (simplest) neg ] }
|
||||
[ 0 ]
|
||||
} cond ;
|
||||
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ PRIVATE>
|
|||
|
||||
M: integer number-hashcode 1 hash-fraction ;
|
||||
|
||||
M: ratio number-hashcode >fraction hash-fraction ;
|
||||
M: ratio number-hashcode fraction>parts hash-fraction ;
|
||||
|
||||
M: float number-hashcode ( x -- h )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -96,7 +96,7 @@ M: integer number>text
|
|||
[ "zero" ] [ [ (number>text) ] with-scope ] if-zero ;
|
||||
|
||||
M: ratio number>text
|
||||
>fraction [ number>text ] bi@ " divided by " glue ;
|
||||
fraction>parts [ number>text ] bi@ " divided by " glue ;
|
||||
|
||||
M: float number>text
|
||||
number>string "." split1 [
|
||||
|
|
|
|||
|
|
@ -110,6 +110,6 @@ M: integer number>text
|
|||
dup abs 102 10^ >= [ number>string ] [ basic ] if ;
|
||||
|
||||
M: ratio number>text
|
||||
>fraction [ [ number>text ] keep ] [ divisor ] bi*
|
||||
fraction>parts [ [ number>text ] keep ] [ divisor ] bi*
|
||||
swap abs 1 > [ pluralize ] when
|
||||
space-append ;
|
||||
|
|
|
|||
|
|
@ -261,15 +261,15 @@ CONSTANT: sky H{
|
|||
tri* 3append
|
||||
] unless ;
|
||||
|
||||
: F>C ( F -- C ) 32 - 5/9 * ;
|
||||
: \F>C ( F -- C ) 32 - 5/9 * ;
|
||||
|
||||
: C>F ( C -- F ) 9/5 * 32 + ;
|
||||
: \C>F ( C -- F ) 9/5 * 32 + ;
|
||||
|
||||
: parse-temperature ( str -- temp dew-point )
|
||||
"/" split1 [
|
||||
[ f ] [
|
||||
"M" ?head [ string>number ] [ [ neg ] when ] bi*
|
||||
dup C>F "%d °C (%.1f °F)" sprintf
|
||||
dup \C>F "%d °C (%.1f °F)" sprintf
|
||||
] if-empty
|
||||
] bi@ ;
|
||||
|
||||
|
|
@ -352,24 +352,24 @@ CONSTANT: re-altimeter R[[ [AQ]\d{4}]]
|
|||
: parse-1hr-temp ( str -- str' )
|
||||
"T" ?head drop dup length 4 > [
|
||||
double-value
|
||||
[ dup C>F "%.1f °C (%.1f °F)" sprintf ] bi@
|
||||
[ dup \C>F "%.1f °C (%.1f °F)" sprintf ] bi@
|
||||
"hourly temperature %s and dew point %s" sprintf
|
||||
] [
|
||||
single-value dup C>F
|
||||
single-value dup \C>F
|
||||
"hourly temperature %.1f °C (%.1f °F)" sprintf
|
||||
] if ;
|
||||
|
||||
: parse-6hr-max-temp ( str -- str' )
|
||||
"1" ?head drop single-value dup C>F
|
||||
"1" ?head drop single-value dup \C>F
|
||||
"6-hour maximum temperature %.1f °C (%.1f °F)" sprintf ;
|
||||
|
||||
: parse-6hr-min-temp ( str -- str' )
|
||||
"2" ?head drop single-value dup C>F
|
||||
"2" ?head drop single-value dup \C>F
|
||||
"6-hour minimum temperature %.1f °C (%.1f °F)" sprintf ;
|
||||
|
||||
: parse-24hr-temp ( str -- str' )
|
||||
"4" ?head drop double-value
|
||||
[ dup C>F "%.1f °C (%.1f °F)" sprintf ] bi@
|
||||
[ dup \C>F "%.1f °C (%.1f °F)" sprintf ] bi@
|
||||
"24-hour maximum temperature %s minimum temperature %s"
|
||||
sprintf ;
|
||||
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ IN: project-euler.057
|
|||
! --------
|
||||
|
||||
: longer-numerator? ( seq -- ? )
|
||||
>fraction [ number>string length ] bi@ > ; inline
|
||||
fraction>parts [ number>string length ] bi@ > ; inline
|
||||
|
||||
: euler057 ( -- answer )
|
||||
0 1000 <iota> [ drop 2 + recip dup 1 + longer-numerator? ] count nip ;
|
||||
|
|
|
|||
|
|
@ -69,7 +69,7 @@ PRIVATE>
|
|||
>lower [ char: a - 1 + ] map-sum ;
|
||||
|
||||
: mediant ( a/c b/d -- (a+b)/(c+d) )
|
||||
2>fraction [ + ] 2bi@ / ;
|
||||
2fraction>parts [ + ] 2bi@ / ;
|
||||
|
||||
: max-path ( triangle -- n )
|
||||
dup length 1 > [
|
||||
|
|
|
|||
|
|
@ -56,7 +56,7 @@ syn keyword factorCallNextMethod call-next-method
|
|||
syn keyword factorKeyword (clone) -rot 2bi 2bi* 2bi@ 2curry 2dip 2drop 2dup 2keep 2nip 2over 2tri 2tri* 2tri@ 2with 3bi 3curry 3dip 3drop 3dup 3keep 3tri 4dip 4drop 4dup 4keep <wrapper> = >boolean ? ?if and assert assert= assert? bi bi* bi-curry bi-curry* bi-curry@ bi@ boa boolean boolean? both? build call callstack callstack>array callstack? clear clone compose composed? curry curried? die dip do drop dup dupd either? eq? equal? execute get-callstack get-datastack get-retainstack hashcode hashcode* identity-hashcode identity-tuple identity-tuple? if if* keep loop most new nip not null object or over pick prepose rot same? swap swapd throw tri tri* tri-curry tri-curry* tri-curry@ tri@ tuple tuple? unless unless* until when when* while with wrapper wrapper? xor
|
||||
syn keyword factorKeyword 2cache <enumerated> >alist ?at ?of assoc assoc-all? assoc-any? assoc-clone-like assoc-combine assoc-diff assoc-diff! assoc-differ assoc-each assoc-empty? assoc-filter assoc-filter! assoc-filter-as assoc-find assoc-hashcode assoc-intersect assoc-like assoc-map assoc-map-as assoc-partition assoc-refine assoc-reject assoc-reject! assoc-reject-as assoc-size assoc-stack assoc-subset? assoc-union assoc-union! assoc= assoc>map assoc? at at* at+ cache change-at clear-assoc delete-at delete-at* enum enum? extract-keys harvest-keys harvest-values inc-at key? keys map>alist map>assoc maybe-set-at new-assoc of push-at rename-at set-at sift-keys sift-values substitute unzip value-at value-at* value? values zip zip-as zip-index zip-index-as
|
||||
syn keyword factorKeyword 2cleave 2cleave>quot 3cleave 3cleave>quot 4cleave 4cleave>quot alist>quot call-effect case case-find case>quot cleave cleave>quot cond cond>quot deep-spread>quot execute-effect linear-case-quot no-case no-case? no-cond no-cond? recursive-hashcode shallow-spread>quot spread to-fixed-point wrong-values wrong-values?
|
||||
syn keyword factorKeyword (all-integers?) (each-integer) (find-integer) * + - / /f /i /mod 2/ 2^ < <= <fp-nan> > >= >bignum >fixnum >float >fraction >integer >rect ?1+ abs align all-integers? bignum bignum? bit? bitand bitnot bitor bits>double bits>float bitxor complex complex? denominator double>bits each-integer even? fast-gcd find-integer find-last-integer fixnum fixnum? float float>bits float? fp-bitwise= fp-infinity? fp-nan-payload fp-nan? fp-qnan? fp-sign fp-snan? fp-special? gcd if-zero imaginary-part integer integer>fixnum integer>fixnum-strict integer? log2 log2-expects-positive log2-expects-positive? mod neg neg? next-float next-power-of-2 number number= number? numerator odd? power-of-2? prev-float ratio ratio? rational rational? real real-part real? recip rect> rem sgn shift sq times u< u<= u> u>= unless-zero unordered? when-zero zero?
|
||||
syn keyword factorKeyword (all-integers?) (each-integer) (find-integer) * + - / /f /i /mod 2/ 2^ < <= <fp-nan> > >= >bignum >fixnum >float fraction>parts >integer >rect ?1+ abs align all-integers? bignum bignum? bit? bitand bitnot bitor bits>double bits>float bitxor complex complex? denominator double>bits each-integer even? fast-gcd find-integer find-last-integer fixnum fixnum? float float>bits float? fp-bitwise= fp-infinity? fp-nan-payload fp-nan? fp-qnan? fp-sign fp-snan? fp-special? gcd if-zero imaginary-part integer integer>fixnum integer>fixnum-strict integer? log2 log2-expects-positive log2-expects-positive? mod neg neg? next-float next-power-of-2 number number= number? numerator odd? power-of-2? prev-float ratio ratio? rational rational? real real-part real? recip rect> rem sgn shift sq times u< u<= u> u>= unless-zero unordered? when-zero zero?
|
||||
syn keyword factorKeyword 1sequence 2all? 2each 2each-from 2map 2map-as 2map-reduce 2reduce 2selector 2sequence 3append 3append-as 3each 3map 3map-as 3sequence 4sequence <repetition> <reversed> <slice> ?first ?last ?nth ?second ?set-nth accumulate accumulate! accumulate-as all? any? append append! append-as assert-sequence assert-sequence= assert-sequence? binary-reduce bounds-check bounds-check? bounds-error bounds-error? but-last but-last-slice cartesian-each cartesian-map cartesian-product change-nth check-slice clone-like collapse-slice collector collector-for concat concat-as copy count cut cut* cut-slice delete-all delete-slice drop-prefix each each-from each-index empty? exchange filter filter! filter-as find find-from find-index find-index-from find-last find-last-from first first2 first3 first4 flip follow fourth glue halves harvest head head* head-slice head-slice* head? if-empty immutable immutable-sequence immutable-sequence? immutable? index index-from indices infimum infimum-by insert-nth interleave iota iota-tuple iota-tuple? join join-as last last-index last-index-from length lengthen like longer longer? longest map map! map-as map-find map-find-last map-index map-index-as map-integers map-reduce map-sum max-length member-eq? member? midpoint@ min-length mismatch move new-like new-resizable new-sequence non-negative-integer-expected non-negative-integer-expected? nth nths pad-head pad-tail padding partition pop pop* prefix prepend prepend-as produce produce-as product push push-all push-either push-if reduce reduce-index reject reject! reject-as remove remove! remove-eq remove-eq! remove-nth remove-nth! repetition repetition? replace-slice replicate replicate-as rest rest-slice reverse reverse! reversed reversed? second selector selector-for sequence sequence-hashcode sequence= sequence? set-first set-fourth set-last set-length set-nth set-second set-third short shorten shorter shorter? shortest sift slice slice-error slice-error? slice? snip snip-slice subseq-start subseq-start-from subseq subseq? suffix suffix! sum sum-lengths supremum supremum-by surround tail tail* tail-slice tail-slice* tail? third trim trim-head trim-head-slice trim-slice trim-tail trim-tail-slice unclip unclip-last unclip-last-slice unclip-slice unless-empty virtual-exemplar virtual-sequence virtual-sequence? virtual@ when-empty
|
||||
syn keyword factorKeyword +@ change change-global counter dec get get-global get-namestack global inc init-namespaces initialize namespace off on set set-global set-namestack toggle with-global with-scope with-variable with-variables
|
||||
syn keyword factorKeyword 1array 2array 3array 4array <array> >array array array? pair pair? resize-array
|
||||
|
|
|
|||
Loading…
Reference in New Issue