Merge branch 'master' of git://factorcode.org/git/littledan
Daniel Ehrenberg
commit
8ea775f9b5
|
|
@ -44,6 +44,9 @@ PRIVATE>
|
|||
>intervals ensure-disjoint >tuple-array
|
||||
interval-map boa ;
|
||||
|
||||
: <interval-set> ( specification -- map )
|
||||
[ dup 2array ] map <interval-map> ;
|
||||
|
||||
:: coalesce ( alist -- specification )
|
||||
! Only works with integer keys, because they're discrete
|
||||
! Makes 2array keys
|
||||
|
|
|
|||
|
|
@ -79,3 +79,5 @@ IN: sequences.lib.tests
|
|||
|
||||
[ ] [ { } 0 firstn ] unit-test
|
||||
[ "a" ] [ { "a" } 1 firstn ] unit-test
|
||||
|
||||
[ { { 1 1 } { 1 2 } { 2 0 } } ] [ { { 2 0 } { 1 1 } { 1 2 } } dup [ first ] insertion-sort ] unit-test
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
USING: combinators.lib kernel sequences math namespaces assocs
|
||||
random sequences.private shuffle math.functions mirrors
|
||||
arrays math.parser math.private sorting strings ascii macros
|
||||
assocs.lib quotations hashtables math.order ;
|
||||
assocs.lib quotations hashtables math.order locals ;
|
||||
IN: sequences.lib
|
||||
|
||||
: each-withn ( seq quot n -- ) nwith each ; inline
|
||||
|
|
@ -243,3 +243,17 @@ PRIVATE>
|
|||
|
||||
: short ( seq n -- seq n' )
|
||||
over length min ; inline
|
||||
|
||||
<PRIVATE
|
||||
:: insert ( seq quot n -- )
|
||||
n zero? [
|
||||
n n 1- [ seq nth quot call ] bi@ >= [
|
||||
n n 1- seq exchange
|
||||
seq quot n 1- insert
|
||||
] unless
|
||||
] unless ; inline
|
||||
PRIVATE>
|
||||
|
||||
: insertion-sort ( seq quot -- )
|
||||
! quot is a transformation on elements
|
||||
over length [ insert ] 2with each ; inline
|
||||
|
|
|
|||
|
|
@ -1,20 +0,0 @@
|
|||
# ================================================
|
||||
# Note: This is only a portion of the original PropList.txt
|
||||
|
||||
09BE ; Other_Grapheme_Extend # Mc BENGALI VOWEL SIGN AA
|
||||
09D7 ; Other_Grapheme_Extend # Mc BENGALI AU LENGTH MARK
|
||||
0B3E ; Other_Grapheme_Extend # Mc ORIYA VOWEL SIGN AA
|
||||
0B57 ; Other_Grapheme_Extend # Mc ORIYA AU LENGTH MARK
|
||||
0BBE ; Other_Grapheme_Extend # Mc TAMIL VOWEL SIGN AA
|
||||
0BD7 ; Other_Grapheme_Extend # Mc TAMIL AU LENGTH MARK
|
||||
0CC2 ; Other_Grapheme_Extend # Mc KANNADA VOWEL SIGN UU
|
||||
0CD5..0CD6 ; Other_Grapheme_Extend # Mc [2] KANNADA LENGTH MARK..KANNADA AI LENGTH MARK
|
||||
0D3E ; Other_Grapheme_Extend # Mc MALAYALAM VOWEL SIGN AA
|
||||
0D57 ; Other_Grapheme_Extend # Mc MALAYALAM AU LENGTH MARK
|
||||
0DCF ; Other_Grapheme_Extend # Mc SINHALA VOWEL SIGN AELA-PILLA
|
||||
0DDF ; Other_Grapheme_Extend # Mc SINHALA VOWEL SIGN GAYANUKITTA
|
||||
200C..200D ; Other_Grapheme_Extend # Cf [2] ZERO WIDTH NON-JOINER..ZERO WIDTH JOINER
|
||||
1D165 ; Other_Grapheme_Extend # Mc MUSICAL SYMBOL COMBINING STEM
|
||||
1D16E..1D172 ; Other_Grapheme_Extend # Mc [5] MUSICAL SYMBOL COMBINING FLAG-1..MUSICAL SYMBOL COMBINING FLAG-5
|
||||
|
||||
# Total code points: 21
|
||||
|
|
@ -1,7 +1,8 @@
|
|||
USING: unicode.categories kernel math combinators splitting
|
||||
sequences math.parser io.files io assocs arrays namespaces
|
||||
math.ranges unicode.normalize values io.encodings.ascii
|
||||
unicode.syntax unicode.data compiler.units alien.syntax sets ;
|
||||
unicode.syntax unicode.data compiler.units alien.syntax sets
|
||||
combinators.lib ;
|
||||
IN: unicode.breaks
|
||||
|
||||
C-ENUM: Any L V T Extend Control CR LF graphemes ;
|
||||
|
|
@ -20,22 +21,10 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ;
|
|||
[ drop Control ]
|
||||
} case ;
|
||||
|
||||
: trim-blank ( str -- newstr )
|
||||
[ blank? ] right-trim ;
|
||||
|
||||
: process-other-extend ( lines -- set )
|
||||
[ "#" split1 drop ";" split1 drop trim-blank ] map harvest
|
||||
[ ".." split1 [ dup ] unless* [ hex> ] bi@ [a,b] ] map
|
||||
concat unique ;
|
||||
|
||||
: other-extend-lines ( -- lines )
|
||||
"resource:extra/unicode/PropList.txt" ascii file-lines ;
|
||||
|
||||
VALUE: other-extend
|
||||
|
||||
CATEGORY: (extend) Me Mn ;
|
||||
: extend? ( ch -- ? )
|
||||
dup (extend)? [ ] [ other-extend key? ] ?if ;
|
||||
[ (extend)? ]
|
||||
[ "Other_Grapheme_Extend" property? ] or? ;
|
||||
|
||||
: grapheme-class ( ch -- class )
|
||||
{
|
||||
|
|
@ -108,10 +97,7 @@ VALUE: grapheme-table
|
|||
unclip-last-slice grapheme-class swap
|
||||
[ grapheme-class dup rot grapheme-break? ] find-last-index ?1+ nip ;
|
||||
|
||||
[
|
||||
other-extend-lines process-other-extend \ other-extend set-value
|
||||
init-grapheme-table table
|
||||
[ make-grapheme-table finish-table ] with-variable
|
||||
\ grapheme-table set-value
|
||||
|
||||
init-grapheme-table table
|
||||
[ make-grapheme-table finish-table ] with-variable
|
||||
\ grapheme-table set-value
|
||||
] with-compilation-unit
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,23 @@
|
|||
USING: io io.files splitting unicode.collation sequences kernel
|
||||
io.encodings.utf8 math.parser math.order tools.test assocs ;
|
||||
IN: unicode.collation.tests
|
||||
|
||||
: parse-test ( -- strings )
|
||||
"resource:extra/unicode/collation/CollationTest_SHIFTED.txt"
|
||||
utf8 file-lines 5 tail
|
||||
[ ";" split1 drop " " split [ hex> ] "" map-as ] map ;
|
||||
|
||||
: test-two ( str1 str2 -- )
|
||||
[ +lt+ ] -rot [ string<=> ] 2curry unit-test ;
|
||||
|
||||
: find-failure
|
||||
parse-test dup 2 <clumps>
|
||||
[ string<=> +lt+ = not ] assoc-find drop ;
|
||||
|
||||
: (find-failure)
|
||||
dup 2 <clumps>
|
||||
[ string<=> +lt+ = not ] assoc-find drop ;
|
||||
|
||||
: failures
|
||||
parse-test dup 2 <clumps>
|
||||
[ string<=> +lt+ = not ] assoc-filter dup assoc-size ;
|
||||
|
|
@ -0,0 +1,133 @@
|
|||
USING: sequences io.files io.encodings.ascii kernel values
|
||||
splitting accessors math.parser ascii io assocs strings math
|
||||
namespaces sorting combinators math.order arrays
|
||||
unicode.normalize unicode.data combinators.lib locals ;
|
||||
IN: unicode.collation
|
||||
|
||||
VALUE: ducet
|
||||
|
||||
TUPLE: weight primary secondary tertiary ignorable? ;
|
||||
|
||||
: parse-weight ( string -- weight )
|
||||
"]" split but-last [
|
||||
weight new swap rest unclip CHAR: * = swapd >>ignorable?
|
||||
swap "." split first3 [ hex> ] tri@
|
||||
[ >>primary ] [ >>secondary ] [ >>tertiary ] tri*
|
||||
] map ;
|
||||
|
||||
: parse-line ( line -- code-poing weight )
|
||||
";" split1 [ [ blank? ] trim ] bi@
|
||||
[ " " split [ hex> ] "" map-as ] [ parse-weight ] bi* ;
|
||||
|
||||
: parse-ducet ( stream -- ducet )
|
||||
lines filter-comments
|
||||
[ parse-line ] H{ } map>assoc ;
|
||||
|
||||
"resource:extra/unicode/collation/allkeys.txt"
|
||||
ascii <file-reader> parse-ducet \ ducet set-value
|
||||
|
||||
: base ( char -- base )
|
||||
dup "Unified_Ideograph" property?
|
||||
[ -16 shift zero? HEX: FB40 HEX: FB80 ? ]
|
||||
[ drop HEX: FBC0 ] if ;
|
||||
|
||||
: AAAA ( char -- weight )
|
||||
[ base ] [ -15 shift ] bi + HEX: 20 2 f weight boa ;
|
||||
|
||||
: BBBB ( char -- weight )
|
||||
HEX: 7FFF bitand HEX: 8000 bitor 0 0 f weight boa ;
|
||||
|
||||
: derive-weight ( char -- weights )
|
||||
first dup "Noncharacter_Code_Point" property?
|
||||
[ drop { } ]
|
||||
[ [ AAAA ] [ BBBB ] bi 2array ] if ;
|
||||
|
||||
: last ( -- char )
|
||||
building get empty? [ 0 ] [ building get peek peek ] if ;
|
||||
|
||||
: blocked? ( char -- ? )
|
||||
combining-class [
|
||||
last combining-class =
|
||||
] [ last combining-class ] if* ;
|
||||
|
||||
: possible-bases ( -- slice-of-building )
|
||||
building get dup [ first combining-class not ] find-last
|
||||
drop [ 0 ] unless* tail-slice ;
|
||||
|
||||
:: ?combine ( char slice i -- ? )
|
||||
[let | str [ i slice nth char suffix ] |
|
||||
str ducet key? dup
|
||||
[ str i slice set-nth ] when
|
||||
] ;
|
||||
|
||||
: add ( char -- )
|
||||
dup blocked? [ 1string , ] [
|
||||
dup possible-bases dup length
|
||||
[ ?combine ] 2with contains?
|
||||
[ drop ] [ 1string , ] if
|
||||
] if ;
|
||||
|
||||
: string>graphemes ( string -- graphemes )
|
||||
[ [ add ] each ] { } make ;
|
||||
|
||||
: graphemes>weights ( graphemes -- weights )
|
||||
[ dup ducet at [ ] [ derive-weight ] ?if ]
|
||||
{ } map-as concat ;
|
||||
|
||||
: append-weights ( weights quot -- )
|
||||
swap [ ignorable?>> not ] filter
|
||||
swap map [ zero? not ] filter % 0 , ;
|
||||
|
||||
: variable-weight ( weight -- )
|
||||
dup ignorable?>> [ primary>> ] [ drop HEX: FFFF ] if , ;
|
||||
|
||||
: weights>bytes ( weights -- byte-array )
|
||||
[
|
||||
{
|
||||
[ [ primary>> ] append-weights ]
|
||||
[ [ secondary>> ] append-weights ]
|
||||
[ [ tertiary>> ] append-weights ]
|
||||
[ [ variable-weight ] each ]
|
||||
} cleave
|
||||
] { } make ;
|
||||
|
||||
: completely-ignorable? ( weight -- ? )
|
||||
[ primary>> ] [ secondary>> ] [ tertiary>> ] tri
|
||||
[ zero? ] tri@ and and ;
|
||||
|
||||
: filter-ignorable ( weights -- weights' )
|
||||
>r f r> [
|
||||
tuck primary>> zero? and
|
||||
[ swap ignorable?>> or ]
|
||||
[ swap completely-ignorable? or not ] 2bi
|
||||
] filter nip ;
|
||||
|
||||
: collation-key ( string -- key )
|
||||
nfd string>graphemes graphemes>weights
|
||||
filter-ignorable weights>bytes ;
|
||||
|
||||
: compare-collation ( {str1,key} {str2,key} -- <=> )
|
||||
2dup [ second ] bi@ <=> dup +eq+ =
|
||||
[ drop <=> ] [ 2nip ] if ;
|
||||
|
||||
: sort-strings ( strings -- sorted )
|
||||
[ dup collation-key ] { } map>assoc
|
||||
[ compare-collation ] sort
|
||||
keys ;
|
||||
|
||||
: string<=> ( str1 str2 -- <=> )
|
||||
[ dup collation-key 2array ] bi@ compare-collation ;
|
||||
|
||||
! Fix up table for long contractions
|
||||
: help-one ( assoc key -- )
|
||||
! Does this need to be more general?
|
||||
2 head 2dup swap key? [ 2drop ] [
|
||||
[ [ 1string swap at ] with { } map-as concat ]
|
||||
[ swap set-at ] 2bi
|
||||
] if ;
|
||||
|
||||
: insert-helpers ( assoc -- )
|
||||
dup keys [ length 3 >= ] filter
|
||||
[ help-one ] with each ;
|
||||
|
||||
ducet insert-helpers
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,264 @@
|
|||
# SpecialCasing-5.0.0.txt
|
||||
# Date: 2006-03-03, 08:23:36 GMT [MD]
|
||||
#
|
||||
# Unicode Character Database
|
||||
# Copyright (c) 1991-2006 Unicode, Inc.
|
||||
# For terms of use, see http://www.unicode.org/terms_of_use.html
|
||||
# For documentation, see UCD.html
|
||||
#
|
||||
# Special Casing Properties
|
||||
#
|
||||
# This file is a supplement to the UnicodeData file.
|
||||
# It contains additional information about the casing of Unicode characters.
|
||||
# (For compatibility, the UnicodeData.txt file only contains case mappings for
|
||||
# characters where they are 1-1, and does not have locale-specific mappings.)
|
||||
# For more information, see the discussion of Case Mappings in the Unicode Standard.
|
||||
#
|
||||
# All code points not listed in this file that do not have a simple case mappings
|
||||
# in UnicodeData.txt map to themselves.
|
||||
# ================================================================================
|
||||
# Format
|
||||
# ================================================================================
|
||||
# The entries in this file are in the following machine-readable format:
|
||||
#
|
||||
# <code>; <lower> ; <title> ; <upper> ; (<condition_list> ;)? # <comment>
|
||||
#
|
||||
# <code>, <lower>, <title>, and <upper> provide character values in hex. If there is more
|
||||
# than one character, they are separated by spaces. Other than as used to separate
|
||||
# elements, spaces are to be ignored.
|
||||
#
|
||||
# The <condition_list> is optional. Where present, it consists of one or more locale IDs
|
||||
# or contexts, separated by spaces. In these conditions:
|
||||
# - A condition list overrides the normal behavior if all of the listed conditions are true.
|
||||
# - The context is always the context of the characters in the original string,
|
||||
# NOT in the resulting string.
|
||||
# - Case distinctions in the condition list are not significant.
|
||||
# - Conditions preceded by "Not_" represent the negation of the condition.
|
||||
#
|
||||
# A locale ID is defined by taking any language tag as defined by
|
||||
# RFC 3066 (or its successor), and replacing '-' by '_'.
|
||||
#
|
||||
# A context for a character C is defined by Section 3.13 Default Case
|
||||
# Operations, of The Unicode Standard, Version 5.0.
|
||||
# (This is identical to the context defined by Unicode 4.1.0,
|
||||
# as specified in http://www.unicode.org/versions/Unicode4.1.0/)
|
||||
#
|
||||
# Parsers of this file must be prepared to deal with future additions to this format:
|
||||
# * Additional contexts
|
||||
# * Additional fields
|
||||
# ================================================================================
|
||||
|
||||
# ================================================================================
|
||||
# Unconditional mappings
|
||||
# ================================================================================
|
||||
|
||||
# The German es-zed is special--the normal mapping is to SS.
|
||||
# Note: the titlecase should never occur in practice. It is equal to titlecase(uppercase(<es-zed>))
|
||||
|
||||
00DF; 00DF; 0053 0073; 0053 0053; # LATIN SMALL LETTER SHARP S
|
||||
|
||||
# Preserve canonical equivalence for I with dot. Turkic is handled below.
|
||||
|
||||
0130; 0069 0307; 0130; 0130; # LATIN CAPITAL LETTER I WITH DOT ABOVE
|
||||
|
||||
# Ligatures
|
||||
|
||||
FB00; FB00; 0046 0066; 0046 0046; # LATIN SMALL LIGATURE FF
|
||||
FB01; FB01; 0046 0069; 0046 0049; # LATIN SMALL LIGATURE FI
|
||||
FB02; FB02; 0046 006C; 0046 004C; # LATIN SMALL LIGATURE FL
|
||||
FB03; FB03; 0046 0066 0069; 0046 0046 0049; # LATIN SMALL LIGATURE FFI
|
||||
FB04; FB04; 0046 0066 006C; 0046 0046 004C; # LATIN SMALL LIGATURE FFL
|
||||
FB05; FB05; 0053 0074; 0053 0054; # LATIN SMALL LIGATURE LONG S T
|
||||
FB06; FB06; 0053 0074; 0053 0054; # LATIN SMALL LIGATURE ST
|
||||
|
||||
0587; 0587; 0535 0582; 0535 0552; # ARMENIAN SMALL LIGATURE ECH YIWN
|
||||
FB13; FB13; 0544 0576; 0544 0546; # ARMENIAN SMALL LIGATURE MEN NOW
|
||||
FB14; FB14; 0544 0565; 0544 0535; # ARMENIAN SMALL LIGATURE MEN ECH
|
||||
FB15; FB15; 0544 056B; 0544 053B; # ARMENIAN SMALL LIGATURE MEN INI
|
||||
FB16; FB16; 054E 0576; 054E 0546; # ARMENIAN SMALL LIGATURE VEW NOW
|
||||
FB17; FB17; 0544 056D; 0544 053D; # ARMENIAN SMALL LIGATURE MEN XEH
|
||||
|
||||
# No corresponding uppercase precomposed character
|
||||
|
||||
0149; 0149; 02BC 004E; 02BC 004E; # LATIN SMALL LETTER N PRECEDED BY APOSTROPHE
|
||||
0390; 0390; 0399 0308 0301; 0399 0308 0301; # GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
|
||||
03B0; 03B0; 03A5 0308 0301; 03A5 0308 0301; # GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
|
||||
01F0; 01F0; 004A 030C; 004A 030C; # LATIN SMALL LETTER J WITH CARON
|
||||
1E96; 1E96; 0048 0331; 0048 0331; # LATIN SMALL LETTER H WITH LINE BELOW
|
||||
1E97; 1E97; 0054 0308; 0054 0308; # LATIN SMALL LETTER T WITH DIAERESIS
|
||||
1E98; 1E98; 0057 030A; 0057 030A; # LATIN SMALL LETTER W WITH RING ABOVE
|
||||
1E99; 1E99; 0059 030A; 0059 030A; # LATIN SMALL LETTER Y WITH RING ABOVE
|
||||
1E9A; 1E9A; 0041 02BE; 0041 02BE; # LATIN SMALL LETTER A WITH RIGHT HALF RING
|
||||
1F50; 1F50; 03A5 0313; 03A5 0313; # GREEK SMALL LETTER UPSILON WITH PSILI
|
||||
1F52; 1F52; 03A5 0313 0300; 03A5 0313 0300; # GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA
|
||||
1F54; 1F54; 03A5 0313 0301; 03A5 0313 0301; # GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA
|
||||
1F56; 1F56; 03A5 0313 0342; 03A5 0313 0342; # GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI
|
||||
1FB6; 1FB6; 0391 0342; 0391 0342; # GREEK SMALL LETTER ALPHA WITH PERISPOMENI
|
||||
1FC6; 1FC6; 0397 0342; 0397 0342; # GREEK SMALL LETTER ETA WITH PERISPOMENI
|
||||
1FD2; 1FD2; 0399 0308 0300; 0399 0308 0300; # GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA
|
||||
1FD3; 1FD3; 0399 0308 0301; 0399 0308 0301; # GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA
|
||||
1FD6; 1FD6; 0399 0342; 0399 0342; # GREEK SMALL LETTER IOTA WITH PERISPOMENI
|
||||
1FD7; 1FD7; 0399 0308 0342; 0399 0308 0342; # GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI
|
||||
1FE2; 1FE2; 03A5 0308 0300; 03A5 0308 0300; # GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA
|
||||
1FE3; 1FE3; 03A5 0308 0301; 03A5 0308 0301; # GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA
|
||||
1FE4; 1FE4; 03A1 0313; 03A1 0313; # GREEK SMALL LETTER RHO WITH PSILI
|
||||
1FE6; 1FE6; 03A5 0342; 03A5 0342; # GREEK SMALL LETTER UPSILON WITH PERISPOMENI
|
||||
1FE7; 1FE7; 03A5 0308 0342; 03A5 0308 0342; # GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI
|
||||
1FF6; 1FF6; 03A9 0342; 03A9 0342; # GREEK SMALL LETTER OMEGA WITH PERISPOMENI
|
||||
|
||||
# IMPORTANT-when capitalizing iota-subscript (0345)
|
||||
# It MUST be in normalized form--moved to the end of any sequence of combining marks.
|
||||
# This is because logically it represents a following base character!
|
||||
# E.g. <iota_subscript> (<Mn> | <Mc> | <Me>)+ => (<Mn> | <Mc> | <Me>)+ <iota_subscript>
|
||||
# It should never be the first character in a word, so in titlecasing it can be left as is.
|
||||
|
||||
# The following cases are already in the UnicodeData file, so are only commented here.
|
||||
|
||||
# 0345; 0345; 0345; 0399; # COMBINING GREEK YPOGEGRAMMENI
|
||||
|
||||
# All letters with YPOGEGRAMMENI (iota-subscript) or PROSGEGRAMMENI (iota adscript)
|
||||
# have special uppercases.
|
||||
# Note: characters with PROSGEGRAMMENI are actually titlecase, not uppercase!
|
||||
|
||||
1F80; 1F80; 1F88; 1F08 0399; # GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI
|
||||
1F81; 1F81; 1F89; 1F09 0399; # GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI
|
||||
1F82; 1F82; 1F8A; 1F0A 0399; # GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI
|
||||
1F83; 1F83; 1F8B; 1F0B 0399; # GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI
|
||||
1F84; 1F84; 1F8C; 1F0C 0399; # GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI
|
||||
1F85; 1F85; 1F8D; 1F0D 0399; # GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI
|
||||
1F86; 1F86; 1F8E; 1F0E 0399; # GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
|
||||
1F87; 1F87; 1F8F; 1F0F 0399; # GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
|
||||
1F88; 1F80; 1F88; 1F08 0399; # GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI
|
||||
1F89; 1F81; 1F89; 1F09 0399; # GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI
|
||||
1F8A; 1F82; 1F8A; 1F0A 0399; # GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI
|
||||
1F8B; 1F83; 1F8B; 1F0B 0399; # GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI
|
||||
1F8C; 1F84; 1F8C; 1F0C 0399; # GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI
|
||||
1F8D; 1F85; 1F8D; 1F0D 0399; # GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI
|
||||
1F8E; 1F86; 1F8E; 1F0E 0399; # GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
|
||||
1F8F; 1F87; 1F8F; 1F0F 0399; # GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
|
||||
1F90; 1F90; 1F98; 1F28 0399; # GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI
|
||||
1F91; 1F91; 1F99; 1F29 0399; # GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI
|
||||
1F92; 1F92; 1F9A; 1F2A 0399; # GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI
|
||||
1F93; 1F93; 1F9B; 1F2B 0399; # GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI
|
||||
1F94; 1F94; 1F9C; 1F2C 0399; # GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI
|
||||
1F95; 1F95; 1F9D; 1F2D 0399; # GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI
|
||||
1F96; 1F96; 1F9E; 1F2E 0399; # GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
|
||||
1F97; 1F97; 1F9F; 1F2F 0399; # GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
|
||||
1F98; 1F90; 1F98; 1F28 0399; # GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI
|
||||
1F99; 1F91; 1F99; 1F29 0399; # GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI
|
||||
1F9A; 1F92; 1F9A; 1F2A 0399; # GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI
|
||||
1F9B; 1F93; 1F9B; 1F2B 0399; # GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI
|
||||
1F9C; 1F94; 1F9C; 1F2C 0399; # GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI
|
||||
1F9D; 1F95; 1F9D; 1F2D 0399; # GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI
|
||||
1F9E; 1F96; 1F9E; 1F2E 0399; # GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
|
||||
1F9F; 1F97; 1F9F; 1F2F 0399; # GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
|
||||
1FA0; 1FA0; 1FA8; 1F68 0399; # GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI
|
||||
1FA1; 1FA1; 1FA9; 1F69 0399; # GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI
|
||||
1FA2; 1FA2; 1FAA; 1F6A 0399; # GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI
|
||||
1FA3; 1FA3; 1FAB; 1F6B 0399; # GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI
|
||||
1FA4; 1FA4; 1FAC; 1F6C 0399; # GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI
|
||||
1FA5; 1FA5; 1FAD; 1F6D 0399; # GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI
|
||||
1FA6; 1FA6; 1FAE; 1F6E 0399; # GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI
|
||||
1FA7; 1FA7; 1FAF; 1F6F 0399; # GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI
|
||||
1FA8; 1FA0; 1FA8; 1F68 0399; # GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI
|
||||
1FA9; 1FA1; 1FA9; 1F69 0399; # GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI
|
||||
1FAA; 1FA2; 1FAA; 1F6A 0399; # GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI
|
||||
1FAB; 1FA3; 1FAB; 1F6B 0399; # GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI
|
||||
1FAC; 1FA4; 1FAC; 1F6C 0399; # GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI
|
||||
1FAD; 1FA5; 1FAD; 1F6D 0399; # GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI
|
||||
1FAE; 1FA6; 1FAE; 1F6E 0399; # GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI
|
||||
1FAF; 1FA7; 1FAF; 1F6F 0399; # GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI
|
||||
1FB3; 1FB3; 1FBC; 0391 0399; # GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI
|
||||
1FBC; 1FB3; 1FBC; 0391 0399; # GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI
|
||||
1FC3; 1FC3; 1FCC; 0397 0399; # GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI
|
||||
1FCC; 1FC3; 1FCC; 0397 0399; # GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI
|
||||
1FF3; 1FF3; 1FFC; 03A9 0399; # GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI
|
||||
1FFC; 1FF3; 1FFC; 03A9 0399; # GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
|
||||
|
||||
# Some characters with YPOGEGRAMMENI also have no corresponding titlecases
|
||||
|
||||
1FB2; 1FB2; 1FBA 0345; 1FBA 0399; # GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI
|
||||
1FB4; 1FB4; 0386 0345; 0386 0399; # GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI
|
||||
1FC2; 1FC2; 1FCA 0345; 1FCA 0399; # GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI
|
||||
1FC4; 1FC4; 0389 0345; 0389 0399; # GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI
|
||||
1FF2; 1FF2; 1FFA 0345; 1FFA 0399; # GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI
|
||||
1FF4; 1FF4; 038F 0345; 038F 0399; # GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI
|
||||
|
||||
1FB7; 1FB7; 0391 0342 0345; 0391 0342 0399; # GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI
|
||||
1FC7; 1FC7; 0397 0342 0345; 0397 0342 0399; # GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI
|
||||
1FF7; 1FF7; 03A9 0342 0345; 03A9 0342 0399; # GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI
|
||||
|
||||
# ================================================================================
|
||||
# Conditional mappings
|
||||
# ================================================================================
|
||||
|
||||
# Special case for final form of sigma
|
||||
|
||||
03A3; 03C2; 03A3; 03A3; Final_Sigma; # GREEK CAPITAL LETTER SIGMA
|
||||
|
||||
# Note: the following cases for non-final are already in the UnicodeData file.
|
||||
|
||||
# 03A3; 03C3; 03A3; 03A3; # GREEK CAPITAL LETTER SIGMA
|
||||
# 03C3; 03C3; 03A3; 03A3; # GREEK SMALL LETTER SIGMA
|
||||
# 03C2; 03C2; 03A3; 03A3; # GREEK SMALL LETTER FINAL SIGMA
|
||||
|
||||
# Note: the following cases are not included, since they would case-fold in lowercasing
|
||||
|
||||
# 03C3; 03C2; 03A3; 03A3; Final_Sigma; # GREEK SMALL LETTER SIGMA
|
||||
# 03C2; 03C3; 03A3; 03A3; Not_Final_Sigma; # GREEK SMALL LETTER FINAL SIGMA
|
||||
|
||||
# ================================================================================
|
||||
# Locale-sensitive mappings
|
||||
# ================================================================================
|
||||
|
||||
# Lithuanian
|
||||
|
||||
# Lithuanian retains the dot in a lowercase i when followed by accents.
|
||||
|
||||
# Remove DOT ABOVE after "i" with upper or titlecase
|
||||
|
||||
0307; 0307; ; ; lt After_Soft_Dotted; # COMBINING DOT ABOVE
|
||||
|
||||
# Introduce an explicit dot above when lowercasing capital I's and J's
|
||||
# whenever there are more accents above.
|
||||
# (of the accents used in Lithuanian: grave, acute, tilde above, and ogonek)
|
||||
|
||||
0049; 0069 0307; 0049; 0049; lt More_Above; # LATIN CAPITAL LETTER I
|
||||
004A; 006A 0307; 004A; 004A; lt More_Above; # LATIN CAPITAL LETTER J
|
||||
012E; 012F 0307; 012E; 012E; lt More_Above; # LATIN CAPITAL LETTER I WITH OGONEK
|
||||
00CC; 0069 0307 0300; 00CC; 00CC; lt; # LATIN CAPITAL LETTER I WITH GRAVE
|
||||
00CD; 0069 0307 0301; 00CD; 00CD; lt; # LATIN CAPITAL LETTER I WITH ACUTE
|
||||
0128; 0069 0307 0303; 0128; 0128; lt; # LATIN CAPITAL LETTER I WITH TILDE
|
||||
|
||||
# ================================================================================
|
||||
|
||||
# Turkish and Azeri
|
||||
|
||||
# I and i-dotless; I-dot and i are case pairs in Turkish and Azeri
|
||||
# The following rules handle those cases.
|
||||
|
||||
0130; 0069; 0130; 0130; tr; # LATIN CAPITAL LETTER I WITH DOT ABOVE
|
||||
0130; 0069; 0130; 0130; az; # LATIN CAPITAL LETTER I WITH DOT ABOVE
|
||||
|
||||
# When lowercasing, remove dot_above in the sequence I + dot_above, which will turn into i.
|
||||
# This matches the behavior of the canonically equivalent I-dot_above
|
||||
|
||||
0307; ; 0307; 0307; tr After_I; # COMBINING DOT ABOVE
|
||||
0307; ; 0307; 0307; az After_I; # COMBINING DOT ABOVE
|
||||
|
||||
# When lowercasing, unless an I is before a dot_above, it turns into a dotless i.
|
||||
|
||||
0049; 0131; 0049; 0049; tr Not_Before_Dot; # LATIN CAPITAL LETTER I
|
||||
0049; 0131; 0049; 0049; az Not_Before_Dot; # LATIN CAPITAL LETTER I
|
||||
|
||||
# When uppercasing, i turns into a dotted capital I
|
||||
|
||||
0069; 0069; 0130; 0130; tr; # LATIN SMALL LETTER I
|
||||
0069; 0069; 0130; 0130; az; # LATIN SMALL LETTER I
|
||||
|
||||
# Note: the following case is already in the UnicodeData file.
|
||||
|
||||
# 0131; 0131; 0049; 0049; tr; # LATIN SMALL LETTER DOTLESS I
|
||||
|
||||
# EOF
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -1,7 +1,8 @@
|
|||
USING: assocs math kernel sequences io.files hashtables
|
||||
quotations splitting arrays math.parser hash2 math.order
|
||||
byte-arrays words namespaces words compiler.units parser
|
||||
io.encodings.ascii values ;
|
||||
io.encodings.ascii values interval-maps ascii sets assocs.lib
|
||||
combinators.lib ;
|
||||
IN: unicode.data
|
||||
|
||||
! Convenience functions
|
||||
|
|
@ -10,15 +11,21 @@ IN: unicode.data
|
|||
|
||||
! Loading data from UnicodeData.txt
|
||||
|
||||
: split-; ( line -- array )
|
||||
";" split [ [ blank? ] trim ] map ;
|
||||
|
||||
: data ( filename -- data )
|
||||
ascii file-lines [ ";" split ] map ;
|
||||
ascii file-lines [ split-; ] map ;
|
||||
|
||||
: load-data ( -- data )
|
||||
"resource:extra/unicode/UnicodeData.txt" data ;
|
||||
"resource:extra/unicode/data/UnicodeData.txt" data ;
|
||||
|
||||
: filter-comments ( lines -- lines )
|
||||
[ "#@" split first ] map harvest ;
|
||||
|
||||
: (process-data) ( index data -- newdata )
|
||||
filter-comments
|
||||
[ [ nth ] keep first swap 2array ] with map
|
||||
[ second empty? not ] filter
|
||||
[ >r hex> r> ] assoc-map ;
|
||||
|
||||
: process-data ( index data -- hash )
|
||||
|
|
@ -34,7 +41,7 @@ IN: unicode.data
|
|||
dup [ swap (chain-decomposed) ] curry assoc-map ;
|
||||
|
||||
: first* ( seq -- ? )
|
||||
second dup empty? [ ] [ first ] ?if ;
|
||||
second [ empty? ] [ first ] or? ;
|
||||
|
||||
: (process-decomposed) ( data -- alist )
|
||||
5 swap (process-data)
|
||||
|
|
@ -46,12 +53,12 @@ IN: unicode.data
|
|||
[ second length 2 = ] filter
|
||||
! using 1009 as the size, the maximum load is 4
|
||||
[ first2 first2 rot 3array ] map 1009 alist>hash2
|
||||
] keep
|
||||
>hashtable chain-decomposed ;
|
||||
] [ >hashtable chain-decomposed ] bi ;
|
||||
|
||||
: process-compat ( data -- hash )
|
||||
: process-compatibility ( data -- hash )
|
||||
(process-decomposed)
|
||||
[ dup first* [ first2 rest 2array ] unless ] map
|
||||
[ second empty? not ] filter
|
||||
>hashtable chain-decomposed ;
|
||||
|
||||
: process-combining ( data -- hash )
|
||||
|
|
@ -99,30 +106,51 @@ C: <code-point> code-point
|
|||
4 head [ multihex ] map first4
|
||||
<code-point> swap first set ;
|
||||
|
||||
! Extra properties
|
||||
: properties-lines ( -- lines )
|
||||
"resource:extra/unicode/data/PropList.txt"
|
||||
ascii file-lines ;
|
||||
|
||||
: parse-properties ( -- {{[a,b],prop}} )
|
||||
properties-lines filter-comments [
|
||||
split-; first2
|
||||
[ ".." split1 [ dup ] unless* [ hex> ] bi@ 2array ] dip
|
||||
] { } map>assoc ;
|
||||
|
||||
: properties>intervals ( properties -- assoc[str,interval] )
|
||||
dup values prune [ f ] H{ } map>assoc
|
||||
[ [ insert-at ] curry assoc-each ] keep
|
||||
[ <interval-set> ] assoc-map ;
|
||||
|
||||
: load-properties ( -- assoc )
|
||||
parse-properties properties>intervals ;
|
||||
|
||||
! Special casing data
|
||||
: load-special-casing ( -- special-casing )
|
||||
"resource:extra/unicode/data/SpecialCasing.txt" data
|
||||
[ length 5 = ] filter
|
||||
[ [ set-code-point ] each ] H{ } make-assoc ;
|
||||
|
||||
VALUE: simple-lower
|
||||
VALUE: simple-upper
|
||||
VALUE: simple-title
|
||||
VALUE: canonical-map
|
||||
VALUE: combine-map
|
||||
VALUE: class-map
|
||||
VALUE: compat-map
|
||||
VALUE: compatibility-map
|
||||
VALUE: category-map
|
||||
VALUE: name-map
|
||||
VALUE: special-casing
|
||||
VALUE: properties
|
||||
|
||||
: canonical-entry ( char -- seq ) canonical-map at ;
|
||||
: combine-chars ( a b -- char/f ) combine-map hash2 ;
|
||||
: compat-entry ( char -- seq ) compat-map at ;
|
||||
: compatibility-entry ( char -- seq ) compatibility-map at ;
|
||||
: combining-class ( char -- n ) class-map at ;
|
||||
: non-starter? ( char -- ? ) class-map key? ;
|
||||
: name>char ( string -- char ) name-map at ;
|
||||
: char>name ( char -- string ) name-map value-at ;
|
||||
|
||||
! Special casing data
|
||||
: load-special-casing ( -- special-casing )
|
||||
"resource:extra/unicode/SpecialCasing.txt" data
|
||||
[ length 5 = ] filter
|
||||
[ [ set-code-point ] each ] H{ } make-assoc ;
|
||||
: property? ( char property -- ? ) properties at interval-key? ;
|
||||
|
||||
load-data
|
||||
dup process-names \ name-map set-value
|
||||
|
|
@ -132,6 +160,9 @@ dup process-names \ name-map set-value
|
|||
dup process-combining \ class-map set-value
|
||||
dup process-canonical \ canonical-map set-value
|
||||
\ combine-map set-value
|
||||
dup process-compat \ compat-map set-value
|
||||
dup process-compatibility \ compatibility-map set-value
|
||||
process-category \ category-map set-value
|
||||
|
||||
load-special-casing \ special-casing set-value
|
||||
|
||||
load-properties \ properties set-value
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: unicode.normalize kernel tools.test sequences ;
|
|||
|
||||
[ "ab\u000323\u000302cd" ] [ "ab\u000302" "\u000323cd" string-append ] unit-test
|
||||
|
||||
[ "ab\u00064b\u00034d\u00034e\u000347\u000346" ] [ "ab\u000346\u000347\u00064b\u00034e\u00034d" dup reorder ] unit-test
|
||||
[ "ab\u00064b\u000347\u00034e\u00034d\u000346" ] [ "ab\u000346\u000347\u00064b\u00034e\u00034d" dup reorder ] unit-test
|
||||
[ "hello" "hello" ] [ "hello" [ nfd ] keep nfkd ] unit-test
|
||||
[ "\u00FB012\u002075\u00017F\u000323\u000307" "fi25s\u000323\u000307" ]
|
||||
[ "\u00FB012\u002075\u001E9B\u000323" [ nfd ] keep nfkd ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
USING: sequences namespaces unicode.data kernel math arrays ;
|
||||
USING: sequences namespaces unicode.data kernel math arrays
|
||||
locals combinators.lib sequences.lib combinators.lib ;
|
||||
IN: unicode.normalize
|
||||
|
||||
! Conjoining Jamo behavior
|
||||
|
|
@ -35,21 +36,6 @@ IN: unicode.normalize
|
|||
|
||||
! Normalization -- Decomposition
|
||||
|
||||
: (insert) ( seq n quot -- )
|
||||
over 0 = [ 3drop ] [
|
||||
[ >r dup 1- rot [ nth ] curry bi@ r> bi@ > ] 3keep
|
||||
roll [ 3drop ]
|
||||
[ >r [ dup 1- rot exchange ] 2keep 1- r> (insert) ] if
|
||||
] if ; inline
|
||||
|
||||
: insert ( seq quot elt n -- )
|
||||
swap rot >r -rot [ swap set-nth ] 2keep r> (insert) ; inline
|
||||
|
||||
: insertion-sort ( seq quot -- )
|
||||
! quot is a transformation on elements
|
||||
over dup length
|
||||
[ >r >r 2dup r> r> insert ] 2each 2drop ; inline
|
||||
|
||||
: reorder-slice ( string start -- slice done? )
|
||||
2dup swap [ non-starter? not ] find-from drop
|
||||
[ [ over length ] unless* rot <slice> ] keep not ;
|
||||
|
|
@ -69,15 +55,17 @@ IN: unicode.normalize
|
|||
: reorder-back ( string i -- )
|
||||
over [ non-starter? not ] find-last-from drop ?1+ reorder-next 2drop ;
|
||||
|
||||
: decompose ( string quot -- decomposed )
|
||||
:: decompose ( string quot -- decomposed )
|
||||
! When there are 8 and 32-bit strings, this'll be
|
||||
! equivalent to clone on 8 and the contents of the last
|
||||
! main quotation on 32.
|
||||
over [ 127 < ] all? [ drop ] [
|
||||
swap [ [
|
||||
dup hangul? [ hangul>jamo % drop ]
|
||||
[ dup rot call [ % ] [ , ] ?if ] if
|
||||
] with each ] "" make
|
||||
string [ 127 < ] all? [ string ] [
|
||||
[
|
||||
string [
|
||||
dup hangul? [ hangul>jamo % ]
|
||||
[ dup quot call [ % ] [ , ] ?if ] if
|
||||
] each
|
||||
] "" make
|
||||
dup reorder
|
||||
] if ; inline
|
||||
|
||||
|
|
@ -85,7 +73,7 @@ IN: unicode.normalize
|
|||
[ canonical-entry ] decompose ;
|
||||
|
||||
: nfkd ( string -- string )
|
||||
[ compat-entry ] decompose ;
|
||||
[ compatibility-entry ] decompose ;
|
||||
|
||||
: string-append ( s1 s2 -- string )
|
||||
! This could be more optimized,
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: values kernel sequences assocs io.files
|
||||
io.encodings ascii math.ranges io splitting math.parser
|
||||
namespaces byte-arrays locals math sets io.encodings.ascii
|
||||
words compiler.units arrays interval-maps ;
|
||||
words compiler.units arrays interval-maps unicode.data ;
|
||||
IN: unicode.script
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -10,9 +10,7 @@ SYMBOL: interned
|
|||
|
||||
: parse-script ( stream -- assoc )
|
||||
! assoc is code point/range => name
|
||||
lines [ "#" split1 drop ] map harvest [
|
||||
";" split1 [ [ blank? ] trim ] bi@
|
||||
] H{ } map>assoc ;
|
||||
lines filter-comments [ split-; ] map >hashtable ;
|
||||
|
||||
: range, ( value key -- )
|
||||
swap interned get
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: http.client xml xml.utilities kernel sequences
|
||||
namespaces http math.parser help math.order ;
|
||||
namespaces http math.parser help math.order locals ;
|
||||
IN: yahoo
|
||||
|
||||
TUPLE: result title url summary ;
|
||||
|
|
@ -16,14 +16,21 @@ C: <result> result
|
|||
] map ;
|
||||
|
||||
: yahoo-url ( -- str )
|
||||
"http://search.yahooapis.com/WebSearchService/V1/webSearch?appid=Factor-search&query=" ;
|
||||
"http://search.yahooapis.com/WebSearchService/V1/webSearch" ;
|
||||
|
||||
: query ( search num -- url )
|
||||
:: query ( search num appid -- url )
|
||||
[
|
||||
yahoo-url %
|
||||
swap url-encode %
|
||||
"&results=" % #
|
||||
"?appid=" % appid %
|
||||
"&query=" % search url-encode %
|
||||
"&results=" % num #
|
||||
] "" make ;
|
||||
|
||||
: search-yahoo ( search num -- seq )
|
||||
: factor-id
|
||||
"fRrVAKzV34GDyeRw6bUHDhEWHRedwfOC7e61wwXZLgGF80E67spxdQXuugBe2pgIevMmKwA-" ;
|
||||
|
||||
: search-yahoo/id ( search num id -- seq )
|
||||
query http-get string>xml parse-yahoo ;
|
||||
|
||||
: search-yahoo ( search num -- seq )
|
||||
factor-id search-yahoo/id ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue