vm/compaction.o \
vm/contexts.o \
vm/data_heap.o \
+ vm/data_heap_checker.o \
vm/debug.o \
vm/dispatch.o \
vm/errors.o \
-IN: alarms\r
USING: help.markup help.syntax calendar quotations ;\r
+IN: alarms\r
\r
HELP: alarm\r
{ $class-description "An alarm. Can be passed to " { $link cancel-alarm } "." } ;\r
\r
HELP: add-alarm\r
{ $values { "quot" quotation } { "time" timestamp } { "frequency" { $maybe duration } } { "alarm" alarm } }\r
-{ $description "Creates and registers an alarm. If " { $snippet "frequency" } " is " { $link f } ", this will be a one-time alarm, otherwise it will fire with the given frequency. The quotation will be called from the alarm thread." } ;\r
+{ $description "Creates and registers an alarm to start at " { $snippet "time" } ". If " { $snippet "frequency" } " is " { $link f } ", this will be a one-time alarm, otherwise it will fire with the given frequency. The quotation will be called from the alarm thread." } ;\r
\r
HELP: later\r
{ $values { "quot" quotation } { "duration" duration } { "alarm" alarm } }\r
-{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } " from now." } ;\r
+{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } " from now." }\r
+{ $examples\r
+ { $unchecked-example\r
+ "USING: alarms io calendar ;"\r
+ """[ "GET BACK TO WORK, Guy." print flush ] 10 minutes later drop"""\r
+ ""\r
+ }\r
+} ;\r
\r
HELP: cancel-alarm\r
{ $values { "alarm" alarm } }\r
{ $values\r
{ "quot" quotation } { "duration" duration }\r
{ "alarm" alarm } }\r
-{ $description "Creates and registers an alarm which calls the quotation repeatedly, using " { $snippet "dt" } " as the frequency." } ;\r
+{ $description "Creates and registers an alarm which calls the quotation repeatedly, using " { $snippet "dt" } " as the frequency." }\r
+{ $examples\r
+ { $unchecked-example\r
+ "USING: alarms io calendar ;"\r
+ """[ "Hi Buddy." print flush ] 10 seconds every drop"""\r
+ ""\r
+ }\r
+} ;\r
\r
ARTICLE: "alarms" "Alarms"\r
-"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks without spawning a new thread."\r
+"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks without spawning a new thread." $nl\r
+"The alarm class:"\r
{ $subsections\r
alarm\r
- add-alarm\r
- later\r
- cancel-alarm\r
}\r
+"Register a recurring alarm:"\r
+{ $subsections every }\r
+"Register a one-time alarm:"\r
+{ $subsections later }\r
+"Low-level interface to add alarms:"\r
+{ $subsections add-alarm }\r
+"Cancelling an alarm:"\r
+{ $subsections cancel-alarm }\r
"Alarms do not persist across image saves. Saving and restoring an image has the effect of calling " { $link cancel-alarm } " on all " { $link alarm } " instances." ;\r
\r
ABOUT: "alarms"\r
M: array c-type-align first c-type-align ;
+M: array c-type-align-first first c-type-align-first ;
+
M: array c-type-stack-align? drop f ;
M: array unbox-parameter drop void* unbox-parameter ;
M: string-type c-type-align
drop void* c-type-align ;
+M: string-type c-type-align-first
+ drop void* c-type-align-first ;
+
M: string-type c-type-stack-align?
drop void* c-type-stack-align? ;
{ char* utf8 } char* typedef
char* uchar* typedef
-char char* "pointer-c-type" set-word-prop
+char char* "pointer-c-type" set-word-prop
uchar uchar* "pointer-c-type" set-word-prop
{ unboxer-quot callable }
{ getter callable }
{ setter callable }
-size
-align ;
+{ size integer }
+{ align integer }
+{ align-first integer } ;
TUPLE: c-type < abstract-c-type
boxer
GENERIC: c-struct? ( c-type -- ? )
-M: object c-struct?
- drop f ;
-M: c-type-name c-struct?
- dup void? [ drop f ] [ c-type c-struct? ] if ;
+M: object c-struct? drop f ;
+
+M: c-type-name c-struct? dup void? [ drop f ] [ c-type c-struct? ] if ;
! These words being foldable means that words need to be
! recompiled if a C type is redefined. Even so, folding the
M: c-type-name c-type-align c-type c-type-align ;
+GENERIC: c-type-align-first ( name -- n )
+
+M: c-type-name c-type-align-first c-type c-type-align-first ;
+
+M: abstract-c-type c-type-align-first align-first>> ;
+
GENERIC: c-type-stack-align? ( name -- ? )
M: c-type c-type-stack-align? stack-align?>> ;
ptrdiff_t intptr_t uintptr_t size_t
char* uchar* ;
+: 8-byte-alignment ( c-type -- c-type )
+ {
+ { [ cpu ppc? os macosx? and ] [ 4 >>align 8 >>align-first ] }
+ { [ cpu x86.32? os windows? not and ] [ 4 >>align 4 >>align-first ] }
+ [ 8 >>align 8 >>align-first ]
+ } cond ;
+
[
<c-type>
c-ptr >>class
[ [ >c-ptr ] 2dip set-alien-cell ] >>setter
bootstrap-cell >>size
bootstrap-cell >>align
+ bootstrap-cell >>align-first
[ >c-ptr ] >>unboxer-quot
"box_alien" >>boxer
"alien_offset" >>unboxer
[ alien-signed-8 ] >>getter
[ set-alien-signed-8 ] >>setter
8 >>size
- cpu x86.32? os windows? not and 4 8 ? >>align
+ 8-byte-alignment
"box_signed_8" >>boxer
"to_signed_8" >>unboxer
\ longlong define-primitive-type
[ alien-unsigned-8 ] >>getter
[ set-alien-unsigned-8 ] >>setter
8 >>size
- cpu x86.32? os windows? not and 4 8 ? >>align
+ 8-byte-alignment
"box_unsigned_8" >>boxer
"to_unsigned_8" >>unboxer
\ ulonglong define-primitive-type
[ set-alien-signed-cell ] >>setter
bootstrap-cell >>size
bootstrap-cell >>align
+ bootstrap-cell >>align-first
"box_signed_cell" >>boxer
"to_fixnum" >>unboxer
\ long define-primitive-type
[ set-alien-unsigned-cell ] >>setter
bootstrap-cell >>size
bootstrap-cell >>align
+ bootstrap-cell >>align-first
"box_unsigned_cell" >>boxer
"to_cell" >>unboxer
\ ulong define-primitive-type
[ set-alien-signed-4 ] >>setter
4 >>size
4 >>align
+ 4 >>align-first
"box_signed_4" >>boxer
"to_fixnum" >>unboxer
\ int define-primitive-type
[ set-alien-unsigned-4 ] >>setter
4 >>size
4 >>align
+ 4 >>align-first
"box_unsigned_4" >>boxer
"to_cell" >>unboxer
\ uint define-primitive-type
[ set-alien-signed-2 ] >>setter
2 >>size
2 >>align
+ 2 >>align-first
"box_signed_2" >>boxer
"to_fixnum" >>unboxer
\ short define-primitive-type
[ set-alien-unsigned-2 ] >>setter
2 >>size
2 >>align
+ 2 >>align-first
"box_unsigned_2" >>boxer
"to_cell" >>unboxer
\ ushort define-primitive-type
[ set-alien-signed-1 ] >>setter
1 >>size
1 >>align
+ 1 >>align-first
"box_signed_1" >>boxer
"to_fixnum" >>unboxer
\ char define-primitive-type
[ set-alien-unsigned-1 ] >>setter
1 >>size
1 >>align
+ 1 >>align-first
"box_unsigned_1" >>boxer
"to_cell" >>unboxer
\ uchar define-primitive-type
[ [ >c-bool ] 2dip set-alien-unsigned-4 ] >>setter
4 >>size
4 >>align
+ 4 >>align-first
"box_boolean" >>boxer
"to_boolean" >>unboxer
] [
[ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
1 >>size
1 >>align
+ 1 >>align-first
"box_boolean" >>boxer
"to_boolean" >>unboxer
- \ bool define-primitive-type
] if
+ \ bool define-primitive-type
<c-type>
math:float >>class
[ [ >float ] 2dip set-alien-float ] >>setter
4 >>size
4 >>align
+ 4 >>align-first
"box_float" >>boxer
"to_float" >>unboxer
float-rep >>rep
[ alien-double ] >>getter
[ [ >float ] 2dip set-alien-double ] >>setter
8 >>size
- cpu x86.32? os windows? not and 4 8 ? >>align
+ 8-byte-alignment
"box_double" >>boxer
"to_double" >>unboxer
double-rep >>rep
M: eq-wrapper equal?
over eq-wrapper? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ;
+M: eq-wrapper hashcode*
+ nip obj>> identity-hashcode ;
+
SYMBOL: objects
: cache-eql-object ( obj quot -- value )
: emit-fixnum ( n -- ) tag-fixnum emit ;
+: emit-header ( n -- ) tag-header emit ;
+
: emit-object ( class quot -- addr )
[ type-number ] dip over here-as
- [ swap tag-fixnum emit call align-here ] dip ;
+ [ swap emit-header call align-here ] dip ;
inline
! Write an object to the image.
! Image header
-: emit-header ( -- )
+: emit-image-header ( -- )
image-magic emit
image-version emit
data-base emit ! relocation base at end of header
: build-image ( -- image )
800000 <vector> image set
20000 <hashtable> objects set
- emit-header t, 0, 1, -1,
+ emit-image-header t, 0, 1, -1,
"Building generic words..." print flush
remake-generics
"Serializing words..." print flush
{ $warning "Do not use this array for looking up a month name directly. Use month-name instead." } ;
HELP: month-name
-{ $values { "n" integer } { "string" string } }
+{ $values { "obj" { $or integer timestamp } } { "string" string } }
{ $description "Looks up the month name and returns it as a string. January has an index of 1 instead of zero." } ;
HELP: month-abbreviations
HELP: day-names
-{ $values { "array" array } }
+{ $values { "value" array } }
{ $description "Returns an array with the English names of the days of the week." } ;
HELP: day-name
-{ $values { "n" integer } { "string" string } }
+{ $values { "obj" { $or integer timestamp } } { "string" string } }
{ $description "Looks up the day name and returns it as a string." } ;
HELP: day-abbreviations2
[ f ] [ now dup midnight eq? ] unit-test
[ f ] [ now dup easter eq? ] unit-test
[ f ] [ now dup beginning-of-year eq? ] unit-test
+
+[ t ] [ 1325376000 unix-time>timestamp 2012 <year-gmt> = ] unit-test
+[ t ] [ 1356998399 unix-time>timestamp 2013 <year-gmt> 1 seconds time- = ] unit-test
+
+[ t ] [ 1500000000 random [ unix-time>timestamp timestamp>unix-time ] keep = ] unit-test
C: <duration> duration
+: instant ( -- duration ) 0 0 0 0 0 0 <duration> ;
+
TUPLE: timestamp
{ year integer }
{ month integer }
: <date> ( year month day -- timestamp )
0 0 0 gmt-offset-duration <timestamp> ;
+: <date-gmt> ( year month day -- timestamp )
+ 0 0 0 instant <timestamp> ;
+
+: <year> ( year -- timestamp )
+ 1 1 <date> ;
+
+: <year-gmt> ( year -- timestamp )
+ 1 1 <date-gmt> ;
+
ERROR: not-a-month ;
M: not-a-month summary
drop "Months are indexed starting at 1" ;
"July" "August" "September" "October" "November" "December"
}
-: month-name ( n -- string )
- check-month 1 - month-names nth ;
+<PRIVATE
+
+: (month-name) ( n -- string ) 1 - month-names nth ;
+
+PRIVATE>
+
+GENERIC: month-name ( obj -- string )
+
+M: integer month-name check-month 1 - month-names nth ;
+M: timestamp month-name month>> 1 - month-names nth ;
CONSTANT: month-abbreviations
{
CONSTANT: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 }
-: day-names ( -- array )
- {
- "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"
- } ;
-
-: day-name ( n -- string ) day-names nth ;
+CONSTANT: day-names
+ { "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" }
CONSTANT: day-abbreviations2
{ "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" }
: >time< ( timestamp -- hour minute second )
[ hour>> ] [ minute>> ] [ second>> ] tri ;
-: instant ( -- duration ) 0 0 0 0 0 0 <duration> ;
: years ( x -- duration ) instant clone swap >>year ;
: months ( x -- duration ) instant clone swap >>month ;
: days ( x -- duration ) instant clone swap >>day ;
: microseconds ( x -- duration ) 1000000 / seconds ;
: nanoseconds ( x -- duration ) 1000000000 / seconds ;
+GENERIC: year ( obj -- n )
+M: integer year ;
+M: timestamp year year>> ;
+
+GENERIC: month ( obj -- n )
+M: integer month ;
+M: timestamp month month>> ;
+
+GENERIC: day ( obj -- n )
+M: integer day ;
+M: timestamp day day>> ;
+
GENERIC: leap-year? ( obj -- ? )
M: integer leap-year? ( year -- ? )
M: timestamp <=> ( ts1 ts2 -- n )
[ >gmt tuple-slots ] compare ;
+: same-day? ( ts1 ts2 -- ? )
+ [ >gmt >date< <date> ] bi@ = ;
+
: (time-) ( timestamp timestamp -- n )
[ >gmt ] bi@
[ [ >date< julian-day-number ] bi@ - 86400 * ] 2keep
: day-of-week ( timestamp -- n )
>date< zeller-congruence ;
+GENERIC: day-name ( obj -- string )
+M: integer day-name day-names nth ;
+M: timestamp day-name day-of-week day-names nth ;
+
:: (day-of-year) ( year month day -- n )
day-counts month head-slice sum day +
year leap-year? [
: day-of-year ( timestamp -- n )
>date< (day-of-year) ;
+: midnight ( timestamp -- new-timestamp )
+ clone 0 >>hour 0 >>minute 0 >>second ; inline
+
+: noon ( timestamp -- new-timestamp )
+ midnight 12 >>hour ; inline
+
+: beginning-of-month ( timestamp -- new-timestamp )
+ midnight 1 >>day ;
+
+: end-of-month ( timestamp -- new-timestamp )
+ [ midnight ] [ days-in-month ] bi >>day ;
+
<PRIVATE
-: day-offset ( timestamp m -- timestamp n )
+
+: day-offset ( timestamp m -- new-timestamp n )
over day-of-week - ; inline
-: day-this-week ( timestamp n -- timestamp )
+: day-this-week ( timestamp n -- new-timestamp )
day-offset days time+ ;
+
+:: nth-day-this-month ( timestamp n day -- new-timestamp )
+ timestamp beginning-of-month day day-this-week
+ dup timestamp [ month>> ] bi@ = [ 1 weeks time+ ] unless
+ n 1 - [ weeks time+ ] unless-zero ;
+
+: last-day-this-month ( timestamp day -- new-timestamp )
+ [ 1 months time+ 1 ] dip nth-day-this-month 1 weeks time- ;
+
PRIVATE>
+GENERIC: january ( obj -- timestamp )
+GENERIC: february ( obj -- timestamp )
+GENERIC: march ( obj -- timestamp )
+GENERIC: april ( obj -- timestamp )
+GENERIC: may ( obj -- timestamp )
+GENERIC: june ( obj -- timestamp )
+GENERIC: july ( obj -- timestamp )
+GENERIC: august ( obj -- timestamp )
+GENERIC: september ( obj -- timestamp )
+GENERIC: october ( obj -- timestamp )
+GENERIC: november ( obj -- timestamp )
+GENERIC: december ( obj -- timestamp )
+
+M: integer january 1 1 <date> ;
+M: integer february 2 1 <date> ;
+M: integer march 3 1 <date> ;
+M: integer april 4 1 <date> ;
+M: integer may 5 1 <date> ;
+M: integer june 6 1 <date> ;
+M: integer july 7 1 <date> ;
+M: integer august 8 1 <date> ;
+M: integer september 9 1 <date> ;
+M: integer october 10 1 <date> ;
+M: integer november 11 1 <date> ;
+M: integer december 12 1 <date> ;
+
+M: timestamp january clone 1 >>month ;
+M: timestamp february clone 2 >>month ;
+M: timestamp march clone 3 >>month ;
+M: timestamp april clone 4 >>month ;
+M: timestamp may clone 5 >>month ;
+M: timestamp june clone 6 >>month ;
+M: timestamp july clone 7 >>month ;
+M: timestamp august clone 8 >>month ;
+M: timestamp september clone 9 >>month ;
+M: timestamp october clone 10 >>month ;
+M: timestamp november clone 11 >>month ;
+M: timestamp december clone 12 >>month ;
+
: sunday ( timestamp -- new-timestamp ) 0 day-this-week ;
: monday ( timestamp -- new-timestamp ) 1 day-this-week ;
: tuesday ( timestamp -- new-timestamp ) 2 day-this-week ;
: friday ( timestamp -- new-timestamp ) 5 day-this-week ;
: saturday ( timestamp -- new-timestamp ) 6 day-this-week ;
-: midnight ( timestamp -- new-timestamp )
- clone 0 >>hour 0 >>minute 0 >>second ; inline
-
-: noon ( timestamp -- new-timestamp )
- midnight 12 >>hour ; inline
-
-: beginning-of-month ( timestamp -- new-timestamp )
- midnight 1 >>day ;
+: sunday? ( timestamp -- ? ) day-of-week 0 = ;
+: monday? ( timestamp -- ? ) day-of-week 1 = ;
+: tuesday? ( timestamp -- ? ) day-of-week 2 = ;
+: wednesday? ( timestamp -- ? ) day-of-week 3 = ;
+: thursday? ( timestamp -- ? ) day-of-week 4 = ;
+: friday? ( timestamp -- ? ) day-of-week 5 = ;
+: saturday? ( timestamp -- ? ) day-of-week 6 = ;
+
+: sunday-of-month ( timestamp n -- new-timestamp ) 0 nth-day-this-month ;
+: monday-of-month ( timestamp n -- new-timestamp ) 1 nth-day-this-month ;
+: tuesday-of-month ( timestamp n -- new-timestamp ) 2 nth-day-this-month ;
+: wednesday-of-month ( timestamp n -- new-timestamp ) 3 nth-day-this-month ;
+: thursday-of-month ( timestamp n -- new-timestamp ) 4 nth-day-this-month ;
+: friday-of-month ( timestamp n -- new-timestamp ) 5 nth-day-this-month ;
+: saturday-of-month ( timestamp n -- new-timestamp ) 6 nth-day-this-month ;
+
+: last-sunday-of-month ( timestamp -- new-timestamp ) 0 last-day-this-month ;
+: last-monday-of-month ( timestamp -- new-timestamp ) 1 last-day-this-month ;
+: last-tuesday-of-month ( timestamp -- new-timestamp ) 2 last-day-this-month ;
+: last-wednesday-of-month ( timestamp -- new-timestamp ) 3 last-day-this-month ;
+: last-thursday-of-month ( timestamp -- new-timestamp ) 4 last-day-this-month ;
+: last-friday-of-month ( timestamp -- new-timestamp ) 5 last-day-this-month ;
+: last-saturday-of-month ( timestamp -- new-timestamp ) 6 last-day-this-month ;
: beginning-of-week ( timestamp -- new-timestamp )
midnight sunday ;
-: beginning-of-year ( timestamp -- new-timestamp )
- beginning-of-month 1 >>month ;
+GENERIC: beginning-of-year ( object -- new-timestamp )
+M: timestamp beginning-of-year beginning-of-month 1 >>month ;
+M: integer beginning-of-year <year> ;
+
+GENERIC: end-of-year ( object -- new-timestamp )
+M: timestamp end-of-year 12 >>month 31 >>day ;
+M: integer end-of-year 12 31 <date> ;
: time-since-midnight ( timestamp -- duration )
dup midnight time- ;
: since-1970 ( duration -- timestamp )
unix-1970 time+ >local-time ;
+: timestamp>unix-time ( timestamp -- seconds )
+ unix-1970 time- second>> ;
+
+: unix-time>timestamp ( seconds -- timestamp )
+ seconds unix-1970 time+ ;
+
M: timestamp sleep-until timestamp>micros sleep-until ;
M: duration sleep hence sleep-until ;
M: circular virtual@ circular-wrap seq>> ;
-M: circular virtual-seq seq>> ;
+M: circular virtual-exemplar seq>> ;
: change-circular-start ( n circular -- )
#! change start to (start + n) mod length
[ -2 ] [ bit-field-test <struct> 2 >>b b>> ] unit-test
[ 1 ] [ bit-field-test <struct> 257 >>c c>> ] unit-test
[ 3 ] [ bit-field-test heap-size ] unit-test
+
+cpu ppc? [
+ STRUCT: ppc-align-test-1
+ { x longlong }
+ { y int } ;
+
+ [ 16 ] [ ppc-align-test-1 heap-size ] unit-test
+
+ STRUCT: ppc-align-test-2
+ { y int }
+ { x longlong } ;
+
+ [ 12 ] [ ppc-align-test-2 heap-size ] unit-test
+ [ 4 ] [ "x" ppc-align-test-2 offset-of ] unit-test
+] when
slots >>fields
size >>size
align >>align
+ align >>align-first
class (unboxer-quot) >>unboxer-quot
- class (boxer-quot) >>boxer-quot ;
-
-GENERIC: align-offset ( offset class -- offset' )
+ class (boxer-quot) >>boxer-quot ;
+
+GENERIC: compute-slot-offset ( offset class -- offset' )
-M: struct-slot-spec align-offset
- [ type>> c-type-align 8 * align ] keep
+: c-type-align-at ( class offset -- n )
+ 0 = [ c-type-align-first ] [ c-type-align ] if ;
+
+M: struct-slot-spec compute-slot-offset
+ [ type>> over c-type-align-at 8 * align ] keep
[ [ 8 /i ] dip (>>offset) ] [ type>> heap-size 8 * + ] 2bi ;
-M: struct-bit-slot-spec align-offset
+M: struct-bit-slot-spec compute-slot-offset
[ (>>offset) ] [ bits>> + ] 2bi ;
-: struct-offsets ( slots -- size )
- 0 [ align-offset ] reduce 8 align 8 /i ;
+: compute-struct-offsets ( slots -- size )
+ 0 [ compute-slot-offset ] reduce 8 align 8 /i ;
-: union-struct-offsets ( slots -- size )
+: compute-union-offsets ( slots -- size )
1 [ 0 >>offset type>> heap-size max ] reduce ;
-: struct-align ( slots -- align )
+: struct-alignment ( slots -- align )
[ struct-bit-slot-spec? not ] filter
- 1 [ type>> c-type-align max ] reduce ;
+ 1 [ [ type>> ] [ offset>> ] bi c-type-align-at max ] reduce ;
+
PRIVATE>
M: struct byte-length class "struct-size" word-prop ; foldable
M: object binary-zero? drop f ;
M: f binary-zero? drop t ;
-M: number binary-zero? zero? ;
-M: struct binary-zero?
- [ byte-length iota ] [ >c-ptr ] bi
- [ <displaced-alien> *uchar zero? ] curry all? ;
+M: number binary-zero? 0 = ;
+M: struct binary-zero? >c-ptr [ 0 = ] all? ;
: struct-needs-prototype? ( class -- ? )
struct-slots [ initial>> binary-zero? ] all? not ;
slots empty? [ struct-must-have-slots ] when
class redefine-struct-tuple-class
slots make-slots dup check-struct-slots :> slot-specs
- slot-specs struct-align :> alignment
+ slot-specs struct-alignment :> alignment
slot-specs offsets-quot call alignment align :> size
class slot-specs size alignment c-type-for-class :> c-type
PRIVATE>
: define-struct-class ( class slots -- )
- [ struct-offsets ] (define-struct-class) ;
+ [ compute-struct-offsets ] (define-struct-class) ;
: define-union-struct-class ( class slots -- )
- [ union-struct-offsets ] (define-struct-class) ;
+ [ compute-union-offsets ] (define-struct-class) ;
M: struct-class reset-class
[ call-next-method ] [ name>> c-types get delete-at ] bi ;
C: <column> column
-M: column virtual-seq seq>> ;
+M: column virtual-exemplar seq>> ;
M: column virtual@ [ col>> swap ] [ seq>> ] bi nth bounds-check ;
M: column length seq>> length ;
[ { { 1 2 } { 3 4 } } ] [ nested-smart-combo-test ] unit-test
[ 14 ] [ [ 1 2 3 ] [ sq ] [ + ] map-reduce-outputs ] unit-test
+
+{ 2 3 } [ [ + ] preserving ] must-infer-as
+
+{ 2 0 } [ [ + ] nullary ] must-infer-as
+
+{ 2 2 } [ [ [ + ] nullary ] preserving ] must-infer-as
MACRO: preserving ( quot -- )
[ infer in>> length ] keep '[ _ ndup @ ] ;
+MACRO: nullary ( quot -- quot' )
+ dup infer out>> length '[ @ _ ndrop ] ;
+
MACRO: smart-if ( pred true false -- )
'[ _ preserving _ _ if ] ; inline
IN: compiler.cfg
TUPLE: basic-block < identity-tuple
-{ id integer }
+id
number
{ instructions vector }
{ successors vector }
{ predecessors vector } ;
-M: basic-block hashcode* nip id>> ;
-
: <basic-block> ( -- bb )
basic-block new
+ \ basic-block counter >>id
V{ } clone >>instructions
V{ } clone >>successors
- V{ } clone >>predecessors
- \ basic-block counter >>id ;
+ V{ } clone >>predecessors ;
+
+M: basic-block hashcode* nip id>> ;
TUPLE: cfg { entry basic-block } word label
spill-area-size reps
{
{ kernel.private:tag [ drop emit-tag ] }
{ kernel.private:getenv [ emit-getenv ] }
+ { kernel.private:(identity-hashcode) [ drop emit-identity-hashcode ] }
{ math.private:both-fixnums? [ drop emit-both-fixnums? ] }
{ math.private:fixnum+ [ drop emit-fixnum+ ] }
{ math.private:fixnum- [ drop emit-fixnum- ] }
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces layouts sequences kernel
-accessors compiler.tree.propagation.info
-compiler.cfg.stacks compiler.cfg.hats
-compiler.cfg.instructions compiler.cfg.utilities ;
+USING: namespaces layouts sequences kernel math accessors
+compiler.tree.propagation.info compiler.cfg.stacks
+compiler.cfg.hats compiler.cfg.instructions
+compiler.cfg.utilities ;
IN: compiler.cfg.intrinsics.misc
: emit-tag ( -- )
swap node-input-infos first literal>>
[ ds-drop 0 ^^slot-imm ] [ ds-pop ^^offset>slot ^^slot ] if*
ds-push ;
+
+: emit-identity-hashcode ( -- )
+ ds-pop tag-mask get bitnot ^^load-immediate ^^and 0 0 ^^slot-imm
+ hashcode-shift ^^shr-imm
+ ^^tag-fixnum
+ ds-push ;
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: layouts namespaces kernel accessors sequences math
-classes.algebra locals combinators cpu.architecture
-compiler.tree.propagation.info compiler.cfg.stacks
-compiler.cfg.hats compiler.cfg.registers
+classes.algebra classes.builtin locals combinators
+cpu.architecture compiler.tree.propagation.info
+compiler.cfg.stacks compiler.cfg.hats compiler.cfg.registers
compiler.cfg.instructions compiler.cfg.utilities
compiler.cfg.builder.blocks compiler.constants ;
IN: compiler.cfg.intrinsics.slots
-: value-tag ( info -- n ) class>> class-type ; inline
+: class-tag ( class -- tag/f )
+ builtins get [ class<= ] with find drop ;
+
+: value-tag ( info -- n ) class>> class-tag ;
: ^^tag-offset>slot ( slot tag -- vreg' )
[ ^^offset>slot ] dip ^^sub-imm ;
M: reference-expr equal?
over reference-expr? [ [ value>> ] bi@ eq? ] [ 2drop f ] if ;
+M: reference-expr hashcode*
+ nip value>> identity-hashcode ;
+
: constant>vn ( constant -- vn ) <constant> expr>vn ; inline
GENERIC: >expr ( insn -- expr )
generic.single combinators deques search-deques macros
source-files.errors combinators.short-circuit
-stack-checker stack-checker.state stack-checker.inlining stack-checker.errors
+stack-checker stack-checker.dependencies stack-checker.inlining
+stack-checker.errors
compiler.errors compiler.units compiler.utilities
M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ;
M: word no-compile?
- {
- [ macro? ]
- [ inline? ]
- [ "special" word-prop ]
- [ "no-compile" word-prop ]
- } 1|| ;
+ { [ macro? ] [ "special" word-prop ] [ "no-compile" word-prop ] } 1|| ;
+
+GENERIC: combinator? ( word -- ? )
+
+M: method-body combinator? "method-generic" word-prop combinator? ;
+
+M: predicate-engine-word combinator? "owner-generic" word-prop combinator? ;
+
+M: word combinator? inline? ;
: ignore-error? ( word error -- ? )
#! Ignore some errors on inline combinators, macros, and special
#! words such as 'call'.
- [ no-compile? ] [ { [ do-not-compile? ] [ literal-expected? ] } 1|| ] bi* and ;
+ {
+ [ drop no-compile? ]
+ [ [ combinator? ] [ unknown-macro-input? ] bi* and ]
+ } 2|| ;
: finish ( word -- )
#! Recompile callers if the word's stack effect changed, then
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs classes.algebra compiler.units definitions graphs
-grouping kernel namespaces sequences words stack-checker.state ;
+grouping kernel namespaces sequences words
+stack-checker.dependencies ;
IN: compiler.crossref
SYMBOL: compiled-crossref
swap [
{ tuple } declare 1 slot
] [
- 0 slot
+ 1 slot
] if ;
-[ t ] [ f B{ } mutable-value-bug-1 byte-array type-number = ] unit-test
+[ 0 ] [ f { } mutable-value-bug-1 ] unit-test
: mutable-value-bug-2 ( a b -- c )
swap [
- 0 slot
+ 1 slot
] [
{ tuple } declare 1 slot
] if ;
-[ t ] [ t B{ } mutable-value-bug-2 byte-array type-number = ] unit-test
+[ 0 ] [ t { } mutable-value-bug-2 ] unit-test
[
<recursive-state> recursive-state set
V{ } clone stack-visitor set
- [ [ >vector \ meta-d set ] [ length d-in set ] bi ]
+ [ [ >vector \ meta-d set ] [ length input-count set ] bi ]
[ (build-tree) ]
bi*
] with-infer nip ;
USING: kernel accessors sequences combinators fry
classes.algebra namespaces assocs words math math.private
math.partial-dispatch math.intervals classes classes.tuple
-classes.tuple.private layouts definitions stack-checker.state
+classes.tuple.private layouts definitions stack-checker.dependencies
stack-checker.branches
compiler.utilities
compiler.tree
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors words assocs sequences arrays namespaces
fry locals definitions classes classes.algebra generic
-stack-checker.state
+stack-checker.dependencies
stack-checker.backend
compiler.tree
compiler.tree.propagation.info
constraints get last update-constraints ;
: branch-phi-constraints ( output values booleans -- )
- {
+ {
{
{ { t } { f } }
[
swap t-->
]
}
+ {
+ { { t f } { t } }
+ [
+ first =f
+ condition-value get =t /\
+ swap f-->
+ ]
+ }
+ {
+ { { t } { t f } }
+ [
+ second =f
+ condition-value get =f /\
+ swap f-->
+ ]
+ }
{
{ { t f } { } }
[
! Copyright (C) 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: compiler.tree.propagation.call-effect tools.test fry math effects kernel
-compiler.tree.builder compiler.tree.optimizer compiler.tree.debugger sequences ;
+compiler.tree.builder compiler.tree.optimizer compiler.tree.debugger sequences
+eval combinators ;
IN: compiler.tree.propagation.call-effect.tests
[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
! [ boa ] by itself doesn't infer
TUPLE: a-tuple x ;
-[ V{ a-tuple } ] [ [ a-tuple '[ _ boa ] call( x -- tuple ) ] final-classes ] unit-test
\ No newline at end of file
+[ V{ a-tuple } ] [ [ a-tuple '[ _ boa ] call( x -- tuple ) ] final-classes ] unit-test
+
+! See if redefinitions are handled correctly
+: call(-redefine-test ( a -- b ) 1 + ;
+
+: test-quotatation ( -- quot ) [ call(-redefine-test ] ;
+
+[ t ] [ test-quotatation cached-effect (( a -- b )) effect<= ] unit-test
+
+[ ] [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a b -- c ) + ;" eval( -- ) ] unit-test
+
+[ t ] [ test-quotatation cached-effect (( a b -- c )) effect<= ] unit-test
+
+: inline-cache-invalidation-test ( a b c -- c ) call( a b -- c ) ;
+
+[ 4 ] [ 1 3 test-quotatation inline-cache-invalidation-test ] unit-test
+
+[ ] [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a -- c ) 1 + ;" eval( -- ) ] unit-test
+
+[ 1 3 test-quotatation inline-cache-invalidation-test ] [ T{ wrong-values f (( a b -- c )) } = ] must-fail-with
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.private effects fry
kernel kernel.private make sequences continuations quotations
-words math stack-checker stack-checker.transforms
-compiler.tree.propagation.info
-compiler.tree.propagation.inlining ;
+words math stack-checker combinators.short-circuit
+stack-checker.transforms compiler.tree.propagation.info
+compiler.tree.propagation.inlining compiler.units ;
IN: compiler.tree.propagation.call-effect
! call( and execute( have complex expansions.
! and compare it with declaration. If matches, call it unsafely.
! - Fallback. If the above doesn't work, call it and compare the datastack before
! and after to make sure it didn't mess anything up.
+! - Inline caches and cached effects are invalidated whenever a macro is redefined, or
+! a word's effect changes, by comparing a global counter against the counter value
+! last observed. The counter is incremented by compiler.units.
! execute( uses a similar strategy.
-TUPLE: inline-cache value ;
+TUPLE: inline-cache value counter ;
-: cache-hit? ( word/quot ic -- ? )
- [ value>> eq? ] [ value>> ] bi and ; inline
+: inline-cache-hit? ( word/quot ic -- ? )
+ { [ value>> eq? ] [ nip counter>> effect-counter eq? ] } 2&& ; inline
+
+: update-inline-cache ( word/quot ic -- )
+ [ effect-counter ] dip
+ [ (>>value) ] [ (>>counter) ] bi-curry bi* ; inline
SINGLETON: +unknown+
: safe-infer ( quot -- effect )
[ infer ] [ 2drop +unknown+ ] recover ;
+: cached-effect-valid? ( quot -- ? )
+ cache-counter>> effect-counter eq? ; inline
+
+: save-effect ( effect quot -- )
+ [ effect-counter ] dip
+ [ (>>cached-effect) ] [ (>>cache-counter) ] bi-curry bi* ;
+
M: quotation cached-effect
- dup cached-effect>>
- [ ] [ [ safe-infer dup ] keep (>>cached-effect) ] ?if ;
+ dup cached-effect-valid?
+ [ cached-effect>> ] [ [ safe-infer dup ] keep save-effect ] if ;
: call-effect-unsafe? ( quot effect -- ? )
[ cached-effect ] dip
: call-effect-fast ( quot effect inline-cache -- )
2over call-effect-unsafe?
- [ [ nip (>>value) ] [ drop call-effect-unsafe ] 3bi ]
+ [ [ nip update-inline-cache ] [ drop call-effect-unsafe ] 3bi ]
[ drop call-effect-slow ]
if ; inline
: call-effect-ic ( quot effect inline-cache -- )
- 3dup nip cache-hit?
+ 3dup nip inline-cache-hit?
[ drop call-effect-unsafe ]
[ call-effect-fast ]
if ; inline
: execute-effect-fast ( word effect inline-cache -- )
2over execute-effect-unsafe?
- [ [ nip (>>value) ] [ drop execute-effect-unsafe ] 3bi ]
+ [ [ nip update-inline-cache ] [ drop execute-effect-unsafe ] 3bi ]
[ drop execute-effect-slow ]
if ; inline
: execute-effect-ic ( word effect inline-cache -- )
- 3dup nip cache-hit?
+ 3dup nip inline-cache-hit?
[ drop execute-effect-unsafe ]
[ execute-effect-fast ]
if ; inline
bi ;
M: true-constraint satisfied?
- value>> value-info class>>
- { [ true-class? ] [ null-class? not ] } 1&& ;
+ value>> value-info*
+ [ class>> true-class? ] [ drop f ] if ;
TUPLE: false-constraint value ;
bi ;
M: false-constraint satisfied?
- value>> value-info class>>
- { [ false-class? ] [ null-class? not ] } 1&& ;
+ value>> value-info*
+ [ class>> false-class? ] [ drop f ] if ;
! Class constraints
TUPLE: class-constraint value class ;
! Assoc stack of current value --> info mapping
SYMBOL: value-infos
+: value-info* ( value -- info ? )
+ resolve-copy value-infos get assoc-stack [ null-info or ] [ >boolean ] bi ; inline
+
: value-info ( value -- info )
- resolve-copy value-infos get assoc-stack null-info or ;
+ value-info* drop ;
: set-value-info ( info value -- )
resolve-copy value-infos get last set-at ;
classes.tuple alien.accessors classes.tuple.private
slots.private definitions strings.private vectors hashtables
generic quotations alien
-stack-checker.state
+stack-checker.dependencies
compiler.tree.comparisons
compiler.tree.propagation.info
compiler.tree.propagation.nodes
[ t ] [ [ over [ drop f ] when [ "A" throw ] unless ] final-classes first false-class? ] unit-test
+[ V{ fixnum } ] [
+ [
+ [ { fixnum } declare ] [ drop f ] if
+ dup [ dup 13 eq? [ t ] [ f ] if ] [ t ] if
+ [ "Oops" throw ] when
+ ] final-classes
+] unit-test
+
[ V{ fixnum } ] [
[
>fixnum
] final-classes
] unit-test
+[ ] [
+ [
+ dup dup dup [ 100 < ] [ drop f ] if dup
+ [ 2drop f ] [ 2drop f ] if
+ [ ] [ dup [ ] [ ] if ] if
+ ] final-info drop
+] unit-test
+
[ V{ fixnum } ] [
[ { fixnum } declare (clone) ] final-classes
] unit-test
! Could be bignum not integer but who cares
[ V{ integer } ] [ [ 10 >bignum bitand ] final-classes ] unit-test
+
words namespaces classes.algebra combinators
combinators.short-circuit classes classes.tuple
classes.tuple.private continuations arrays alien.c-types math
-math.private slots generic definitions stack-checker.state
+math.private slots generic definitions stack-checker.dependencies
compiler.tree
compiler.tree.propagation.info
compiler.tree.propagation.nodes
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences words fry generic accessors
classes.tuple classes classes.algebra definitions
-stack-checker.state quotations classes.tuple.private math
+stack-checker.dependencies quotations classes.tuple.private math
math.partial-dispatch math.private math.intervals sets.private
math.floats.private math.integers.private layouts math.order
vectors hashtables combinators effects generalizations assocs
-sets combinators.short-circuit sequences.private locals
+sets combinators.short-circuit sequences.private locals growable
stack-checker namespaces compiler.tree.propagation.info ;
IN: compiler.tree.propagation.transforms
tester '[ _ filter ] ;
\ intersect [ intersect-quot ] 1 define-partial-eval
+
+! Speeds up sum-file, sort and reverse-complement benchmarks by
+! compiling decoder-readln better
+\ push [
+ in-d>> second value-info class>> growable class<=
+ [ \ push def>> ] [ f ] if
+] "custom-inlining" set-word-prop
TUPLE: node < identity-tuple ;
-M: node hashcode* drop node hashcode* ;
-
TUPLE: #introduce < node out-d ;
: #introduce ( out-d -- node )
M: simple-cord length
[ first>> length ] [ second>> length ] bi + ; inline
-M: simple-cord virtual-seq first>> ; inline
+M: simple-cord virtual-exemplar first>> ; inline
M: simple-cord virtual@
2dup first>> length <
seqs>> [ first <=> ] with search nip
[ first - ] [ second ] bi ; inline
-M: multi-cord virtual-seq
+M: multi-cord virtual-exemplar
seqs>> [ f ] [ first second ] if-empty ; inline
: <cord> ( seqs -- cord )
! cache = ...\r
0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel\r
! key = hashcode(class)\r
- 5 4 3 SRAWI\r
- 6 4 8 SRAWI\r
- 5 5 6 ADD\r
- 6 4 13 SRAWI\r
- 5 5 6 ADD\r
- 5 5 3 SLWI\r
+ 5 4 1 SRAWI\r
! key &= cache.length - 1\r
5 5 mega-cache-size get 1 - bootstrap-cell * ANDI\r
! cache += array-start-offset\r
\r
[\r
3 ds-reg 0 LWZ\r
- 3 3 1 SRAWI\r
+ 3 3 2 SRAWI\r
rs-reg 3 3 LWZX\r
3 ds-reg 0 STW\r
] \ get-local define-sub-primitive\r
[\r
3 ds-reg 0 LWZ\r
ds-reg ds-reg 4 SUBI\r
- 3 3 1 SRAWI\r
+ 3 3 2 SRAWI\r
rs-reg 3 rs-reg SUBF\r
] \ drop-locals define-sub-primitive\r
\r
alien.c-types cpu.architecture cpu.ppc ;
IN: cpu.ppc.macosx
-<<
-4 "longlong" c-type (>>align)
-4 "ulonglong" c-type (>>align)
-4 "double" c-type (>>align)
->>
-
M: macosx reserved-area-size 6 cells ;
M: macosx lr-save 2 cells ;
M: ppc %unbox-alien ( dst src -- )
alien-offset LWZ ;
-M:: ppc %unbox-any-c-ptr ( dst src temp -- )
+M:: ppc %unbox-any-c-ptr ( dst src -- )
[
- { "is-byte-array" "end" "start" } [ define-label ] each
- ! Address is computed in dst
+ "end" define-label
0 dst LI
- ! Load object into scratch-reg
- scratch-reg src MR
- ! We come back here with displaced aliens
- "start" resolve-label
! Is the object f?
- 0 scratch-reg \ f type-number CMPI
- ! If so, done
+ 0 src \ f type-number CMPI
"end" get BEQ
+ ! Compute tag in dst register
+ dst src tag-mask get ANDI
! Is the object an alien?
- 0 scratch-reg header-offset LWZ
- 0 0 alien type-number tag-fixnum CMPI
- "is-byte-array" get BNE
- ! If so, load the offset
- 0 scratch-reg alien-offset LWZ
- ! Add it to address being computed
- dst dst 0 ADD
- ! Now recurse on the underlying alien
- scratch-reg scratch-reg underlying-alien-offset LWZ
- "start" get B
- "is-byte-array" resolve-label
- ! Add byte array address to address being computed
- dst dst scratch-reg ADD
- ! Add an offset to start of byte array's data area
- dst dst byte-array-offset ADDI
+ 0 dst alien type-number CMPI
+ ! Add an offset to start of byte array's data
+ dst src byte-array-offset ADDI
+ "end" get BNE
+ ! If so, load the offset and add it to the address
+ dst src alien-offset LWZ
"end" resolve-label
] with-scope ;
M:: ppc %box-alien ( dst src temp -- )
[
"f" define-label
- dst %load-immediate
+ dst \ f type-number %load-immediate
0 src 0 CMPI
"f" get BEQ
dst 5 cells alien temp %allot
temp \ f type-number %load-immediate
temp dst 1 alien@ STW
temp dst 2 alien@ STW
- displacement dst 3 alien@ STW
- displacement dst 4 alien@ STW
+ src dst 3 alien@ STW
+ src dst 4 alien@ STW
"f" resolve-label
] with-scope ;
-M:: ppc %box-displaced-alien ( dst displacement base displacement' base' base-class -- )
+M:: ppc %box-displaced-alien ( dst displacement base temp base-class -- )
+ ! This is ridiculous
[
"end" define-label
- "alloc" define-label
- "simple-case" define-label
+ "not-f" define-label
+ "not-alien" define-label
+
! If displacement is zero, return the base
dst base MR
0 displacement 0 CMPI
"end" get BEQ
- ! Quickly use displacement' before its needed for real, as allot temporary
- displacement' :> temp
- dst 4 cells alien temp %allot
- ! If base is already a displaced alien, unpack it
- 0 base \ f type-number CMPI
- "simple-case" get BEQ
- temp base header-offset LWZ
- 0 temp alien type-number tag-fixnum CMPI
- "simple-case" get BNE
- ! displacement += base.displacement
- temp base 3 alien@ LWZ
- displacement' displacement temp ADD
- ! base = base.base
- base' base 1 alien@ LWZ
- "alloc" get B
- "simple-case" resolve-label
- displacement' displacement MR
- base' base MR
- "alloc" resolve-label
- ! Store underlying-alien slot
- base' dst 1 alien@ STW
- ! Store offset
- displacement' dst 3 alien@ STW
- ! Store expired slot (its ok to clobber displacement')
+
+ ! Displacement is non-zero, we're going to be allocating a new
+ ! object
+ dst 5 cells alien temp %allot
+
+ ! Set expired to f
temp \ f type-number %load-immediate
temp dst 2 alien@ STW
+
+ ! Is base f?
+ 0 base \ f type-number CMPI
+ "not-f" get BNE
+
+ ! Yes, it is f. Fill in new object
+ base dst 1 alien@ STW
+ displacement dst 3 alien@ STW
+ displacement dst 4 alien@ STW
+
+ "end" get B
+
+ "not-f" resolve-label
+
+ ! Check base type
+ temp base tag-mask get ANDI
+
+ ! Is base an alien?
+ 0 temp alien type-number CMPI
+ "not-alien" get BNE
+
+ ! Yes, it is an alien. Set new alien's base to base.base
+ temp base 1 alien@ LWZ
+ temp dst 1 alien@ STW
+
+ ! Compute displacement
+ temp base 3 alien@ LWZ
+ temp temp displacement ADD
+ temp dst 3 alien@ STW
+
+ ! Compute address
+ temp base 4 alien@ LWZ
+ temp temp displacement ADD
+ temp dst 4 alien@ STW
+
+ ! We are done
+ "end" get B
+
+ ! Is base a byte array? It has to be, by now...
+ "not-alien" resolve-label
+
+ base dst 1 alien@ STW
+ displacement dst 3 alien@ STW
+ temp base byte-array-offset ADDI
+ temp temp displacement ADD
+ temp dst 4 alien@ STW
+
"end" resolve-label
] with-scope ;
scratch-reg nursery-ptr 0 STW ;
:: store-header ( dst class -- )
- class type-number tag-fixnum scratch-reg LI
+ class type-number tag-header scratch-reg LI
scratch-reg dst 0 STW ;
: store-tagged ( dst tag -- )
[ [] ] dip data-alignment get align ADD ;
: store-header ( temp class -- )
- [ [] ] [ type-number tag-fixnum ] bi* MOV ;
+ [ [] ] [ type-number tag-header ] bi* MOV ;
: store-tagged ( dst tag -- )
type-number OR ;
M: string error. print ;
+: traceback-link. ( continuation -- )
+ "[" write [ "Traceback" ] dip write-object "]" print ;
+
: :s ( -- )
error-continuation get data>> stack. ;
M: wrong-values summary drop "Quotation called with wrong stack effect" ;
+M: stack-effect-omits-dashes summary drop "Stack effect must contain “--”" ;
+
{
{ [ os windows? ] [ "debugger.windows" require ] }
{ [ os unix? ] [ "debugger.unix" require ] }
[ [ \ 3curry suffix! ] dip 3 - (ncurry) ]
} case ;
+: wrap-non-callable ( obj -- quot )
+ dup callable? [ ] [ [ call ] curry ] if ; inline
+
: [ncurry] ( n -- quot )
[ V{ } clone ] dip (ncurry) >quotation ;
: [ndip] ( quot n -- quot' )
{
- { 0 [ ] }
+ { 0 [ wrap-non-callable ] }
{ 1 [ \ dip [ ] 2sequence ] }
{ 2 [ \ 2dip [ ] 2sequence ] }
{ 3 [ \ 3dip [ ] 2sequence ] }
USING: accessors assocs byte-arrays calendar classes
combinators combinators.short-circuit concurrency.promises
continuations destructors ftp io io.backend io.directories
-io.encodings io.encodings.8-bit io.encodings.binary
+io.encodings io.encodings.binary
tools.files io.encodings.utf8 io.files io.files.info
io.pathnames io.launcher.unix.parser io.servers.connection
io.sockets io.streams.duplex io.streams.string io.timeouts
kernel make math math.bitwise math.parser namespaces sequences
splitting threads unicode.case logging calendar.format
-strings io.files.links io.files.types ;
+strings io.files.links io.files.types io.encodings.8-bit.latin1 ;
IN: ftp.server
SYMBOL: server
[ [ >float half>bits ] 2dip set-alien-unsigned-2 ] >>setter
2 >>size
2 >>align
+ 2 >>align-first
[ >float ] >>unboxer-quot
\ half define-primitive-type
INSTANCE: apropos topic
: apropos ( str -- )
- <apropos> print-topic ;
+ <apropos> print-topic nl ;
SYMBOL: help-hook
-help-hook [ [ print-topic ] ] initialize
+help-hook [ [ print-topic nl ] ] initialize
: help ( topic -- )
help-hook get call( topic -- ) ;
USING: http help.markup help.syntax io.pathnames io.streams.string
-io.encodings.8-bit io.encodings.binary kernel urls
+io.encodings.binary kernel urls
urls.encoding byte-arrays strings assocs sequences destructors
-http.client.post-data.private ;
+http.client.post-data.private io.encodings.8-bit.latin1 ;
IN: http.client
HELP: download-failed
math.order hashtables byte-arrays destructors
io io.sockets io.streams.string io.files io.timeouts
io.pathnames io.encodings io.encodings.string io.encodings.ascii
-io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.crlf
+io.encodings.utf8 io.encodings.binary io.crlf
io.streams.duplex fry ascii urls urls.encoding present locals
http http.parsers http.client.post-data ;
IN: http.client
multiline io.streams.string io.encodings.utf8 io.encodings.8-bit
io.encodings.binary io.encodings.string io.encodings.ascii kernel
arrays splitting sequences assocs io.sockets db db.sqlite
-continuations urls hashtables accessors namespaces xml.data ;
+continuations urls hashtables accessors namespaces xml.data
+io.encodings.8-bit.latin1 ;
IN: http.tests
[ "text/plain" latin1 ] [ "text/plain" parse-content-type ] unit-test
quotations arrays byte-arrays math.parser calendar
calendar.format present urls fry
io io.encodings io.encodings.iana io.encodings.binary
-io.encodings.8-bit io.crlf ascii
-http.parsers
-base64 ;
+io.crlf ascii io.encodings.8-bit.latin1 http.parsers base64 ;
IN: http
CONSTANT: max-redirects 10
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays byte-arrays combinators
compression.run-length fry grouping images images.loader io
-io.binary io.encodings.8-bit io.encodings.binary
+io.binary io.encodings.binary
io.encodings.string io.streams.limited kernel math math.bitwise
-sequences specialized-arrays summary images.bitmap ;
+io.encodings.8-bit.latin1 sequences specialized-arrays summary images.bitmap ;
QUALIFIED-WITH: bitstreams b
SPECIALIZED-ARRAY: ushort
IN: images.bitmap.loading
IN: io.encodings.8-bit
ARTICLE: "io.encodings.8-bit" "Legacy 8-bit encodings"
-"Many encodings are a simple mapping of bytes onto characters. The " { $vocab-link "io.encodings.8-bit" } " vocabulary implements these generically using existing resource files. These encodings should be used with extreme caution, as fully general Unicode encodings like UTF-8 are nearly always more appropriate. The following 8-bit encodings are already defined:"
-{ $subsections
- latin1
- latin2
- latin3
- latin4
- latin/cyrillic
- latin/arabic
- latin/greek
- latin/hebrew
- latin5
- latin6
- latin/thai
- latin7
- latin8
- latin9
- latin10
- koi8-r
- windows-1252
- ebcdic
- mac-roman
+"Many encodings are a simple mapping of bytes onto characters. The " { $vocab-link "io.encodings.8-bit" } " vocabulary implements these generically using existing resource files. These encodings should be used with extreme caution, as fully general Unicode encodings like UTF-8 are nearly always more appropriate. The following 8-bit encodings are available:"
+{ $list
+ { $vocab-link "io.encodings.8-bit.ebcdic" }
+ { $vocab-link "io.encodings.8-bit.latin1" }
+ { $vocab-link "io.encodings.8-bit.latin2" }
+ { $vocab-link "io.encodings.8-bit.latin3" }
+ { $vocab-link "io.encodings.8-bit.latin4" }
+ { $vocab-link "io.encodings.8-bit.cyrillic" }
+ { $vocab-link "io.encodings.8-bit.arabic" }
+ { $vocab-link "io.encodings.8-bit.greek" }
+ { $vocab-link "io.encodings.8-bit.hebrew" }
+ { $vocab-link "io.encodings.8-bit.latin5" }
+ { $vocab-link "io.encodings.8-bit.latin6" }
+ { $vocab-link "io.encodings.8-bit.thai" }
+ { $vocab-link "io.encodings.8-bit.latin7" }
+ { $vocab-link "io.encodings.8-bit.latin8" }
+ { $vocab-link "io.encodings.8-bit.latin9" }
+ { $vocab-link "io.encodings.8-bit.koi8-r" }
+ { $vocab-link "io.encodings.8-bit.mac-roman" }
+ { $vocab-link "io.encodings.8-bit.windows-1250" }
+ { $vocab-link "io.encodings.8-bit.windows-1251" }
+ { $vocab-link "io.encodings.8-bit.windows-1252" }
+ { $vocab-link "io.encodings.8-bit.windows-1253" }
+ { $vocab-link "io.encodings.8-bit.windows-1254" }
+ { $vocab-link "io.encodings.8-bit.windows-1255" }
+ { $vocab-link "io.encodings.8-bit.windows-1256" }
+ { $vocab-link "io.encodings.8-bit.windows-1257" }
+ { $vocab-link "io.encodings.8-bit.windows-1258" }
} ;
ABOUT: "io.encodings.8-bit"
-
-HELP: 8-bit
-{ $class-description "Describes an 8-bit encoding, including its name (a symbol) and a table used for encoding and decoding." } ;
-
-HELP: latin1
-{ $description "This is the ISO-8859-1 encoding, also called Latin-1: Western European. It is an 8-bit superset of ASCII which is the default for a mimetype starting with 'text' and provides the characters necessary for most western European languages." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin2
-{ $description "This is the ISO-8859-2 encoding, also called Latin-2: Eastern European. It is an 8-bit superset of ASCII and provides the characters necessary for most eastern European languages." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin3
-{ $description "This is the ISO-8859-3 encoding, also called Latin-3: South European. It is an 8-bit superset of ASCII and provides the characters necessary for Turkish, Maltese and Esperanto." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin4
-{ $description "This is the ISO-8859-4 encoding, also called Latin-4: North European. It is an 8-bit superset of ASCII and provides the characters necessary for Latvian, Lithuanian, Estonian, Greenlandic and Sami." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin/cyrillic
-{ $description "This is the ISO-8859-5 encoding, also called Latin/Cyrillic. It is an 8-bit superset of ASCII and provides the characters necessary for most languages which use Cyrilic, including Russian, Macedonian, Belarusian, Bulgarian, Serbian, and Ukrainian. KOI8-R is used much more commonly." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin/arabic
-{ $description "This is the ISO-8859-6 encoding, also called Latin/Arabic. It is an 8-bit superset of ASCII and provides the characters necessary for Arabic, though not other languages which use Arabic script." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin/greek
-{ $description "This is the ISO-8859-7 encoding, also called Latin/Greek. It is an 8-bit superset of ASCII and provides the characters necessary for Greek written in modern monotonic orthography, or ancient Greek without accent marks." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin/hebrew
-{ $description "This is the ISO-8859-8 encoding, also called Latin/Hebrew. It is an 8-bit superset of ASCII and provides the characters necessary for modern Hebrew without explicit vowels. Generally, this is interpreted in logical order, making it ISO-8859-8-I, technically." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin5
-{ $description "This is the ISO-8859-9 encoding, also called Latin-5: Turkish. It is an 8-bit superset of ASCII and provides the characters necessary for Turkish, similar to Latin-1 but replacing the spots used for Icelandic with characters used in Turkish." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin6
-{ $description "This is the ISO-8859-10 encoding, also called Latin-6: Nordic. It is an 8-bit superset of ASCII containing the same characters as Latin-4, but rearranged to be of better use to nordic languages." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin/thai
-{ $description "This is the ISO-8859-11 encoding, also called Latin/Thai. It is an 8-bit superset of ASCII containing the characters necessary to represent Thai. It is basically identical to TIS-620." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin7
-{ $description "This is the ISO-8859-13 encoding, also called Latin-7: Baltic Rim. It is an 8-bit superset of ASCII containing all characters necesary to represent Baltic Rim languages, as previous character sets were incomplete." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin8
-{ $description "This is the ISO-8859-14 encoding, also called Latin-8: Celtic. It is an 8-bit superset of ASCII designed for Celtic languages like Gaelic and Breton." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin9
-{ $description "This is the ISO-8859-15 encoding, also called Latin-9 and unoffically as Latin-0. It is an 8-bit superset of ASCII designed as a modification of Latin-1, removing little-used characters in favor of the Euro symbol and other characters." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: latin10
-{ $description "This is the ISO-8859-16 encoding, also called Latin-10: South-Eastern European. It is an 8-bit superset of ASCII." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: windows-1252
-{ $description "Windows 1252 is an 8-bit superset of ASCII which is closely related to Latin-1. Control characters in the 0x80 to 0x9F range are replaced with printable characters such as the Euro symbol." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: ebcdic
-{ $description "EBCDIC is an 8-bit legacy encoding designed for IBM mainframes like System/360 in the 1960s. It has since fallen into disuse. It contains large unallocated regions, and the version included here (code page 37) contains auxiliary characters in this region for English- and Portugese-speaking countries." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: mac-roman
-{ $description "Mac Roman is an 8-bit superset of ASCII which was the standard encoding on Mac OS prior to version 10. It is incompatible with Latin-1 in all but a few places and ASCII, and it is suitable for encoding many Western European languages." }
-{ $see-also "encodings-introduction" } ;
-
-HELP: koi8-r
-{ $description "KOI8-R is an 8-bit superset of ASCII which encodes the Cyrillic alphabet, as used in Russian and Bulgarian. Characters are in such an order that, if the eight bit is stripped, text is still interpretable as ASCII. Block-building characters also exist." }
-{ $see-also "encodings-introduction" } ;
USING: io.encodings.string io.encodings.8-bit
-io.encodings.8-bit.private tools.test strings arrays ;
+io.encodings.8-bit.private tools.test strings arrays
+io.encodings.8-bit.latin1 io.encodings.8-bit.windows-1252 ;
IN: io.encodings.8-bit.tests
[ B{ CHAR: f CHAR: o CHAR: o } ] [ "foo" latin1 encode ] unit-test
-! Copyright (C) 2008 Daniel Ehrenberg
+! Copyright (C) 2008 Daniel Ehrenberg, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: math.parser arrays io.encodings sequences kernel assocs
hashtables io.encodings.ascii generic parser classes.tuple words
words.symbol io io.files splitting namespaces math
compiler.units accessors classes.singleton classes.mixin
-io.encodings.iana fry simple-flat-file ;
+io.encodings.iana fry simple-flat-file lexer ;
IN: io.encodings.8-bit
<PRIVATE
-CONSTANT: mappings {
- ! encoding-name iana-name file-name
- { "latin1" "ISO_8859-1:1987" "8859-1" }
- { "latin2" "ISO_8859-2:1987" "8859-2" }
- { "latin3" "ISO_8859-3:1988" "8859-3" }
- { "latin4" "ISO_8859-4:1988" "8859-4" }
- { "latin/cyrillic" "ISO_8859-5:1988" "8859-5" }
- { "latin/arabic" "ISO_8859-6:1987" "8859-6" }
- { "latin/greek" "ISO_8859-7:1987" "8859-7" }
- { "latin/hebrew" "ISO_8859-8:1988" "8859-8" }
- { "latin5" "ISO_8859-9:1989" "8859-9" }
- { "latin6" "ISO-8859-10" "8859-10" }
- { "latin/thai" "TIS-620" "8859-11" }
- { "latin7" "ISO-8859-13" "8859-13" }
- { "latin8" "ISO-8859-14" "8859-14" }
- { "latin9" "ISO-8859-15" "8859-15" }
- { "latin10" "ISO-8859-16" "8859-16" }
- { "koi8-r" "KOI8-R" "KOI8-R" }
- { "windows-1250" "windows-1250" "CP1250" }
- { "windows-1252" "windows-1252" "CP1252" }
- { "ebcdic" "IBM037" "CP037" }
- { "mac-roman" "macintosh" "ROMAN" }
-}
-
: encoding-file ( file-name -- stream )
"vocab:io/encodings/8-bit/" ".TXT" surround ;
SYMBOL: 8-bit-encodings
+8-bit-encodings [ H{ } clone ] initialize
TUPLE: 8-bit biassoc ;
8-bit-encodings get-global at <decoder> ;
: create-encoding ( name -- word )
- "io.encodings.8-bit" create
+ create-in
[ define-singleton-class ]
[ 8-bit-encoding add-mixin-instance ]
[ ] tri ;
+: load-encoding ( name iana-name file-name -- )
+ [ create-encoding dup ]
+ [ register-encoding ]
+ [ encoding-file flat-file>biassoc 8-bit boa ] tri*
+ swap 8-bit-encodings get-global set-at ;
+
PRIVATE>
-[
- mappings [
- first3
- [ create-encoding ]
- [ dupd register-encoding ]
- [ encoding-file flat-file>biassoc 8-bit boa ]
- tri*
- ] H{ } map>assoc
- 8-bit-encodings set-global
-] with-compilation-unit
+SYNTAX: 8-BIT: scan scan scan load-encoding ;
--- /dev/null
+#
+# Name: cp1251 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: Shawn.Steele@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1251 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1251 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x0402 #CYRILLIC CAPITAL LETTER DJE
+0x81 0x0403 #CYRILLIC CAPITAL LETTER GJE
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0453 #CYRILLIC SMALL LETTER GJE
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 0x20AC #EURO SIGN
+0x89 0x2030 #PER MILLE SIGN
+0x8A 0x0409 #CYRILLIC CAPITAL LETTER LJE
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C 0x040A #CYRILLIC CAPITAL LETTER NJE
+0x8D 0x040C #CYRILLIC CAPITAL LETTER KJE
+0x8E 0x040B #CYRILLIC CAPITAL LETTER TSHE
+0x8F 0x040F #CYRILLIC CAPITAL LETTER DZHE
+0x90 0x0452 #CYRILLIC SMALL LETTER DJE
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 #UNDEFINED
+0x99 0x2122 #TRADE MARK SIGN
+0x9A 0x0459 #CYRILLIC SMALL LETTER LJE
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C 0x045A #CYRILLIC SMALL LETTER NJE
+0x9D 0x045C #CYRILLIC SMALL LETTER KJE
+0x9E 0x045B #CYRILLIC SMALL LETTER TSHE
+0x9F 0x045F #CYRILLIC SMALL LETTER DZHE
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x040E #CYRILLIC CAPITAL LETTER SHORT U
+0xA2 0x045E #CYRILLIC SMALL LETTER SHORT U
+0xA3 0x0408 #CYRILLIC CAPITAL LETTER JE
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x0490 #CYRILLIC CAPITAL LETTER GHE WITH UPTURN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x0401 #CYRILLIC CAPITAL LETTER IO
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x0404 #CYRILLIC CAPITAL LETTER UKRAINIAN IE
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x0407 #CYRILLIC CAPITAL LETTER YI
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x0406 #CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
+0xB3 0x0456 #CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
+0xB4 0x0491 #CYRILLIC SMALL LETTER GHE WITH UPTURN
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x0451 #CYRILLIC SMALL LETTER IO
+0xB9 0x2116 #NUMERO SIGN
+0xBA 0x0454 #CYRILLIC SMALL LETTER UKRAINIAN IE
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x0458 #CYRILLIC SMALL LETTER JE
+0xBD 0x0405 #CYRILLIC CAPITAL LETTER DZE
+0xBE 0x0455 #CYRILLIC SMALL LETTER DZE
+0xBF 0x0457 #CYRILLIC SMALL LETTER YI
+0xC0 0x0410 #CYRILLIC CAPITAL LETTER A
+0xC1 0x0411 #CYRILLIC CAPITAL LETTER BE
+0xC2 0x0412 #CYRILLIC CAPITAL LETTER VE
+0xC3 0x0413 #CYRILLIC CAPITAL LETTER GHE
+0xC4 0x0414 #CYRILLIC CAPITAL LETTER DE
+0xC5 0x0415 #CYRILLIC CAPITAL LETTER IE
+0xC6 0x0416 #CYRILLIC CAPITAL LETTER ZHE
+0xC7 0x0417 #CYRILLIC CAPITAL LETTER ZE
+0xC8 0x0418 #CYRILLIC CAPITAL LETTER I
+0xC9 0x0419 #CYRILLIC CAPITAL LETTER SHORT I
+0xCA 0x041A #CYRILLIC CAPITAL LETTER KA
+0xCB 0x041B #CYRILLIC CAPITAL LETTER EL
+0xCC 0x041C #CYRILLIC CAPITAL LETTER EM
+0xCD 0x041D #CYRILLIC CAPITAL LETTER EN
+0xCE 0x041E #CYRILLIC CAPITAL LETTER O
+0xCF 0x041F #CYRILLIC CAPITAL LETTER PE
+0xD0 0x0420 #CYRILLIC CAPITAL LETTER ER
+0xD1 0x0421 #CYRILLIC CAPITAL LETTER ES
+0xD2 0x0422 #CYRILLIC CAPITAL LETTER TE
+0xD3 0x0423 #CYRILLIC CAPITAL LETTER U
+0xD4 0x0424 #CYRILLIC CAPITAL LETTER EF
+0xD5 0x0425 #CYRILLIC CAPITAL LETTER HA
+0xD6 0x0426 #CYRILLIC CAPITAL LETTER TSE
+0xD7 0x0427 #CYRILLIC CAPITAL LETTER CHE
+0xD8 0x0428 #CYRILLIC CAPITAL LETTER SHA
+0xD9 0x0429 #CYRILLIC CAPITAL LETTER SHCHA
+0xDA 0x042A #CYRILLIC CAPITAL LETTER HARD SIGN
+0xDB 0x042B #CYRILLIC CAPITAL LETTER YERU
+0xDC 0x042C #CYRILLIC CAPITAL LETTER SOFT SIGN
+0xDD 0x042D #CYRILLIC CAPITAL LETTER E
+0xDE 0x042E #CYRILLIC CAPITAL LETTER YU
+0xDF 0x042F #CYRILLIC CAPITAL LETTER YA
+0xE0 0x0430 #CYRILLIC SMALL LETTER A
+0xE1 0x0431 #CYRILLIC SMALL LETTER BE
+0xE2 0x0432 #CYRILLIC SMALL LETTER VE
+0xE3 0x0433 #CYRILLIC SMALL LETTER GHE
+0xE4 0x0434 #CYRILLIC SMALL LETTER DE
+0xE5 0x0435 #CYRILLIC SMALL LETTER IE
+0xE6 0x0436 #CYRILLIC SMALL LETTER ZHE
+0xE7 0x0437 #CYRILLIC SMALL LETTER ZE
+0xE8 0x0438 #CYRILLIC SMALL LETTER I
+0xE9 0x0439 #CYRILLIC SMALL LETTER SHORT I
+0xEA 0x043A #CYRILLIC SMALL LETTER KA
+0xEB 0x043B #CYRILLIC SMALL LETTER EL
+0xEC 0x043C #CYRILLIC SMALL LETTER EM
+0xED 0x043D #CYRILLIC SMALL LETTER EN
+0xEE 0x043E #CYRILLIC SMALL LETTER O
+0xEF 0x043F #CYRILLIC SMALL LETTER PE
+0xF0 0x0440 #CYRILLIC SMALL LETTER ER
+0xF1 0x0441 #CYRILLIC SMALL LETTER ES
+0xF2 0x0442 #CYRILLIC SMALL LETTER TE
+0xF3 0x0443 #CYRILLIC SMALL LETTER U
+0xF4 0x0444 #CYRILLIC SMALL LETTER EF
+0xF5 0x0445 #CYRILLIC SMALL LETTER HA
+0xF6 0x0446 #CYRILLIC SMALL LETTER TSE
+0xF7 0x0447 #CYRILLIC SMALL LETTER CHE
+0xF8 0x0448 #CYRILLIC SMALL LETTER SHA
+0xF9 0x0449 #CYRILLIC SMALL LETTER SHCHA
+0xFA 0x044A #CYRILLIC SMALL LETTER HARD SIGN
+0xFB 0x044B #CYRILLIC SMALL LETTER YERU
+0xFC 0x044C #CYRILLIC SMALL LETTER SOFT SIGN
+0xFD 0x044D #CYRILLIC SMALL LETTER E
+0xFE 0x044E #CYRILLIC SMALL LETTER YU
+0xFF 0x044F #CYRILLIC SMALL LETTER YA
--- /dev/null
+#
+# Name: cp1253 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: Shawn.Steele@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1253 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1253 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 #UNDEFINED
+0x89 0x2030 #PER MILLE SIGN
+0x8A #UNDEFINED
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C #UNDEFINED
+0x8D #UNDEFINED
+0x8E #UNDEFINED
+0x8F #UNDEFINED
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 #UNDEFINED
+0x99 0x2122 #TRADE MARK SIGN
+0x9A #UNDEFINED
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C #UNDEFINED
+0x9D #UNDEFINED
+0x9E #UNDEFINED
+0x9F #UNDEFINED
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x0385 #GREEK DIALYTIKA TONOS
+0xA2 0x0386 #GREEK CAPITAL LETTER ALPHA WITH TONOS
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x00A5 #YEN SIGN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA #UNDEFINED
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x2015 #HORIZONTAL BAR
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x0384 #GREEK TONOS
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x0388 #GREEK CAPITAL LETTER EPSILON WITH TONOS
+0xB9 0x0389 #GREEK CAPITAL LETTER ETA WITH TONOS
+0xBA 0x038A #GREEK CAPITAL LETTER IOTA WITH TONOS
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x038C #GREEK CAPITAL LETTER OMICRON WITH TONOS
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x038E #GREEK CAPITAL LETTER UPSILON WITH TONOS
+0xBF 0x038F #GREEK CAPITAL LETTER OMEGA WITH TONOS
+0xC0 0x0390 #GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
+0xC1 0x0391 #GREEK CAPITAL LETTER ALPHA
+0xC2 0x0392 #GREEK CAPITAL LETTER BETA
+0xC3 0x0393 #GREEK CAPITAL LETTER GAMMA
+0xC4 0x0394 #GREEK CAPITAL LETTER DELTA
+0xC5 0x0395 #GREEK CAPITAL LETTER EPSILON
+0xC6 0x0396 #GREEK CAPITAL LETTER ZETA
+0xC7 0x0397 #GREEK CAPITAL LETTER ETA
+0xC8 0x0398 #GREEK CAPITAL LETTER THETA
+0xC9 0x0399 #GREEK CAPITAL LETTER IOTA
+0xCA 0x039A #GREEK CAPITAL LETTER KAPPA
+0xCB 0x039B #GREEK CAPITAL LETTER LAMDA
+0xCC 0x039C #GREEK CAPITAL LETTER MU
+0xCD 0x039D #GREEK CAPITAL LETTER NU
+0xCE 0x039E #GREEK CAPITAL LETTER XI
+0xCF 0x039F #GREEK CAPITAL LETTER OMICRON
+0xD0 0x03A0 #GREEK CAPITAL LETTER PI
+0xD1 0x03A1 #GREEK CAPITAL LETTER RHO
+0xD2 #UNDEFINED
+0xD3 0x03A3 #GREEK CAPITAL LETTER SIGMA
+0xD4 0x03A4 #GREEK CAPITAL LETTER TAU
+0xD5 0x03A5 #GREEK CAPITAL LETTER UPSILON
+0xD6 0x03A6 #GREEK CAPITAL LETTER PHI
+0xD7 0x03A7 #GREEK CAPITAL LETTER CHI
+0xD8 0x03A8 #GREEK CAPITAL LETTER PSI
+0xD9 0x03A9 #GREEK CAPITAL LETTER OMEGA
+0xDA 0x03AA #GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
+0xDB 0x03AB #GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
+0xDC 0x03AC #GREEK SMALL LETTER ALPHA WITH TONOS
+0xDD 0x03AD #GREEK SMALL LETTER EPSILON WITH TONOS
+0xDE 0x03AE #GREEK SMALL LETTER ETA WITH TONOS
+0xDF 0x03AF #GREEK SMALL LETTER IOTA WITH TONOS
+0xE0 0x03B0 #GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
+0xE1 0x03B1 #GREEK SMALL LETTER ALPHA
+0xE2 0x03B2 #GREEK SMALL LETTER BETA
+0xE3 0x03B3 #GREEK SMALL LETTER GAMMA
+0xE4 0x03B4 #GREEK SMALL LETTER DELTA
+0xE5 0x03B5 #GREEK SMALL LETTER EPSILON
+0xE6 0x03B6 #GREEK SMALL LETTER ZETA
+0xE7 0x03B7 #GREEK SMALL LETTER ETA
+0xE8 0x03B8 #GREEK SMALL LETTER THETA
+0xE9 0x03B9 #GREEK SMALL LETTER IOTA
+0xEA 0x03BA #GREEK SMALL LETTER KAPPA
+0xEB 0x03BB #GREEK SMALL LETTER LAMDA
+0xEC 0x03BC #GREEK SMALL LETTER MU
+0xED 0x03BD #GREEK SMALL LETTER NU
+0xEE 0x03BE #GREEK SMALL LETTER XI
+0xEF 0x03BF #GREEK SMALL LETTER OMICRON
+0xF0 0x03C0 #GREEK SMALL LETTER PI
+0xF1 0x03C1 #GREEK SMALL LETTER RHO
+0xF2 0x03C2 #GREEK SMALL LETTER FINAL SIGMA
+0xF3 0x03C3 #GREEK SMALL LETTER SIGMA
+0xF4 0x03C4 #GREEK SMALL LETTER TAU
+0xF5 0x03C5 #GREEK SMALL LETTER UPSILON
+0xF6 0x03C6 #GREEK SMALL LETTER PHI
+0xF7 0x03C7 #GREEK SMALL LETTER CHI
+0xF8 0x03C8 #GREEK SMALL LETTER PSI
+0xF9 0x03C9 #GREEK SMALL LETTER OMEGA
+0xFA 0x03CA #GREEK SMALL LETTER IOTA WITH DIALYTIKA
+0xFB 0x03CB #GREEK SMALL LETTER UPSILON WITH DIALYTIKA
+0xFC 0x03CC #GREEK SMALL LETTER OMICRON WITH TONOS
+0xFD 0x03CD #GREEK SMALL LETTER UPSILON WITH TONOS
+0xFE 0x03CE #GREEK SMALL LETTER OMEGA WITH TONOS
+0xFF #UNDEFINED
--- /dev/null
+#
+# Name: cp1254 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: Shawn.Steele@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1254 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1254 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 0x02C6 #MODIFIER LETTER CIRCUMFLEX ACCENT
+0x89 0x2030 #PER MILLE SIGN
+0x8A 0x0160 #LATIN CAPITAL LETTER S WITH CARON
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C 0x0152 #LATIN CAPITAL LIGATURE OE
+0x8D #UNDEFINED
+0x8E #UNDEFINED
+0x8F #UNDEFINED
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 0x02DC #SMALL TILDE
+0x99 0x2122 #TRADE MARK SIGN
+0x9A 0x0161 #LATIN SMALL LETTER S WITH CARON
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C 0x0153 #LATIN SMALL LIGATURE OE
+0x9D #UNDEFINED
+0x9E #UNDEFINED
+0x9F 0x0178 #LATIN CAPITAL LETTER Y WITH DIAERESIS
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x00A1 #INVERTED EXCLAMATION MARK
+0xA2 0x00A2 #CENT SIGN
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x00A5 #YEN SIGN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x00AA #FEMININE ORDINAL INDICATOR
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x00AF #MACRON
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00B8 #CEDILLA
+0xB9 0x00B9 #SUPERSCRIPT ONE
+0xBA 0x00BA #MASCULINE ORDINAL INDICATOR
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xBF 0x00BF #INVERTED QUESTION MARK
+0xC0 0x00C0 #LATIN CAPITAL LETTER A WITH GRAVE
+0xC1 0x00C1 #LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x00C3 #LATIN CAPITAL LETTER A WITH TILDE
+0xC4 0x00C4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x00C6 #LATIN CAPITAL LETTER AE
+0xC7 0x00C7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x00C8 #LATIN CAPITAL LETTER E WITH GRAVE
+0xC9 0x00C9 #LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x00CA #LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xCB 0x00CB #LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x00CC #LATIN CAPITAL LETTER I WITH GRAVE
+0xCD 0x00CD #LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE #LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x00CF #LATIN CAPITAL LETTER I WITH DIAERESIS
+0xD0 0x011E #LATIN CAPITAL LETTER G WITH BREVE
+0xD1 0x00D1 #LATIN CAPITAL LETTER N WITH TILDE
+0xD2 0x00D2 #LATIN CAPITAL LETTER O WITH GRAVE
+0xD3 0x00D3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x00D5 #LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 #MULTIPLICATION SIGN
+0xD8 0x00D8 #LATIN CAPITAL LETTER O WITH STROKE
+0xD9 0x00D9 #LATIN CAPITAL LETTER U WITH GRAVE
+0xDA 0x00DA #LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB #LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC #LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x0130 #LATIN CAPITAL LETTER I WITH DOT ABOVE
+0xDE 0x015E #LATIN CAPITAL LETTER S WITH CEDILLA
+0xDF 0x00DF #LATIN SMALL LETTER SHARP S
+0xE0 0x00E0 #LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x00E1 #LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x00E3 #LATIN SMALL LETTER A WITH TILDE
+0xE4 0x00E4 #LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 #LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x00E6 #LATIN SMALL LETTER AE
+0xE7 0x00E7 #LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 #LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 #LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB #LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x00EC #LATIN SMALL LETTER I WITH GRAVE
+0xED 0x00ED #LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF #LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x011F #LATIN SMALL LETTER G WITH BREVE
+0xF1 0x00F1 #LATIN SMALL LETTER N WITH TILDE
+0xF2 0x00F2 #LATIN SMALL LETTER O WITH GRAVE
+0xF3 0x00F3 #LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x00F5 #LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 #LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 #DIVISION SIGN
+0xF8 0x00F8 #LATIN SMALL LETTER O WITH STROKE
+0xF9 0x00F9 #LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x00FA #LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC #LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x0131 #LATIN SMALL LETTER DOTLESS I
+0xFE 0x015F #LATIN SMALL LETTER S WITH CEDILLA
+0xFF 0x00FF #LATIN SMALL LETTER Y WITH DIAERESIS
--- /dev/null
+#
+# Name: cp1255 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 1/7/2000
+#
+# Contact: Shawn.Steele@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1255 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1255 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 0x02C6 #MODIFIER LETTER CIRCUMFLEX ACCENT
+0x89 0x2030 #PER MILLE SIGN
+0x8A #UNDEFINED
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C #UNDEFINED
+0x8D #UNDEFINED
+0x8E #UNDEFINED
+0x8F #UNDEFINED
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 0x02DC #SMALL TILDE
+0x99 0x2122 #TRADE MARK SIGN
+0x9A #UNDEFINED
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C #UNDEFINED
+0x9D #UNDEFINED
+0x9E #UNDEFINED
+0x9F #UNDEFINED
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x00A1 #INVERTED EXCLAMATION MARK
+0xA2 0x00A2 #CENT SIGN
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x20AA #NEW SHEQEL SIGN
+0xA5 0x00A5 #YEN SIGN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x00D7 #MULTIPLICATION SIGN
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x00AF #MACRON
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00B8 #CEDILLA
+0xB9 0x00B9 #SUPERSCRIPT ONE
+0xBA 0x00F7 #DIVISION SIGN
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xBF 0x00BF #INVERTED QUESTION MARK
+0xC0 0x05B0 #HEBREW POINT SHEVA
+0xC1 0x05B1 #HEBREW POINT HATAF SEGOL
+0xC2 0x05B2 #HEBREW POINT HATAF PATAH
+0xC3 0x05B3 #HEBREW POINT HATAF QAMATS
+0xC4 0x05B4 #HEBREW POINT HIRIQ
+0xC5 0x05B5 #HEBREW POINT TSERE
+0xC6 0x05B6 #HEBREW POINT SEGOL
+0xC7 0x05B7 #HEBREW POINT PATAH
+0xC8 0x05B8 #HEBREW POINT QAMATS
+0xC9 0x05B9 #HEBREW POINT HOLAM
+0xCA #UNDEFINED
+0xCB 0x05BB #HEBREW POINT QUBUTS
+0xCC 0x05BC #HEBREW POINT DAGESH OR MAPIQ
+0xCD 0x05BD #HEBREW POINT METEG
+0xCE 0x05BE #HEBREW PUNCTUATION MAQAF
+0xCF 0x05BF #HEBREW POINT RAFE
+0xD0 0x05C0 #HEBREW PUNCTUATION PASEQ
+0xD1 0x05C1 #HEBREW POINT SHIN DOT
+0xD2 0x05C2 #HEBREW POINT SIN DOT
+0xD3 0x05C3 #HEBREW PUNCTUATION SOF PASUQ
+0xD4 0x05F0 #HEBREW LIGATURE YIDDISH DOUBLE VAV
+0xD5 0x05F1 #HEBREW LIGATURE YIDDISH VAV YOD
+0xD6 0x05F2 #HEBREW LIGATURE YIDDISH DOUBLE YOD
+0xD7 0x05F3 #HEBREW PUNCTUATION GERESH
+0xD8 0x05F4 #HEBREW PUNCTUATION GERSHAYIM
+0xD9 #UNDEFINED
+0xDA #UNDEFINED
+0xDB #UNDEFINED
+0xDC #UNDEFINED
+0xDD #UNDEFINED
+0xDE #UNDEFINED
+0xDF #UNDEFINED
+0xE0 0x05D0 #HEBREW LETTER ALEF
+0xE1 0x05D1 #HEBREW LETTER BET
+0xE2 0x05D2 #HEBREW LETTER GIMEL
+0xE3 0x05D3 #HEBREW LETTER DALET
+0xE4 0x05D4 #HEBREW LETTER HE
+0xE5 0x05D5 #HEBREW LETTER VAV
+0xE6 0x05D6 #HEBREW LETTER ZAYIN
+0xE7 0x05D7 #HEBREW LETTER HET
+0xE8 0x05D8 #HEBREW LETTER TET
+0xE9 0x05D9 #HEBREW LETTER YOD
+0xEA 0x05DA #HEBREW LETTER FINAL KAF
+0xEB 0x05DB #HEBREW LETTER KAF
+0xEC 0x05DC #HEBREW LETTER LAMED
+0xED 0x05DD #HEBREW LETTER FINAL MEM
+0xEE 0x05DE #HEBREW LETTER MEM
+0xEF 0x05DF #HEBREW LETTER FINAL NUN
+0xF0 0x05E0 #HEBREW LETTER NUN
+0xF1 0x05E1 #HEBREW LETTER SAMEKH
+0xF2 0x05E2 #HEBREW LETTER AYIN
+0xF3 0x05E3 #HEBREW LETTER FINAL PE
+0xF4 0x05E4 #HEBREW LETTER PE
+0xF5 0x05E5 #HEBREW LETTER FINAL TSADI
+0xF6 0x05E6 #HEBREW LETTER TSADI
+0xF7 0x05E7 #HEBREW LETTER QOF
+0xF8 0x05E8 #HEBREW LETTER RESH
+0xF9 0x05E9 #HEBREW LETTER SHIN
+0xFA 0x05EA #HEBREW LETTER TAV
+0xFB #UNDEFINED
+0xFC #UNDEFINED
+0xFD 0x200E #LEFT-TO-RIGHT MARK
+0xFE 0x200F #RIGHT-TO-LEFT MARK
+0xFF #UNDEFINED
--- /dev/null
+#
+# Name: cp1256 to Unicode table
+# Unicode version: 2.1
+# Table version: 2.01
+# Table format: Format A
+# Date: 01/5/99
+#
+# Contact: Shawn.Steele@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1256 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1256 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 0x067E #ARABIC LETTER PEH
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 0x02C6 #MODIFIER LETTER CIRCUMFLEX ACCENT
+0x89 0x2030 #PER MILLE SIGN
+0x8A 0x0679 #ARABIC LETTER TTEH
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C 0x0152 #LATIN CAPITAL LIGATURE OE
+0x8D 0x0686 #ARABIC LETTER TCHEH
+0x8E 0x0698 #ARABIC LETTER JEH
+0x8F 0x0688 #ARABIC LETTER DDAL
+0x90 0x06AF #ARABIC LETTER GAF
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 0x06A9 #ARABIC LETTER KEHEH
+0x99 0x2122 #TRADE MARK SIGN
+0x9A 0x0691 #ARABIC LETTER RREH
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C 0x0153 #LATIN SMALL LIGATURE OE
+0x9D 0x200C #ZERO WIDTH NON-JOINER
+0x9E 0x200D #ZERO WIDTH JOINER
+0x9F 0x06BA #ARABIC LETTER NOON GHUNNA
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x060C #ARABIC COMMA
+0xA2 0x00A2 #CENT SIGN
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x00A5 #YEN SIGN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x06BE #ARABIC LETTER HEH DOACHASHMEE
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x00AF #MACRON
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00B8 #CEDILLA
+0xB9 0x00B9 #SUPERSCRIPT ONE
+0xBA 0x061B #ARABIC SEMICOLON
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xBF 0x061F #ARABIC QUESTION MARK
+0xC0 0x06C1 #ARABIC LETTER HEH GOAL
+0xC1 0x0621 #ARABIC LETTER HAMZA
+0xC2 0x0622 #ARABIC LETTER ALEF WITH MADDA ABOVE
+0xC3 0x0623 #ARABIC LETTER ALEF WITH HAMZA ABOVE
+0xC4 0x0624 #ARABIC LETTER WAW WITH HAMZA ABOVE
+0xC5 0x0625 #ARABIC LETTER ALEF WITH HAMZA BELOW
+0xC6 0x0626 #ARABIC LETTER YEH WITH HAMZA ABOVE
+0xC7 0x0627 #ARABIC LETTER ALEF
+0xC8 0x0628 #ARABIC LETTER BEH
+0xC9 0x0629 #ARABIC LETTER TEH MARBUTA
+0xCA 0x062A #ARABIC LETTER TEH
+0xCB 0x062B #ARABIC LETTER THEH
+0xCC 0x062C #ARABIC LETTER JEEM
+0xCD 0x062D #ARABIC LETTER HAH
+0xCE 0x062E #ARABIC LETTER KHAH
+0xCF 0x062F #ARABIC LETTER DAL
+0xD0 0x0630 #ARABIC LETTER THAL
+0xD1 0x0631 #ARABIC LETTER REH
+0xD2 0x0632 #ARABIC LETTER ZAIN
+0xD3 0x0633 #ARABIC LETTER SEEN
+0xD4 0x0634 #ARABIC LETTER SHEEN
+0xD5 0x0635 #ARABIC LETTER SAD
+0xD6 0x0636 #ARABIC LETTER DAD
+0xD7 0x00D7 #MULTIPLICATION SIGN
+0xD8 0x0637 #ARABIC LETTER TAH
+0xD9 0x0638 #ARABIC LETTER ZAH
+0xDA 0x0639 #ARABIC LETTER AIN
+0xDB 0x063A #ARABIC LETTER GHAIN
+0xDC 0x0640 #ARABIC TATWEEL
+0xDD 0x0641 #ARABIC LETTER FEH
+0xDE 0x0642 #ARABIC LETTER QAF
+0xDF 0x0643 #ARABIC LETTER KAF
+0xE0 0x00E0 #LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x0644 #ARABIC LETTER LAM
+0xE2 0x00E2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x0645 #ARABIC LETTER MEEM
+0xE4 0x0646 #ARABIC LETTER NOON
+0xE5 0x0647 #ARABIC LETTER HEH
+0xE6 0x0648 #ARABIC LETTER WAW
+0xE7 0x00E7 #LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 #LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 #LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB #LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x0649 #ARABIC LETTER ALEF MAKSURA
+0xED 0x064A #ARABIC LETTER YEH
+0xEE 0x00EE #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF #LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x064B #ARABIC FATHATAN
+0xF1 0x064C #ARABIC DAMMATAN
+0xF2 0x064D #ARABIC KASRATAN
+0xF3 0x064E #ARABIC FATHA
+0xF4 0x00F4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x064F #ARABIC DAMMA
+0xF6 0x0650 #ARABIC KASRA
+0xF7 0x00F7 #DIVISION SIGN
+0xF8 0x0651 #ARABIC SHADDA
+0xF9 0x00F9 #LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x0652 #ARABIC SUKUN
+0xFB 0x00FB #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC #LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x200E #LEFT-TO-RIGHT MARK
+0xFE 0x200F #RIGHT-TO-LEFT MARK
+0xFF 0x06D2 #ARABIC LETTER YEH BARREE
--- /dev/null
+#
+# Name: cp1257 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: Shawn.Steele@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1257 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1257 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 #UNDEFINED
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 #UNDEFINED
+0x89 0x2030 #PER MILLE SIGN
+0x8A #UNDEFINED
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C #UNDEFINED
+0x8D 0x00A8 #DIAERESIS
+0x8E 0x02C7 #CARON
+0x8F 0x00B8 #CEDILLA
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 #UNDEFINED
+0x99 0x2122 #TRADE MARK SIGN
+0x9A #UNDEFINED
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C #UNDEFINED
+0x9D 0x00AF #MACRON
+0x9E 0x02DB #OGONEK
+0x9F #UNDEFINED
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 #UNDEFINED
+0xA2 0x00A2 #CENT SIGN
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 #UNDEFINED
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00D8 #LATIN CAPITAL LETTER O WITH STROKE
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x0156 #LATIN CAPITAL LETTER R WITH CEDILLA
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x00C6 #LATIN CAPITAL LETTER AE
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00F8 #LATIN SMALL LETTER O WITH STROKE
+0xB9 0x00B9 #SUPERSCRIPT ONE
+0xBA 0x0157 #LATIN SMALL LETTER R WITH CEDILLA
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xBF 0x00E6 #LATIN SMALL LETTER AE
+0xC0 0x0104 #LATIN CAPITAL LETTER A WITH OGONEK
+0xC1 0x012E #LATIN CAPITAL LETTER I WITH OGONEK
+0xC2 0x0100 #LATIN CAPITAL LETTER A WITH MACRON
+0xC3 0x0106 #LATIN CAPITAL LETTER C WITH ACUTE
+0xC4 0x00C4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x0118 #LATIN CAPITAL LETTER E WITH OGONEK
+0xC7 0x0112 #LATIN CAPITAL LETTER E WITH MACRON
+0xC8 0x010C #LATIN CAPITAL LETTER C WITH CARON
+0xC9 0x00C9 #LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x0179 #LATIN CAPITAL LETTER Z WITH ACUTE
+0xCB 0x0116 #LATIN CAPITAL LETTER E WITH DOT ABOVE
+0xCC 0x0122 #LATIN CAPITAL LETTER G WITH CEDILLA
+0xCD 0x0136 #LATIN CAPITAL LETTER K WITH CEDILLA
+0xCE 0x012A #LATIN CAPITAL LETTER I WITH MACRON
+0xCF 0x013B #LATIN CAPITAL LETTER L WITH CEDILLA
+0xD0 0x0160 #LATIN CAPITAL LETTER S WITH CARON
+0xD1 0x0143 #LATIN CAPITAL LETTER N WITH ACUTE
+0xD2 0x0145 #LATIN CAPITAL LETTER N WITH CEDILLA
+0xD3 0x00D3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x014C #LATIN CAPITAL LETTER O WITH MACRON
+0xD5 0x00D5 #LATIN CAPITAL LETTER O WITH TILDE
+0xD6 0x00D6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 #MULTIPLICATION SIGN
+0xD8 0x0172 #LATIN CAPITAL LETTER U WITH OGONEK
+0xD9 0x0141 #LATIN CAPITAL LETTER L WITH STROKE
+0xDA 0x015A #LATIN CAPITAL LETTER S WITH ACUTE
+0xDB 0x016A #LATIN CAPITAL LETTER U WITH MACRON
+0xDC 0x00DC #LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x017B #LATIN CAPITAL LETTER Z WITH DOT ABOVE
+0xDE 0x017D #LATIN CAPITAL LETTER Z WITH CARON
+0xDF 0x00DF #LATIN SMALL LETTER SHARP S
+0xE0 0x0105 #LATIN SMALL LETTER A WITH OGONEK
+0xE1 0x012F #LATIN SMALL LETTER I WITH OGONEK
+0xE2 0x0101 #LATIN SMALL LETTER A WITH MACRON
+0xE3 0x0107 #LATIN SMALL LETTER C WITH ACUTE
+0xE4 0x00E4 #LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 #LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x0119 #LATIN SMALL LETTER E WITH OGONEK
+0xE7 0x0113 #LATIN SMALL LETTER E WITH MACRON
+0xE8 0x010D #LATIN SMALL LETTER C WITH CARON
+0xE9 0x00E9 #LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x017A #LATIN SMALL LETTER Z WITH ACUTE
+0xEB 0x0117 #LATIN SMALL LETTER E WITH DOT ABOVE
+0xEC 0x0123 #LATIN SMALL LETTER G WITH CEDILLA
+0xED 0x0137 #LATIN SMALL LETTER K WITH CEDILLA
+0xEE 0x012B #LATIN SMALL LETTER I WITH MACRON
+0xEF 0x013C #LATIN SMALL LETTER L WITH CEDILLA
+0xF0 0x0161 #LATIN SMALL LETTER S WITH CARON
+0xF1 0x0144 #LATIN SMALL LETTER N WITH ACUTE
+0xF2 0x0146 #LATIN SMALL LETTER N WITH CEDILLA
+0xF3 0x00F3 #LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x014D #LATIN SMALL LETTER O WITH MACRON
+0xF5 0x00F5 #LATIN SMALL LETTER O WITH TILDE
+0xF6 0x00F6 #LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 #DIVISION SIGN
+0xF8 0x0173 #LATIN SMALL LETTER U WITH OGONEK
+0xF9 0x0142 #LATIN SMALL LETTER L WITH STROKE
+0xFA 0x015B #LATIN SMALL LETTER S WITH ACUTE
+0xFB 0x016B #LATIN SMALL LETTER U WITH MACRON
+0xFC 0x00FC #LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x017C #LATIN SMALL LETTER Z WITH DOT ABOVE
+0xFE 0x017E #LATIN SMALL LETTER Z WITH CARON
+0xFF 0x02D9 #DOT ABOVE
--- /dev/null
+#
+# Name: cp1258 to Unicode table
+# Unicode version: 2.0
+# Table version: 2.01
+# Table format: Format A
+# Date: 04/15/98
+#
+# Contact: Shawn.Steele@microsoft.com
+#
+# General notes: none
+#
+# Format: Three tab-separated columns
+# Column #1 is the cp1258 code (in hex)
+# Column #2 is the Unicode (in hex as 0xXXXX)
+# Column #3 is the Unicode name (follows a comment sign, '#')
+#
+# The entries are in cp1258 order
+#
+0x00 0x0000 #NULL
+0x01 0x0001 #START OF HEADING
+0x02 0x0002 #START OF TEXT
+0x03 0x0003 #END OF TEXT
+0x04 0x0004 #END OF TRANSMISSION
+0x05 0x0005 #ENQUIRY
+0x06 0x0006 #ACKNOWLEDGE
+0x07 0x0007 #BELL
+0x08 0x0008 #BACKSPACE
+0x09 0x0009 #HORIZONTAL TABULATION
+0x0A 0x000A #LINE FEED
+0x0B 0x000B #VERTICAL TABULATION
+0x0C 0x000C #FORM FEED
+0x0D 0x000D #CARRIAGE RETURN
+0x0E 0x000E #SHIFT OUT
+0x0F 0x000F #SHIFT IN
+0x10 0x0010 #DATA LINK ESCAPE
+0x11 0x0011 #DEVICE CONTROL ONE
+0x12 0x0012 #DEVICE CONTROL TWO
+0x13 0x0013 #DEVICE CONTROL THREE
+0x14 0x0014 #DEVICE CONTROL FOUR
+0x15 0x0015 #NEGATIVE ACKNOWLEDGE
+0x16 0x0016 #SYNCHRONOUS IDLE
+0x17 0x0017 #END OF TRANSMISSION BLOCK
+0x18 0x0018 #CANCEL
+0x19 0x0019 #END OF MEDIUM
+0x1A 0x001A #SUBSTITUTE
+0x1B 0x001B #ESCAPE
+0x1C 0x001C #FILE SEPARATOR
+0x1D 0x001D #GROUP SEPARATOR
+0x1E 0x001E #RECORD SEPARATOR
+0x1F 0x001F #UNIT SEPARATOR
+0x20 0x0020 #SPACE
+0x21 0x0021 #EXCLAMATION MARK
+0x22 0x0022 #QUOTATION MARK
+0x23 0x0023 #NUMBER SIGN
+0x24 0x0024 #DOLLAR SIGN
+0x25 0x0025 #PERCENT SIGN
+0x26 0x0026 #AMPERSAND
+0x27 0x0027 #APOSTROPHE
+0x28 0x0028 #LEFT PARENTHESIS
+0x29 0x0029 #RIGHT PARENTHESIS
+0x2A 0x002A #ASTERISK
+0x2B 0x002B #PLUS SIGN
+0x2C 0x002C #COMMA
+0x2D 0x002D #HYPHEN-MINUS
+0x2E 0x002E #FULL STOP
+0x2F 0x002F #SOLIDUS
+0x30 0x0030 #DIGIT ZERO
+0x31 0x0031 #DIGIT ONE
+0x32 0x0032 #DIGIT TWO
+0x33 0x0033 #DIGIT THREE
+0x34 0x0034 #DIGIT FOUR
+0x35 0x0035 #DIGIT FIVE
+0x36 0x0036 #DIGIT SIX
+0x37 0x0037 #DIGIT SEVEN
+0x38 0x0038 #DIGIT EIGHT
+0x39 0x0039 #DIGIT NINE
+0x3A 0x003A #COLON
+0x3B 0x003B #SEMICOLON
+0x3C 0x003C #LESS-THAN SIGN
+0x3D 0x003D #EQUALS SIGN
+0x3E 0x003E #GREATER-THAN SIGN
+0x3F 0x003F #QUESTION MARK
+0x40 0x0040 #COMMERCIAL AT
+0x41 0x0041 #LATIN CAPITAL LETTER A
+0x42 0x0042 #LATIN CAPITAL LETTER B
+0x43 0x0043 #LATIN CAPITAL LETTER C
+0x44 0x0044 #LATIN CAPITAL LETTER D
+0x45 0x0045 #LATIN CAPITAL LETTER E
+0x46 0x0046 #LATIN CAPITAL LETTER F
+0x47 0x0047 #LATIN CAPITAL LETTER G
+0x48 0x0048 #LATIN CAPITAL LETTER H
+0x49 0x0049 #LATIN CAPITAL LETTER I
+0x4A 0x004A #LATIN CAPITAL LETTER J
+0x4B 0x004B #LATIN CAPITAL LETTER K
+0x4C 0x004C #LATIN CAPITAL LETTER L
+0x4D 0x004D #LATIN CAPITAL LETTER M
+0x4E 0x004E #LATIN CAPITAL LETTER N
+0x4F 0x004F #LATIN CAPITAL LETTER O
+0x50 0x0050 #LATIN CAPITAL LETTER P
+0x51 0x0051 #LATIN CAPITAL LETTER Q
+0x52 0x0052 #LATIN CAPITAL LETTER R
+0x53 0x0053 #LATIN CAPITAL LETTER S
+0x54 0x0054 #LATIN CAPITAL LETTER T
+0x55 0x0055 #LATIN CAPITAL LETTER U
+0x56 0x0056 #LATIN CAPITAL LETTER V
+0x57 0x0057 #LATIN CAPITAL LETTER W
+0x58 0x0058 #LATIN CAPITAL LETTER X
+0x59 0x0059 #LATIN CAPITAL LETTER Y
+0x5A 0x005A #LATIN CAPITAL LETTER Z
+0x5B 0x005B #LEFT SQUARE BRACKET
+0x5C 0x005C #REVERSE SOLIDUS
+0x5D 0x005D #RIGHT SQUARE BRACKET
+0x5E 0x005E #CIRCUMFLEX ACCENT
+0x5F 0x005F #LOW LINE
+0x60 0x0060 #GRAVE ACCENT
+0x61 0x0061 #LATIN SMALL LETTER A
+0x62 0x0062 #LATIN SMALL LETTER B
+0x63 0x0063 #LATIN SMALL LETTER C
+0x64 0x0064 #LATIN SMALL LETTER D
+0x65 0x0065 #LATIN SMALL LETTER E
+0x66 0x0066 #LATIN SMALL LETTER F
+0x67 0x0067 #LATIN SMALL LETTER G
+0x68 0x0068 #LATIN SMALL LETTER H
+0x69 0x0069 #LATIN SMALL LETTER I
+0x6A 0x006A #LATIN SMALL LETTER J
+0x6B 0x006B #LATIN SMALL LETTER K
+0x6C 0x006C #LATIN SMALL LETTER L
+0x6D 0x006D #LATIN SMALL LETTER M
+0x6E 0x006E #LATIN SMALL LETTER N
+0x6F 0x006F #LATIN SMALL LETTER O
+0x70 0x0070 #LATIN SMALL LETTER P
+0x71 0x0071 #LATIN SMALL LETTER Q
+0x72 0x0072 #LATIN SMALL LETTER R
+0x73 0x0073 #LATIN SMALL LETTER S
+0x74 0x0074 #LATIN SMALL LETTER T
+0x75 0x0075 #LATIN SMALL LETTER U
+0x76 0x0076 #LATIN SMALL LETTER V
+0x77 0x0077 #LATIN SMALL LETTER W
+0x78 0x0078 #LATIN SMALL LETTER X
+0x79 0x0079 #LATIN SMALL LETTER Y
+0x7A 0x007A #LATIN SMALL LETTER Z
+0x7B 0x007B #LEFT CURLY BRACKET
+0x7C 0x007C #VERTICAL LINE
+0x7D 0x007D #RIGHT CURLY BRACKET
+0x7E 0x007E #TILDE
+0x7F 0x007F #DELETE
+0x80 0x20AC #EURO SIGN
+0x81 #UNDEFINED
+0x82 0x201A #SINGLE LOW-9 QUOTATION MARK
+0x83 0x0192 #LATIN SMALL LETTER F WITH HOOK
+0x84 0x201E #DOUBLE LOW-9 QUOTATION MARK
+0x85 0x2026 #HORIZONTAL ELLIPSIS
+0x86 0x2020 #DAGGER
+0x87 0x2021 #DOUBLE DAGGER
+0x88 0x02C6 #MODIFIER LETTER CIRCUMFLEX ACCENT
+0x89 0x2030 #PER MILLE SIGN
+0x8A #UNDEFINED
+0x8B 0x2039 #SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+0x8C 0x0152 #LATIN CAPITAL LIGATURE OE
+0x8D #UNDEFINED
+0x8E #UNDEFINED
+0x8F #UNDEFINED
+0x90 #UNDEFINED
+0x91 0x2018 #LEFT SINGLE QUOTATION MARK
+0x92 0x2019 #RIGHT SINGLE QUOTATION MARK
+0x93 0x201C #LEFT DOUBLE QUOTATION MARK
+0x94 0x201D #RIGHT DOUBLE QUOTATION MARK
+0x95 0x2022 #BULLET
+0x96 0x2013 #EN DASH
+0x97 0x2014 #EM DASH
+0x98 0x02DC #SMALL TILDE
+0x99 0x2122 #TRADE MARK SIGN
+0x9A #UNDEFINED
+0x9B 0x203A #SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+0x9C 0x0153 #LATIN SMALL LIGATURE OE
+0x9D #UNDEFINED
+0x9E #UNDEFINED
+0x9F 0x0178 #LATIN CAPITAL LETTER Y WITH DIAERESIS
+0xA0 0x00A0 #NO-BREAK SPACE
+0xA1 0x00A1 #INVERTED EXCLAMATION MARK
+0xA2 0x00A2 #CENT SIGN
+0xA3 0x00A3 #POUND SIGN
+0xA4 0x00A4 #CURRENCY SIGN
+0xA5 0x00A5 #YEN SIGN
+0xA6 0x00A6 #BROKEN BAR
+0xA7 0x00A7 #SECTION SIGN
+0xA8 0x00A8 #DIAERESIS
+0xA9 0x00A9 #COPYRIGHT SIGN
+0xAA 0x00AA #FEMININE ORDINAL INDICATOR
+0xAB 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xAC 0x00AC #NOT SIGN
+0xAD 0x00AD #SOFT HYPHEN
+0xAE 0x00AE #REGISTERED SIGN
+0xAF 0x00AF #MACRON
+0xB0 0x00B0 #DEGREE SIGN
+0xB1 0x00B1 #PLUS-MINUS SIGN
+0xB2 0x00B2 #SUPERSCRIPT TWO
+0xB3 0x00B3 #SUPERSCRIPT THREE
+0xB4 0x00B4 #ACUTE ACCENT
+0xB5 0x00B5 #MICRO SIGN
+0xB6 0x00B6 #PILCROW SIGN
+0xB7 0x00B7 #MIDDLE DOT
+0xB8 0x00B8 #CEDILLA
+0xB9 0x00B9 #SUPERSCRIPT ONE
+0xBA 0x00BA #MASCULINE ORDINAL INDICATOR
+0xBB 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+0xBC 0x00BC #VULGAR FRACTION ONE QUARTER
+0xBD 0x00BD #VULGAR FRACTION ONE HALF
+0xBE 0x00BE #VULGAR FRACTION THREE QUARTERS
+0xBF 0x00BF #INVERTED QUESTION MARK
+0xC0 0x00C0 #LATIN CAPITAL LETTER A WITH GRAVE
+0xC1 0x00C1 #LATIN CAPITAL LETTER A WITH ACUTE
+0xC2 0x00C2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+0xC3 0x0102 #LATIN CAPITAL LETTER A WITH BREVE
+0xC4 0x00C4 #LATIN CAPITAL LETTER A WITH DIAERESIS
+0xC5 0x00C5 #LATIN CAPITAL LETTER A WITH RING ABOVE
+0xC6 0x00C6 #LATIN CAPITAL LETTER AE
+0xC7 0x00C7 #LATIN CAPITAL LETTER C WITH CEDILLA
+0xC8 0x00C8 #LATIN CAPITAL LETTER E WITH GRAVE
+0xC9 0x00C9 #LATIN CAPITAL LETTER E WITH ACUTE
+0xCA 0x00CA #LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+0xCB 0x00CB #LATIN CAPITAL LETTER E WITH DIAERESIS
+0xCC 0x0300 #COMBINING GRAVE ACCENT
+0xCD 0x00CD #LATIN CAPITAL LETTER I WITH ACUTE
+0xCE 0x00CE #LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+0xCF 0x00CF #LATIN CAPITAL LETTER I WITH DIAERESIS
+0xD0 0x0110 #LATIN CAPITAL LETTER D WITH STROKE
+0xD1 0x00D1 #LATIN CAPITAL LETTER N WITH TILDE
+0xD2 0x0309 #COMBINING HOOK ABOVE
+0xD3 0x00D3 #LATIN CAPITAL LETTER O WITH ACUTE
+0xD4 0x00D4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+0xD5 0x01A0 #LATIN CAPITAL LETTER O WITH HORN
+0xD6 0x00D6 #LATIN CAPITAL LETTER O WITH DIAERESIS
+0xD7 0x00D7 #MULTIPLICATION SIGN
+0xD8 0x00D8 #LATIN CAPITAL LETTER O WITH STROKE
+0xD9 0x00D9 #LATIN CAPITAL LETTER U WITH GRAVE
+0xDA 0x00DA #LATIN CAPITAL LETTER U WITH ACUTE
+0xDB 0x00DB #LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+0xDC 0x00DC #LATIN CAPITAL LETTER U WITH DIAERESIS
+0xDD 0x01AF #LATIN CAPITAL LETTER U WITH HORN
+0xDE 0x0303 #COMBINING TILDE
+0xDF 0x00DF #LATIN SMALL LETTER SHARP S
+0xE0 0x00E0 #LATIN SMALL LETTER A WITH GRAVE
+0xE1 0x00E1 #LATIN SMALL LETTER A WITH ACUTE
+0xE2 0x00E2 #LATIN SMALL LETTER A WITH CIRCUMFLEX
+0xE3 0x0103 #LATIN SMALL LETTER A WITH BREVE
+0xE4 0x00E4 #LATIN SMALL LETTER A WITH DIAERESIS
+0xE5 0x00E5 #LATIN SMALL LETTER A WITH RING ABOVE
+0xE6 0x00E6 #LATIN SMALL LETTER AE
+0xE7 0x00E7 #LATIN SMALL LETTER C WITH CEDILLA
+0xE8 0x00E8 #LATIN SMALL LETTER E WITH GRAVE
+0xE9 0x00E9 #LATIN SMALL LETTER E WITH ACUTE
+0xEA 0x00EA #LATIN SMALL LETTER E WITH CIRCUMFLEX
+0xEB 0x00EB #LATIN SMALL LETTER E WITH DIAERESIS
+0xEC 0x0301 #COMBINING ACUTE ACCENT
+0xED 0x00ED #LATIN SMALL LETTER I WITH ACUTE
+0xEE 0x00EE #LATIN SMALL LETTER I WITH CIRCUMFLEX
+0xEF 0x00EF #LATIN SMALL LETTER I WITH DIAERESIS
+0xF0 0x0111 #LATIN SMALL LETTER D WITH STROKE
+0xF1 0x00F1 #LATIN SMALL LETTER N WITH TILDE
+0xF2 0x0323 #COMBINING DOT BELOW
+0xF3 0x00F3 #LATIN SMALL LETTER O WITH ACUTE
+0xF4 0x00F4 #LATIN SMALL LETTER O WITH CIRCUMFLEX
+0xF5 0x01A1 #LATIN SMALL LETTER O WITH HORN
+0xF6 0x00F6 #LATIN SMALL LETTER O WITH DIAERESIS
+0xF7 0x00F7 #DIVISION SIGN
+0xF8 0x00F8 #LATIN SMALL LETTER O WITH STROKE
+0xF9 0x00F9 #LATIN SMALL LETTER U WITH GRAVE
+0xFA 0x00FA #LATIN SMALL LETTER U WITH ACUTE
+0xFB 0x00FB #LATIN SMALL LETTER U WITH CIRCUMFLEX
+0xFC 0x00FC #LATIN SMALL LETTER U WITH DIAERESIS
+0xFD 0x01B0 #LATIN SMALL LETTER U WITH HORN
+0xFE 0x20AB #DONG SIGN
+0xFF 0x00FF #LATIN SMALL LETTER Y WITH DIAERESIS
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.arabic
+
+HELP: latin/arabic
+{ $var-description "This is the ISO-8859-6 encoding, also called Latin/Arabic. It is an 8-bit superset of ASCII and provides the characters necessary for Arabic, though not other languages which use Arabic script." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.arabic" "Arabic encoding"
+"The " { $vocab-link "io.encodings.8-bit.arabic" } " vocabulary provides the " { $link latin/arabic } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.arabic"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.arabic
+
+8-BIT: latin/arabic ISO_8859-6:1987 8859-6
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.cyrillic
+
+HELP: latin/cyrillic
+{ $var-description "This is the ISO-8859-5 encoding, also called Latin/Cyrillic. It is an 8-bit superset of ASCII and provides the characters necessary for most languages which use Cyrilic, including Russian, Macedonian, Belarusian, Bulgarian, Serbian, and Ukrainian. KOI8-R is used much more commonly." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.cyrillic" "Cyrillic encoding"
+"The " { $vocab-link "io.encodings.8-bit.cyrillic" } " vocabulary provides the " { $link latin/cyrillic } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.cyrillic"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.cyrillic
+
+8-BIT: latin/cyrillic ISO_8859-5:1988 8859-5
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.ebcdic
+
+HELP: ebcdic
+{ $var-description "EBCDIC is an 8-bit legacy encoding designed for IBM mainframes like System/360 in the 1960s. It has since fallen into disuse. It contains large unallocated regions, and the version included here (code page 37) contains auxiliary characters in this region for English- and Portugese-speaking countries." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.ebcdic" "EBCDIC encoding"
+"The " { $vocab-link "io.encodings.8-bit.ebcdic" } " vocabulary provides the " { $link ebcdic } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.ebcdic"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.ebcdic
+
+8-BIT: ebcdic IBM037 CP037
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.greek
+
+HELP: latin/greek
+{ $description "This is the ISO-8859-7 encoding, also called Latin/Greek. It is an 8-bit superset of ASCII and provides the characters necessary for Greek written in modern monotonic orthography, or ancient Greek without accent marks." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.greek" "Greek encoding"
+"The " { $vocab-link "io.encodings.8-bit.greek" } " vocabulary provides the " { $link latin/greek } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.greek"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.greek
+
+8-BIT: latin/greek ISO_8859-7:1987 8859-7
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.hebrew
+
+HELP: latin/hebrew
+{ $var-description "This is the ISO-8859-8 encoding, also called Latin/Hebrew. It is an 8-bit superset of ASCII and provides the characters necessary for modern Hebrew without explicit vowels. Generally, this is interpreted in logical order, making it ISO-8859-8-I, technically." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.hebrew" "Hebrew encoding"
+"The " { $vocab-link "io.encodings.8-bit.hebrew" } " vocabulary provides the " { $link latin/hebrew } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.hebrew"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.hebrew
+
+8-BIT: latin/hebrew ISO_8859-8:1988 8859-8
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.koi8-r
+
+HELP: koi8-r
+{ $var-description "KOI8-R is an 8-bit superset of ASCII which encodes the Cyrillic alphabet, as used in Russian and Bulgarian. Characters are in such an order that, if the eight bit is stripped, text is still interpretable as ASCII. Block-building characters also exist." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.koi8-r" "KOI8-R encoding"
+"The " { $vocab-link "io.encodings.8-bit.koi8-r" } " vocabulary provides the " { $link koi8-r } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.koi8-r"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.koi8-r
+
+8-BIT: koi8-r KOI8-R KOI8-R
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.latin1
+
+HELP: latin1
+{ $var-description "This is the ISO-8859-1 encoding, also called Latin-1: Western European. It is an 8-bit superset of ASCII which is the default for a mimetype starting with 'text' and provides the characters necessary for most western European languages." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.latin1" "Latin1 encoding"
+"The " { $vocab-link "io.encodings.8-bit.latin1" } " vocabulary provides the " { $link latin1 } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.latin1"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.latin1
+
+8-BIT: latin1 ISO_8859-1:1987 8859-1
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.latin10
+
+HELP: latin10
+{ $var-description "This is the ISO-8859-16 encoding, also called Latin-10: South-Eastern European. It is an 8-bit superset of ASCII." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.latin10" "Latin10 encoding"
+"The " { $vocab-link "io.encodings.8-bit.latin10" } " vocabulary provides the " { $link latin10 } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.latin10"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.latin10
+
+8-BIT: latin10 ISO-8859-16 8859-16
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.latin2
+
+HELP: latin2
+{ $var-description "This is the ISO-8859-2 encoding, also called Latin-2: Eastern European. It is an 8-bit superset of ASCII and provides the characters necessary for most eastern European languages." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.latin2" "Latin2 encoding"
+"The " { $vocab-link "io.encodings.8-bit.latin2" } " vocabulary provides the " { $link latin2 } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.latin2"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.latin2
+
+8-BIT: latin2 ISO_8859-2:1987 8859-2
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.latin3
+
+HELP: latin3
+{ $var-description "This is the ISO-8859-3 encoding, also called Latin-3: South European. It is an 8-bit superset of ASCII and provides the characters necessary for Turkish, Maltese and Esperanto." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.latin3" "Latin3 encoding"
+"The " { $vocab-link "io.encodings.8-bit.latin3" } " vocabulary provides the " { $link latin3 } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.latin3"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.latin3
+
+8-BIT: latin3 ISO_8859-3:1988 8859-3
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.latin4
+
+HELP: latin4
+{ $description "This is the ISO-8859-4 encoding, also called Latin-4: North European. It is an 8-bit superset of ASCII and provides the characters necessary for Latvian, Lithuanian, Estonian, Greenlandic and Sami." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.latin4" "Latin4 encoding"
+"The " { $vocab-link "io.encodings.8-bit.latin4" } " vocabulary provides the " { $link latin4 } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.latin4"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.latin4
+
+8-BIT: latin4 ISO_8859-4:1988 8859-4
+
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.latin5
+
+HELP: latin5
+{ $var-description "This is the ISO-8859-9 encoding, also called Latin-5: Turkish. It is an 8-bit superset of ASCII and provides the characters necessary for Turkish, similar to Latin-1 but replacing the spots used for Icelandic with characters used in Turkish." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.latin5" "Latin5 encoding"
+"The " { $vocab-link "io.encodings.8-bit.latin5" } " vocabulary provides the " { $link latin5 } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.latin5"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.latin5
+
+8-BIT: latin5 ISO_8859-9:1989 8859-9
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.latin6
+
+HELP: latin6
+{ $var-description "This is the ISO-8859-10 encoding, also called Latin-6: Nordic. It is an 8-bit superset of ASCII containing the same characters as Latin-4, but rearranged to be of better use to nordic languages." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.latin6" "Latin6 encoding"
+"The " { $vocab-link "io.encodings.8-bit.latin6" } " vocabulary provides the " { $link latin6 } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.latin6"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.latin6
+
+8-BIT: latin6 ISO-8859-10 8859-10
+
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.latin7
+
+HELP: latin7
+{ $var-description "This is the ISO-8859-13 encoding, also called Latin-7: Baltic Rim. It is an 8-bit superset of ASCII containing all characters necessary to represent Baltic Rim languages, as previous character sets were incomplete." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.latin7" "Latin7 encoding"
+"The " { $vocab-link "io.encodings.8-bit.latin7" } " vocabulary provides the " { $link latin7 } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.latin7"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.latin7
+
+8-BIT: latin7 ISO-8859-13 8859-13
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.latin8
+
+HELP: latin8
+{ $var-description "This is the ISO-8859-14 encoding, also called Latin-8: Celtic. It is an 8-bit superset of ASCII designed for Celtic languages like Gaelic and Breton." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.latin8" "Latin8 encoding"
+"The " { $vocab-link "io.encodings.8-bit.latin8" } " vocabulary provides the " { $link latin8 } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.latin8"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.latin8
+
+8-BIT: latin8 ISO-8859-14 8859-14
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.latin9
+
+HELP: latin9
+{ $var-description "This is the ISO-8859-15 encoding, also called Latin-9 and unoffically as Latin-0. It is an 8-bit superset of ASCII designed as a modification of Latin-1, removing little-used characters in favor of the Euro symbol and other characters." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.latin9" "Latin9 encoding"
+"The " { $vocab-link "io.encodings.8-bit.latin9" } " vocabulary provides the " { $link latin9 } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.latin9"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.latin9
+
+8-BIT: latin9 ISO-8859-15 8859-15
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.mac-roman
+
+HELP: mac-roman
+{ $var-description "Mac Roman is an 8-bit superset of ASCII which was the standard encoding on Mac OS prior to version 10. It is incompatible with Latin-1 in all but a few places and ASCII, and it is suitable for encoding many Western European languages." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.mac-roman" "Mac Roman encoding"
+"The " { $vocab-link "io.encodings.8-bit.mac-roman" } " vocabulary provides the " { $link mac-roman } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.mac-roman"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.mac-roman
+
+8-BIT: mac-roman macintosh ROMAN
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.thai
+
+HELP: latin/thai
+{ $var-description "This is the ISO-8859-11 encoding, also called Latin/Thai. It is an 8-bit superset of ASCII containing the characters necessary to represent Thai. It is basically identical to TIS-620." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.thai" "Thai encoding"
+"The " { $vocab-link "io.encodings.8-bit.thai" } " vocabulary provides the " { $link latin/thai } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.thai"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.thai
+
+8-BIT: latin/thai TIS-620 8859-11
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.windows-1250
+
+8-BIT: windows-1250 windows-1250 CP1250
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.windows-1251
+
+8-BIT: windows-1251 windows-1251 CP1251
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax ;
+IN: io.encodings.8-bit.windows-1252
+
+HELP: windows-1252
+{ $var-description "Windows 1252 is an 8-bit superset of ASCII which is closely related to Latin-1. Control characters in the 0x80 to 0x9F range are replaced with printable characters such as the Euro symbol." }
+{ $see-also "encodings-introduction" } ;
+
+ARTICLE: "io.encodings.8-bit.windows-1252" "Windows 1252 encoding"
+"The " { $vocab-link "io.encodings.8-bit.windows-1252" } " vocabulary provides the " { $link windows-1252 } " encoding." ;
+
+ABOUT: "io.encodings.8-bit.windows-1252"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.windows-1252
+
+8-BIT: windows-1252 windows-1252 CP1252
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.windows-1253
+
+8-BIT: windows-1253 windows-1253 CP1253
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.windows-1254
+
+8-BIT: windows-1254 windows-1254 CP1254
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.windows-1255
+
+8-BIT: windows-1255 windows-1255 CP1255
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.windows-1256
+
+8-BIT: windows-1256 windows-1256 CP1256
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.windows-1257
+
+8-BIT: windows-1257 windows-1257 CP1257
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.8-bit ;
+IN: io.encodings.8-bit.windows-1258
+
+8-BIT: windows-1258 windows-1258 CP1258
ascii "ANSI_X3.4-1968" register-encoding
utf16be "UTF-16BE" register-encoding
utf16le "UTF-16LE" register-encoding
-utf16 "UTF-16" register-encoding
\ No newline at end of file
+utf16 "UTF-16" register-encoding
V{ } clone swap processes get set-at
wait-flag get-global raise-flag ;
-M: process hashcode* handle>> hashcode* ;
-
: pass-environment? ( process -- ? )
dup environment>> assoc-empty? not
swap environment-mode>> +replace-environment+ eq? or ;
+++ /dev/null
-Slava Pestov
+++ /dev/null
-USING: concurrency.combinators destructors fry
-io.sockets kernel logging ;
-IN: io.servers.packet
-
-<PRIVATE
-
-LOG: received-datagram NOTICE
-
-: datagram-loop ( quot datagram -- )
- [
- [ receive dup received-datagram [ swap call ] dip ] keep
- pick [ send ] [ 3drop ] if
- ] 2keep datagram-loop ; inline
-
-: spawn-datagrams ( quot addrspec -- )
- <datagram> [ datagram-loop ] with-disposal ; inline
-
-\ spawn-datagrams NOTICE add-input-logging
-
-PRIVATE>
-
-: with-datagrams ( seq service quot -- )
- '[ [ [ _ ] dip spawn-datagrams ] parallel-each ] with-logging ; inline
+++ /dev/null
-Multi-threaded UDP/IP servers
alien.strings libc continuations destructors summary splitting
assocs random math.parser locals unicode.case openssl
openssl.libcrypto openssl.libssl io.backend io.ports io.pathnames
-io.encodings.8-bit io.timeouts io.sockets.secure ;
+io.encodings.8-bit.latin1 io.timeouts io.sockets.secure ;
IN: io.sockets.secure.openssl
GENERIC: ssl-method ( symbol -- method )
USING: accessors continuations destructors io io.encodings
-io.encodings.8-bit io.encodings.ascii io.encodings.binary
+io.encodings.ascii io.encodings.binary
io.encodings.string io.encodings.utf8 io.files io.pipes
io.streams.byte-array io.streams.limited io.streams.string
-kernel namespaces strings tools.test system ;
+kernel namespaces strings tools.test system
+io.encodings.8-bit.latin1 ;
IN: io.streams.limited.tests
[ ] [
foldl
foldr
lmap>array
- traverse
} ;
ARTICLE: { "lists" "manipulation" } "Manipulating lists"
{ $values { "list" list } { "array" array } }
{ $description "Convert a list into an array." } ;
-HELP: traverse
-{ $values { "list" list } { "pred" { $quotation "( list/elt -- ? )" } }
- { "quot" { $quotation "( list/elt -- result)" } } { "result" "a new cons object" } }
-{ $description "Recursively traverses the list object, replacing any elements (which can themselves be sublists) that pred"
- " returns true for with the result of applying quot to." } ;
-
HELP: list
{ $class-description "The class of lists. All lists are expected to conform to " { $link { "lists" "protocol" } } "." } ;
: list>array ( list -- array )
[ ] lmap>array ;
-:: traverse ( list pred quot: ( list/elt -- result ) -- result )
- list [| elt |
- elt dup pred call [ quot call ] when
- dup list? [ pred quot traverse ] when
- ] lmap ; inline recursive
-
INSTANCE: cons list
INSTANCE: +nil+ list
eval( -- ) call
] [ error>> >r/r>-in-fry-error? ] must-fail-with
-:: (funny-macro-test) ( obj quot -- ? ) obj { quot } 1&& ; inline
+:: (funny-macro-test) ( obj quot -- ? ) obj { [ quot call ] } 1&& ; inline
: funny-macro-test ( n -- ? ) [ odd? ] (funny-macro-test) ;
\ funny-macro-test def>> must-infer
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser kernel sequences words effects combinators assocs
-definitions quotations namespaces memoize accessors ;
+definitions quotations namespaces memoize accessors
+compiler.units ;
IN: macros
<PRIVATE
M: macro reset-word
[ call-next-method ] [ f "macro" set-word-prop ] bi ;
+
+M: macro bump-effect-counter* drop t ;
M: blas-vector-base length
length>> ;
-M: blas-vector-base virtual-seq
+M: blas-vector-base virtual-exemplar
(blas-direct-array) ;
M: blas-vector-base virtual@
[ inc>> * ] [ nip (blas-direct-array) ] 2bi ;
[ [ underlying>> ] 2dip rep set-alien-vector ] >>setter
16 >>size
16 >>align
+ 16 >>align-first
rep >>rep
class c:typedef ;
] >>setter
32 >>size
16 >>align
+ 16 >>align-first
rep >>rep
class c:typedef ;
{
[ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ]
[ "print-checks" get [ [ . ] bi@ ] [ 2drop ] if ]
- [ [ call ] dip call ]
- [ [ call ] dip compile-call ]
+ [ [ [ call ] dip call ] call( quot quot -- result ) ]
+ [ [ [ call ] dip compile-call ] call( quot quot -- result ) ]
} 2cleave
@ not
] filter ; inline
] [ ] map-as
word '[ _ execute ] ;
-: check-boolean-ops ( class elt-class compare-quot -- )
+: check-boolean-ops ( class elt-class compare-quot -- seq )
[
[ boolean-ops [ dup word-schema ] { } map>assoc ] 2dip
'[ first2 inputs _ _ check-boolean-op ]
new [ drop 16 random ] map ;
:: test-shift-vector ( class -- ? )
- class random-int-vector :> src
- char-16 random-shift-vector :> perm
- { class char-16 } :> decl
-
- src perm vshuffle
- src perm [ decl declare vshuffle ] compile-call
- = ; inline
+ [
+ class random-int-vector :> src
+ char-16 random-shift-vector :> perm
+ { class char-16 } :> decl
+
+ src perm vshuffle
+ src perm [ decl declare vshuffle ] compile-call
+ =
+ ] call( -- ? ) ;
{ char-16 uchar-16 short-8 ushort-8 int-4 uint-4 longlong-2 ulonglong-2 }
[ 10 swap '[ [ t ] [ _ test-shift-vector ] unit-test ] times ] each
"== Checking vector tests" print
:: test-vector-tests-bool ( vector declaration -- none? any? all? )
- vector
- [ [ declaration declare vnone? ] compile-call ]
- [ [ declaration declare vany? ] compile-call ]
- [ [ declaration declare vall? ] compile-call ] tri ; inline
+ [
+ vector
+ [ [ declaration declare vnone? ] compile-call ]
+ [ [ declaration declare vany? ] compile-call ]
+ [ [ declaration declare vall? ] compile-call ] tri
+ ] call( -- none? any? all? ) ;
: yes ( -- x ) t ;
: no ( -- x ) f ;
:: test-vector-tests-branch ( vector declaration -- none? any? all? )
- vector
- [ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ]
- [ [ declaration declare vany? [ yes ] [ no ] if ] compile-call ]
- [ [ declaration declare vall? [ yes ] [ no ] if ] compile-call ] tri ; inline
+ [
+ vector
+ [ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ]
+ [ [ declaration declare vany? [ yes ] [ no ] if ] compile-call ]
+ [ [ declaration declare vall? [ yes ] [ no ] if ] compile-call ] tri
+ ] call( -- none? any? all? ) ;
TUPLE: inconsistent-vector-test bool branch ;
2dup = [ drop ] [ inconsistent-vector-test boa ] if ;
:: test-vector-tests ( vector decl -- none? any? all? )
- vector decl test-vector-tests-bool :> ( bool-none bool-any bool-all )
- vector decl test-vector-tests-branch :> ( branch-none branch-any branch-all )
-
- bool-none branch-none ?inconsistent
- bool-any branch-any ?inconsistent
- bool-all branch-all ?inconsistent ; inline
+ [
+ vector decl test-vector-tests-bool :> ( bool-none bool-any bool-all )
+ vector decl test-vector-tests-branch :> ( branch-none branch-any branch-all )
+
+ bool-none branch-none ?inconsistent
+ bool-any branch-any ?inconsistent
+ bool-all branch-all ?inconsistent
+ ] call( -- none? any? all? ) ;
[ f t t ]
[ float-4{ t t t t } { float-4 } test-vector-tests ] unit-test
"== Checking broadcast" print
: test-broadcast ( seq -- failures )
[ length >array ] keep
- '[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ; inline
+ '[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ;
[ { } ] [ float-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test
[ { } ] [ int-4{ HEX: 7fffffff 3 4 -8 } test-broadcast ] unit-test
+++ /dev/null
-Sam Anklesaria
\ No newline at end of file
+++ /dev/null
-USING: accessors models models.arrow inverse kernel ;
-IN: models.illusion
-
-TUPLE: illusion < arrow ;
-
-: <illusion> ( model quot -- illusion )
- illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref
- swap >>quot over >>model [ add-dependency ] keep ;
-
-: <activated-illusion> ( model quot -- illusion ) <illusion> dup activate-model ;
-
-: backtalk ( value object -- )
- [ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ;
-
-M: illusion update-model ( model -- ) [ [ value>> ] keep backtalk ] with-locked-model ;
\ No newline at end of file
+++ /dev/null
-Two Way Arrows
\ No newline at end of file
: <model> ( value -- model )
model new-model ;
-M: model hashcode* drop model hashcode* ;
-
: add-dependency ( dep model -- )
dependencies>> push ;
--- /dev/null
+USING: tools.test math opengl opengl.gl ;
+IN: opengl.tests
+
+{ 2 1 } [ { GL_TEXTURE_2D } [ + ] all-enabled ] must-infer-as
+
+{ 2 1 } [ { GL_TEXTURE_2D } [ + ] all-enabled-client-state ] must-infer-as
[ ?execute ] map ;
: (all-enabled) ( seq quot -- )
- over [ glEnable ] each dip [ glDisable ] each ; inline
+ [ dup [ glEnable ] each ] dip
+ dip
+ [ glDisable ] each ; inline
: (all-enabled-client-state) ( seq quot -- )
[ dup [ glEnableClientState ] each ] dip
: check-recursion ( obj quot -- )
nesting-limit? [
drop
- "~" over class name>> "~" 3append
- swap present-text
+ [ class name>> "~" dup surround ] keep present-text
] [
over recursion-check get member-eq? [
drop "~circularity~" swap present-text
: pprint-elements ( seq -- )
do-length-limit
[ [ pprint* ] each ] dip
- [ "~" swap number>string " more~" 3append text ] when* ;
+ [ number>string "~" " more~" surround text ] when* ;
M: quotation pprint-delims drop \ [ \ ] ;
M: curry pprint-delims drop \ [ \ ] ;
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test quoted-printable io.encodings.string
-sequences io.encodings.8-bit splitting kernel ;
+sequences splitting kernel io.encodings.8-bit.latin2 ;
IN: quoted-printable.tests
[ """José was the
HELP: <merged> ( seqs -- merged )
{ $values { "seqs" "a sequence of sequences to merge" } { "merged" "a virtual sequence" } }
-{ $description "Creates an instance of the " { $link merged } " virtual sequence." }
+{ $description "Creates an instance of the " { $link merged } " virtual sequence. The length of the created virtual sequences is the minimum length of the input sequences times the number of input sequences." }
{ $see-also <2merged> <3merged> merge } ;
HELP: <2merged> ( seq1 seq2 -- merged )
[ 6 ] [ 5 { 1 2 3 } { 4 5 6 } <2merged> nth ] unit-test
[ 4 ] [ 4 { 1 2 } { 3 4 } { 5 6 } 3merge nth ] unit-test
+
+[ "" ] [ "abcdefg" "" 2merge ] unit-test
+[ "a1b2" ] [ "abc" "12" <2merged> "" like ] unit-test
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel math sequences ;
+USING: accessors arrays kernel math math.order sequences
+sequences.private ;
IN: sequences.merged
TUPLE: merged seqs ;
: <3merged> ( seq1 seq2 seq3 -- merged ) 3array <merged> ;
: merge ( seqs -- seq )
- dup <merged> swap first like ;
+ [ <merged> ] keep first like ;
: 2merge ( seq1 seq2 -- seq )
- dupd <2merged> swap like ;
+ [ <2merged> ] 2keep drop like ;
: 3merge ( seq1 seq2 seq3 -- seq )
- pick [ <3merged> ] dip like ;
+ [ <3merged> ] 3keep 2drop like ;
-M: merged length seqs>> [ length ] map sum ;
+M: merged length
+ seqs>> [ [ length ] [ min ] map-reduce ] [ length ] bi * ; inline
M: merged virtual@ ( n seq -- n' seq' )
- seqs>> [ length /mod ] [ nth ] bi ;
+ seqs>> [ length /mod ] [ nth-unsafe ] bi ; inline
-M: merged virtual-seq ( merged -- seq ) [ ] { } map-as ;
+M: merged virtual-exemplar ( merged -- seq )
+ seqs>> [ f ] [ first ] if-empty ; inline
INSTANCE: merged virtual-sequence
C: <id> id
-M: id hashcode* obj>> hashcode* ;
+M: id hashcode* nip obj>> identity-hashcode ;
M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ;
pop-literal nip >>abi
pop-literal nip >>parameters
pop-literal nip >>return
- "( callback )" f <word> >>xt
+ "( callback )" <uninterned-word> >>xt
dup callback-bottom
#alien-callback, ;
USING: stack-checker.backend tools.test kernel namespaces
-stack-checker.state sequences ;
+stack-checker.state stack-checker.values sequences assocs ;
IN: stack-checker.backend.tests
[ ] [
V{ } clone \ meta-d set
V{ } clone \ meta-r set
V{ } clone \ literals set
- 0 d-in set
+ H{ } clone known-values set
+ 0 input-count set
] unit-test
[ 0 ] [ 0 ensure-d length ] unit-test
[ 2 ] [ 2 ensure-d length ] unit-test
+
+[ t ] [ meta-d [ known-values get at input-parameter? ] all? ] unit-test
+
[ 2 ] [ meta-d length ] unit-test
[ 3 ] [ 3 ensure-d length ] unit-test
continuations assocs combinators compiler.errors accessors math.order
definitions sets hints macros stack-checker.state
stack-checker.visitor stack-checker.errors stack-checker.values
-stack-checker.recursive-state summary ;
+stack-checker.recursive-state stack-checker.dependencies summary ;
IN: stack-checker.backend
: push-d ( obj -- ) meta-d push ;
+: introduce-values ( values -- )
+ [ [ [ input-parameter ] dip set-known ] each ]
+ [ length input-count +@ ]
+ [ #introduce, ]
+ tri ;
+
: pop-d ( -- obj )
- meta-d [
- <value> dup 1array #introduce, d-in inc
- ] [ pop ] if-empty ;
+ meta-d [ <value> dup 1array introduce-values ] [ pop ] if-empty ;
: peek-d ( -- obj ) pop-d dup push-d ;
meta-d 2dup length > [
2dup
[ nip >array ] [ length - make-values ] [ nip delete-all ] 2tri
- [ length d-in +@ ] [ #introduce, ] [ meta-d push-all ] tri
+ [ introduce-values ] [ meta-d push-all ] bi
meta-d push-all
] when swap tail* ;
SYMBOLS: +bottom+ +top+ ;
-: unify-inputs ( max-d-in d-in meta-d -- new-meta-d )
+: unify-inputs ( max-input-count input-count meta-d -- new-meta-d )
! Introduced values can be anything, and don't unify with
! literals.
dup [ [ - +top+ <repetition> ] dip append ] [ 3drop f ] if ;
'[ _ +bottom+ pad-head ] map
] unless ;
-: phi-inputs ( max-d-in pairs -- newseq )
+: phi-inputs ( max-input-count pairs -- newseq )
dup empty? [ nip ] [
swap '[ [ _ ] dip first2 unify-inputs ] map
pad-with-bottom
branch-variable ;
: datastack-phi ( seq -- phi-in phi-out )
- [ d-in branch-variable ] [ \ meta-d active-variable ] bi
+ [ input-count branch-variable ] [ \ meta-d active-variable ] bi
unify-branches
- [ d-in set ] [ ] [ dup >vector \ meta-d set ] tri* ;
+ [ input-count set ] [ ] [ dup >vector \ meta-d set ] tri* ;
: terminated-phi ( seq -- terminated )
terminated? branch-variable ;
: copy-inference ( -- )
\ meta-d [ clone ] change
literals [ clone ] change
- d-in [ ] change ;
+ input-count [ ] change ;
GENERIC: infer-branch ( literal -- namespace )
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+IN: stack-checker.dependencies.tests
+USING: tools.test stack-checker.dependencies words kernel namespaces
+definitions ;
+
+: computing-dependencies ( quot -- dependencies )
+ H{ } clone [ dependencies rot with-variable ] keep ;
+ inline
+
+SYMBOL: a
+SYMBOL: b
+
+[ ] [ a called-dependency depends-on ] unit-test
+
+[ H{ { a called-dependency } } ] [
+ [ a called-dependency depends-on ] computing-dependencies
+] unit-test
+
+[ H{ { a called-dependency } { b inlined-dependency } } ] [
+ [
+ a called-dependency depends-on b inlined-dependency depends-on
+ ] computing-dependencies
+] unit-test
+
+[ H{ { a inlined-dependency } { b inlined-dependency } } ] [
+ [
+ a inlined-dependency depends-on
+ a called-dependency depends-on
+ b inlined-dependency depends-on
+ ] computing-dependencies
+] unit-test
+
+[ flushed-dependency ] [ f flushed-dependency strongest-dependency ] unit-test
+[ flushed-dependency ] [ flushed-dependency f strongest-dependency ] unit-test
+[ inlined-dependency ] [ flushed-dependency inlined-dependency strongest-dependency ] unit-test
+[ inlined-dependency ] [ called-dependency inlined-dependency strongest-dependency ] unit-test
+[ flushed-dependency ] [ called-dependency flushed-dependency strongest-dependency ] unit-test
+[ called-dependency ] [ called-dependency f strongest-dependency ] unit-test
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs classes.algebra fry kernel math namespaces
+sequences words ;
+IN: stack-checker.dependencies
+
+! Words that the current quotation depends on
+SYMBOL: dependencies
+
+SYMBOLS: inlined-dependency flushed-dependency called-dependency ;
+
+: index>= ( obj1 obj2 seq -- ? )
+ [ index ] curry bi@ >= ;
+
+: dependency>= ( how1 how2 -- ? )
+ { called-dependency flushed-dependency inlined-dependency }
+ index>= ;
+
+: strongest-dependency ( how1 how2 -- how )
+ [ called-dependency or ] bi@ [ dependency>= ] most ;
+
+: depends-on ( word how -- )
+ over primitive? [ 2drop ] [
+ dependencies get dup [
+ swap '[ _ strongest-dependency ] change-at
+ ] [ 3drop ] if
+ ] if ;
+
+! Generic words that the current quotation depends on
+SYMBOL: generic-dependencies
+
+: ?class-or ( class/f class -- class' )
+ swap [ class-or ] when* ;
+
+: depends-on-generic ( generic class -- )
+ generic-dependencies get dup
+ [ swap '[ _ ?class-or ] change-at ] [ 3drop ] if ;
}
} ;
-HELP: literal-expected
-{ $error-description "Thrown when inference encounters a combinator or macro being applied to a value which is not known to be a literal, or constructed in a manner which can be analyzed statically. Such code needs changes before it can compile and run. See " { $link "inference-combinators" } " and " { $link "inference-escape" } " for details." }
+HELP: unknown-macro-input
+{ $error-description "Thrown when inference encounters a combinator or macro being applied to an input parameter of a non-" { $link POSTPONE: inline } " word. The word needs to be declared " { $link POSTPONE: inline } " before its callers can compile and run. See " { $link "inference-combinators" } " and " { $link "inference-escape" } " for details." }
{ $examples
- "In this example, the words being defined cannot be called, because they fail to compile with a " { $link literal-expected } " error:"
+ "In this example, the words being defined cannot be called, because they fail to compile with a " { $link unknown-macro-input } " error:"
{ $code
": bad-example ( quot -- )"
" [ call ] [ call ] bi ;"
}
} ;
+HELP: bad-macro-input
+{ $error-description "Thrown when inference encounters a combinator or macro being applied to a value which is not known at compile time. Such code needs changes before it can compile and run. See " { $link "inference-combinators" } " and " { $link "inference-escape" } " for details." }
+{ $examples
+ "In this example, the words being defined cannot be called, because they fail to compile with a " { $link bad-macro-input } " error:"
+ { $code
+ ": bad-example ( quot -- )"
+ " [ . ] append call ; inline"
+ ""
+ ": usage ( -- )"
+ " 2 2 [ + ] bad-example ;"
+ }
+ "One fix is to use " { $link compose } " instead of " { $link append } ":"
+ { $code
+ ": good-example ( quot -- )"
+ " [ . ] compose call ; inline"
+ ""
+ ": usage ( -- )"
+ " 2 2 [ + ] good-example ;"
+ }
+} ;
+
HELP: unbalanced-branches-error
{ $values { "in" "a sequence of integers" } { "out" "a sequence of integers" } }
{ $description "Throws an " { $link unbalanced-branches-error } "." }
"Errors thrown when insufficient information is available to calculate the stack effect of a call to a combinator or macro (see " { $link "inference-combinators" } "):"
{ $subsections
do-not-compile
- literal-expected
+ unknown-macro-input
+ bad-macro-input
}
"Error thrown when a word's stack effect declaration does not match the composition of the stack effects of its factors:"
{ $subsections effect-error }
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel stack-checker.values ;
IN: stack-checker.errors
TUPLE: inference-error ;
ERROR: do-not-compile < inference-error word ;
-ERROR: literal-expected < inference-error what ;
+ERROR: bad-macro-input < inference-error macro ;
+
+ERROR: unknown-macro-input < inference-error macro ;
ERROR: unbalanced-branches-error < inference-error branches quots ;
ERROR: unknown-primitive-error < inference-error ;
-ERROR: transform-expansion-error < inference-error word error ;
-
-ERROR: bad-declaration-error < inference-error declaration ;
+ERROR: transform-expansion-error < inference-error error continuation word ;
-M: object (literal) "literal value" literal-expected ;
\ No newline at end of file
+ERROR: bad-declaration-error < inference-error declaration ;
\ No newline at end of file
sequences assocs stack-checker.errors summary effects ;
IN: stack-checker.errors.prettyprint
-M: literal-expected summary
- what>> "Got a computed value where a " " was expected" surround ;
+M: unknown-macro-input summary
+ macro>> name>> "Cannot apply “" "” to an input parameter of a non-inline word" surround ;
-M: literal-expected error. summary print ;
+M: bad-macro-input summary
+ macro>> name>> "Cannot apply “" "” to a run-time computed value" surround ;
M: unbalanced-branches-error summary
drop "Unbalanced branches" ;
word>> name>> "Macro expansion of " " threw an error" surround ;
M: transform-expansion-error error.
- [ summary print ] [ error>> error. ] bi ;
+ [ summary print ]
+ [ nl "The error was:" print error>> error. nl ]
+ [ continuation>> traceback-link. ]
+ tri ;
M: do-not-compile summary
word>> name>> "Cannot compile call to " prepend ;
\ No newline at end of file
stack-checker.backend
stack-checker.branches
stack-checker.known-words
+stack-checker.dependencies
stack-checker.recursive-state ;
IN: stack-checker.inlining
introductions
loop? ;
-M: inline-recursive hashcode* id>> hashcode* ;
-
: inlined-block? ( word -- ? ) "inlined-block" word-prop ;
: <inline-recursive> ( word -- label )
bi ;
: recursive-word-inputs ( label -- n )
- entry-stack-height d-in get + ;
+ entry-stack-height input-count get + ;
: (inline-recursive-word) ( word -- label in out visitor terminated? )
dup prepare-stack
stack-checker.backend
stack-checker.branches
stack-checker.transforms
+stack-checker.dependencies
stack-checker.recursive-state ;
IN: stack-checker.known-words
1 infer->r infer-call
terminated? get [ 1 infer-r> infer-call ] unless ;
-M: object infer-call*
- "literal quotation" literal-expected ;
+M: input-parameter infer-call* \ call unknown-macro-input ;
+M: object infer-call* \ call bad-macro-input ;
: infer-ndip ( word n -- )
[ literals get ] 2dip
\ alien-callback [ infer-alien-callback ] "special" set-word-prop
: infer-special ( word -- )
- "special" word-prop call( -- ) ;
+ [ current-word set ] [ "special" word-prop call( -- ) ] bi ;
: infer-local-reader ( word -- )
(( -- value )) apply-word/effect ;
\ disable-gc-events { } { object } define-primitive
\ profiling { object } { } define-primitive
+
+\ (identity-hashcode) { object } { fixnum } define-primitive
+
+\ compute-identity-hashcode { object } { } define-primitive
{ "The combinator must be called with a quotation that is either literal or built from literal quotations, " { $link curry } ", and " { $link compose } ". (Note that quotations that use " { $vocab-link "fry" } " or " { $vocab-link "locals" } " use " { $link curry } " and " { $link compose } " from the perspective of the stack checker.)" }
{ "If the word is declared " { $link POSTPONE: inline } ", the combinator may additionally be called on one of the word's input parameters or with quotations built from the word's input parameters, literal quotations, " { $link curry } ", and " { $link compose } ". When inline, a word is itself considered to be a combinator, and its callers must in turn satisfy these conditions." }
}
-"If neither condition holds, the stack checker throws a " { $link literal-expected } " error. To make the code compile, a runtime checking combinator such as " { $link POSTPONE: call( } " must be used instead. See " { $link "inference-escape" } " for details. An inline combinator can be called with an unknown quotation by " { $link curry } "ing the quotation onto a literal quotation that uses " { $link POSTPONE: call( } "."
+"If neither condition holds, the stack checker throws a " { $link unknown-macro-input } " or " { $link bad-macro-input } " error. To make the code compile, a runtime checking combinator such as " { $link POSTPONE: call( } " must be used instead. See " { $link "inference-escape" } " for details. An inline combinator can be called with an unknown quotation by " { $link curry } "ing the quotation onto a literal quotation that uses " { $link POSTPONE: call( } "."
{ $heading "Examples" }
{ $subheading "Calling a combinator" }
"The following usage of " { $link map } " passes the stack checker, because the quotation is the result of " { $link curry } ":"
"However this fails to pass the stack checker since there is no guarantee the quotation has the right stack effect for " { $link map } ". It can be wrapped in a new quotation with a declaration:"
{ $code ": perform ( values action -- results )" " quot>> [ call( value -- result ) ] curry map ;" }
{ $heading "Explanation" }
-"This restriction exists because without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the stack checker encounters a " { $link call } " without further information, a " { $link literal-expected } " error is raised."
+"This restriction exists because without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the stack checker encounters a " { $link call } " without further information, a " { $link unknown-macro-input } " or " { $link bad-macro-input } " error is raised."
$nl
"On the other hand, the stack effect of applying " { $link call } " to a literal quotation or a " { $link curry } " of a literal quotation is easy to compute; it behaves as if the quotation was substituted at that point."
{ $heading "Limitations" }
"The stack checker cannot guarantee that a literal quotation is still literal if it is passed on the data stack to an inlined recursive combinator such as " { $link each } " or " { $link map } ". For example, the following will not infer:"
{ $example
- "[ [ reverse ] swap [ reverse ] map swap call ] infer." "Got a computed value where a literal quotation was expected"
+ "[ [ reverse ] swap [ reverse ] map swap call ] infer." "Cannot apply “call” to a run-time computed value\nmacro call"
}
"To make this work, use " { $link dip } " to pass the quotation instead:"
{ $example
"Combinators which are recursive require additional care. In addition to being declared " { $link POSTPONE: inline } ", they must be declared " { $link POSTPONE: recursive } ". There are three restrictions that only apply to combinators with this declaration:"
{ $heading "Input quotation declaration" }
"Input parameters which are quotations must be annotated as much in the stack effect. For example, the following will not infer:"
-{ $example ": bad ( quot -- ) [ call ] keep bad ; inline recursive" "[ [ ] bad ] infer." "Got a computed value where a literal quotation was expected" }
+{ $unchecked-example ": bad ( quot -- ) [ call ] keep bad ; inline recursive" "[ [ ] bad ] infer." "Cannot apply “call” to a run-time computed value\nmacro call" }
"The following is correct:"
{ $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" }
"The effect of the nested quotation itself is only present for documentation purposes; the mere presence of a nested effect is sufficient to mark that value as a quotation parameter."
"The stack checker does not trace data flow in two instances."
$nl
"An inline recursive word cannot pass a quotation on the data stack through the recursive call. For example, the following will not infer:"
-{ $example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Got a computed value where a literal quotation was expected" }
+{ $unchecked-example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Cannot apply “call” to a run-time computed value\nmacro call" }
"However a small change can be made:"
{ $example ": good ( ? quot: ( ? -- ) -- ) [ good ] 2keep [ not ] dip call ; inline recursive" "[ [ drop ] good ] infer." "( object -- )" }
"An inline recursive word must have a fixed stack effect in its base case. The following will not infer:"
{ 1 2 } [ dup ] must-infer-as
{ 1 2 } [ [ dup ] call ] must-infer-as
-[ [ call ] infer ] must-fail
+[ [ call ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
+[ [ curry call ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
+[ [ { } >quotation call ] infer ] [ T{ bad-macro-input f call } = ] must-fail-with
+[ [ append curry call ] infer ] [ T{ bad-macro-input f call } = ] must-fail-with
{ 2 4 } [ 2dup ] must-infer-as
{ 1 0 } [ [ ] [ ] if ] must-infer-as
-[ [ if ] infer ] must-fail
-[ [ [ ] if ] infer ] must-fail
-[ [ [ 2 ] [ ] if ] infer ] must-fail
+[ [ if ] infer ] [ T{ unknown-macro-input f if } = ] must-fail-with
+[ [ { } >quotation { } >quotation if ] infer ] [ T{ bad-macro-input f if } = ] must-fail-with
+[ [ [ ] if ] infer ] [ T{ unknown-macro-input f if } = ] must-fail-with
+[ [ [ 2 ] [ ] if ] infer ] [ unbalanced-branches-error? ] must-fail-with
{ 4 3 } [ [ rot ] [ -rot ] if ] must-infer-as
{ 4 3 } [
[
[ [ [ 2 2 fixnum+ ] ] [ [ 2 2 fixnum* ] ] if call ] infer
-] must-fail
+] [ T{ bad-macro-input f call } = ] must-fail-with
! Test inference of termination of control flow
: termination-test-1 ( -- * ) "foo" throw ;
! This used to hang
[ [ [ dup call ] dup call ] infer ]
-[ inference-error? ] must-fail-with
+[ recursive-quotation-error? ] must-fail-with
: m ( q -- ) dup call ; inline
-[ [ [ m ] m ] infer ] [ inference-error? ] must-fail-with
+[ [ [ m ] m ] infer ] [ recursive-quotation-error? ] must-fail-with
: m' ( quot -- ) dup curry call ; inline
-[ [ [ m' ] m' ] infer ] [ inference-error? ] must-fail-with
+[ [ [ m' ] m' ] infer ] [ recursive-quotation-error? ] must-fail-with
: m'' ( -- q ) [ dup curry ] ; inline
: m''' ( -- ) m'' call call ; inline
-[ [ [ m''' ] m''' ] infer ] [ inference-error? ] must-fail-with
+[ [ [ m''' ] m''' ] infer ] [ recursive-quotation-error? ] must-fail-with
-: m-if ( a b c -- ) t over if ; inline
+: m-if ( a b c -- ) t over when ; inline
-[ [ [ m-if ] m-if ] infer ] [ inference-error? ] must-fail-with
+[ [ [ m-if ] m-if ] infer ] [ recursive-quotation-error? ] must-fail-with
! This doesn't hang but it's also an example of the
! undedicable case
[ [ [ [ drop 3 ] swap call ] dup call ] infer ]
-[ inference-error? ] must-fail-with
+[ recursive-quotation-error? ] must-fail-with
-[ [ 1 drop-locals ] infer ] [ inference-error? ] must-fail-with
+[ [ 1 drop-locals ] infer ] [ too-many-r>? ] must-fail-with
! Regression
-[ [ cleave ] infer ] [ inference-error? ] must-fail-with
+[ [ cleave ] infer ] [ T{ unknown-macro-input f cleave } = ] must-fail-with
! Test some curry stuff
{ 1 1 } [ 3 [ ] curry 4 [ ] curry if ] must-infer-as
{ 2 1 } [ [ ] curry 4 [ ] curry if ] must-infer-as
-[ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] must-fail
+[ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] [ unbalanced-branches-error? ] must-fail-with
{ 1 3 } [ [ 2drop f ] assoc-find ] must-infer-as
] unit-test
! Regression
-[ [ 1 load-locals ] infer ] must-fail
+[ [ 1 load-locals ] infer ] [ too-many->r? ] must-fail-with
! Corner case
[ [ [ f dup ] [ dup ] produce ] infer ] must-fail
dup bad-recursion-6 call ; inline recursive
[ [ [ drop f ] bad-recursion-6 ] infer ] must-fail
+[ ] [ [ \ bad-recursion-6 forget ] with-compilation-unit ] unit-test
+
{ 3 0 } [ [ 2drop "A" throw ] [ ] if 2drop ] must-infer-as
{ 2 0 } [ drop f f [ 2drop "A" throw ] [ ] if 2drop ] must-infer-as
[ [ eee' ] infer ] [ inference-error? ] must-fail-with
+[ ] [ [ \ ddd' forget ] with-compilation-unit ] unit-test
+[ ] [ [ \ eee' forget ] with-compilation-unit ] unit-test
+
: bogus-error ( x -- )
dup "A" throw [ bogus-error ] [ drop ] if ; inline recursive
[ ] [ [ \ forget-test forget ] with-compilation-unit ] unit-test
[ forget-test ] must-infer
-[ [ cond ] infer ] must-fail
-[ [ bi ] infer ] must-fail
-[ at ] must-infer
+[ [ cond ] infer ] [ T{ unknown-macro-input f cond } = ] must-fail-with
+[ [ bi ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
+[ [ each ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
[ [ [ "OOPS" throw ] dip ] [ drop ] if ] must-infer
{ 3 1 } [ call( a b -- c ) ] must-infer-as
{ 3 1 } [ execute( a b -- c ) ] must-infer-as
-[ [ call-effect ] infer ] must-fail
-[ [ execute-effect ] infer ] must-fail
+[ [ call-effect ] infer ] [ T{ unknown-macro-input f call-effect } = ] must-fail-with
+[ [ execute-effect ] infer ] [ T{ unknown-macro-input f execute-effect } = ] must-fail-with
+++ /dev/null
-IN: stack-checker.state.tests
-USING: tools.test stack-checker.state words kernel namespaces
-definitions ;
-
-: computing-dependencies ( quot -- dependencies )
- H{ } clone [ dependencies rot with-variable ] keep ;
- inline
-
-SYMBOL: a
-SYMBOL: b
-
-[ ] [ a called-dependency depends-on ] unit-test
-
-[ H{ { a called-dependency } } ] [
- [ a called-dependency depends-on ] computing-dependencies
-] unit-test
-
-[ H{ { a called-dependency } { b inlined-dependency } } ] [
- [
- a called-dependency depends-on b inlined-dependency depends-on
- ] computing-dependencies
-] unit-test
-
-[ H{ { a inlined-dependency } { b inlined-dependency } } ] [
- [
- a inlined-dependency depends-on
- a called-dependency depends-on
- b inlined-dependency depends-on
- ] computing-dependencies
-] unit-test
-
-[ flushed-dependency ] [ f flushed-dependency strongest-dependency ] unit-test
-[ flushed-dependency ] [ flushed-dependency f strongest-dependency ] unit-test
-[ inlined-dependency ] [ flushed-dependency inlined-dependency strongest-dependency ] unit-test
-[ inlined-dependency ] [ called-dependency inlined-dependency strongest-dependency ] unit-test
-[ flushed-dependency ] [ called-dependency flushed-dependency strongest-dependency ] unit-test
-[ called-dependency ] [ called-dependency f strongest-dependency ] unit-test
-
! See http://factorcode.org/license.txt for BSD license.
USING: assocs arrays namespaces sequences kernel definitions
math effects accessors words fry classes.algebra
-compiler.units stack-checker.values stack-checker.visitor ;
+compiler.units stack-checker.values stack-checker.visitor
+stack-checker.errors ;
IN: stack-checker.state
! Did the current control-flow path throw an error?
SYMBOL: terminated?
! Number of inputs current word expects from the stack
-SYMBOL: d-in
+SYMBOL: input-count
DEFER: commit-literals
[ [ (push-literal) ] each ] [ delete-all ] bi
] unless-empty ;
-: current-stack-height ( -- n ) meta-d length d-in get - ;
+: current-stack-height ( -- n ) meta-d length input-count get - ;
: current-effect ( -- effect )
- d-in get meta-d length terminated? get effect boa ;
+ input-count get meta-d length terminated? get effect boa ;
: init-inference ( -- )
terminated? off
V{ } clone \ meta-d set
V{ } clone literals set
- 0 d-in set ;
-
-! Words that the current quotation depends on
-SYMBOL: dependencies
-
-SYMBOLS: inlined-dependency flushed-dependency called-dependency ;
-
-: index>= ( obj1 obj2 seq -- ? )
- [ index ] curry bi@ >= ;
-
-: dependency>= ( how1 how2 -- ? )
- { called-dependency flushed-dependency inlined-dependency }
- index>= ;
-
-: strongest-dependency ( how1 how2 -- how )
- [ called-dependency or ] bi@ [ dependency>= ] most ;
-
-: depends-on ( word how -- )
- over primitive? [ 2drop ] [
- dependencies get dup [
- swap '[ _ strongest-dependency ] change-at
- ] [ 3drop ] if
- ] if ;
-
-! Generic words that the current quotation depends on
-SYMBOL: generic-dependencies
-
-: ?class-or ( class/f class -- class' )
- swap [ class-or ] when* ;
-
-: depends-on-generic ( generic class -- )
- generic-dependencies get dup
- [ swap '[ _ ?class-or ] change-at ] [ 3drop ] if ;
+ 0 input-count set ;
IN: stack-checker.transforms.tests
USING: sequences stack-checker.transforms tools.test math kernel
-quotations stack-checker stack-checker.errors accessors combinators words arrays
-classes classes.tuple ;
+quotations stack-checker stack-checker.errors accessors
+combinators words arrays classes classes.tuple macros ;
-: compose-n ( quot n -- ) "OOPS" throw ;
-
-<<
-: compose-n-quot ( n word -- quot' ) <repetition> >quotation ;
-\ compose-n [ compose-n-quot ] 2 define-transform
-\ compose-n t "no-compile" set-word-prop
->>
+MACRO: compose-n ( n word -- quot' ) <repetition> >quotation ;
: compose-n-test ( a b c -- x ) 2 \ + compose-n ;
[ [ [ "a" "b" ] very-smart-combo "c" ] very-smart-combo ] must-infer
! Caveat found by Doug
-DEFER: curry-folding-test ( quot -- )
-
-\ curry-folding-test [ length \ drop <repetition> >quotation ] 1 define-transform
+MACRO: curry-folding-test ( quot -- )
+ length \ drop <repetition> >quotation ;
{ 3 0 } [ [ 1 2 3 ] curry-folding-test ] must-infer-as
{ 3 0 } [ 1 [ 2 3 ] curry curry-folding-test ] must-infer-as
{ 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as
+[ [ curry curry-folding-test ] infer ]
+[ T{ unknown-macro-input f curry-folding-test } = ] must-fail-with
+
: member?-test ( a -- ? ) { 1 2 3 10 7 58 } member? ;
[ f ] [ 1.0 member?-test ] unit-test
\ bad-macro [ "OOPS" throw ] 0 define-transform
-[ [ bad-macro ] infer ] [ inference-error? ] must-fail-with
\ No newline at end of file
+[ [ bad-macro ] infer ] [ f >>continuation T{ transform-expansion-error f "OOPS" f bad-macro } = ] must-fail-with
+
+MACRO: two-params ( a b -- c ) + 1quotation ;
+
+[ [ 3 two-params ] infer ] [ T{ unknown-macro-input f two-params } = ] must-fail-with
\ No newline at end of file
definitions generic.standard slots.private continuations locals
sequences.private generalizations stack-checker.backend
stack-checker.state stack-checker.visitor stack-checker.errors
-stack-checker.values stack-checker.recursive-state ;
+stack-checker.values stack-checker.recursive-state
+stack-checker.dependencies ;
IN: stack-checker.transforms
-: call-transformer ( word stack quot -- newquot )
- '[ _ _ with-datastack [ length 1 assert= ] [ first ] bi nip ]
- [ transform-expansion-error ]
+: call-transformer ( stack quot -- newquot )
+ '[ _ _ with-datastack [ length 1 assert= ] [ first ] bi ]
+ [ error-continuation get current-word get transform-expansion-error ]
recover ;
-:: ((apply-transform)) ( word quot values stack rstate -- )
- rstate recursive-state
- [ word stack quot call-transformer ] with-variable
- [
- values [ length meta-d shorten-by ] [ #drop, ] bi
- rstate infer-quot
- ] [ word infer-word ] if* ;
-
-: literals? ( values -- ? ) [ literal-value? ] all? ;
-
-: (apply-transform) ( word quot n -- )
- ensure-d dup literals? [
- dup empty? [ dup recursive-state get ] [
- [ ]
- [ [ literal value>> ] map ]
- [ first literal recursion>> ] tri
- ] if
- ((apply-transform))
- ] [ 2drop infer-word ] if ;
+:: ((apply-transform)) ( quot values stack rstate -- )
+ rstate recursive-state [ stack quot call-transformer ] with-variable
+ values [ length meta-d shorten-by ] [ #drop, ] bi
+ rstate infer-quot ;
+
+: literal-values? ( values -- ? ) [ literal-value? ] all? ;
+
+: input-values? ( values -- ? )
+ [ { [ literal-value? ] [ input-value? ] } 1|| ] all? ;
+
+: (apply-transform) ( quot n -- )
+ ensure-d {
+ { [ dup literal-values? ] [
+ dup empty? [ dup recursive-state get ] [
+ [ ]
+ [ [ literal value>> ] map ]
+ [ first literal recursion>> ] tri
+ ] if
+ ((apply-transform))
+ ] }
+ { [ dup input-values? ] [ drop current-word get unknown-macro-input ] }
+ [ drop current-word get bad-macro-input ]
+ } cond ;
: apply-transform ( word -- )
- [ ] [ "transform-quot" word-prop ] [ "transform-n" word-prop ] tri
+ [ current-word set ]
+ [ "transform-quot" word-prop ]
+ [ "transform-n" word-prop ] tri
(apply-transform) ;
: apply-macro ( word -- )
- [ ] [ "macro" word-prop ] [ "declared-effect" word-prop in>> length ] tri
+ [ current-word set ]
+ [ "macro" word-prop ]
+ [ "declared-effect" word-prop in>> length ] tri
(apply-transform) ;
: define-transform ( word quot n -- )
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors namespaces kernel assocs sequences
-stack-checker.recursive-state ;
+stack-checker.recursive-state stack-checker.errors ;
IN: stack-checker.values
! Values
GENERIC: (literal-value?) ( value -- ? )
-M: object (literal-value?) drop f ;
+: literal-value? ( value -- ? ) known (literal-value?) ;
+
+GENERIC: (input-value?) ( value -- ? )
+
+: input-value? ( value -- ? ) known (input-value?) ;
-GENERIC: (literal) ( value -- literal )
+GENERIC: (literal) ( known -- literal )
! Literal value
-TUPLE: literal < identity-tuple value recursion hashcode ;
+TUPLE: literal < identity-tuple value recursion ;
: literal ( value -- literal ) known (literal) ;
-: literal-value? ( value -- ? ) known (literal-value?) ;
-
-M: literal hashcode* nip hashcode>> ;
+M: literal hashcode* nip value>> identity-hashcode ;
: <literal> ( obj -- value )
- recursive-state get over hashcode \ literal boa ;
+ recursive-state get \ literal boa ;
+
+M: literal (input-value?) drop f ;
M: literal (literal-value?) drop t ;
: curried/composed-literal ( input1 input2 quot -- literal )
[ [ literal ] bi@ ] dip
[ [ [ value>> ] bi@ ] dip call ] [ drop nip recursion>> ] 3bi
- over hashcode \ literal boa ; inline
+ \ literal boa ; inline
! Result of curry
TUPLE: curried obj quot ;
: >curried< ( curried -- obj quot )
[ obj>> ] [ quot>> ] bi ; inline
+M: curried (input-value?) >curried< [ input-value? ] either? ;
+
M: curried (literal-value?) >curried< [ literal-value? ] both? ;
+
M: curried (literal) >curried< [ curry ] curried/composed-literal ;
! Result of compose
: >composed< ( composed -- quot1 quot2 )
[ quot1>> ] [ quot2>> ] bi ; inline
+M: composed (input-value?)
+ [ quot1>> input-value? ] [ quot2>> input-value? ] bi or ;
+
M: composed (literal-value?) >composed< [ literal-value? ] both? ;
-M: composed (literal) >composed< [ compose ] curried/composed-literal ;
\ No newline at end of file
+
+M: composed (literal) >composed< [ compose ] curried/composed-literal ;
+
+! Input parameters
+SINGLETON: input-parameter
+
+SYMBOL: current-word
+
+M: input-parameter (input-value?) drop t ;
+
+M: input-parameter (literal-value?) drop f ;
+
+M: input-parameter (literal) current-word get unknown-macro-input ;
+
+! Computed values
+M: f (input-value?) drop f ;
+
+M: f (literal-value?) drop f ;
+
+M: f (literal) current-word get bad-macro-input ;
\ No newline at end of file
urls math.parser io.directories tools.deploy.test ;\r
IN: tools.deploy.tests\r
\r
-[ t ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test\r
+[ ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test\r
\r
-[ t ] [ "sudoku" shake-and-bake 800000 small-enough? ] unit-test\r
+[ ] [ "sudoku" shake-and-bake 800000 small-enough? ] unit-test\r
\r
-[ t ] [ "hello-ui" shake-and-bake 1300000 small-enough? ] unit-test\r
+[ ] [ "hello-ui" shake-and-bake 1300000 small-enough? ] unit-test\r
\r
[ "staging.math-threads-compiler-ui.image" ] [\r
"hello-ui" deploy-config\r
[ bootstrap-profile staging-image-name file-name ] bind\r
] unit-test\r
\r
-[ t ] [ "maze" shake-and-bake 1200000 small-enough? ] unit-test\r
+[ ] [ "maze" shake-and-bake 1200000 small-enough? ] unit-test\r
\r
-[ t ] [ "tetris" shake-and-bake 1500000 small-enough? ] unit-test\r
+[ ] [ "tetris" shake-and-bake 1500000 small-enough? ] unit-test\r
\r
-[ t ] [ "spheres" shake-and-bake 1500000 small-enough? ] unit-test\r
+[ ] [ "spheres" shake-and-bake 1500000 small-enough? ] unit-test\r
\r
-[ t ] [ "terrain" shake-and-bake 1700000 small-enough? ] unit-test\r
+[ ] [ "terrain" shake-and-bake 1700000 small-enough? ] unit-test\r
\r
-[ t ] [ "bunny" shake-and-bake 2500000 small-enough? ] unit-test\r
+[ ] [ "bunny" shake-and-bake 2500000 small-enough? ] unit-test\r
\r
os macosx? [\r
- [ t ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test\r
+ [ ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test\r
] when\r
\r
-[ t ] [ "benchmark.regex-dna" shake-and-bake 900000 small-enough? ] unit-test\r
+[ ] [ "benchmark.regex-dna" shake-and-bake 900000 small-enough? ] unit-test\r
\r
{\r
"tools.deploy.test.1"\r
+USING: io.encodings.string kernel io.encodings.8-bit.latin7 ;
IN: tools.deploy.test.4
-USING: io.encodings.8-bit io.encodings.string kernel ;
: deploy-test-4 ( -- )
"xyzthg" \ latin7 encode drop ;
dup deploy-config make-deploy-image
] with-directory ;
-: small-enough? ( n -- ? )
+ERROR: image-too-big actual-size max-size ;
+
+: small-enough? ( n -- )
[ "test.image" temp-file file-info size>> ]
[
cell 4 / *
cpu ppc? [ 100000 + ] when
os windows? [ 150000 + ] when
] bi*
- <= ;
+ 2dup <= [ 2drop ] [ image-too-big ] if ;
: deploy-test-command ( -- args )
os macosx?
combinators combinators.smart continuations fry generalizations
generic grouping io io.styles kernel make math math.parser
math.statistics memory namespaces parser prettyprint sequences
-sorting specialized-arrays splitting strings system vm words ;
-SPECIALIZED-ARRAY: gc-event
+sorting splitting strings system vm words ;
IN: tools.memory
<PRIVATE
: collect-gc-events ( quot -- )
enable-gc-events
[ ] [ disable-gc-events drop ] cleanup
- disable-gc-events byte-array>gc-event-array gc-events set ; inline
+ disable-gc-events [ gc-event memory>struct ] map gc-events set ; inline
<PRIVATE
[ [ gensym execute ] profile ] [ T{ undefined } = ] must-fail-with
-: crash-bug-1 ( -- x ) "hi" "bye" <word> ;
+: crash-bug-1 ( -- x ) "hi" <uninterned-word> ;
: crash-bug-2 ( -- ) 100000 [ crash-bug-1 drop ] times ;
[ ] [ [ crash-bug-2 ] profile ] unit-test
vocab-tests [ run-test-file ] each
] [ drop ] if ;
-: traceback-button. ( failure -- )
- "[" write [ "Traceback" ] dip continuation>> write-object "]" print ;
-
PRIVATE>
TEST: unit-test
[ error-location print nl ]
[ asset>> [ experiment. nl ] when* ]
[ error>> error. ]
- [ traceback-button. ]
+ [ continuation>> traceback-link. ]
} cleave ;
: :test-failures ( -- ) test-failures get errors. ;
combinators.short-circuit definitions effects fry hints
math kernel kernel.private namespaces parser quotations
sequences slots words locals
-locals.parser macros stack-checker.state ;
+locals.parser macros stack-checker.dependencies ;
IN: typed
ERROR: type-mismatch-error word expected-types ;
CONSTANT: vertical { 0 1 }
TUPLE: gadget < rect
-id
pref-dim
parent
children
M: gadget equal? 2drop f ;
-M: gadget hashcode* nip [ [ \ gadget counter ] unless* ] change-id id>> ;
+M: gadget hashcode* nip identity-hashcode ;
M: gadget model-changed 2drop ;
{ data-sweep-time cell }
{ code-sweep-time cell }
{ compaction-time cell }
-{ temp-time cell } ;
+{ temp-time ulonglong } ;
STRUCT: dispatch-statistics
{ megamorphic-cache-hits cell }
: get-html ( -- table )
{ "lat1" "special" "symbol" } [
- "vocab:xml/entities/html/xhtml-"
- swap ".ent" 3append read-entities-file
+ "vocab:xml/entities/html/xhtml-" ".ent" surround
+ read-entities-file
] map first3 assoc-union assoc-union ;
get-html to: html-entities
-USING: xml xml.data xml.traversal tools.test accessors kernel
-io.encodings.8-bit ;
+USING: xml xml.data xml.traversal tools.test accessors kernel ;
[ "\u000131" ] [ "vocab:xml/tests/latin5.xml" file>xml children>string ] unit-test
[ "\u0000e9" ] [ "vocab:xml/tests/latin1.xml" file>xml children>string ] unit-test
-USING: alien.strings alien.c-types alien.data tools.test kernel libc
-io.encodings.8-bit io.encodings.utf8 io.encodings.utf16
-io.encodings.utf16n io.encodings.ascii alien io.encodings.string ;
+USING: alien.strings alien.c-types alien.data tools.test
+kernel libc io.encodings.utf8 io.encodings.utf16 io.encodings.utf16n
+io.encodings.ascii alien io.encodings.string io.encodings.8-bit.latin1 ;
IN: alien.strings.tests
[ "\u0000ff" ]
{ word 12 }
{ dll 13 }
} type-numbers set
+
+2 header-bits set
"vocab:bootstrap/syntax.factor" parse-file
-"vocab:cpu/" architecture get {
+architecture get {
{ "x86.32" "x86/32" }
{ "winnt-x86.64" "x86/64/winnt" }
{ "unix-x86.64" "x86/64/unix" }
{ "macosx-ppc" "ppc/macosx" }
{ "arm" "arm" }
} ?at [ "Bad architecture: " prepend throw ] unless
-"/bootstrap.factor" 3append parse-file
+"vocab:cpu/" "/bootstrap.factor" surround parse-file
"vocab:bootstrap/layouts/layouts.factor" parse-file
bootstrapping? on
+[
+
! Create some empty vocabs where the below primitives and
! classes will go
{
{ "<callback>" "alien" (( word -- alien )) }
{ "enable-gc-events" "memory" (( -- )) }
{ "disable-gc-events" "memory" (( -- events )) }
+ { "(identity-hashcode)" "kernel.private" (( obj -- code )) }
+ { "compute-identity-hashcode" "kernel.private" (( obj -- )) }
} [ [ first3 ] dip swap make-primitive ] each-index
! Bump build number
"build" "kernel" create build 1 + [ ] curry (( -- n )) define-declared
+
+] with-compilation-unit
load-help? off
{ "resource:core" } vocab-roots set
-! Create a boot quotation for the target
+! Create a boot quotation for the target by collecting all top-level
+! forms into a quotation, surrounded by some boilerplate.
[
[
! Rehash hashtables first, since bootstrap.image creates
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: words words.symbol sequences vocabs kernel ;
+USING: words words.symbol sequences vocabs kernel
+compiler.units ;
IN: bootstrap.syntax
-"syntax" create-vocab drop
+[
+ "syntax" create-vocab drop
-{
- "!"
- "\""
- "#!"
- "("
- "(("
- ":"
- ";"
- "<PRIVATE"
- "BIN:"
- "B{"
- "BV{"
- "C:"
- "CHAR:"
- "DEFER:"
- "ERROR:"
- "FORGET:"
- "GENERIC#"
- "GENERIC:"
- "HEX:"
- "HOOK:"
- "H{"
- "IN:"
- "INSTANCE:"
- "M:"
- "MAIN:"
- "MATH:"
- "MIXIN:"
- "NAN:"
- "OCT:"
- "P\""
- "POSTPONE:"
- "PREDICATE:"
- "PRIMITIVE:"
- "PRIVATE>"
- "SBUF\""
- "SINGLETON:"
- "SINGLETONS:"
- "SYMBOL:"
- "SYMBOLS:"
- "CONSTANT:"
- "TUPLE:"
- "SLOT:"
- "T{"
- "UNION:"
- "INTERSECTION:"
- "USE:"
- "UNUSE:"
- "USING:"
- "QUALIFIED:"
- "QUALIFIED-WITH:"
- "FROM:"
- "EXCLUDE:"
- "RENAME:"
- "ALIAS:"
- "SYNTAX:"
- "V{"
- "W{"
- "["
- "\\"
- "M\\"
- "]"
- "delimiter"
- "deprecated"
- "f"
- "flushable"
- "foldable"
- "inline"
- "recursive"
- "t"
- "{"
- "}"
- "CS{"
- "<<"
- ">>"
- "call-next-method"
- "initial:"
- "read-only"
- "call("
- "execute("
-} [ "syntax" create drop ] each
+ {
+ "!"
+ "\""
+ "#!"
+ "("
+ "(("
+ ":"
+ ";"
+ "BIN:"
+ "B{"
+ "BV{"
+ "C:"
+ "CHAR:"
+ "DEFER:"
+ "ERROR:"
+ "FORGET:"
+ "GENERIC#"
+ "GENERIC:"
+ "HEX:"
+ "HOOK:"
+ "H{"
+ "IN:"
+ "INSTANCE:"
+ "M:"
+ "MAIN:"
+ "MATH:"
+ "MIXIN:"
+ "NAN:"
+ "OCT:"
+ "P\""
+ "POSTPONE:"
+ "PREDICATE:"
+ "PRIMITIVE:"
+ "PRIVATE>"
+ "SBUF\""
+ "SINGLETON:"
+ "SINGLETONS:"
+ "SYMBOL:"
+ "SYMBOLS:"
+ "CONSTANT:"
+ "TUPLE:"
+ "SLOT:"
+ "T{"
+ "UNION:"
+ "INTERSECTION:"
+ "USE:"
+ "UNUSE:"
+ "USING:"
+ "QUALIFIED:"
+ "QUALIFIED-WITH:"
+ "FROM:"
+ "EXCLUDE:"
+ "RENAME:"
+ "ALIAS:"
+ "SYNTAX:"
+ "V{"
+ "W{"
+ "["
+ "\\"
+ "M\\"
+ "]"
+ "delimiter"
+ "deprecated"
+ "f"
+ "flushable"
+ "foldable"
+ "inline"
+ "recursive"
+ "t"
+ "{"
+ "}"
+ "CS{"
+ "<<"
+ ">>"
+ "call-next-method"
+ "initial:"
+ "read-only"
+ "call("
+ "execute("
+ } [ "syntax" create drop ] each
-"t" "syntax" lookup define-symbol
+ "t" "syntax" lookup define-symbol
+] with-compilation-unit
class-and\r
class-or\r
classes-intersect?\r
-}\r
-"Low-level implementation detail:"\r
-{ $subsections\r
flatten-class\r
- flatten-builtin-class\r
- class-types\r
} ;\r
\r
ARTICLE: "class-linearization" "Class linearization"\r
"Metaclass order:"\r
{ $subsections rank-class } ;\r
\r
-HELP: flatten-builtin-class\r
-{ $values { "class" class } { "assoc" "an assoc whose keys are classes" } }\r
-{ $description "Outputs a set of tuple classes whose union is the smallest cover of " { $snippet "class" } " intersected with " { $link tuple } "." } ;\r
-\r
HELP: flatten-class\r
{ $values { "class" class } { "assoc" "an assoc whose keys are classes" } }\r
{ $description "Outputs a set of builtin and tuple classes whose union is the smallest cover of " { $snippet "class" } "." } ;\r
\r
-HELP: class-types\r
-{ $values { "class" class } { "seq" "an increasing sequence of integers" } }\r
-{ $description "Outputs a sequence of builtin type numbers whose instances can possibly be instances of the given class." } ;\r
-\r
HELP: class<=\r
{ $values { "first" "a class" } { "second" "a class" } { "?" "a boolean" } }\r
{ $description "Tests if all instances of " { $snippet "class1" } " are also instances of " { $snippet "class2" } "." }\r
classes.tuple accessors generic.private ;\r
IN: classes.algebra.tests\r
\r
-: class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ;\r
+TUPLE: first-one ;\r
+TUPLE: second-one ;\r
+UNION: both first-one union-class ;\r
\r
-: class-or* ( cls1 cls2 cls3 -- ? ) [ class-or ] dip class= ;\r
+PREDICATE: no-docs < word "documentation" word-prop not ;\r
\r
-[ t ] [ object object object class-and* ] unit-test\r
-[ t ] [ fixnum object fixnum class-and* ] unit-test\r
-[ t ] [ object fixnum fixnum class-and* ] unit-test\r
-[ t ] [ fixnum fixnum fixnum class-and* ] unit-test\r
-[ t ] [ fixnum integer fixnum class-and* ] unit-test\r
-[ t ] [ integer fixnum fixnum class-and* ] unit-test\r
+UNION: no-docs-union no-docs integer ;\r
\r
-[ t ] [ vector fixnum null class-and* ] unit-test\r
-[ t ] [ number object number class-and* ] unit-test\r
-[ t ] [ object number number class-and* ] unit-test\r
-[ t ] [ slice reversed null class-and* ] unit-test\r
-[ t ] [ \ f class-not \ f null class-and* ] unit-test\r
-[ t ] [ \ f class-not \ f object class-or* ] unit-test\r
+TUPLE: a ;\r
+TUPLE: b ;\r
+UNION: c a b ;\r
\r
-TUPLE: first-one ;\r
-TUPLE: second-one ;\r
-UNION: both first-one union-class ;\r
+TUPLE: tuple-example ;\r
\r
-[ t ] [ both tuple classes-intersect? ] unit-test\r
-[ t ] [ vector virtual-sequence null class-and* ] unit-test\r
-[ f ] [ vector virtual-sequence classes-intersect? ] unit-test\r
+TUPLE: a1 ;\r
+TUPLE: b1 ;\r
+TUPLE: c1 ;\r
\r
-[ t ] [ number vector class-or sequence classes-intersect? ] unit-test\r
+UNION: x1 a1 b1 ;\r
+UNION: y1 a1 c1 ;\r
+UNION: z1 b1 c1 ;\r
\r
-[ f ] [ number vector class-and sequence classes-intersect? ] unit-test\r
+SINGLETON: sa\r
+SINGLETON: sb\r
+SINGLETON: sc\r
+\r
+INTERSECTION: empty-intersection ;\r
+\r
+INTERSECTION: generic-class generic class ;\r
\r
+UNION: union-with-one-member a ;\r
+\r
+MIXIN: mixin-with-one-member\r
+INSTANCE: union-with-one-member mixin-with-one-member\r
+\r
+! class<=\r
[ t ] [ \ fixnum \ integer class<= ] unit-test\r
[ t ] [ \ fixnum \ fixnum class<= ] unit-test\r
[ f ] [ \ integer \ fixnum class<= ] unit-test\r
[ f ] [ \ reversed \ slice class<= ] unit-test\r
[ f ] [ \ slice \ reversed class<= ] unit-test\r
\r
-PREDICATE: no-docs < word "documentation" word-prop not ;\r
-\r
-UNION: no-docs-union no-docs integer ;\r
-\r
[ t ] [ no-docs no-docs-union class<= ] unit-test\r
[ f ] [ no-docs-union no-docs class<= ] unit-test\r
\r
-TUPLE: a ;\r
-TUPLE: b ;\r
-UNION: c a b ;\r
-\r
[ t ] [ \ c \ tuple class<= ] unit-test\r
[ f ] [ \ tuple \ c class<= ] unit-test\r
\r
[ t ] [ \ tuple-class \ class class<= ] unit-test\r
[ f ] [ \ class \ tuple-class class<= ] unit-test\r
\r
-TUPLE: tuple-example ;\r
-\r
[ t ] [ \ null \ tuple-example class<= ] unit-test\r
[ f ] [ \ object \ tuple-example class<= ] unit-test\r
[ f ] [ \ object \ tuple-example class<= ] unit-test\r
[ t ] [ \ tuple-example \ tuple class<= ] unit-test\r
[ f ] [ \ tuple \ tuple-example class<= ] unit-test\r
\r
-TUPLE: a1 ;\r
-TUPLE: b1 ;\r
-TUPLE: c1 ;\r
-\r
-UNION: x1 a1 b1 ;\r
-UNION: y1 a1 c1 ;\r
-UNION: z1 b1 c1 ;\r
-\r
[ f ] [ z1 x1 y1 class-and class<= ] unit-test\r
\r
[ t ] [ x1 y1 class-and a1 class<= ] unit-test\r
\r
-[ f ] [ y1 z1 class-and x1 classes-intersect? ] unit-test\r
-\r
[ f ] [ b1 c1 class-or a1 b1 class-or a1 c1 class-and class-and class<= ] unit-test\r
\r
[ t ] [ a1 b1 class-or a1 c1 class-or class-and a1 class<= ] unit-test\r
\r
-[ f ] [ a1 c1 class-or b1 c1 class-or class-and a1 b1 class-or classes-intersect? ] unit-test\r
-\r
-[ t ] [\r
- growable tuple sequence class-and class<=\r
-] unit-test\r
+[ t ] [ growable tuple sequence class-and class<= ] unit-test\r
\r
-[ t ] [\r
- growable assoc class-and tuple class<=\r
-] unit-test\r
+[ t ] [ growable assoc class-and tuple class<= ] unit-test\r
\r
[ t ] [ object \ f \ f class-not class-or class<= ] unit-test\r
\r
[ t ] [ fixnum class-not integer class-and bignum class= ] unit-test\r
\r
-[ f ] [ integer integer class-not classes-intersect? ] unit-test\r
-\r
[ t ] [ array number class-not class<= ] unit-test\r
\r
[ f ] [ bignum number class-not class<= ] unit-test\r
\r
-[ vector ] [ vector class-not class-not ] unit-test\r
-\r
[ t ] [ fixnum fixnum bignum class-or class<= ] unit-test\r
\r
[ f ] [ fixnum class-not integer class-and array class<= ] unit-test\r
\r
[ t ] [ number class-not integer class-not class<= ] unit-test\r
\r
-[ t ] [ vector array class-not class-and vector class= ] unit-test\r
+[ f ] [ fixnum class-not integer class<= ] unit-test\r
+\r
+[ t ] [ object empty-intersection class<= ] unit-test\r
+[ t ] [ empty-intersection object class<= ] unit-test\r
+[ t ] [ \ f class-not empty-intersection class<= ] unit-test\r
+[ f ] [ empty-intersection \ f class-not class<= ] unit-test\r
+[ t ] [ \ number empty-intersection class<= ] unit-test\r
+[ t ] [ empty-intersection class-not null class<= ] unit-test\r
+[ t ] [ null empty-intersection class-not class<= ] unit-test\r
+\r
+[ t ] [ \ f class-not \ f class-or empty-intersection class<= ] unit-test\r
+[ t ] [ empty-intersection \ f class-not \ f class-or class<= ] unit-test\r
+\r
+[ t ] [ object \ f class-not \ f class-or class<= ] unit-test\r
+\r
+[ t ] [\r
+ fixnum class-not\r
+ fixnum fixnum class-not class-or\r
+ class<=\r
+] unit-test\r
+\r
+[ t ] [ generic-class generic class<= ] unit-test\r
+[ t ] [ generic-class \ class class<= ] unit-test\r
+\r
+[ t ] [ a union-with-one-member class<= ] unit-test\r
+[ f ] [ union-with-one-member class-not integer class<= ] unit-test\r
+\r
+! class-and\r
+: class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ;\r
+\r
+[ t ] [ object object object class-and* ] unit-test\r
+[ t ] [ fixnum object fixnum class-and* ] unit-test\r
+[ t ] [ object fixnum fixnum class-and* ] unit-test\r
+[ t ] [ fixnum fixnum fixnum class-and* ] unit-test\r
+[ t ] [ fixnum integer fixnum class-and* ] unit-test\r
+[ t ] [ integer fixnum fixnum class-and* ] unit-test\r
+\r
+[ t ] [ vector fixnum null class-and* ] unit-test\r
+[ t ] [ number object number class-and* ] unit-test\r
+[ t ] [ object number number class-and* ] unit-test\r
+[ t ] [ slice reversed null class-and* ] unit-test\r
+[ t ] [ \ f class-not \ f null class-and* ] unit-test\r
+\r
+[ t ] [ vector virtual-sequence null class-and* ] unit-test\r
+\r
+[ t ] [ vector array class-not vector class-and* ] unit-test\r
+\r
+! class-or\r
+: class-or* ( cls1 cls2 cls3 -- ? ) [ class-or ] dip class= ;\r
+\r
+[ t ] [ \ f class-not \ f object class-or* ] unit-test\r
+\r
+! class-not\r
+[ vector ] [ vector class-not class-not ] unit-test\r
+\r
+! classes-intersect?\r
+[ t ] [ both tuple classes-intersect? ] unit-test\r
+[ f ] [ vector virtual-sequence classes-intersect? ] unit-test\r
+\r
+[ t ] [ number vector class-or sequence classes-intersect? ] unit-test\r
+\r
+[ f ] [ number vector class-and sequence classes-intersect? ] unit-test\r
+\r
+[ f ] [ y1 z1 class-and x1 classes-intersect? ] unit-test\r
+\r
+[ f ] [ a1 c1 class-or b1 c1 class-or class-and a1 b1 class-or classes-intersect? ] unit-test\r
+\r
+[ f ] [ integer integer class-not classes-intersect? ] unit-test\r
\r
[ f ] [ fixnum class-not number class-and array classes-intersect? ] unit-test\r
\r
-[ f ] [ fixnum class-not integer class<= ] unit-test\r
+[ t ] [ \ word generic-class classes-intersect? ] unit-test\r
+[ f ] [ number generic-class classes-intersect? ] unit-test\r
+\r
+[ f ] [ sa sb classes-intersect? ] unit-test\r
\r
+[ t ] [ a union-with-one-member classes-intersect? ] unit-test\r
+[ f ] [ fixnum union-with-one-member classes-intersect? ] unit-test\r
+[ t ] [ object union-with-one-member classes-intersect? ] unit-test\r
+\r
+[ t ] [ union-with-one-member a classes-intersect? ] unit-test\r
+[ f ] [ union-with-one-member fixnum classes-intersect? ] unit-test\r
+[ t ] [ union-with-one-member object classes-intersect? ] unit-test\r
+\r
+[ t ] [ a mixin-with-one-member classes-intersect? ] unit-test\r
+[ f ] [ fixnum mixin-with-one-member classes-intersect? ] unit-test\r
+[ t ] [ object mixin-with-one-member classes-intersect? ] unit-test\r
+\r
+[ t ] [ mixin-with-one-member a classes-intersect? ] unit-test\r
+[ f ] [ mixin-with-one-member fixnum classes-intersect? ] unit-test\r
+[ t ] [ mixin-with-one-member object classes-intersect? ] unit-test\r
+\r
+! class=\r
[ t ] [ null class-not object class= ] unit-test\r
\r
[ t ] [ object class-not null class= ] unit-test\r
\r
[ f ] [ null class-not null class= ] unit-test\r
\r
-[ t ] [\r
- fixnum class-not\r
- fixnum fixnum class-not class-or\r
- class<=\r
-] unit-test\r
+! class<=>\r
\r
-! Test method inlining\r
+[ +lt+ ] [ integer sequence class<=> ] unit-test\r
+[ +lt+ ] [ sequence object class<=> ] unit-test\r
+[ +gt+ ] [ object sequence class<=> ] unit-test\r
+[ +eq+ ] [ integer integer class<=> ] unit-test\r
+\r
+! smallest-class etc\r
[ real ] [ { real sequence } smallest-class ] unit-test\r
[ real ] [ { sequence real } smallest-class ] unit-test\r
\r
\r
[ t ] [ { xa xb xc xd xe xf xg xh } sort-classes dup sort-classes = ] unit-test\r
\r
-INTERSECTION: generic-class generic class ;\r
-\r
-[ t ] [ generic-class generic class<= ] unit-test\r
-[ t ] [ generic-class \ class class<= ] unit-test\r
-\r
-! Later\r
-[\r
- [ t ] [ \ class generic class-and generic-class class<= ] unit-test\r
- [ t ] [ \ class generic class-and generic-class swap class<= ] unit-test\r
-] drop\r
-\r
-[ t ] [ \ word generic-class classes-intersect? ] unit-test\r
-[ f ] [ number generic-class classes-intersect? ] unit-test\r
-\r
[ H{ { word word } } ] [ \r
generic-class flatten-class\r
] unit-test\r
\r
-[ \ + flatten-class ] must-fail\r
-\r
-INTERSECTION: empty-intersection ;\r
-\r
-[ t ] [ object empty-intersection class<= ] unit-test\r
-[ t ] [ empty-intersection object class<= ] unit-test\r
-[ t ] [ \ f class-not empty-intersection class<= ] unit-test\r
-[ f ] [ empty-intersection \ f class-not class<= ] unit-test\r
-[ t ] [ \ number empty-intersection class<= ] unit-test\r
-[ t ] [ empty-intersection class-not null class<= ] unit-test\r
-[ t ] [ null empty-intersection class-not class<= ] unit-test\r
-\r
-[ t ] [ \ f class-not \ f class-or empty-intersection class<= ] unit-test\r
-[ t ] [ empty-intersection \ f class-not \ f class-or class<= ] unit-test\r
-\r
-[ t ] [ object \ f class-not \ f class-or class<= ] unit-test\r
-\r
-[ ] [ object flatten-builtin-class drop ] unit-test\r
-\r
-SINGLETON: sa\r
-SINGLETON: sb\r
-SINGLETON: sc\r
-\r
[ sa ] [ sa { sa sb sc } min-class ] unit-test\r
\r
-[ f ] [ sa sb classes-intersect? ] unit-test\r
-\r
-[ +lt+ ] [ integer sequence class<=> ] unit-test\r
-[ +lt+ ] [ sequence object class<=> ] unit-test\r
-[ +gt+ ] [ object sequence class<=> ] unit-test\r
-[ +eq+ ] [ integer integer class<=> ] unit-test\r
-\r
-! Limitations:\r
-\r
-! UNION: u1 sa sb ;\r
-! UNION: u2 sc ;\r
-\r
-! [ f ] [ u1 u2 classes-intersect? ] unit-test\r
+[ \ + flatten-class ] must-fail\r
kernel.private sets math.order ;\r
IN: classes.algebra\r
\r
-TUPLE: anonymous-union members ;\r
+<PRIVATE\r
\r
-C: <anonymous-union> anonymous-union\r
+TUPLE: anonymous-union { members read-only } ;\r
\r
-TUPLE: anonymous-intersection participants ;\r
+: <anonymous-union> ( members -- class )\r
+ [ null eq? not ] filter prune\r
+ dup length 1 = [ first ] [ anonymous-union boa ] if ;\r
\r
-C: <anonymous-intersection> anonymous-intersection\r
+TUPLE: anonymous-intersection { participants read-only } ;\r
\r
-TUPLE: anonymous-complement class ;\r
+: <anonymous-intersection> ( participants -- class )\r
+ prune dup length 1 = [ first ] [ anonymous-intersection boa ] if ;\r
+\r
+TUPLE: anonymous-complement { class read-only } ;\r
\r
C: <anonymous-complement> anonymous-complement\r
\r
+DEFER: (class<=)\r
+\r
+DEFER: (class-not)\r
+\r
+GENERIC: (classes-intersect?) ( first second -- ? )\r
+\r
+DEFER: (class-and)\r
+\r
+DEFER: (class-or)\r
+\r
+GENERIC: (flatten-class) ( class -- )\r
+\r
+: normalize-class ( class -- class' )\r
+ {\r
+ { [ dup members ] [ members <anonymous-union> normalize-class ] }\r
+ { [ dup participants ] [ participants <anonymous-intersection> normalize-class ] }\r
+ [ ]\r
+ } cond ;\r
+\r
+PRIVATE>\r
+\r
GENERIC: valid-class? ( obj -- ? )\r
\r
M: class valid-class? drop t ;\r
M: anonymous-complement valid-class? class>> valid-class? ;\r
M: word valid-class? drop f ;\r
\r
-DEFER: (class<=)\r
-\r
: class<= ( first second -- ? )\r
class<=-cache get [ (class<=) ] 2cache ;\r
\r
-DEFER: (class-not)\r
-\r
-: class-not ( class -- complement )\r
- class-not-cache get [ (class-not) ] cache ;\r
-\r
-GENERIC: (classes-intersect?) ( first second -- ? )\r
+: class< ( first second -- ? )\r
+ {\r
+ { [ 2dup class<= not ] [ 2drop f ] }\r
+ { [ 2dup swap class<= not ] [ 2drop t ] }\r
+ [ [ rank-class ] bi@ < ]\r
+ } cond ;\r
\r
-: normalize-class ( class -- class' )\r
+: class<=> ( first second -- ? )\r
{\r
- { [ dup members ] [ members <anonymous-union> ] }\r
- { [ dup participants ] [ participants <anonymous-intersection> ] }\r
- [ ]\r
+ { [ 2dup class<= not ] [ 2drop +gt+ ] }\r
+ { [ 2dup swap class<= not ] [ 2drop +lt+ ] }\r
+ [ [ rank-class ] bi@ <=> ]\r
} cond ;\r
\r
+: class= ( first second -- ? )\r
+ [ class<= ] [ swap class<= ] 2bi and ;\r
+\r
+: class-not ( class -- complement )\r
+ class-not-cache get [ (class-not) ] cache ;\r
+\r
: classes-intersect? ( first second -- ? )\r
classes-intersect-cache get [\r
normalize-class (classes-intersect?)\r
] 2cache ;\r
\r
-DEFER: (class-and)\r
-\r
: class-and ( first second -- class )\r
class-and-cache get [ (class-and) ] 2cache ;\r
\r
-DEFER: (class-or)\r
-\r
: class-or ( first second -- class )\r
class-or-cache get [ (class-or) ] 2cache ;\r
\r
+<PRIVATE\r
+\r
: superclass<= ( first second -- ? )\r
swap superclass dup [ swap class<= ] [ 2drop f ] if ;\r
\r
[ class-not normalize-class ] map\r
<anonymous-union>\r
] }\r
+ [ <anonymous-complement> ]\r
} cond ;\r
\r
: left-anonymous-complement<= ( first second -- ? )\r
\r
: (class<=) ( first second -- ? )\r
2dup eq? [ 2drop t ] [\r
+ [ normalize-class ] bi@\r
2dup superclass<= [ 2drop t ] [\r
- [ normalize-class ] bi@ {\r
+ {\r
+ { [ 2dup eq? ] [ 2drop t ] }\r
{ [ dup empty-intersection? ] [ 2drop t ] }\r
{ [ over empty-union? ] [ 2drop t ] }\r
{ [ 2dup [ anonymous-complement? ] both? ] [ anonymous-complement<= ] }\r
[ <anonymous-complement> ]\r
} cond ;\r
\r
-: class< ( first second -- ? )\r
- {\r
- { [ 2dup class<= not ] [ 2drop f ] }\r
- { [ 2dup swap class<= not ] [ 2drop t ] }\r
- [ [ rank-class ] bi@ < ]\r
- } cond ;\r
-\r
-: class<=> ( first second -- ? )\r
- {\r
- { [ 2dup class<= not ] [ 2drop +gt+ ] }\r
- { [ 2dup swap class<= not ] [ 2drop +lt+ ] }\r
- [ [ rank-class ] bi@ <=> ]\r
- } cond ;\r
+M: anonymous-union (flatten-class)\r
+ members>> [ (flatten-class) ] each ;\r
\r
-: class= ( first second -- ? )\r
- [ class<= ] [ swap class<= ] 2bi and ;\r
+PRIVATE>\r
\r
ERROR: topological-sort-failed ;\r
\r
: sort-classes ( seq -- newseq )\r
[ name>> ] sort-with >vector\r
[ dup empty? not ]\r
- [ dup largest-class [ over remove-nth! drop ] dip ]\r
+ [ dup largest-class [ swap remove-nth! ] dip ]\r
produce nip ;\r
\r
: smallest-class ( classes -- class/f )\r
[ ] [ [ class<= ] most ] map-reduce\r
] if-empty ;\r
\r
-GENERIC: (flatten-class) ( class -- )\r
-\r
-M: anonymous-union (flatten-class)\r
- members>> [ (flatten-class) ] each ;\r
-\r
: flatten-class ( class -- assoc )\r
[ (flatten-class) ] H{ } make-assoc ;\r
-\r
-: flatten-builtin-class ( class -- assoc )\r
- flatten-class [\r
- dup tuple class<= [ 2drop tuple tuple ] when\r
- ] assoc-map ;\r
-\r
-: class-types ( class -- seq )\r
- flatten-builtin-class keys\r
- [ "type" word-prop ] map natural-sort ;\r
-\r
-: class-type ( class -- tag/f )\r
- class-types dup length 1 = [ first ] [ drop f ] if ;\r
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors classes classes.algebra words kernel
-kernel.private namespaces sequences math math.private
-combinators assocs quotations ;
+USING: accessors classes classes.algebra classes.algebra.private
+words kernel kernel.private namespaces sequences math
+math.private combinators assocs quotations ;
IN: classes.builtin
SYMBOL: builtins
[ swap classes-intersect? ]
} cond ;
-: full-cover ( -- ) builtins get sift [ (flatten-class) ] each ;
+: full-cover ( -- ) builtins get [ (flatten-class) ] each ;
M: anonymous-complement (flatten-class) drop full-cover ;
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: words accessors sequences kernel assocs combinators classes
-classes.algebra classes.builtin namespaces arrays math quotations ;
+classes.algebra classes.algebra.private classes.builtin
+namespaces arrays math quotations ;
IN: classes.intersection
PREDICATE: intersection-class < class
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: classes classes.algebra kernel namespaces make words
-sequences quotations arrays kernel.private assocs combinators ;
+USING: classes classes.algebra classes.algebra.private kernel
+namespaces make words sequences quotations arrays kernel.private
+assocs combinators ;
IN: classes.predicate
PREDICATE: predicate-class < class
! Copyright (C) 2008, 2009 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: classes classes.algebra classes.predicate kernel
-sequences words ;
+USING: classes classes.algebra classes.algebra.private
+classes.predicate kernel sequences words ;
IN: classes.singleton
: singleton-predicate-quot ( class -- quot ) [ eq? ] curry ;
USING: arrays definitions hashtables kernel kernel.private math
namespaces make sequences sequences.private strings vectors
words quotations memory combinators generic classes
-classes.algebra classes.builtin classes.private slots.private
-slots math.private accessors assocs effects ;
+classes.algebra classes.algebra.private classes.builtin
+classes.private slots.private slots math.private accessors
+assocs effects ;
IN: classes.tuple
PREDICATE: tuple-class < class
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: words sequences kernel assocs combinators classes
-classes.algebra namespaces arrays math quotations ;
+classes.algebra classes.algebra.private namespaces arrays math
+quotations ;
IN: classes.union
PREDICATE: union-class < class
! Non-optimizing compiler bugs
[ 1 1 ] [
- "A" "B" <word> [ [ [ 1 ] dip ] 2array 1array modify-code-heap ] keep
+ "A" <uninterned-word> [ [ [ 1 ] dip ] 2array 1array modify-code-heap ] keep
1 swap execute
] unit-test
USING: accessors arrays kernel continuations assocs namespaces
sequences words vocabs definitions hashtables init sets
math math.order classes classes.algebra classes.tuple
-classes.tuple.private generic source-files.errors ;
+classes.tuple.private generic source-files.errors
+kernel.private ;
IN: compiler.units
SYMBOL: old-definitions
\ redefine-error boa
{ { "Continue" t } } throw-restarts drop ;
+<PRIVATE
+
: add-once ( key assoc -- )
2dup key? [ over redefine-error ] when conjoin ;
: (remember-definition) ( definition loc assoc -- )
[ over set-where ] dip add-once ;
+PRIVATE>
+
: remember-definition ( definition loc -- )
new-definitions get first (remember-definition) ;
HOOK: process-forgotten-words compiler-impl ( words -- )
+: compile ( words -- ) recompile modify-code-heap ;
+
! Non-optimizing compiler
M: f recompile
[ dup def>> ] { } map>assoc ;
definition-observers get
[ definitions-changed ] with each ;
+! Incremented each time stack effects potentially changed, used
+! by compiler.tree.propagation.call-effect for call( and execute(
+! inline caching
+: effect-counter ( -- n ) 46 getenv ; inline
+
+GENERIC: bump-effect-counter* ( defspec -- ? )
+
+M: object bump-effect-counter* drop f ;
+
+<PRIVATE
+
: changed-vocabs ( assoc -- vocabs )
[ drop word? ] assoc-filter
[ drop vocabulary>> dup [ vocab ] when dup ] assoc-map ;
dup changed-definitions get update
dup dup changed-vocabs update ;
-: compile ( words -- ) recompile modify-code-heap ;
-
: process-forgotten-definitions ( -- )
forgotten-definitions get keys
[ [ word? ] filter process-forgotten-words ]
[ [ delete-definition-errors ] each ]
bi ;
+: bump-effect-counter? ( -- ? )
+ changed-effects get new-words get assoc-diff assoc-empty? not
+ changed-definitions get [ drop bump-effect-counter* ] assoc-any?
+ or ;
+
+: bump-effect-counter ( -- )
+ bump-effect-counter? [ 46 getenv 0 or 1 + 46 setenv ] when ;
+
+: notify-observers ( -- )
+ updated-definitions dup assoc-empty?
+ [ drop ] [ notify-definition-observers notify-error-observers ] if ;
+
: finish-compilation-unit ( -- )
remake-generics
to-recompile recompile
update-tuples
process-forgotten-definitions
modify-code-heap
- updated-definitions dup assoc-empty?
- [ drop ] [ notify-definition-observers notify-error-observers ] if ;
+ bump-effect-counter
+ notify-observers ;
+
+PRIVATE>
: with-nested-compilation-unit ( quot -- )
[
H{ } clone changed-effects set
H{ } clone outdated-generics set
H{ } clone outdated-tuples set
+ H{ } clone new-words set
H{ } clone new-classes set
[ finish-compilation-unit ] [ ] cleanup
] with-scope ; inline
H{ } clone outdated-generics set
H{ } clone forgotten-definitions set
H{ } clone outdated-tuples set
+ H{ } clone new-words set
H{ } clone new-classes set
<definitions> new-definitions set
<definitions> old-definitions set
SYMBOL: outdated-generics
+SYMBOL: new-words
+
SYMBOL: new-classes
+: new-word ( word -- )
+ dup new-words get set-in-unit ;
+
+: new-word? ( word -- ? )
+ new-words get key? ;
+
: new-class ( word -- )
dup new-classes get set-in-unit ;
PRIVATE>
TUPLE: disposable < identity-tuple
-{ id integer }
{ disposed boolean }
continuation ;
-M: disposable hashcode* nip id>> ;
-
: new-disposable ( class -- disposable )
- new \ disposable counter >>id
- dup register-disposable ; inline
+ new dup register-disposable ; inline
GENERIC: dispose* ( disposable -- )
: parse-effect-tokens ( end -- tokens )
[ parse-effect-token dup ] curry [ ] produce nip ;
-ERROR: stack-effect-omits-dashes effect ;
+ERROR: stack-effect-omits-dashes tokens ;
: parse-effect ( end -- effect )
parse-effect-tokens { "--" } split1 dup
definitions eval generic generic.math generic.standard
hashtables io io.streams.string kernel layouts math math.order
namespaces parser prettyprint quotations sequences sorting
-strings tools.test vectors words generic.single ;
+strings tools.test vectors words generic.single
+compiler.crossref ;
IN: generic.tests
GENERIC: foobar ( x -- y )
$nl
"In certain advanced applications, this cannot be avoided and the best design involves mutating hashtable keys. In this case, a custom " { $link hashcode* } " method must be defined which only depends on immutable slots."
$nl
-"In addition, the " { $link equal? } " and " { $link hashcode* } " methods must be congruent, and if one is defined the other should be defined also. This is documented in detail in the documentation for these respective words." ;
+"In addition, the " { $link equal? } " and " { $link hashcode* } " methods must be congruent, and if one is defined the other should be defined also. This is documented in detail in the documentation for these respective words."
+{ $subsections hashcode hashcode* identity-hashcode } ;
ARTICLE: "hashtables.utilities" "Hashtable utilities"
"Utility words to create a new hashtable from a single key/value pair:"
[ count>> ] [ deleted>> ] bi - ; inline
: rehash ( hash -- )
- dup >alist [
- dup clear-assoc
- ] dip (rehash) ;
+ dup >alist [ dup clear-assoc ] dip (rehash) ;
M: hashtable set-at ( value key hash -- )
dup ?grow-hash
USING: arrays debugger.threads destructors io io.directories
-io.encodings.8-bit io.encodings.ascii io.encodings.binary
+io.encodings.ascii io.encodings.binary
io.files io.files.private io.files.temp io.files.unique kernel
-make math sequences system threads tools.test generic.single ;
+make math sequences system threads tools.test generic.single
+io.encodings.8-bit.latin1 ;
IN: io.files.tests
[ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
[ ] [
"closing-twice" unique-file ascii <file-writer>
[ dispose ] [ dispose ] bi
-] unit-test
\ No newline at end of file
+] unit-test
-USING: help.markup help.syntax io.backend io.files io.directories strings
-sequences io.pathnames.private ;
+USING: help.markup help.syntax io.backend io.files
+io.directories strings system sequences io.pathnames.private ;
IN: io.pathnames
HELP: path-separator?
HELP: normalize-path
{ $values { "path" "a pathname string" } { "path'" "a new pathname string" } }
-{ $description "Prepends the " { $link current-directory } " to the pathname, resolves a " { $snippet "resource:" } " or " { $snippet "voacb:" } " prefix, if present, and performs any platform-specific pathname normalization." }
+{ $description "Prepends the " { $link current-directory } " to the pathname, resolves a " { $snippet "resource:" } " or " { $snippet "vocab:" } " prefix, if present (see " { $link "io.pathnames.special" } "). Also converts the path into a UNC path on Windows." }
{ $notes "High-level words, such as " { $link <file-reader> } " and " { $link delete-file } " call this word for you. It only needs to be called directly when passing pathnames to C functions or external processes. This is because Factor does not use the operating system's notion of a current directory, and instead maintains its own dynamically-scoped " { $link current-directory } " variable." }
{ $notes "On Windows NT platforms, this word does prepends the Unicode path prefix." }
{ $examples
{ "path" "a pathname string" }
{ "path'" "a pathname string" }
}
-{ $description "Prepends the " { $link current-directory } " to the pathname and resolves a " { $snippet "resource:" } " prefix, if present." }
+{ $description "Prepends the " { $link current-directory } " to the pathname and resolves a " { $snippet "resource:" } " or " { $snippet "voacb:" } " prefix, if present (see " { $link "io.pathnames.special" } ")." }
{ $notes "This word is exaclty the same as " { $link normalize-path } ", except on Windows NT platforms, where it does not prepend the Unicode path prefix. Most code should call " { $link normalize-path } " instead." } ;
HELP: resolve-symlinks
}
} ;
+ARTICLE: "io.pathnames.special" "Special pathnames"
+"If a pathname begins with " { $snippet "resource:" } ", it is resolved relative to the directory containing the current image (see " { $link image } ")."
+$nl
+"If a pathname begins with " { $snippet "vocab:" } ", then it will be searched for in all current vocabulary roots (see " { $link "add-vocab-roots" } ")." ;
+
+ARTICLE: "io.pathnames.presentations" "Pathname presentations"
+"Pathname presentations are objects that wrap a pathname string. Clicking a pathname presentation in the UI brings up the file in one of the supported editors. See " { $link "editor" } " for more details."
+{ $subsections
+ pathname
+ <pathname>
+}
+"Literal pathname presentations:"
+{ $subsections POSTPONE: P" }
+"Many words that accept pathname strings can also work on pathname presentations." ;
+
ARTICLE: "io.pathnames" "Pathnames"
-"Pathnames are objects that contain a string representing the path to a file on disk. Pathnames are cross-platform; Windows accepts both forward and backward slashes as directory separators and new separators are added as a forward slash on all platforms. Clicking a pathname object in the UI brings up the file in one of the supported editors, but otherwise, pathnames and strings are interchangeable. See " { $link "editor" } " for more details." $nl
+"Pathnames are strings that refer to a file on disk. Pathname semantics are platform-specific, and Factor makes no attempt to abstract away the differences. Note that on Windows, both forward and backward slashes are accepted as directory separators."
+$nl
"Pathname introspection:"
{ $subsections
parent-directory
prepend-path
append-path
}
-"Pathname presentations:"
-{ $subsections
- pathname
- <pathname>
-}
-"Literal pathnames:"
-{ $subsections POSTPONE: P" }
-"Normalizing pathnames for use with native APIs:"
-{ $subsections normalize-path }
-"Outputting an absolute path from a path:"
-{ $subsection absolute-path }
-"Removing symlinks from a path:"
-{ $subsections resolve-symlinks } ;
+"Normalizing pathnames:"
+{ $subsections normalize-path absolute-path resolve-symlinks }
+"Additional topics:"
+{ $subsections "io.pathnames.presentations" "io.pathnames.special" } ;
ABOUT: "io.pathnames"
[ 2 head ] dip append
] }
[
- [ trim-tail-separators "/" ] dip
- trim-head-separators 3append
+ [ trim-tail-separators ]
+ [ trim-head-separators ] bi* "/" glue
]
} cond ;
{ $values { "obj" object } { "code" fixnum } }
{ $description "Computes the hashcode of an object with a default hashing depth. See " { $link hashcode* } " for the hashcode contract." } ;
-{ hashcode hashcode* } related-words
+HELP: identity-hashcode
+{ $values { "obj" object } { "code" fixnum } }
+{ $description "Outputs the identity hashcode of an object. The identity hashcode is not guaranteed to be unique, however it will not change during the object's lifetime." } ;
+
+{ hashcode hashcode* identity-hashcode } related-words
HELP: =
{ $values { "obj1" object } { "obj2" object } { "?" "a boolean" } }
[ 3 -1 5/6 ] [ 1 2 3 4 5 6 [ + ] [ - ] [ / ] 2tri* ] unit-test
[ { 1 2 } { 3 4 } { 5 6 } ] [ 1 2 3 4 5 6 [ 2array ] 2tri@ ] unit-test
+
+[ t ] [ { } identity-hashcode fixnum? ] unit-test
+[ 123 ] [ 123 identity-hashcode ] unit-test
+[ t ] [ f identity-hashcode fixnum? ] unit-test
: hashcode ( obj -- code ) 3 swap hashcode* ; inline
+: identity-hashcode ( obj -- code )
+ dup tag 0 eq? [
+ dup tag 1 eq? [ drop 0 ] [
+ dup (identity-hashcode) dup 0 eq? [
+ drop dup compute-identity-hashcode
+ (identity-hashcode)
+ ] [ nip ] if
+ ] if
+ ] unless ; inline
+
GENERIC: equal? ( obj1 obj2 -- ? )
M: object equal? 2drop f ; inline
M: identity-tuple equal? 2drop f ; inline
+M: identity-tuple hashcode* nip identity-hashcode ; inline
+
: = ( obj1 obj2 -- ? )
2dup eq? [ 2drop t ] [
2dup both-fixnums? [ 2drop f ] [ equal? ] if
SYMBOL: mega-cache-size
+SYMBOL: header-bits
+
: type-number ( class -- n )
type-numbers get at ;
: tag-fixnum ( n -- tagged )
tag-bits get shift ;
+: tag-header ( n -- tagged )
+ header-bits get shift ;
+
: untag-fixnum ( n -- tagged )
tag-bits get neg shift ;
+: hashcode-shift ( -- n )
+ tag-bits get header-bits get + ;
+
! We do this in its own compilation unit so that they can be
! folded below
<<
2 [ [ [ 3 throw ] instances ] must-fail ] times
! Bug found on Windows build box, having too many words in the image breaks 'become'
-[ ] [ 100000 [ f f <word> ] replicate { } { } become drop ] unit-test
+[ ] [ 100000 [ f <uninterned-word> ] replicate { } { } become drop ] unit-test
M: compose length
[ first>> length ] [ second>> length ] bi + ;
-M: compose virtual-seq first>> ;
+M: compose virtual-exemplar first>> ;
M: compose virtual@
2dup first>> length < [
}
} ;
-HELP: virtual-seq
+HELP: virtual-exemplar
{ $values
{ "seq" sequence }
{ "seq'" sequence } }
-{ $description "Part of the virtual sequence protocol, this word is used to return an underlying array from which to look up a value at an index given by " { $link virtual@ } "." } ;
+{ $description "Part of the virtual sequence protocol, this word is used to return an exemplar of the underlying storage. This is used in words like " { $link new-sequence } "." } ;
HELP: virtual@
{ $values
{ "n" integer } { "seq" sequence }
{ "n'" integer } { "seq'" sequence } }
-{ $description "Part of the sequence protocol, this word translates the input index " { $snippet "n" } " into an index into the underlying storage returned by " { $link virtual-seq } "." } ;
+{ $description "Part of the sequence protocol, this word translates the input index " { $snippet "n" } " into an index and the underlying storage this index points into." } ;
HELP: 2map-reduce
{ $values
ARTICLE: "virtual-sequences-protocol" "Virtual sequence protocol"
"Virtual sequences must know their length:"
{ $subsections length }
-"The underlying sequence to look up a value in:"
-{ $subsections virtual-seq }
-"The index of the value in the underlying sequence:"
+"An exemplar of the underlying storage:"
+{ $subsections virtual-exemplar }
+"The index and the underlying storage where the value is located:"
{ $subsections virtual@ } ;
ARTICLE: "virtual-sequences" "Virtual sequences"
2dup bounds-check? [ nth-unsafe ] [ 2drop f ] if ; inline
MIXIN: virtual-sequence
-GENERIC: virtual-seq ( seq -- seq' )
+GENERIC: virtual-exemplar ( seq -- seq' )
GENERIC: virtual@ ( n seq -- n' seq' )
M: virtual-sequence nth virtual@ nth ; inline
M: virtual-sequence set-nth virtual@ set-nth ; inline
M: virtual-sequence nth-unsafe virtual@ nth-unsafe ; inline
M: virtual-sequence set-nth-unsafe virtual@ set-nth-unsafe ; inline
-M: virtual-sequence like virtual-seq like ; inline
-M: virtual-sequence new-sequence virtual-seq new-sequence ; inline
+M: virtual-sequence like virtual-exemplar like ; inline
+M: virtual-sequence new-sequence virtual-exemplar new-sequence ; inline
INSTANCE: virtual-sequence sequence
C: <reversed> reversed
-M: reversed virtual-seq seq>> ; inline
+M: reversed virtual-exemplar seq>> ; inline
M: reversed virtual@ seq>> [ length swap - 1 - ] keep ; inline
M: reversed length seq>> length ; inline
check-slice
slice boa ; inline
-M: slice virtual-seq seq>> ; inline
+M: slice virtual-exemplar seq>> ; inline
M: slice virtual@ [ from>> + ] [ seq>> ] bi ; inline
[ 0 swap copy ] keep
] new-like ;
-: suffix! ( seq elt -- seq ) over push ;
+: suffix! ( seq elt -- seq ) over push ; inline
-: append! ( seq1 seq2 -- seq1 ) over push-all ;
+: append! ( seq1 seq2 -- seq1 ) over push-all ; inline
: last ( seq -- elt ) [ length 1 - ] [ nth ] bi ;
USING: arrays definitions generic assocs kernel math namespaces
sequences strings vectors words quotations io io.files
io.pathnames combinators sorting splitting math.parser effects
-continuations checksums checksums.crc32 vocabs hashtables graphs
+continuations checksums checksums.crc32 vocabs hashtables
compiler.units io.encodings.utf8 accessors source-files.errors ;
IN: source-files
HELP: <word> ( name vocab -- word )
{ $values { "name" string } { "vocab" string } { "word" word } }
-{ $description "Allocates an uninterned word with the specified name and vocabulary, and a blank word property hashtable. User code should call " { $link gensym } " to create uninterned words and " { $link create } " to create interned words." } ;
+{ $description "Allocates an uninterned word with the specified name and vocabulary, and a blank word property hashtable. User code should call " { $link gensym } " to create uninterned words and " { $link create } " to create interned words." }
+{ $notes "This word must be called from inside " { $link with-compilation-unit } "." } ;
HELP: gensym
{ $values { "word" word } }
HELP: create
{ $values { "name" string } { "vocab" string } { "word" word } }
-{ $description "Creates a new word. If the vocabulary already contains a word with the requested name, outputs the existing word. The vocabulary must exist already; if it does not, you must call " { $link create-vocab } " first." } ;
+{ $description "Creates a new word. If the vocabulary already contains a word with the requested name, outputs the existing word. The vocabulary must exist already; if it does not, you must call " { $link create-vocab } " first." }
+{ $notes "This word must be called from inside " { $link with-compilation-unit } ". Parsing words should call " { $link create-in } " instead of this word." } ;
HELP: constructor-word
{ $values { "name" string } { "vocab" string } { "word" word } }
{ $description "Creates a new word, surrounding " { $snippet "name" } " in angle brackets." }
-{ $examples { $example "USING: prettyprint words ;" "\"salmon\" \"scratchpad\" constructor-word ." "<salmon>" } } ;
+{ $notes "This word must be called from inside " { $link with-compilation-unit } "." }
+{ $examples { $example "USING: compiler.units prettyprint words ;" "[ \"salmon\" \"scratchpad\" constructor-word ] with-compilation-unit ." "<salmon>" } } ;
{ POSTPONE: FORGET: forget forget* forget-vocab } related-words
USING: arrays generic assocs kernel math namespaces
sequences tools.test words definitions parser quotations
vocabs continuations classes.tuple compiler.units
-io.streams.string accessors eval words.symbol ;
+io.streams.string accessors eval words.symbol grouping ;
IN: words.tests
[ 4 ] [
\ plist-test "sample-property" word-prop
] unit-test
-"create-test" "scratchpad" create { 1 2 } "testing" set-word-prop
+[ ] [ [ "create-test" "scratchpad" create { 1 2 } "testing" set-word-prop ] with-compilation-unit ] unit-test
+
[ { 1 2 } ] [
"create-test" "scratchpad" lookup "testing" word-prop
] unit-test
[
[ t ] [ \ array? "array?" "arrays" lookup = ] unit-test
- [ ] [ "test-scope" "scratchpad" create drop ] unit-test
+ [ ] [ [ "test-scope" "scratchpad" create drop ] with-compilation-unit ] unit-test
] with-scope
[ "test-scope" ] [
DEFER: x
[ x ] [ undefined? ] must-fail-with
-[ ] [ "no-loc" "words.tests" create drop ] unit-test
+[ ] [ [ "no-loc" "words.tests" create drop ] with-compilation-unit ] unit-test
[ f ] [ "no-loc" "words.tests" lookup where ] unit-test
[ ] [ "IN: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test
[ { } ]
[
all-words [
- "compiled-uses" word-prop
+ "compiled-uses" word-prop 2 <groups>
keys [ "forgotten" word-prop ] filter
] map harvest
] unit-test
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays definitions graphs kernel
-kernel.private slots.private math namespaces sequences
-strings vectors sbufs quotations assocs hashtables sorting vocabs
-math.order sets words.private ;
+USING: accessors arrays definitions kernel kernel.private
+slots.private math namespaces sequences strings vectors sbufs
+quotations assocs hashtables sorting vocabs math.order sets
+words.private ;
IN: words
: word ( -- word ) \ word get-global ;
] tri ;
: <word> ( name vocab -- word )
- 2dup [ hashcode ] bi@ bitxor >fixnum (word) ;
+ 2dup [ hashcode ] bi@ bitxor >fixnum (word) dup new-word ;
+
+: <uninterned-word> ( name -- word )
+ f \ <uninterned-word> counter >fixnum (word) ;
: gensym ( -- word )
- "( gensym )" f \ gensym counter >fixnum (word) ;
+ "( gensym )" <uninterned-word> ;
: define-temp ( quot effect -- word )
[ gensym dup ] 2dip define-declared ;
: fannkuch ( n -- )
[
- [ 0 0 ] dip [ 1 + ] B{ } map-as
+ [ 0 0 ] dip iota [ 1 + ] B{ } map-as
[ fannkuch-step ] each-permutation nip
] keep
"Pfannkuchen(" write pprint ") = " write . ;
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: calendar.holidays calendar.holidays.canada kernel
+tools.test ;
+IN: calendar.holidays.canada.tests
+
+[ ] [ 2009 canada holidays drop ] unit-test
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: calendar calendar.holidays ;
+IN: calendar.holidays.canada
+
+SINGLETONS: canada canadian-federal ;
+
+HOLIDAY: canadian-thanksgiving-day october 2 monday-of-month ;
+HOLIDAY-NAME: canadian-thanksgiving-day canadian-federal "Thanksgiving Day"
+
+HOLIDAY-NAME: armistice-day commonwealth-of-nations "Remembrance Day"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs calendar fry kernel parser sequences
+shuffle vocabs words memoize ;
+IN: calendar.holidays
+
+SINGLETONS: all world commonwealth-of-nations ;
+
+<<
+SYNTAX: HOLIDAY:
+ CREATE-WORD
+ dup "holiday" word-prop [
+ dup H{ } clone "holiday" set-word-prop
+ ] unless
+ parse-definition (( timestamp/n -- timestamp )) define-declared ;
+
+SYNTAX: HOLIDAY-NAME:
+ scan-word "holiday" word-prop scan-word scan-object spin set-at ;
+>>
+
+GENERIC: holidays ( n singleton -- seq )
+
+<PRIVATE
+
+: (holidays) ( singleton -- seq )
+ all-words swap '[ "holiday" word-prop _ swap key? ] filter ;
+
+M: object holidays
+ (holidays) [ execute( timestamp -- timestamp' ) ] with map ;
+
+PRIVATE>
+
+M: all holidays
+ drop
+ all-words [ "holiday" word-prop key? ] with filter ;
+
+: holiday? ( timestamp/n singleton -- ? )
+ [ holidays ] [ drop ] 2bi '[ _ same-day? ] any? ;
+
+: holiday-assoc ( timestamp singleton -- assoc )
+ (holidays) swap
+ '[ [ _ swap execute( ts -- ts' ) >gmt midnight ] keep ] { } map>assoc ;
+
+: holiday-name ( singleton word -- string/f )
+ "holiday" word-prop at ;
+
+: holiday-names ( timestamp/n singleton -- seq )
+ [
+ [ >gmt midnight ] dip
+ [ drop ] [ holiday-assoc ] 2bi swap
+ '[ drop _ same-day? ] assoc-filter values
+ ] keep '[ _ swap "holiday" word-prop at ] map ;
+
+HOLIDAY: armistice-day november 11 >>day ;
+HOLIDAY-NAME: armistice-day world "Armistice Day"
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: calendar.holidays calendar.holidays.us kernel sequences
+tools.test ;
+IN: calendar.holidays.us.tests
+
+[ 10 ] [ 2009 us-federal holidays length ] unit-test
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs calendar calendar.holidays
+calendar.holidays.private combinators combinators.short-circuit
+fry kernel lexer math namespaces parser sequences shuffle
+vocabs words ;
+IN: calendar.holidays.us
+
+SINGLETONS: us us-federal ;
+
+<PRIVATE
+
+: adjust-federal-holiday ( timestamp -- timestamp' )
+ {
+ { [ dup saturday? ] [ 1 days time- ] }
+ { [ dup sunday? ] [ 1 days time+ ] }
+ [ ]
+ } cond ;
+
+PRIVATE>
+
+M: us-federal holidays
+ (holidays)
+ [ execute( timestamp -- timestamp' ) adjust-federal-holiday ] with map ;
+
+: us-post-office-open? ( timestamp -- ? )
+ { [ sunday? not ] [ us-federal holiday? not ] } 1&& ;
+
+HOLIDAY: new-years-day january 1 >>day ;
+HOLIDAY-NAME: new-years-day world "New Year's Day"
+HOLIDAY-NAME: new-years-day us-federal "New Year's Day"
+
+HOLIDAY: martin-luther-king-day january 3 monday-of-month ;
+HOLIDAY-NAME: martin-luther-king-day us-federal "Martin Luther King Day"
+
+HOLIDAY: inauguration-day year dup 4 neg rem + january 20 >>day ;
+HOLIDAY-NAME: inauguration-day us "Inauguration Day"
+
+HOLIDAY: washingtons-birthday february 3 monday-of-month ;
+HOLIDAY-NAME: washingtons-birthday us-federal "Washington's Birthday"
+
+HOLIDAY: memorial-day may last-monday-of-month ;
+HOLIDAY-NAME: memorial-day us-federal "Memorial Day"
+
+HOLIDAY: independence-day july 4 >>day ;
+HOLIDAY-NAME: independence-day us-federal "Independence Day"
+
+HOLIDAY: labor-day september 1 monday-of-month ;
+HOLIDAY-NAME: labor-day us-federal "Labor Day"
+
+HOLIDAY: columbus-day october 2 monday-of-month ;
+HOLIDAY-NAME: columbus-day us-federal "Columbus Day"
+
+HOLIDAY-NAME: armistice-day us-federal "Veterans Day"
+
+HOLIDAY: thanksgiving-day november 4 thursday-of-month ;
+HOLIDAY-NAME: thanksgiving-day us-federal "Thanksgiving Day"
+
+HOLIDAY: christmas-day december 25 >>day ;
+HOLIDAY-NAME: christmas-day world "Christmas Day"
+HOLIDAY-NAME: christmas-day us-federal "Christmas Day"
+
+HOLIDAY: belly-laugh-day january 24 >>day ;
+
+HOLIDAY: groundhog-day february 2 >>day ;
+
+HOLIDAY: lincolns-birthday february 12 >>day ;
+
+HOLIDAY: valentines-day february 14 >>day ;
+
+HOLIDAY: st-patricks-day march 17 >>day ;
+
+HOLIDAY: ash-wednesday easter 46 days time- ;
+
+ALIAS: first-day-of-lent ash-wednesday
+
+HOLIDAY: fat-tuesday ash-wednesday 1 days time- ;
+
+HOLIDAY: good-friday easter 2 days time- ;
+
+HOLIDAY: tax-day april 15 >>day ;
+
+HOLIDAY: earth-day april 22 >>day ;
+
+HOLIDAY: administrative-professionals-day april last-saturday-of-month wednesday ;
+
+HOLIDAY: cinco-de-mayo may 5 >>day ;
+
+HOLIDAY: mothers-day may 2 sunday-of-month ;
+
+HOLIDAY: armed-forces-day may 3 saturday-of-month ;
+
+HOLIDAY: flag-day june 14 >>day ;
+
+HOLIDAY: parents-day july 4 sunday-of-month ;
+
+HOLIDAY: grandparents-day labor-day 1 weeks time+ ;
+
+HOLIDAY: patriot-day september 11 >>day ;
+
+HOLIDAY: stepfamily-day september 16 >>day ;
+
+HOLIDAY: citizenship-day september 17 >>day ;
+
+HOLIDAY: bosss-day october 16 >>day ;
+
+HOLIDAY: sweetest-day october 3 saturday-of-month ;
+
+HOLIDAY: halloween october 31 >>day ;
+
+HOLIDAY: election-day november 1 monday-of-month 1 days time+ ;
+
+HOLIDAY: black-friday thanksgiving-day 1 days time+ ;
+
+HOLIDAY: pearl-harbor-remembrance-day december 7 >>day ;
+
+HOLIDAY: new-years-eve december 31 >>day ;
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.strings assocs byte-arrays
combinators continuations destructors fry io.encodings.8-bit
-io io.encodings.string io.encodings.utf8 kernel math
+io io.encodings.string io.encodings.utf8 kernel locals math
namespaces prettyprint sequences classes.struct
strings threads curses.ffi ;
IN: curses
+++ /dev/null
-USING: tools.deploy.config ;
-H{
- { deploy-name "drills" }
- { deploy-c-types? t }
- { "stop-after-last-window?" t }
- { deploy-unicode? t }
- { deploy-threads? t }
- { deploy-reflection 6 }
- { deploy-word-defs? t }
- { deploy-math? t }
- { deploy-ui? t }
- { deploy-word-props? t }
- { deploy-io 3 }
-}
+++ /dev/null
-USING: arrays cocoa.dialogs combinators continuations
-fry grouping io.encodings.utf8 io.files io.styles kernel math
-math.parser models models.arrow models.history namespaces random
-sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
-ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
-ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks fonts
-wrap.strings system ;
-EXCLUDE: accessors => change-model ;
-IN: drills.deployed
-SYMBOLS: it startLength ;
-: big ( gadget -- gadget ) T{ font { name "sans-serif" } { size 30 } } >>font ;
-: card ( model quot -- button ) <arrow> <label-control> big [ next ] <book-btn> ;
-: op ( quot str -- gadget ) <label> big swap <book-bevel-btn> ;
-
-: show ( model -- gadget ) dup it set-global [ random ] <arrow>
- { [ [ first ] card ]
- [ [ second ] card ]
- [ '[ |<< it get _ model-changed ] "No" op ]
- [ '[ |<< [ it get [
- _ value>> swap remove
- [ [ it get go-back ] "Drill Complete" alert return ] when-empty
- ] change-model ] with-return ] "Yes" op ]
- } cleave
-2array { 1 0 } <track> swap [ 0.5 track-add ] each
-3array <book*> 3 3 <frame> { 1 1 } >>filled-cell { 450 175 } >>pref-dim swap { 1 1 } grid-add
-it get [ length startLength get swap - number>string "/" startLength get number>string 3append ] <arrow> <label-control> { 1 2 } grid-add ;
-
-: drill ( -- ) [
- open-panel [
- [ utf8 file-lines [ "\t" split [ 25 wrap-string ] map ] map dup [ first2 swap 2array ] map append ] map concat
- [ length startLength set-global ] keep <history> [ add-history ] [ show ] bi
- "Got it?" open-window
- ] [ 0 exit ] if*
-] with-ui ;
-
-MAIN: drill
\ No newline at end of file
+++ /dev/null
-unportable
+++ /dev/null
-USING: arrays cocoa.dialogs combinators continuations
-fry grouping io.encodings.utf8 io.files io.styles kernel math
-math.parser models models.arrow models.history namespaces random
-sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
-ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
-ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks fonts
-wrap.strings ;
-EXCLUDE: accessors => change-model ;
-
-IN: drills
-SYMBOLS: it startLength ;
-: big ( gadget -- gadget ) T{ font { name "sans-serif" } { size 30 } } >>font ;
-: card ( model quot -- button ) <arrow> <label-control> big [ next ] <book-btn> ;
-: op ( quot str -- gadget ) <label> big swap <book-border-btn> ;
-
-: show ( model -- gadget ) dup it set-global [ random ] <arrow>
- { [ [ first ] card ]
- [ [ second ] card ]
- [ '[ |<< it get _ model-changed ] "No" op ]
- [ '[ |<< [ it get [
- _ value>> swap remove
- [ [ it get go-back ] "Drill Complete" alert return ] when-empty
- ] change-model ] with-return ] "Yes" op ]
- } cleave
-2array { 1 0 } <track> swap [ 0.5 track-add ] each
-3array <book*> 3 3 <frame> { 1 1 } >>filled-cell { 450 175 } >>pref-dim swap { 1 1 } grid-add
-it get [ length startLength get swap - number>string "/" startLength get number>string 3append ] <arrow> <label-control> { 1 2 } grid-add ;
-
-: drill ( -- ) [
- open-panel [
- [ utf8 file-lines [ "\t" split [ 25 wrap-string ] map ] map dup [ first2 swap 2array ] map append ] map concat
- [ length startLength set-global ] keep <history> [ add-history ] [ show ] bi
- "Got it?" open-window
- ] when*
-] with-ui ;
-
-MAIN: drill
\ No newline at end of file
+++ /dev/null
-unportable
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators combinators.smart csv io.encodings.8-bit
-math.parser memoize sequences kernel unicode.categories money ;
+math.parser memoize sequences kernel unicode.categories money
+io.encodings.8-bit.latin1 ;
IN: geobytes
! GeoBytes is not free software.
! Copyright (C) 2009 Bruno Deferrari
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors concurrency.mailboxes kernel calendar io.sockets io.encodings.8-bit
-destructors arrays sequences ;
+USING: accessors concurrency.mailboxes kernel calendar io.sockets
+destructors arrays sequences io.encodings.8-bit.latin1 ;
IN: irc.client.chats
CONSTANT: irc-port 6667 ! Default irc port
irc> [ connect>> ] [ reconnect-attempts>> ] bi do-connect ;
: /JOIN ( channel password -- )
- [ " :" swap 3append ] when* "JOIN " prepend irc-print ;
+ [ " :" glue ] when* "JOIN " prepend irc-print ;
: try-connect ( -- stream/f )
irc> profile>> [ server>> ] [ port>> ] bi /CONNECT ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: fry irc.client irc.client.chats kernel namespaces
-sequences threads io.encodings.8-bit io.launcher io splitting
-make mason.common mason.updates calendar math alarms ;
+sequences threads io.launcher io splitting
+make mason.common mason.updates calendar math alarms
+io.encodings.8-bit.latin1 ;
IN: irc.gitbot
: bot-profile ( -- obj )
USING: accessors calendar calendar.format destructors fry io io.encodings.8-bit
io.files io.pathnames irc.client irc.client.chats irc.messages
irc.messages.base kernel make namespaces sequences threads
-irc.logbot.log-line ;
+irc.logbot.log-line io.encodings.8-bit.latin1 ;
IN: irc.logbot
CONSTANT: bot-channel "#concatenative"
target-os get target-cpu get arch ;
: boot-image-name ( -- string )
- "boot." boot-image-arch ".image" 3append ;
+ boot-image-arch "boot." ".image" surround ;
+++ /dev/null
-Sam Anklesaria
+++ /dev/null
-USING: help.markup help.syntax models models.arrow sequences monads ;
-IN: models.combinators
-
-HELP: merge
-{ $values { "models" "a list of models" } { "model" basic-model } }
-{ $description "Creates a model that merges the updates of others" } ;
-
-HELP: filter-model
-{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-model" filter-model } }
-{ $description "Creates a model that uses the updates of another model only when they satisfy a given predicate" } ;
-
-HELP: fold
-{ $values { "model" model } { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } }
-{ $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ;
-
-HELP: switch-models
-{ $values { "model1" model } { "model2" model } { "model'" model } }
-{ $description "Creates a model that starts with the behavior of model2 and switches to the behavior of model1 on its update" } ;
-
-HELP: <mapped>
-{ $values { "model" model } { "quot" "applied to model's value on updates" } { "model" model } }
-{ $description "An expanded version of " { $link <arrow> } ". Use " { $link fmap } " instead." } ;
-
-HELP: when-model
-{ $values { "model" model } { "quot" "called on the model if the quot yields true" } { "cond" "a quotation called on the model's value, yielding a boolean value" } }
-{ $description "Calls quot when model updates if its value meets the condition set in cond" } ;
-
-HELP: with-self
-{ $values { "quot" "quotation that recieves its own return value" } { "model" model } }
-{ $description "Fixed points for models: the quot reacts to the same model to gives" } ;
-
-HELP: #1
-{ $values { "model" model } { "model'" model } }
-{ $description "Moves a model to the top of its dependencies' connections, thus being notified before the others" } ;
-
-ARTICLE: "models.combinators" "Extending models"
-"The " { $vocab-link "models.combinators" } " library expands models to have discrete start and end times. "
-"Also, it provides methods of manipulating and combining models, expecially useful when programming user interfaces: "
-"The output models of some gadgets (see " { $vocab-link "ui.gadgets.controls" } " ) can be manipulated and used as the input models of others. " ;
-
-ABOUT: "models.combinators"
+++ /dev/null
-USING: accessors arrays kernel models models.product monads
-sequences sequences.extras shuffle ;
-FROM: syntax => >> ;
-IN: models.combinators
-
-TUPLE: multi-model < model important? ;
-GENERIC: (model-changed) ( model observer -- )
-: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
-M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ;
-M: multi-model model-activated dup dependencies>> [ value>> ] find nip
- [ swap model-changed ] [ drop ] if* ;
-
-: #1 ( model -- model' ) t >>important? ;
-
-IN: models
-: notify-connections ( model -- )
- dup connections>> dup [ dup multi-model? [ important?>> ] [ drop f ] if ] find-all
- [ second tuck [ remove ] dip prefix ] each
- [ model-changed ] with each ;
-IN: models.combinators
-
-TUPLE: basic-model < multi-model ;
-M: basic-model (model-changed) [ value>> ] dip set-model ;
-: merge ( models -- model ) basic-model <multi-model> ;
-: 2merge ( model1 model2 -- model ) 2array merge ;
-: <basic> ( value -- model ) basic-model new-model ;
-
-TUPLE: filter-model < multi-model quot ;
-M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
- [ set-model ] [ 2drop ] if ;
-: filter-model ( model quot -- filter-model ) [ 1array \ filter-model <multi-model> ] dip >>quot ;
-
-TUPLE: fold-model < multi-model quot base values ;
-M: fold-model (model-changed) 2dup base>> =
- [ [ [ value>> ] [ [ values>> ] [ quot>> ] bi ] bi* swapd reduce* ] keep set-model ]
- [ [ [ value>> ] [ values>> ] bi* push ]
- [ [ [ value>> ] [ [ value>> ] [ quot>> ] bi ] bi* call( val oldval -- newval ) ] keep set-model ] 2bi
- ] if ;
-M: fold-model model-activated drop ;
-: new-fold-model ( deps -- model ) fold-model <multi-model> V{ } clone >>values ;
-: fold ( model oldval quot -- model ) rot 1array new-fold-model swap >>quot
- swap >>value ;
-: fold* ( model oldmodel quot -- model ) over [ [ 2array new-fold-model ] dip >>quot ]
- dip [ >>base ] [ value>> >>value ] bi ;
-
-TUPLE: updater-model < multi-model values updates ;
-M: updater-model (model-changed) [ tuck updates>> =
- [ [ values>> value>> ] keep set-model ]
- [ drop ] if ] keep f swap (>>value) ;
-: updates ( values updates -- model ) [ 2array updater-model <multi-model> ] 2keep
- [ >>values ] [ >>updates ] bi* ;
-
-SYMBOL: switch
-TUPLE: switch-model < multi-model original switcher on ;
-M: switch-model (model-changed) 2dup switcher>> =
- [ [ value>> ] dip over switch = [ nip [ original>> ] keep f >>on model-changed ] [ t >>on set-model ] if ]
- [ dup on>> [ 2drop ] [ [ value>> ] dip over [ set-model ] [ 2drop ] if ] if ] if ;
-: switch-models ( model1 model2 -- model' ) swap [ 2array switch-model <multi-model> ] 2keep
- [ [ value>> >>value ] [ >>original ] bi ] [ >>switcher ] bi* ;
-M: switch-model model-activated [ original>> ] keep model-changed ;
-: >behavior ( event -- behavior ) t >>value ;
-
-TUPLE: mapped-model < multi-model model quot ;
-: new-mapped-model ( model quot class -- mapped-model ) [ over 1array ] dip
- <multi-model> swap >>quot swap >>model ;
-: <mapped> ( model quot -- model ) mapped-model new-mapped-model ;
-M: mapped-model (model-changed)
- [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
- set-model ;
-
-TUPLE: side-effect-model < mapped-model ;
-M: side-effect-model (model-changed) [ value>> ] dip [ quot>> call( old -- ) ] 2keep set-model ;
-
-TUPLE: quot-model < mapped-model ;
-M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
-
-TUPLE: action-value < basic-model parent ;
-: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
-M: action-value model-activated dup parent>> dup activate-model model-changed ; ! a fake dependency of sorts
-
-TUPLE: action < multi-model quot ;
-M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
- [ swap add-connection ] 2keep model-changed ;
-: <action> ( model quot -- action-model ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
-
-TUPLE: collection < multi-model ;
-: <collection> ( models -- product ) collection <multi-model> ;
-M: collection (model-changed)
- nip
- dup dependencies>> [ value>> ] all?
- [ dup [ value>> ] product-value swap set-model ]
- [ drop ] if ;
-M: collection model-activated dup (model-changed) ;
-
-! for side effects
-TUPLE: (when-model) < multi-model quot cond ;
-: when-model ( model quot cond -- model ) rot 1array (when-model) <multi-model> swap >>cond swap >>quot ;
-M: (when-model) (model-changed) [ quot>> ] 2keep
- [ value>> ] [ cond>> ] bi* call( a -- ? ) [ call( model -- ) ] [ 2drop ] if ;
-
-! only used in construction
-: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
-
-USE: models.combinators.templates
-<< { "$>" "<$" "fmap" } [ fmaps ] each >>
+++ /dev/null
-Model combination and manipulation
\ No newline at end of file
+++ /dev/null
-USING: kernel sequences functors fry macros generalizations ;
-IN: models.combinators.templates
-FROM: models.combinators => <collection> #1 ;
-FUNCTOR: fmaps ( W -- )
-W IS ${W}
-w-n DEFINES ${W}-n
-w-2 DEFINES 2${W}
-w-3 DEFINES 3${W}
-w-4 DEFINES 4${W}
-w-n* DEFINES ${W}-n*
-w-2* DEFINES 2${W}*
-w-3* DEFINES 3${W}*
-w-4* DEFINES 4${W}*
-WHERE
-MACRO: w-n ( int -- quot ) dup '[ [ _ narray <collection> ] dip [ _ firstn ] prepend W ] ;
-: w-2 ( a b quot -- mapped ) 2 w-n ; inline
-: w-3 ( a b c quot -- mapped ) 3 w-n ; inline
-: w-4 ( a b c d quot -- mapped ) 4 w-n ; inline
-MACRO: w-n* ( int -- quot ) dup '[ [ _ narray <collection> #1 ] dip [ _ firstn ] prepend W ] ;
-: w-2* ( a b quot -- mapped ) 2 w-n* ; inline
-: w-3* ( a b c quot -- mapped ) 3 w-n* ; inline
-: w-4* ( a b c d quot -- mapped ) 4 w-n* ; inline
-;FUNCTOR
\ No newline at end of file
--- /dev/null
+Sam Anklesaria
\ No newline at end of file
--- /dev/null
+USING: accessors models models.arrow inverse kernel ;
+IN: models.illusion
+
+TUPLE: illusion < arrow ;
+
+: <illusion> ( model quot -- illusion )
+ illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref
+ swap >>quot over >>model [ add-dependency ] keep ;
+
+: <activated-illusion> ( model quot -- illusion ) <illusion> dup activate-model ;
+
+: backtalk ( value object -- )
+ [ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ;
+
+M: illusion update-model ( model -- ) [ [ value>> ] keep backtalk ] with-locked-model ;
\ No newline at end of file
--- /dev/null
+Two Way Arrows
\ No newline at end of file
CONSTRUCTOR: cond-value ( value quot -- cond-value ) ;
-: write-mdb-persistent ( value quot: ( tuple -- assoc ) -- value' )
+: write-mdb-persistent ( value quot -- value' )
over [ call( tuple -- assoc ) ] dip
[ [ tuple-collection name>> ] [ >toid ] bi ] keep
[ add-storable ] dip
- [ tuple-collection name>> ] [ id>> ] bi <objref> ; inline
+ [ tuple-collection name>> ] [ id>> ] bi <objref> ;
-: write-field ( value quot: ( tuple -- assoc ) -- value' )
+: write-field ( value quot -- value' )
<cond-value> {
{ [ dup value>> mdb-special-value? ] [ value>> ] }
{ [ dup value>> mdb-persistent? ]
{ [ dup value>> [ hashtable? ] [ linked-assoc? ] bi or ]
[ [ value>> ] [ quot>> ] bi '[ _ write-field ] assoc-map ] }
[ value>> ]
- } cond ; inline recursive
+ } cond ;
: write-tuple-fields ( mirror tuple assoc quot: ( tuple -- assoc ) -- )
swap ! m t q q a
\ fake H{ } clone "multi-methods" set-word-prop
<< (( -- )) \ fake set-stack-effect >>
-[ "fake-{ }" ] [ { } \ fake method-word-name ] unit-test
+[
+ [ "fake-{ }" ] [ { } \ fake method-word-name ] unit-test
-[ H{ { "multi-method-generic" fake } { "multi-method-specializer" { } } } ]
-[ { } \ fake method-word-props ] unit-test
+ [ H{ { "multi-method-generic" fake } { "multi-method-specializer" { } } } ]
+ [ { } \ fake method-word-props ] unit-test
-[ t ] [ { } \ fake <method> method-body? ] unit-test
+ [ t ] [ { } \ fake <method> method-body? ] unit-test
-[
[ { } [ ] ] [ \ fake methods prepare-methods [ sort-methods ] dip ] unit-test
[ t ] [ { } \ fake multi-dispatch-quot callable? ] unit-test
USING: namespaces math partial-continuations tools.test
-kernel sequences ;
+kernel sequences fry ;
IN: partial-continuations.tests
SYMBOL: sum
: range ( r from to -- n )
over - 1 + rot [
- -rot [ over + pick call drop ] each 2drop f
+ '[ over + @ drop ] each drop f
] bshift 2nip ; inline
[ 55 ] [
--- /dev/null
+USING: project-euler.062 tools.test ;
+IN: project-euler.062.tests
+
+[ 127035954683 ] [ euler062 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays assocs hashtables kernel math math.functions
+project-euler.common sequences sorting ;
+IN: project-euler.062
+
+! http://projecteuler.net/index.php?section=problems&id=062
+
+! DESCRIPTION
+! -----------
+
+! The cube, 41063625 (345^3), can be permuted to produce two
+! other cubes: 56623104 (384^3) and 66430125 (405^3). In
+! fact, 41063625 is the smallest cube which has exactly three
+! permutations of its digits which are also cube.
+
+! Find the smallest cube for which exactly five permutations of
+! its digits are cube.
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: cube ( n -- n^3 ) 3 ^ ; inline
+: >key ( n -- k ) cube number>digits natural-sort ; inline
+: has-entry? ( n assoc -- ? ) [ >key ] dip key? ; inline
+
+: (euler062) ( n assoc -- n )
+ 2dup has-entry? [
+ 2dup [ >key ] dip
+ [ dup 0 swap [ 1 + ] change-nth ] change-at
+ 2dup [ >key ] dip at first 5 =
+ [
+ [ >key ] dip at second
+ ] [
+ [ 1 + ] dip (euler062)
+ ] if
+ ] [
+ 2dup 1 pick cube 2array -rot
+ [ >key ] dip set-at [ 1 + ] dip
+ (euler062)
+ ] if ;
+
+PRIVATE>
+
+: euler062 ( -- answer )
+ 1 1 <hashtable> (euler062) ;
+
+! [ euler062 ] 100 ave-time
+! 78 ms ave run time - 0.9 SD (100 trials)
+
+SOLUTION: euler062
--- /dev/null
+Guillaume Nargeot
$nl
"A nicer word for interactive use is " { $link ave-time } "." } ;
-HELP: nth-place
-{ $values { "x" float } { "n" integer } { "y" float } }
-{ $description "Rounds a floating point number to " { $snippet "n" } " decimal places." }
-{ $examples
- "This word is useful for display purposes when showing 15 decimal places is not desired:"
- { $unchecked-example "3.141592653589793 3 nth-place number>string" "\"3.142\"" }
-} ;
-
HELP: ave-time
{ $values { "quot" quotation } { "n" integer } }
{ $description "Runs a quotation " { $snippet "n" } " times, then prints the average run time and standard deviation." }
--- /dev/null
+IN: project-euler.ave-time.tests
+USING: tools.test math arrays project-euler.ave-time ;
+
+{ 0 3 } [ 1 2 [ + ] 10 collect-benchmarks ] must-infer-as
+[ 1 2 t ] [ 1 2 [ + ] 10 collect-benchmarks array? ] unit-test
! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: continuations fry io kernel make math math.functions
-math.parser math.statistics memory tools.time ;
+USING: combinators.smart formatting fry io kernel macros math
+math.functions math.statistics memory sequences tools.time ;
IN: project-euler.ave-time
-: nth-place ( x n -- y )
- 10^ [ * round >integer ] keep /f ;
-
-: collect-benchmarks ( quot n -- seq )
- [
- [ datastack ]
- [
- '[ _ gc benchmark 1000 / , ]
- [ '[ _ _ with-datastack drop ] ] keep swap
- ]
- [ 1 - ] tri* swap times call
- ] { } make ; inline
+MACRO: collect-benchmarks ( quot n -- seq )
+ swap '[ _ [ [ [ _ nullary ] preserving ] gc benchmark 1000 / ] replicate ] ;
: ave-time ( quot n -- )
- [ collect-benchmarks ] keep swap
- [ std 2 nth-place ] [ mean round >integer ] bi [
- # " ms ave run time - " % # " SD (" % # " trials)" %
- ] "" make print flush ; inline
+ [
+ collect-benchmarks
+ [ mean round >integer ]
+ [ std ] bi
+ ] keep
+ "%d ms ave run time - %.2f SD (%d trials)\n" printf flush ; inline
project-euler.045 project-euler.046 project-euler.047 project-euler.048
project-euler.049 project-euler.051 project-euler.052 project-euler.053
project-euler.054 project-euler.055 project-euler.056 project-euler.057
- project-euler.058 project-euler.059 project-euler.063 project-euler.065
- project-euler.067 project-euler.069 project-euler.071 project-euler.072
- project-euler.073 project-euler.074 project-euler.075 project-euler.076
- project-euler.079 project-euler.081 project-euler.085 project-euler.092
- project-euler.097 project-euler.099 project-euler.100 project-euler.102
- project-euler.112 project-euler.116 project-euler.117 project-euler.124
- project-euler.134 project-euler.148 project-euler.150 project-euler.151
- project-euler.164 project-euler.169 project-euler.173 project-euler.175
- project-euler.186 project-euler.188 project-euler.190 project-euler.203
- project-euler.215 ;
+ project-euler.058 project-euler.059 project-euler.062 project-euler.063
+ project-euler.065 project-euler.067 project-euler.069 project-euler.071
+ project-euler.072 project-euler.073 project-euler.074 project-euler.075
+ project-euler.076 project-euler.079 project-euler.081 project-euler.085
+ project-euler.092 project-euler.097 project-euler.099 project-euler.100
+ project-euler.102 project-euler.112 project-euler.116 project-euler.117
+ project-euler.124 project-euler.134 project-euler.148 project-euler.150
+ project-euler.151 project-euler.164 project-euler.169 project-euler.173
+ project-euler.175 project-euler.186 project-euler.188 project-euler.190
+ project-euler.203 project-euler.215 ;
IN: project-euler
<PRIVATE
+++ /dev/null
-Sam Anklesaria
\ No newline at end of file
+++ /dev/null
-USING: accessors arrays colors.constants combinators
-db.sqlite db.tuples db.types kernel locals math
-monads persistency sequences sequences.extras ui ui.gadgets.controls
-ui.gadgets.layout models.combinators ui.gadgets.labels
-ui.gadgets.scrollers ui.pens.solid io.files.temp ;
-FROM: sets => prune ;
-IN: recipes
-
-STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
-: <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title 0 >>votes ;
-"recipes.db" temp-file <sqlite-db> recipe define-db
-: top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
- "votes" >>order 30 >>limit swap >>offset get-tuples ;
-: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 short head-slice ;
-
-: interface ( -- book ) [
- [
- [ $ TOOLBAR $ ] <hbox> COLOR: AliceBlue <solid> >>interior ,
- [ "Genres:" <label> , <spacer> $ ALL $ $ GENRES $ ] <hbox>
- { 5 0 } >>gap COLOR: gray <solid> >>interior ,
- $ RECIPES $
- ] <vbox> ,
- [
- [ "Title:" <label> , $ TITLE $ "Genre:" <label> , $ GENRE $ ] <hbox> ,
- $ BODY $
- $ BUTTON $
- ] <vbox> ,
- ] <book*> { 350 245 } >>pref-dim ;
-
-:: recipe-browser ( -- ) [ [
- interface
- <table*> :> tbl
- "okay" <model-border-btn> BUTTON -> :> ok
- IMG-MODEL-BTN: submit [ store-tuple ] >>value TOOLBAR -> :> submit
- IMG-MODEL-BTN: love 1 >>value TOOLBAR ->
- IMG-MODEL-BTN: hate -1 >>value -> 2array merge :> votes
- IMG-MODEL-BTN: back -> [ -30 ] <$
- IMG-MODEL-BTN: more -> [ 30 ] <$ 2array merge :> viewed
- <spacer> <model-field*> ->% 1 :> search
- submit ok [ [ drop ] ] <$ 2array merge [ drop ] >>value :> quot
- viewed 0 [ + ] fold search ok t <basic> "all" <model-btn> ALL ->
- tbl selection>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
- 4array merge
- [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> ups
- ups [ top-genres [ <model-btn> GENRES -> ] map merge ] bind*
- [ text>> T{ recipe } swap >>genre get-tuples ] fmap
- tbl swap ups 2merge >>model
- [ [ title>> ] [ genre>> ] bi 2array ] >>quot
- { "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1 actions>>
- submit [ "" dup dup <recipe> ] <$ 2array merge
- { [ [ title>> ] fmap <model-field> TITLE ->% .5 ]
- [ [ genre>> ] fmap <model-field> GENRE ->% .5 ]
- [ [ txt>> ] fmap <model-editor> BODY ->% 1 ]
- } cleave
- [ <recipe> ] 3fmap
- [ [ 1 ] <$ ]
- [ quot ok updates #1 [ call( recipe -- ) 0 ] 2fmap ] bi
- 2merge 0 <basic> switch-models >>model
- ] with-interface "recipes" open-window ] with-ui ;
-
-MAIN: recipe-browser
\ No newline at end of file
+++ /dev/null
-Database backed recipe sharing
\ No newline at end of file
! Copyright (C) 2009 Bruno Deferrari
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors io io.encodings.8-bit io.sockets
-io.streams.duplex kernel redis.command-writer
-redis.response-parser splitting ;
+USING: accessors io io.sockets io.streams.duplex kernel
+redis.command-writer redis.response-parser splitting
+io.encodings.8-bit.latin1 ;
IN: redis
#! Connection
M: modified length seq>> length ;
M: modified set-length seq>> set-length ;
-M: 1modified virtual-seq seq>> ;
+M: 1modified virtual-exemplar seq>> ;
TUPLE: scaled < 1modified c ;
C: <scaled> scaled
M: summed set-length ( n seq -- )
seqs>> [ set-length ] with each ;
-M: summed virtual-seq ( summed -- seq ) [ ] { } map-as ;
+M: summed virtual-exemplar ( summed -- seq )
+ seqs>> [ f ] [ first ] if-empty ;
: <2summed> ( seq seq -- summed-seq ) 2array <summed> ;
: <3summed> ( seq seq seq -- summed-seq ) 3array <summed> ;
M: repeating virtual@ ( n seq -- n' seq' ) circular>> ;
-M: repeating virtual-seq circular>> ;
+M: repeating virtual-exemplar circular>> ;
INSTANCE: repeating virtual-sequence
: peek-url ( unique-deque -- todo-url ) deque>> peek-front ;
-:: slurp-deque-when ( deque quot1 quot2: ( value -- ) -- )
+:: slurp-deque-when ( deque quot1: ( value -- ) quot2: ( value -- ) -- )
deque deque-empty? [
deque pop-front dup quot1 call
[ quot2 call t ] [ drop f ] if
+++ /dev/null
-Sam Anklesaria
\ No newline at end of file
+++ /dev/null
-USING: accessors arrays combinators.short-circuit grouping kernel lists
-lists.lazy locals math math.functions math.parser math.ranges
-models.product monads random sequences sets ui ui.gadgets.controls
-ui.gadgets.layout models.combinators ui.gadgets.alerts vectors fry
-ui.gadgets.labels shuffle ;
-IN: sudokus
-
-: row ( index -- row ) 1 + 9 / ceiling ;
-: col ( index -- col ) 9 mod 1 + ;
-: sq ( index -- square ) [ row ] [ col ] bi [ 3 / ceiling ] bi@ 2array ;
-: near ( a pos -- ? ) { [ [ row ] bi@ = ] [ [ col ] bi@ = ] [ [ sq ] bi@ = ] } 2|| ;
-: nth-or-lower ( n seq -- elt ) [ length 1 - 2dup > [ nip ] [ drop ] if ] keep nth ;
-
-:: solutions ( puzzle random? -- solutions )
- f puzzle random? [ indices [ f ] [ random? swap nth-or-lower ] if-empty ] [ index ] if
- [ :> pos
- 1 9 [a,b] 80 iota [ pos near ] filter [ puzzle nth ] map prune diff
- [ 1array puzzle pos cut-slice rest surround ] map >list [ random? solutions ] bind
- ] [ puzzle list-monad return ] if* ;
-
-: solution ( puzzle random? -- solution ) dupd solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if ;
-: hint ( puzzle -- puzzle' ) [ [ f swap indices random dup ] [ f solution ] bi nth ] keep swapd >vector [ set-nth ] keep ;
-: create ( difficulty -- puzzle ) 81 [ f ] replicate
- 40 random solution [ [ f swap [ length random ] keep set-nth ] curry times ] keep ;
-
-: do-sudoku ( -- ) [ [
- [
- 81 [ "" ] replicate <basic> switch-models [ [ <basic> ] map 9 group [ 3 group ] map 3 group
- [ [ [ <spacer> [ [ <model-field> ->% 2 [ string>number ] fmap ]
- map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product>
- [ "Difficulty:" <label> , "1" <basic> <model-field> -> [ string>number 1 or 1 + 10 * ] fmap
- "Generate" <model-border-btn> -> updates [ create ] fmap <spacer>
- "Hint" <model-border-btn> -> "Solve" <model-border-btn> -> ] <hbox> ,
- roll [ swap updates ] curry bi@
- [ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array merge [ [ [ number>string ] [ "" ] if* ] map ] fmap
- ] bind
- ] with-self , ] <vbox> { 280 220 } >>pref-dim
- "Sudoku Sleuth" open-window ] with-ui ;
-
-MAIN: do-sudoku
+++ /dev/null
-graphical sudoku solver
\ No newline at end of file
+++ /dev/null
-USING: accessors models monads macros generalizations kernel
-ui ui.gadgets.controls models.combinators ui.gadgets.layout ui.gadgets
-ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
-ui.gadgets.packs locals sequences fonts io.styles
-wrap.strings ;
-
-IN: ui.gadgets.alerts
-:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align
- string 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
- "okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
-
-: alert* ( str -- ) [ ] swap alert ;
-
-:: ask-user ( string -- model' )
- [
- string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , :> lbl
- <model-field*> ->% 1 :> fldm
- "okay" <model-border-btn> :> btn
- btn -> [ fldm swap updates ]
- [ [ drop lbl close-window ] $> , ] bi
- ] <vbox> { 161 86 } >>pref-dim "" open-window ;
-
-MACRO: ask-buttons ( buttons -- quot ) dup length [
- [ swap
- [ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
- [ [ <model-border-btn> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
- "" open-window
- ] dip firstn
- ] 2curry ;
+++ /dev/null
-Sam Anklesaria
\ No newline at end of file
+++ /dev/null
-Really simple dialog boxes
\ No newline at end of file
+++ /dev/null
-Sam Anklesaria
\ No newline at end of file
+++ /dev/null
-USING: accessors arrays kernel math.rectangles sequences
-ui.gadgets.controls models.combinators ui.gadgets ui.gadgets.glass
-ui.gadgets.labels ui.gestures ;
-QUALIFIED-WITH: ui.gadgets.tables tbl
-IN: ui.gadgets.comboboxes
-
-TUPLE: combo-table < table spawner ;
-
-M: combo-table handle-gesture [ call-next-method drop ] 2keep swap
- T{ button-up } = [
- [ spawner>> ]
- [ tbl:selected-row [ swap set-control-value ] [ 2drop ] if ]
- [ hide-glass ] tri
- ] [ drop ] if t ;
-
-TUPLE: combobox < label-control table ;
-combobox H{
- { T{ button-down } [ dup table>> over >>spawner <zero-rect> show-glass ] }
-} set-gestures
-
-: <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <basic> >>model ] keep
- <basic> combo-table new-table [ 1array ] >>quot >>table ;
\ No newline at end of file
+++ /dev/null
-Combo boxes have a model choosen from a list of options
\ No newline at end of file
+++ /dev/null
-Sam Anklesaria
+++ /dev/null
-USING: accessors help.markup help.syntax ui.gadgets.buttons
-ui.gadgets.editors models ui.gadgets ;
-IN: ui.gadgets.controls
-
-HELP: <model-btn>
-{ $values { "gadget" "the button's label" } { "button" button } }
-{ $description "Creates an button whose signal updates on clicks. " } ;
-
-HELP: <model-border-btn>
-{ $values { "text" "the button's label" } { "button" button } }
-{ $description "Creates an button whose signal updates on clicks. " } ;
-
-HELP: <table>
-{ $values { "model" "values the table is to display" } { "table" table } }
-{ $description "Creates an " { $link table } } ;
-
-HELP: <table*>
-{ $values { "table" table } }
-{ $description "Creates an " { $link table } " with no initial values to display" } ;
-
-HELP: <list>
-{ $values { "column-model" "values the table is to display" } { "table" table } }
-{ $description "Creates an " { $link table } " with a val-quot that renders each element as its own row" } ;
-
-HELP: <list*>
-{ $values { "table" table } }
-{ $description "Creates an model-list with no initial values to display" } ;
-
-HELP: indexed
-{ $values { "table" table } }
-{ $description "Sets the output model of an table to the selected-index, rather than the selected-value" } ;
-
-HELP: <model-field>
-{ $values { "model" model } { "gadget" model-field } }
-{ $description "Creates a field with an initial value" } ;
-
-HELP: <model-field*>
-{ $values { "field" model-field } }
-{ $description "Creates a field with an empty initial value" } ;
-
-HELP: <empty-field>
-{ $values { "model" model } { "field" model-field } }
-{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
-
-HELP: <model-editor>
-{ $values { "model" model } { "gadget" model-field } }
-{ $description "Creates an editor with an initial value" } ;
-
-HELP: <model-editor*>
-{ $values { "editor" "an editor" } }
-{ $description "Creates a editor with an empty initial value" } ;
-
-HELP: <empty-editor>
-{ $values { "model" model } { "editor" "an editor" } }
-{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
-
-HELP: <model-action-field>
-{ $values { "field" action-field } }
-{ $description "Field that updates its model with its contents when the user hits the return key" } ;
-
-HELP: IMG-MODEL-BTN:
-{ $syntax "IMAGE-MODEL-BTN: filename" }
-{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path" } ;
-
-HELP: IMG-BTN:
-{ $syntax "[ do-something ] IMAGE-BTN: filename" }
-{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path, calling the specified quotation on click" } ;
-
-HELP: output-model
-{ $values { "gadget" gadget } { "model" model } }
-{ $description "Returns the model a gadget uses for output. Often the same as " { $link model>> } } ;
\ No newline at end of file
+++ /dev/null
-USING: accessors assocs arrays kernel models monads sequences
-models.combinators ui.gadgets ui.gadgets.borders ui.gadgets.buttons
-ui.gadgets.buttons.private ui.gadgets.editors ui.gadgets.editors.private
-words images.loader ui.gadgets.scrollers ui.images vocabs.parser lexer
-models.range ui.gadgets.sliders ;
-QUALIFIED-WITH: ui.gadgets.sliders slider
-QUALIFIED-WITH: ui.gadgets.tables tbl
-EXCLUDE: ui.gadgets.editors => model-field ;
-IN: ui.gadgets.controls
-
-TUPLE: model-btn < button hook value ;
-: <model-btn> ( gadget -- button ) [
- [ dup hook>> [ call( button -- ) ] [ drop ] if* ]
- [ [ [ value>> ] [ ] bi or ] keep set-control-value ]
- [ model>> f swap (>>value) ] tri
- ] model-btn new-button f <basic> >>model ;
-: <model-border-btn> ( text -- button ) <model-btn> border-button-theme ;
-
-TUPLE: table < tbl:table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment actions ;
-M: table tbl:column-titles column-titles>> ;
-M: table tbl:column-alignment column-alignment>> ;
-M: table tbl:row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ;
-M: table tbl:row-value val-quot>> [ call( a -- b ) ] [ drop f ] if* ;
-M: table tbl:row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
-
-: new-table ( model class -- table ) f swap tbl:new-table dup >>renderer
- f <basic> >>actions dup actions>> [ set-model ] curry >>action ;
-: <table> ( model -- table ) table new-table ;
-: <table*> ( -- table ) V{ } clone <model> <table> ;
-: <list> ( column-model -- table ) <table> [ 1array ] >>quot ;
-: <list*> ( -- table ) V{ } clone <model> <list> ;
-: indexed ( table -- table ) f >>val-quot ;
-
-TUPLE: model-field < field model* ;
-: init-field ( model -- model' ) [ [ ] [ "" ] if* ] change-value ;
-: <model-field> ( model -- gadget ) model-field new-field swap init-field >>model* ;
-M: model-field graft*
- [ [ model*>> value>> ] [ editor>> ] bi set-editor-string ]
- [ dup editor>> model>> add-connection ]
- [ dup model*>> add-connection ] tri ;
-M: model-field ungraft*
- [ dup editor>> model>> remove-connection ]
- [ dup model*>> remove-connection ] bi ;
-M: model-field model-changed 2dup model*>> =
- [ [ value>> ] [ editor>> ] bi* set-editor-string ]
- [ nip [ editor>> editor-string ] [ model*>> ] bi set-model ] if ;
-
-: (new-field) ( editor field -- gadget ) [ new-editor ] dip new-border dup gadget-child >>editor
- field-theme { 1 0 } >>align ; inline
-: <model-field*> ( -- field ) "" <model> <model-field> ;
-: <empty-field> ( model -- field ) "" <model> switch-models <model-field> ;
-: <model-editor> ( model -- gadget ) multiline-editor model-field (new-field) swap init-field >>model* ;
-: <model-editor*> ( -- editor ) "" <model> <model-editor> ;
-: <empty-editor> ( model -- editor ) "" <model> switch-models <model-editor> ;
-
-: <model-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
- f <model> >>model ;
-
-: <slider> ( init page min max step -- slider ) <range> horizontal slider:<slider> ;
-
-: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> dup cached-image drop ;
-SYNTAX: IMG-MODEL-BTN: image-prep [ <model-btn> ] curry append! ;
-
-SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry append! ;
-
-GENERIC: output-model ( gadget -- model )
-M: gadget output-model model>> ;
-M: table output-model dup val-quot>> [ selection>> ] [ selection-index>> ] if ;
-M: model-field output-model model*>> ;
-M: scroller output-model viewport>> children>> first output-model ;
-M: slider output-model model>> range-model ;
-
-IN: accessors
-M: model-btn text>> children>> first text>> ;
-
-IN: ui.gadgets.controls
-
-SINGLETON: gadget-monad
-INSTANCE: gadget-monad monad
-INSTANCE: gadget monad
-M: gadget monad-of drop gadget-monad ;
-M: gadget-monad return drop <gadget> swap >>model ;
-M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
+++ /dev/null
-Gadgets with expanded model usage
\ No newline at end of file
+++ /dev/null
-Sam Anklesaria
+++ /dev/null
-USING: help.markup help.syntax models ui.gadgets.tracks ;
-IN: ui.gadgets.layout
-
-HELP: ,
-{ $values { "item" "a gadget or model" } }
-{ $description "Used in a series of gadgets created by a box, accumulating the gadget" } ;
-
-HELP: ,%
-{ $syntax "gadget ,% width" }
-{ $description "Like ',' but stretches the gadget to always fill a percent of the parent" } ;
-
-HELP: ->
-{ $values { "uiitem" "a gadget or model" } { "model" model } }
-{ $description "Like ',' but passes its model on for further use." } ;
-
-HELP: ->%
-{ $syntax "gadget ,% width" }
-{ $description "Like '->' but stretches the gadget to always fill a percent of the parent" } ;
-
-HELP: <spacer>
-{ $description "Grows to fill any empty space in a box" } ;
-
-HELP: <hbox>
-{ $values { "gadgets" "a list of gadgets" } { "track" track } }
-{ $syntax "[ gadget , gadget , ... ] <hbox>" }
-{ $description "Creates an horizontal track containing the gadgets listed in the quotation" } ;
-
-HELP: <vbox>
-{ $values { "gadgets" "a list of gadgets" } { "track" track } }
-{ $syntax "[ gadget , gadget , ... ] <hbox>" }
-{ $description "Creates an vertical track containing the gadgets listed in the quotation" } ;
-
-HELP: $
-{ $syntax "$ PLACEHOLDER-NAME $" }
-{ $description "Defines an insertion point in a template named PLACEHOLDER-NAME which can be used by calling its name" } ;
-
-HELP: with-interface
-{ $values { "quot" "quotation that builds a template and inserts into it" } }
-{ $description "Create templates, used with " { $link POSTPONE: $ } } ;
-
-ARTICLE: "ui.gadgets.layout" "GUI Layout"
-"Laying out GUIs works the same way as building lists with " { $vocab-link "make" }
-". Gadgets are layed out using " { $vocab-link "ui.gadgets.tracks" } " through " { $link <hbox> } " and " { $link <vbox> } ", which allow both fixed and percentage widths. "
-{ $link , } " and " { $link -> } " add a model or gadget to the gadget you're building. "
-"Also, books can be made with " { $link <book> } ". "
-{ $link <spacer> } "s add flexable space between items. " $nl
-"Using " { $link with-interface } ", one can pre-build templates to add items to later: "
-"Like in the StringTemplate framework for java, placeholders are defined using $ PLACERHOLDER-NAME $ "
-"Using PLACEHOLDER-NAME again sets it as the current insertion point. "
-"For examples using normal layout, see the " { $vocab-link "sudokus" } " demo. "
-"For examples of templating, see the " { $vocab-link "recipes" } " demo. " ;
-
-ABOUT: "ui.gadgets.layout"
\ No newline at end of file
+++ /dev/null
-USING: accessors assocs arrays fry kernel lexer make math.parser
-models monads namespaces parser sequences
-sequences.extras models.combinators ui.gadgets
-ui.gadgets.tracks words ui.gadgets.controls ;
-QUALIFIED: make
-QUALIFIED-WITH: ui.gadgets.books book
-IN: ui.gadgets.layout
-
-SYMBOL: templates
-TUPLE: layout gadget size ; C: <layout> layout
-TUPLE: placeholder < gadget members ;
-: <placeholder> ( -- placeholder ) placeholder new V{ } clone >>members ;
-
-: (remove-members) ( placeholder members -- ) [ [ model? ] filter swap parent>> model>> [ remove-connection ] curry each ]
- [ nip [ gadget? ] filter [ unparent ] each ] 2bi ;
-
-: remove-members ( placeholder -- ) dup members>> [ drop ] [ [ (remove-members) ] keep delete-all ] if-empty ;
-: add-member ( obj placeholder -- ) over layout? [ [ gadget>> ] dip ] when members>> push ;
-
-: , ( item -- ) make:, ;
-: make* ( quot -- list ) { } make ; inline
-
-! Just take the previous mentioned placeholder and use it
-! If there is no previously mentioned placeholder, we're probably making a box, and will create the placeholder ourselves
-DEFER: with-interface
-: insertion-quot ( quot -- quot' )
- make:building get [ [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
- [ templates get ] 2dip swap '[ [ _ templates set _ , @ ] with-interface ] ] when* ;
-
-SYNTAX: ,% scan string>number [ <layout> , ] curry append! ;
-SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] append! ;
-
-GENERIC: -> ( uiitem -- model )
-M: gadget -> dup , output-model ;
-M: model -> dup , ;
-
-: <spacer> ( -- ) <gadget> 1 <layout> , ;
-
-: add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ;
-: layouts ( sized? gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter swap
- [ [ dup layout? [ f <layout> ] unless ] map ]
- [ [ dup gadget? [ gadget>> ] unless ] map ] if ;
-: make-layout ( building sized? -- models layouts ) [ swap layouts ] curry
- [ make* [ [ model? ] filter ] ] dip bi ; inline
-: <box> ( gadgets type -- track )
- [ t make-layout ] dip <track>
- swap [ add-layout ] each
- swap [ <collection> >>model ] unless-empty ; inline
-: <hbox> ( gadgets -- track ) horizontal <box> ; inline
-: <vbox> ( gadgets -- track ) vertical <box> ; inline
-
-: make-book ( models gadgets model -- book ) book:<book> swap [ "No models in books" throw ] unless-empty ;
-: <book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
-: <book*> ( quot -- book ) f make-layout f make-book ; inline
-
-ERROR: not-in-template word ;
-SYNTAX: $ CREATE-WORD dup
- [ [ dup templates get at [ nip , ] [ not-in-template ] if* ] curry (( -- )) define-declared "$" expect ]
- [ [ <placeholder> [ swap templates get set-at ] keep , ] curry ] bi append! ;
-
-: insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ;
-: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
-: insertion-point ( placeholder -- number parent ) dup parent>> [ children>> index ] keep ;
-
-GENERIC: >layout ( gadget -- layout )
-M: gadget >layout f <layout> ;
-M: layout >layout ;
-
-GENERIC# (add-gadget-at) 2 ( parent item n -- )
-M: gadget (add-gadget-at) -rot [ add-gadget ] keep insert-gadget ;
-M: track (add-gadget-at) -rot >layout [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
-
-GENERIC# add-gadget-at 1 ( item location -- )
-M: object add-gadget-at insertion-point -rot (add-gadget-at) ;
-M: model add-gadget-at parent>> dup book:book? [ "No models in books" throw ]
- [ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip (>>model) ] if ] if ;
-: track-add-at ( item location size -- ) swap [ <layout> ] dip add-gadget-at ;
-: (track-add-at) ( parent item n size -- ) swap [ <layout> ] dip (add-gadget-at) ;
-
-: insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
- [ add-member ] 2keep add-gadget-at ;
-
-: insert-items ( makelist -- ) t swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
-
-: with-interface ( quot -- ) [ make* ] curry H{ } clone templates rot with-variable [ insert-items ] with-scope ; inline
-
-M: model >>= [ swap insertion-quot <action> ] curry ;
-M: model fmap insertion-quot <mapped> ;
-M: model $> insertion-quot side-effect-model new-mapped-model ;
-M: model <$ insertion-quot quot-model new-mapped-model ;
+++ /dev/null
-Syntax for easily building GUIs and using templates
\ No newline at end of file
+++ /dev/null
-Sam Anklesaria
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Sam Anklesaria
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays accessors combinators kernel math
-models models.combinators namespaces sequences
-ui.gadgets ui.gadgets.controls ui.gadgets.layout
-ui.gadgets.tracks ui.gestures ui.gadgets.line-support ;
-EXCLUDE: ui.gadgets.editors => model-field ;
-IN: ui.gadgets.poppers
-
-TUPLE: popped < model-field { fatal? initial: t } ;
-TUPLE: popped-editor < multiline-editor ;
-: <popped> ( text -- gadget ) <basic> init-field popped-editor popped (new-field) swap >>model* ;
-
-: set-expansion ( popped size -- ) over dup parent>> [ children>> index ] [ sizes>> ] bi set-nth relayout ;
-: new-popped ( popped -- ) insertion-point "" <popped>
- [ rot 1 + f (track-add-at) ] keep [ relayout ] [ request-focus ] bi ;
-: focus-prev ( popped -- ) dup parent>> children>> length 1 =
- [ drop ] [
- insertion-point [ 1 - dup -1 = [ drop 1 ] when ] [ children>> ] bi* nth
- [ request-focus ] [ editor>> end-of-document ] bi
- ] if ;
-: initial-popped ( popper -- ) "" <popped> [ f track-add drop ] keep request-focus ;
-
-TUPLE: popper < track { unfocus-hook initial: [ drop ] } ;
-! list of strings is model (make shown objects implement sequence protocol)
-: <popper> ( model -- popper ) vertical popper new-track swap >>model ;
-
-M: popped handle-gesture swap {
- { gain-focus [ 1 set-expansion f ] }
- { lose-focus [ dup parent>>
- [ [ unfocus-hook>> call( a -- ) ] curry [ f set-expansion ] bi ]
- [ drop ] if* f
- ] }
- { T{ key-up f f "RET" } [ dup editor>> delete-previous-character new-popped f ] }
- { T{ key-up f f "BACKSPACE" } [ dup editor>> editor-string "" =
- [ dup fatal?>> [ [ focus-prev ] [ unparent ] bi ] [ t >>fatal? drop ] if ]
- [ f >>fatal? drop ] if f
- ] }
- [ swap call-next-method ]
-} case ;
-
-M: popper handle-gesture swap T{ button-down f f 1 } =
- [ hand-click# get 2 = [ initial-popped ] [ drop ] if ] [ drop ] if f ;
-
-M: popper model-changed
- [ children>> [ unparent ] each ]
- [ [ value>> [ <popped> ] map ] dip [ f track-add ] reduce request-focus ] bi ;
-
-M: popped pref-dim* editor>> [ pref-dim* first ] [ line-height ] bi 2array ;
-M: popper focusable-child* children>> [ t ] [ first ] if-empty ;
\ No newline at end of file
--- /dev/null
+USING: tools.deploy.config ;
+H{
+ { deploy-name "drills" }
+ { deploy-c-types? t }
+ { "stop-after-last-window?" t }
+ { deploy-unicode? t }
+ { deploy-threads? t }
+ { deploy-reflection 6 }
+ { deploy-word-defs? t }
+ { deploy-math? t }
+ { deploy-ui? t }
+ { deploy-word-props? t }
+ { deploy-io 3 }
+}
--- /dev/null
+USING: arrays cocoa.dialogs combinators continuations
+fry grouping io.encodings.utf8 io.files io.styles kernel math
+math.parser models models.arrow models.history namespaces random
+sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
+ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
+ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks fonts
+wrap.strings system ;
+EXCLUDE: accessors => change-model ;
+IN: drills.deployed
+SYMBOLS: it startLength ;
+: big ( gadget -- gadget ) T{ font { name "sans-serif" } { size 30 } } >>font ;
+: card ( model quot -- button ) <arrow> <label-control> big [ next ] <book-btn> ;
+: op ( quot str -- gadget ) <label> big swap <book-bevel-btn> ;
+
+: show ( model -- gadget ) dup it set-global [ random ] <arrow>
+ { [ [ first ] card ]
+ [ [ second ] card ]
+ [ '[ |<< it get _ model-changed ] "No" op ]
+ [ '[ |<< [ it get [
+ _ value>> swap remove
+ [ [ it get go-back ] "Drill Complete" alert return ] when-empty
+ ] change-model ] with-return ] "Yes" op ]
+ } cleave
+2array { 1 0 } <track> swap [ 0.5 track-add ] each
+3array <book*> 3 3 <frame> { 1 1 } >>filled-cell { 450 175 } >>pref-dim swap { 1 1 } grid-add
+it get [ length startLength get swap - number>string "/" startLength get number>string 3append ] <arrow> <label-control> { 1 2 } grid-add ;
+
+: drill ( -- ) [
+ open-panel [
+ [ utf8 file-lines [ "\t" split [ 25 wrap-string ] map ] map dup [ first2 swap 2array ] map append ] map concat
+ [ length startLength set-global ] keep <history> [ add-history ] [ show ] bi
+ "Got it?" open-window
+ ] [ 0 exit ] if*
+] with-ui ;
+
+MAIN: drill
\ No newline at end of file
--- /dev/null
+unportable
--- /dev/null
+USING: arrays cocoa.dialogs combinators continuations
+fry grouping io.encodings.utf8 io.files io.styles kernel math
+math.parser models models.arrow models.history namespaces random
+sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
+ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
+ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks fonts
+wrap.strings ;
+EXCLUDE: accessors => change-model ;
+
+IN: drills
+SYMBOLS: it startLength ;
+: big ( gadget -- gadget ) T{ font { name "sans-serif" } { size 30 } } >>font ;
+: card ( model quot -- button ) <arrow> <label-control> big [ next ] <book-btn> ;
+: op ( quot str -- gadget ) <label> big swap <book-border-btn> ;
+
+: show ( model -- gadget ) dup it set-global [ random ] <arrow>
+ { [ [ first ] card ]
+ [ [ second ] card ]
+ [ '[ |<< it get _ model-changed ] "No" op ]
+ [ '[ |<< [ it get [
+ _ value>> swap remove
+ [ [ it get go-back ] "Drill Complete" alert return ] when-empty
+ ] change-model ] with-return ] "Yes" op ]
+ } cleave
+2array { 1 0 } <track> swap [ 0.5 track-add ] each
+3array <book*> 3 3 <frame> { 1 1 } >>filled-cell { 450 175 } >>pref-dim swap { 1 1 } grid-add
+it get [ length startLength get swap - number>string "/" startLength get number>string 3append ] <arrow> <label-control> { 1 2 } grid-add ;
+
+: drill ( -- ) [
+ open-panel [
+ [ utf8 file-lines [ "\t" split [ 25 wrap-string ] map ] map dup [ first2 swap 2array ] map append ] map concat
+ [ length startLength set-global ] keep <history> [ add-history ] [ show ] bi
+ "Got it?" open-window
+ ] when*
+] with-ui ;
+
+MAIN: drill
\ No newline at end of file
--- /dev/null
+unportable
--- /dev/null
+Sam Anklesaria
--- /dev/null
+USING: help.markup help.syntax models models.arrow sequences monads ;
+IN: models.combinators
+
+HELP: merge
+{ $values { "models" "a list of models" } { "model" basic-model } }
+{ $description "Creates a model that merges the updates of others" } ;
+
+HELP: filter-model
+{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-model" filter-model } }
+{ $description "Creates a model that uses the updates of another model only when they satisfy a given predicate" } ;
+
+HELP: fold
+{ $values { "model" model } { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } }
+{ $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ;
+
+HELP: switch-models
+{ $values { "model1" model } { "model2" model } { "model'" model } }
+{ $description "Creates a model that starts with the behavior of model2 and switches to the behavior of model1 on its update" } ;
+
+HELP: <mapped>
+{ $values { "model" model } { "quot" "applied to model's value on updates" } { "model" model } }
+{ $description "An expanded version of " { $link <arrow> } ". Use " { $link fmap } " instead." } ;
+
+HELP: when-model
+{ $values { "model" model } { "quot" "called on the model if the quot yields true" } { "cond" "a quotation called on the model's value, yielding a boolean value" } }
+{ $description "Calls quot when model updates if its value meets the condition set in cond" } ;
+
+HELP: with-self
+{ $values { "quot" "quotation that recieves its own return value" } { "model" model } }
+{ $description "Fixed points for models: the quot reacts to the same model to gives" } ;
+
+HELP: #1
+{ $values { "model" model } { "model'" model } }
+{ $description "Moves a model to the top of its dependencies' connections, thus being notified before the others" } ;
+
+ARTICLE: "models.combinators" "Extending models"
+"The " { $vocab-link "models.combinators" } " library expands models to have discrete start and end times. "
+"Also, it provides methods of manipulating and combining models, expecially useful when programming user interfaces: "
+"The output models of some gadgets (see " { $vocab-link "ui.gadgets.controls" } " ) can be manipulated and used as the input models of others. " ;
+
+ABOUT: "models.combinators"
--- /dev/null
+USING: accessors arrays kernel models models.product monads
+sequences sequences.extras shuffle ;
+FROM: syntax => >> ;
+IN: models.combinators
+
+TUPLE: multi-model < model important? ;
+GENERIC: (model-changed) ( model observer -- )
+: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
+M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ;
+M: multi-model model-activated dup dependencies>> [ value>> ] find nip
+ [ swap model-changed ] [ drop ] if* ;
+
+: #1 ( model -- model' ) t >>important? ;
+
+IN: models
+: notify-connections ( model -- )
+ dup connections>> dup [ dup multi-model? [ important?>> ] [ drop f ] if ] find-all
+ [ second tuck [ remove ] dip prefix ] each
+ [ model-changed ] with each ;
+IN: models.combinators
+
+TUPLE: basic-model < multi-model ;
+M: basic-model (model-changed) [ value>> ] dip set-model ;
+: merge ( models -- model ) basic-model <multi-model> ;
+: 2merge ( model1 model2 -- model ) 2array merge ;
+: <basic> ( value -- model ) basic-model new-model ;
+
+TUPLE: filter-model < multi-model quot ;
+M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
+ [ set-model ] [ 2drop ] if ;
+: filter-model ( model quot -- filter-model ) [ 1array \ filter-model <multi-model> ] dip >>quot ;
+
+TUPLE: fold-model < multi-model quot base values ;
+M: fold-model (model-changed) 2dup base>> =
+ [ [ [ value>> ] [ [ values>> ] [ quot>> ] bi ] bi* swapd reduce* ] keep set-model ]
+ [ [ [ value>> ] [ values>> ] bi* push ]
+ [ [ [ value>> ] [ [ value>> ] [ quot>> ] bi ] bi* call( val oldval -- newval ) ] keep set-model ] 2bi
+ ] if ;
+M: fold-model model-activated drop ;
+: new-fold-model ( deps -- model ) fold-model <multi-model> V{ } clone >>values ;
+: fold ( model oldval quot -- model ) rot 1array new-fold-model swap >>quot
+ swap >>value ;
+: fold* ( model oldmodel quot -- model ) over [ [ 2array new-fold-model ] dip >>quot ]
+ dip [ >>base ] [ value>> >>value ] bi ;
+
+TUPLE: updater-model < multi-model values updates ;
+M: updater-model (model-changed) [ tuck updates>> =
+ [ [ values>> value>> ] keep set-model ]
+ [ drop ] if ] keep f swap (>>value) ;
+: updates ( values updates -- model ) [ 2array updater-model <multi-model> ] 2keep
+ [ >>values ] [ >>updates ] bi* ;
+
+SYMBOL: switch
+TUPLE: switch-model < multi-model original switcher on ;
+M: switch-model (model-changed) 2dup switcher>> =
+ [ [ value>> ] dip over switch = [ nip [ original>> ] keep f >>on model-changed ] [ t >>on set-model ] if ]
+ [ dup on>> [ 2drop ] [ [ value>> ] dip over [ set-model ] [ 2drop ] if ] if ] if ;
+: switch-models ( model1 model2 -- model' ) swap [ 2array switch-model <multi-model> ] 2keep
+ [ [ value>> >>value ] [ >>original ] bi ] [ >>switcher ] bi* ;
+M: switch-model model-activated [ original>> ] keep model-changed ;
+: >behavior ( event -- behavior ) t >>value ;
+
+TUPLE: mapped-model < multi-model model quot ;
+: new-mapped-model ( model quot class -- mapped-model ) [ over 1array ] dip
+ <multi-model> swap >>quot swap >>model ;
+: <mapped> ( model quot -- model ) mapped-model new-mapped-model ;
+M: mapped-model (model-changed)
+ [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
+ set-model ;
+
+TUPLE: side-effect-model < mapped-model ;
+M: side-effect-model (model-changed) [ value>> ] dip [ quot>> call( old -- ) ] 2keep set-model ;
+
+TUPLE: quot-model < mapped-model ;
+M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
+
+TUPLE: action-value < basic-model parent ;
+: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
+M: action-value model-activated dup parent>> dup activate-model model-changed ; ! a fake dependency of sorts
+
+TUPLE: action < multi-model quot ;
+M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
+ [ swap add-connection ] 2keep model-changed ;
+: <action> ( model quot -- action-model ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
+
+TUPLE: collection < multi-model ;
+: <collection> ( models -- product ) collection <multi-model> ;
+M: collection (model-changed)
+ nip
+ dup dependencies>> [ value>> ] all?
+ [ dup [ value>> ] product-value swap set-model ]
+ [ drop ] if ;
+M: collection model-activated dup (model-changed) ;
+
+! for side effects
+TUPLE: (when-model) < multi-model quot cond ;
+: when-model ( model quot cond -- model ) rot 1array (when-model) <multi-model> swap >>cond swap >>quot ;
+M: (when-model) (model-changed) [ quot>> ] 2keep
+ [ value>> ] [ cond>> ] bi* call( a -- ? ) [ call( model -- ) ] [ 2drop ] if ;
+
+! only used in construction
+: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
+
+USE: models.combinators.templates
+<< { "$>" "<$" "fmap" } [ fmaps ] each >>
--- /dev/null
+Model combination and manipulation
\ No newline at end of file
--- /dev/null
+USING: kernel sequences functors fry macros generalizations ;
+IN: models.combinators.templates
+FROM: models.combinators => <collection> #1 ;
+FUNCTOR: fmaps ( W -- )
+W IS ${W}
+w-n DEFINES ${W}-n
+w-2 DEFINES 2${W}
+w-3 DEFINES 3${W}
+w-4 DEFINES 4${W}
+w-n* DEFINES ${W}-n*
+w-2* DEFINES 2${W}*
+w-3* DEFINES 3${W}*
+w-4* DEFINES 4${W}*
+WHERE
+MACRO: w-n ( int -- quot ) dup '[ [ _ narray <collection> ] dip [ _ firstn ] prepend W ] ;
+: w-2 ( a b quot -- mapped ) 2 w-n ; inline
+: w-3 ( a b c quot -- mapped ) 3 w-n ; inline
+: w-4 ( a b c d quot -- mapped ) 4 w-n ; inline
+MACRO: w-n* ( int -- quot ) dup '[ [ _ narray <collection> #1 ] dip [ _ firstn ] prepend W ] ;
+: w-2* ( a b quot -- mapped ) 2 w-n* ; inline
+: w-3* ( a b c quot -- mapped ) 3 w-n* ; inline
+: w-4* ( a b c d quot -- mapped ) 4 w-n* ; inline
+;FUNCTOR
\ No newline at end of file
--- /dev/null
+Sam Anklesaria
\ No newline at end of file
--- /dev/null
+USING: accessors arrays colors.constants combinators
+db.sqlite db.tuples db.types kernel locals math
+monads persistency sequences sequences.extras ui ui.gadgets.controls
+ui.gadgets.layout models.combinators ui.gadgets.labels
+ui.gadgets.scrollers ui.pens.solid io.files.temp ;
+FROM: sets => prune ;
+IN: recipes
+
+STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
+: <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title 0 >>votes ;
+"recipes.db" temp-file <sqlite-db> recipe define-db
+: top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
+ "votes" >>order 30 >>limit swap >>offset get-tuples ;
+: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 short head-slice ;
+
+: interface ( -- book ) [
+ [
+ [ $ TOOLBAR $ ] <hbox> COLOR: AliceBlue <solid> >>interior ,
+ [ "Genres:" <label> , <spacer> $ ALL $ $ GENRES $ ] <hbox>
+ { 5 0 } >>gap COLOR: gray <solid> >>interior ,
+ $ RECIPES $
+ ] <vbox> ,
+ [
+ [ "Title:" <label> , $ TITLE $ "Genre:" <label> , $ GENRE $ ] <hbox> ,
+ $ BODY $
+ $ BUTTON $
+ ] <vbox> ,
+ ] <book*> { 350 245 } >>pref-dim ;
+
+:: recipe-browser ( -- ) [ [
+ interface
+ <table*> :> tbl
+ "okay" <model-border-btn> BUTTON -> :> ok
+ IMG-MODEL-BTN: submit [ store-tuple ] >>value TOOLBAR -> :> submit
+ IMG-MODEL-BTN: love 1 >>value TOOLBAR ->
+ IMG-MODEL-BTN: hate -1 >>value -> 2array merge :> votes
+ IMG-MODEL-BTN: back -> [ -30 ] <$
+ IMG-MODEL-BTN: more -> [ 30 ] <$ 2array merge :> viewed
+ <spacer> <model-field*> ->% 1 :> search
+ submit ok [ [ drop ] ] <$ 2array merge [ drop ] >>value :> quot
+ viewed 0 [ + ] fold search ok t <basic> "all" <model-btn> ALL ->
+ tbl selection>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
+ 4array merge
+ [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> ups
+ ups [ top-genres [ <model-btn> GENRES -> ] map merge ] bind*
+ [ text>> T{ recipe } swap >>genre get-tuples ] fmap
+ tbl swap ups 2merge >>model
+ [ [ title>> ] [ genre>> ] bi 2array ] >>quot
+ { "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1 actions>>
+ submit [ "" dup dup <recipe> ] <$ 2array merge
+ { [ [ title>> ] fmap <model-field> TITLE ->% .5 ]
+ [ [ genre>> ] fmap <model-field> GENRE ->% .5 ]
+ [ [ txt>> ] fmap <model-editor> BODY ->% 1 ]
+ } cleave
+ [ <recipe> ] 3fmap
+ [ [ 1 ] <$ ]
+ [ quot ok updates #1 [ call( recipe -- ) 0 ] 2fmap ] bi
+ 2merge 0 <basic> switch-models >>model
+ ] with-interface "recipes" open-window ] with-ui ;
+
+MAIN: recipe-browser
\ No newline at end of file
--- /dev/null
+Database backed recipe sharing
\ No newline at end of file
--- /dev/null
+Sam Anklesaria
\ No newline at end of file
--- /dev/null
+USING: accessors arrays combinators.short-circuit grouping kernel lists
+lists.lazy locals math math.functions math.parser math.ranges
+models.product monads random sequences sets ui ui.gadgets.controls
+ui.gadgets.layout models.combinators ui.gadgets.alerts vectors fry
+ui.gadgets.labels shuffle ;
+IN: sudokus
+
+: row ( index -- row ) 1 + 9 / ceiling ;
+: col ( index -- col ) 9 mod 1 + ;
+: sq ( index -- square ) [ row ] [ col ] bi [ 3 / ceiling ] bi@ 2array ;
+: near ( a pos -- ? ) { [ [ row ] bi@ = ] [ [ col ] bi@ = ] [ [ sq ] bi@ = ] } 2|| ;
+: nth-or-lower ( n seq -- elt ) [ length 1 - 2dup > [ nip ] [ drop ] if ] keep nth ;
+
+:: solutions ( puzzle random? -- solutions )
+ f puzzle random? [ indices [ f ] [ random? swap nth-or-lower ] if-empty ] [ index ] if
+ [ :> pos
+ 1 9 [a,b] 80 iota [ pos near ] filter [ puzzle nth ] map prune diff
+ [ 1array puzzle pos cut-slice rest surround ] map >list [ random? solutions ] bind
+ ] [ puzzle list-monad return ] if* ;
+
+: solution ( puzzle random? -- solution ) dupd solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if ;
+: hint ( puzzle -- puzzle' ) [ [ f swap indices random dup ] [ f solution ] bi nth ] keep swapd >vector [ set-nth ] keep ;
+: create ( difficulty -- puzzle ) 81 [ f ] replicate
+ 40 random solution [ [ f swap [ length random ] keep set-nth ] curry times ] keep ;
+
+: do-sudoku ( -- ) [ [
+ [
+ 81 [ "" ] replicate <basic> switch-models [ [ <basic> ] map 9 group [ 3 group ] map 3 group
+ [ [ [ <spacer> [ [ <model-field> ->% 2 [ string>number ] fmap ]
+ map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product>
+ [ "Difficulty:" <label> , "1" <basic> <model-field> -> [ string>number 1 or 1 + 10 * ] fmap
+ "Generate" <model-border-btn> -> updates [ create ] fmap <spacer>
+ "Hint" <model-border-btn> -> "Solve" <model-border-btn> -> ] <hbox> ,
+ roll [ swap updates ] curry bi@
+ [ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array merge [ [ [ number>string ] [ "" ] if* ] map ] fmap
+ ] bind
+ ] with-self , ] <vbox> { 280 220 } >>pref-dim
+ "Sudoku Sleuth" open-window ] with-ui ;
+
+MAIN: do-sudoku
--- /dev/null
+graphical sudoku solver
\ No newline at end of file
--- /dev/null
+USING: accessors models monads macros generalizations kernel
+ui ui.gadgets.controls models.combinators ui.gadgets.layout ui.gadgets
+ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
+ui.gadgets.packs locals sequences fonts io.styles
+wrap.strings ;
+
+IN: ui.gadgets.alerts
+:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align
+ string 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
+ "okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
+
+: alert* ( str -- ) [ ] swap alert ;
+
+:: ask-user ( string -- model' )
+ [
+ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , :> lbl
+ <model-field*> ->% 1 :> fldm
+ "okay" <model-border-btn> :> btn
+ btn -> [ fldm swap updates ]
+ [ [ drop lbl close-window ] $> , ] bi
+ ] <vbox> { 161 86 } >>pref-dim "" open-window ;
+
+MACRO: ask-buttons ( buttons -- quot ) dup length [
+ [ swap
+ [ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
+ [ [ <model-border-btn> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
+ "" open-window
+ ] dip firstn
+ ] 2curry ;
--- /dev/null
+Sam Anklesaria
\ No newline at end of file
--- /dev/null
+Really simple dialog boxes
\ No newline at end of file
--- /dev/null
+Sam Anklesaria
\ No newline at end of file
--- /dev/null
+USING: accessors arrays kernel math.rectangles sequences
+ui.gadgets.controls models.combinators ui.gadgets ui.gadgets.glass
+ui.gadgets.labels ui.gestures ;
+QUALIFIED-WITH: ui.gadgets.tables tbl
+IN: ui.gadgets.comboboxes
+
+TUPLE: combo-table < table spawner ;
+
+M: combo-table handle-gesture [ call-next-method drop ] 2keep swap
+ T{ button-up } = [
+ [ spawner>> ]
+ [ tbl:selected-row [ swap set-control-value ] [ 2drop ] if ]
+ [ hide-glass ] tri
+ ] [ drop ] if t ;
+
+TUPLE: combobox < label-control table ;
+combobox H{
+ { T{ button-down } [ dup table>> over >>spawner <zero-rect> show-glass ] }
+} set-gestures
+
+: <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <basic> >>model ] keep
+ <basic> combo-table new-table [ 1array ] >>quot >>table ;
\ No newline at end of file
--- /dev/null
+Combo boxes have a model choosen from a list of options
\ No newline at end of file
--- /dev/null
+Sam Anklesaria
--- /dev/null
+USING: accessors help.markup help.syntax ui.gadgets.buttons
+ui.gadgets.editors models ui.gadgets ;
+IN: ui.gadgets.controls
+
+HELP: <model-btn>
+{ $values { "gadget" "the button's label" } { "button" button } }
+{ $description "Creates an button whose signal updates on clicks. " } ;
+
+HELP: <model-border-btn>
+{ $values { "text" "the button's label" } { "button" button } }
+{ $description "Creates an button whose signal updates on clicks. " } ;
+
+HELP: <table>
+{ $values { "model" "values the table is to display" } { "table" table } }
+{ $description "Creates an " { $link table } } ;
+
+HELP: <table*>
+{ $values { "table" table } }
+{ $description "Creates an " { $link table } " with no initial values to display" } ;
+
+HELP: <list>
+{ $values { "column-model" "values the table is to display" } { "table" table } }
+{ $description "Creates an " { $link table } " with a val-quot that renders each element as its own row" } ;
+
+HELP: <list*>
+{ $values { "table" table } }
+{ $description "Creates an model-list with no initial values to display" } ;
+
+HELP: indexed
+{ $values { "table" table } }
+{ $description "Sets the output model of an table to the selected-index, rather than the selected-value" } ;
+
+HELP: <model-field>
+{ $values { "model" model } { "gadget" model-field } }
+{ $description "Creates a field with an initial value" } ;
+
+HELP: <model-field*>
+{ $values { "field" model-field } }
+{ $description "Creates a field with an empty initial value" } ;
+
+HELP: <empty-field>
+{ $values { "model" model } { "field" model-field } }
+{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
+
+HELP: <model-editor>
+{ $values { "model" model } { "gadget" model-field } }
+{ $description "Creates an editor with an initial value" } ;
+
+HELP: <model-editor*>
+{ $values { "editor" "an editor" } }
+{ $description "Creates a editor with an empty initial value" } ;
+
+HELP: <empty-editor>
+{ $values { "model" model } { "editor" "an editor" } }
+{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
+
+HELP: <model-action-field>
+{ $values { "field" action-field } }
+{ $description "Field that updates its model with its contents when the user hits the return key" } ;
+
+HELP: IMG-MODEL-BTN:
+{ $syntax "IMAGE-MODEL-BTN: filename" }
+{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path" } ;
+
+HELP: IMG-BTN:
+{ $syntax "[ do-something ] IMAGE-BTN: filename" }
+{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path, calling the specified quotation on click" } ;
+
+HELP: output-model
+{ $values { "gadget" gadget } { "model" model } }
+{ $description "Returns the model a gadget uses for output. Often the same as " { $link model>> } } ;
\ No newline at end of file
--- /dev/null
+USING: accessors assocs arrays kernel models monads sequences
+models.combinators ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+ui.gadgets.buttons.private ui.gadgets.editors ui.gadgets.editors.private
+words images.loader ui.gadgets.scrollers ui.images vocabs.parser lexer
+models.range ui.gadgets.sliders ;
+QUALIFIED-WITH: ui.gadgets.sliders slider
+QUALIFIED-WITH: ui.gadgets.tables tbl
+EXCLUDE: ui.gadgets.editors => model-field ;
+IN: ui.gadgets.controls
+
+TUPLE: model-btn < button hook value ;
+: <model-btn> ( gadget -- button ) [
+ [ dup hook>> [ call( button -- ) ] [ drop ] if* ]
+ [ [ [ value>> ] [ ] bi or ] keep set-control-value ]
+ [ model>> f swap (>>value) ] tri
+ ] model-btn new-button f <basic> >>model ;
+: <model-border-btn> ( text -- button ) <model-btn> border-button-theme ;
+
+TUPLE: table < tbl:table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment actions ;
+M: table tbl:column-titles column-titles>> ;
+M: table tbl:column-alignment column-alignment>> ;
+M: table tbl:row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ;
+M: table tbl:row-value val-quot>> [ call( a -- b ) ] [ drop f ] if* ;
+M: table tbl:row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
+
+: new-table ( model class -- table ) f swap tbl:new-table dup >>renderer
+ f <basic> >>actions dup actions>> [ set-model ] curry >>action ;
+: <table> ( model -- table ) table new-table ;
+: <table*> ( -- table ) V{ } clone <model> <table> ;
+: <list> ( column-model -- table ) <table> [ 1array ] >>quot ;
+: <list*> ( -- table ) V{ } clone <model> <list> ;
+: indexed ( table -- table ) f >>val-quot ;
+
+TUPLE: model-field < field model* ;
+: init-field ( model -- model' ) [ [ ] [ "" ] if* ] change-value ;
+: <model-field> ( model -- gadget ) model-field new-field swap init-field >>model* ;
+M: model-field graft*
+ [ [ model*>> value>> ] [ editor>> ] bi set-editor-string ]
+ [ dup editor>> model>> add-connection ]
+ [ dup model*>> add-connection ] tri ;
+M: model-field ungraft*
+ [ dup editor>> model>> remove-connection ]
+ [ dup model*>> remove-connection ] bi ;
+M: model-field model-changed 2dup model*>> =
+ [ [ value>> ] [ editor>> ] bi* set-editor-string ]
+ [ nip [ editor>> editor-string ] [ model*>> ] bi set-model ] if ;
+
+: (new-field) ( editor field -- gadget ) [ new-editor ] dip new-border dup gadget-child >>editor
+ field-theme { 1 0 } >>align ; inline
+: <model-field*> ( -- field ) "" <model> <model-field> ;
+: <empty-field> ( model -- field ) "" <model> switch-models <model-field> ;
+: <model-editor> ( model -- gadget ) multiline-editor model-field (new-field) swap init-field >>model* ;
+: <model-editor*> ( -- editor ) "" <model> <model-editor> ;
+: <empty-editor> ( model -- editor ) "" <model> switch-models <model-editor> ;
+
+: <model-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
+ f <model> >>model ;
+
+: <slider> ( init page min max step -- slider ) <range> horizontal slider:<slider> ;
+
+: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> dup cached-image drop ;
+SYNTAX: IMG-MODEL-BTN: image-prep [ <model-btn> ] curry append! ;
+
+SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry append! ;
+
+GENERIC: output-model ( gadget -- model )
+M: gadget output-model model>> ;
+M: table output-model dup val-quot>> [ selection>> ] [ selection-index>> ] if ;
+M: model-field output-model model*>> ;
+M: scroller output-model viewport>> children>> first output-model ;
+M: slider output-model model>> range-model ;
+
+IN: accessors
+M: model-btn text>> children>> first text>> ;
+
+IN: ui.gadgets.controls
+
+SINGLETON: gadget-monad
+INSTANCE: gadget-monad monad
+INSTANCE: gadget monad
+M: gadget monad-of drop gadget-monad ;
+M: gadget-monad return drop <gadget> swap >>model ;
+M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
--- /dev/null
+Gadgets with expanded model usage
\ No newline at end of file
--- /dev/null
+Sam Anklesaria
--- /dev/null
+USING: help.markup help.syntax models ui.gadgets.tracks ;
+IN: ui.gadgets.layout
+
+HELP: ,
+{ $values { "item" "a gadget or model" } }
+{ $description "Used in a series of gadgets created by a box, accumulating the gadget" } ;
+
+HELP: ,%
+{ $syntax "gadget ,% width" }
+{ $description "Like ',' but stretches the gadget to always fill a percent of the parent" } ;
+
+HELP: ->
+{ $values { "uiitem" "a gadget or model" } { "model" model } }
+{ $description "Like ',' but passes its model on for further use." } ;
+
+HELP: ->%
+{ $syntax "gadget ,% width" }
+{ $description "Like '->' but stretches the gadget to always fill a percent of the parent" } ;
+
+HELP: <spacer>
+{ $description "Grows to fill any empty space in a box" } ;
+
+HELP: <hbox>
+{ $values { "gadgets" "a list of gadgets" } { "track" track } }
+{ $syntax "[ gadget , gadget , ... ] <hbox>" }
+{ $description "Creates an horizontal track containing the gadgets listed in the quotation" } ;
+
+HELP: <vbox>
+{ $values { "gadgets" "a list of gadgets" } { "track" track } }
+{ $syntax "[ gadget , gadget , ... ] <hbox>" }
+{ $description "Creates an vertical track containing the gadgets listed in the quotation" } ;
+
+HELP: $
+{ $syntax "$ PLACEHOLDER-NAME $" }
+{ $description "Defines an insertion point in a template named PLACEHOLDER-NAME which can be used by calling its name" } ;
+
+HELP: with-interface
+{ $values { "quot" "quotation that builds a template and inserts into it" } }
+{ $description "Create templates, used with " { $link POSTPONE: $ } } ;
+
+ARTICLE: "ui.gadgets.layout" "GUI Layout"
+"Laying out GUIs works the same way as building lists with " { $vocab-link "make" }
+". Gadgets are layed out using " { $vocab-link "ui.gadgets.tracks" } " through " { $link <hbox> } " and " { $link <vbox> } ", which allow both fixed and percentage widths. "
+{ $link , } " and " { $link -> } " add a model or gadget to the gadget you're building. "
+"Also, books can be made with " { $link <book> } ". "
+{ $link <spacer> } "s add flexable space between items. " $nl
+"Using " { $link with-interface } ", one can pre-build templates to add items to later: "
+"Like in the StringTemplate framework for java, placeholders are defined using $ PLACERHOLDER-NAME $ "
+"Using PLACEHOLDER-NAME again sets it as the current insertion point. "
+"For examples using normal layout, see the " { $vocab-link "sudokus" } " demo. "
+"For examples of templating, see the " { $vocab-link "recipes" } " demo. " ;
+
+ABOUT: "ui.gadgets.layout"
\ No newline at end of file
--- /dev/null
+USING: accessors assocs arrays fry kernel lexer make math.parser
+models monads namespaces parser sequences
+sequences.extras models.combinators ui.gadgets
+ui.gadgets.tracks words ui.gadgets.controls ;
+QUALIFIED: make
+QUALIFIED-WITH: ui.gadgets.books book
+IN: ui.gadgets.layout
+
+SYMBOL: templates
+TUPLE: layout gadget size ; C: <layout> layout
+TUPLE: placeholder < gadget members ;
+: <placeholder> ( -- placeholder ) placeholder new V{ } clone >>members ;
+
+: (remove-members) ( placeholder members -- ) [ [ model? ] filter swap parent>> model>> [ remove-connection ] curry each ]
+ [ nip [ gadget? ] filter [ unparent ] each ] 2bi ;
+
+: remove-members ( placeholder -- ) dup members>> [ drop ] [ [ (remove-members) ] keep delete-all ] if-empty ;
+: add-member ( obj placeholder -- ) over layout? [ [ gadget>> ] dip ] when members>> push ;
+
+: , ( item -- ) make:, ;
+: make* ( quot -- list ) { } make ; inline
+
+! Just take the previous mentioned placeholder and use it
+! If there is no previously mentioned placeholder, we're probably making a box, and will create the placeholder ourselves
+DEFER: with-interface
+: insertion-quot ( quot -- quot' )
+ make:building get [ [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
+ [ templates get ] 2dip swap '[ [ _ templates set _ , @ ] with-interface ] ] when* ;
+
+SYNTAX: ,% scan string>number [ <layout> , ] curry append! ;
+SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] append! ;
+
+GENERIC: -> ( uiitem -- model )
+M: gadget -> dup , output-model ;
+M: model -> dup , ;
+
+: <spacer> ( -- ) <gadget> 1 <layout> , ;
+
+: add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ;
+: layouts ( sized? gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter swap
+ [ [ dup layout? [ f <layout> ] unless ] map ]
+ [ [ dup gadget? [ gadget>> ] unless ] map ] if ;
+: make-layout ( building sized? -- models layouts ) [ swap layouts ] curry
+ [ make* [ [ model? ] filter ] ] dip bi ; inline
+: <box> ( gadgets type -- track )
+ [ t make-layout ] dip <track>
+ swap [ add-layout ] each
+ swap [ <collection> >>model ] unless-empty ; inline
+: <hbox> ( gadgets -- track ) horizontal <box> ; inline
+: <vbox> ( gadgets -- track ) vertical <box> ; inline
+
+: make-book ( models gadgets model -- book ) book:<book> swap [ "No models in books" throw ] unless-empty ;
+: <book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
+: <book*> ( quot -- book ) f make-layout f make-book ; inline
+
+ERROR: not-in-template word ;
+SYNTAX: $ CREATE-WORD dup
+ [ [ dup templates get at [ nip , ] [ not-in-template ] if* ] curry (( -- )) define-declared "$" expect ]
+ [ [ <placeholder> [ swap templates get set-at ] keep , ] curry ] bi append! ;
+
+: insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ;
+: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
+: insertion-point ( placeholder -- number parent ) dup parent>> [ children>> index ] keep ;
+
+GENERIC: >layout ( gadget -- layout )
+M: gadget >layout f <layout> ;
+M: layout >layout ;
+
+GENERIC# (add-gadget-at) 2 ( parent item n -- )
+M: gadget (add-gadget-at) -rot [ add-gadget ] keep insert-gadget ;
+M: track (add-gadget-at) -rot >layout [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
+
+GENERIC# add-gadget-at 1 ( item location -- )
+M: object add-gadget-at insertion-point -rot (add-gadget-at) ;
+M: model add-gadget-at parent>> dup book:book? [ "No models in books" throw ]
+ [ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip (>>model) ] if ] if ;
+: track-add-at ( item location size -- ) swap [ <layout> ] dip add-gadget-at ;
+: (track-add-at) ( parent item n size -- ) swap [ <layout> ] dip (add-gadget-at) ;
+
+: insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
+ [ add-member ] 2keep add-gadget-at ;
+
+: insert-items ( makelist -- ) t swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
+
+: with-interface ( quot -- ) [ make* ] curry H{ } clone templates rot with-variable [ insert-items ] with-scope ; inline
+
+M: model >>= [ swap insertion-quot <action> ] curry ;
+M: model fmap insertion-quot <mapped> ;
+M: model $> insertion-quot side-effect-model new-mapped-model ;
+M: model <$ insertion-quot quot-model new-mapped-model ;
--- /dev/null
+Syntax for easily building GUIs and using templates
\ No newline at end of file
--- /dev/null
+Sam Anklesaria
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Sam Anklesaria
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays accessors combinators kernel math
+models models.combinators namespaces sequences
+ui.gadgets ui.gadgets.controls ui.gadgets.layout
+ui.gadgets.tracks ui.gestures ui.gadgets.line-support ;
+EXCLUDE: ui.gadgets.editors => model-field ;
+IN: ui.gadgets.poppers
+
+TUPLE: popped < model-field { fatal? initial: t } ;
+TUPLE: popped-editor < multiline-editor ;
+: <popped> ( text -- gadget ) <basic> init-field popped-editor popped (new-field) swap >>model* ;
+
+: set-expansion ( popped size -- ) over dup parent>> [ children>> index ] [ sizes>> ] bi set-nth relayout ;
+: new-popped ( popped -- ) insertion-point "" <popped>
+ [ rot 1 + f (track-add-at) ] keep [ relayout ] [ request-focus ] bi ;
+: focus-prev ( popped -- ) dup parent>> children>> length 1 =
+ [ drop ] [
+ insertion-point [ 1 - dup -1 = [ drop 1 ] when ] [ children>> ] bi* nth
+ [ request-focus ] [ editor>> end-of-document ] bi
+ ] if ;
+: initial-popped ( popper -- ) "" <popped> [ f track-add drop ] keep request-focus ;
+
+TUPLE: popper < track { unfocus-hook initial: [ drop ] } ;
+! list of strings is model (make shown objects implement sequence protocol)
+: <popper> ( model -- popper ) vertical popper new-track swap >>model ;
+
+M: popped handle-gesture swap {
+ { gain-focus [ 1 set-expansion f ] }
+ { lose-focus [ dup parent>>
+ [ [ unfocus-hook>> call( a -- ) ] curry [ f set-expansion ] bi ]
+ [ drop ] if* f
+ ] }
+ { T{ key-up f f "RET" } [ dup editor>> delete-previous-character new-popped f ] }
+ { T{ key-up f f "BACKSPACE" } [ dup editor>> editor-string "" =
+ [ dup fatal?>> [ [ focus-prev ] [ unparent ] bi ] [ t >>fatal? drop ] if ]
+ [ f >>fatal? drop ] if f
+ ] }
+ [ swap call-next-method ]
+} case ;
+
+M: popper handle-gesture swap T{ button-down f f 1 } =
+ [ hand-click# get 2 = [ initial-popped ] [ drop ] if ] [ drop ] if f ;
+
+M: popper model-changed
+ [ children>> [ unparent ] each ]
+ [ [ value>> [ <popped> ] map ] dip [ f track-add ] reduce request-focus ] bi ;
+
+M: popped pref-dim* editor>> [ pref-dim* first ] [ line-height ] bi 2array ;
+M: popper focusable-child* children>> [ t ] [ first ] if-empty ;
\ No newline at end of file
* It is up to the caller to fill in the object's fields in a meaningful
* fashion!
*/
-inline object *factor_vm::allot_object(header header, cell size)
+inline object *factor_vm::allot_object(cell type, cell size)
{
/* If the object is smaller than the nursery, allocate it in the nursery,
after a GC if needed */
object *obj = nursery.allot(size);
- obj->h = header;
+ obj->initialize(type);
return obj;
}
/* If the object is bigger than the nursery, allocate it in
tenured space */
else
- return allot_large_object(header,size);
+ return allot_large_object(type,size);
}
}
namespace factor
{
-/* make a new array with an initial element */
array *factor_vm::allot_array(cell capacity, cell fill_)
{
data_root<object> fill(fill_,this);
return new_array;
}
-/* push a new array on the stack */
void factor_vm::primitive_array()
{
- cell initial = dpop();
- cell size = unbox_array_size();
- dpush(tag<array>(allot_array(size,initial)));
+ data_root<object> fill(dpop(),this);
+ cell capacity = unbox_array_size();
+ array *new_array = allot_uninitialized_array<array>(capacity);
+ memset_cell(new_array->data(),fill.value(),capacity * sizeof(cell));
+ dpush(tag<array>(new_array));
}
cell factor_vm::allot_array_1(cell obj_)
void factor_vm::primitive_resize_array()
{
- array *a = untag_check<array>(dpop());
+ data_root<array> a(dpop(),this);
+ a.untag_check(this);
cell capacity = unbox_array_size();
- dpush(tag<array>(reallot_array(a,capacity)));
+ dpush(tag<array>(reallot_array(a.untagged(),capacity)));
}
void growable_array::add(cell elt_)
void factor_vm::primitive_resize_byte_array()
{
- byte_array *array = untag_check<byte_array>(dpop());
+ data_root<byte_array> array(dpop(),this);
+ array.untag_check(this);
cell capacity = unbox_array_size();
- dpush(tag<byte_array>(reallot_array(array,capacity)));
+ dpush(tag<byte_array>(reallot_array(array.untagged(),capacity)));
}
void growable_byte_array::append_bytes(void *elts, cell len)
template<typename Type> byte_array *factor_vm::byte_array_from_value(Type *value)
{
- return byte_array_from_values(value,1);
-}
-
-template<typename Type> byte_array *factor_vm::byte_array_from_values(Type *values, cell len)
-{
- cell size = sizeof(Type) * len;
- byte_array *data = allot_uninitialized_array<byte_array>(size);
- memcpy(data->data<char>(),values,size);
+ byte_array *data = allot_uninitialized_array<byte_array>(sizeof(Type));
+ memcpy(data->data<char>(),value,sizeof(Type));
return data;
}
void visit_object_code_block(object *obj)
{
- switch(obj->h.hi_tag())
+ switch(obj->type())
{
case WORD_TYPE:
{
parent->check_data_pointer(untagged);
/* is there another forwarding pointer? */
- while(untagged->h.forwarding_pointer_p())
- untagged = untagged->h.forwarding_pointer();
+ while(untagged->forwarding_pointer_p())
+ untagged = untagged->forwarding_pointer();
/* we've found the destination */
- untagged->h.check_header();
return untagged;
}
if(!newpointer) longjmp(parent->current_gc->gc_unwind,1);
memcpy(newpointer,untagged,size);
- untagged->h.forward_to(newpointer);
+ untagged->forward_to(newpointer);
policy.promoted_object(newpointer);
void trace_object(object *ptr)
{
workhorse.visit_slots(ptr);
- if(ptr->h.hi_tag() == ALIEN_TYPE)
+ if(ptr->type() == ALIEN_TYPE)
((alien *)ptr)->update_address();
}
{
if(!forwarding_map->marked_p(obj))
return forwarding_map->unmarked_block_size(obj);
- else if(obj->h.hi_tag() == TUPLE_TYPE)
+ else if(obj->type() == TUPLE_TYPE)
return align(tuple_size_with_forwarding(forwarding_map,obj),data_alignment);
else
return obj->size();
void operator()(object *old_address, object *new_address, cell size)
{
cell payload_start;
- if(old_address->h.hi_tag() == TUPLE_TYPE)
+ if(old_address->type() == TUPLE_TYPE)
payload_start = tuple_size_with_forwarding(data_forwarding_map,old_address);
else
payload_start = old_address->binary_payload_start();
namespace factor
{
+context::context(cell ds_size, cell rs_size) :
+ callstack_top(NULL),
+ callstack_bottom(NULL),
+ datastack(0),
+ retainstack(0),
+ datastack_save(0),
+ retainstack_save(0),
+ magic_frame(NULL),
+ datastack_region(new segment(ds_size,false)),
+ retainstack_region(new segment(rs_size,false)),
+ catchstack_save(0),
+ current_callback_save(0),
+ next(NULL) {}
+
void factor_vm::reset_datastack()
{
ds = ds_bot - sizeof(cell);
unused_contexts = unused_contexts->next;
}
else
- {
- new_context = new context;
- new_context->datastack_region = new segment(ds_size,false);
- new_context->retainstack_region = new segment(rs_size,false);
- }
+ new_context = new context(ds_size,rs_size);
return new_context;
}
cell current_callback_save;
context *next;
+
+ context(cell ds_size, cell rs_size);
};
#define ds_bot (ctx->datastack_region->start)
{
if(free_p()) return ((free_heap_block *)this)->size();
- switch(h.hi_tag())
+ switch(type())
{
case ARRAY_TYPE:
return align(array_size((array*)this),data_alignment);
we ignore. */
cell object::binary_payload_start() const
{
- switch(h.hi_tag())
+ switch(type())
{
/* these objects do not refer to other objects at all */
case FLOAT_TYPE:
void operator()(object *obj)
{
- if(type == TYPE_COUNT || obj->h.hi_tag() == type)
+ if(type == TYPE_COUNT || obj->type() == type)
objects.push_back(tag_dynamic(obj));
}
};
--- /dev/null
+#include "master.hpp"
+
+/* A tool to debug write barriers. Call check_data_heap() to ensure that all
+cards that should be marked are actually marked. */
+
+namespace factor
+{
+
+enum generation {
+ nursery_generation,
+ aging_generation,
+ tenured_generation
+};
+
+inline generation generation_of(factor_vm *parent, object *obj)
+{
+ if(parent->data->nursery->contains_p(obj))
+ return nursery_generation;
+ else if(parent->data->aging->contains_p(obj))
+ return aging_generation;
+ else if(parent->data->tenured->contains_p(obj))
+ return tenured_generation;
+ else
+ {
+ critical_error("Bad object",(cell)obj);
+ return (generation)-1;
+ }
+}
+
+struct slot_checker {
+ factor_vm *parent;
+ object *obj;
+ generation gen;
+
+ explicit slot_checker(factor_vm *parent_, object *obj_, generation gen_) :
+ parent(parent_), obj(obj_), gen(gen_) {}
+
+ void check_write_barrier(cell *slot_ptr, generation target, char mask)
+ {
+ cell object_card_pointer = parent->cards_offset + ((cell)obj >> card_bits);
+ cell slot_card_pointer = parent->cards_offset + ((cell)slot_ptr >> card_bits);
+ char slot_card_value = *(char *)slot_card_pointer;
+ if((slot_card_value & mask) != mask)
+ {
+ printf("card not marked\n");
+ printf("source generation: %d\n",gen);
+ printf("target generation: %d\n",target);
+ printf("object: 0x%lx\n",(cell)obj);
+ printf("object type: %ld\n",obj->type());
+ printf("slot pointer: 0x%lx\n",(cell)slot_ptr);
+ printf("slot value: 0x%lx\n",*slot_ptr);
+ printf("card of object: 0x%lx\n",object_card_pointer);
+ printf("card of slot: 0x%lx\n",slot_card_pointer);
+ printf("\n");
+ parent->factorbug();
+ }
+ }
+
+ void operator()(cell *slot_ptr)
+ {
+ if(!immediate_p(*slot_ptr))
+ {
+ generation target = generation_of(parent,untag<object>(*slot_ptr));
+ switch(gen)
+ {
+ case nursery_generation:
+ break;
+ case aging_generation:
+ if(target == nursery_generation)
+ check_write_barrier(slot_ptr,target,card_points_to_nursery);
+ break;
+ case tenured_generation:
+ if(target == nursery_generation)
+ check_write_barrier(slot_ptr,target,card_points_to_nursery);
+ else if(target == aging_generation)
+ check_write_barrier(slot_ptr,target,card_points_to_aging);
+ break;
+ }
+ }
+ }
+};
+
+struct object_checker {
+ factor_vm *parent;
+
+ explicit object_checker(factor_vm *parent_) : parent(parent_) {}
+
+ void operator()(object *obj)
+ {
+ slot_checker checker(parent,obj,generation_of(parent,obj));
+ obj->each_slot(checker);
+ }
+};
+
+void factor_vm::check_data_heap()
+{
+ object_checker checker(this);
+ each_object(checker);
+}
+
+}
void operator()(object *obj)
{
- if(type == TYPE_COUNT || obj->h.hi_tag() == type)
+ if(type == TYPE_COUNT || obj->type() == type)
{
std::cout << padded_address((cell)obj) << " ";
parent->print_nested_obj(tag_dynamic(obj),2);
void operator()(object *obj)
{
data_reference_slot_visitor visitor(look_for,obj,parent);
- parent->do_slots(obj,visitor);
+ obj->each_slot(visitor);
}
};
free_heap_block *free_list::find_free_block(cell size)
{
/* Check small free lists */
- for(cell i = size / block_granularity; i < free_list_count; i++)
+ if(size / block_granularity < free_list_count)
{
- std::vector<free_heap_block *> &blocks = small_blocks[i];
- if(blocks.size())
+ std::vector<free_heap_block *> &blocks = small_blocks[size / block_granularity];
+ if(blocks.size() == 0)
{
- free_heap_block *block = blocks.back();
- blocks.pop_back();
-
- free_block_count--;
- free_space -= block->size();
-
- return block;
+ /* Round up to a multiple of 'size' */
+ cell large_block_size = ((allocation_page_size + size - 1) / size) * size;
+
+ /* Allocate a block this big */
+ free_heap_block *large_block = find_free_block(large_block_size);
+ if(!large_block) return NULL;
+
+ large_block = split_free_block(large_block,large_block_size);
+
+ /* Split it up into pieces and add each piece back to the free list */
+ for(cell offset = 0; offset < large_block_size; offset += size)
+ {
+ free_heap_block *small_block = large_block;
+ large_block = (free_heap_block *)((cell)large_block + size);
+ small_block->make_free(size);
+ add_to_free_list(small_block);
+ }
}
- }
-
- /* Check large free lists */
- free_heap_block key;
- key.make_free(size);
- large_block_set::iterator iter = large_blocks.lower_bound(&key);
- large_block_set::iterator end = large_blocks.end();
- if(iter != end)
- {
- free_heap_block *block = *iter;
- large_blocks.erase(iter);
+ free_heap_block *block = blocks.back();
+ blocks.pop_back();
free_block_count--;
free_space -= block->size();
return block;
}
+ else
+ {
+ /* Check large free list */
+ free_heap_block key;
+ key.make_free(size);
+ large_block_set::iterator iter = large_blocks.lower_bound(&key);
+ large_block_set::iterator end = large_blocks.end();
- return NULL;
+ if(iter != end)
+ {
+ free_heap_block *block = *iter;
+ large_blocks.erase(iter);
+
+ free_block_count--;
+ free_space -= block->size();
+
+ return block;
+ }
+
+ return NULL;
+ }
}
free_heap_block *free_list::split_free_block(free_heap_block *block, cell size)
bool free_list::can_allot_p(cell size)
{
- /* Check small free lists */
- for(cell i = size / block_granularity; i < free_list_count; i++)
- {
- if(small_blocks[i].size()) return true;
- }
-
- /* Check large free lists */
- large_block_set::const_iterator iter = large_blocks.begin();
- large_block_set::const_iterator end = large_blocks.end();
-
- for(; iter != end; iter++)
- {
- if((*iter)->size() >= size) return true;
- }
-
- return false;
+ return largest_free_block() >= std::max(size,allocation_page_size);
}
cell free_list::largest_free_block()
{
static const cell free_list_count = 32;
+static const cell allocation_page_size = 1024;
struct free_heap_block
{
collect_mark_impl(trace_contexts_p);
collect_sweep_impl();
if(data->low_memory_p())
+ {
+ current_gc->op = collect_compact_op;
+ current_gc->event->op = collect_compact_op;
collect_compact_impl(trace_contexts_p);
+ }
else
update_code_heap_words_and_literals();
}
* It is up to the caller to fill in the object's fields in a meaningful
* fashion!
*/
-object *factor_vm::allot_large_object(header header, cell size)
+object *factor_vm::allot_large_object(cell type, cell size)
{
/* If tenured space does not have enough room, collect and compact */
if(!data->tenured->can_allot_p(size))
a nursery allocation */
write_barrier(obj,size);
- obj->h = header;
+ obj->initialize(type);
return obj;
}
{
if(gc_events)
{
- byte_array *data = byte_array_from_values(&gc_events->front(),gc_events->size());
- dpush(tag<byte_array>(data));
+ growable_array result(this);
- delete gc_events;
- gc_events = NULL;
+ std::vector<gc_event> *gc_events = this->gc_events;
+ this->gc_events = NULL;
+
+ std::vector<gc_event>::const_iterator iter = gc_events->begin();
+ std::vector<gc_event>::const_iterator end = gc_events->end();
+
+ for(; iter != end; iter++)
+ {
+ gc_event event = *iter;
+ byte_array *obj = byte_array_from_value(&event);
+ result.add(tag<byte_array>(obj));
+ }
+
+ result.trim();
+ dpush(result.elements.value());
+
+ delete this->gc_events;
}
else
dpush(false_object);
cell data_sweep_time;
cell code_sweep_time;
cell compaction_time;
- cell temp_time;
+ u64 temp_time;
explicit gc_event(gc_op op_, factor_vm *parent);
void started_card_scan();
cell data_relocation_base,
cell code_relocation_base)
{
- cell hi_tag = object->h.hi_tag();
+ cell type = object->type();
/* Tuple relocation is a bit trickier; we have to fix up the
- layout object before we can get the tuple size, so do_slots is
+ layout object before we can get the tuple size, so each_slot is
out of the question */
- if(hi_tag == TUPLE_TYPE)
+ if(type == TUPLE_TYPE)
{
tuple *t = (tuple *)object;
data_fixup(&t->layout,data_relocation_base);
else
{
object_fixupper fixupper(this,data_relocation_base);
- do_slots(object,fixupper);
+ object->each_slot(fixupper);
- switch(hi_tag)
+ switch(type)
{
case WORD_TYPE:
fixup_word((word *)object,code_relocation_base);
#define TYPE_COUNT 14
-#define FORWARDING_POINTER 5 /* can be anything other than FIXNUM_TYPE */
-
enum code_block_type
{
code_block_unoptimized,
struct object;
-struct header {
- cell value;
+#define NO_TYPE_CHECK static const cell type_number = TYPE_COUNT
+
+struct object {
+ NO_TYPE_CHECK;
+ cell header;
+
+ cell size() const;
+ cell binary_payload_start() const;
- /* Default ctor to make gcc 3.x happy */
- explicit header() { abort(); }
+ cell *slots() const { return (cell *)this; }
- explicit header(cell value_) : value(value_ << TAG_BITS) {}
+ template<typename Iterator> void each_slot(Iterator &iter);
- void check_header() const
+ /* Only valid for objects in tenured space; must cast to free_heap_block
+ to do anything with it if its free */
+ bool free_p() const
{
-#ifdef FACTOR_DEBUG
- assert(TAG(value) == FIXNUM_TYPE && untag_fixnum(value) < TYPE_COUNT);
-#endif
+ return (header & 1) == 1;
}
- cell hi_tag() const
+ cell type() const
{
- check_header();
- return value >> TAG_BITS;
+ return (header >> 2) & TAG_MASK;
}
- bool forwarding_pointer_p() const
+ void initialize(cell type)
{
- return TAG(value) == FORWARDING_POINTER;
+ header = type << 2;
}
- object *forwarding_pointer() const
+ cell hashcode() const
{
- return (object *)UNTAG(value);
+ return (header >> 6);
}
- void forward_to(object *pointer)
+ void set_hashcode(cell hashcode)
{
- value = RETAG(pointer,FORWARDING_POINTER);
+ header = (header & 0x3f) | (hashcode << 6);
}
-};
-
-#define NO_TYPE_CHECK static const cell type_number = TYPE_COUNT
-struct object {
- NO_TYPE_CHECK;
- header h;
-
- cell size() const;
- cell binary_payload_start() const;
+ bool forwarding_pointer_p() const
+ {
+ return (header & 2) == 2;
+ }
- cell *slots() const { return (cell *)this; }
+ object *forwarding_pointer() const
+ {
+ return (object *)UNTAG(header);
+ }
- /* Only valid for objects in tenured space; must fast to free_heap_block
- to do anything with it if its free */
- bool free_p() const
+ void forward_to(object *pointer)
{
- return (h.value & 1) == 1;
+ header = ((cell)pointer | 2);
}
};
special_objects[e] = value;
}
+void factor_vm::primitive_identity_hashcode()
+{
+ cell tagged = dpeek();
+ object *obj = untag<object>(tagged);
+ drepl(tag_fixnum(obj->hashcode()));
+}
+
+void factor_vm::compute_identity_hashcode(object *obj)
+{
+ object_counter++;
+ if(object_counter == 0) object_counter++;
+ obj->set_hashcode((cell)obj ^ object_counter);
+}
+
+void factor_vm::primitive_compute_identity_hashcode()
+{
+ object *obj = untag<object>(dpop());
+ compute_identity_hashcode(obj);
+}
+
void factor_vm::primitive_set_slot()
{
fixnum slot = untag_fixnum(dpop());
else
{
cell size = object_size(obj.value());
- object *new_obj = allot_object(header(obj.type()),size);
+ object *new_obj = allot_object(obj.type(),size);
memcpy(new_obj,obj.untagged(),size);
+ new_obj->set_hashcode(0);
return tag_dynamic(new_obj);
}
}
/* Callback stub generation in callbacks.c */
CALLBACK_STUB = 45,
+
+ /* Incremented on every modify-code-heap call; invalidates call( inline
+ caching */
+ REDEFINITION_COUNTER = 46,
/* Polymorphic inline cache generation in inline_cache.c */
PIC_LOAD = 47,
return (i >= OBJ_FIRST_SAVE && i <= OBJ_LAST_SAVE);
}
+template<typename Iterator> void object::each_slot(Iterator &iter)
+{
+ cell scan = (cell)this;
+ cell payload_start = binary_payload_start();
+ cell end = scan + payload_start;
+
+ scan += sizeof(cell);
+
+ while(scan < end)
+ {
+ iter((cell *)scan);
+ scan += sizeof(cell);
+ }
+}
+
}
PRIMITIVE_FORWARD(callback)
PRIMITIVE_FORWARD(enable_gc_events)
PRIMITIVE_FORWARD(disable_gc_events)
+PRIMITIVE_FORWARD(identity_hashcode)
+PRIMITIVE_FORWARD(compute_identity_hashcode)
const primitive_type primitives[] = {
primitive_bignum_to_fixnum,
primitive_callback,
primitive_enable_gc_events,
primitive_disable_gc_events,
+ primitive_identity_hashcode,
+ primitive_compute_identity_hashcode,
};
}
void factor_vm::primitive_resize_string()
{
- string* str = untag_check<string>(dpop());
+ data_root<string> str(dpop(),this);
+ str.untag_check(this);
cell capacity = unbox_array_size();
- dpush(tag<string>(reallot_string(str,capacity)));
+ dpush(tag<string>(reallot_string(str.untagged(),capacity)));
}
void factor_vm::primitive_string_nth()
inline static cell tag_dynamic(object *value)
{
- return RETAG(value,value->h.hi_tag());
+ return RETAG(value,value->type());
}
template<typename Type>
/* Number of entries in a polymorphic inline cache */
cell max_pic_size;
+ /* Incrementing object counter for identity hashing */
+ cell object_counter;
+
// contexts
void reset_datastack();
void reset_retainstack();
// objects
void primitive_special_object();
void primitive_set_special_object();
+ void primitive_identity_hashcode();
+ void compute_identity_hashcode(object *obj);
+ void primitive_compute_identity_hashcode();
cell object_size(cell tagged);
cell clone_object(cell obj_);
void primitive_clone();
inline void write_barrier(object *obj, cell size)
{
- char *start = (char *)obj;
- for(cell offset = 0; offset < size; offset += card_size)
- write_barrier((cell *)(start + offset));
+ cell start = (cell)obj & -card_size;
+ cell end = ((cell)obj + size + card_size - 1) & -card_size;
+
+ for(cell offset = start; offset < end; offset += card_size)
+ write_barrier((cell *)offset);
}
+ // data heap checker
+ void check_data_heap();
+
// gc
void end_gc();
void start_gc_again();
void inline_gc(cell *data_roots_base, cell data_roots_size);
void primitive_enable_gc_events();
void primitive_disable_gc_events();
- object *allot_object(header header, cell size);
- object *allot_large_object(header header, cell size);
+ object *allot_object(cell type, cell size);
+ object *allot_large_object(cell type, cell size);
template<typename Type> Type *allot(cell size)
{
- return (Type *)allot_object(header(Type::type_number),size);
+ return (Type *)allot_object(Type::type_number,size);
}
inline void check_data_pointer(object *pointer)
void primitive_resize_byte_array();
template<typename Type> byte_array *byte_array_from_value(Type *value);
- template<typename Type> byte_array *byte_array_from_values(Type *values, cell len);
//tuples
void primitive_tuple();
void save_callstack_bottom(stack_frame *callstack_bottom);
template<typename Iterator> void iterate_callstack(context *ctx, Iterator &iterator);
- /* Every object has a regular representation in the runtime, which makes GC
- much simpler. Every slot of the object until binary_payload_start is a pointer
- to some other object. */
- template<typename Iterator> void do_slots(object *obj, Iterator &iter)
- {
- cell scan = (cell)obj;
- cell payload_start = obj->binary_payload_start();
- cell end = scan + payload_start;
-
- scan += sizeof(cell);
-
- while(scan < end)
- {
- iter((cell *)scan);
- scan += sizeof(cell);
- }
- }
-
//alien
char *pinned_alien_offset(cell obj);
cell allot_alien(cell delegate_, cell displacement);
projects / factor.git / commitdiff