From 4ecd7fff4237df32f2409f7ee16db16d32cd57f6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Apr 2007 04:27:15 -0500 Subject: [PATCH 001/219] split up some unix constants split up netbsd stat --- extra/unix/bsd/bsd.factor | 11 +++++++--- extra/unix/bsd/freebsd/freebsd.factor | 3 +++ extra/unix/bsd/macosx/macosx.factor | 3 +++ extra/unix/bsd/netbsd/netbsd.factor | 3 +++ extra/unix/bsd/openbsd/openbsd.factor | 3 +++ extra/unix/stat/netbsd/32/32.factor | 26 ++++++++++++++++++++++++ extra/unix/stat/netbsd/64/64.factor | 27 +++++++++++++++++++++++++ extra/unix/stat/netbsd/netbsd.factor | 29 +++++---------------------- extra/unix/types/netbsd/netbsd.factor | 5 ++--- extra/unix/unix.factor | 1 - 10 files changed, 80 insertions(+), 31 deletions(-) create mode 100644 extra/unix/bsd/freebsd/freebsd.factor create mode 100644 extra/unix/bsd/macosx/macosx.factor create mode 100644 extra/unix/bsd/netbsd/netbsd.factor create mode 100644 extra/unix/bsd/openbsd/openbsd.factor create mode 100644 extra/unix/stat/netbsd/32/32.factor create mode 100644 extra/unix/stat/netbsd/64/64.factor diff --git a/extra/unix/bsd/bsd.factor b/extra/unix/bsd/bsd.factor index e652f1b9f9..cb7b347c20 100755 --- a/extra/unix/bsd/bsd.factor +++ b/extra/unix/bsd/bsd.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax combinators system vocabs.loader ; IN: unix -USING: alien.syntax ; ! FreeBSD @@ -15,8 +15,6 @@ USING: alien.syntax ; : O_TRUNC HEX: 0400 ; inline : O_EXCL HEX: 0800 ; inline -: FD_SETSIZE 1024 ; inline - : SOL_SOCKET HEX: ffff ; inline : SO_REUSEADDR HEX: 4 ; inline : SO_OOBINLINE HEX: 100 ; inline @@ -83,3 +81,10 @@ C-STRUCT: sockaddr-un : SEEK_SET 0 ; inline : SEEK_CUR 1 ; inline : SEEK_END 2 ; inline + +os { + { "macosx" [ "unix.bsd.macosx" require ] } + { "freebsd" [ "unix.bsd.freebsd" require ] } + { "openbsd" [ "unix.bsd.openbsd" require ] } + { "netbsd" [ "unix.bsd.netbsd" require ] } +} case diff --git a/extra/unix/bsd/freebsd/freebsd.factor b/extra/unix/bsd/freebsd/freebsd.factor new file mode 100644 index 0000000000..94bb708527 --- /dev/null +++ b/extra/unix/bsd/freebsd/freebsd.factor @@ -0,0 +1,3 @@ +IN: unix + +: FD_SETSIZE 1024 ; diff --git a/extra/unix/bsd/macosx/macosx.factor b/extra/unix/bsd/macosx/macosx.factor new file mode 100644 index 0000000000..3c0617ad17 --- /dev/null +++ b/extra/unix/bsd/macosx/macosx.factor @@ -0,0 +1,3 @@ +IN: unix + +: FD_SETSIZE 1024 ; inline diff --git a/extra/unix/bsd/netbsd/netbsd.factor b/extra/unix/bsd/netbsd/netbsd.factor new file mode 100644 index 0000000000..ac18749830 --- /dev/null +++ b/extra/unix/bsd/netbsd/netbsd.factor @@ -0,0 +1,3 @@ +IN: unix + +: FD_SETSIZE 256 ; inline diff --git a/extra/unix/bsd/openbsd/openbsd.factor b/extra/unix/bsd/openbsd/openbsd.factor new file mode 100644 index 0000000000..3c0617ad17 --- /dev/null +++ b/extra/unix/bsd/openbsd/openbsd.factor @@ -0,0 +1,3 @@ +IN: unix + +: FD_SETSIZE 1024 ; inline diff --git a/extra/unix/stat/netbsd/32/32.factor b/extra/unix/stat/netbsd/32/32.factor new file mode 100644 index 0000000000..bb2df6d6d3 --- /dev/null +++ b/extra/unix/stat/netbsd/32/32.factor @@ -0,0 +1,26 @@ +USING: kernel alien.syntax math ; +IN: unix.stat + +! NetBSD 4.0 + +C-STRUCT: stat + { "dev_t" "st_dev" } + { "mode_t" "st_mode" } + { "ino_t" "st_ino" } + { "nlink_t" "st_nlink" } + { "uid_t" "st_uid" } + { "gid_t" "st_gid" } + { "dev_t" "st_rdev" } + { "timespec" "st_atim" } + { "timespec" "st_mtim" } + { "timespec" "st_ctim" } + { "timespec" "st_birthtim" } + { "off_t" "st_size" } + { "blkcnt_t" "st_blocks" } + { "blksize_t" "st_blksize" } + { "uint32_t" "st_flags" } + { "uint32_t" "st_gen" } + { { "uint32_t" 2 } "st_qspare" } ; + +FUNCTION: int stat ( char* pathname, stat* buf ) ; +FUNCTION: int lstat ( char* pathname, stat* buf ) ; diff --git a/extra/unix/stat/netbsd/64/64.factor b/extra/unix/stat/netbsd/64/64.factor new file mode 100644 index 0000000000..f1f6f93dbd --- /dev/null +++ b/extra/unix/stat/netbsd/64/64.factor @@ -0,0 +1,27 @@ +USING: kernel alien.syntax math ; +IN: unix.stat + +! NetBSD 4.0 + +C-STRUCT: stat + { "dev_t" "st_dev" } + { "ino_t" "st_ino" } + { "mode_t" "st_mode" } + { "nlink_t" "st_nlink" } + { "uid_t" "st_uid" } + { "gid_t" "st_gid" } + { "dev_t" "st_rdev" } + { "timespec" "st_atim" } + { "timespec" "st_mtim" } + { "timespec" "st_ctim" } + { "off_t" "st_size" } + { "blkcnt_t" "st_blocks" } + { "blksize_t" "st_blksize" } + { "uint32_t" "st_flags" } + { "uint32_t" "st_gen" } + { "uint32_t" "st_spare0" } + { "timespec" "st_birthtim" } + { "int" "__pad5" } ; + +FUNCTION: int stat ( char* pathname, stat* buf ) ; +FUNCTION: int lstat ( char* pathname, stat* buf ) ; diff --git a/extra/unix/stat/netbsd/netbsd.factor b/extra/unix/stat/netbsd/netbsd.factor index bb2df6d6d3..8057e5939b 100644 --- a/extra/unix/stat/netbsd/netbsd.factor +++ b/extra/unix/stat/netbsd/netbsd.factor @@ -1,26 +1,7 @@ -USING: kernel alien.syntax math ; +USING: layouts combinators vocabs.loader ; IN: unix.stat -! NetBSD 4.0 - -C-STRUCT: stat - { "dev_t" "st_dev" } - { "mode_t" "st_mode" } - { "ino_t" "st_ino" } - { "nlink_t" "st_nlink" } - { "uid_t" "st_uid" } - { "gid_t" "st_gid" } - { "dev_t" "st_rdev" } - { "timespec" "st_atim" } - { "timespec" "st_mtim" } - { "timespec" "st_ctim" } - { "timespec" "st_birthtim" } - { "off_t" "st_size" } - { "blkcnt_t" "st_blocks" } - { "blksize_t" "st_blksize" } - { "uint32_t" "st_flags" } - { "uint32_t" "st_gen" } - { { "uint32_t" 2 } "st_qspare" } ; - -FUNCTION: int stat ( char* pathname, stat* buf ) ; -FUNCTION: int lstat ( char* pathname, stat* buf ) ; +cell-bits { + { 32 [ "unix.stat.netbsd.32" require ] } + { 64 [ "unix.stat.netbsd.64" require ] } +} case diff --git a/extra/unix/types/netbsd/netbsd.factor b/extra/unix/types/netbsd/netbsd.factor index 77636a6d6d..6d33547627 100755 --- a/extra/unix/types/netbsd/netbsd.factor +++ b/extra/unix/types/netbsd/netbsd.factor @@ -18,7 +18,7 @@ TYPEDEF: ulonglong u_int64_t TYPEDEF: __uint32_t __dev_t TYPEDEF: __uint32_t dev_t -TYPEDEF: __uint64_t ino_t +TYPEDEF: __uint32_t ino_t TYPEDEF: __uint32_t mode_t TYPEDEF: __uint32_t nlink_t TYPEDEF: __uint32_t uid_t @@ -26,7 +26,6 @@ TYPEDEF: __uint32_t gid_t TYPEDEF: __int64_t off_t TYPEDEF: __int64_t blkcnt_t TYPEDEF: __uint32_t blksize_t -TYPEDEF: __uint32_t fflags_t -TYPEDEF: int ssize_t +TYPEDEF: longlong ssize_t TYPEDEF: int pid_t TYPEDEF: int time_t diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 09d77fee11..d02e180cff 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -149,6 +149,5 @@ FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ; { [ linux? ] [ "unix.linux" require ] } { [ bsd? ] [ "unix.bsd" require ] } { [ solaris? ] [ "unix.solaris" require ] } - { [ t ] [ ] } } cond From b993a1c588c5bf091e353d84bd3295081f3e05f2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Apr 2007 04:27:28 -0500 Subject: [PATCH 002/219] more constants --- build-support/grovel.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/build-support/grovel.c b/build-support/grovel.c index 8422ec197c..1260b29c80 100644 --- a/build-support/grovel.c +++ b/build-support/grovel.c @@ -141,10 +141,12 @@ void unix_constants() constant(EINTR); constant(EAGAIN); constant(EINPROGRESS); - constant(PROT_READ); + constant(PROT_READ); constant(PROT_WRITE); constant(MAP_FILE); constant(MAP_SHARED); + grovel(pid_t); + } int main() { @@ -158,6 +160,10 @@ int main() { openbsd_stat(); openbsd_types(); #endif + grovel(blkcnt_t); + grovel(blksize_t); + //grovel(fflags_t); + grovel(ssize_t); #ifdef UNIX unix_types(); From 4c449296b207fba5ba4de2125e0e6beb5ef93292 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Mar 2008 11:18:32 -0500 Subject: [PATCH 003/219] Fix NetBSD FFI --- core/cpu/x86/architecture/architecture.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor index 49b05ea48f..f993639c05 100755 --- a/core/cpu/x86/architecture/architecture.factor +++ b/core/cpu/x86/architecture/architecture.factor @@ -156,7 +156,7 @@ M: x86-backend %unbox-small-struct ( size -- ) M: x86-backend struct-small-enough? ( size -- ? ) { 1 2 4 8 } member? - os { "linux" "solaris" } member? not and ; + os { "linux" "netbsd" "solaris" } member? not and ; M: x86-backend %return ( -- ) 0 %unwind ; From aad587d6647607042bbbed72e59cbbb67d801c46 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Mar 2008 11:48:51 -0500 Subject: [PATCH 004/219] Fix deploy test --- extra/tools/deploy/deploy-tests.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/extra/tools/deploy/deploy-tests.factor b/extra/tools/deploy/deploy-tests.factor index 8db34320de..5030763a3d 100755 --- a/extra/tools/deploy/deploy-tests.factor +++ b/extra/tools/deploy/deploy-tests.factor @@ -1,10 +1,11 @@ IN: tools.deploy.tests USING: tools.test system io.files kernel tools.deploy.config tools.deploy.backend math sequences io.launcher arrays -namespaces ; +namespaces continuations ; : shake-and-bake ( vocab -- ) - "." resource-path [ + [ "test.image" temp-file delete-file ] ignore-errors + "resource:" [ >r vm "test.image" temp-file r> dup deploy-config make-deploy-image From ea94662abd7abe4b19ccd6e0a7eaf17211792db2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Apr 2007 05:49:09 -0500 Subject: [PATCH 005/219] NetBSD x86/64 fixes --- vm/{os-linux-x86-32.h => os-linux-x86.32.h} | 0 vm/{os-linux-x86-64.h => os-linux-x86.64.h} | 0 vm/os-netbsd-x86.32.h | 3 +++ vm/os-netbsd-x86.64.h | 4 ++++ vm/os-netbsd.h | 1 - vm/platform.h | 13 +++++++++++-- 6 files changed, 18 insertions(+), 3 deletions(-) rename vm/{os-linux-x86-32.h => os-linux-x86.32.h} (100%) rename vm/{os-linux-x86-64.h => os-linux-x86.64.h} (100%) create mode 100644 vm/os-netbsd-x86.32.h create mode 100644 vm/os-netbsd-x86.64.h diff --git a/vm/os-linux-x86-32.h b/vm/os-linux-x86.32.h similarity index 100% rename from vm/os-linux-x86-32.h rename to vm/os-linux-x86.32.h diff --git a/vm/os-linux-x86-64.h b/vm/os-linux-x86.64.h similarity index 100% rename from vm/os-linux-x86-64.h rename to vm/os-linux-x86.64.h diff --git a/vm/os-netbsd-x86.32.h b/vm/os-netbsd-x86.32.h new file mode 100644 index 0000000000..ca4a9f88f5 --- /dev/null +++ b/vm/os-netbsd-x86.32.h @@ -0,0 +1,3 @@ +#include + +#define ucontext_stack_pointer(uap) ((void *)_UC_MACHINE_SP((ucontext_t *)uap)) diff --git a/vm/os-netbsd-x86.64.h b/vm/os-netbsd-x86.64.h new file mode 100644 index 0000000000..587dc85ec7 --- /dev/null +++ b/vm/os-netbsd-x86.64.h @@ -0,0 +1,4 @@ +#include + +#define ucontext_stack_pointer(uap) \ + ((void *)(((ucontext_t *)(uap))->uc_mcontext.__gregs[_REG_URSP])) diff --git a/vm/os-netbsd.h b/vm/os-netbsd.h index e282828577..b42c6b9d7e 100644 --- a/vm/os-netbsd.h +++ b/vm/os-netbsd.h @@ -1,6 +1,5 @@ #include -#define ucontext_stack_pointer(uap) ((void *)_UC_MACHINE_SP((ucontext_t *)uap)) #define UAP_PROGRAM_COUNTER(uap) _UC_MACHINE_PC((ucontext_t *)uap) #define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN) diff --git a/vm/platform.h b/vm/platform.h index cd2b6e0a0e..7678d483d6 100644 --- a/vm/platform.h +++ b/vm/platform.h @@ -67,20 +67,29 @@ #endif #elif defined(__NetBSD__) #define FACTOR_OS_STRING "netbsd" + + #if defined(FACTOR_X86) + #include "os-netbsd-x86.32.h" + #elif defined(FACTOR_AMD64) + #include "os-netbsd-x86.64.h" + #else + #error "Unsupported NetBSD flavor" + #endif + #include "os-netbsd.h" #elif defined(linux) #define FACTOR_OS_STRING "linux" #include "os-linux.h" #if defined(FACTOR_X86) - #include "os-linux-x86-32.h" + #include "os-linux-x86.32.h" #elif defined(FACTOR_PPC) #include "os-unix-ucontext.h" #include "os-linux-ppc.h" #elif defined(FACTOR_ARM) #include "os-linux-arm.h" #elif defined(FACTOR_AMD64) - #include "os-linux-x86-64.h" + #include "os-linux-x86.64.h" #else #error "Unsupported Linux flavor" #endif From d7872708a0d36fcc70290d23b94659ca7efed5a1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Apr 2007 06:13:34 -0500 Subject: [PATCH 006/219] Fix 64-bit stat --- extra/unix/stat/netbsd/64/64.factor | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/extra/unix/stat/netbsd/64/64.factor b/extra/unix/stat/netbsd/64/64.factor index f1f6f93dbd..46ab43eeca 100644 --- a/extra/unix/stat/netbsd/64/64.factor +++ b/extra/unix/stat/netbsd/64/64.factor @@ -20,8 +20,10 @@ C-STRUCT: stat { "uint32_t" "st_flags" } { "uint32_t" "st_gen" } { "uint32_t" "st_spare0" } - { "timespec" "st_birthtim" } - { "int" "__pad5" } ; + { "timespec" "st_birthtim" } ; -FUNCTION: int stat ( char* pathname, stat* buf ) ; -FUNCTION: int lstat ( char* pathname, stat* buf ) ; +FUNCTION: int __stat13 ( char* pathname, stat* buf ) ; +FUNCTION: int __lstat13 ( char* pathname, stat* buf ) ; + +: stat __stat13 ; inline +: lstat __lstat13 ; inline From 0a34198912cc6b4c7054c661d8861e0faa4cb4cc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Apr 2007 06:24:02 -0500 Subject: [PATCH 007/219] Working on kqueue --- extra/unix/kqueue/freebsd/freebsd.factor | 13 +++++++++++++ extra/unix/kqueue/kqueue.factor | 15 +++------------ extra/unix/kqueue/macosx/macosx.factor | 13 +++++++++++++ extra/unix/kqueue/netbsd/netbsd.factor | 14 ++++++++++++++ extra/unix/kqueue/openbsd/openbsd.factor | 14 ++++++++++++++ 5 files changed, 57 insertions(+), 12 deletions(-) create mode 100644 extra/unix/kqueue/freebsd/freebsd.factor create mode 100644 extra/unix/kqueue/macosx/macosx.factor create mode 100644 extra/unix/kqueue/netbsd/netbsd.factor create mode 100644 extra/unix/kqueue/openbsd/openbsd.factor diff --git a/extra/unix/kqueue/freebsd/freebsd.factor b/extra/unix/kqueue/freebsd/freebsd.factor new file mode 100644 index 0000000000..4cc539daa3 --- /dev/null +++ b/extra/unix/kqueue/freebsd/freebsd.factor @@ -0,0 +1,13 @@ +USE: alien.syntax +IN: unix.kqueue + +C-STRUCT: kevent + { "ulong" "ident" } ! identifier for this event + { "short" "filter" } ! filter for event + { "ushort" "flags" } ! action flags for kqueue + { "uint" "fflags" } ! filter flag value + { "long" "data" } ! filter data value + { "void*" "udata" } ! opaque user data identifier +; + +FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ; diff --git a/extra/unix/kqueue/kqueue.factor b/extra/unix/kqueue/kqueue.factor index 4e6504470d..8166052b01 100644 --- a/extra/unix/kqueue/kqueue.factor +++ b/extra/unix/kqueue/kqueue.factor @@ -1,21 +1,12 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax ; +USING: alien.syntax system sequences vocabs.loader ; IN: unix.kqueue +<< "unix.kqueue." os append require >> + FUNCTION: int kqueue ( ) ; -FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ; - -C-STRUCT: kevent - { "ulong" "ident" } ! identifier for this event - { "short" "filter" } ! filter for event - { "ushort" "flags" } ! action flags for kqueue - { "uint" "fflags" } ! filter flag value - { "long" "data" } ! filter data value - { "void*" "udata" } ! opaque user data identifier -; - : EVFILT_READ -1 ; inline : EVFILT_WRITE -2 ; inline : EVFILT_AIO -3 ; inline ! attached to aio requests diff --git a/extra/unix/kqueue/macosx/macosx.factor b/extra/unix/kqueue/macosx/macosx.factor new file mode 100644 index 0000000000..4cc539daa3 --- /dev/null +++ b/extra/unix/kqueue/macosx/macosx.factor @@ -0,0 +1,13 @@ +USE: alien.syntax +IN: unix.kqueue + +C-STRUCT: kevent + { "ulong" "ident" } ! identifier for this event + { "short" "filter" } ! filter for event + { "ushort" "flags" } ! action flags for kqueue + { "uint" "fflags" } ! filter flag value + { "long" "data" } ! filter data value + { "void*" "udata" } ! opaque user data identifier +; + +FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ; diff --git a/extra/unix/kqueue/netbsd/netbsd.factor b/extra/unix/kqueue/netbsd/netbsd.factor new file mode 100644 index 0000000000..7e97f3bcff --- /dev/null +++ b/extra/unix/kqueue/netbsd/netbsd.factor @@ -0,0 +1,14 @@ +USE: alien.syntax +IN: unix.kqueue + +C-STRUCT: kevent + { "ulong" "ident" } ! identifier for this event + { "uint" "filter" } ! filter for event + { "uint" "flags" } ! action flags for kqueue + { "uint" "fflags" } ! filter flag value + { "longlong" "data" } ! filter data value + { "void*" "udata" } ! opaque user data identifier +; + +FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ; + diff --git a/extra/unix/kqueue/openbsd/openbsd.factor b/extra/unix/kqueue/openbsd/openbsd.factor new file mode 100644 index 0000000000..7e97f3bcff --- /dev/null +++ b/extra/unix/kqueue/openbsd/openbsd.factor @@ -0,0 +1,14 @@ +USE: alien.syntax +IN: unix.kqueue + +C-STRUCT: kevent + { "ulong" "ident" } ! identifier for this event + { "uint" "filter" } ! filter for event + { "uint" "flags" } ! action flags for kqueue + { "uint" "fflags" } ! filter flag value + { "longlong" "data" } ! filter data value + { "void*" "udata" } ! opaque user data identifier +; + +FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ; + From 857a442e072704e54acbe9a1d112dac08c89a6a4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Mar 2008 13:10:51 -0500 Subject: [PATCH 008/219] fix struct sizes fix file-info --- extra/unix/stat/netbsd/32/32.factor | 7 +++++-- extra/unix/types/netbsd/32/32.factor | 6 ++++++ extra/unix/types/netbsd/64/64.factor | 6 ++++++ extra/unix/types/netbsd/netbsd.factor | 11 ++++++++--- 4 files changed, 25 insertions(+), 5 deletions(-) create mode 100755 extra/unix/types/netbsd/32/32.factor create mode 100755 extra/unix/types/netbsd/64/64.factor diff --git a/extra/unix/stat/netbsd/32/32.factor b/extra/unix/stat/netbsd/32/32.factor index bb2df6d6d3..d4b39a90d1 100644 --- a/extra/unix/stat/netbsd/32/32.factor +++ b/extra/unix/stat/netbsd/32/32.factor @@ -22,5 +22,8 @@ C-STRUCT: stat { "uint32_t" "st_gen" } { { "uint32_t" 2 } "st_qspare" } ; -FUNCTION: int stat ( char* pathname, stat* buf ) ; -FUNCTION: int lstat ( char* pathname, stat* buf ) ; +FUNCTION: int __stat30 ( char* pathname, stat* buf ) ; +FUNCTION: int __lstat30 ( char* pathname, stat* buf ) ; + +: stat __stat30 ; +: lstat __lstat30 ; diff --git a/extra/unix/types/netbsd/32/32.factor b/extra/unix/types/netbsd/32/32.factor new file mode 100755 index 0000000000..892626c416 --- /dev/null +++ b/extra/unix/types/netbsd/32/32.factor @@ -0,0 +1,6 @@ +USING: alien.syntax ; +IN: unix.types + +! NetBSD 4.0 + +TYPEDEF: __uint64_t ino_t diff --git a/extra/unix/types/netbsd/64/64.factor b/extra/unix/types/netbsd/64/64.factor new file mode 100755 index 0000000000..e475bd449b --- /dev/null +++ b/extra/unix/types/netbsd/64/64.factor @@ -0,0 +1,6 @@ +USING: alien.syntax ; +IN: unix.types + +! NetBSD 4.0 + +TYPEDEF: __uint32_t ino_t diff --git a/extra/unix/types/netbsd/netbsd.factor b/extra/unix/types/netbsd/netbsd.factor index 6d33547627..5b54928d95 100755 --- a/extra/unix/types/netbsd/netbsd.factor +++ b/extra/unix/types/netbsd/netbsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax ; +USING: alien.syntax combinators layouts vocabs.loader ; IN: unix.types ! NetBSD 4.0 @@ -18,7 +18,6 @@ TYPEDEF: ulonglong u_int64_t TYPEDEF: __uint32_t __dev_t TYPEDEF: __uint32_t dev_t -TYPEDEF: __uint32_t ino_t TYPEDEF: __uint32_t mode_t TYPEDEF: __uint32_t nlink_t TYPEDEF: __uint32_t uid_t @@ -26,6 +25,12 @@ TYPEDEF: __uint32_t gid_t TYPEDEF: __int64_t off_t TYPEDEF: __int64_t blkcnt_t TYPEDEF: __uint32_t blksize_t -TYPEDEF: longlong ssize_t +TYPEDEF: long ssize_t TYPEDEF: int pid_t TYPEDEF: int time_t + +cell-bits { + { 32 [ "unix.types.netbsd.32" require ] } + { 64 [ "unix.types.netbsd.64" require ] } +} case + From e61f63b2c9a6e9e4487949a69d5ab0db001c596d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Apr 2007 07:21:12 -0500 Subject: [PATCH 009/219] More kqueue changes --- extra/unix/kqueue/freebsd/freebsd.factor | 10 ++++++++++ extra/unix/kqueue/kqueue.factor | 10 ---------- extra/unix/kqueue/macosx/macosx.factor | 10 ++++++++++ extra/unix/kqueue/netbsd/netbsd.factor | 8 ++++++++ extra/unix/kqueue/openbsd/openbsd.factor | 7 +++++++ 5 files changed, 35 insertions(+), 10 deletions(-) diff --git a/extra/unix/kqueue/freebsd/freebsd.factor b/extra/unix/kqueue/freebsd/freebsd.factor index 4cc539daa3..edddae2c16 100644 --- a/extra/unix/kqueue/freebsd/freebsd.factor +++ b/extra/unix/kqueue/freebsd/freebsd.factor @@ -11,3 +11,13 @@ C-STRUCT: kevent ; FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ; + +: EVFILT_READ -1 ; inline +: EVFILT_WRITE -2 ; inline +: EVFILT_AIO -3 ; inline ! attached to aio requests +: EVFILT_VNODE -4 ; inline ! attached to vnodes +: EVFILT_PROC -5 ; inline ! attached to struct proc +: EVFILT_SIGNAL -6 ; inline ! attached to struct proc +: EVFILT_TIMER -7 ; inline ! timers +: EVFILT_NETDEV -8 ; inline ! Mach ports +: EVFILT_FS -9 ; inline ! Filesystem events diff --git a/extra/unix/kqueue/kqueue.factor b/extra/unix/kqueue/kqueue.factor index 8166052b01..55b53bd6d0 100644 --- a/extra/unix/kqueue/kqueue.factor +++ b/extra/unix/kqueue/kqueue.factor @@ -7,16 +7,6 @@ IN: unix.kqueue FUNCTION: int kqueue ( ) ; -: EVFILT_READ -1 ; inline -: EVFILT_WRITE -2 ; inline -: EVFILT_AIO -3 ; inline ! attached to aio requests -: EVFILT_VNODE -4 ; inline ! attached to vnodes -: EVFILT_PROC -5 ; inline ! attached to struct proc -: EVFILT_SIGNAL -6 ; inline ! attached to struct proc -: EVFILT_TIMER -7 ; inline ! timers -: EVFILT_MACHPORT -8 ; inline ! Mach ports -: EVFILT_FS -9 ; inline ! Filesystem events - ! actions : EV_ADD HEX: 1 ; inline ! add event to kq (implies enable) : EV_DELETE HEX: 2 ; inline ! delete event from kq diff --git a/extra/unix/kqueue/macosx/macosx.factor b/extra/unix/kqueue/macosx/macosx.factor index 4cc539daa3..7dc2a79c09 100644 --- a/extra/unix/kqueue/macosx/macosx.factor +++ b/extra/unix/kqueue/macosx/macosx.factor @@ -11,3 +11,13 @@ C-STRUCT: kevent ; FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ; + +: EVFILT_READ -1 ; inline +: EVFILT_WRITE -2 ; inline +: EVFILT_AIO -3 ; inline ! attached to aio requests +: EVFILT_VNODE -4 ; inline ! attached to vnodes +: EVFILT_PROC -5 ; inline ! attached to struct proc +: EVFILT_SIGNAL -6 ; inline ! attached to struct proc +: EVFILT_TIMER -7 ; inline ! timers +: EVFILT_MACHPORT -8 ; inline ! Mach ports +: EVFILT_FS -9 ; inline ! Filesystem events diff --git a/extra/unix/kqueue/netbsd/netbsd.factor b/extra/unix/kqueue/netbsd/netbsd.factor index 7e97f3bcff..e3fc11a688 100644 --- a/extra/unix/kqueue/netbsd/netbsd.factor +++ b/extra/unix/kqueue/netbsd/netbsd.factor @@ -12,3 +12,11 @@ C-STRUCT: kevent FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ; +: EVFILT_READ 0 ; inline +: EVFILT_WRITE 1 ; inline +: EVFILT_AIO 2 ; inline ! attached to aio requests +: EVFILT_VNODE 3 ; inline ! attached to vnodes +: EVFILT_PROC 4 ; inline ! attached to struct proc +: EVFILT_SIGNAL 5 ; inline ! attached to struct proc +: EVFILT_TIMER 6 ; inline ! timers +: EVFILT_SYSCOUNT 7 ; inline ! Filesystem events diff --git a/extra/unix/kqueue/openbsd/openbsd.factor b/extra/unix/kqueue/openbsd/openbsd.factor index 7e97f3bcff..70b75f42bd 100644 --- a/extra/unix/kqueue/openbsd/openbsd.factor +++ b/extra/unix/kqueue/openbsd/openbsd.factor @@ -12,3 +12,10 @@ C-STRUCT: kevent FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ; +: EVFILT_READ -1 ; inline +: EVFILT_WRITE -2 ; inline +: EVFILT_AIO -3 ; inline ! attached to aio requests +: EVFILT_VNODE -4 ; inline ! attached to vnodes +: EVFILT_PROC -5 ; inline ! attached to struct proc +: EVFILT_SIGNAL -6 ; inline ! attached to struct proc +: EVFILT_TIMER -7 ; inline ! timers From 6778362ae74dc1d07734e272ca6bd1e91598f346 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 23 Mar 2008 11:34:48 -0500 Subject: [PATCH 010/219] Fix OpenBSD kqueue --- extra/unix/kqueue/openbsd/openbsd.factor | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/extra/unix/kqueue/openbsd/openbsd.factor b/extra/unix/kqueue/openbsd/openbsd.factor index 70b75f42bd..bc4be88c42 100644 --- a/extra/unix/kqueue/openbsd/openbsd.factor +++ b/extra/unix/kqueue/openbsd/openbsd.factor @@ -2,15 +2,15 @@ USE: alien.syntax IN: unix.kqueue C-STRUCT: kevent - { "ulong" "ident" } ! identifier for this event - { "uint" "filter" } ! filter for event - { "uint" "flags" } ! action flags for kqueue - { "uint" "fflags" } ! filter flag value - { "longlong" "data" } ! filter data value - { "void*" "udata" } ! opaque user data identifier + { "uint" "ident" } ! identifier for this event + { "short" "filter" } ! filter for event + { "ushort" "flags" } ! action flags for kqueue + { "uint" "fflags" } ! filter flag value + { "int" "data" } ! filter data value + { "void*" "udata" } ! opaque user data identifier ; -FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ; +FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ; : EVFILT_READ -1 ; inline : EVFILT_WRITE -2 ; inline From e20e98133216e31e83f2f8514a5e1e340f2f78b1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 23 Mar 2008 11:38:26 -0500 Subject: [PATCH 011/219] fix temp-file --- core/io/files/files.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index cb80f98a50..48098e612d 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -278,7 +278,7 @@ DEFER: copy-tree-into prepend-path ; : temp-directory ( -- path ) - "resource:temp" dup make-directories ; + "temp" resource-path dup make-directories ; : temp-file ( name -- path ) temp-directory prepend-path ; From da3e9c2fb64805ad9b4c4ac25344911a15c84d5b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Apr 2007 07:35:29 -0500 Subject: [PATCH 012/219] add constant --- build-support/grovel.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/build-support/grovel.c b/build-support/grovel.c index 1260b29c80..2eee054dab 100644 --- a/build-support/grovel.c +++ b/build-support/grovel.c @@ -1,4 +1,5 @@ #include +#include #if defined(__FreeBSD__) #define BSD @@ -165,6 +166,8 @@ int main() { //grovel(fflags_t); grovel(ssize_t); + grovel(size_t); + grovel(struct kevent); #ifdef UNIX unix_types(); unix_constants(); From f50821af6e14025dcd049601645dfaf17a62e014 Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Wed, 12 Mar 2008 02:11:03 -0700 Subject: [PATCH 013/219] Implement sequence matching in extra/match. --- extra/match/match.factor | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/extra/match/match.factor b/extra/match/match.factor index 722c330a32..36af5c990a 100755 --- a/extra/match/match.factor +++ b/extra/match/match.factor @@ -65,3 +65,26 @@ MACRO: match-cond ( assoc -- ) -rot match [ "Pattern does not match" throw ] unless* [ replace-patterns ] bind ; + +: ?1-tail ( seq -- tail/f ) + dup length zero? not [ 1 tail ] [ drop f ] if ; + +: (match-first) ( seq pattern-seq -- bindings leftover/f ) + 2dup [ length ] 2apply < [ 2drop f f ] + [ + 2dup length head over match + [ nip swap ?1-tail ] [ >r 1 tail r> (match-first) ] if* + ] if ; + +: match-first ( seq pattern-seq -- bindings ) + (match-first) drop ; + +: (match-all) ( seq pattern-seq -- ) + tuck (match-first) swap + [ + , [ swap (match-all) ] [ drop ] if* + ] [ 2drop ] if* ; + +: match-all ( seq pattern-seq -- bindings-seq ) + [ (match-all) ] { } make ; + From a14854520da6b9c41ee0f0aeb9235fa9d894129a Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 21 Mar 2008 03:05:21 +1300 Subject: [PATCH 014/219] Compile pegs down to words --- extra/peg/parsers/parsers.factor | 6 +- extra/peg/peg.factor | 124 +++++++++++++++++++------------ 2 files changed, 78 insertions(+), 52 deletions(-) diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor index 3ccb1e7d10..407729004f 100755 --- a/extra/peg/parsers/parsers.factor +++ b/extra/peg/parsers/parsers.factor @@ -16,11 +16,11 @@ TUPLE: just-parser p1 ; ] ; -M: just-parser compile ( parser -- quot ) - just-parser-p1 compile just-pattern append ; +M: just-parser (compile) ( parser -- quot ) + just-parser-p1 compiled-parser just-pattern curry ; : just ( parser -- parser ) - just-parser construct-boa ; + just-parser construct-boa init-parser ; : 1token ( ch -- parser ) 1string token ; diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index b3200ec5eb..9d6b18398e 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -8,16 +8,42 @@ IN: peg TUPLE: parse-result remaining ast ; -GENERIC: compile ( parser -- quot ) - -: parse ( state parser -- result ) - compile call ; - SYMBOL: ignore : ( remaining ast -- parse-result ) parse-result construct-boa ; +TUPLE: parser ; +C: parser +M: parser equal? eq? ; + +: init-parser ( parser -- parser ) + #! Set the delegate for the parser + over set-delegate ; + +SYMBOL: compiled-parsers + +GENERIC: (compile) ( parser -- quot ) + +: compiled-parser ( parser -- word ) + #! Look to see if the given parser has been compied. + #! If not, compile it to a temporary word, cache it, + #! and return it. Otherwise return the existing one. + dup compiled-parsers get at [ + nip + ] [ + dup (compile) define-temp + [ swap compiled-parsers get set-at ] keep + ] if* ; + +: compile ( parser -- word ) + H{ } clone compiled-parsers [ + [ compiled-parser ] with-compilation-unit + ] with-variable ; + +: parse ( state parser -- result ) + compile call ; + ] % - seq-parser-parsers [ compile \ ?quot seq-pattern match-replace % ] each + seq-parser-parsers [ compiled-parser \ ?quot seq-pattern match-replace % ] each ] [ ] make ; TUPLE: choice-parser parsers ; @@ -110,14 +136,14 @@ TUPLE: choice-parser parsers ; dup [ ] [ - drop dup ?quot call + drop dup ?quot ] if ] ; -M: choice-parser compile ( parser -- quot ) +M: choice-parser (compile) ( parser -- quot ) [ f , - choice-parser-parsers [ compile \ ?quot choice-pattern match-replace % ] each + choice-parser-parsers [ compiled-parser \ ?quot choice-pattern match-replace % ] each \ nip , ] [ ] make ; @@ -134,20 +160,20 @@ TUPLE: repeat0-parser p1 ; : repeat0-pattern ( -- quot ) [ - ?quot swap (repeat0) + [ ?quot ] swap (repeat0) ] ; -M: repeat0-parser compile ( parser -- quot ) +M: repeat0-parser (compile) ( parser -- quot ) [ [ V{ } clone ] % - repeat0-parser-p1 compile \ ?quot repeat0-pattern match-replace % + repeat0-parser-p1 compiled-parser \ ?quot repeat0-pattern match-replace % ] [ ] make ; TUPLE: repeat1-parser p1 ; : repeat1-pattern ( -- quot ) [ - ?quot swap (repeat0) [ + [ ?quot ] swap (repeat0) [ dup parse-result-ast empty? [ drop f ] when @@ -156,49 +182,49 @@ TUPLE: repeat1-parser p1 ; ] if* ] ; -M: repeat1-parser compile ( parser -- quot ) +M: repeat1-parser (compile) ( parser -- quot ) [ [ V{ } clone ] % - repeat1-parser-p1 compile \ ?quot repeat1-pattern match-replace % + repeat1-parser-p1 compiled-parser \ ?quot repeat1-pattern match-replace % ] [ ] make ; TUPLE: optional-parser p1 ; : optional-pattern ( -- quot ) [ - dup ?quot call swap f or + dup ?quot swap f or ] ; -M: optional-parser compile ( parser -- quot ) - optional-parser-p1 compile \ ?quot optional-pattern match-replace ; +M: optional-parser (compile) ( parser -- quot ) + optional-parser-p1 compiled-parser \ ?quot optional-pattern match-replace ; TUPLE: ensure-parser p1 ; : ensure-pattern ( -- quot ) [ - dup ?quot call [ + dup ?quot [ ignore ] [ drop f ] if ] ; -M: ensure-parser compile ( parser -- quot ) - ensure-parser-p1 compile \ ?quot ensure-pattern match-replace ; +M: ensure-parser (compile) ( parser -- quot ) + ensure-parser-p1 compiled-parser \ ?quot ensure-pattern match-replace ; TUPLE: ensure-not-parser p1 ; : ensure-not-pattern ( -- quot ) [ - dup ?quot call [ + dup ?quot [ drop f ] [ ignore ] if ] ; -M: ensure-not-parser compile ( parser -- quot ) - ensure-not-parser-p1 compile \ ?quot ensure-not-pattern match-replace ; +M: ensure-not-parser (compile) ( parser -- quot ) + ensure-not-parser-p1 compiled-parser \ ?quot ensure-not-pattern match-replace ; TUPLE: action-parser p1 quot ; @@ -206,14 +232,14 @@ MATCH-VARS: ?action ; : action-pattern ( -- quot ) [ - ?quot call dup [ + ?quot dup [ dup parse-result-ast ?action call swap [ set-parse-result-ast ] keep ] when ] ; -M: action-parser compile ( parser -- quot ) - { action-parser-p1 action-parser-quot } get-slots [ compile ] dip +M: action-parser (compile) ( parser -- quot ) + { action-parser-p1 action-parser-quot } get-slots [ compiled-parser ] dip 2array { ?quot ?action } action-pattern match-replace ; : left-trim-slice ( string -- string ) @@ -225,31 +251,31 @@ M: action-parser compile ( parser -- quot ) TUPLE: sp-parser p1 ; -M: sp-parser compile ( parser -- quot ) +M: sp-parser (compile) ( parser -- quot ) [ - \ left-trim-slice , sp-parser-p1 compile % + \ left-trim-slice , sp-parser-p1 compiled-parser , ] [ ] make ; TUPLE: delay-parser quot ; -M: delay-parser compile ( parser -- quot ) +M: delay-parser (compile) ( parser -- quot ) [ - delay-parser-quot % \ compile , \ call , + delay-parser-quot % \ (compile) , \ call , ] [ ] make ; PRIVATE> : token ( string -- parser ) - token-parser construct-boa ; + token-parser construct-boa init-parser ; : satisfy ( quot -- parser ) - satisfy-parser construct-boa ; + satisfy-parser construct-boa init-parser ; : range ( min max -- parser ) - range-parser construct-boa ; + range-parser construct-boa init-parser ; : seq ( seq -- parser ) - seq-parser construct-boa ; + seq-parser construct-boa init-parser ; : 2seq ( parser1 parser2 -- parser ) 2array seq ; @@ -264,7 +290,7 @@ PRIVATE> { } make seq ; inline : choice ( seq -- parser ) - choice-parser construct-boa ; + choice-parser construct-boa init-parser ; : 2choice ( parser1 parser2 -- parser ) 2array choice ; @@ -279,31 +305,31 @@ PRIVATE> { } make choice ; inline : repeat0 ( parser -- parser ) - repeat0-parser construct-boa ; + repeat0-parser construct-boa init-parser ; : repeat1 ( parser -- parser ) - repeat1-parser construct-boa ; + repeat1-parser construct-boa init-parser ; : optional ( parser -- parser ) - optional-parser construct-boa ; + optional-parser construct-boa init-parser ; : ensure ( parser -- parser ) - ensure-parser construct-boa ; + ensure-parser construct-boa init-parser ; : ensure-not ( parser -- parser ) - ensure-not-parser construct-boa ; + ensure-not-parser construct-boa init-parser ; : action ( parser quot -- parser ) - action-parser construct-boa ; + action-parser construct-boa init-parser ; : sp ( parser -- parser ) - sp-parser construct-boa ; + sp-parser construct-boa init-parser ; : hide ( parser -- parser ) [ drop ignore ] action ; : delay ( quot -- parser ) - delay-parser construct-boa ; + delay-parser construct-boa init-parser ; : PEG: (:) [ From d1e0aa6e806e730d1972274e262a2f5b8ddd3563 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 22 Mar 2008 00:58:53 +1300 Subject: [PATCH 015/219] Get peg subvocabs working again --- extra/peg/ebnf/ebnf-tests.factor | 2 +- extra/peg/ebnf/ebnf.factor | 2 +- extra/peg/peg.factor | 8 ++++---- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index 54639431a4..c9b9f5d977 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: kernel tools.test peg peg.ebnf ; +USING: kernel tools.test peg peg.ebnf words ; IN: peg.ebnf.tests { T{ ebnf-non-terminal f "abc" } } [ diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index ab7baa547e..db478e571f 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -278,7 +278,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) : ebnf>quot ( string -- hashtable quot ) 'ebnf' parse check-parse-result - parse-result-ast transform dup main swap at compile ; + parse-result-ast transform dup main swap at compile 1quotation ; : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 9d6b18398e..47dc0a3454 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -3,7 +3,7 @@ USING: kernel sequences strings namespaces math assocs shuffle vectors arrays combinators.lib math.parser match unicode.categories sequences.lib compiler.units parser - words ; + words quotations ; IN: peg TUPLE: parse-result remaining ast ; @@ -42,7 +42,7 @@ GENERIC: (compile) ( parser -- quot ) ] with-variable ; : parse ( state parser -- result ) - compile call ; + compile execute ; @@ -334,7 +334,7 @@ PRIVATE> : PEG: (:) [ [ - call compile + call compile 1quotation [ dup [ parse-result-ast ] [ "Parse failed" throw ] if ] append define ] with-compilation-unit From 943b02ab2f1893012ff68af1bef4214f03c4d349 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 22 Mar 2008 01:59:16 +1300 Subject: [PATCH 016/219] Fix performance regression in pegs delay parser is improved to use a memoized quotation so the construction and compilation of the parser at runtime only occurs once. Changed compile so it would use equality rather than identity for memoization purposes. --- extra/peg/parsers/parsers.factor | 2 +- extra/peg/peg.factor | 50 +++++++++++++++----------------- 2 files changed, 25 insertions(+), 27 deletions(-) diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor index 407729004f..4bba60bb09 100755 --- a/extra/peg/parsers/parsers.factor +++ b/extra/peg/parsers/parsers.factor @@ -20,7 +20,7 @@ M: just-parser (compile) ( parser -- quot ) just-parser-p1 compiled-parser just-pattern curry ; : just ( parser -- parser ) - just-parser construct-boa init-parser ; + just-parser construct-boa ; : 1token ( ch -- parser ) 1string token ; diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 47dc0a3454..1707193e70 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -3,7 +3,7 @@ USING: kernel sequences strings namespaces math assocs shuffle vectors arrays combinators.lib math.parser match unicode.categories sequences.lib compiler.units parser - words quotations ; + words quotations effects memoize ; IN: peg TUPLE: parse-result remaining ast ; @@ -13,20 +13,12 @@ SYMBOL: ignore : ( remaining ast -- parse-result ) parse-result construct-boa ; -TUPLE: parser ; -C: parser -M: parser equal? eq? ; - -: init-parser ( parser -- parser ) - #! Set the delegate for the parser - over set-delegate ; - SYMBOL: compiled-parsers GENERIC: (compile) ( parser -- quot ) : compiled-parser ( parser -- word ) - #! Look to see if the given parser has been compied. + #! Look to see if the given parser has been compiled. #! If not, compile it to a temporary word, cache it, #! and return it. Otherwise return the existing one. dup compiled-parsers get at [ @@ -36,7 +28,7 @@ GENERIC: (compile) ( parser -- quot ) [ swap compiled-parsers get set-at ] keep ] if* ; -: compile ( parser -- word ) +MEMO: compile ( parser -- word ) H{ } clone compiled-parsers [ [ compiled-parser ] with-compilation-unit ] with-variable ; @@ -47,6 +39,7 @@ GENERIC: (compile) ( parser -- quot ) memoize-quot + [ % \ execute , ] [ ] make ; PRIVATE> : token ( string -- parser ) - token-parser construct-boa init-parser ; + token-parser construct-boa ; : satisfy ( quot -- parser ) - satisfy-parser construct-boa init-parser ; + satisfy-parser construct-boa ; : range ( min max -- parser ) - range-parser construct-boa init-parser ; + range-parser construct-boa ; : seq ( seq -- parser ) - seq-parser construct-boa init-parser ; + seq-parser construct-boa ; : 2seq ( parser1 parser2 -- parser ) 2array seq ; @@ -290,7 +288,7 @@ PRIVATE> { } make seq ; inline : choice ( seq -- parser ) - choice-parser construct-boa init-parser ; + choice-parser construct-boa ; : 2choice ( parser1 parser2 -- parser ) 2array choice ; @@ -305,31 +303,31 @@ PRIVATE> { } make choice ; inline : repeat0 ( parser -- parser ) - repeat0-parser construct-boa init-parser ; + repeat0-parser construct-boa ; : repeat1 ( parser -- parser ) - repeat1-parser construct-boa init-parser ; + repeat1-parser construct-boa ; : optional ( parser -- parser ) - optional-parser construct-boa init-parser ; + optional-parser construct-boa ; : ensure ( parser -- parser ) - ensure-parser construct-boa init-parser ; + ensure-parser construct-boa ; : ensure-not ( parser -- parser ) - ensure-not-parser construct-boa init-parser ; + ensure-not-parser construct-boa ; : action ( parser quot -- parser ) - action-parser construct-boa init-parser ; + action-parser construct-boa ; : sp ( parser -- parser ) - sp-parser construct-boa init-parser ; + sp-parser construct-boa ; : hide ( parser -- parser ) [ drop ignore ] action ; : delay ( quot -- parser ) - delay-parser construct-boa init-parser ; + delay-parser construct-boa ; : PEG: (:) [ From 3586b5a35d8b043fb46389064ccd691766c9cb30 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 21 Mar 2008 12:30:13 -0400 Subject: [PATCH 017/219] More 8-bit encodings --- extra/io/encodings/8-bit/8-bit-tests.factor | 9 + extra/io/encodings/8-bit/8-bit.factor | 89 +++++ extra/io/encodings/8-bit/8859-1.TXT | 303 ++++++++++++++ extra/io/encodings/8-bit/8859-10.TXT | 303 ++++++++++++++ extra/io/encodings/8-bit/8859-11.TXT | 297 ++++++++++++++ extra/io/encodings/8-bit/8859-13.TXT | 299 ++++++++++++++ extra/io/encodings/8-bit/8859-14.TXT | 301 ++++++++++++++ extra/io/encodings/8-bit/8859-15.TXT | 303 ++++++++++++++ extra/io/encodings/8-bit/8859-16.TXT | 299 ++++++++++++++ extra/io/encodings/8-bit/8859-2.TXT | 303 ++++++++++++++ extra/io/encodings/8-bit/8859-3.TXT | 296 ++++++++++++++ extra/io/encodings/8-bit/8859-4.TXT | 303 ++++++++++++++ extra/io/encodings/8-bit/8859-5.TXT | 303 ++++++++++++++ extra/io/encodings/8-bit/8859-6.TXT | 260 ++++++++++++ extra/io/encodings/8-bit/8859-7.TXT | 308 +++++++++++++++ extra/io/encodings/8-bit/8859-8.TXT | 270 +++++++++++++ extra/io/encodings/8-bit/8859-9.TXT | 307 +++++++++++++++ extra/io/encodings/8-bit/CP037.TXT | 275 +++++++++++++ extra/io/encodings/8-bit/CP1252.TXT | 274 +++++++++++++ extra/io/encodings/8-bit/GSM0338.TXT | 239 +++++++++++ extra/io/encodings/8-bit/KOI8-R.TXT | 302 ++++++++++++++ extra/io/encodings/8-bit/ROMAN.TXT | 370 ++++++++++++++++++ .../encodings/{latin1 => 8-bit}/authors.txt | 0 extra/io/encodings/8-bit/summary.txt | 1 + extra/io/encodings/{latin1 => 8-bit}/tags.txt | 0 extra/io/encodings/latin1/latin1-docs.factor | 5 - extra/io/encodings/latin1/latin1-tests.factor | 9 - extra/io/encodings/latin1/latin1.factor | 12 - extra/io/encodings/latin1/summary.txt | 1 - 29 files changed, 6014 insertions(+), 27 deletions(-) create mode 100644 extra/io/encodings/8-bit/8-bit-tests.factor create mode 100644 extra/io/encodings/8-bit/8-bit.factor create mode 100644 extra/io/encodings/8-bit/8859-1.TXT create mode 100644 extra/io/encodings/8-bit/8859-10.TXT create mode 100644 extra/io/encodings/8-bit/8859-11.TXT create mode 100644 extra/io/encodings/8-bit/8859-13.TXT create mode 100644 extra/io/encodings/8-bit/8859-14.TXT create mode 100644 extra/io/encodings/8-bit/8859-15.TXT create mode 100644 extra/io/encodings/8-bit/8859-16.TXT create mode 100644 extra/io/encodings/8-bit/8859-2.TXT create mode 100644 extra/io/encodings/8-bit/8859-3.TXT create mode 100644 extra/io/encodings/8-bit/8859-4.TXT create mode 100644 extra/io/encodings/8-bit/8859-5.TXT create mode 100644 extra/io/encodings/8-bit/8859-6.TXT create mode 100644 extra/io/encodings/8-bit/8859-7.TXT create mode 100644 extra/io/encodings/8-bit/8859-8.TXT create mode 100644 extra/io/encodings/8-bit/8859-9.TXT create mode 100644 extra/io/encodings/8-bit/CP037.TXT create mode 100644 extra/io/encodings/8-bit/CP1252.TXT create mode 100644 extra/io/encodings/8-bit/GSM0338.TXT create mode 100644 extra/io/encodings/8-bit/KOI8-R.TXT create mode 100644 extra/io/encodings/8-bit/ROMAN.TXT rename extra/io/encodings/{latin1 => 8-bit}/authors.txt (100%) create mode 100644 extra/io/encodings/8-bit/summary.txt rename extra/io/encodings/{latin1 => 8-bit}/tags.txt (100%) delete mode 100644 extra/io/encodings/latin1/latin1-docs.factor delete mode 100644 extra/io/encodings/latin1/latin1-tests.factor delete mode 100755 extra/io/encodings/latin1/latin1.factor delete mode 100644 extra/io/encodings/latin1/summary.txt diff --git a/extra/io/encodings/8-bit/8-bit-tests.factor b/extra/io/encodings/8-bit/8-bit-tests.factor new file mode 100644 index 0000000000..316e496219 --- /dev/null +++ b/extra/io/encodings/8-bit/8-bit-tests.factor @@ -0,0 +1,9 @@ +USING: io.encodings.string io.encodings.8-bit tools.test strings arrays ; +IN: io.encodings.8-bit.tests + +[ B{ CHAR: f CHAR: o CHAR: o } ] [ "foo" iso-8859-1 encode ] unit-test +[ { 256 } >string iso-8859-1 encode ] must-fail +[ B{ 255 } ] [ { 255 } iso-8859-1 encode ] unit-test + +[ "bar" ] [ "bar" iso-8859-1 decode ] unit-test +[ { CHAR: b 233 CHAR: r } ] [ { CHAR: b 233 CHAR: r } iso-8859-1 decode >array ] unit-test diff --git a/extra/io/encodings/8-bit/8-bit.factor b/extra/io/encodings/8-bit/8-bit.factor new file mode 100644 index 0000000000..ff0e6ec8bf --- /dev/null +++ b/extra/io/encodings/8-bit/8-bit.factor @@ -0,0 +1,89 @@ +! Copyright (C) 2008 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: math.parser arrays io.encodings sequences kernel +assocs hashtables io.encodings.ascii combinators.cleave +generic parser tuples words io io.files splitting namespaces +classes quotations ; +IN: io.encodings.8-bit + + ] map ] map ; + +: byte>ch ( assoc -- array ) + 256 replacement-char + [ [ swapd set-nth ] curry assoc-each ] keep ; + +: ch>byte ( assoc -- newassoc ) + [ swap ] assoc-map >hashtable ; + +: parse-file ( file-name -- byte>ch ch>byte ) + full-path ascii file-lines process-contents + [ byte>ch ] [ ch>byte ] bi ; + +: empty-tuple-class ( string -- class ) + in get create + dup { f } "slots" set-word-prop + dup predicate-word drop + dup { } define-tuple-class ; + +: data-quot ( class word data -- quot ) + >r [ word-name ] 2apply "/" swap 3append + "/data" append in get create dup 1quotation swap r> + 1quotation define ; + +: method-with-data ( class data word quot -- ) + >r swap >r 2dup r> data-quot r> + compose >r create-method r> define ; + +: encode-8-bit ( char stream encoding assoc -- ) + nip swapd at* [ encode-error ] unless swap stream-write1 ; + +: define-encode-char ( class assoc -- ) + \ encode-char [ encode-8-bit ] method-with-data ; + +: decode-8-bit ( stream encoding array -- char/f ) + nip swap stream-read1 [ swap nth ] [ drop f ] if* ; + +: define-decode-char ( class array -- ) + \ decode-char [ decode-8-bit ] method-with-data ; + +: 8-bit-methods ( class byte>ch ch>byte -- ) + >r over r> define-encode-char define-decode-char ; + +: define-8-bit-encoding ( tuple-name file-name -- ) + >r empty-tuple-class r> parse-file 8-bit-methods ; + +PRIVATE> + +! << mappings [ define-8-bit-encoding ] assoc-each >> diff --git a/extra/io/encodings/8-bit/8859-1.TXT b/extra/io/encodings/8-bit/8859-1.TXT new file mode 100644 index 0000000000..473ecabc17 --- /dev/null +++ b/extra/io/encodings/8-bit/8859-1.TXT @@ -0,0 +1,303 @@ +# +# Name: ISO/IEC 8859-1:1998 to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 1999 July 27 +# Authors: Ken Whistler +# +# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-1:1998 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-1 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-1 order. +# +# Version history +# 1.0 version updates 0.1 version by adding mappings for all +# control characters. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +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 0x00D0 # LATIN CAPITAL LETTER ETH (Icelandic) +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 0x00DD # LATIN CAPITAL LETTER Y WITH ACUTE +0xDE 0x00DE # LATIN CAPITAL LETTER THORN (Icelandic) +0xDF 0x00DF # LATIN SMALL LETTER SHARP S (German) +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 0x00F0 # LATIN SMALL LETTER ETH (Icelandic) +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 0x00FD # LATIN SMALL LETTER Y WITH ACUTE +0xFE 0x00FE # LATIN SMALL LETTER THORN (Icelandic) +0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS diff --git a/extra/io/encodings/8-bit/8859-10.TXT b/extra/io/encodings/8-bit/8859-10.TXT new file mode 100644 index 0000000000..374a42b1a5 --- /dev/null +++ b/extra/io/encodings/8-bit/8859-10.TXT @@ -0,0 +1,303 @@ +# +# Name: ISO/IEC 8859-10:1998 to Unicode +# Unicode version: 3.0 +# Table version: 1.1 +# Table format: Format A +# Date: 1999 October 11 +# Authors: Ken Whistler +# +# Copyright (c) 1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-10:1998 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-10 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-10 order. +# +# Version history +# 1.0 version new. +# 1.1 corrected mistake in mapping of 0xA4 +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA1 0x0104 # LATIN CAPITAL LETTER A WITH OGONEK +0xA2 0x0112 # LATIN CAPITAL LETTER E WITH MACRON +0xA3 0x0122 # LATIN CAPITAL LETTER G WITH CEDILLA +0xA4 0x012A # LATIN CAPITAL LETTER I WITH MACRON +0xA5 0x0128 # LATIN CAPITAL LETTER I WITH TILDE +0xA6 0x0136 # LATIN CAPITAL LETTER K WITH CEDILLA +0xA7 0x00A7 # SECTION SIGN +0xA8 0x013B # LATIN CAPITAL LETTER L WITH CEDILLA +0xA9 0x0110 # LATIN CAPITAL LETTER D WITH STROKE +0xAA 0x0160 # LATIN CAPITAL LETTER S WITH CARON +0xAB 0x0166 # LATIN CAPITAL LETTER T WITH STROKE +0xAC 0x017D # LATIN CAPITAL LETTER Z WITH CARON +0xAD 0x00AD # SOFT HYPHEN +0xAE 0x016A # LATIN CAPITAL LETTER U WITH MACRON +0xAF 0x014A # LATIN CAPITAL LETTER ENG +0xB0 0x00B0 # DEGREE SIGN +0xB1 0x0105 # LATIN SMALL LETTER A WITH OGONEK +0xB2 0x0113 # LATIN SMALL LETTER E WITH MACRON +0xB3 0x0123 # LATIN SMALL LETTER G WITH CEDILLA +0xB4 0x012B # LATIN SMALL LETTER I WITH MACRON +0xB5 0x0129 # LATIN SMALL LETTER I WITH TILDE +0xB6 0x0137 # LATIN SMALL LETTER K WITH CEDILLA +0xB7 0x00B7 # MIDDLE DOT +0xB8 0x013C # LATIN SMALL LETTER L WITH CEDILLA +0xB9 0x0111 # LATIN SMALL LETTER D WITH STROKE +0xBA 0x0161 # LATIN SMALL LETTER S WITH CARON +0xBB 0x0167 # LATIN SMALL LETTER T WITH STROKE +0xBC 0x017E # LATIN SMALL LETTER Z WITH CARON +0xBD 0x2015 # HORIZONTAL BAR +0xBE 0x016B # LATIN SMALL LETTER U WITH MACRON +0xBF 0x014B # LATIN SMALL LETTER ENG +0xC0 0x0100 # LATIN CAPITAL LETTER A WITH MACRON +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 0x012E # LATIN CAPITAL LETTER I WITH OGONEK +0xC8 0x010C # LATIN CAPITAL LETTER C WITH CARON +0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE +0xCA 0x0118 # LATIN CAPITAL LETTER E WITH OGONEK +0xCB 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS +0xCC 0x0116 # LATIN CAPITAL LETTER E WITH DOT ABOVE +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 0x00D0 # LATIN CAPITAL LETTER ETH (Icelandic) +0xD1 0x0145 # LATIN CAPITAL LETTER N WITH CEDILLA +0xD2 0x014C # LATIN CAPITAL LETTER O WITH MACRON +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 0x0168 # LATIN CAPITAL LETTER U WITH TILDE +0xD8 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE +0xD9 0x0172 # LATIN CAPITAL LETTER U WITH OGONEK +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 0x00DD # LATIN CAPITAL LETTER Y WITH ACUTE +0xDE 0x00DE # LATIN CAPITAL LETTER THORN (Icelandic) +0xDF 0x00DF # LATIN SMALL LETTER SHARP S (German) +0xE0 0x0101 # LATIN SMALL LETTER A WITH MACRON +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 0x012F # LATIN SMALL LETTER I WITH OGONEK +0xE8 0x010D # LATIN SMALL LETTER C WITH CARON +0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE +0xEA 0x0119 # LATIN SMALL LETTER E WITH OGONEK +0xEB 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS +0xEC 0x0117 # LATIN SMALL LETTER E WITH DOT ABOVE +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 0x00F0 # LATIN SMALL LETTER ETH (Icelandic) +0xF1 0x0146 # LATIN SMALL LETTER N WITH CEDILLA +0xF2 0x014D # LATIN SMALL LETTER O WITH MACRON +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 0x0169 # LATIN SMALL LETTER U WITH TILDE +0xF8 0x00F8 # LATIN SMALL LETTER O WITH STROKE +0xF9 0x0173 # LATIN SMALL LETTER U WITH OGONEK +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 0x00FD # LATIN SMALL LETTER Y WITH ACUTE +0xFE 0x00FE # LATIN SMALL LETTER THORN (Icelandic) +0xFF 0x0138 # LATIN SMALL LETTER KRA diff --git a/extra/io/encodings/8-bit/8859-11.TXT b/extra/io/encodings/8-bit/8859-11.TXT new file mode 100644 index 0000000000..192bd9d7cf --- /dev/null +++ b/extra/io/encodings/8-bit/8859-11.TXT @@ -0,0 +1,297 @@ +# +# Name: ISO/IEC 8859-11:2001 to Unicode +# Unicode version: 3.2 +# Table version: 1.0 +# Table format: Format A +# Date: 2002 October 7 +# Authors: Ken Whistler +# +# Copyright (c) 2002 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-11:2001 characters map into Unicode. +# +# ISO/IEC 8859-11:2001 is equivalent to TIS 620-2533 (1990) with +# the addition of 0xA0 NO-BREAK SPACE. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-11 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-11 order. +# +# Version history: +# 2002 October 7 Created +# +# Updated versions of this file may be found in: +# +# +# For any comments or problems, please use the Unicode +# web contact form at: +# http://www.unicode.org/unicode/reporting.html +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA1 0x0E01 # THAI CHARACTER KO KAI +0xA2 0x0E02 # THAI CHARACTER KHO KHAI +0xA3 0x0E03 # THAI CHARACTER KHO KHUAT +0xA4 0x0E04 # THAI CHARACTER KHO KHWAI +0xA5 0x0E05 # THAI CHARACTER KHO KHON +0xA6 0x0E06 # THAI CHARACTER KHO RAKHANG +0xA7 0x0E07 # THAI CHARACTER NGO NGU +0xA8 0x0E08 # THAI CHARACTER CHO CHAN +0xA9 0x0E09 # THAI CHARACTER CHO CHING +0xAA 0x0E0A # THAI CHARACTER CHO CHANG +0xAB 0x0E0B # THAI CHARACTER SO SO +0xAC 0x0E0C # THAI CHARACTER CHO CHOE +0xAD 0x0E0D # THAI CHARACTER YO YING +0xAE 0x0E0E # THAI CHARACTER DO CHADA +0xAF 0x0E0F # THAI CHARACTER TO PATAK +0xB0 0x0E10 # THAI CHARACTER THO THAN +0xB1 0x0E11 # THAI CHARACTER THO NANGMONTHO +0xB2 0x0E12 # THAI CHARACTER THO PHUTHAO +0xB3 0x0E13 # THAI CHARACTER NO NEN +0xB4 0x0E14 # THAI CHARACTER DO DEK +0xB5 0x0E15 # THAI CHARACTER TO TAO +0xB6 0x0E16 # THAI CHARACTER THO THUNG +0xB7 0x0E17 # THAI CHARACTER THO THAHAN +0xB8 0x0E18 # THAI CHARACTER THO THONG +0xB9 0x0E19 # THAI CHARACTER NO NU +0xBA 0x0E1A # THAI CHARACTER BO BAIMAI +0xBB 0x0E1B # THAI CHARACTER PO PLA +0xBC 0x0E1C # THAI CHARACTER PHO PHUNG +0xBD 0x0E1D # THAI CHARACTER FO FA +0xBE 0x0E1E # THAI CHARACTER PHO PHAN +0xBF 0x0E1F # THAI CHARACTER FO FAN +0xC0 0x0E20 # THAI CHARACTER PHO SAMPHAO +0xC1 0x0E21 # THAI CHARACTER MO MA +0xC2 0x0E22 # THAI CHARACTER YO YAK +0xC3 0x0E23 # THAI CHARACTER RO RUA +0xC4 0x0E24 # THAI CHARACTER RU +0xC5 0x0E25 # THAI CHARACTER LO LING +0xC6 0x0E26 # THAI CHARACTER LU +0xC7 0x0E27 # THAI CHARACTER WO WAEN +0xC8 0x0E28 # THAI CHARACTER SO SALA +0xC9 0x0E29 # THAI CHARACTER SO RUSI +0xCA 0x0E2A # THAI CHARACTER SO SUA +0xCB 0x0E2B # THAI CHARACTER HO HIP +0xCC 0x0E2C # THAI CHARACTER LO CHULA +0xCD 0x0E2D # THAI CHARACTER O ANG +0xCE 0x0E2E # THAI CHARACTER HO NOKHUK +0xCF 0x0E2F # THAI CHARACTER PAIYANNOI +0xD0 0x0E30 # THAI CHARACTER SARA A +0xD1 0x0E31 # THAI CHARACTER MAI HAN-AKAT +0xD2 0x0E32 # THAI CHARACTER SARA AA +0xD3 0x0E33 # THAI CHARACTER SARA AM +0xD4 0x0E34 # THAI CHARACTER SARA I +0xD5 0x0E35 # THAI CHARACTER SARA II +0xD6 0x0E36 # THAI CHARACTER SARA UE +0xD7 0x0E37 # THAI CHARACTER SARA UEE +0xD8 0x0E38 # THAI CHARACTER SARA U +0xD9 0x0E39 # THAI CHARACTER SARA UU +0xDA 0x0E3A # THAI CHARACTER PHINTHU +0xDF 0x0E3F # THAI CURRENCY SYMBOL BAHT +0xE0 0x0E40 # THAI CHARACTER SARA E +0xE1 0x0E41 # THAI CHARACTER SARA AE +0xE2 0x0E42 # THAI CHARACTER SARA O +0xE3 0x0E43 # THAI CHARACTER SARA AI MAIMUAN +0xE4 0x0E44 # THAI CHARACTER SARA AI MAIMALAI +0xE5 0x0E45 # THAI CHARACTER LAKKHANGYAO +0xE6 0x0E46 # THAI CHARACTER MAIYAMOK +0xE7 0x0E47 # THAI CHARACTER MAITAIKHU +0xE8 0x0E48 # THAI CHARACTER MAI EK +0xE9 0x0E49 # THAI CHARACTER MAI THO +0xEA 0x0E4A # THAI CHARACTER MAI TRI +0xEB 0x0E4B # THAI CHARACTER MAI CHATTAWA +0xEC 0x0E4C # THAI CHARACTER THANTHAKHAT +0xED 0x0E4D # THAI CHARACTER NIKHAHIT +0xEE 0x0E4E # THAI CHARACTER YAMAKKAN +0xEF 0x0E4F # THAI CHARACTER FONGMAN +0xF0 0x0E50 # THAI DIGIT ZERO +0xF1 0x0E51 # THAI DIGIT ONE +0xF2 0x0E52 # THAI DIGIT TWO +0xF3 0x0E53 # THAI DIGIT THREE +0xF4 0x0E54 # THAI DIGIT FOUR +0xF5 0x0E55 # THAI DIGIT FIVE +0xF6 0x0E56 # THAI DIGIT SIX +0xF7 0x0E57 # THAI DIGIT SEVEN +0xF8 0x0E58 # THAI DIGIT EIGHT +0xF9 0x0E59 # THAI DIGIT NINE +0xFA 0x0E5A # THAI CHARACTER ANGKHANKHU +0xFB 0x0E5B # THAI CHARACTER KHOMUT diff --git a/extra/io/encodings/8-bit/8859-13.TXT b/extra/io/encodings/8-bit/8859-13.TXT new file mode 100644 index 0000000000..cd11b53fd7 --- /dev/null +++ b/extra/io/encodings/8-bit/8859-13.TXT @@ -0,0 +1,299 @@ +# +# Name: ISO/IEC 8859-13:1998 to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 1999 July 27 +# Authors: Ken Whistler +# +# Copyright (c) 1998 - 1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-13:1998 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-13 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-13 order. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA1 0x201D # RIGHT DOUBLE QUOTATION MARK +0xA2 0x00A2 # CENT SIGN +0xA3 0x00A3 # POUND SIGN +0xA4 0x00A4 # CURRENCY SIGN +0xA5 0x201E # DOUBLE LOW-9 QUOTATION MARK +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 0x201C # LEFT DOUBLE QUOTATION MARK +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 (German) +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 0x2019 # RIGHT SINGLE QUOTATION MARK diff --git a/extra/io/encodings/8-bit/8859-14.TXT b/extra/io/encodings/8-bit/8859-14.TXT new file mode 100644 index 0000000000..73e98555ea --- /dev/null +++ b/extra/io/encodings/8-bit/8859-14.TXT @@ -0,0 +1,301 @@ +# +# Name: ISO/IEC 8859-14:1998 to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 1999 July 27 +# Authors: Markus Kuhn +# Ken Whistler +# +# Copyright (c) 1998 - 1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-14:1998 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-14 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-14 order. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA1 0x1E02 # LATIN CAPITAL LETTER B WITH DOT ABOVE +0xA2 0x1E03 # LATIN SMALL LETTER B WITH DOT ABOVE +0xA3 0x00A3 # POUND SIGN +0xA4 0x010A # LATIN CAPITAL LETTER C WITH DOT ABOVE +0xA5 0x010B # LATIN SMALL LETTER C WITH DOT ABOVE +0xA6 0x1E0A # LATIN CAPITAL LETTER D WITH DOT ABOVE +0xA7 0x00A7 # SECTION SIGN +0xA8 0x1E80 # LATIN CAPITAL LETTER W WITH GRAVE +0xA9 0x00A9 # COPYRIGHT SIGN +0xAA 0x1E82 # LATIN CAPITAL LETTER W WITH ACUTE +0xAB 0x1E0B # LATIN SMALL LETTER D WITH DOT ABOVE +0xAC 0x1EF2 # LATIN CAPITAL LETTER Y WITH GRAVE +0xAD 0x00AD # SOFT HYPHEN +0xAE 0x00AE # REGISTERED SIGN +0xAF 0x0178 # LATIN CAPITAL LETTER Y WITH DIAERESIS +0xB0 0x1E1E # LATIN CAPITAL LETTER F WITH DOT ABOVE +0xB1 0x1E1F # LATIN SMALL LETTER F WITH DOT ABOVE +0xB2 0x0120 # LATIN CAPITAL LETTER G WITH DOT ABOVE +0xB3 0x0121 # LATIN SMALL LETTER G WITH DOT ABOVE +0xB4 0x1E40 # LATIN CAPITAL LETTER M WITH DOT ABOVE +0xB5 0x1E41 # LATIN SMALL LETTER M WITH DOT ABOVE +0xB6 0x00B6 # PILCROW SIGN +0xB7 0x1E56 # LATIN CAPITAL LETTER P WITH DOT ABOVE +0xB8 0x1E81 # LATIN SMALL LETTER W WITH GRAVE +0xB9 0x1E57 # LATIN SMALL LETTER P WITH DOT ABOVE +0xBA 0x1E83 # LATIN SMALL LETTER W WITH ACUTE +0xBB 0x1E60 # LATIN CAPITAL LETTER S WITH DOT ABOVE +0xBC 0x1EF3 # LATIN SMALL LETTER Y WITH GRAVE +0xBD 0x1E84 # LATIN CAPITAL LETTER W WITH DIAERESIS +0xBE 0x1E85 # LATIN SMALL LETTER W WITH DIAERESIS +0xBF 0x1E61 # LATIN SMALL LETTER S WITH DOT ABOVE +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 0x0174 # LATIN CAPITAL LETTER W WITH CIRCUMFLEX +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 0x1E6A # LATIN CAPITAL LETTER T WITH DOT ABOVE +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 0x00DD # LATIN CAPITAL LETTER Y WITH ACUTE +0xDE 0x0176 # LATIN CAPITAL LETTER Y WITH CIRCUMFLEX +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 0x0175 # LATIN SMALL LETTER W WITH CIRCUMFLEX +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 0x1E6B # LATIN SMALL LETTER T WITH DOT ABOVE +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 0x00FD # LATIN SMALL LETTER Y WITH ACUTE +0xFE 0x0177 # LATIN SMALL LETTER Y WITH CIRCUMFLEX +0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS + diff --git a/extra/io/encodings/8-bit/8859-15.TXT b/extra/io/encodings/8-bit/8859-15.TXT new file mode 100644 index 0000000000..ab2f32fcea --- /dev/null +++ b/extra/io/encodings/8-bit/8859-15.TXT @@ -0,0 +1,303 @@ +# +# Name: ISO/IEC 8859-15:1999 to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 1999 July 27 +# Authors: Markus Kuhn +# Ken Whistler +# +# Copyright (c) 1998 - 1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-15:1999 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-15 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-15 order. +# +# Version history +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA1 0x00A1 # INVERTED EXCLAMATION MARK +0xA2 0x00A2 # CENT SIGN +0xA3 0x00A3 # POUND SIGN +0xA4 0x20AC # EURO SIGN +0xA5 0x00A5 # YEN SIGN +0xA6 0x0160 # LATIN CAPITAL LETTER S WITH CARON +0xA7 0x00A7 # SECTION SIGN +0xA8 0x0161 # LATIN SMALL LETTER S WITH CARON +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 0x017D # LATIN CAPITAL LETTER Z WITH CARON +0xB5 0x00B5 # MICRO SIGN +0xB6 0x00B6 # PILCROW SIGN +0xB7 0x00B7 # MIDDLE DOT +0xB8 0x017E # LATIN SMALL LETTER Z WITH CARON +0xB9 0x00B9 # SUPERSCRIPT ONE +0xBA 0x00BA # MASCULINE ORDINAL INDICATOR +0xBB 0x00BB # RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK +0xBC 0x0152 # LATIN CAPITAL LIGATURE OE +0xBD 0x0153 # LATIN SMALL LIGATURE OE +0xBE 0x0178 # LATIN CAPITAL LETTER Y WITH DIAERESIS +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 0x00D0 # LATIN CAPITAL LETTER ETH +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 0x00DD # LATIN CAPITAL LETTER Y WITH ACUTE +0xDE 0x00DE # LATIN CAPITAL LETTER THORN +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 0x00F0 # LATIN SMALL LETTER ETH +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 0x00FD # LATIN SMALL LETTER Y WITH ACUTE +0xFE 0x00FE # LATIN SMALL LETTER THORN +0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS + diff --git a/extra/io/encodings/8-bit/8859-16.TXT b/extra/io/encodings/8-bit/8859-16.TXT new file mode 100644 index 0000000000..c0dcf0dac6 --- /dev/null +++ b/extra/io/encodings/8-bit/8859-16.TXT @@ -0,0 +1,299 @@ +# +# Name: ISO/IEC 8859-16:2001 to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 2001 July 26 +# Authors: Markus Kuhn +# +# Copyright (c) 1999-2001 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-16:2001 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-16 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-16 order. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA1 0x0104 # LATIN CAPITAL LETTER A WITH OGONEK +0xA2 0x0105 # LATIN SMALL LETTER A WITH OGONEK +0xA3 0x0141 # LATIN CAPITAL LETTER L WITH STROKE +0xA4 0x20AC # EURO SIGN +0xA5 0x201E # DOUBLE LOW-9 QUOTATION MARK +0xA6 0x0160 # LATIN CAPITAL LETTER S WITH CARON +0xA7 0x00A7 # SECTION SIGN +0xA8 0x0161 # LATIN SMALL LETTER S WITH CARON +0xA9 0x00A9 # COPYRIGHT SIGN +0xAA 0x0218 # LATIN CAPITAL LETTER S WITH COMMA BELOW +0xAB 0x00AB # LEFT-POINTING DOUBLE ANGLE QUOTATION MARK +0xAC 0x0179 # LATIN CAPITAL LETTER Z WITH ACUTE +0xAD 0x00AD # SOFT HYPHEN +0xAE 0x017A # LATIN SMALL LETTER Z WITH ACUTE +0xAF 0x017B # LATIN CAPITAL LETTER Z WITH DOT ABOVE +0xB0 0x00B0 # DEGREE SIGN +0xB1 0x00B1 # PLUS-MINUS SIGN +0xB2 0x010C # LATIN CAPITAL LETTER C WITH CARON +0xB3 0x0142 # LATIN SMALL LETTER L WITH STROKE +0xB4 0x017D # LATIN CAPITAL LETTER Z WITH CARON +0xB5 0x201D # RIGHT DOUBLE QUOTATION MARK +0xB6 0x00B6 # PILCROW SIGN +0xB7 0x00B7 # MIDDLE DOT +0xB8 0x017E # LATIN SMALL LETTER Z WITH CARON +0xB9 0x010D # LATIN SMALL LETTER C WITH CARON +0xBA 0x0219 # LATIN SMALL LETTER S WITH COMMA BELOW +0xBB 0x00BB # RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK +0xBC 0x0152 # LATIN CAPITAL LIGATURE OE +0xBD 0x0153 # LATIN SMALL LIGATURE OE +0xBE 0x0178 # LATIN CAPITAL LETTER Y WITH DIAERESIS +0xBF 0x017C # LATIN SMALL LETTER Z WITH DOT ABOVE +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 0x0106 # LATIN CAPITAL LETTER C WITH ACUTE +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 0x0110 # LATIN CAPITAL LETTER D WITH STROKE +0xD1 0x0143 # LATIN CAPITAL LETTER N WITH ACUTE +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 0x0150 # LATIN CAPITAL LETTER O WITH DOUBLE ACUTE +0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS +0xD7 0x015A # LATIN CAPITAL LETTER S WITH ACUTE +0xD8 0x0170 # LATIN CAPITAL LETTER U WITH DOUBLE ACUTE +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 0x0118 # LATIN CAPITAL LETTER E WITH OGONEK +0xDE 0x021A # LATIN CAPITAL LETTER T WITH COMMA BELOW +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 0x0107 # LATIN SMALL LETTER C WITH ACUTE +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 0x0111 # LATIN SMALL LETTER D WITH STROKE +0xF1 0x0144 # LATIN SMALL LETTER N WITH ACUTE +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 0x0151 # LATIN SMALL LETTER O WITH DOUBLE ACUTE +0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS +0xF7 0x015B # LATIN SMALL LETTER S WITH ACUTE +0xF8 0x0171 # LATIN SMALL LETTER U WITH DOUBLE ACUTE +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 0x0119 # LATIN SMALL LETTER E WITH OGONEK +0xFE 0x021B # LATIN SMALL LETTER T WITH COMMA BELOW +0xFF 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS diff --git a/extra/io/encodings/8-bit/8859-2.TXT b/extra/io/encodings/8-bit/8859-2.TXT new file mode 100644 index 0000000000..e45df25eb8 --- /dev/null +++ b/extra/io/encodings/8-bit/8859-2.TXT @@ -0,0 +1,303 @@ +# +# Name: ISO 8859-2:1999 to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 1999 July 27 +# Authors: Ken Whistler +# +# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-2:1999 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-2 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-2 order. +# +# Version history +# 1.0 version updates 0.1 version by adding mappings for all +# control characters. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA1 0x0104 # LATIN CAPITAL LETTER A WITH OGONEK +0xA2 0x02D8 # BREVE +0xA3 0x0141 # LATIN CAPITAL LETTER L WITH STROKE +0xA4 0x00A4 # CURRENCY SIGN +0xA5 0x013D # LATIN CAPITAL LETTER L WITH CARON +0xA6 0x015A # LATIN CAPITAL LETTER S WITH ACUTE +0xA7 0x00A7 # SECTION SIGN +0xA8 0x00A8 # DIAERESIS +0xA9 0x0160 # LATIN CAPITAL LETTER S WITH CARON +0xAA 0x015E # LATIN CAPITAL LETTER S WITH CEDILLA +0xAB 0x0164 # LATIN CAPITAL LETTER T WITH CARON +0xAC 0x0179 # LATIN CAPITAL LETTER Z WITH ACUTE +0xAD 0x00AD # SOFT HYPHEN +0xAE 0x017D # LATIN CAPITAL LETTER Z WITH CARON +0xAF 0x017B # LATIN CAPITAL LETTER Z WITH DOT ABOVE +0xB0 0x00B0 # DEGREE SIGN +0xB1 0x0105 # LATIN SMALL LETTER A WITH OGONEK +0xB2 0x02DB # OGONEK +0xB3 0x0142 # LATIN SMALL LETTER L WITH STROKE +0xB4 0x00B4 # ACUTE ACCENT +0xB5 0x013E # LATIN SMALL LETTER L WITH CARON +0xB6 0x015B # LATIN SMALL LETTER S WITH ACUTE +0xB7 0x02C7 # CARON +0xB8 0x00B8 # CEDILLA +0xB9 0x0161 # LATIN SMALL LETTER S WITH CARON +0xBA 0x015F # LATIN SMALL LETTER S WITH CEDILLA +0xBB 0x0165 # LATIN SMALL LETTER T WITH CARON +0xBC 0x017A # LATIN SMALL LETTER Z WITH ACUTE +0xBD 0x02DD # DOUBLE ACUTE ACCENT +0xBE 0x017E # LATIN SMALL LETTER Z WITH CARON +0xBF 0x017C # LATIN SMALL LETTER Z WITH DOT ABOVE +0xC0 0x0154 # LATIN CAPITAL LETTER R WITH ACUTE +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 0x0139 # LATIN CAPITAL LETTER L WITH ACUTE +0xC6 0x0106 # LATIN CAPITAL LETTER C WITH ACUTE +0xC7 0x00C7 # LATIN CAPITAL LETTER C WITH CEDILLA +0xC8 0x010C # LATIN CAPITAL LETTER C WITH CARON +0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE +0xCA 0x0118 # LATIN CAPITAL LETTER E WITH OGONEK +0xCB 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS +0xCC 0x011A # LATIN CAPITAL LETTER E WITH CARON +0xCD 0x00CD # LATIN CAPITAL LETTER I WITH ACUTE +0xCE 0x00CE # LATIN CAPITAL LETTER I WITH CIRCUMFLEX +0xCF 0x010E # LATIN CAPITAL LETTER D WITH CARON +0xD0 0x0110 # LATIN CAPITAL LETTER D WITH STROKE +0xD1 0x0143 # LATIN CAPITAL LETTER N WITH ACUTE +0xD2 0x0147 # LATIN CAPITAL LETTER N WITH CARON +0xD3 0x00D3 # LATIN CAPITAL LETTER O WITH ACUTE +0xD4 0x00D4 # LATIN CAPITAL LETTER O WITH CIRCUMFLEX +0xD5 0x0150 # LATIN CAPITAL LETTER O WITH DOUBLE ACUTE +0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS +0xD7 0x00D7 # MULTIPLICATION SIGN +0xD8 0x0158 # LATIN CAPITAL LETTER R WITH CARON +0xD9 0x016E # LATIN CAPITAL LETTER U WITH RING ABOVE +0xDA 0x00DA # LATIN CAPITAL LETTER U WITH ACUTE +0xDB 0x0170 # LATIN CAPITAL LETTER U WITH DOUBLE ACUTE +0xDC 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS +0xDD 0x00DD # LATIN CAPITAL LETTER Y WITH ACUTE +0xDE 0x0162 # LATIN CAPITAL LETTER T WITH CEDILLA +0xDF 0x00DF # LATIN SMALL LETTER SHARP S +0xE0 0x0155 # LATIN SMALL LETTER R WITH ACUTE +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 0x013A # LATIN SMALL LETTER L WITH ACUTE +0xE6 0x0107 # LATIN SMALL LETTER C WITH ACUTE +0xE7 0x00E7 # LATIN SMALL LETTER C WITH CEDILLA +0xE8 0x010D # LATIN SMALL LETTER C WITH CARON +0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE +0xEA 0x0119 # LATIN SMALL LETTER E WITH OGONEK +0xEB 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS +0xEC 0x011B # LATIN SMALL LETTER E WITH CARON +0xED 0x00ED # LATIN SMALL LETTER I WITH ACUTE +0xEE 0x00EE # LATIN SMALL LETTER I WITH CIRCUMFLEX +0xEF 0x010F # LATIN SMALL LETTER D WITH CARON +0xF0 0x0111 # LATIN SMALL LETTER D WITH STROKE +0xF1 0x0144 # LATIN SMALL LETTER N WITH ACUTE +0xF2 0x0148 # LATIN SMALL LETTER N WITH CARON +0xF3 0x00F3 # LATIN SMALL LETTER O WITH ACUTE +0xF4 0x00F4 # LATIN SMALL LETTER O WITH CIRCUMFLEX +0xF5 0x0151 # LATIN SMALL LETTER O WITH DOUBLE ACUTE +0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS +0xF7 0x00F7 # DIVISION SIGN +0xF8 0x0159 # LATIN SMALL LETTER R WITH CARON +0xF9 0x016F # LATIN SMALL LETTER U WITH RING ABOVE +0xFA 0x00FA # LATIN SMALL LETTER U WITH ACUTE +0xFB 0x0171 # LATIN SMALL LETTER U WITH DOUBLE ACUTE +0xFC 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS +0xFD 0x00FD # LATIN SMALL LETTER Y WITH ACUTE +0xFE 0x0163 # LATIN SMALL LETTER T WITH CEDILLA +0xFF 0x02D9 # DOT ABOVE diff --git a/extra/io/encodings/8-bit/8859-3.TXT b/extra/io/encodings/8-bit/8859-3.TXT new file mode 100644 index 0000000000..9b6ac69dd8 --- /dev/null +++ b/extra/io/encodings/8-bit/8859-3.TXT @@ -0,0 +1,296 @@ +# +# Name: ISO/IEC 8859-3:1999 to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 1999 July 27 +# Authors: Ken Whistler +# +# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-3:1999 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-3 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-3 order. +# +# Version history +# 1.0 version updates 0.1 version by adding mappings for all +# control characters. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA1 0x0126 # LATIN CAPITAL LETTER H WITH STROKE +0xA2 0x02D8 # BREVE +0xA3 0x00A3 # POUND SIGN +0xA4 0x00A4 # CURRENCY SIGN +0xA6 0x0124 # LATIN CAPITAL LETTER H WITH CIRCUMFLEX +0xA7 0x00A7 # SECTION SIGN +0xA8 0x00A8 # DIAERESIS +0xA9 0x0130 # LATIN CAPITAL LETTER I WITH DOT ABOVE +0xAA 0x015E # LATIN CAPITAL LETTER S WITH CEDILLA +0xAB 0x011E # LATIN CAPITAL LETTER G WITH BREVE +0xAC 0x0134 # LATIN CAPITAL LETTER J WITH CIRCUMFLEX +0xAD 0x00AD # SOFT HYPHEN +0xAF 0x017B # LATIN CAPITAL LETTER Z WITH DOT ABOVE +0xB0 0x00B0 # DEGREE SIGN +0xB1 0x0127 # LATIN SMALL LETTER H WITH STROKE +0xB2 0x00B2 # SUPERSCRIPT TWO +0xB3 0x00B3 # SUPERSCRIPT THREE +0xB4 0x00B4 # ACUTE ACCENT +0xB5 0x00B5 # MICRO SIGN +0xB6 0x0125 # LATIN SMALL LETTER H WITH CIRCUMFLEX +0xB7 0x00B7 # MIDDLE DOT +0xB8 0x00B8 # CEDILLA +0xB9 0x0131 # LATIN SMALL LETTER DOTLESS I +0xBA 0x015F # LATIN SMALL LETTER S WITH CEDILLA +0xBB 0x011F # LATIN SMALL LETTER G WITH BREVE +0xBC 0x0135 # LATIN SMALL LETTER J WITH CIRCUMFLEX +0xBD 0x00BD # VULGAR FRACTION ONE HALF +0xBF 0x017C # LATIN SMALL LETTER Z WITH DOT ABOVE +0xC0 0x00C0 # LATIN CAPITAL LETTER A WITH GRAVE +0xC1 0x00C1 # LATIN CAPITAL LETTER A WITH ACUTE +0xC2 0x00C2 # LATIN CAPITAL LETTER A WITH CIRCUMFLEX +0xC4 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS +0xC5 0x010A # LATIN CAPITAL LETTER C WITH DOT ABOVE +0xC6 0x0108 # LATIN CAPITAL LETTER C WITH CIRCUMFLEX +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 +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 0x0120 # LATIN CAPITAL LETTER G WITH DOT ABOVE +0xD6 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS +0xD7 0x00D7 # MULTIPLICATION SIGN +0xD8 0x011C # LATIN CAPITAL LETTER G WITH CIRCUMFLEX +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 0x016C # LATIN CAPITAL LETTER U WITH BREVE +0xDE 0x015C # LATIN CAPITAL LETTER S WITH CIRCUMFLEX +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 +0xE4 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS +0xE5 0x010B # LATIN SMALL LETTER C WITH DOT ABOVE +0xE6 0x0109 # LATIN SMALL LETTER C WITH CIRCUMFLEX +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 +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 0x0121 # LATIN SMALL LETTER G WITH DOT ABOVE +0xF6 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS +0xF7 0x00F7 # DIVISION SIGN +0xF8 0x011D # LATIN SMALL LETTER G WITH CIRCUMFLEX +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 0x016D # LATIN SMALL LETTER U WITH BREVE +0xFE 0x015D # LATIN SMALL LETTER S WITH CIRCUMFLEX +0xFF 0x02D9 # DOT ABOVE diff --git a/extra/io/encodings/8-bit/8859-4.TXT b/extra/io/encodings/8-bit/8859-4.TXT new file mode 100644 index 0000000000..662e698ab2 --- /dev/null +++ b/extra/io/encodings/8-bit/8859-4.TXT @@ -0,0 +1,303 @@ +# +# Name: ISO/IEC 8859-4:1998 to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 1999 July 27 +# Authors: Ken Whistler +# +# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-4:1998 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-4 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-4 order. +# +# Version history +# 1.0 version updates 0.1 version by adding mappings for all +# control characters. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA1 0x0104 # LATIN CAPITAL LETTER A WITH OGONEK +0xA2 0x0138 # LATIN SMALL LETTER KRA +0xA3 0x0156 # LATIN CAPITAL LETTER R WITH CEDILLA +0xA4 0x00A4 # CURRENCY SIGN +0xA5 0x0128 # LATIN CAPITAL LETTER I WITH TILDE +0xA6 0x013B # LATIN CAPITAL LETTER L WITH CEDILLA +0xA7 0x00A7 # SECTION SIGN +0xA8 0x00A8 # DIAERESIS +0xA9 0x0160 # LATIN CAPITAL LETTER S WITH CARON +0xAA 0x0112 # LATIN CAPITAL LETTER E WITH MACRON +0xAB 0x0122 # LATIN CAPITAL LETTER G WITH CEDILLA +0xAC 0x0166 # LATIN CAPITAL LETTER T WITH STROKE +0xAD 0x00AD # SOFT HYPHEN +0xAE 0x017D # LATIN CAPITAL LETTER Z WITH CARON +0xAF 0x00AF # MACRON +0xB0 0x00B0 # DEGREE SIGN +0xB1 0x0105 # LATIN SMALL LETTER A WITH OGONEK +0xB2 0x02DB # OGONEK +0xB3 0x0157 # LATIN SMALL LETTER R WITH CEDILLA +0xB4 0x00B4 # ACUTE ACCENT +0xB5 0x0129 # LATIN SMALL LETTER I WITH TILDE +0xB6 0x013C # LATIN SMALL LETTER L WITH CEDILLA +0xB7 0x02C7 # CARON +0xB8 0x00B8 # CEDILLA +0xB9 0x0161 # LATIN SMALL LETTER S WITH CARON +0xBA 0x0113 # LATIN SMALL LETTER E WITH MACRON +0xBB 0x0123 # LATIN SMALL LETTER G WITH CEDILLA +0xBC 0x0167 # LATIN SMALL LETTER T WITH STROKE +0xBD 0x014A # LATIN CAPITAL LETTER ENG +0xBE 0x017E # LATIN SMALL LETTER Z WITH CARON +0xBF 0x014B # LATIN SMALL LETTER ENG +0xC0 0x0100 # LATIN CAPITAL LETTER A WITH MACRON +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 0x012E # LATIN CAPITAL LETTER I WITH OGONEK +0xC8 0x010C # LATIN CAPITAL LETTER C WITH CARON +0xC9 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE +0xCA 0x0118 # LATIN CAPITAL LETTER E WITH OGONEK +0xCB 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS +0xCC 0x0116 # LATIN CAPITAL LETTER E WITH DOT ABOVE +0xCD 0x00CD # LATIN CAPITAL LETTER I WITH ACUTE +0xCE 0x00CE # LATIN CAPITAL LETTER I WITH CIRCUMFLEX +0xCF 0x012A # LATIN CAPITAL LETTER I WITH MACRON +0xD0 0x0110 # LATIN CAPITAL LETTER D WITH STROKE +0xD1 0x0145 # LATIN CAPITAL LETTER N WITH CEDILLA +0xD2 0x014C # LATIN CAPITAL LETTER O WITH MACRON +0xD3 0x0136 # LATIN CAPITAL LETTER K WITH CEDILLA +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 0x0172 # LATIN CAPITAL LETTER U WITH OGONEK +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 0x0168 # LATIN CAPITAL LETTER U WITH TILDE +0xDE 0x016A # LATIN CAPITAL LETTER U WITH MACRON +0xDF 0x00DF # LATIN SMALL LETTER SHARP S +0xE0 0x0101 # LATIN SMALL LETTER A WITH MACRON +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 0x012F # LATIN SMALL LETTER I WITH OGONEK +0xE8 0x010D # LATIN SMALL LETTER C WITH CARON +0xE9 0x00E9 # LATIN SMALL LETTER E WITH ACUTE +0xEA 0x0119 # LATIN SMALL LETTER E WITH OGONEK +0xEB 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS +0xEC 0x0117 # LATIN SMALL LETTER E WITH DOT ABOVE +0xED 0x00ED # LATIN SMALL LETTER I WITH ACUTE +0xEE 0x00EE # LATIN SMALL LETTER I WITH CIRCUMFLEX +0xEF 0x012B # LATIN SMALL LETTER I WITH MACRON +0xF0 0x0111 # LATIN SMALL LETTER D WITH STROKE +0xF1 0x0146 # LATIN SMALL LETTER N WITH CEDILLA +0xF2 0x014D # LATIN SMALL LETTER O WITH MACRON +0xF3 0x0137 # LATIN SMALL LETTER K WITH CEDILLA +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 0x0173 # LATIN SMALL LETTER U WITH OGONEK +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 0x0169 # LATIN SMALL LETTER U WITH TILDE +0xFE 0x016B # LATIN SMALL LETTER U WITH MACRON +0xFF 0x02D9 # DOT ABOVE diff --git a/extra/io/encodings/8-bit/8859-5.TXT b/extra/io/encodings/8-bit/8859-5.TXT new file mode 100644 index 0000000000..a7ed1ce2ab --- /dev/null +++ b/extra/io/encodings/8-bit/8859-5.TXT @@ -0,0 +1,303 @@ +# +# Name: ISO 8859-5:1999 to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 1999 July 27 +# Authors: Ken Whistler +# +# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-5:1999 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-5 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-5 order. +# +# Version history +# 1.0 version updates 0.1 version by adding mappings for all +# control characters. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA1 0x0401 # CYRILLIC CAPITAL LETTER IO +0xA2 0x0402 # CYRILLIC CAPITAL LETTER DJE +0xA3 0x0403 # CYRILLIC CAPITAL LETTER GJE +0xA4 0x0404 # CYRILLIC CAPITAL LETTER UKRAINIAN IE +0xA5 0x0405 # CYRILLIC CAPITAL LETTER DZE +0xA6 0x0406 # CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I +0xA7 0x0407 # CYRILLIC CAPITAL LETTER YI +0xA8 0x0408 # CYRILLIC CAPITAL LETTER JE +0xA9 0x0409 # CYRILLIC CAPITAL LETTER LJE +0xAA 0x040A # CYRILLIC CAPITAL LETTER NJE +0xAB 0x040B # CYRILLIC CAPITAL LETTER TSHE +0xAC 0x040C # CYRILLIC CAPITAL LETTER KJE +0xAD 0x00AD # SOFT HYPHEN +0xAE 0x040E # CYRILLIC CAPITAL LETTER SHORT U +0xAF 0x040F # CYRILLIC CAPITAL LETTER DZHE +0xB0 0x0410 # CYRILLIC CAPITAL LETTER A +0xB1 0x0411 # CYRILLIC CAPITAL LETTER BE +0xB2 0x0412 # CYRILLIC CAPITAL LETTER VE +0xB3 0x0413 # CYRILLIC CAPITAL LETTER GHE +0xB4 0x0414 # CYRILLIC CAPITAL LETTER DE +0xB5 0x0415 # CYRILLIC CAPITAL LETTER IE +0xB6 0x0416 # CYRILLIC CAPITAL LETTER ZHE +0xB7 0x0417 # CYRILLIC CAPITAL LETTER ZE +0xB8 0x0418 # CYRILLIC CAPITAL LETTER I +0xB9 0x0419 # CYRILLIC CAPITAL LETTER SHORT I +0xBA 0x041A # CYRILLIC CAPITAL LETTER KA +0xBB 0x041B # CYRILLIC CAPITAL LETTER EL +0xBC 0x041C # CYRILLIC CAPITAL LETTER EM +0xBD 0x041D # CYRILLIC CAPITAL LETTER EN +0xBE 0x041E # CYRILLIC CAPITAL LETTER O +0xBF 0x041F # CYRILLIC CAPITAL LETTER PE +0xC0 0x0420 # CYRILLIC CAPITAL LETTER ER +0xC1 0x0421 # CYRILLIC CAPITAL LETTER ES +0xC2 0x0422 # CYRILLIC CAPITAL LETTER TE +0xC3 0x0423 # CYRILLIC CAPITAL LETTER U +0xC4 0x0424 # CYRILLIC CAPITAL LETTER EF +0xC5 0x0425 # CYRILLIC CAPITAL LETTER HA +0xC6 0x0426 # CYRILLIC CAPITAL LETTER TSE +0xC7 0x0427 # CYRILLIC CAPITAL LETTER CHE +0xC8 0x0428 # CYRILLIC CAPITAL LETTER SHA +0xC9 0x0429 # CYRILLIC CAPITAL LETTER SHCHA +0xCA 0x042A # CYRILLIC CAPITAL LETTER HARD SIGN +0xCB 0x042B # CYRILLIC CAPITAL LETTER YERU +0xCC 0x042C # CYRILLIC CAPITAL LETTER SOFT SIGN +0xCD 0x042D # CYRILLIC CAPITAL LETTER E +0xCE 0x042E # CYRILLIC CAPITAL LETTER YU +0xCF 0x042F # CYRILLIC CAPITAL LETTER YA +0xD0 0x0430 # CYRILLIC SMALL LETTER A +0xD1 0x0431 # CYRILLIC SMALL LETTER BE +0xD2 0x0432 # CYRILLIC SMALL LETTER VE +0xD3 0x0433 # CYRILLIC SMALL LETTER GHE +0xD4 0x0434 # CYRILLIC SMALL LETTER DE +0xD5 0x0435 # CYRILLIC SMALL LETTER IE +0xD6 0x0436 # CYRILLIC SMALL LETTER ZHE +0xD7 0x0437 # CYRILLIC SMALL LETTER ZE +0xD8 0x0438 # CYRILLIC SMALL LETTER I +0xD9 0x0439 # CYRILLIC SMALL LETTER SHORT I +0xDA 0x043A # CYRILLIC SMALL LETTER KA +0xDB 0x043B # CYRILLIC SMALL LETTER EL +0xDC 0x043C # CYRILLIC SMALL LETTER EM +0xDD 0x043D # CYRILLIC SMALL LETTER EN +0xDE 0x043E # CYRILLIC SMALL LETTER O +0xDF 0x043F # CYRILLIC SMALL LETTER PE +0xE0 0x0440 # CYRILLIC SMALL LETTER ER +0xE1 0x0441 # CYRILLIC SMALL LETTER ES +0xE2 0x0442 # CYRILLIC SMALL LETTER TE +0xE3 0x0443 # CYRILLIC SMALL LETTER U +0xE4 0x0444 # CYRILLIC SMALL LETTER EF +0xE5 0x0445 # CYRILLIC SMALL LETTER HA +0xE6 0x0446 # CYRILLIC SMALL LETTER TSE +0xE7 0x0447 # CYRILLIC SMALL LETTER CHE +0xE8 0x0448 # CYRILLIC SMALL LETTER SHA +0xE9 0x0449 # CYRILLIC SMALL LETTER SHCHA +0xEA 0x044A # CYRILLIC SMALL LETTER HARD SIGN +0xEB 0x044B # CYRILLIC SMALL LETTER YERU +0xEC 0x044C # CYRILLIC SMALL LETTER SOFT SIGN +0xED 0x044D # CYRILLIC SMALL LETTER E +0xEE 0x044E # CYRILLIC SMALL LETTER YU +0xEF 0x044F # CYRILLIC SMALL LETTER YA +0xF0 0x2116 # NUMERO SIGN +0xF1 0x0451 # CYRILLIC SMALL LETTER IO +0xF2 0x0452 # CYRILLIC SMALL LETTER DJE +0xF3 0x0453 # CYRILLIC SMALL LETTER GJE +0xF4 0x0454 # CYRILLIC SMALL LETTER UKRAINIAN IE +0xF5 0x0455 # CYRILLIC SMALL LETTER DZE +0xF6 0x0456 # CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I +0xF7 0x0457 # CYRILLIC SMALL LETTER YI +0xF8 0x0458 # CYRILLIC SMALL LETTER JE +0xF9 0x0459 # CYRILLIC SMALL LETTER LJE +0xFA 0x045A # CYRILLIC SMALL LETTER NJE +0xFB 0x045B # CYRILLIC SMALL LETTER TSHE +0xFC 0x045C # CYRILLIC SMALL LETTER KJE +0xFD 0x00A7 # SECTION SIGN +0xFE 0x045E # CYRILLIC SMALL LETTER SHORT U +0xFF 0x045F # CYRILLIC SMALL LETTER DZHE diff --git a/extra/io/encodings/8-bit/8859-6.TXT b/extra/io/encodings/8-bit/8859-6.TXT new file mode 100644 index 0000000000..69ac7f5894 --- /dev/null +++ b/extra/io/encodings/8-bit/8859-6.TXT @@ -0,0 +1,260 @@ +# +# Name: ISO 8859-6:1999 to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 1999 July 27 +# Authors: Ken Whistler +# +# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-6:1999 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-6 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-6 order. +# +# Version history +# 1.0 version updates 0.1 version by adding mappings for all +# control characters. +# 0x30..0x39 remapped to the ASCII digits (U+0030..U+0039) instead +# of the Arabic digits (U+0660..U+0669). +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA4 0x00A4 # CURRENCY SIGN +0xAC 0x060C # ARABIC COMMA +0xAD 0x00AD # SOFT HYPHEN +0xBB 0x061B # ARABIC SEMICOLON +0xBF 0x061F # ARABIC QUESTION MARK +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 0x0637 # ARABIC LETTER TAH +0xD8 0x0638 # ARABIC LETTER ZAH +0xD9 0x0639 # ARABIC LETTER AIN +0xDA 0x063A # ARABIC LETTER GHAIN +0xE0 0x0640 # ARABIC TATWEEL +0xE1 0x0641 # ARABIC LETTER FEH +0xE2 0x0642 # ARABIC LETTER QAF +0xE3 0x0643 # ARABIC LETTER KAF +0xE4 0x0644 # ARABIC LETTER LAM +0xE5 0x0645 # ARABIC LETTER MEEM +0xE6 0x0646 # ARABIC LETTER NOON +0xE7 0x0647 # ARABIC LETTER HEH +0xE8 0x0648 # ARABIC LETTER WAW +0xE9 0x0649 # ARABIC LETTER ALEF MAKSURA +0xEA 0x064A # ARABIC LETTER YEH +0xEB 0x064B # ARABIC FATHATAN +0xEC 0x064C # ARABIC DAMMATAN +0xED 0x064D # ARABIC KASRATAN +0xEE 0x064E # ARABIC FATHA +0xEF 0x064F # ARABIC DAMMA +0xF0 0x0650 # ARABIC KASRA +0xF1 0x0651 # ARABIC SHADDA +0xF2 0x0652 # ARABIC SUKUN diff --git a/extra/io/encodings/8-bit/8859-7.TXT b/extra/io/encodings/8-bit/8859-7.TXT new file mode 100644 index 0000000000..bc46b74719 --- /dev/null +++ b/extra/io/encodings/8-bit/8859-7.TXT @@ -0,0 +1,308 @@ +# +# Name: ISO 8859-7:2003 to Unicode +# Unicode version: 4.0 +# Table version: 2.0 +# Table format: Format A +# Date: 2003-Nov-12 +# Authors: Ken Whistler +# +# Copyright (c) 1991-2003 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO 8859-7:2003 characters map into Unicode. +# +# ISO 8859-7:1987 is equivalent to ISO-IR-126, ELOT 928, +# and ECMA 118. ISO 8859-7:2003 adds two currency signs +# and one other character not in the earlier standard. +# +# Format: Three tab-separated columns +# Column #1 is the ISO 8859-7 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO 8859-7 order. +# +# Version history +# 1.0 version updates 0.1 version by adding mappings for all +# control characters. +# Remap 0xA1 to U+2018 (instead of 0x02BD) to match text of 8859-7 +# Remap 0xA2 to U+2019 (instead of 0x02BC) to match text of 8859-7 +# +# 2.0 version updates 1.0 version by adding mappings for the +# three newly added characters 0xA4, 0xA5, 0xAA. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact the Unicode Consortium at: +# +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +0xA1 0x2018 # LEFT SINGLE QUOTATION MARK +0xA2 0x2019 # RIGHT SINGLE QUOTATION MARK +0xA3 0x00A3 # POUND SIGN +0xA4 0x20AC # EURO SIGN +0xA5 0x20AF # DRACHMA SIGN +0xA6 0x00A6 # BROKEN BAR +0xA7 0x00A7 # SECTION SIGN +0xA8 0x00A8 # DIAERESIS +0xA9 0x00A9 # COPYRIGHT SIGN +0xAA 0x037A # GREEK YPOGEGRAMMENI +0xAB 0x00AB # LEFT-POINTING DOUBLE ANGLE QUOTATION MARK +0xAC 0x00AC # NOT SIGN +0xAD 0x00AD # SOFT HYPHEN +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 0x0385 # GREEK DIALYTIKA TONOS +0xB6 0x0386 # GREEK CAPITAL LETTER ALPHA WITH TONOS +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 +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 diff --git a/extra/io/encodings/8-bit/8859-8.TXT b/extra/io/encodings/8-bit/8859-8.TXT new file mode 100644 index 0000000000..bc8da4c7fd --- /dev/null +++ b/extra/io/encodings/8-bit/8859-8.TXT @@ -0,0 +1,270 @@ +# +# Name: ISO/IEC 8859-8:1999 to Unicode +# Unicode version: 3.0 +# Table version: 1.1 +# Table format: Format A +# Date: 2000-Jan-03 +# Authors: Ken Whistler +# +# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-8:1999 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-8 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-8 order. +# +# Version history +# 1.0 version updates 0.1 version by adding mappings for all +# control characters. +# 1.1 version updates to the published 8859-8:1999, correcting +# the mapping of 0xAF and adding mappings for LRM and RLM. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +0xA0 0x00A0 # NO-BREAK SPACE +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 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 +0xDF 0x2017 # DOUBLE LOW LINE +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 +0xFD 0x200E # LEFT-TO-RIGHT MARK +0xFE 0x200F # RIGHT-TO-LEFT MARK + diff --git a/extra/io/encodings/8-bit/8859-9.TXT b/extra/io/encodings/8-bit/8859-9.TXT new file mode 100644 index 0000000000..22901f1077 --- /dev/null +++ b/extra/io/encodings/8-bit/8859-9.TXT @@ -0,0 +1,307 @@ +# +# Name: ISO/IEC 8859-9:1999 to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 1999 July 27 +# Authors: Ken Whistler +# +# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on magnetic media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ISO/IEC 8859-9:1999 characters map into Unicode. +# +# Format: Three tab-separated columns +# Column #1 is the ISO/IEC 8859-9 code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ISO/IEC 8859-9 order. +# +# ISO/IEC 8859-9 is also equivalent to ISO-IR-148. +# +# Version history +# 1.0 version updates 0.1 version by adding mappings for all +# control characters. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x0080 # +0x81 0x0081 # +0x82 0x0082 # +0x83 0x0083 # +0x84 0x0084 # +0x85 0x0085 # +0x86 0x0086 # +0x87 0x0087 # +0x88 0x0088 # +0x89 0x0089 # +0x8A 0x008A # +0x8B 0x008B # +0x8C 0x008C # +0x8D 0x008D # +0x8E 0x008E # +0x8F 0x008F # +0x90 0x0090 # +0x91 0x0091 # +0x92 0x0092 # +0x93 0x0093 # +0x94 0x0094 # +0x95 0x0095 # +0x96 0x0096 # +0x97 0x0097 # +0x98 0x0098 # +0x99 0x0099 # +0x9A 0x009A # +0x9B 0x009B # +0x9C 0x009C # +0x9D 0x009D # +0x9E 0x009E # +0x9F 0x009F # +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 + + diff --git a/extra/io/encodings/8-bit/CP037.TXT b/extra/io/encodings/8-bit/CP037.TXT new file mode 100644 index 0000000000..48fde2ae69 --- /dev/null +++ b/extra/io/encodings/8-bit/CP037.TXT @@ -0,0 +1,275 @@ +# +# Name: cp037_IBMUSCanada to Unicode table +# Unicode version: 2.0 +# Table version: 2.00 +# Table format: Format A +# Date: 04/24/96 +# Contact: Shawn.Steele@microsoft.com +# +# General notes: none +# +# Format: Three tab-separated columns +# Column #1 is the cp037_IBMUSCanada 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 cp037_IBMUSCanada order +# +0x00 0x0000 #NULL +0x01 0x0001 #START OF HEADING +0x02 0x0002 #START OF TEXT +0x03 0x0003 #END OF TEXT +0x04 0x009C #CONTROL +0x05 0x0009 #HORIZONTAL TABULATION +0x06 0x0086 #CONTROL +0x07 0x007F #DELETE +0x08 0x0097 #CONTROL +0x09 0x008D #CONTROL +0x0A 0x008E #CONTROL +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 0x009D #CONTROL +0x15 0x0085 #CONTROL +0x16 0x0008 #BACKSPACE +0x17 0x0087 #CONTROL +0x18 0x0018 #CANCEL +0x19 0x0019 #END OF MEDIUM +0x1A 0x0092 #CONTROL +0x1B 0x008F #CONTROL +0x1C 0x001C #FILE SEPARATOR +0x1D 0x001D #GROUP SEPARATOR +0x1E 0x001E #RECORD SEPARATOR +0x1F 0x001F #UNIT SEPARATOR +0x20 0x0080 #CONTROL +0x21 0x0081 #CONTROL +0x22 0x0082 #CONTROL +0x23 0x0083 #CONTROL +0x24 0x0084 #CONTROL +0x25 0x000A #LINE FEED +0x26 0x0017 #END OF TRANSMISSION BLOCK +0x27 0x001B #ESCAPE +0x28 0x0088 #CONTROL +0x29 0x0089 #CONTROL +0x2A 0x008A #CONTROL +0x2B 0x008B #CONTROL +0x2C 0x008C #CONTROL +0x2D 0x0005 #ENQUIRY +0x2E 0x0006 #ACKNOWLEDGE +0x2F 0x0007 #BELL +0x30 0x0090 #CONTROL +0x31 0x0091 #CONTROL +0x32 0x0016 #SYNCHRONOUS IDLE +0x33 0x0093 #CONTROL +0x34 0x0094 #CONTROL +0x35 0x0095 #CONTROL +0x36 0x0096 #CONTROL +0x37 0x0004 #END OF TRANSMISSION +0x38 0x0098 #CONTROL +0x39 0x0099 #CONTROL +0x3A 0x009A #CONTROL +0x3B 0x009B #CONTROL +0x3C 0x0014 #DEVICE CONTROL FOUR +0x3D 0x0015 #NEGATIVE ACKNOWLEDGE +0x3E 0x009E #CONTROL +0x3F 0x001A #SUBSTITUTE +0x40 0x0020 #SPACE +0x41 0x00A0 #NO-BREAK SPACE +0x42 0x00E2 #LATIN SMALL LETTER A WITH CIRCUMFLEX +0x43 0x00E4 #LATIN SMALL LETTER A WITH DIAERESIS +0x44 0x00E0 #LATIN SMALL LETTER A WITH GRAVE +0x45 0x00E1 #LATIN SMALL LETTER A WITH ACUTE +0x46 0x00E3 #LATIN SMALL LETTER A WITH TILDE +0x47 0x00E5 #LATIN SMALL LETTER A WITH RING ABOVE +0x48 0x00E7 #LATIN SMALL LETTER C WITH CEDILLA +0x49 0x00F1 #LATIN SMALL LETTER N WITH TILDE +0x4A 0x00A2 #CENT SIGN +0x4B 0x002E #FULL STOP +0x4C 0x003C #LESS-THAN SIGN +0x4D 0x0028 #LEFT PARENTHESIS +0x4E 0x002B #PLUS SIGN +0x4F 0x007C #VERTICAL LINE +0x50 0x0026 #AMPERSAND +0x51 0x00E9 #LATIN SMALL LETTER E WITH ACUTE +0x52 0x00EA #LATIN SMALL LETTER E WITH CIRCUMFLEX +0x53 0x00EB #LATIN SMALL LETTER E WITH DIAERESIS +0x54 0x00E8 #LATIN SMALL LETTER E WITH GRAVE +0x55 0x00ED #LATIN SMALL LETTER I WITH ACUTE +0x56 0x00EE #LATIN SMALL LETTER I WITH CIRCUMFLEX +0x57 0x00EF #LATIN SMALL LETTER I WITH DIAERESIS +0x58 0x00EC #LATIN SMALL LETTER I WITH GRAVE +0x59 0x00DF #LATIN SMALL LETTER SHARP S (GERMAN) +0x5A 0x0021 #EXCLAMATION MARK +0x5B 0x0024 #DOLLAR SIGN +0x5C 0x002A #ASTERISK +0x5D 0x0029 #RIGHT PARENTHESIS +0x5E 0x003B #SEMICOLON +0x5F 0x00AC #NOT SIGN +0x60 0x002D #HYPHEN-MINUS +0x61 0x002F #SOLIDUS +0x62 0x00C2 #LATIN CAPITAL LETTER A WITH CIRCUMFLEX +0x63 0x00C4 #LATIN CAPITAL LETTER A WITH DIAERESIS +0x64 0x00C0 #LATIN CAPITAL LETTER A WITH GRAVE +0x65 0x00C1 #LATIN CAPITAL LETTER A WITH ACUTE +0x66 0x00C3 #LATIN CAPITAL LETTER A WITH TILDE +0x67 0x00C5 #LATIN CAPITAL LETTER A WITH RING ABOVE +0x68 0x00C7 #LATIN CAPITAL LETTER C WITH CEDILLA +0x69 0x00D1 #LATIN CAPITAL LETTER N WITH TILDE +0x6A 0x00A6 #BROKEN BAR +0x6B 0x002C #COMMA +0x6C 0x0025 #PERCENT SIGN +0x6D 0x005F #LOW LINE +0x6E 0x003E #GREATER-THAN SIGN +0x6F 0x003F #QUESTION MARK +0x70 0x00F8 #LATIN SMALL LETTER O WITH STROKE +0x71 0x00C9 #LATIN CAPITAL LETTER E WITH ACUTE +0x72 0x00CA #LATIN CAPITAL LETTER E WITH CIRCUMFLEX +0x73 0x00CB #LATIN CAPITAL LETTER E WITH DIAERESIS +0x74 0x00C8 #LATIN CAPITAL LETTER E WITH GRAVE +0x75 0x00CD #LATIN CAPITAL LETTER I WITH ACUTE +0x76 0x00CE #LATIN CAPITAL LETTER I WITH CIRCUMFLEX +0x77 0x00CF #LATIN CAPITAL LETTER I WITH DIAERESIS +0x78 0x00CC #LATIN CAPITAL LETTER I WITH GRAVE +0x79 0x0060 #GRAVE ACCENT +0x7A 0x003A #COLON +0x7B 0x0023 #NUMBER SIGN +0x7C 0x0040 #COMMERCIAL AT +0x7D 0x0027 #APOSTROPHE +0x7E 0x003D #EQUALS SIGN +0x7F 0x0022 #QUOTATION MARK +0x80 0x00D8 #LATIN CAPITAL LETTER O WITH STROKE +0x81 0x0061 #LATIN SMALL LETTER A +0x82 0x0062 #LATIN SMALL LETTER B +0x83 0x0063 #LATIN SMALL LETTER C +0x84 0x0064 #LATIN SMALL LETTER D +0x85 0x0065 #LATIN SMALL LETTER E +0x86 0x0066 #LATIN SMALL LETTER F +0x87 0x0067 #LATIN SMALL LETTER G +0x88 0x0068 #LATIN SMALL LETTER H +0x89 0x0069 #LATIN SMALL LETTER I +0x8A 0x00AB #LEFT-POINTING DOUBLE ANGLE QUOTATION MARK +0x8B 0x00BB #RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK +0x8C 0x00F0 #LATIN SMALL LETTER ETH (ICELANDIC) +0x8D 0x00FD #LATIN SMALL LETTER Y WITH ACUTE +0x8E 0x00FE #LATIN SMALL LETTER THORN (ICELANDIC) +0x8F 0x00B1 #PLUS-MINUS SIGN +0x90 0x00B0 #DEGREE SIGN +0x91 0x006A #LATIN SMALL LETTER J +0x92 0x006B #LATIN SMALL LETTER K +0x93 0x006C #LATIN SMALL LETTER L +0x94 0x006D #LATIN SMALL LETTER M +0x95 0x006E #LATIN SMALL LETTER N +0x96 0x006F #LATIN SMALL LETTER O +0x97 0x0070 #LATIN SMALL LETTER P +0x98 0x0071 #LATIN SMALL LETTER Q +0x99 0x0072 #LATIN SMALL LETTER R +0x9A 0x00AA #FEMININE ORDINAL INDICATOR +0x9B 0x00BA #MASCULINE ORDINAL INDICATOR +0x9C 0x00E6 #LATIN SMALL LIGATURE AE +0x9D 0x00B8 #CEDILLA +0x9E 0x00C6 #LATIN CAPITAL LIGATURE AE +0x9F 0x00A4 #CURRENCY SIGN +0xA0 0x00B5 #MICRO SIGN +0xA1 0x007E #TILDE +0xA2 0x0073 #LATIN SMALL LETTER S +0xA3 0x0074 #LATIN SMALL LETTER T +0xA4 0x0075 #LATIN SMALL LETTER U +0xA5 0x0076 #LATIN SMALL LETTER V +0xA6 0x0077 #LATIN SMALL LETTER W +0xA7 0x0078 #LATIN SMALL LETTER X +0xA8 0x0079 #LATIN SMALL LETTER Y +0xA9 0x007A #LATIN SMALL LETTER Z +0xAA 0x00A1 #INVERTED EXCLAMATION MARK +0xAB 0x00BF #INVERTED QUESTION MARK +0xAC 0x00D0 #LATIN CAPITAL LETTER ETH (ICELANDIC) +0xAD 0x00DD #LATIN CAPITAL LETTER Y WITH ACUTE +0xAE 0x00DE #LATIN CAPITAL LETTER THORN (ICELANDIC) +0xAF 0x00AE #REGISTERED SIGN +0xB0 0x005E #CIRCUMFLEX ACCENT +0xB1 0x00A3 #POUND SIGN +0xB2 0x00A5 #YEN SIGN +0xB3 0x00B7 #MIDDLE DOT +0xB4 0x00A9 #COPYRIGHT SIGN +0xB5 0x00A7 #SECTION SIGN +0xB6 0x00B6 #PILCROW SIGN +0xB7 0x00BC #VULGAR FRACTION ONE QUARTER +0xB8 0x00BD #VULGAR FRACTION ONE HALF +0xB9 0x00BE #VULGAR FRACTION THREE QUARTERS +0xBA 0x005B #LEFT SQUARE BRACKET +0xBB 0x005D #RIGHT SQUARE BRACKET +0xBC 0x00AF #MACRON +0xBD 0x00A8 #DIAERESIS +0xBE 0x00B4 #ACUTE ACCENT +0xBF 0x00D7 #MULTIPLICATION SIGN +0xC0 0x007B #LEFT CURLY BRACKET +0xC1 0x0041 #LATIN CAPITAL LETTER A +0xC2 0x0042 #LATIN CAPITAL LETTER B +0xC3 0x0043 #LATIN CAPITAL LETTER C +0xC4 0x0044 #LATIN CAPITAL LETTER D +0xC5 0x0045 #LATIN CAPITAL LETTER E +0xC6 0x0046 #LATIN CAPITAL LETTER F +0xC7 0x0047 #LATIN CAPITAL LETTER G +0xC8 0x0048 #LATIN CAPITAL LETTER H +0xC9 0x0049 #LATIN CAPITAL LETTER I +0xCA 0x00AD #SOFT HYPHEN +0xCB 0x00F4 #LATIN SMALL LETTER O WITH CIRCUMFLEX +0xCC 0x00F6 #LATIN SMALL LETTER O WITH DIAERESIS +0xCD 0x00F2 #LATIN SMALL LETTER O WITH GRAVE +0xCE 0x00F3 #LATIN SMALL LETTER O WITH ACUTE +0xCF 0x00F5 #LATIN SMALL LETTER O WITH TILDE +0xD0 0x007D #RIGHT CURLY BRACKET +0xD1 0x004A #LATIN CAPITAL LETTER J +0xD2 0x004B #LATIN CAPITAL LETTER K +0xD3 0x004C #LATIN CAPITAL LETTER L +0xD4 0x004D #LATIN CAPITAL LETTER M +0xD5 0x004E #LATIN CAPITAL LETTER N +0xD6 0x004F #LATIN CAPITAL LETTER O +0xD7 0x0050 #LATIN CAPITAL LETTER P +0xD8 0x0051 #LATIN CAPITAL LETTER Q +0xD9 0x0052 #LATIN CAPITAL LETTER R +0xDA 0x00B9 #SUPERSCRIPT ONE +0xDB 0x00FB #LATIN SMALL LETTER U WITH CIRCUMFLEX +0xDC 0x00FC #LATIN SMALL LETTER U WITH DIAERESIS +0xDD 0x00F9 #LATIN SMALL LETTER U WITH GRAVE +0xDE 0x00FA #LATIN SMALL LETTER U WITH ACUTE +0xDF 0x00FF #LATIN SMALL LETTER Y WITH DIAERESIS +0xE0 0x005C #REVERSE SOLIDUS +0xE1 0x00F7 #DIVISION SIGN +0xE2 0x0053 #LATIN CAPITAL LETTER S +0xE3 0x0054 #LATIN CAPITAL LETTER T +0xE4 0x0055 #LATIN CAPITAL LETTER U +0xE5 0x0056 #LATIN CAPITAL LETTER V +0xE6 0x0057 #LATIN CAPITAL LETTER W +0xE7 0x0058 #LATIN CAPITAL LETTER X +0xE8 0x0059 #LATIN CAPITAL LETTER Y +0xE9 0x005A #LATIN CAPITAL LETTER Z +0xEA 0x00B2 #SUPERSCRIPT TWO +0xEB 0x00D4 #LATIN CAPITAL LETTER O WITH CIRCUMFLEX +0xEC 0x00D6 #LATIN CAPITAL LETTER O WITH DIAERESIS +0xED 0x00D2 #LATIN CAPITAL LETTER O WITH GRAVE +0xEE 0x00D3 #LATIN CAPITAL LETTER O WITH ACUTE +0xEF 0x00D5 #LATIN CAPITAL LETTER O WITH TILDE +0xF0 0x0030 #DIGIT ZERO +0xF1 0x0031 #DIGIT ONE +0xF2 0x0032 #DIGIT TWO +0xF3 0x0033 #DIGIT THREE +0xF4 0x0034 #DIGIT FOUR +0xF5 0x0035 #DIGIT FIVE +0xF6 0x0036 #DIGIT SIX +0xF7 0x0037 #DIGIT SEVEN +0xF8 0x0038 #DIGIT EIGHT +0xF9 0x0039 #DIGIT NINE +0xFA 0x00B3 #SUPERSCRIPT THREE +0xFB 0x00DB #LATIN CAPITAL LETTER U WITH CIRCUMFLEX +0xFC 0x00DC #LATIN CAPITAL LETTER U WITH DIAERESIS +0xFD 0x00D9 #LATIN CAPITAL LETTER U WITH GRAVE +0xFE 0x00DA #LATIN CAPITAL LETTER U WITH ACUTE +0xFF 0x009F #CONTROL + + \ No newline at end of file diff --git a/extra/io/encodings/8-bit/CP1252.TXT b/extra/io/encodings/8-bit/CP1252.TXT new file mode 100644 index 0000000000..8ff4b204b7 --- /dev/null +++ b/extra/io/encodings/8-bit/CP1252.TXT @@ -0,0 +1,274 @@ +# +# Name: cp1252 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 cp1252 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 cp1252 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 0x017D #LATIN CAPITAL LETTER Z WITH CARON +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 0x017E #LATIN SMALL LETTER Z WITH CARON +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 0x00D0 #LATIN CAPITAL LETTER ETH +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 0x00DD #LATIN CAPITAL LETTER Y WITH ACUTE +0xDE 0x00DE #LATIN CAPITAL LETTER THORN +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 0x00F0 #LATIN SMALL LETTER ETH +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 0x00FD #LATIN SMALL LETTER Y WITH ACUTE +0xFE 0x00FE #LATIN SMALL LETTER THORN +0xFF 0x00FF #LATIN SMALL LETTER Y WITH DIAERESIS diff --git a/extra/io/encodings/8-bit/GSM0338.TXT b/extra/io/encodings/8-bit/GSM0338.TXT new file mode 100644 index 0000000000..ae804d635a --- /dev/null +++ b/extra/io/encodings/8-bit/GSM0338.TXT @@ -0,0 +1,239 @@ +# +# Name: GSM 03.38 to Unicode +# Unicode version: 3.0 +# Table version: 1.1 +# Table format: Format A +# Date: 2000 May 30 +# Authors: Ken Whistler +# Kent Karlsson +# Markus Kuhn +# +# Copyright (c) 2000 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# ETSI GSM 03.38 7-bit default alphabet characters map into Unicode. +# This mapping is based on ETSI TS 100 900 V7.2.0 (1999-07), with +# a correction of 0x09 to *small* c-cedilla, instead of *capital* +# C-cedilla. +# +# Format: Three tab-separated columns +# Column #1 is the ETSI GSM 03.38 7-bit default alphabet +# code (in hex as 0xXX, or 0xXXXX for double-byte +# sequences) +# Column #2 is the Unicode scalar value (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in ETSI GSM 03.38 7-bit default alphabet code order. +# +# Note that ETSI GSM 03.38 also allows for the use of UCS-2 (UTF-16 +# restricted to the BMP) in GSM/SMS messages. +# +# Note also that there are commented Greek mappings for some +# capital Latin characters. This follows from the clear intent +# of the ETSI GSM 03.38 to have glyph coverage for the uppercase +# Greek alphabet by reusing Latin letters that have the same +# form as an uppercase Greek letter. Conversion implementations +# should be aware of this fact. +# +# The ETSI GSM 03.38 specification shows an uppercase C-cedilla +# glyph at 0x09. This may be the result of limited display +# capabilities for handling characters with descenders. However, the +# language coverage intent is clearly for the lowercase c-cedilla, as shown +# in the mapping below. The mapping for uppercase C-cedilla is shown +# in a commented line in the mapping table. +# +# The ESC character 0x1B is +# mapped to the no-break space character, unless it is part of a +# valid ESC sequence, to facilitate round-trip compatibility in +# the presence of unknown ESC sequences. +# +# 0x00 is NULL (when followed only by 0x00 up to the +# end of (fixed byte length) message, possibly also up to +# FORM FEED. But 0x00 is also the code for COMMERCIAL AT +# when some other character (CARRIAGE RETURN if nothing else) +# comes after the 0x00. +# +# Version history +# 1.0 version: first creation +# 1.1 version: fixed problem with the wrong line being a comment, +# added text regarding 0x00's interpretation, +# added second mapping for C-cedilla, +# added mapping of 0x1B escape to NBSP for display. +# +# Updated versions of this file may be found in: +# +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +0x00 0x0040 # COMMERCIAL AT +#0x00 0x0000 # NULL (see note above) +0x01 0x00A3 # POUND SIGN +0x02 0x0024 # DOLLAR SIGN +0x03 0x00A5 # YEN SIGN +0x04 0x00E8 # LATIN SMALL LETTER E WITH GRAVE +0x05 0x00E9 # LATIN SMALL LETTER E WITH ACUTE +0x06 0x00F9 # LATIN SMALL LETTER U WITH GRAVE +0x07 0x00EC # LATIN SMALL LETTER I WITH GRAVE +0x08 0x00F2 # LATIN SMALL LETTER O WITH GRAVE +0x09 0x00E7 # LATIN SMALL LETTER C WITH CEDILLA +#0x09 0x00C7 # LATIN CAPITAL LETTER C WITH CEDILLA (see note above) +0x0A 0x000A # LINE FEED +0x0B 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE +0x0C 0x00F8 # LATIN SMALL LETTER O WITH STROKE +0x0D 0x000D # CARRIAGE RETURN +0x0E 0x00C5 # LATIN CAPITAL LETTER A WITH RING ABOVE +0x0F 0x00E5 # LATIN SMALL LETTER A WITH RING ABOVE +0x10 0x0394 # GREEK CAPITAL LETTER DELTA +0x11 0x005F # LOW LINE +0x12 0x03A6 # GREEK CAPITAL LETTER PHI +0x13 0x0393 # GREEK CAPITAL LETTER GAMMA +0x14 0x039B # GREEK CAPITAL LETTER LAMDA +0x15 0x03A9 # GREEK CAPITAL LETTER OMEGA +0x16 0x03A0 # GREEK CAPITAL LETTER PI +0x17 0x03A8 # GREEK CAPITAL LETTER PSI +0x18 0x03A3 # GREEK CAPITAL LETTER SIGMA +0x19 0x0398 # GREEK CAPITAL LETTER THETA +0x1A 0x039E # GREEK CAPITAL LETTER XI +0x1B 0x00A0 # ESCAPE TO EXTENSION TABLE (or displayed as NBSP, see note above) +0x1B0A 0x000C # FORM FEED +0x1B14 0x005E # CIRCUMFLEX ACCENT +0x1B28 0x007B # LEFT CURLY BRACKET +0x1B29 0x007D # RIGHT CURLY BRACKET +0x1B2F 0x005C # REVERSE SOLIDUS +0x1B3C 0x005B # LEFT SQUARE BRACKET +0x1B3D 0x007E # TILDE +0x1B3E 0x005D # RIGHT SQUARE BRACKET +0x1B40 0x007C # VERTICAL LINE +0x1B65 0x20AC # EURO SIGN +0x1C 0x00C6 # LATIN CAPITAL LETTER AE +0x1D 0x00E6 # LATIN SMALL LETTER AE +0x1E 0x00DF # LATIN SMALL LETTER SHARP S (German) +0x1F 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE +0x20 0x0020 # SPACE +0x21 0x0021 # EXCLAMATION MARK +0x22 0x0022 # QUOTATION MARK +0x23 0x0023 # NUMBER SIGN +0x24 0x00A4 # CURRENCY 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 0x00A1 # INVERTED EXCLAMATION MARK +0x41 0x0041 # LATIN CAPITAL LETTER A +#0x41 0x0391 # GREEK CAPITAL LETTER ALPHA +0x42 0x0042 # LATIN CAPITAL LETTER B +#0x42 0x0392 # GREEK CAPITAL LETTER BETA +0x43 0x0043 # LATIN CAPITAL LETTER C +0x44 0x0044 # LATIN CAPITAL LETTER D +0x45 0x0045 # LATIN CAPITAL LETTER E +#0x45 0x0395 # GREEK CAPITAL LETTER EPSILON +0x46 0x0046 # LATIN CAPITAL LETTER F +0x47 0x0047 # LATIN CAPITAL LETTER G +0x48 0x0048 # LATIN CAPITAL LETTER H +#0x48 0x0397 # GREEK CAPITAL LETTER ETA +0x49 0x0049 # LATIN CAPITAL LETTER I +#0x49 0x0399 # GREEK CAPITAL LETTER IOTA +0x4A 0x004A # LATIN CAPITAL LETTER J +0x4B 0x004B # LATIN CAPITAL LETTER K +#0x4B 0x039A # GREEK CAPITAL LETTER KAPPA +0x4C 0x004C # LATIN CAPITAL LETTER L +0x4D 0x004D # LATIN CAPITAL LETTER M +#0x4D 0x039C # GREEK CAPITAL LETTER MU +0x4E 0x004E # LATIN CAPITAL LETTER N +#0x4E 0x039D # GREEK CAPITAL LETTER NU +0x4F 0x004F # LATIN CAPITAL LETTER O +#0x4F 0x039F # GREEK CAPITAL LETTER OMICRON +0x50 0x0050 # LATIN CAPITAL LETTER P +#0x50 0x03A1 # GREEK CAPITAL LETTER RHO +0x51 0x0051 # LATIN CAPITAL LETTER Q +0x52 0x0052 # LATIN CAPITAL LETTER R +0x53 0x0053 # LATIN CAPITAL LETTER S +0x54 0x0054 # LATIN CAPITAL LETTER T +#0x54 0x03A4 # GREEK CAPITAL LETTER TAU +0x55 0x0055 # LATIN CAPITAL LETTER U +#0x55 0x03A5 # GREEK CAPITAL LETTER UPSILON +0x56 0x0056 # LATIN CAPITAL LETTER V +0x57 0x0057 # LATIN CAPITAL LETTER W +0x58 0x0058 # LATIN CAPITAL LETTER X +#0x58 0x03A7 # GREEK CAPITAL LETTER CHI +0x59 0x0059 # LATIN CAPITAL LETTER Y +0x5A 0x005A # LATIN CAPITAL LETTER Z +#0x5A 0x0396 # GREEK CAPITAL LETTER ZETA +0x5B 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS +0x5C 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS +0x5D 0x00D1 # LATIN CAPITAL LETTER N WITH TILDE +0x5E 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS +0x5F 0x00A7 # SECTION SIGN +0x60 0x00BF # INVERTED QUESTION MARK +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 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS +0x7C 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS +0x7D 0x00F1 # LATIN SMALL LETTER N WITH TILDE +0x7E 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS +0x7F 0x00E0 # LATIN SMALL LETTER A WITH GRAVE diff --git a/extra/io/encodings/8-bit/KOI8-R.TXT b/extra/io/encodings/8-bit/KOI8-R.TXT new file mode 100644 index 0000000000..510561005c --- /dev/null +++ b/extra/io/encodings/8-bit/KOI8-R.TXT @@ -0,0 +1,302 @@ +# +# Name: KOI8-R (RFC1489) to Unicode +# Unicode version: 3.0 +# Table version: 1.0 +# Table format: Format A +# Date: 18 August 1999 +# Authors: Helmut Richter +# +# Copyright (c) 1991-1999 Unicode, Inc. All Rights reserved. +# +# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). +# No claims are made as to fitness for any particular purpose. No +# warranties of any kind are expressed or implied. The recipient +# agrees to determine applicability of information provided. If this +# file has been provided on optical media by Unicode, Inc., the sole +# remedy for any claim will be exchange of defective media within 90 +# days of receipt. +# +# Unicode, Inc. hereby grants the right to freely use the information +# supplied in this file in the creation of products supporting the +# Unicode Standard, and to make copies of this file in any form for +# internal or external distribution as long as this notice remains +# attached. +# +# General notes: +# +# This table contains the data the Unicode Consortium has on how +# KOI8-R characters map into Unicode. The underlying document is the +# mapping described in RFC 1489. No statements are made as to whether +# this mapping is the same as the mapping defined as "Code Page 878" +# with some vendors. +# +# Format: Three tab-separated columns +# Column #1 is the KOI8-R code (in hex as 0xXX) +# Column #2 is the Unicode (in hex as 0xXXXX) +# Column #3 the Unicode name (follows a comment sign, '#') +# +# The entries are in KOI8-R order. +# +# Version history +# 1.0 version: created. +# +# Any comments or problems, contact +# Please note that is an archival address; +# notices will be checked, but do not expect an immediate response. +# +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 0x2500 # BOX DRAWINGS LIGHT HORIZONTAL +0x81 0x2502 # BOX DRAWINGS LIGHT VERTICAL +0x82 0x250C # BOX DRAWINGS LIGHT DOWN AND RIGHT +0x83 0x2510 # BOX DRAWINGS LIGHT DOWN AND LEFT +0x84 0x2514 # BOX DRAWINGS LIGHT UP AND RIGHT +0x85 0x2518 # BOX DRAWINGS LIGHT UP AND LEFT +0x86 0x251C # BOX DRAWINGS LIGHT VERTICAL AND RIGHT +0x87 0x2524 # BOX DRAWINGS LIGHT VERTICAL AND LEFT +0x88 0x252C # BOX DRAWINGS LIGHT DOWN AND HORIZONTAL +0x89 0x2534 # BOX DRAWINGS LIGHT UP AND HORIZONTAL +0x8A 0x253C # BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL +0x8B 0x2580 # UPPER HALF BLOCK +0x8C 0x2584 # LOWER HALF BLOCK +0x8D 0x2588 # FULL BLOCK +0x8E 0x258C # LEFT HALF BLOCK +0x8F 0x2590 # RIGHT HALF BLOCK +0x90 0x2591 # LIGHT SHADE +0x91 0x2592 # MEDIUM SHADE +0x92 0x2593 # DARK SHADE +0x93 0x2320 # TOP HALF INTEGRAL +0x94 0x25A0 # BLACK SQUARE +0x95 0x2219 # BULLET OPERATOR +0x96 0x221A # SQUARE ROOT +0x97 0x2248 # ALMOST EQUAL TO +0x98 0x2264 # LESS-THAN OR EQUAL TO +0x99 0x2265 # GREATER-THAN OR EQUAL TO +0x9A 0x00A0 # NO-BREAK SPACE +0x9B 0x2321 # BOTTOM HALF INTEGRAL +0x9C 0x00B0 # DEGREE SIGN +0x9D 0x00B2 # SUPERSCRIPT TWO +0x9E 0x00B7 # MIDDLE DOT +0x9F 0x00F7 # DIVISION SIGN +0xA0 0x2550 # BOX DRAWINGS DOUBLE HORIZONTAL +0xA1 0x2551 # BOX DRAWINGS DOUBLE VERTICAL +0xA2 0x2552 # BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE +0xA3 0x0451 # CYRILLIC SMALL LETTER IO +0xA4 0x2553 # BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE +0xA5 0x2554 # BOX DRAWINGS DOUBLE DOWN AND RIGHT +0xA6 0x2555 # BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE +0xA7 0x2556 # BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE +0xA8 0x2557 # BOX DRAWINGS DOUBLE DOWN AND LEFT +0xA9 0x2558 # BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE +0xAA 0x2559 # BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE +0xAB 0x255A # BOX DRAWINGS DOUBLE UP AND RIGHT +0xAC 0x255B # BOX DRAWINGS UP SINGLE AND LEFT DOUBLE +0xAD 0x255C # BOX DRAWINGS UP DOUBLE AND LEFT SINGLE +0xAE 0x255D # BOX DRAWINGS DOUBLE UP AND LEFT +0xAF 0x255E # BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE +0xB0 0x255F # BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE +0xB1 0x2560 # BOX DRAWINGS DOUBLE VERTICAL AND RIGHT +0xB2 0x2561 # BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE +0xB3 0x0401 # CYRILLIC CAPITAL LETTER IO +0xB4 0x2562 # BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE +0xB5 0x2563 # BOX DRAWINGS DOUBLE VERTICAL AND LEFT +0xB6 0x2564 # BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE +0xB7 0x2565 # BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE +0xB8 0x2566 # BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL +0xB9 0x2567 # BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE +0xBA 0x2568 # BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE +0xBB 0x2569 # BOX DRAWINGS DOUBLE UP AND HORIZONTAL +0xBC 0x256A # BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE +0xBD 0x256B # BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE +0xBE 0x256C # BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL +0xBF 0x00A9 # COPYRIGHT SIGN +0xC0 0x044E # CYRILLIC SMALL LETTER YU +0xC1 0x0430 # CYRILLIC SMALL LETTER A +0xC2 0x0431 # CYRILLIC SMALL LETTER BE +0xC3 0x0446 # CYRILLIC SMALL LETTER TSE +0xC4 0x0434 # CYRILLIC SMALL LETTER DE +0xC5 0x0435 # CYRILLIC SMALL LETTER IE +0xC6 0x0444 # CYRILLIC SMALL LETTER EF +0xC7 0x0433 # CYRILLIC SMALL LETTER GHE +0xC8 0x0445 # CYRILLIC SMALL LETTER HA +0xC9 0x0438 # CYRILLIC SMALL LETTER I +0xCA 0x0439 # CYRILLIC SMALL LETTER SHORT I +0xCB 0x043A # CYRILLIC SMALL LETTER KA +0xCC 0x043B # CYRILLIC SMALL LETTER EL +0xCD 0x043C # CYRILLIC SMALL LETTER EM +0xCE 0x043D # CYRILLIC SMALL LETTER EN +0xCF 0x043E # CYRILLIC SMALL LETTER O +0xD0 0x043F # CYRILLIC SMALL LETTER PE +0xD1 0x044F # CYRILLIC SMALL LETTER YA +0xD2 0x0440 # CYRILLIC SMALL LETTER ER +0xD3 0x0441 # CYRILLIC SMALL LETTER ES +0xD4 0x0442 # CYRILLIC SMALL LETTER TE +0xD5 0x0443 # CYRILLIC SMALL LETTER U +0xD6 0x0436 # CYRILLIC SMALL LETTER ZHE +0xD7 0x0432 # CYRILLIC SMALL LETTER VE +0xD8 0x044C # CYRILLIC SMALL LETTER SOFT SIGN +0xD9 0x044B # CYRILLIC SMALL LETTER YERU +0xDA 0x0437 # CYRILLIC SMALL LETTER ZE +0xDB 0x0448 # CYRILLIC SMALL LETTER SHA +0xDC 0x044D # CYRILLIC SMALL LETTER E +0xDD 0x0449 # CYRILLIC SMALL LETTER SHCHA +0xDE 0x0447 # CYRILLIC SMALL LETTER CHE +0xDF 0x044A # CYRILLIC SMALL LETTER HARD SIGN +0xE0 0x042E # CYRILLIC CAPITAL LETTER YU +0xE1 0x0410 # CYRILLIC CAPITAL LETTER A +0xE2 0x0411 # CYRILLIC CAPITAL LETTER BE +0xE3 0x0426 # CYRILLIC CAPITAL LETTER TSE +0xE4 0x0414 # CYRILLIC CAPITAL LETTER DE +0xE5 0x0415 # CYRILLIC CAPITAL LETTER IE +0xE6 0x0424 # CYRILLIC CAPITAL LETTER EF +0xE7 0x0413 # CYRILLIC CAPITAL LETTER GHE +0xE8 0x0425 # CYRILLIC CAPITAL LETTER HA +0xE9 0x0418 # CYRILLIC CAPITAL LETTER I +0xEA 0x0419 # CYRILLIC CAPITAL LETTER SHORT I +0xEB 0x041A # CYRILLIC CAPITAL LETTER KA +0xEC 0x041B # CYRILLIC CAPITAL LETTER EL +0xED 0x041C # CYRILLIC CAPITAL LETTER EM +0xEE 0x041D # CYRILLIC CAPITAL LETTER EN +0xEF 0x041E # CYRILLIC CAPITAL LETTER O +0xF0 0x041F # CYRILLIC CAPITAL LETTER PE +0xF1 0x042F # CYRILLIC CAPITAL LETTER YA +0xF2 0x0420 # CYRILLIC CAPITAL LETTER ER +0xF3 0x0421 # CYRILLIC CAPITAL LETTER ES +0xF4 0x0422 # CYRILLIC CAPITAL LETTER TE +0xF5 0x0423 # CYRILLIC CAPITAL LETTER U +0xF6 0x0416 # CYRILLIC CAPITAL LETTER ZHE +0xF7 0x0412 # CYRILLIC CAPITAL LETTER VE +0xF8 0x042C # CYRILLIC CAPITAL LETTER SOFT SIGN +0xF9 0x042B # CYRILLIC CAPITAL LETTER YERU +0xFA 0x0417 # CYRILLIC CAPITAL LETTER ZE +0xFB 0x0428 # CYRILLIC CAPITAL LETTER SHA +0xFC 0x042D # CYRILLIC CAPITAL LETTER E +0xFD 0x0429 # CYRILLIC CAPITAL LETTER SHCHA +0xFE 0x0427 # CYRILLIC CAPITAL LETTER CHE +0xFF 0x042A # CYRILLIC CAPITAL LETTER HARD SIGN diff --git a/extra/io/encodings/8-bit/ROMAN.TXT b/extra/io/encodings/8-bit/ROMAN.TXT new file mode 100644 index 0000000000..5b3b8b4005 --- /dev/null +++ b/extra/io/encodings/8-bit/ROMAN.TXT @@ -0,0 +1,370 @@ +#======================================================================= +# File name: ROMAN.TXT +# +# Contents: Map (external version) from Mac OS Roman +# character set to Unicode 2.1 and later. +# +# Copyright: (c) 1994-2002, 2005 by Apple Computer, Inc., all rights +# reserved. +# +# Contact: charsets@apple.com +# +# Changes: +# +# c02 2005-Apr-05 Update header comments. Matches internal xml +# and Text Encoding Converter 2.0. +# b4,c1 2002-Dec-19 Update URLs, notes. Matches internal +# utom. +# b03 1999-Sep-22 Update contact e-mail address. Matches +# internal utom, ufrm, and Text +# Encoding Converter version 1.5. +# b02 1998-Aug-18 Encoding changed for Mac OS 8.5; change +# mapping of 0xDB from CURRENCY SIGN to +# EURO SIGN. Matches internal utom, +# ufrm. +# n08 1998-Feb-05 Minor update to header comments +# n06 1997-Dec-14 Add warning about future changes to 0xDB +# from CURRENCY SIGN to EURO SIGN. Clarify +# some header information +# n04 1997-Dec-01 Update to match internal utom, ufrm: +# Change standard mapping for 0xBD from U+2126 +# to its canonical decomposition, U+03A9. +# n03 1995-Apr-15 First version (after fixing some typos). +# Matches internal ufrm. +# +# Standard header: +# ---------------- +# +# Apple, the Apple logo, and Macintosh are trademarks of Apple +# Computer, Inc., registered in the United States and other countries. +# Unicode is a trademark of Unicode Inc. For the sake of brevity, +# throughout this document, "Macintosh" can be used to refer to +# Macintosh computers and "Unicode" can be used to refer to the +# Unicode standard. +# +# Apple Computer, Inc. ("Apple") makes no warranty or representation, +# either express or implied, with respect to this document and the +# included data, its quality, accuracy, or fitness for a particular +# purpose. In no event will Apple be liable for direct, indirect, +# special, incidental, or consequential damages resulting from any +# defect or inaccuracy in this document or the included data. +# +# These mapping tables and character lists are subject to change. +# The latest tables should be available from the following: +# +# +# +# For general information about Mac OS encodings and these mapping +# tables, see the file "README.TXT". +# +# Format: +# ------- +# +# Three tab-separated columns; +# '#' begins a comment which continues to the end of the line. +# Column #1 is the Mac OS Roman code (in hex as 0xNN) +# Column #2 is the corresponding Unicode (in hex as 0xNNNN) +# Column #3 is a comment containing the Unicode name +# +# The entries are in Mac OS Roman code order. +# +# One of these mappings requires the use of a corporate character. +# See the file "CORPCHAR.TXT" and notes below. +# +# Control character mappings are not shown in this table, following +# the conventions of the standard UTC mapping tables. However, the +# Mac OS Roman character set uses the standard control characters at +# 0x00-0x1F and 0x7F. +# +# Notes on Mac OS Roman: +# ---------------------- +# +# This is a legacy Mac OS encoding; in the Mac OS X Carbon and Cocoa +# environments, it is only supported directly in programming +# interfaces for QuickDraw Text, the Script Manager, and related +# Text Utilities. For other purposes it is supported via transcoding +# to and from Unicode. +# +# This character set is used for at least the following Mac OS +# localizations: U.S., British, Canadian French, French, Swiss +# French, German, Swiss German, Italian, Swiss Italian, Dutch, +# Swedish, Norwegian, Danish, Finnish, Spanish, Catalan, +# Portuguese, Brazilian, and the default International system. +# +# Variants of Mac OS Roman are used for Croatian, Icelandic, +# Turkish, Romanian, and other encodings. Separate mapping tables +# are available for these encodings. +# +# Before Mac OS 8.5, code point 0xDB was CURRENCY SIGN, and was +# mapped to U+00A4. In Mac OS 8.5 and later versions, code point +# 0xDB is changed to EURO SIGN and maps to U+20AC; the standard +# Apple fonts are updated for Mac OS 8.5 to reflect this. There is +# a "currency sign" variant of the Mac OS Roman encoding that still +# maps 0xDB to U+00A4; this can be used for older fonts. +# +# Before Mac OS 8.5, the ROM bitmap versions of the fonts Chicago, +# New York, Geneva, and Monaco did not implement the full Mac OS +# Roman character set; they only supported character codes up to +# 0xD8. The TrueType versions of these fonts have always implemented +# the full character set, as with the bitmap and TrueType versions +# of the other standard Roman fonts. +# +# In all Mac OS encodings, fonts such as Chicago which are used +# as "system" fonts (for menus, dialogs, etc.) have four glyphs +# at code points 0x11-0x14 for transient use by the Menu Manager. +# These glyphs are not intended as characters for use in normal +# text, and the associated code points are not generally +# interpreted as associated with these glyphs; they are usually +# interpreted (if at all) as the control codes DC1-DC4. +# +# Unicode mapping issues and notes: +# --------------------------------- +# +# The following corporate zone Unicode character is used in this +# mapping: +# +# 0xF8FF Apple logo +# +# NOTE: The graphic image associated with the Apple logo character +# is not authorized for use without permission of Apple, and +# unauthorized use might constitute trademark infringement. +# +# Details of mapping changes in each version: +# ------------------------------------------- +# +# Changes from version n08 to version b02: +# +# - Encoding changed for Mac OS 8.5; change mapping of 0xDB from +# CURRENCY SIGN (U+00A4) to EURO SIGN (U+20AC). +# +# Changes from version n03 to version n04: +# +# - Change mapping of 0xBD from U+2126 to its canonical +# decomposition, U+03A9. +# +################## + +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 +# +0x80 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS +0x81 0x00C5 # LATIN CAPITAL LETTER A WITH RING ABOVE +0x82 0x00C7 # LATIN CAPITAL LETTER C WITH CEDILLA +0x83 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE +0x84 0x00D1 # LATIN CAPITAL LETTER N WITH TILDE +0x85 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS +0x86 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS +0x87 0x00E1 # LATIN SMALL LETTER A WITH ACUTE +0x88 0x00E0 # LATIN SMALL LETTER A WITH GRAVE +0x89 0x00E2 # LATIN SMALL LETTER A WITH CIRCUMFLEX +0x8A 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS +0x8B 0x00E3 # LATIN SMALL LETTER A WITH TILDE +0x8C 0x00E5 # LATIN SMALL LETTER A WITH RING ABOVE +0x8D 0x00E7 # LATIN SMALL LETTER C WITH CEDILLA +0x8E 0x00E9 # LATIN SMALL LETTER E WITH ACUTE +0x8F 0x00E8 # LATIN SMALL LETTER E WITH GRAVE +0x90 0x00EA # LATIN SMALL LETTER E WITH CIRCUMFLEX +0x91 0x00EB # LATIN SMALL LETTER E WITH DIAERESIS +0x92 0x00ED # LATIN SMALL LETTER I WITH ACUTE +0x93 0x00EC # LATIN SMALL LETTER I WITH GRAVE +0x94 0x00EE # LATIN SMALL LETTER I WITH CIRCUMFLEX +0x95 0x00EF # LATIN SMALL LETTER I WITH DIAERESIS +0x96 0x00F1 # LATIN SMALL LETTER N WITH TILDE +0x97 0x00F3 # LATIN SMALL LETTER O WITH ACUTE +0x98 0x00F2 # LATIN SMALL LETTER O WITH GRAVE +0x99 0x00F4 # LATIN SMALL LETTER O WITH CIRCUMFLEX +0x9A 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS +0x9B 0x00F5 # LATIN SMALL LETTER O WITH TILDE +0x9C 0x00FA # LATIN SMALL LETTER U WITH ACUTE +0x9D 0x00F9 # LATIN SMALL LETTER U WITH GRAVE +0x9E 0x00FB # LATIN SMALL LETTER U WITH CIRCUMFLEX +0x9F 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS +0xA0 0x2020 # DAGGER +0xA1 0x00B0 # DEGREE SIGN +0xA2 0x00A2 # CENT SIGN +0xA3 0x00A3 # POUND SIGN +0xA4 0x00A7 # SECTION SIGN +0xA5 0x2022 # BULLET +0xA6 0x00B6 # PILCROW SIGN +0xA7 0x00DF # LATIN SMALL LETTER SHARP S +0xA8 0x00AE # REGISTERED SIGN +0xA9 0x00A9 # COPYRIGHT SIGN +0xAA 0x2122 # TRADE MARK SIGN +0xAB 0x00B4 # ACUTE ACCENT +0xAC 0x00A8 # DIAERESIS +0xAD 0x2260 # NOT EQUAL TO +0xAE 0x00C6 # LATIN CAPITAL LETTER AE +0xAF 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE +0xB0 0x221E # INFINITY +0xB1 0x00B1 # PLUS-MINUS SIGN +0xB2 0x2264 # LESS-THAN OR EQUAL TO +0xB3 0x2265 # GREATER-THAN OR EQUAL TO +0xB4 0x00A5 # YEN SIGN +0xB5 0x00B5 # MICRO SIGN +0xB6 0x2202 # PARTIAL DIFFERENTIAL +0xB7 0x2211 # N-ARY SUMMATION +0xB8 0x220F # N-ARY PRODUCT +0xB9 0x03C0 # GREEK SMALL LETTER PI +0xBA 0x222B # INTEGRAL +0xBB 0x00AA # FEMININE ORDINAL INDICATOR +0xBC 0x00BA # MASCULINE ORDINAL INDICATOR +0xBD 0x03A9 # GREEK CAPITAL LETTER OMEGA +0xBE 0x00E6 # LATIN SMALL LETTER AE +0xBF 0x00F8 # LATIN SMALL LETTER O WITH STROKE +0xC0 0x00BF # INVERTED QUESTION MARK +0xC1 0x00A1 # INVERTED EXCLAMATION MARK +0xC2 0x00AC # NOT SIGN +0xC3 0x221A # SQUARE ROOT +0xC4 0x0192 # LATIN SMALL LETTER F WITH HOOK +0xC5 0x2248 # ALMOST EQUAL TO +0xC6 0x2206 # INCREMENT +0xC7 0x00AB # LEFT-POINTING DOUBLE ANGLE QUOTATION MARK +0xC8 0x00BB # RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK +0xC9 0x2026 # HORIZONTAL ELLIPSIS +0xCA 0x00A0 # NO-BREAK SPACE +0xCB 0x00C0 # LATIN CAPITAL LETTER A WITH GRAVE +0xCC 0x00C3 # LATIN CAPITAL LETTER A WITH TILDE +0xCD 0x00D5 # LATIN CAPITAL LETTER O WITH TILDE +0xCE 0x0152 # LATIN CAPITAL LIGATURE OE +0xCF 0x0153 # LATIN SMALL LIGATURE OE +0xD0 0x2013 # EN DASH +0xD1 0x2014 # EM DASH +0xD2 0x201C # LEFT DOUBLE QUOTATION MARK +0xD3 0x201D # RIGHT DOUBLE QUOTATION MARK +0xD4 0x2018 # LEFT SINGLE QUOTATION MARK +0xD5 0x2019 # RIGHT SINGLE QUOTATION MARK +0xD6 0x00F7 # DIVISION SIGN +0xD7 0x25CA # LOZENGE +0xD8 0x00FF # LATIN SMALL LETTER Y WITH DIAERESIS +0xD9 0x0178 # LATIN CAPITAL LETTER Y WITH DIAERESIS +0xDA 0x2044 # FRACTION SLASH +0xDB 0x20AC # EURO SIGN +0xDC 0x2039 # SINGLE LEFT-POINTING ANGLE QUOTATION MARK +0xDD 0x203A # SINGLE RIGHT-POINTING ANGLE QUOTATION MARK +0xDE 0xFB01 # LATIN SMALL LIGATURE FI +0xDF 0xFB02 # LATIN SMALL LIGATURE FL +0xE0 0x2021 # DOUBLE DAGGER +0xE1 0x00B7 # MIDDLE DOT +0xE2 0x201A # SINGLE LOW-9 QUOTATION MARK +0xE3 0x201E # DOUBLE LOW-9 QUOTATION MARK +0xE4 0x2030 # PER MILLE SIGN +0xE5 0x00C2 # LATIN CAPITAL LETTER A WITH CIRCUMFLEX +0xE6 0x00CA # LATIN CAPITAL LETTER E WITH CIRCUMFLEX +0xE7 0x00C1 # LATIN CAPITAL LETTER A WITH ACUTE +0xE8 0x00CB # LATIN CAPITAL LETTER E WITH DIAERESIS +0xE9 0x00C8 # LATIN CAPITAL LETTER E WITH GRAVE +0xEA 0x00CD # LATIN CAPITAL LETTER I WITH ACUTE +0xEB 0x00CE # LATIN CAPITAL LETTER I WITH CIRCUMFLEX +0xEC 0x00CF # LATIN CAPITAL LETTER I WITH DIAERESIS +0xED 0x00CC # LATIN CAPITAL LETTER I WITH GRAVE +0xEE 0x00D3 # LATIN CAPITAL LETTER O WITH ACUTE +0xEF 0x00D4 # LATIN CAPITAL LETTER O WITH CIRCUMFLEX +0xF0 0xF8FF # Apple logo +0xF1 0x00D2 # LATIN CAPITAL LETTER O WITH GRAVE +0xF2 0x00DA # LATIN CAPITAL LETTER U WITH ACUTE +0xF3 0x00DB # LATIN CAPITAL LETTER U WITH CIRCUMFLEX +0xF4 0x00D9 # LATIN CAPITAL LETTER U WITH GRAVE +0xF5 0x0131 # LATIN SMALL LETTER DOTLESS I +0xF6 0x02C6 # MODIFIER LETTER CIRCUMFLEX ACCENT +0xF7 0x02DC # SMALL TILDE +0xF8 0x00AF # MACRON +0xF9 0x02D8 # BREVE +0xFA 0x02D9 # DOT ABOVE +0xFB 0x02DA # RING ABOVE +0xFC 0x00B8 # CEDILLA +0xFD 0x02DD # DOUBLE ACUTE ACCENT +0xFE 0x02DB # OGONEK +0xFF 0x02C7 # CARON diff --git a/extra/io/encodings/latin1/authors.txt b/extra/io/encodings/8-bit/authors.txt similarity index 100% rename from extra/io/encodings/latin1/authors.txt rename to extra/io/encodings/8-bit/authors.txt diff --git a/extra/io/encodings/8-bit/summary.txt b/extra/io/encodings/8-bit/summary.txt new file mode 100644 index 0000000000..7fe8064015 --- /dev/null +++ b/extra/io/encodings/8-bit/summary.txt @@ -0,0 +1 @@ +Definitions of 8-bit encodings like ISO 8859 and Windows 1252 diff --git a/extra/io/encodings/latin1/tags.txt b/extra/io/encodings/8-bit/tags.txt similarity index 100% rename from extra/io/encodings/latin1/tags.txt rename to extra/io/encodings/8-bit/tags.txt diff --git a/extra/io/encodings/latin1/latin1-docs.factor b/extra/io/encodings/latin1/latin1-docs.factor deleted file mode 100644 index 5872b2bcfd..0000000000 --- a/extra/io/encodings/latin1/latin1-docs.factor +++ /dev/null @@ -1,5 +0,0 @@ -USING: help.syntax help.markup ; -IN: io.encodings.latin1 - -HELP: latin1 -{ $class-description "This class is used for Latin 1 (ISO 8859-1) encoding and decoding" } ; diff --git a/extra/io/encodings/latin1/latin1-tests.factor b/extra/io/encodings/latin1/latin1-tests.factor deleted file mode 100644 index a89bfe0e6f..0000000000 --- a/extra/io/encodings/latin1/latin1-tests.factor +++ /dev/null @@ -1,9 +0,0 @@ -USING: io.encodings.string io.encodings.latin1 tools.test strings arrays ; -IN: io.encodings.latin1.tests - -[ B{ CHAR: f CHAR: o CHAR: o } ] [ "foo" latin1 encode ] unit-test -[ { 256 } >string latin1 encode ] must-fail -[ B{ 255 } ] [ { 255 } latin1 encode ] unit-test - -[ "bar" ] [ "bar" latin1 decode ] unit-test -[ { CHAR: b 233 CHAR: r } ] [ { CHAR: b 233 CHAR: r } latin1 decode >array ] unit-test diff --git a/extra/io/encodings/latin1/latin1.factor b/extra/io/encodings/latin1/latin1.factor deleted file mode 100755 index 2b82318885..0000000000 --- a/extra/io/encodings/latin1/latin1.factor +++ /dev/null @@ -1,12 +0,0 @@ -! Copyright (C) 2008 Daniel Ehrenberg. -! See http://factorcode.org/license.txt for BSD license. -USING: io io.encodings kernel io.encodings.ascii.private ; -IN: io.encodings.latin1 - -TUPLE: latin1 ; - -M: latin1 encode-char - 256 encode-if< ; - -M: latin1 decode-char - drop stream-read1 ; diff --git a/extra/io/encodings/latin1/summary.txt b/extra/io/encodings/latin1/summary.txt deleted file mode 100644 index d40d628767..0000000000 --- a/extra/io/encodings/latin1/summary.txt +++ /dev/null @@ -1 +0,0 @@ -ISO 8859-1 encoding/decoding From 7adef0c61321a004bf93d0fb3c1241b75a4a44c1 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 21 Mar 2008 14:01:50 -0400 Subject: [PATCH 018/219] Completing 8-bit changes --- extra/io/encodings/8-bit/8-bit-tests.factor | 1 + extra/io/encodings/8-bit/8-bit.factor | 18 +- extra/io/encodings/8-bit/GSM0338.TXT | 239 -------------------- 3 files changed, 12 insertions(+), 246 deletions(-) delete mode 100644 extra/io/encodings/8-bit/GSM0338.TXT diff --git a/extra/io/encodings/8-bit/8-bit-tests.factor b/extra/io/encodings/8-bit/8-bit-tests.factor index 316e496219..5dbe28cb14 100644 --- a/extra/io/encodings/8-bit/8-bit-tests.factor +++ b/extra/io/encodings/8-bit/8-bit-tests.factor @@ -7,3 +7,4 @@ IN: io.encodings.8-bit.tests [ "bar" ] [ "bar" iso-8859-1 decode ] unit-test [ { CHAR: b 233 CHAR: r } ] [ { CHAR: b 233 CHAR: r } iso-8859-1 decode >array ] unit-test +[ { HEX: fffd HEX: 20AC } ] [ { HEX: 81 HEX: 80 } windows-1252 decode >array ] unit-test diff --git a/extra/io/encodings/8-bit/8-bit.factor b/extra/io/encodings/8-bit/8-bit.factor index ff0e6ec8bf..2cc6b2e57c 100644 --- a/extra/io/encodings/8-bit/8-bit.factor +++ b/extra/io/encodings/8-bit/8-bit.factor @@ -3,7 +3,7 @@ USING: math.parser arrays io.encodings sequences kernel assocs hashtables io.encodings.ascii combinators.cleave generic parser tuples words io io.files splitting namespaces -classes quotations ; +classes quotations math compiler.units ; IN: io.encodings.8-bit ] map ] map ; + [ "\t " split 2 head [ 2 tail-if hex> ] map ] map ; : byte>ch ( assoc -- array ) 256 replacement-char @@ -73,7 +75,9 @@ IN: io.encodings.8-bit \ encode-char [ encode-8-bit ] method-with-data ; : decode-8-bit ( stream encoding array -- char/f ) - nip swap stream-read1 [ swap nth ] [ drop f ] if* ; + nip swap stream-read1 + [ swap nth [ replacement-char ] unless* ] + [ drop f ] if* ; : define-decode-char ( class array -- ) \ decode-char [ decode-8-bit ] method-with-data ; @@ -86,4 +90,4 @@ IN: io.encodings.8-bit PRIVATE> -! << mappings [ define-8-bit-encoding ] assoc-each >> +[ mappings [ define-8-bit-encoding ] assoc-each ] with-compilation-unit diff --git a/extra/io/encodings/8-bit/GSM0338.TXT b/extra/io/encodings/8-bit/GSM0338.TXT deleted file mode 100644 index ae804d635a..0000000000 --- a/extra/io/encodings/8-bit/GSM0338.TXT +++ /dev/null @@ -1,239 +0,0 @@ -# -# Name: GSM 03.38 to Unicode -# Unicode version: 3.0 -# Table version: 1.1 -# Table format: Format A -# Date: 2000 May 30 -# Authors: Ken Whistler -# Kent Karlsson -# Markus Kuhn -# -# Copyright (c) 2000 Unicode, Inc. All Rights reserved. -# -# This file is provided as-is by Unicode, Inc. (The Unicode Consortium). -# No claims are made as to fitness for any particular purpose. No -# warranties of any kind are expressed or implied. The recipient -# agrees to determine applicability of information provided. If this -# file has been provided on optical media by Unicode, Inc., the sole -# remedy for any claim will be exchange of defective media within 90 -# days of receipt. -# -# Unicode, Inc. hereby grants the right to freely use the information -# supplied in this file in the creation of products supporting the -# Unicode Standard, and to make copies of this file in any form for -# internal or external distribution as long as this notice remains -# attached. -# -# General notes: -# -# This table contains the data the Unicode Consortium has on how -# ETSI GSM 03.38 7-bit default alphabet characters map into Unicode. -# This mapping is based on ETSI TS 100 900 V7.2.0 (1999-07), with -# a correction of 0x09 to *small* c-cedilla, instead of *capital* -# C-cedilla. -# -# Format: Three tab-separated columns -# Column #1 is the ETSI GSM 03.38 7-bit default alphabet -# code (in hex as 0xXX, or 0xXXXX for double-byte -# sequences) -# Column #2 is the Unicode scalar value (in hex as 0xXXXX) -# Column #3 the Unicode name (follows a comment sign, '#') -# -# The entries are in ETSI GSM 03.38 7-bit default alphabet code order. -# -# Note that ETSI GSM 03.38 also allows for the use of UCS-2 (UTF-16 -# restricted to the BMP) in GSM/SMS messages. -# -# Note also that there are commented Greek mappings for some -# capital Latin characters. This follows from the clear intent -# of the ETSI GSM 03.38 to have glyph coverage for the uppercase -# Greek alphabet by reusing Latin letters that have the same -# form as an uppercase Greek letter. Conversion implementations -# should be aware of this fact. -# -# The ETSI GSM 03.38 specification shows an uppercase C-cedilla -# glyph at 0x09. This may be the result of limited display -# capabilities for handling characters with descenders. However, the -# language coverage intent is clearly for the lowercase c-cedilla, as shown -# in the mapping below. The mapping for uppercase C-cedilla is shown -# in a commented line in the mapping table. -# -# The ESC character 0x1B is -# mapped to the no-break space character, unless it is part of a -# valid ESC sequence, to facilitate round-trip compatibility in -# the presence of unknown ESC sequences. -# -# 0x00 is NULL (when followed only by 0x00 up to the -# end of (fixed byte length) message, possibly also up to -# FORM FEED. But 0x00 is also the code for COMMERCIAL AT -# when some other character (CARRIAGE RETURN if nothing else) -# comes after the 0x00. -# -# Version history -# 1.0 version: first creation -# 1.1 version: fixed problem with the wrong line being a comment, -# added text regarding 0x00's interpretation, -# added second mapping for C-cedilla, -# added mapping of 0x1B escape to NBSP for display. -# -# Updated versions of this file may be found in: -# -# -# Any comments or problems, contact -# Please note that is an archival address; -# notices will be checked, but do not expect an immediate response. -# -0x00 0x0040 # COMMERCIAL AT -#0x00 0x0000 # NULL (see note above) -0x01 0x00A3 # POUND SIGN -0x02 0x0024 # DOLLAR SIGN -0x03 0x00A5 # YEN SIGN -0x04 0x00E8 # LATIN SMALL LETTER E WITH GRAVE -0x05 0x00E9 # LATIN SMALL LETTER E WITH ACUTE -0x06 0x00F9 # LATIN SMALL LETTER U WITH GRAVE -0x07 0x00EC # LATIN SMALL LETTER I WITH GRAVE -0x08 0x00F2 # LATIN SMALL LETTER O WITH GRAVE -0x09 0x00E7 # LATIN SMALL LETTER C WITH CEDILLA -#0x09 0x00C7 # LATIN CAPITAL LETTER C WITH CEDILLA (see note above) -0x0A 0x000A # LINE FEED -0x0B 0x00D8 # LATIN CAPITAL LETTER O WITH STROKE -0x0C 0x00F8 # LATIN SMALL LETTER O WITH STROKE -0x0D 0x000D # CARRIAGE RETURN -0x0E 0x00C5 # LATIN CAPITAL LETTER A WITH RING ABOVE -0x0F 0x00E5 # LATIN SMALL LETTER A WITH RING ABOVE -0x10 0x0394 # GREEK CAPITAL LETTER DELTA -0x11 0x005F # LOW LINE -0x12 0x03A6 # GREEK CAPITAL LETTER PHI -0x13 0x0393 # GREEK CAPITAL LETTER GAMMA -0x14 0x039B # GREEK CAPITAL LETTER LAMDA -0x15 0x03A9 # GREEK CAPITAL LETTER OMEGA -0x16 0x03A0 # GREEK CAPITAL LETTER PI -0x17 0x03A8 # GREEK CAPITAL LETTER PSI -0x18 0x03A3 # GREEK CAPITAL LETTER SIGMA -0x19 0x0398 # GREEK CAPITAL LETTER THETA -0x1A 0x039E # GREEK CAPITAL LETTER XI -0x1B 0x00A0 # ESCAPE TO EXTENSION TABLE (or displayed as NBSP, see note above) -0x1B0A 0x000C # FORM FEED -0x1B14 0x005E # CIRCUMFLEX ACCENT -0x1B28 0x007B # LEFT CURLY BRACKET -0x1B29 0x007D # RIGHT CURLY BRACKET -0x1B2F 0x005C # REVERSE SOLIDUS -0x1B3C 0x005B # LEFT SQUARE BRACKET -0x1B3D 0x007E # TILDE -0x1B3E 0x005D # RIGHT SQUARE BRACKET -0x1B40 0x007C # VERTICAL LINE -0x1B65 0x20AC # EURO SIGN -0x1C 0x00C6 # LATIN CAPITAL LETTER AE -0x1D 0x00E6 # LATIN SMALL LETTER AE -0x1E 0x00DF # LATIN SMALL LETTER SHARP S (German) -0x1F 0x00C9 # LATIN CAPITAL LETTER E WITH ACUTE -0x20 0x0020 # SPACE -0x21 0x0021 # EXCLAMATION MARK -0x22 0x0022 # QUOTATION MARK -0x23 0x0023 # NUMBER SIGN -0x24 0x00A4 # CURRENCY 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 0x00A1 # INVERTED EXCLAMATION MARK -0x41 0x0041 # LATIN CAPITAL LETTER A -#0x41 0x0391 # GREEK CAPITAL LETTER ALPHA -0x42 0x0042 # LATIN CAPITAL LETTER B -#0x42 0x0392 # GREEK CAPITAL LETTER BETA -0x43 0x0043 # LATIN CAPITAL LETTER C -0x44 0x0044 # LATIN CAPITAL LETTER D -0x45 0x0045 # LATIN CAPITAL LETTER E -#0x45 0x0395 # GREEK CAPITAL LETTER EPSILON -0x46 0x0046 # LATIN CAPITAL LETTER F -0x47 0x0047 # LATIN CAPITAL LETTER G -0x48 0x0048 # LATIN CAPITAL LETTER H -#0x48 0x0397 # GREEK CAPITAL LETTER ETA -0x49 0x0049 # LATIN CAPITAL LETTER I -#0x49 0x0399 # GREEK CAPITAL LETTER IOTA -0x4A 0x004A # LATIN CAPITAL LETTER J -0x4B 0x004B # LATIN CAPITAL LETTER K -#0x4B 0x039A # GREEK CAPITAL LETTER KAPPA -0x4C 0x004C # LATIN CAPITAL LETTER L -0x4D 0x004D # LATIN CAPITAL LETTER M -#0x4D 0x039C # GREEK CAPITAL LETTER MU -0x4E 0x004E # LATIN CAPITAL LETTER N -#0x4E 0x039D # GREEK CAPITAL LETTER NU -0x4F 0x004F # LATIN CAPITAL LETTER O -#0x4F 0x039F # GREEK CAPITAL LETTER OMICRON -0x50 0x0050 # LATIN CAPITAL LETTER P -#0x50 0x03A1 # GREEK CAPITAL LETTER RHO -0x51 0x0051 # LATIN CAPITAL LETTER Q -0x52 0x0052 # LATIN CAPITAL LETTER R -0x53 0x0053 # LATIN CAPITAL LETTER S -0x54 0x0054 # LATIN CAPITAL LETTER T -#0x54 0x03A4 # GREEK CAPITAL LETTER TAU -0x55 0x0055 # LATIN CAPITAL LETTER U -#0x55 0x03A5 # GREEK CAPITAL LETTER UPSILON -0x56 0x0056 # LATIN CAPITAL LETTER V -0x57 0x0057 # LATIN CAPITAL LETTER W -0x58 0x0058 # LATIN CAPITAL LETTER X -#0x58 0x03A7 # GREEK CAPITAL LETTER CHI -0x59 0x0059 # LATIN CAPITAL LETTER Y -0x5A 0x005A # LATIN CAPITAL LETTER Z -#0x5A 0x0396 # GREEK CAPITAL LETTER ZETA -0x5B 0x00C4 # LATIN CAPITAL LETTER A WITH DIAERESIS -0x5C 0x00D6 # LATIN CAPITAL LETTER O WITH DIAERESIS -0x5D 0x00D1 # LATIN CAPITAL LETTER N WITH TILDE -0x5E 0x00DC # LATIN CAPITAL LETTER U WITH DIAERESIS -0x5F 0x00A7 # SECTION SIGN -0x60 0x00BF # INVERTED QUESTION MARK -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 0x00E4 # LATIN SMALL LETTER A WITH DIAERESIS -0x7C 0x00F6 # LATIN SMALL LETTER O WITH DIAERESIS -0x7D 0x00F1 # LATIN SMALL LETTER N WITH TILDE -0x7E 0x00FC # LATIN SMALL LETTER U WITH DIAERESIS -0x7F 0x00E0 # LATIN SMALL LETTER A WITH GRAVE From 88baf7c3b7a7c38bb699e8ff72cb09fc6ce17031 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 21 Mar 2008 14:07:17 -0400 Subject: [PATCH 019/219] latin1 -> iso-8859-1 --- core/io/io-tests.factor | 4 ++-- .../benchmark/reverse-complement/reverse-complement.factor | 6 +++--- extra/http/client/client.factor | 6 +++--- extra/http/server/server.factor | 4 ++-- extra/io/unix/launcher/launcher.factor | 2 +- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 22c942d2d9..6200bd5235 100755 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -1,5 +1,5 @@ USING: arrays io io.files kernel math parser strings system -tools.test words namespaces io.encodings.latin1 +tools.test words namespaces io.encodings.8-bit io.encodings.binary ; IN: io.tests @@ -9,7 +9,7 @@ IN: io.tests ] unit-test : ( resource -- stream ) - resource-path latin1 ; + resource-path iso-8859-1 ; [ "This is a line.\rThis is another line.\r" diff --git a/extra/benchmark/reverse-complement/reverse-complement.factor b/extra/benchmark/reverse-complement/reverse-complement.factor index 9c782e65e6..d83b720187 100755 --- a/extra/benchmark/reverse-complement/reverse-complement.factor +++ b/extra/benchmark/reverse-complement/reverse-complement.factor @@ -1,6 +1,6 @@ USING: io io.files io.streams.duplex kernel sequences sequences.private strings vectors words memoize splitting -hints unicode.case continuations io.encodings.latin1 ; +hints unicode.case continuations io.encodings.ascii ; IN: benchmark.reverse-complement MEMO: trans-map ( -- str ) @@ -32,8 +32,8 @@ HINTS: do-line vector string ; readln [ do-line (reverse-complement) ] [ show-seq ] if* ; : reverse-complement ( infile outfile -- ) - latin1 [ - swap latin1 [ + ascii [ + swap ascii [ swap [ 500000 (reverse-complement) ] with-stream diff --git a/extra/http/client/client.factor b/extra/http/client/client.factor index fc85cce3ad..233b61ea74 100755 --- a/extra/http/client/client.factor +++ b/extra/http/client/client.factor @@ -3,7 +3,7 @@ USING: assocs http kernel math math.parser namespaces sequences io io.sockets io.streams.string io.files io.timeouts strings splitting calendar continuations accessors vectors -io.encodings.latin1 io.encodings.binary fry ; +io.encodings.8-bit io.encodings.binary fry ; IN: http.client DEFER: http-request @@ -52,7 +52,7 @@ PRIVATE> : http-request ( request -- response stream ) dup request [ - dup request-addr latin1 + dup request-addr iso-8859-1 1 minutes over set-timeout [ write-request flush @@ -82,7 +82,7 @@ PRIVATE> : download-to ( url file -- ) #! Downloads the contents of a URL to a file. swap http-get-stream swap check-response - [ swap latin1 stream-copy ] with-disposal ; + [ swap iso-8859-1 stream-copy ] with-disposal ; : download ( url -- ) dup download-name download-to ; diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor index 6b3ae52730..3df21adf26 100755 --- a/extra/http/server/server.factor +++ b/extra/http/server/server.factor @@ -4,7 +4,7 @@ USING: assocs kernel namespaces io io.timeouts strings splitting threads http sequences prettyprint io.server logging calendar html.elements accessors math.parser combinators.lib tools.vocabs debugger html continuations random combinators -destructors io.encodings.latin1 fry combinators.cleave ; +destructors io.encodings.8-bit fry combinators.cleave ; IN: http.server GENERIC: call-responder ( path responder -- response ) @@ -217,7 +217,7 @@ SYMBOL: exit-continuation : httpd ( port -- ) internet-server "http.server" - latin1 [ handle-client ] with-server ; + iso-8859-1 [ handle-client ] with-server ; : httpd-main ( -- ) 8888 httpd ; diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index a1e42fddf2..8ed1c957af 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -4,7 +4,7 @@ USING: io io.backend io.launcher io.nonblocking io.unix.backend io.unix.files io.nonblocking sequences kernel namespaces math system alien.c-types debugger continuations arrays assocs combinators unix.process strings threads unix -io.unix.launcher.parser io.encodings.latin1 accessors ; +io.unix.launcher.parser accessors ; IN: io.unix.launcher ! Search unix first From e60d8a49c1e676d357f7d84aa4cc8c3a56734342 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 21 Mar 2008 15:36:49 -0500 Subject: [PATCH 020/219] add more priority constants, priority functions --- extra/windows/kernel32/kernel32.factor | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/extra/windows/kernel32/kernel32.factor b/extra/windows/kernel32/kernel32.factor index 37b833cae1..22a86818cf 100644 --- a/extra/windows/kernel32/kernel32.factor +++ b/extra/windows/kernel32/kernel32.factor @@ -189,6 +189,16 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION : FILE_MAP_WRITE 2 ; : FILE_MAP_COPY 1 ; +: THREAD_MODE_BACKGROUND_BEGIN HEX: 10000 ; inline +: THREAD_MODE_BACKGROUND_END HEX: 20000 ; inline +: THREAD_PRIORITY_ABOVE_NORMAL 1 ; inline +: THREAD_PRIORITY_BELOW_NORMAL -1 ; inline +: THREAD_PRIORITY_HIGHEST 2 ; inline +: THREAD_PRIORITY_IDLE -15 ; inline +: THREAD_PRIORITY_LOWEST -2 ; inline +: THREAD_PRIORITY_NORMAL 0 ; inline +: THREAD_PRIORITY_TIME_CRITICAL 15 ; inline + C-STRUCT: OVERLAPPED { "int" "internal" } { "int" "internal-high" } @@ -998,7 +1008,7 @@ FUNCTION: HMODULE GetModuleHandleW ( LPCWSTR lpModuleName ) ; ! FUNCTION: GetNumberOfConsoleMouseButtons ! FUNCTION: GetOEMCP FUNCTION: BOOL GetOverlappedResult ( HANDLE hFile, LPOVERLAPPED lpOverlapped, LPDWORD lpNumberOfBytesTransferred, BOOL bWait ) ; -! FUNCTION: GetPriorityClass +FUNCTION: DWORD GetPriorityClass ( HANDLE hProcess ) ; ! FUNCTION: GetPrivateProfileIntA ! FUNCTION: GetPrivateProfileIntW ! FUNCTION: GetPrivateProfileSectionA @@ -1065,8 +1075,8 @@ FUNCTION: UINT GetSystemWindowsDirectoryW ( LPTSTR lpBuffer, UINT uSize ) ; ! FUNCTION: GetThreadContext ! FUNCTION: GetThreadIOPendingFlag ! FUNCTION: GetThreadLocale -! FUNCTION: GetThreadPriority -! FUNCTION: GetThreadPriorityBoost +FUNCTION: int GetThreadPriority ( HANDLE hThread ) ; +FUNCTION: BOOL GetThreadPriorityBoost ( HANDLE hThread, PBOOL pDisablePriorityBoost ) ; ! FUNCTION: GetThreadSelectorEntry ! FUNCTION: GetThreadTimes ! FUNCTION: GetTickCount @@ -1437,9 +1447,9 @@ FUNCTION: BOOL SetHandleInformation ( HANDLE hObject, DWORD dwMask, DWORD dwFlag ! FUNCTION: SetMailslotInfo ! FUNCTION: SetMessageWaitingIndicator ! FUNCTION: SetNamedPipeHandleState -! FUNCTION: SetPriorityClass +FUNCTION: BOOL SetPriorityClass ( HANDLE hProcess, DWORD dwPriorityClass ) ; ! FUNCTION: SetProcessAffinityMask -! FUNCTION: SetProcessPriorityBoost +FUNCTION: BOOL SetProcessPriorityBoost ( HANDLE hProcess, BOOL disablePriorityBoost ) ; ! FUNCTION: SetProcessShutdownParameters ! FUNCTION: SetProcessWorkingSetSize ! FUNCTION: SetStdHandle @@ -1454,8 +1464,8 @@ FUNCTION: BOOL SetHandleInformation ( HANDLE hObject, DWORD dwMask, DWORD dwFlag ! FUNCTION: SetThreadExecutionState ! FUNCTION: SetThreadIdealProcessor ! FUNCTION: SetThreadLocale -! FUNCTION: SetThreadPriority -! FUNCTION: SetThreadPriorityBoost +FUNCTION: BOOL SetThreadPriority ( HANDLE hThread, int nPriority ) ; +FUNCTION: BOOL SetThreadPriorityBoost ( HANDLE hThread, BOOL disablePriorityBoost ) ; ! FUNCTION: SetThreadUILanguage ! FUNCTION: SetTimerQueueTimer ! FUNCTION: SetTimeZoneInformation From fae69bd0920a1a53c411ff02b720585b9183c2c8 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 21 Mar 2008 16:57:13 -0400 Subject: [PATCH 021/219] Final fix for 8-bit encodings --- core/io/encodings/encodings-docs.factor | 9 +++++---- extra/io/encodings/8-bit/CP037.TXT | 2 -- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor index 548d2cd7fc..5d1068d496 100644 --- a/core/io/encodings/encodings-docs.factor +++ b/core/io/encodings/encodings-docs.factor @@ -37,10 +37,11 @@ HELP: ( stream-in stream-out encoding -- duplex ) ARTICLE: "encodings-descriptors" "Encoding descriptors" "An encoding descriptor is something which can be used for input or output streams to encode or decode files. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:" -$nl { $vocab-link "io.encodings.utf8" } -$nl { $vocab-link "io.encodings.ascii" } -$nl { $vocab-link "io.encodings.binary" } -$nl { $vocab-link "io.encodings.utf16" } ; +{ $vocab-subsection "io.encodings.utf8" } +{ $vocab-subsection "io.encodings.ascii" } +{ $vocab-subsection "io.encodings.8-bit" } +{ $vocab-subsection "io.encodings.binary" } +{ $vocab-subsection "io.encodings.utf16" } ; ARTICLE: "encodings-protocol" "Encoding protocol" "An encoding descriptor must implement the following methods. The methods are implemented on tuple classes by instantiating the class and calling the method again." diff --git a/extra/io/encodings/8-bit/CP037.TXT b/extra/io/encodings/8-bit/CP037.TXT index 48fde2ae69..43186f7bf9 100644 --- a/extra/io/encodings/8-bit/CP037.TXT +++ b/extra/io/encodings/8-bit/CP037.TXT @@ -271,5 +271,3 @@ 0xFD 0x00D9 #LATIN CAPITAL LETTER U WITH GRAVE 0xFE 0x00DA #LATIN CAPITAL LETTER U WITH ACUTE 0xFF 0x009F #CONTROL - - \ No newline at end of file From 8d7ccf2596bfca71ed9d50849a70e4cc371d7f0a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 21 Mar 2008 17:48:01 -0500 Subject: [PATCH 022/219] Add unit test for ifte --- extra/combinators/lib/lib-tests.factor | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor index 0a08948346..ed481f72e6 100755 --- a/extra/combinators/lib/lib-tests.factor +++ b/extra/combinators/lib/lib-tests.factor @@ -46,3 +46,8 @@ IN: combinators.lib.tests [ dup array? ] [ dup vector? ] [ dup float? ] } || nip ] unit-test + + +{ 1 1 } [ + [ even? ] [ drop 1 ] [ drop 2 ] ifte +] must-infer-as From 86efc8467c1959725813b46edd6c7bc6e7ca6c89 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 21 Mar 2008 21:47:16 -0400 Subject: [PATCH 023/219] Strict wrapper for encodings --- extra/io/encodings/strict/authors.txt | 1 + extra/io/encodings/strict/strict-tests.factor | 6 ++++++ extra/io/encodings/strict/strict.factor | 18 ++++++++++++++++++ extra/io/encodings/strict/summary.txt | 1 + extra/io/encodings/strict/tags.txt | 1 + 5 files changed, 27 insertions(+) create mode 100644 extra/io/encodings/strict/authors.txt create mode 100644 extra/io/encodings/strict/strict-tests.factor create mode 100644 extra/io/encodings/strict/strict.factor create mode 100644 extra/io/encodings/strict/summary.txt create mode 100644 extra/io/encodings/strict/tags.txt diff --git a/extra/io/encodings/strict/authors.txt b/extra/io/encodings/strict/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/extra/io/encodings/strict/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/extra/io/encodings/strict/strict-tests.factor b/extra/io/encodings/strict/strict-tests.factor new file mode 100644 index 0000000000..aebb58cc30 --- /dev/null +++ b/extra/io/encodings/strict/strict-tests.factor @@ -0,0 +1,6 @@ +USING: io.encodings.strict io.encodings.ascii tools.test +arrays io.encodings.string ; +IN: io.encodings.strict.test + +[ { HEX: fffd } ] [ { 128 } ascii decode >array ] unit-test +[ { 128 } ascii strict decode ] must-fail diff --git a/extra/io/encodings/strict/strict.factor b/extra/io/encodings/strict/strict.factor new file mode 100644 index 0000000000..89c10d89cc --- /dev/null +++ b/extra/io/encodings/strict/strict.factor @@ -0,0 +1,18 @@ +! Copyright (C) 2008 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: io.encodings kernel accessors inspector ; +IN: io.encodings.strict + +TUPLE: strict code ; +C: strict strict + +TUPLE: decode-error ; +: decode-error ( -- * ) \ decode-error construct-empty throw ; +M: decode-error summary + drop "Error in decoding input stream" ; + +M: strict + code>> [ strict ] change-code ; + +M: strict decode-char + code>> decode-char dup replacement-char = [ decode-error ] when ; diff --git a/extra/io/encodings/strict/summary.txt b/extra/io/encodings/strict/summary.txt new file mode 100644 index 0000000000..9fd0fe3bf1 --- /dev/null +++ b/extra/io/encodings/strict/summary.txt @@ -0,0 +1 @@ +Strict wrapper for encodings diff --git a/extra/io/encodings/strict/tags.txt b/extra/io/encodings/strict/tags.txt new file mode 100644 index 0000000000..8e27be7d61 --- /dev/null +++ b/extra/io/encodings/strict/tags.txt @@ -0,0 +1 @@ +text From bd89b4eb12e8a88ca540717c9a125b82a070a4f4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 21 Mar 2008 23:21:02 -0500 Subject: [PATCH 024/219] mmap constants --- build-support/grovel.c | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/build-support/grovel.c b/build-support/grovel.c index 600865cf39..8422ec197c 100644 --- a/build-support/grovel.c +++ b/build-support/grovel.c @@ -12,12 +12,18 @@ #define UNIX #endif -#if (__OpenBSD__) +#if defined(__OpenBSD__) #define BSD #define OPENBSD #define UNIX #endif +#if defined(__APPLE__) + #define BSD + #define MACOSX + #define UNIX +#endif + #if defined(linux) #define LINUX #define UNIX @@ -34,6 +40,7 @@ #include #include #include + #include #include #include #endif @@ -134,6 +141,10 @@ void unix_constants() constant(EINTR); constant(EAGAIN); constant(EINPROGRESS); + constant(PROT_READ); + constant(PROT_WRITE); + constant(MAP_FILE); + constant(MAP_SHARED); } int main() { From 3d1ba04462461f7d89fe3419b166f95bd56a9a89 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 22 Mar 2008 01:21:21 -0500 Subject: [PATCH 025/219] add remove-nth --- extra/sequences/lib/lib.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index a6b6b73148..0b93552e76 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -225,3 +225,6 @@ PRIVATE> : replace ( str oldseq newseq -- str' ) H{ } 2seq>assoc substitute ; + +: remove-nth ( seq n -- seq' ) + cut-slice 1 tail-slice append ; From d967d04e4cf961af1919b55620119381c2251ef7 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sun, 23 Mar 2008 00:43:43 -0400 Subject: [PATCH 026/219] Changing 8-bit encoding names; documentation --- core/io/io-tests.factor | 2 +- extra/http/client/client.factor | 4 +- extra/http/server/server.factor | 2 +- extra/io/encodings/8-bit/8-bit-docs.factor | 91 ++++++++++++++++++++ extra/io/encodings/8-bit/8-bit-tests.factor | 10 +-- extra/io/encodings/8-bit/8-bit.factor | 36 ++++---- extra/io/encodings/strict/strict-docs.factor | 10 +++ 7 files changed, 128 insertions(+), 27 deletions(-) create mode 100644 extra/io/encodings/8-bit/8-bit-docs.factor create mode 100644 extra/io/encodings/strict/strict-docs.factor diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 91e51f25b0..abae63c82b 100755 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -9,7 +9,7 @@ IN: io.tests ] unit-test : ( resource -- stream ) - resource-path iso-8859-1 ; + resource-path latin1 ; [ "This is a line.\rThis is another line.\r" diff --git a/extra/http/client/client.factor b/extra/http/client/client.factor index 233b61ea74..e4bbf0279f 100755 --- a/extra/http/client/client.factor +++ b/extra/http/client/client.factor @@ -52,7 +52,7 @@ PRIVATE> : http-request ( request -- response stream ) dup request [ - dup request-addr iso-8859-1 + dup request-addr latin1 1 minutes over set-timeout [ write-request flush @@ -82,7 +82,7 @@ PRIVATE> : download-to ( url file -- ) #! Downloads the contents of a URL to a file. swap http-get-stream swap check-response - [ swap iso-8859-1 stream-copy ] with-disposal ; + [ swap latin1 stream-copy ] with-disposal ; : download ( url -- ) dup download-name download-to ; diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor index 3df21adf26..81201dd3fe 100755 --- a/extra/http/server/server.factor +++ b/extra/http/server/server.factor @@ -217,7 +217,7 @@ SYMBOL: exit-continuation : httpd ( port -- ) internet-server "http.server" - iso-8859-1 [ handle-client ] with-server ; + latin1 [ handle-client ] with-server ; : httpd-main ( -- ) 8888 httpd ; diff --git a/extra/io/encodings/8-bit/8-bit-docs.factor b/extra/io/encodings/8-bit/8-bit-docs.factor new file mode 100644 index 0000000000..ff21094ba1 --- /dev/null +++ b/extra/io/encodings/8-bit/8-bit-docs.factor @@ -0,0 +1,91 @@ +! Copyright (C) 2008 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup io.encodings.8-bit.private ; +IN: io.encodings.8-bit + +ARTICLE: "io.encodings.8-bit" "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:" +{ $subsection latin1 } +{ $subsection latin2 } +{ $subsection latin3 } +{ $subsection latin4 } +{ $subsection latin/cyrillic } +{ $subsection latin/arabic } +{ $subsection latin/greek } +{ $subsection latin/hebrew } +{ $subsection latin5 } +{ $subsection latin6 } +{ $subsection latin/thai } +{ $subsection latin7 } +{ $subsection latin8 } +{ $subsection latin9 } +{ $subsection latin10 } +{ $subsection koi8-r } +{ $subsection windows-1252 } +{ $subsection ebcdic } +{ $subsection mac-roman } +"Other encodings can be defined using the following utility" +{ $subsection define-8-bit-encoding } ; + +ABOUT: "io.encodings.8-bit" + +HELP: define-8-bit-encoding +{ $values { "name" "a string" } { "path" "a path" } } +{ $description "Creates a new encoding with the given name, using the resource file at the path to tell how to encode and decode octets. The resource file should be in a similar format to those at ftp://ftp.unicode.org/Public/MAPPINGS/ISO8859/" } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; + +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." } ; diff --git a/extra/io/encodings/8-bit/8-bit-tests.factor b/extra/io/encodings/8-bit/8-bit-tests.factor index 5dbe28cb14..24cd4137d4 100644 --- a/extra/io/encodings/8-bit/8-bit-tests.factor +++ b/extra/io/encodings/8-bit/8-bit-tests.factor @@ -1,10 +1,10 @@ USING: io.encodings.string io.encodings.8-bit tools.test strings arrays ; IN: io.encodings.8-bit.tests -[ B{ CHAR: f CHAR: o CHAR: o } ] [ "foo" iso-8859-1 encode ] unit-test -[ { 256 } >string iso-8859-1 encode ] must-fail -[ B{ 255 } ] [ { 255 } iso-8859-1 encode ] unit-test +[ B{ CHAR: f CHAR: o CHAR: o } ] [ "foo" latin1 encode ] unit-test +[ { 256 } >string latin1 encode ] must-fail +[ B{ 255 } ] [ { 255 } latin1 encode ] unit-test -[ "bar" ] [ "bar" iso-8859-1 decode ] unit-test -[ { CHAR: b 233 CHAR: r } ] [ { CHAR: b 233 CHAR: r } iso-8859-1 decode >array ] unit-test +[ "bar" ] [ "bar" latin1 decode ] unit-test +[ { CHAR: b 233 CHAR: r } ] [ { CHAR: b 233 CHAR: r } latin1 decode >array ] unit-test [ { HEX: fffd HEX: 20AC } ] [ { HEX: 81 HEX: 80 } windows-1252 decode >array ] unit-test diff --git a/extra/io/encodings/8-bit/8-bit.factor b/extra/io/encodings/8-bit/8-bit.factor index 2cc6b2e57c..c041e699a2 100644 --- a/extra/io/encodings/8-bit/8-bit.factor +++ b/extra/io/encodings/8-bit/8-bit.factor @@ -9,21 +9,21 @@ IN: io.encodings.8-bit hashtable ; : parse-file ( file-name -- byte>ch ch>byte ) - full-path ascii file-lines process-contents + ascii file-lines process-contents [ byte>ch ] [ ch>byte ] bi ; : empty-tuple-class ( string -- class ) @@ -85,9 +85,9 @@ IN: io.encodings.8-bit : 8-bit-methods ( class byte>ch ch>byte -- ) >r over r> define-encode-char define-decode-char ; -: define-8-bit-encoding ( tuple-name file-name -- ) +: define-8-bit-encoding ( name path -- ) >r empty-tuple-class r> parse-file 8-bit-methods ; PRIVATE> -[ mappings [ define-8-bit-encoding ] assoc-each ] with-compilation-unit +[ mappings [ full-path define-8-bit-encoding ] assoc-each ] with-compilation-unit diff --git a/extra/io/encodings/strict/strict-docs.factor b/extra/io/encodings/strict/strict-docs.factor new file mode 100644 index 0000000000..e8a4f18179 --- /dev/null +++ b/extra/io/encodings/strict/strict-docs.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2008 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup ; +IN: io.encodings.strict + +HELP: strict ( encoding -- strict-encoding ) +{ $values { "encoding" "an encoding descriptor" } { "strict-encoding" "a strict encoding descriptor" } } +{ $description "Makes an encoding strict, that is, in the presence of a malformed code point, an error is thrown. Note that the existence of a replacement character in a file (U+FFFD) also throws an error." } ; + +ABOUT: strict From 78886019496045a8436df8c6f2c6777bc1396144 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sun, 23 Mar 2008 00:58:17 -0400 Subject: [PATCH 027/219] Change to encodings docs --- core/io/encodings/encodings-docs.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor index d5bdf24dc0..0f43bba0db 100644 --- a/core/io/encodings/encodings-docs.factor +++ b/core/io/encodings/encodings-docs.factor @@ -10,6 +10,7 @@ ARTICLE: "io.encodings" "I/O encodings" { $subsection "encodings-protocol" } ; ARTICLE: "encodings-constructors" "Constructing an encoded stream" +"The following words can be used to construct encoded streams. Note that they are usually not used directly, but rather by the stream constructors themselves." { $subsection } { $subsection } { $subsection } ; @@ -47,7 +48,7 @@ ARTICLE: "encodings-protocol" "Encoding protocol" "An encoding descriptor must implement the following methods. The methods are implemented on tuple classes by instantiating the class and calling the method again." { $subsection decode-char } { $subsection encode-char } -"The following methods are optional:" +"Optionally, an encoding can override the constructor words:" { $subsection } { $subsection } ; From 598127c0e2d1ca6d72fdbf0551c76ff4a0a306a7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 24 Mar 2008 12:02:10 -0500 Subject: [PATCH 028/219] add new stack effects library --- extra/new-effects/new-effects.factor | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 extra/new-effects/new-effects.factor diff --git a/extra/new-effects/new-effects.factor b/extra/new-effects/new-effects.factor new file mode 100644 index 0000000000..dbb7b850d0 --- /dev/null +++ b/extra/new-effects/new-effects.factor @@ -0,0 +1,17 @@ +USING: assocs kernel sequences ; +IN: new-effects + +: new-nth ( seq n -- elt ) + swap nth ; + +: new-set-nth ( seq obj n -- seq ) + pick set-nth ; + +: new-at ( assoc key -- elt ) + swap at ; + +: new-at* ( assoc key -- elt ? ) + swap at* ; + +: new-set-at ( assoc value key -- assoc ) + pick set-at ; From c5cc14de917a420876fe8609872b91f5c12b3641 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 24 Mar 2008 12:02:57 -0500 Subject: [PATCH 029/219] inline new-effects use new-effects for mersenne-twister --- extra/new-effects/new-effects.factor | 10 +++++----- extra/random/mersenne-twister/mersenne-twister.factor | 5 +---- 2 files changed, 6 insertions(+), 9 deletions(-) diff --git a/extra/new-effects/new-effects.factor b/extra/new-effects/new-effects.factor index dbb7b850d0..f073ccadd3 100644 --- a/extra/new-effects/new-effects.factor +++ b/extra/new-effects/new-effects.factor @@ -2,16 +2,16 @@ USING: assocs kernel sequences ; IN: new-effects : new-nth ( seq n -- elt ) - swap nth ; + swap nth ; inline : new-set-nth ( seq obj n -- seq ) - pick set-nth ; + pick set-nth ; inline : new-at ( assoc key -- elt ) - swap at ; + swap at ; inline : new-at* ( assoc key -- elt ? ) - swap at* ; + swap at* ; inline : new-set-at ( assoc value key -- assoc ) - pick set-at ; + pick set-at ; inline diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index bf2ff78f2d..ed515716e0 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -4,14 +4,11 @@ ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c USING: arrays kernel math namespaces sequences system init -accessors math.ranges combinators.cleave random ; +accessors math.ranges combinators.cleave random new-effects ; IN: random.mersenne-twister Date: Mon, 24 Mar 2008 17:19:22 -0500 Subject: [PATCH 030/219] fix bug in find-all-files --- extra/io/paths/paths.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/io/paths/paths.factor b/extra/io/paths/paths.factor index 6c73669e9f..dad1087022 100755 --- a/extra/io/paths/paths.factor +++ b/extra/io/paths/paths.factor @@ -44,7 +44,7 @@ TUPLE: directory-iterator path bfs queue ; : find-all-files ( path bfs? quot -- paths ) >r r> - pusher >r iterate-directory drop r> ; inline + pusher >r [ f ] compose iterate-directory drop r> ; inline : recursive-directory ( path bfs? -- paths ) [ ] accumulator >r each-file r> ; From b68e79726ffee45639d7f0b46d2f4758084fac32 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 24 Mar 2008 17:20:42 -0500 Subject: [PATCH 031/219] move priority bindings to extra/unix --- extra/unix/unix.factor | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index 09d77fee11..8953b638f6 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -102,6 +102,17 @@ FUNCTION: int utimes ( char* path, timeval[2] times ) ; FUNCTION: int kill ( pid_t pid, int sig ) ; +: PRIO_PROCESS 0 ; inline +: PRIO_PGRP 1 ; inline +: PRIO_USER 2 ; inline + +: PRIO_MIN -20 ; inline +: PRIO_MAX 20 ; inline + +! which/who = 0 for current process +FUNCTION: int getpriority ( int which, int who ) ; +FUNCTION: int setpriority ( int which, int who, int prio ) ; + ! Flags for waitpid : WNOHANG 1 ; inline From 1ff27e7de5f42914217cc1d2075ac1273143a406 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 24 Mar 2008 17:25:03 -0500 Subject: [PATCH 032/219] rename process to priority --- extra/io/process/process.factor | 17 +++++++++++++++++ extra/io/unix/process/process.factor | 19 +++++++++++++++++++ extra/io/windows/process/priority.factor | 8 ++++++++ extra/io/windows/process/process.factor | 8 ++++++++ 4 files changed, 52 insertions(+) create mode 100644 extra/io/process/process.factor create mode 100644 extra/io/unix/process/process.factor create mode 100644 extra/io/windows/process/priority.factor create mode 100644 extra/io/windows/process/process.factor diff --git a/extra/io/process/process.factor b/extra/io/process/process.factor new file mode 100644 index 0000000000..8a7c5b1a11 --- /dev/null +++ b/extra/io/process/process.factor @@ -0,0 +1,17 @@ +USING: io.backend kernel ; +IN: io.priority + +SYMBOL: +lowest-priority+ +SYMBOL: +low-priority+ +SYMBOL: +normal-priority+ +SYMBOL: +high-priority+ +SYMBOL: +highest-priority+ + +HOOK: current-priority io-backend ( -- symbol ) +HOOK: set-current-priority io-backend ( symbol -- ) +HOOK: priority-values ( -- assoc ) + +: lookup-priority ( symbol -- n ) + priority-values at ; + +HOOK: get-process-list io-backend ( -- assoc ) diff --git a/extra/io/unix/process/process.factor b/extra/io/unix/process/process.factor new file mode 100644 index 0000000000..00df6b6f52 --- /dev/null +++ b/extra/io/unix/process/process.factor @@ -0,0 +1,19 @@ +USING: alien.syntax kernel io.process io.unix.backend +unix ; +IN: io.unix.process + +M: unix-io current-priority ( -- n ) + clear_err_no + 0 0 getpriority dup -1 = [ check-errno ] when ; + +M: unix-io set-current-priority ( n -- ) + 0 0 rot setpriority io-error ; + +M: unix-io priority-values ( -- assoc ) + { + { +lowest-priority+ 20 } + { +low-priority+ 10 } + { +normal-priority+ 0 } + { +high-priority+ -10 } + { +highest-priority+ -20 } + } ; diff --git a/extra/io/windows/process/priority.factor b/extra/io/windows/process/priority.factor new file mode 100644 index 0000000000..f0ca04fd8a --- /dev/null +++ b/extra/io/windows/process/priority.factor @@ -0,0 +1,8 @@ +USING: kernel ; +IN: io.windows.process + +M: windows-io current-priority ( -- n ) + ; + +M: windows-io set-current-priority ( n -- ) + ; diff --git a/extra/io/windows/process/process.factor b/extra/io/windows/process/process.factor new file mode 100644 index 0000000000..f0ca04fd8a --- /dev/null +++ b/extra/io/windows/process/process.factor @@ -0,0 +1,8 @@ +USING: kernel ; +IN: io.windows.process + +M: windows-io current-priority ( -- n ) + ; + +M: windows-io set-current-priority ( n -- ) + ; From fd0d489543d8a577975aba46a1db46fa3c55d0af Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 24 Mar 2008 17:25:19 -0500 Subject: [PATCH 033/219] finish rename process to priority --- extra/io/priority/priority.factor | 5 ----- extra/io/unix/priority/priority.factor | 21 --------------------- extra/io/unix/unix.factor | 2 +- extra/io/windows/process/priority.factor | 8 -------- 4 files changed, 1 insertion(+), 35 deletions(-) delete mode 100644 extra/io/priority/priority.factor delete mode 100644 extra/io/unix/priority/priority.factor delete mode 100644 extra/io/windows/process/priority.factor diff --git a/extra/io/priority/priority.factor b/extra/io/priority/priority.factor deleted file mode 100644 index 0790563072..0000000000 --- a/extra/io/priority/priority.factor +++ /dev/null @@ -1,5 +0,0 @@ -USING: io.backend kernel ; -IN: io.priority - -HOOK: get-priority io-backend ( -- n ) -HOOK: set-priority io-backend ( n -- ) diff --git a/extra/io/unix/priority/priority.factor b/extra/io/unix/priority/priority.factor deleted file mode 100644 index deb801e3cf..0000000000 --- a/extra/io/unix/priority/priority.factor +++ /dev/null @@ -1,21 +0,0 @@ -USING: alien.syntax kernel io.priority io.unix.backend -unix ; -IN: io.unix.priority - -: PRIO_PROCESS 0 ; inline -: PRIO_PGRP 1 ; inline -: PRIO_USER 2 ; inline - -: PRIO_MIN -20 ; inline -: PRIO_MAX 20 ; inline - -! which/who = 0 for current process -FUNCTION: int getpriority ( int which, int who ) ; -FUNCTION: int setpriority ( int which, int who, int prio ) ; - -M: unix-io get-priority ( -- n ) - clear_err_no - 0 0 getpriority dup -1 = [ check-errno ] when ; - -M: unix-io set-priority ( n -- ) - 0 0 rot setpriority io-error ; diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor index bd58761a5b..d1c0db72f4 100755 --- a/extra/io/unix/unix.factor +++ b/extra/io/unix/unix.factor @@ -1,5 +1,5 @@ USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts -io.unix.launcher io.unix.mmap io.backend io.unix.priority +io.unix.launcher io.unix.mmap io.backend io.unix.process combinators namespaces system vocabs.loader sequences ; "io.unix." os append require diff --git a/extra/io/windows/process/priority.factor b/extra/io/windows/process/priority.factor deleted file mode 100644 index f0ca04fd8a..0000000000 --- a/extra/io/windows/process/priority.factor +++ /dev/null @@ -1,8 +0,0 @@ -USING: kernel ; -IN: io.windows.process - -M: windows-io current-priority ( -- n ) - ; - -M: windows-io set-current-priority ( n -- ) - ; From 99b9ab367bc330969fa055e504da1f2652ac4e70 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Mar 2008 18:02:39 -0500 Subject: [PATCH 034/219] Move priority code to io.launcher --- extra/io/launcher/launcher-docs.factor | 11 +++++++++++ extra/io/launcher/launcher.factor | 9 ++++++++- extra/io/process/process.factor | 17 ----------------- extra/io/unix/launcher/launcher.factor | 19 +++++++++++++++++-- extra/io/unix/process/process.factor | 19 ------------------- extra/io/windows/process/process.factor | 8 -------- extra/unix/process/process.factor | 5 ++++- 7 files changed, 40 insertions(+), 48 deletions(-) delete mode 100644 extra/io/process/process.factor delete mode 100644 extra/io/unix/process/process.factor delete mode 100644 extra/io/windows/process/process.factor diff --git a/extra/io/launcher/launcher-docs.factor b/extra/io/launcher/launcher-docs.factor index 7fdd22c8a5..640801234b 100755 --- a/extra/io/launcher/launcher-docs.factor +++ b/extra/io/launcher/launcher-docs.factor @@ -33,6 +33,17 @@ $nl { "a file stream or a socket - the stream is connected to the given Factor stream, which cannot be used again from within Factor and must be closed after the process has been started" } } ; +ARTICLE: "io.launcher.priority" "Setting process priority" +"The priority of the child process can be set by storing one of the below symbols in the " { $snippet "priority" } " slot of a " { $link process } " tuple:" +{ $list + { $link +lowest-priority+ } + { $link +low-priority+ } + { $link +normal-priority+ } + { $link +high-priority+ } + { $link +highest-priority+ } +} +"The default value is " { $link f } ", which denotes that the child process should inherit the current process priority." ; + HELP: +closed+ { $description "Possible value for the " { $snippet "stdin" } ", " { $snippet "stdout" } ", and " { $snippet "stderr" } " slots of a " { $link process } "." } ; diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index 9c7d64934e..ac8dc15661 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -6,7 +6,6 @@ init threads continuations math io.encodings io.streams.duplex io.nonblocking accessors ; IN: io.launcher - TUPLE: process command @@ -19,6 +18,8 @@ stdin stdout stderr +priority + timeout handle status @@ -32,6 +33,12 @@ SYMBOL: +prepend-environment+ SYMBOL: +replace-environment+ SYMBOL: +append-environment+ +SYMBOL: +lowest-priority+ +SYMBOL: +low-priority+ +SYMBOL: +normal-priority+ +SYMBOL: +high-priority+ +SYMBOL: +highest-priority+ + : ( -- process ) process construct-empty H{ } clone >>environment diff --git a/extra/io/process/process.factor b/extra/io/process/process.factor deleted file mode 100644 index 8a7c5b1a11..0000000000 --- a/extra/io/process/process.factor +++ /dev/null @@ -1,17 +0,0 @@ -USING: io.backend kernel ; -IN: io.priority - -SYMBOL: +lowest-priority+ -SYMBOL: +low-priority+ -SYMBOL: +normal-priority+ -SYMBOL: +high-priority+ -SYMBOL: +highest-priority+ - -HOOK: current-priority io-backend ( -- symbol ) -HOOK: set-current-priority io-backend ( symbol -- ) -HOOK: priority-values ( -- assoc ) - -: lookup-priority ( symbol -- n ) - priority-values at ; - -HOOK: get-process-list io-backend ( -- assoc ) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 8ed1c957af..e16ecde6fa 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -16,6 +16,17 @@ USE: unix : assoc>env ( assoc -- env ) [ "=" swap 3append ] { } assoc>map ; +: setup-priority ( process -- process ) + dup priority>> [ + H{ + { +lowest-priority+ 20 } + { +low-priority+ 10 } + { +normal-priority+ 0 } + { +high-priority+ -10 } + { +highest-priority+ -20 } + } at set-priority + ] when* ; + : redirect-fd ( oldfd fd -- ) 2dup = [ 2drop ] [ dupd dup2 io-error close ] if ; @@ -47,11 +58,15 @@ USE: unix : setup-redirection ( process -- process ) dup stdin>> ?closed read-flags 0 redirect dup stdout>> ?closed write-flags 1 redirect - dup stderr>> dup +stdout+ eq? - [ drop 1 2 dup2 io-error ] [ ?closed write-flags 2 redirect ] if ; + dup stderr>> dup +stdout+ eq? [ + drop 1 2 dup2 io-error + ] [ + ?closed write-flags 2 redirect + ] if ; : spawn-process ( process -- * ) [ + setup-priority setup-redirection dup pass-environment? [ dup get-environment set-os-envs diff --git a/extra/io/unix/process/process.factor b/extra/io/unix/process/process.factor deleted file mode 100644 index 00df6b6f52..0000000000 --- a/extra/io/unix/process/process.factor +++ /dev/null @@ -1,19 +0,0 @@ -USING: alien.syntax kernel io.process io.unix.backend -unix ; -IN: io.unix.process - -M: unix-io current-priority ( -- n ) - clear_err_no - 0 0 getpriority dup -1 = [ check-errno ] when ; - -M: unix-io set-current-priority ( n -- ) - 0 0 rot setpriority io-error ; - -M: unix-io priority-values ( -- assoc ) - { - { +lowest-priority+ 20 } - { +low-priority+ 10 } - { +normal-priority+ 0 } - { +high-priority+ -10 } - { +highest-priority+ -20 } - } ; diff --git a/extra/io/windows/process/process.factor b/extra/io/windows/process/process.factor deleted file mode 100644 index f0ca04fd8a..0000000000 --- a/extra/io/windows/process/process.factor +++ /dev/null @@ -1,8 +0,0 @@ -USING: kernel ; -IN: io.windows.process - -M: windows-io current-priority ( -- n ) - ; - -M: windows-io set-current-priority ( n -- ) - ; diff --git a/extra/unix/process/process.factor b/extra/unix/process/process.factor index 6fdc8e358b..c9612c4384 100755 --- a/extra/unix/process/process.factor +++ b/extra/unix/process/process.factor @@ -33,4 +33,7 @@ IN: unix.process fork dup io-error dup zero? -roll swap curry if ; inline : wait-for-pid ( pid -- status ) - 0 [ 0 waitpid drop ] keep *int WEXITSTATUS ; \ No newline at end of file + 0 [ 0 waitpid drop ] keep *int WEXITSTATUS ; + +: set-priority ( n -- ) + 0 0 rot setpriority io-error ; \ No newline at end of file From 09d8c8eb88b86f6cea48ab68662484d2f625fd85 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Mar 2008 19:47:30 -0500 Subject: [PATCH 035/219] Launcher documentation --- extra/io/launcher/launcher-docs.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/extra/io/launcher/launcher-docs.factor b/extra/io/launcher/launcher-docs.factor index 640801234b..0f6ca3a2c9 100755 --- a/extra/io/launcher/launcher-docs.factor +++ b/extra/io/launcher/launcher-docs.factor @@ -227,6 +227,7 @@ ARTICLE: "io.launcher" "Operating system processes" { $subsection "io.launcher.detached" } { $subsection "io.launcher.environment" } { $subsection "io.launcher.redirection" } +{ $subsection "io.launcher.priority" } { $subsection "io.launcher.timeouts" } ; ABOUT: "io.launcher" From 8d7367674c42eaadb26d3883bb2fca17e52c2dfb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Mar 2008 19:52:21 -0500 Subject: [PATCH 036/219] Class algebra refactoring --- core/bootstrap/image/image.factor | 6 +- core/bootstrap/primitives.factor | 12 +- core/classes/algebra/algebra-docs.factor | 55 ++++ core/classes/algebra/algebra-tests.factor | 201 ++++++++++++++ core/classes/algebra/algebra.factor | 233 ++++++++++++++++ core/classes/classes-docs.factor | 82 +----- core/classes/classes-tests.factor | 85 +----- core/classes/classes.factor | 257 +++--------------- core/generator/registers/registers.factor | 21 +- core/generic/generic-docs.factor | 6 +- core/generic/generic-tests.factor | 4 +- core/generic/generic.factor | 4 +- core/generic/math/math.factor | 8 +- core/generic/standard/standard.factor | 2 +- core/inference/class/class.factor | 11 +- core/optimizer/control/control.factor | 4 +- core/optimizer/inlining/inlining.factor | 10 +- core/optimizer/known-words/known-words.factor | 9 +- core/optimizer/math/math.factor | 7 +- .../pattern-match/pattern-match.factor | 2 +- core/tuples/tuples-tests.factor | 11 +- extra/tools/deploy/shaker/shaker.factor | 8 +- 22 files changed, 593 insertions(+), 445 deletions(-) create mode 100755 core/classes/algebra/algebra-docs.factor create mode 100755 core/classes/algebra/algebra-tests.factor create mode 100755 core/classes/algebra/algebra.factor mode change 100644 => 100755 core/optimizer/pattern-match/pattern-match.factor diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 52a2496755..6aa4b9212d 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -348,8 +348,10 @@ M: curry ' : emit-global ( -- ) [ { - dictionary source-files - typemap builtins class builtins set +init-caches ! Vocabulary for slot accessors "accessors" create-vocab drop @@ -93,11 +97,6 @@ call "vectors.private" } [ create-vocab drop ] each -H{ } clone source-files set -H{ } clone update-map set -H{ } clone class define-builtin-slots ; -H{ } clone typemap set -num-types get f builtins set - ! Forward definitions "object" "kernel" create t "class" set-word-prop "object" "kernel" create union-class "metaclass" set-word-prop diff --git a/core/classes/algebra/algebra-docs.factor b/core/classes/algebra/algebra-docs.factor new file mode 100755 index 0000000000..c21098916d --- /dev/null +++ b/core/classes/algebra/algebra-docs.factor @@ -0,0 +1,55 @@ +USING: help.markup help.syntax kernel classes ; +IN: classes.algebra + +ARTICLE: "class-operations" "Class operations" +"Set-theoretic operations on classes:" +{ $subsection class< } +{ $subsection class-and } +{ $subsection class-or } +{ $subsection classes-intersect? } +"Topological sort:" +{ $subsection sort-classes } +{ $subsection min-class } +"Low-level implementation detail:" +{ $subsection class-types } +{ $subsection flatten-class } +{ $subsection flatten-builtin-class } +{ $subsection class-types } +{ $subsection class-tags } ; + +HELP: flatten-builtin-class +{ $values { "class" class } { "assoc" "an assoc whose keys are classes" } } +{ $description "Outputs a set of tuple classes whose union is the smallest cover of " { $snippet "class" } " intersected with " { $link tuple } "." } ; + +HELP: flatten-class +{ $values { "class" class } { "assoc" "an assoc whose keys are classes" } } +{ $description "Outputs a set of builtin and tuple classes whose union is the smallest cover of " { $snippet "class" } "." } ; + +HELP: class-types +{ $values { "class" class } { "seq" "an increasing sequence of integers" } } +{ $description "Outputs a sequence of builtin type numbers whose instances can possibly be instances of the given class." } ; + +HELP: class< +{ $values { "class1" "a class" } { "class2" "a class" } { "?" "a boolean" } } +{ $description "Tests if all instances of " { $snippet "class1" } " are also instances of " { $snippet "class2" } "." } +{ $notes "Classes are partially ordered. This means that if " { $snippet "class1 <= class2" } " and " { $snippet "class2 <= class1" } ", then " { $snippet "class1 = class2" } ". Also, if " { $snippet "class1 <= class2" } " and " { $snippet "class2 <= class3" } ", then " { $snippet "class1 <= class3" } "." } ; + +HELP: sort-classes +{ $values { "seq" "a sequence of class" } { "newseq" "a new seqence of classes" } } +{ $description "Outputs a topological sort of a sequence of classes. Larger classes come before their subclasses." } ; + +HELP: class-or +{ $values { "class1" class } { "class2" class } { "class" class } } +{ $description "Outputs the smallest anonymous class containing both " { $snippet "class1" } " and " { $snippet "class2" } "." } ; + +HELP: class-and +{ $values { "class1" class } { "class2" class } { "class" class } } +{ $description "Outputs the largest anonymous class contained in both " { $snippet "class1" } " and " { $snippet "class2" } "." } ; + +HELP: classes-intersect? +{ $values { "class1" class } { "class2" class } { "?" "a boolean" } } +{ $description "Tests if two classes have a non-empty intersection. If the intersection is empty, no object can be an instance of both classes at once." } ; + +HELP: min-class +{ $values { "class" class } { "seq" "a sequence of class words" } { "class/f" "a class word or " { $link f } } } +{ $description "If all classes in " { $snippet "seq" } " that intersect " { $snippet "class" } " are subtypes of " { $snippet "class" } ", outputs the last such element of " { $snippet "seq" } ". If any conditions fail to hold, outputs " { $link f } "." } ; diff --git a/core/classes/algebra/algebra-tests.factor b/core/classes/algebra/algebra-tests.factor new file mode 100755 index 0000000000..24a18559fe --- /dev/null +++ b/core/classes/algebra/algebra-tests.factor @@ -0,0 +1,201 @@ +IN: classes.algebra.tests +USING: alien arrays definitions generic assocs hashtables io +kernel math namespaces parser prettyprint sequences strings +tools.test vectors words quotations classes classes.algebra +classes.private classes.union classes.mixin classes.predicate +vectors definitions source-files compiler.units growable +random inference effects ; + +: class= [ class< ] 2keep swap class< and ; + +: class-and* >r class-and r> class= ; + +: class-or* >r class-or r> class= ; + +[ t ] [ object object object class-and* ] unit-test +[ t ] [ fixnum object fixnum class-and* ] unit-test +[ t ] [ object fixnum fixnum class-and* ] unit-test +[ t ] [ fixnum fixnum fixnum class-and* ] unit-test +[ t ] [ fixnum integer fixnum class-and* ] unit-test +[ t ] [ integer fixnum fixnum class-and* ] unit-test + +[ t ] [ vector fixnum null class-and* ] unit-test +[ t ] [ number object number class-and* ] unit-test +[ t ] [ object number number class-and* ] unit-test +[ t ] [ slice reversed null class-and* ] unit-test +[ t ] [ general-t \ f null class-and* ] unit-test +[ t ] [ general-t \ f object class-or* ] unit-test + +TUPLE: first-one ; +TUPLE: second-one ; +UNION: both first-one union-class ; + +[ t ] [ both tuple classes-intersect? ] unit-test +[ t ] [ vector virtual-sequence null class-and* ] unit-test +[ f ] [ vector virtual-sequence classes-intersect? ] unit-test + +[ t ] [ number vector class-or sequence classes-intersect? ] unit-test + +[ f ] [ number vector class-and sequence classes-intersect? ] unit-test + +[ t ] [ \ fixnum \ integer class< ] unit-test +[ t ] [ \ fixnum \ fixnum class< ] unit-test +[ f ] [ \ integer \ fixnum class< ] unit-test +[ t ] [ \ integer \ object class< ] unit-test +[ f ] [ \ integer \ null class< ] unit-test +[ t ] [ \ null \ object class< ] unit-test + +[ t ] [ \ generic \ word class< ] unit-test +[ f ] [ \ word \ generic class< ] unit-test + +[ f ] [ \ reversed \ slice class< ] unit-test +[ f ] [ \ slice \ reversed class< ] unit-test + +PREDICATE: word no-docs "documentation" word-prop not ; + +UNION: no-docs-union no-docs integer ; + +[ t ] [ no-docs no-docs-union class< ] unit-test +[ f ] [ no-docs-union no-docs class< ] unit-test + +TUPLE: a ; +TUPLE: b ; +UNION: c a b ; + +[ t ] [ \ c \ tuple class< ] unit-test +[ f ] [ \ tuple \ c class< ] unit-test + +[ t ] [ \ tuple-class \ class class< ] unit-test +[ f ] [ \ class \ tuple-class class< ] unit-test + +TUPLE: delegate-clone ; + +[ t ] [ \ null \ delegate-clone class< ] unit-test +[ f ] [ \ object \ delegate-clone class< ] unit-test +[ f ] [ \ object \ delegate-clone class< ] unit-test +[ t ] [ \ delegate-clone \ tuple class< ] unit-test +[ f ] [ \ tuple \ delegate-clone class< ] unit-test + +TUPLE: a1 ; +TUPLE: b1 ; +TUPLE: c1 ; + +UNION: x1 a1 b1 ; +UNION: y1 a1 c1 ; +UNION: z1 b1 c1 ; + +[ f ] [ z1 x1 y1 class-and class< ] unit-test + +[ t ] [ x1 y1 class-and a1 class< ] unit-test + +[ f ] [ y1 z1 class-and x1 classes-intersect? ] unit-test + +[ f ] [ b1 c1 class-or a1 b1 class-or a1 c1 class-and class-and class< ] unit-test + +[ t ] [ a1 b1 class-or a1 c1 class-or class-and a1 class< ] unit-test + +[ f ] [ a1 c1 class-or b1 c1 class-or class-and a1 b1 class-or classes-intersect? ] unit-test + +[ f ] [ growable hi-tag classes-intersect? ] unit-test + +[ t ] [ + growable tuple sequence class-and class< +] unit-test + +[ t ] [ + growable assoc class-and tuple class< +] unit-test + +[ t ] [ object \ f \ f class-not class-or class< ] unit-test + +[ t ] [ fixnum class-not integer class-and bignum class= ] unit-test + +[ f ] [ integer integer class-not classes-intersect? ] unit-test + +[ t ] [ array number class-not class< ] unit-test + +[ f ] [ bignum number class-not class< ] unit-test + +[ vector ] [ vector class-not class-not ] unit-test + +[ t ] [ fixnum fixnum bignum class-or class< ] unit-test + +[ f ] [ fixnum class-not integer class-and array class< ] unit-test + +[ f ] [ fixnum class-not integer class< ] unit-test + +[ f ] [ number class-not array class< ] unit-test + +[ f ] [ fixnum class-not array class< ] unit-test + +[ t ] [ number class-not integer class-not class< ] unit-test + +[ t ] [ vector array class-not class-and vector class= ] unit-test + +[ f ] [ fixnum class-not number class-and array classes-intersect? ] unit-test + +[ f ] [ fixnum class-not integer class< ] unit-test + +[ t ] [ null class-not object class= ] unit-test + +[ t ] [ object class-not null class= ] unit-test + +[ f ] [ object class-not object class= ] unit-test + +[ f ] [ null class-not null class= ] unit-test + +! Test for hangs? +: random-class classes random ; + +: random-op + { + class-and + class-or + class-not + } random ; + +10 [ + [ ] [ + 20 [ drop random-op ] map >quotation + [ infer effect-in [ random-class ] times ] keep + call + drop + ] unit-test +] times + +: random-boolean + { t f } random ; + +: boolean>class + object null ? ; + +: random-boolean-op + { + and + or + not + xor + } random ; + +: class-xor [ class-or ] 2keep class-and class-not class-and ; + +: boolean-op>class-op + { + { and class-and } + { or class-or } + { not class-not } + { xor class-xor } + } at ; + +20 [ + [ t ] [ + 20 [ drop random-boolean-op ] [ ] map-as dup . + [ infer effect-in [ drop random-boolean ] map dup . ] keep + + [ >r [ ] each r> call ] 2keep + + >r [ boolean>class ] each r> [ boolean-op>class-op ] map call object class= + + = + ] unit-test +] times diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor new file mode 100755 index 0000000000..e2206213a6 --- /dev/null +++ b/core/classes/algebra/algebra.factor @@ -0,0 +1,233 @@ +! Copyright (C) 2004, 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel classes combinators accessors sequences arrays +vectors assocs namespaces words sorting layouts math hashtables +; +IN: classes.algebra + +: 2cache ( key1 key2 assoc quot -- value ) + >r >r 2array r> [ first2 ] r> compose cache ; inline + +DEFER: (class<) + +: class< ( first second -- ? ) + class<-cache get [ (class<) ] 2cache ; + +DEFER: (class-not) + +: class-not ( class -- complement ) + class-not-cache get [ (class-not) ] cache ; + +DEFER: (classes-intersect?) ( first second -- ? ) + +: classes-intersect? ( first second -- ? ) + classes-intersect-cache get [ (classes-intersect?) ] 2cache ; + +DEFER: (class-and) + +: class-and ( first second -- class ) + class-and-cache get [ (class-and) ] 2cache ; + +DEFER: (class-or) + +: class-or ( first second -- class ) + class-or-cache get [ (class-or) ] 2cache ; + +TUPLE: anonymous-union members ; + +C: anonymous-union + +TUPLE: anonymous-intersection members ; + +C: anonymous-intersection + +TUPLE: anonymous-complement class ; + +C: anonymous-complement + +: superclass< ( first second -- ? ) + >r superclass r> class< ; + +: left-union-class< ( first second -- ? ) + >r members r> [ class< ] curry all? ; + +: right-union-class< ( first second -- ? ) + members [ class< ] with contains? ; + +: left-anonymous-union< ( first second -- ? ) + >r members>> r> [ class< ] curry all? ; + +: right-anonymous-union< ( first second -- ? ) + members>> [ class< ] with contains? ; + +: left-anonymous-intersection< ( first second -- ? ) + >r members>> r> [ class< ] curry contains? ; + +: right-anonymous-intersection< ( first second -- ? ) + members>> [ class< ] with all? ; + +: anonymous-complement< ( first second -- ? ) + [ class>> ] 2apply swap class< ; + +: (class<) ( first second -- -1/0/1 ) + { + { [ 2dup eq? ] [ 2drop t ] } + { [ dup object eq? ] [ 2drop t ] } + { [ over null eq? ] [ 2drop t ] } + { [ 2dup [ anonymous-complement? ] both? ] [ anonymous-complement< ] } + { [ over anonymous-union? ] [ left-anonymous-union< ] } + { [ over anonymous-intersection? ] [ left-anonymous-intersection< ] } + { [ over anonymous-complement? ] [ 2drop f ] } + { [ over members ] [ left-union-class< ] } + { [ dup anonymous-union? ] [ right-anonymous-union< ] } + { [ dup anonymous-intersection? ] [ right-anonymous-intersection< ] } + { [ dup anonymous-complement? ] [ class>> classes-intersect? not ] } + { [ dup members ] [ right-union-class< ] } + { [ over superclass ] [ superclass< ] } + { [ t ] [ 2drop f ] } + } cond ; + +: anonymous-union-intersect? ( first second -- ? ) + members>> [ classes-intersect? ] with contains? ; + +: anonymous-intersection-intersect? ( first second -- ? ) + members>> [ classes-intersect? ] with all? ; + +: anonymous-complement-intersect? ( first second -- ? ) + class>> class< not ; + +: union-class-intersect? ( first second -- ? ) + members [ classes-intersect? ] with contains? ; + +: tuple-class-intersect? ( first second -- ? ) + { + { [ over tuple eq? ] [ 2drop t ] } + { [ over builtin-class? ] [ 2drop f ] } + { [ over tuple-class? ] [ [ class< ] 2keep swap class< or ] } + { [ t ] [ swap classes-intersect? ] } + } cond ; + +: builtin-class-intersect? ( first second -- ? ) + { + { [ 2dup eq? ] [ 2drop t ] } + { [ over builtin-class? ] [ 2drop f ] } + { [ t ] [ swap classes-intersect? ] } + } cond ; + +: (classes-intersect?) ( first second -- ? ) + { + { [ dup anonymous-union? ] [ anonymous-union-intersect? ] } + { [ dup anonymous-intersection? ] [ anonymous-intersection-intersect? ] } + { [ dup anonymous-complement? ] [ anonymous-complement-intersect? ] } + { [ dup tuple-class? ] [ tuple-class-intersect? ] } + { [ dup builtin-class? ] [ builtin-class-intersect? ] } + { [ dup superclass ] [ superclass classes-intersect? ] } + { [ dup members ] [ union-class-intersect? ] } + } cond ; + +: left-union-and ( first second -- class ) + >r members r> [ class-and ] curry map ; + +: right-union-and ( first second -- class ) + members [ class-and ] with map ; + +: left-anonymous-union-and ( first second -- class ) + >r members>> r> [ class-and ] curry map ; + +: right-anonymous-union-and ( first second -- class ) + members>> [ class-and ] with map ; + +: left-anonymous-intersection-and ( first second -- class ) + >r members>> r> add ; + +: right-anonymous-intersection-and ( first second -- class ) + members>> swap add ; + +: (class-and) ( first second -- class ) + { + { [ 2dup class< ] [ drop ] } + { [ 2dup swap class< ] [ nip ] } + { [ 2dup classes-intersect? not ] [ 2drop null ] } + { [ dup members ] [ right-union-and ] } + { [ dup anonymous-union? ] [ right-anonymous-union-and ] } + { [ dup anonymous-intersection? ] [ right-anonymous-intersection-and ] } + { [ over members ] [ left-union-and ] } + { [ over anonymous-union? ] [ left-anonymous-union-and ] } + { [ over anonymous-intersection? ] [ left-anonymous-intersection-and ] } + { [ t ] [ 2array ] } + } cond ; + +: left-anonymous-union-or ( first second -- class ) + >r members>> r> add ; + +: right-anonymous-union-or ( first second -- class ) + members>> swap add ; + +: (class-or) ( first second -- class ) + { + { [ 2dup class< ] [ nip ] } + { [ 2dup swap class< ] [ drop ] } + { [ dup anonymous-union? ] [ right-anonymous-union-or ] } + { [ over anonymous-union? ] [ left-anonymous-union-or ] } + { [ t ] [ 2array ] } + } cond ; + +: (class-not) ( class -- complement ) + { + { [ dup anonymous-complement? ] [ class>> ] } + { [ dup object eq? ] [ drop null ] } + { [ dup null eq? ] [ drop object ] } + { [ t ] [ ] } + } cond ; + +: largest-class ( seq -- n elt ) + dup [ + [ 2dup class< >r swap class< not r> and ] + with subset empty? + ] curry find [ "Topological sort failed" throw ] unless* ; + +: sort-classes ( seq -- newseq ) + >vector + [ dup empty? not ] + [ dup largest-class >r over delete-nth r> ] + [ ] unfold nip ; + +: min-class ( class seq -- class/f ) + [ dupd classes-intersect? ] subset dup empty? [ + 2drop f + ] [ + tuck [ class< ] with all? [ peek ] [ drop f ] if + ] if ; + +: (flatten-class) ( class -- ) + { + { [ dup tuple-class? ] [ dup set ] } + { [ dup builtin-class? ] [ dup set ] } + { [ dup members ] [ members [ (flatten-class) ] each ] } + { [ dup superclass ] [ superclass (flatten-class) ] } + { [ t ] [ drop ] } + } cond ; + +: flatten-class ( class -- assoc ) + [ (flatten-class) ] H{ } make-assoc ; + +: class-hashes ( class -- seq ) + flatten-class keys [ + dup builtin-class? + [ "type" word-prop ] [ hashcode ] if + ] map ; + +: flatten-builtin-class ( class -- assoc ) + flatten-class [ + dup tuple class< [ 2drop tuple tuple ] when + ] assoc-map ; + +: class-types ( class -- seq ) + flatten-builtin-class keys + [ "type" word-prop ] map natural-sort ; + +: class-tags ( class -- tag/f ) + class-types [ + dup num-tags get >= + [ drop object tag-number ] when + ] map prune ; diff --git a/core/classes/classes-docs.factor b/core/classes/classes-docs.factor index 1e71173153..9573de8949 100755 --- a/core/classes/classes-docs.factor +++ b/core/classes/classes-docs.factor @@ -12,21 +12,6 @@ $nl { $subsection builtin-class? } "See " { $link "type-index" } " for a list of built-in classes." ; -ARTICLE: "class-operations" "Class operations" -"Set-theoretic operations on classes:" -{ $subsection class< } -{ $subsection class-and } -{ $subsection class-or } -{ $subsection classes-intersect? } -"Topological sort:" -{ $subsection sort-classes } -{ $subsection min-class } -"Low-level implementation detail:" -{ $subsection types } -{ $subsection flatten-class } -{ $subsection flatten-builtin-class } -{ $subsection flatten-union-class } ; - ARTICLE: "class-predicates" "Class predicate words" "With a handful of exceptions, each class has a membership predicate word, named " { $snippet { $emphasis "class" } "?" } " . A quotation calling this predicate is stored in the " { $snippet "\"predicate\"" } " word property." $nl @@ -93,15 +78,9 @@ HELP: tuple-class { $class-description "The class of tuple class words." } { $examples { $example "USING: classes prettyprint ;" "TUPLE: name title first last ;" "name tuple-class? ." "t" } } ; -HELP: typemap -{ $var-description "Hashtable mapping unions to class words, used to implement " { $link class-and } " and " { $link class-or } "." } ; - HELP: builtins { $var-description "Vector mapping type numbers to builtin class words." } ; -HELP: classclass ( n -- class ) builtins get-global nth ; @@ -37,146 +54,12 @@ PREDICATE: word predicate "predicating" word-prop >boolean ; r> predicate-effect define-declared ; : superclass ( class -- super ) - "superclass" word-prop ; + #! Output f for non-classes to work with algebra code + dup class? [ "superclass" word-prop ] [ drop f ] if ; -: members ( class -- seq ) "members" word-prop ; - -: class-empty? ( class -- ? ) members dup [ empty? ] when ; - -: (flatten-union-class) ( class -- ) - dup members [ - [ (flatten-union-class) ] each - ] [ - dup set - ] ?if ; - -: flatten-union-class ( class -- assoc ) - [ (flatten-union-class) ] H{ } make-assoc ; - -: (flatten-class) ( class -- ) - { - { [ dup tuple-class? ] [ dup set ] } - { [ dup builtin-class? ] [ dup set ] } - { [ dup members ] [ members [ (flatten-class) ] each ] } - { [ dup superclass ] [ superclass (flatten-class) ] } - { [ t ] [ drop ] } - } cond ; - -: flatten-class ( class -- assoc ) - [ (flatten-class) ] H{ } make-assoc ; - -: class-hashes ( class -- seq ) - flatten-class keys [ - dup builtin-class? - [ "type" word-prop ] [ hashcode ] if - ] map ; - -: (flatten-builtin-class) ( class -- ) - { - { [ dup members ] [ members [ (flatten-builtin-class) ] each ] } - { [ dup superclass ] [ superclass (flatten-builtin-class) ] } - { [ t ] [ dup set ] } - } cond ; - -: flatten-builtin-class ( class -- assoc ) - [ (flatten-builtin-class) ] H{ } make-assoc ; - -: types ( class -- seq ) - flatten-builtin-class keys - [ "type" word-prop ] map natural-sort ; - -: class< ( class1 class2 -- ? ) swap classr superclass r> 2dup and [ (class<) ] [ 2drop f ] if ; - -: union-class< ( cls1 cls2 -- ? ) - [ flatten-union-class ] 2apply keys - [ nip [ (class<) ] with contains? ] curry assoc-all? ; - -: (class<) ( class1 class2 -- ? ) - { - { [ 2dup eq? ] [ 2drop t ] } - { [ over class-empty? ] [ 2drop t ] } - { [ 2dup superclass< ] [ 2drop t ] } - { [ 2dup [ members not ] both? ] [ 2drop f ] } - { [ t ] [ union-class< ] } - } cond ; - -: lookup-union ( classes -- class ) - typemap get at dup empty? [ drop object ] [ first ] if ; - -: lookup-tuple-union ( classes -- class ) - class-map get at dup empty? [ drop object ] [ first ] if ; - -! : (class-or) ( class class -- class ) -! [ flatten-builtin-class ] 2apply union lookup-union ; -! -! : (class-and) ( class class -- class ) -! [ flatten-builtin-class ] 2apply intersect lookup-union ; - -: class-or-fixup ( set set -- set ) - union - tuple over key? - [ [ drop tuple-class? not ] assoc-subset ] when ; - -: (class-or) ( class class -- class ) - [ flatten-class ] 2apply class-or-fixup lookup-tuple-union ; - -: (class-and) ( class class -- class ) - 2dup [ tuple swap class< ] either? [ - [ flatten-builtin-class ] 2apply - intersect lookup-union - ] [ - [ flatten-class ] 2apply - intersect lookup-tuple-union - ] if ; - -: tuple-class-and ( class1 class2 -- class ) - dupd eq? [ drop null ] unless ; - -: largest-class ( seq -- n elt ) - dup [ - [ 2dup class< >r swap class< not r> and ] - with subset empty? - ] curry find [ "Topological sort failed" throw ] unless* ; - -PRIVATE> - -: sort-classes ( seq -- newseq ) - >vector - [ dup empty? not ] - [ dup largest-class >r over delete-nth r> ] - [ ] unfold nip ; - -: class-or ( class1 class2 -- class ) - { - { [ 2dup class< ] [ nip ] } - { [ 2dup swap class< ] [ drop ] } - { [ t ] [ (class-or) ] } - } cond ; - -: class-and ( class1 class2 -- class ) - { - { [ 2dup class< ] [ drop ] } - { [ 2dup swap class< ] [ nip ] } - { [ 2dup [ tuple-class? ] both? ] [ tuple-class-and ] } - { [ t ] [ (class-and) ] } - } cond ; - -: classes-intersect? ( class1 class2 -- ? ) - class-and class-empty? not ; - -: min-class ( class seq -- class/f ) - [ dupd classes-intersect? ] subset dup empty? [ - 2drop f - ] [ - tuck [ class< ] with all? [ peek ] [ drop f ] if - ] if ; +: members ( class -- seq ) + #! Output f for non-classes to work with algebra code + dup class? [ "members" word-prop ] [ drop f ] if ; GENERIC: reset-class ( class -- ) @@ -184,36 +67,9 @@ M: word reset-class drop ; assoc ] keep - classr >r 1vector r> r> set-at - ] if ; - -: typemap+ ( class -- ) - dup flatten-builtin-class typemap get push-at ; - -: pop-at ( value key assoc -- ) - at* [ delete ] [ 2drop ] if ; - -: typemap- ( class -- ) - dup flatten-builtin-class typemap get pop-at ; - -! class-map -: class-map+ ( class -- ) - dup flatten-class class-map get push-at ; - -: class-map- ( class -- ) - dup flatten-class class-map get pop-at ; - -! Class definition -: cache-class ( class -- ) - dup typemap+ dup class-map+ dup class : define-class-props ( members superclass metaclass -- assoc ) @@ -293,14 +108,12 @@ GENERIC: update-methods ( assoc -- ) : define-class ( word members superclass metaclass -- ) #! If it was already a class, update methods after. + reset-caches define-class-props - over class? >r - over class-usages [ - uncache-classes - dupd (define-class) - ] keep cache-classes r> - [ class-usages dup update-predicates update-methods ] - [ drop ] if ; + over update-map- + dupd (define-class) + dup update-map+ + class-usages dup update-predicates update-methods ; GENERIC: class ( object -- class ) inline diff --git a/core/generator/registers/registers.factor b/core/generator/registers/registers.factor index 307e3a99f1..e03923e860 100755 --- a/core/generator/registers/registers.factor +++ b/core/generator/registers/registers.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2006, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays assocs classes classes.private combinators -cpu.architecture generator.fixup hashtables kernel layouts math -namespaces quotations sequences system vectors words effects -alien byte-arrays bit-arrays float-arrays ; +USING: arrays assocs classes classes.private classes.algebra +combinators cpu.architecture generator.fixup hashtables kernel +layouts math namespaces quotations sequences system vectors +words effects alien byte-arrays bit-arrays float-arrays ; IN: generator.registers SYMBOL: +input+ @@ -581,13 +581,14 @@ M: loc lazy-store 2drop t ] if ; +: class-tags ( class -- tag/f ) + class-types [ + dup num-tags get >= + [ drop object tag-number ] when + ] map prune ; + : class-tag ( class -- tag/f ) - dup hi-tag class< [ - drop object tag-number - ] [ - flatten-builtin-class keys - dup length 1 = [ first tag-number ] [ drop f ] if - ] if ; + class-tags dup length 1 = [ first ] [ drop f ] if ; : class-matches? ( actual expected -- ? ) { diff --git a/core/generic/generic-docs.factor b/core/generic/generic-docs.factor index b59c92c798..56de801e7a 100755 --- a/core/generic/generic-docs.factor +++ b/core/generic/generic-docs.factor @@ -1,6 +1,6 @@ -USING: help.markup help.syntax words classes definitions kernel -alien sequences math quotations generic.standard generic.math -combinators ; +USING: help.markup help.syntax words classes classes.algebra +definitions kernel alien sequences math quotations +generic.standard generic.math combinators ; IN: generic ARTICLE: "method-order" "Method precedence" diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor index 785600cfb0..853a03d184 100755 --- a/core/generic/generic-tests.factor +++ b/core/generic/generic-tests.factor @@ -1,8 +1,8 @@ USING: alien arrays definitions generic generic.standard generic.math assocs hashtables io kernel math namespaces parser prettyprint sequences strings tools.test vectors words -quotations classes continuations layouts classes.union sorting -compiler.units ; +quotations classes classes.algebra continuations layouts +classes.union sorting compiler.units ; IN: generic.tests GENERIC: foobar ( x -- y ) diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 8fe5e4921a..36ca0358b7 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: words kernel sequences namespaces assocs hashtables definitions kernel.private classes classes.private -quotations arrays vocabs effects ; +classes.algebra quotations arrays vocabs effects ; IN: generic ! Method combination protocol @@ -138,7 +138,7 @@ M: method-body forget* M: class forget* ( class -- ) dup forget-methods - dup uncache-class + dup update-map- forget-word ; M: assoc update-methods ( assoc -- ) diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor index 46f57a1629..93c89af25c 100755 --- a/core/generic/math/math.factor +++ b/core/generic/math/math.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2005, 2007 Slava Pestov. +! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays generic hashtables kernel kernel.private math namespaces sequences words quotations layouts combinators -sequences.private classes definitions ; +sequences.private classes classes.algebra definitions ; IN: generic.math PREDICATE: class math-class ( object -- ? ) @@ -16,8 +16,8 @@ PREDICATE: class math-class ( object -- ? ) : math-precedence ( class -- n ) { - { [ dup class-empty? ] [ drop { -1 -1 } ] } - { [ dup math-class? ] [ types last/first ] } + { [ dup null class< ] [ drop { -1 -1 } ] } + { [ dup math-class? ] [ class-types last/first ] } { [ t ] [ drop { 100 100 } ] } } cond ; diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index 37f72e7d95..4105a05cb1 100755 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -3,7 +3,7 @@ USING: arrays assocs kernel kernel.private slots.private math namespaces sequences vectors words quotations definitions hashtables layouts combinators sequences.private generic -classes classes.private ; +classes classes.algebra classes.private ; IN: generic.standard TUPLE: standard-combination # ; diff --git a/core/inference/class/class.factor b/core/inference/class/class.factor index 690571de98..7764fd4fd1 100755 --- a/core/inference/class/class.factor +++ b/core/inference/class/class.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays generic assocs hashtables inference kernel math namespaces sequences words parser math.intervals -effects classes inference.dataflow inference.backend -combinators ; +effects classes classes.algebra inference.dataflow +inference.backend combinators ; IN: inference.class ! Class inference @@ -88,8 +88,11 @@ M: interval-constraint apply-constraint swap interval-constraint-value intersect-value-interval ; : set-class-interval ( class value -- ) - >r "interval" word-prop dup - [ r> set-value-interval* ] [ r> 2drop ] if ; + over class? [ + over "interval" word-prop [ + >r "interval" word-prop r> set-value-interval* + ] [ 2drop ] if + ] [ 2drop ] if ; : value-class* ( value -- class ) value-classes get at object or ; diff --git a/core/optimizer/control/control.factor b/core/optimizer/control/control.factor index b04d4677ce..c108e3b1a7 100755 --- a/core/optimizer/control/control.factor +++ b/core/optimizer/control/control.factor @@ -3,8 +3,8 @@ USING: arrays generic assocs inference inference.class inference.dataflow inference.backend inference.state io kernel math namespaces sequences vectors words quotations hashtables -combinators classes generic.math continuations optimizer.def-use -optimizer.backend generic.standard ; +combinators classes classes.algebra generic.math continuations +optimizer.def-use optimizer.backend generic.standard ; IN: optimizer.control ! ! ! Rudimentary CFA diff --git a/core/optimizer/inlining/inlining.factor b/core/optimizer/inlining/inlining.factor index 04d7ab4ee5..1f3df92421 100755 --- a/core/optimizer/inlining/inlining.factor +++ b/core/optimizer/inlining/inlining.factor @@ -3,10 +3,10 @@ USING: arrays generic assocs inference inference.class inference.dataflow inference.backend inference.state io kernel math namespaces sequences vectors words quotations hashtables -combinators classes generic.math continuations optimizer.def-use -optimizer.backend generic.standard optimizer.specializers -optimizer.def-use optimizer.pattern-match generic.standard -optimizer.control kernel.private ; +combinators classes classes.algebra generic.math continuations +optimizer.def-use optimizer.backend generic.standard +optimizer.specializers optimizer.def-use optimizer.pattern-match +generic.standard optimizer.control kernel.private ; IN: optimizer.inlining : remember-inlining ( node history -- ) @@ -175,7 +175,7 @@ DEFER: (flat-length) : optimistic-inline? ( #call -- ? ) dup node-param "specializer" word-prop dup [ >r node-input-classes r> specialized-length tail* - [ types length 1 = ] all? + [ class-types length 1 = ] all? ] [ 2drop f ] if ; diff --git a/core/optimizer/known-words/known-words.factor b/core/optimizer/known-words/known-words.factor index 18c98c5115..0a3442566c 100755 --- a/core/optimizer/known-words/known-words.factor +++ b/core/optimizer/known-words/known-words.factor @@ -7,8 +7,9 @@ sequences words parser vectors strings sbufs io namespaces assocs quotations sequences.private io.binary io.crc32 io.streams.string layouts splitting math.intervals math.floats.private tuples tuples.private classes -optimizer.def-use optimizer.backend optimizer.pattern-match -optimizer.inlining float-arrays sequences.private combinators ; +classes.algebra optimizer.def-use optimizer.backend +optimizer.pattern-match optimizer.inlining float-arrays +sequences.private combinators ; ! the output of and has the class which is ! its second-to-last input @@ -89,10 +90,10 @@ optimizer.inlining float-arrays sequences.private combinators ; ! type applied to an object of a known type can be folded : known-type? ( node -- ? ) - node-class-first types length 1 number= ; + node-class-first class-types length 1 number= ; : fold-known-type ( node -- node ) - dup node-class-first types inline-literals ; + dup node-class-first class-types inline-literals ; \ type [ { [ dup known-type? ] [ fold-known-type ] } diff --git a/core/optimizer/math/math.factor b/core/optimizer/math/math.factor index 7afc177d10..349cf88f17 100755 --- a/core/optimizer/math/math.factor +++ b/core/optimizer/math/math.factor @@ -5,9 +5,10 @@ USING: alien alien.accessors arrays generic hashtables kernel assocs math math.private kernel.private sequences words parser inference.class inference.dataflow vectors strings sbufs io namespaces assocs quotations math.intervals sequences.private -combinators splitting layouts math.parser classes generic.math -optimizer.pattern-match optimizer.backend optimizer.def-use -optimizer.inlining generic.standard system ; +combinators splitting layouts math.parser classes +classes.algebra generic.math optimizer.pattern-match +optimizer.backend optimizer.def-use optimizer.inlining +generic.standard system ; { + bignum+ float+ fixnum+fast } { { { number 0 } [ drop ] } diff --git a/core/optimizer/pattern-match/pattern-match.factor b/core/optimizer/pattern-match/pattern-match.factor old mode 100644 new mode 100755 index ed78330492..0e7e801938 --- a/core/optimizer/pattern-match/pattern-match.factor +++ b/core/optimizer/pattern-match/pattern-match.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. IN: optimizer.pattern-match USING: kernel sequences inference namespaces generic -combinators classes inference.dataflow ; +combinators classes classes.algebra inference.dataflow ; ! Funny pattern matching SYMBOL: @ diff --git a/core/tuples/tuples-tests.factor b/core/tuples/tuples-tests.factor index b5076ea22b..fec3bdbc6f 100755 --- a/core/tuples/tuples-tests.factor +++ b/core/tuples/tuples-tests.factor @@ -5,9 +5,6 @@ generic.standard effects tuples tuples.private arrays vectors strings compiler.units ; IN: tuples.tests -[ t ] [ \ tuple-class \ class class< ] unit-test -[ f ] [ \ class \ tuple-class class< ] unit-test - TUPLE: rect x y w h ; : rect construct-boa ; @@ -90,12 +87,6 @@ TUPLE: delegate-clone ; [ T{ delegate-clone T{ empty f } } ] [ T{ delegate-clone T{ empty f } } clone ] unit-test -[ t ] [ \ null \ delegate-clone class< ] unit-test -[ f ] [ \ object \ delegate-clone class< ] unit-test -[ f ] [ \ object \ delegate-clone class< ] unit-test -[ t ] [ \ delegate-clone \ tuple class< ] unit-test -[ f ] [ \ tuple \ delegate-clone class< ] unit-test - ! Compiler regression [ t length ] [ no-method-object t eq? ] must-fail-with @@ -121,7 +112,7 @@ TUPLE: yo-momma ; [ [ t ] [ \ yo-momma class? ] unit-test [ ] [ \ yo-momma forget ] unit-test - [ f ] [ \ yo-momma typemap get values memq? ] unit-test + [ f ] [ \ yo-momma update-map get values memq? ] unit-test [ f ] [ \ yo-momma crossref get at ] unit-test ] with-compilation-unit diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor index 76e4a212b2..754d93d9b4 100755 --- a/extra/tools/deploy/shaker/shaker.factor +++ b/extra/tools/deploy/shaker/shaker.factor @@ -148,8 +148,12 @@ IN: tools.deploy.shaker layouts:tag-mask layouts:tag-numbers layouts:type-numbers - classes:typemap - classes:class-map + classes:class<-cache + classes:class-not-cache + classes:classes-intersect-cache + classes:class-and-cache + classes:class-or-cache + classes:update-map vocab-roots definitions:crossref compiled-crossref From 577c670631086600ea675467195325438fe1e2b8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 24 Mar 2008 20:15:42 -0500 Subject: [PATCH 037/219] Test fix --- core/optimizer/optimizer-tests.factor | 5 ++-- extra/tools/deploy/shaker/shaker.factor | 36 ++++++++++++------------- 2 files changed, 20 insertions(+), 21 deletions(-) diff --git a/core/optimizer/optimizer-tests.factor b/core/optimizer/optimizer-tests.factor index 3abccecc7f..89cea45aee 100755 --- a/core/optimizer/optimizer-tests.factor +++ b/core/optimizer/optimizer-tests.factor @@ -1,8 +1,9 @@ USING: arrays compiler.units generic hashtables inference kernel kernel.private math optimizer prettyprint sequences sbufs strings tools.test vectors words sequences.private quotations -optimizer.backend classes inference.dataflow tuples.private -continuations growable optimizer.inlining namespaces hints ; +optimizer.backend classes classes.algebra inference.dataflow +tuples.private continuations growable optimizer.inlining +namespaces hints ; IN: optimizer.tests [ H{ { 1 5 } { 3 4 } { 2 5 } } ] [ diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor index 754d93d9b4..f731f5d694 100755 --- a/extra/tools/deploy/shaker/shaker.factor +++ b/extra/tools/deploy/shaker/shaker.factor @@ -139,31 +139,29 @@ IN: tools.deploy.shaker { } { "cpu" } strip-vocab-globals % { - vocabs:dictionary - lexer-factory - vocabs:load-vocab-hook - root-cache + classes:class-and-cache + classes:class-not-cache + classes:class-or-cache + classes:class<-cache + classes:classes-intersect-cache + classes:update-map + compiled-crossref + compiler.units:recompile-hook + definitions:crossref + interactive-vocabs layouts:num-tags layouts:num-types layouts:tag-mask layouts:tag-numbers layouts:type-numbers - classes:class<-cache - classes:class-not-cache - classes:classes-intersect-cache - classes:class-and-cache - classes:class-or-cache - classes:update-map - vocab-roots - definitions:crossref - compiled-crossref - interactive-vocabs - word - compiler.units:recompile-hook - listener:listener-hook lexer-factory - classes:update-map - classes:class Date: Mon, 24 Mar 2008 20:44:39 -0500 Subject: [PATCH 038/219] Fix --- extra/io/unix/unix.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/io/unix/unix.factor b/extra/io/unix/unix.factor index d1c0db72f4..0a7fc72662 100755 --- a/extra/io/unix/unix.factor +++ b/extra/io/unix/unix.factor @@ -1,5 +1,5 @@ USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts -io.unix.launcher io.unix.mmap io.backend io.unix.process -combinators namespaces system vocabs.loader sequences ; +io.unix.launcher io.unix.mmap io.backend combinators namespaces +system vocabs.loader sequences ; "io.unix." os append require From 1c75abce235a4062b1ef4f66db53af97b5a19fa3 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 25 Mar 2008 04:40:36 -0600 Subject: [PATCH 039/219] lsys.ui: Add a '500 sleep' workaround --- extra/lsys/ui/ui.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/extra/lsys/ui/ui.factor b/extra/lsys/ui/ui.factor index 45372aec6c..c8d103a084 100644 --- a/extra/lsys/ui/ui.factor +++ b/extra/lsys/ui/ui.factor @@ -196,6 +196,8 @@ slate> handler> set-gadget-delegate handler> "L-system view" open-window +500 sleep + slate> find-gl-context 1 glGenLists >model From 8362ef09588d883934f66cb6a4febdb00f55a49e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 25 Mar 2008 13:51:09 -0500 Subject: [PATCH 040/219] fix netbsd32 --- misc/factor.sh | 2 ++ 1 file changed, 2 insertions(+) diff --git a/misc/factor.sh b/misc/factor.sh index 9d4f26fa46..a1437c67bf 100755 --- a/misc/factor.sh +++ b/misc/factor.sh @@ -90,6 +90,8 @@ set_gcc() { openbsd) ensure_program_installed egcc; CC=egcc;; netbsd) if [[ $WORD -eq 64 ]] ; then CC=/usr/pkg/gcc34/bin/gcc + else + CC=gcc fi ;; *) CC=gcc;; esac From dc22e5767b0d655847e0a9312c5817b15348629e Mon Sep 17 00:00:00 2001 From: "U-FROGGER\\erg" Date: Tue, 25 Mar 2008 14:37:17 -0500 Subject: [PATCH 041/219] add more dlls to factor.sh --- misc/factor.sh | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/misc/factor.sh b/misc/factor.sh index 9d4f26fa46..5fc8654216 100755 --- a/misc/factor.sh +++ b/misc/factor.sh @@ -346,10 +346,25 @@ maybe_download_dlls() { get_url http://factorcode.org/dlls/zlib1.dll get_url http://factorcode.org/dlls/OpenAL32.dll get_url http://factorcode.org/dlls/alut.dll + get_url http://factorcode.org/dlls/comerr32.dll + get_url http://factorcode.org/dlls/gssapi32.dll + get_url http://factorcode.org/dlls/iconv.dll + get_url http://factorcode.org/dlls/k5sprt32.dll + get_url http://factorcode.org/dlls/krb5_32.dll + get_url http://factorcode.org/dlls/libcairo-2.dll + get_url http://factorcode.org/dlls/libeay32.dll + get_url http://factorcode.org/dlls/libiconv2.dll + get_url http://factorcode.org/dlls/libintl3.dll + get_url http://factorcode.org/dlls/libpq.dll + get_url http://factorcode.org/dlls/libxml2.dll + get_url http://factorcode.org/dlls/libxslt.dll + get_url http://factorcode.org/dlls/msvcr71.dll get_url http://factorcode.org/dlls/ogg.dll + get_url http://factorcode.org/dlls/pgaevent.dll + get_url http://factorcode.org/dlls/sqlite3.dll + get_url http://factorcode.org/dlls/ssleay32.dll get_url http://factorcode.org/dlls/theora.dll get_url http://factorcode.org/dlls/vorbis.dll - get_url http://factorcode.org/dlls/sqlite3.dll chmod 777 *.dll check_ret chmod fi @@ -433,6 +448,7 @@ case "$1" in quick-update) update; refresh_image ;; update) update; update_bootstrap ;; bootstrap) get_config_info; bootstrap ;; + dlls) get_config_info; maybe_download_dlls;; net-bootstrap) get_config_info; update_boot_images; bootstrap ;; *) usage ;; esac From b13e0f7042f38814ed28166e6d11ad97b488089c Mon Sep 17 00:00:00 2001 From: erg Date: Tue, 25 Mar 2008 19:50:39 -0500 Subject: [PATCH 042/219] redo path handling --- core/io/files/files-tests.factor | 51 +++++++++ core/io/files/files.factor | 152 ++++++++++++++++--------- extra/io/unix/files/files-tests.factor | 6 + 3 files changed, 155 insertions(+), 54 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 4cda463983..e3765fead0 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -9,6 +9,9 @@ io.files.unique sequences strings accessors ; [ "passwd" ] [ "/etc/passwd" file-name ] unit-test [ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test [ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test +[ "" ] [ "" file-name ] unit-test +[ "/" ] [ "/" file-name ] unit-test +[ "///" ] [ "///" file-name ] unit-test [ ] [ { "Hello world." } @@ -144,3 +147,51 @@ io.files.unique sequences strings accessors ; ] keep file-info size>> ] with-unique-file ] unit-test + +[ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test +[ "/usr/lib" ] [ "/usr/" "lib" append-path ] unit-test +[ "/lib" ] [ "/usr/" "/lib" append-path ] unit-test +[ "/lib/" ] [ "/usr/" "/lib/" append-path ] unit-test +[ "/usr/lib" ] [ "/usr" "./lib" append-path ] unit-test +[ "/usr/lib/" ] [ "/usr" "./lib/" append-path ] unit-test +[ "/lib" ] [ "/usr" "../lib" append-path ] unit-test +[ "/lib/" ] [ "/usr" "../lib/" append-path ] unit-test +[ "/lib" ] [ "/" "../lib" append-path ] unit-test +[ "/lib/" ] [ "/" "../lib/" append-path ] unit-test + +[ "" ] [ "" "." append-path ] unit-test +[ "" ".." append-path ] must-fail + +[ "/" ] [ "/" "./." append-path ] unit-test +[ "/" ] [ "/" "././" append-path ] unit-test +[ "/" ] [ "/" "../.." append-path ] unit-test +[ "/" ] [ "/" "../../" append-path ] unit-test +[ "/lib" ] [ "/" "../../lib" append-path ] unit-test +[ "/lib/" ] [ "/" "../../lib/" append-path ] unit-test +[ "/a/b/lib" ] [ "/a/b/c/d/e/f/" "../../../../lib" append-path ] unit-test +[ "/a/b/lib/" ] [ "/a/b/c/d/e/f/" "../../../../lib/" append-path ] unit-test + +[ "" "../lib/" append-path ] must-fail +[ "lib" ] [ "" "lib" append-path ] unit-test +[ "lib" ] [ "" "./lib" append-path ] unit-test + +[ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test +[ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test + +[ "foo/" ] [ "foo/bar/." parent-directory ] unit-test +[ "foo/" ] [ "foo/bar/./" parent-directory ] unit-test +[ "foo/" ] [ "foo/bar/baz/.." parent-directory ] unit-test +[ "foo/" ] [ "foo/bar/baz/../" parent-directory ] unit-test + +[ "." parent-directory ] must-fail +[ "./" parent-directory ] must-fail +[ ".." parent-directory ] must-fail +[ "../" parent-directory ] must-fail +[ "../../" parent-directory ] must-fail +[ "foo/.." parent-directory ] must-fail +[ "foo/../" parent-directory ] must-fail + +[ "bar/foo" ] [ "bar/baz" "..///foo" append-path ] unit-test +[ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path ] unit-test +[ "bar/foo" ] [ "bar/baz" "./..//foo" append-path ] unit-test +[ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 21cc7c8f0a..8595f227bf 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -3,7 +3,7 @@ USING: io.backend io.files.private io hashtables kernel math memory namespaces sequences strings assocs arrays definitions system combinators splitting sbufs continuations io.encodings -io.encodings.binary ; +io.encodings.binary init ; IN: io.files HOOK: (file-reader) io-backend ( path -- stream ) @@ -21,7 +21,26 @@ HOOK: (file-appender) io-backend ( path -- stream ) : ( path encoding -- stream ) swap (file-appender) swap ; -HOOK: rename-file io-backend ( from to -- ) +: file-lines ( path encoding -- seq ) + lines ; + +: with-file-reader ( path encoding quot -- ) + >r r> with-stream ; inline + +: file-contents ( path encoding -- str ) + contents ; + +: with-file-writer ( path encoding quot -- ) + >r r> with-stream ; inline + +: set-file-lines ( seq path encoding -- ) + [ [ print ] each ] with-file-writer ; + +: set-file-contents ( str path encoding -- ) + [ write ] with-file-writer ; + +: with-file-appender ( path encoding quot -- ) + >r r> with-stream ; inline ! Pathnames : path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ; @@ -32,42 +51,84 @@ HOOK: rename-file io-backend ( from to -- ) : left-trim-separators ( str -- newstr ) [ path-separator? ] left-trim ; -: append-path ( str1 str2 -- str ) - >r right-trim-separators "/" r> - left-trim-separators 3append ; - -: prepend-path ( str1 str2 -- str ) - swap append-path ; inline - : last-path-separator ( path -- n ? ) [ length 1- ] keep [ path-separator? ] find-last* ; HOOK: root-directory? io-backend ( path -- ? ) -M: object root-directory? ( path -- ? ) path-separator? ; - -: special-directory? ( name -- ? ) { "." ".." } member? ; +M: object root-directory? ( path -- ? ) + dup empty? [ drop f ] [ [ path-separator? ] all? ] if ; ERROR: no-parent-directory path ; : parent-directory ( path -- parent ) - right-trim-separators { - { [ dup empty? ] [ drop "/" ] } - { [ dup root-directory? ] [ ] } - { [ dup [ path-separator? ] contains? not ] [ drop "." ] } + dup root-directory? [ + right-trim-separators + dup last-path-separator [ + 1+ cut + { + { "." [ 1 head* parent-directory ] } + { ".." [ + 2 head* parent-directory parent-directory + ] } + [ drop ] + } case + ] [ no-parent-directory ] if + ] unless ; + + + +: absolute-path? ( path -- ? ) + dup empty? [ drop f ] [ first path-separator? ] if ; + +: append-path ( str1 str2 -- str ) + { + { [ over empty? ] [ append-path-empty ] } + { [ dup empty? ] [ drop ] } + { [ dup absolute-path? ] [ nip ] } + { [ dup head.? ] [ 1 tail left-trim-separators append-path ] } + { [ dup head..? ] [ + 2 tail left-trim-separators + >r parent-directory r> append-path + ] } { [ t ] [ - dup last-path-separator drop 1+ cut - special-directory? [ no-parent-directory ] when + >r right-trim-separators "/" r> + left-trim-separators 3append ] } } cond ; -: file-name ( path -- string ) - right-trim-separators { - { [ dup empty? ] [ drop "/" ] } - { [ dup last-path-separator ] [ 1+ tail ] } - { [ t ] [ drop ] } - } cond ; +: prepend-path ( str1 str2 -- str ) + swap append-path ; inline +: file-name ( path -- string ) + dup root-directory? [ + right-trim-separators + dup last-path-separator [ 1+ tail ] [ drop ] if + ] unless ; + +! File info TUPLE: file-info type size permissions modified ; HOOK: file-info io-backend ( path -- info ) @@ -94,8 +155,12 @@ HOOK: cd io-backend ( path -- ) HOOK: cwd io-backend ( -- path ) +SYMBOL: current-directory + +[ cwd current-directory set-global ] "current-directory" add-init-hook + : with-directory ( path quot -- ) - cwd [ cd ] curry rot cd [ ] cleanup ; inline + current-directory swap with-variable ; inline ! Creating directories HOOK: make-directory io-backend ( path -- ) @@ -118,7 +183,7 @@ HOOK: make-directory io-backend ( path -- ) dup string? [ tuck append-path directory? 2array ] [ nip ] if ] with map - [ first special-directory? not ] subset ; + [ first { "." ".." } member? not ] subset ; : directory ( path -- seq ) normalize-directory dup (directory) fixup-directory ; @@ -199,34 +264,6 @@ DEFER: copy-tree-into : resource-exists? ( path -- ? ) ?resource-path exists? ; -! Pathname presentations -TUPLE: pathname string ; - -C: pathname - -M: pathname <=> [ pathname-string ] compare ; - -: file-lines ( path encoding -- seq ) - lines ; - -: with-file-reader ( path encoding quot -- ) - >r r> with-stream ; inline - -: file-contents ( path encoding -- str ) - contents ; - -: with-file-writer ( path encoding quot -- ) - >r r> with-stream ; inline - -: set-file-lines ( seq path encoding -- ) - [ [ print ] each ] with-file-writer ; - -: set-file-contents ( str path encoding -- ) - [ write ] with-file-writer ; - -: with-file-appender ( path encoding quot -- ) - >r r> with-stream ; inline - : temp-directory ( -- path ) "temp" resource-path dup exists? not @@ -235,6 +272,13 @@ M: pathname <=> [ pathname-string ] compare ; : temp-file ( name -- path ) temp-directory prepend-path ; +! Pathname presentations +TUPLE: pathname string ; + +C: pathname + +M: pathname <=> [ pathname-string ] compare ; + ! Home directory : home ( -- dir ) { diff --git a/extra/io/unix/files/files-tests.factor b/extra/io/unix/files/files-tests.factor index f5366d32ae..98de09e8f1 100755 --- a/extra/io/unix/files/files-tests.factor +++ b/extra/io/unix/files/files-tests.factor @@ -6,3 +6,9 @@ IN: io.unix.files.tests [ "/" ] [ "/etc/" parent-directory ] unit-test [ "/" ] [ "/etc" parent-directory ] unit-test [ "/" ] [ "/" parent-directory ] unit-test +[ "asdf" parent-directory ] must-fail + +[ f ] [ "" root-directory? ] unit-test +[ t ] [ "/" root-directory? ] unit-test +[ t ] [ "//" root-directory? ] unit-test +[ t ] [ "///////" root-directory? ] unit-test From 807c84918b952c377e949454fc13b59dfbeeb93b Mon Sep 17 00:00:00 2001 From: erg Date: Tue, 25 Mar 2008 19:52:07 -0500 Subject: [PATCH 043/219] minor cleanup in windows path handling --- extra/io/windows/nt/files/files.factor | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 7cf056674f..540737004b 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -2,7 +2,8 @@ USING: continuations destructors io.buffers io.files io.backend io.timeouts io.nonblocking io.windows io.windows.nt.backend kernel libc math threads windows windows.kernel32 alien.c-types alien.arrays sequences combinators combinators.lib -sequences.lib ascii splitting alien strings assocs ; +sequences.lib ascii splitting alien strings assocs +combinators.cleave ; IN: io.windows.nt.files M: windows-nt-io cwd @@ -18,18 +19,19 @@ M: windows-nt-io cd M: windows-nt-io root-directory? ( path -- ? ) dup length 2 = [ - dup first Letter? - swap second CHAR: : = and + first2 + [ Letter? ] [ CHAR: : = ] bi* and ] [ drop f ] if ; +ERROR: not-absolute-path ; : root-directory ( string -- string' ) { [ dup length 2 >= ] [ dup second CHAR: : = ] [ dup first Letter? ] - } && [ 2 head ] [ "Not an absolute path" throw ] if ; + } && [ 2 head ] [ not-absolute-path ] if ; : prepend-prefix ( string -- string' ) unicode-prefix prepend ; @@ -58,9 +60,12 @@ M: windows-nt-io root-directory? ( path -- ? ) ] } } cond ; +ERROR: nonstring-pathname ; +ERROR: empty-pathname ; + M: windows-nt-io normalize-pathname ( string -- string ) - dup string? [ "Pathname must be a string" throw ] unless - dup empty? [ "Empty pathname" throw ] when + dup string? [ nonstring-pathname ] unless + dup empty? [ empty-pathname ] when { { CHAR: / CHAR: \\ } } substitute cwd swap windows-append-path [ "/\\." member? ] right-trim From 06848c8e7575983cb590beb7c1ad43ed1dfdf66f Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 25 Mar 2008 21:17:37 -0400 Subject: [PATCH 044/219] UTF-16 native order; better encodings docs --- core/io/encodings/binary/binary-docs.factor | 5 +- core/io/encodings/encodings-docs.factor | 29 ++++++----- core/io/encodings/utf8/utf8-docs.factor | 11 ++-- extra/help/handbook/handbook.factor | 13 ++++- extra/io/encodings/8-bit/8-bit-docs.factor | 57 ++++++++++++++------- extra/io/encodings/ascii/ascii-docs.factor | 8 +++ extra/io/encodings/utf16/utf16-docs.factor | 19 ++++--- extra/io/encodings/utf16/utf16-tests.factor | 10 +++- extra/io/encodings/utf16/utf16.factor | 14 ++++- 9 files changed, 115 insertions(+), 51 deletions(-) create mode 100644 extra/io/encodings/ascii/ascii-docs.factor diff --git a/core/io/encodings/binary/binary-docs.factor b/core/io/encodings/binary/binary-docs.factor index 823eea67be..fdd9828867 100644 --- a/core/io/encodings/binary/binary-docs.factor +++ b/core/io/encodings/binary/binary-docs.factor @@ -2,4 +2,7 @@ USING: help.syntax help.markup ; IN: io.encodings.binary HELP: binary -{ $class-description "This is the encoding descriptor for binary I/O. Making an encoded stream with the binary encoding is a no-op; streams with this encoding deal with byte-arrays, not strings." } ; +{ $class-description "This is the encoding descriptor for binary I/O. Making an encoded stream with the binary encoding is a no-op; streams with this encoding deal with byte-arrays, not strings." } +{ $see-also "encodings-introduction" } ; + +ABOUT: binary diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor index 0f43bba0db..07e0f9f401 100644 --- a/core/io/encodings/encodings-docs.factor +++ b/core/io/encodings/encodings-docs.factor @@ -1,16 +1,16 @@ USING: help.markup help.syntax ; IN: io.encodings -ABOUT: "encodings" +ABOUT: "io.encodings" ARTICLE: "io.encodings" "I/O encodings" -"Many streams deal with bytes, rather than Unicode code points, at some level. The translation between these two things is specified by an encoding. To abstract this away from the programmer, Factor provides a system where these streams are associated with an encoding which is always used when the stream is read from or written to. For most purposes, an encoding descriptor consisting of a symbol is all that is needed when initializing a stream." +"Bytes can't be understood in isolation as text. They must be interpreted under a certain encoding. Factor provides utilities for dealing with encoded text by declaring that a stream has a particular encoding, and utilities to encode and decode strings." { $subsection "encodings-constructors" } { $subsection "encodings-descriptors" } { $subsection "encodings-protocol" } ; -ARTICLE: "encodings-constructors" "Constructing an encoded stream" -"The following words can be used to construct encoded streams. Note that they are usually not used directly, but rather by the stream constructors themselves." +ARTICLE: "encodings-constructors" "Manually constructing an encoded stream" +"The following words can be used to construct encoded streams. Note that they are usually not used directly, but rather by the stream constructors themselves. Most stream constructors take an encoding descriptor as a parameter and internally call these constructors." { $subsection } { $subsection } { $subsection } ; @@ -38,19 +38,22 @@ HELP: ARTICLE: "encodings-descriptors" "Encoding descriptors" "An encoding descriptor is something which can be used for input or output streams to encode or decode files. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:" -{ $vocab-subsection "io.encodings.utf8" } -{ $vocab-subsection "io.encodings.ascii" } -{ $vocab-subsection "io.encodings.8-bit" } -{ $vocab-subsection "io.encodings.binary" } -{ $vocab-subsection "io.encodings.utf16" } ; +{ $vocab-subsection "ASCII" "io.encodings.ascii" } +{ $vocab-subsection "Binary" "io.encodings.binary" } +{ $vocab-subsection "Strict encodings" "io.encodings.strict" } +{ $vocab-subsection "8-bit encodings" "io.encodings.8-bit" } +{ $vocab-subsection "UTF-8" "io.encodings.utf8" } +{ $vocab-subsection "UTF-16" "io.encodings.utf16" } +{ $see-also "encodings-introduction" } ; ARTICLE: "encodings-protocol" "Encoding protocol" -"An encoding descriptor must implement the following methods. The methods are implemented on tuple classes by instantiating the class and calling the method again." +"There are two parts to implementing a new encoding. First, methods for creating an encoded or decoded stream must be provided. These have defaults, however, which wrap a stream in an encoder or decoder wrapper with the given encoding descriptor." +{ $subsection } +{ $subsection } +"If an encoding might be contained in the code slot of an encoder or decoder tuple, then the following methods must be implemented to read or write one code point from a stream:" { $subsection decode-char } { $subsection encode-char } -"Optionally, an encoding can override the constructor words:" -{ $subsection } -{ $subsection } ; +{ $see-also "encodings-introduction" } ; HELP: decode-char { $values { "stream" "an underlying input stream" } diff --git a/core/io/encodings/utf8/utf8-docs.factor b/core/io/encodings/utf8/utf8-docs.factor index dbbc193a02..7a29039eca 100755 --- a/core/io/encodings/utf8/utf8-docs.factor +++ b/core/io/encodings/utf8/utf8-docs.factor @@ -1,11 +1,8 @@ -USING: help.markup help.syntax io.encodings strings io.files ; +USING: help.markup help.syntax ; IN: io.encodings.utf8 -ARTICLE: "io.encodings.utf8" "Working with UTF8-encoded data" -"The UTF8 encoding is a variable-width encoding. 7-bit ASCII characters are encoded as single bytes, and other Unicode code points are encoded as 2 to 4 byte sequences. The encoding descriptor for UTF-8:" -{ $subsection utf8 } ; - HELP: utf8 -{ $class-description "This is the class of encoding tuples which denote a UTF-8 encoding. This conforms to the " { $link "encodings-protocol" } "." } ; +{ $class-description "This is the encoding descriptor for a UTF-8 encoding. UTF-8 is a variable-width encoding. 7-bit ASCII characters are encoded as single bytes, and other Unicode code points are encoded as 2 to 4 byte sequences." } +{ $see-also "encodings-introduction" } ; -ABOUT: "io.encodings.utf8" +ABOUT: utf8 diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index 1310b58133..4079386d7f 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -170,7 +170,17 @@ ARTICLE: "collections" "Collections" { $subsection "graphs" } { $subsection "buffers" } ; -USING: io.sockets io.launcher io.mmap io.monitors ; +USING: io.sockets io.launcher io.mmap io.monitors +io.encodings.utf8 io.encodings.binary io.encodings.ascii io.files ; + +ARTICLE: "encodings-introduction" "An introduction to encodings" +"In order to express text in terms of binary, some sort of encoding has to be used. In a modern context, this is understood as a two-way mapping between Unicode code points (characters) and some amount of binary. Since English isn't the only language in the world, ASCII is not sufficient as a mapping from binary to Unicode; it can't even express em-dashes or curly quotes. Unicode was designed as a universal character set that could potentially represent everything." $nl +"Not all encodings can represent all Unicode code points, but Unicode can represent basically everything that exists in modern encodings. Some encodings are language-specific, and some can represent everything in Unicode. Though the world is moving toward Unicode and UTF-8, the reality today is that there are several encodings which must be taken into account." $nl +"Factor uses a system of encoding descriptors to denote encodings. Encoding descriptors are objects which describe encodings. Examples are " { $link utf8 } ", " { $link ascii } " and " { $link binary } ". Encoding descriptors can be passed around independently. Each encoding descriptor has some method for constructing an encoded or decoded stream, and the resulting stream has an encoding descriptor stored which has methods for reading or writing characters." $nl +"Constructors for streams which deal with bytes usually take an encoding as an explicit parameter. For example, to open a text file for reading whose contents are in UTF-8, use the following" +{ $code "\"filename\" utf8 " } +"If there is an error in the encoded stream, a replacement character (0xFFFD) will be inserted. To throw an exception upon error, use a strict encoding as follows" +{ $code "\"filename\" utf8 strict " } ; ARTICLE: "io" "Input and output" { $heading "Streams" } @@ -188,6 +198,7 @@ ARTICLE: "io" "Input and output" { $subsection "io.mmap" } { $subsection "io.monitors" } { $heading "Encodings" } +{ $subsection "encodings-introduction" } { $subsection "io.encodings" } { $subsection "io.encodings.string" } { $heading "Other features" } diff --git a/extra/io/encodings/8-bit/8-bit-docs.factor b/extra/io/encodings/8-bit/8-bit-docs.factor index ff21094ba1..8e5fd815bc 100644 --- a/extra/io/encodings/8-bit/8-bit-docs.factor +++ b/extra/io/encodings/8-bit/8-bit-docs.factor @@ -34,58 +34,77 @@ HELP: define-8-bit-encoding { $description "Creates a new encoding with the given name, using the resource file at the path to tell how to encode and decode octets. The resource file should be in a similar format to those at ftp://ftp.unicode.org/Public/MAPPINGS/ISO8859/" } ; 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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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." } ; +{ $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" } ; diff --git a/extra/io/encodings/ascii/ascii-docs.factor b/extra/io/encodings/ascii/ascii-docs.factor new file mode 100644 index 0000000000..0b54a341d9 --- /dev/null +++ b/extra/io/encodings/ascii/ascii-docs.factor @@ -0,0 +1,8 @@ +USING: help.markup help.syntax ; +IN: io.encodings.ascii + +HELP: ascii +{ $class-description "This is the encoding descriptor which denotes an ASCII encoding. By default, if there's a non-ASCII character in an input stream, it will be replaced with a replacement character (U+FFFD), and if a non-ASCII character is used in output, an exception is thrown." } +{ $see-also "encodings-introduction" } ; + +ABOUT: ascii diff --git a/extra/io/encodings/utf16/utf16-docs.factor b/extra/io/encodings/utf16/utf16-docs.factor index 018a15a534..7198cb2b27 100644 --- a/extra/io/encodings/utf16/utf16-docs.factor +++ b/extra/io/encodings/utf16/utf16-docs.factor @@ -1,22 +1,25 @@ USING: help.markup help.syntax io.encodings strings ; IN: io.encodings.utf16 -ARTICLE: "utf16" "Working with UTF-16-encoded data" +ARTICLE: "io.encodings.utf16" "UTF-16" "The UTF-16 encoding is a variable-width encoding. Unicode code points are encoded as 2 or 4 byte sequences. There are three encoding descriptor classes for working with UTF-16, depending on endianness or the presence of a BOM:" +{ $subsection utf16 } { $subsection utf16le } { $subsection utf16be } -{ $subsection utf16 } -"All of these conform to the " { $link "encodings-protocol" } "." ; +{ $subsection utf16n } ; -ABOUT: "utf16" +ABOUT: "io.encodings.utf16" HELP: utf16le -{ $class-description "The encoding protocol for UTF-16LE, that is, UTF-16 in little endian, without a byte order mark. Streams can be made which read or write wth this encoding." } ; +{ $class-description "The encoding descriptor for UTF-16LE, that is, UTF-16 in little endian, without a byte order mark. Streams can be made which read or write wth this encoding." } ; HELP: utf16be -{ $class-description "The encoding protocol for UTF-16BE, that is, UTF-16 in big endian, without a byte order mark. Streams can be made which read or write wth this encoding." } ; +{ $class-description "The encoding descriptor for UTF-16BE, that is, UTF-16 in big endian, without a byte order mark. Streams can be made which read or write wth this encoding." } ; HELP: utf16 -{ $class-description "The encoding protocol for UTF-16, that is, UTF-16 with a byte order mark. This is the most useful for general input and output in UTF-16. Streams can be made which read or write wth this encoding." } ; +{ $class-description "The encoding descriptor for UTF-16, that is, UTF-16 with a byte order mark. This is the most useful for general input and output in UTF-16. Streams can be made which read or write wth this encoding." } ; -{ utf16 utf16le utf16be } related-words +HELP: utf16n +{ $class-description "The encoding descriptor for UTF-16 without a byte order mark in native endian order. This is useful mostly for FFI calls which take input of strings in of wide_t*." } ; + +{ utf16 utf16le utf16be utf16n } related-words diff --git a/extra/io/encodings/utf16/utf16-tests.factor b/extra/io/encodings/utf16/utf16-tests.factor index 89b61a3e37..6985983917 100755 --- a/extra/io/encodings/utf16/utf16-tests.factor +++ b/extra/io/encodings/utf16/utf16-tests.factor @@ -1,5 +1,7 @@ USING: kernel tools.test io.encodings.utf16 arrays sbufs -sequences io.encodings io unicode io.encodings.string ; +io.streams.byte-array sequences io.encodings io unicode +io.encodings.string alien.c-types accessors classes ; +IN: io.encodings.utf16.tests [ { CHAR: x } ] [ { 0 CHAR: x } utf16be decode >array ] unit-test [ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } utf16be decode >array ] unit-test @@ -20,3 +22,9 @@ sequences io.encodings io unicode io.encodings.string ; [ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode >array ] unit-test [ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode >array ] unit-test + +: correct-endian + code>> class little-endian? [ utf16le = ] [ utf16be = ] if ; + +[ t ] [ B{ } utf16n correct-endian ] unit-test +[ t ] [ utf16n correct-endian ] unit-test diff --git a/extra/io/encodings/utf16/utf16.factor b/extra/io/encodings/utf16/utf16.factor index 290761ec91..e8ca04af35 100755 --- a/extra/io/encodings/utf16/utf16.factor +++ b/extra/io/encodings/utf16/utf16.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2006, 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: math kernel sequences sbufs vectors namespaces io.binary -io.encodings combinators splitting io byte-arrays inspector ; +io.encodings combinators splitting io byte-arrays inspector +alien.c-types ; IN: io.encodings.utf16 TUPLE: utf16be ; @@ -10,6 +11,8 @@ TUPLE: utf16le ; TUPLE: utf16 ; +TUPLE: utf16n ; + ( stream utf16 -- decoder ) M: utf16 ( stream utf16 -- encoder ) drop bom-le over stream-write utf16le ; +! Native-order UTF-16 + +: native-utf16 ( -- descriptor ) + little-endian? utf16le utf16be ? ; + +M: utf16n drop native-utf16 ; + +M: utf16n drop native-utf16 ; + PRIVATE> From c9b22c92a67fd50177378e5566f0e55a3cba9715 Mon Sep 17 00:00:00 2001 From: erg Date: Tue, 25 Mar 2008 21:09:39 -0500 Subject: [PATCH 045/219] redo target --- build-support/target | 70 ++++++++++++++++++++++---------------------- 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/build-support/target b/build-support/target index 1903a6da64..1fbfb31d11 100755 --- a/build-support/target +++ b/build-support/target @@ -1,38 +1,38 @@ #!/bin/sh -if [ \( `uname -s ` = FreeBSD \) -a \( `uname -p` = i386 \) ] -then - echo freebsd-x86-32 -elif [ \( `uname -s` = FreeBSD \) -a \( `uname -m` = amd64 \) ] -then - echo freebsd-x86-64 -elif [ \( `uname -s` = OpenBSD \) -a \( `uname -m` = i386 \) ] -then - echo openbsd-x86-32 -elif [ \( `uname -s` = OpenBSD \) -a \( `uname -m` = amd64 \) ] -then - echo openbsd-x86-64 -elif [ \( `uname -s` = NetBSD \) -a \( `uname -p` = i386 \) ] -then - echo netbsd-x86-32 -elif [ \( `uname -s` = NetBSD \) -a \( `uname -p` = x86_64 \) ] -then - echo netbsd-x86-64 -elif [ \( `uname -s` = Darwin \) -a \( `uname -p` = powerpc \) ] -then - echo macosx-ppc -elif [ `uname -s` = Darwin ] -then - echo macosx-x86-`./build-support/wordsize` -elif [ \( `uname -s` = Linux \) -a \( `uname -m` = i686 \) ] -then - echo linux-x86-32 -elif [ \( `uname -s` = Linux \) -a \( `uname -m` = x86_64 \) ] -then - echo linux-x86-64 -elif [ \( `uname -o` = Cygwin \) -a \( `uname -m` = i686 \) ] -then - echo winnt-x86-`./build-support/wordsize` -else - echo help +uname_s=`uname -s` +case $uname_s in + CYGWIN_NT-5.2-WOW64) OS=winnt;; + *CYGWIN_NT*) OS=winnt;; + *CYGWIN*) OS=winnt;; + *darwin*) OS=macosx;; + *Darwin*) OS=macosx;; + *linux*) OS=linux;; + *Linux*) OS=linux;; + *NetBSD*) OS=netbsd;; + *FreeBSD*) OS=freebsd;; + *OpenBSD*) OS=openbsd;; + *DragonFly*) OS=dragonflybsd;; +esac + +uname_m=`uname -m` +case $uname_m in + i386) ARCH=x86;; + i686) ARCH=x86;; + amd64) ARCH=x86;; + *86) ARCH=x86;; + *86_64) ARCH=x86;; + "Power Macintosh") ARCH=ppc;; +esac + +WORD=`./build-support/wordsize` + +MAKE_TARGET=$OS-$ARCH-$WORD +if [[ $OS == macosx && $ARCH == ppc ]] ; then + MAKE_TARGET=$OS-$ARCH fi +if [[ $OS == linux && $ARCH == ppc ]] ; then + MAKE_TARGET=$OS-$ARCH +fi + +echo $MAKE_TARGET From 9b7246555a8107262dc7e674d845ff3ac0d48300 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Wed, 26 Mar 2008 15:26:54 +1300 Subject: [PATCH 046/219] Fix just parser in pegs --- extra/peg/parsers/parsers-tests.factor | 4 ++++ extra/peg/parsers/parsers.factor | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/extra/peg/parsers/parsers-tests.factor b/extra/peg/parsers/parsers-tests.factor index 08bde98419..e80baf3c4f 100644 --- a/extra/peg/parsers/parsers-tests.factor +++ b/extra/peg/parsers/parsers-tests.factor @@ -48,3 +48,7 @@ IN: peg.parsers.tests [ V{ } ] [ "" epsilon parse parse-result-ast ] unit-test + +{ "a" } [ + "a" "a" token just parse parse-result-ast +] unit-test \ No newline at end of file diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor index 4bba60bb09..13509e81f7 100755 --- a/extra/peg/parsers/parsers.factor +++ b/extra/peg/parsers/parsers.factor @@ -3,14 +3,14 @@ USING: kernel sequences strings namespaces math assocs shuffle vectors arrays combinators.lib math.parser match unicode.categories sequences.deep peg peg.private - peg.search math.ranges ; + peg.search math.ranges words ; IN: peg.parsers TUPLE: just-parser p1 ; : just-pattern [ - dup [ + execute dup [ dup parse-result-remaining empty? [ drop f ] unless ] when ] ; From b1561de0f6636af53f2e53918b9f4e60265ad076 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Wed, 26 Mar 2008 15:40:17 +1300 Subject: [PATCH 047/219] Reduce amount of generated code for peg token parser --- extra/peg/peg.factor | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 1707193e70..ae5ed2f8b2 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -43,17 +43,16 @@ TUPLE: token-parser symbol ; MATCH-VARS: ?token ; -: token-pattern ( -- quot ) - [ - ?token 2dup head? [ - dup >r length tail-slice r> - ] [ - 2drop f - ] if - ] ; - +: parse-token ( input string -- result ) + #! Parse the string, returning a parse result + 2dup head? [ + dup >r length tail-slice r> + ] [ + 2drop f + ] if ; + M: token-parser (compile) ( parser -- quot ) - token-parser-symbol \ ?token token-pattern match-replace ; + token-parser-symbol [ parse-token ] curry ; TUPLE: satisfy-parser quot ; From 2bc882bf5aabb65198a798fb645c65c90bceacf0 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 25 Mar 2008 22:45:26 -0400 Subject: [PATCH 048/219] XML reports its encoding as UTF-8 --- extra/xml/tests/errors.factor | 2 +- extra/xml/tests/templating.factor | 2 +- extra/xml/tests/test.factor | 6 +++--- extra/xml/tokenize/tokenize.factor | 2 +- extra/xml/utilities/utilities.factor | 2 +- extra/xml/xml.factor | 2 +- 6 files changed, 8 insertions(+), 8 deletions(-) diff --git a/extra/xml/tests/errors.factor b/extra/xml/tests/errors.factor index b421ae011a..6ba0b0d560 100755 --- a/extra/xml/tests/errors.factor +++ b/extra/xml/tests/errors.factor @@ -16,7 +16,7 @@ T{ extra-attrs T{ parsing-error f 1 32 } V{ T{ name f "" "foo" f } } T{ bad-version T{ parsing-error f 1 28 } "5 million" } "" xml-error-test T{ notags f } "" xml-error-test T{ multitags f } "" xml-error-test -T{ bad-prolog T{ parsing-error f 1 26 } T{ prolog f "1.0" "iso-8859-1" f } +T{ bad-prolog T{ parsing-error f 1 26 } T{ prolog f "1.0" "UTF-8" f } } "" xml-error-test T{ capitalized-prolog T{ parsing-error f 1 6 } "XmL" } "" xml-error-test diff --git a/extra/xml/tests/templating.factor b/extra/xml/tests/templating.factor index 6db98ec848..d81e807fe5 100644 --- a/extra/xml/tests/templating.factor +++ b/extra/xml/tests/templating.factor @@ -40,4 +40,4 @@ M: object (r-ref) drop ; sample-doc string>xml dup template xml>string ] with-scope ; -[ "foo
blah

" ] [ test-refs ] unit-test +[ "foo

" ] [ test-refs ] unit-test diff --git a/extra/xml/tests/test.factor b/extra/xml/tests/test.factor index 02c7aecb13..98146136e6 100644 --- a/extra/xml/tests/test.factor +++ b/extra/xml/tests/test.factor @@ -26,7 +26,7 @@ SYMBOL: xml-file ] unit-test [ V{ "fa&g" } ] [ xml-file get "x" get-id tag-children ] unit-test [ "that" ] [ xml-file get "this" swap at ] unit-test -[ "" ] +[ "" ] [ "" string>xml xml>string ] unit-test [ "abcd" ] [ "

abcd
" string>xml @@ -44,7 +44,7 @@ SYMBOL: xml-file at swap "z" >r tuck r> swap set-at T{ name f "blah" "z" f } swap at ] unit-test [ "foo" ] [ "" string>xml children>string ] unit-test -[ "bar baz" ] +[ "bar baz" ] [ "bar" string>xml [ " baz" append ] map xml>string ] unit-test -[ "\n\n bar\n" ] +[ "\n\n bar\n" ] [ " bar " string>xml pprint-xml>string ] unit-test diff --git a/extra/xml/tokenize/tokenize.factor b/extra/xml/tokenize/tokenize.factor index d99c306b2b..b2b7d78b3e 100644 --- a/extra/xml/tokenize/tokenize.factor +++ b/extra/xml/tokenize/tokenize.factor @@ -172,7 +172,7 @@ SYMBOL: ns-stack [ T{ name f "" "version" f } swap at [ good-version ] [ throw ] if* ] keep [ T{ name f "" "encoding" f } swap at - "iso-8859-1" or ] keep + "UTF-8" or ] keep T{ name f "" "standalone" f } swap at [ yes/no>bool ] [ f ] if* ; diff --git a/extra/xml/utilities/utilities.factor b/extra/xml/utilities/utilities.factor index d6814851ee..b397e3c7b1 100755 --- a/extra/xml/utilities/utilities.factor +++ b/extra/xml/utilities/utilities.factor @@ -42,7 +42,7 @@ M: process-missing error. >r 1array r> build-tag* ; : standard-prolog ( -- prolog ) - T{ prolog f "1.0" "iso-8859-1" f } ; + T{ prolog f "1.0" "UTF-8" f } ; : build-xml ( tag -- xml ) standard-prolog { } rot { } ; diff --git a/extra/xml/xml.factor b/extra/xml/xml.factor index 970ff39cf1..61ef27b72e 100644 --- a/extra/xml/xml.factor +++ b/extra/xml/xml.factor @@ -63,7 +63,7 @@ M: closer process V{ } clone xml-stack set f push-xml ; : default-prolog ( -- prolog ) - "1.0" "iso-8859-1" f ; + "1.0" "UTF-8" f ; : reset-prolog ( -- ) default-prolog prolog-data set ; From 4d8d25ecb336ff486755334d90f1f09b2f352463 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Mar 2008 21:58:27 -0500 Subject: [PATCH 049/219] Update .gitignore --- .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 7e1e52d866..f2cf3de119 100644 --- a/.gitignore +++ b/.gitignore @@ -18,4 +18,4 @@ factor temp logs work -buildsupport/wordsize +build-support/wordsize From 8569d18068dbaebeb28a4984af87dcbb3dda89ff Mon Sep 17 00:00:00 2001 From: Chris Double Date: Wed, 26 Mar 2008 16:08:14 +1300 Subject: [PATCH 050/219] Use new slots in peg --- extra/peg/peg.factor | 46 ++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index ae5ed2f8b2..79c866c768 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -3,7 +3,7 @@ USING: kernel sequences strings namespaces math assocs shuffle vectors arrays combinators.lib math.parser match unicode.categories sequences.lib compiler.units parser - words quotations effects memoize ; + words quotations effects memoize accessors ; IN: peg TUPLE: parse-result remaining ast ; @@ -52,7 +52,7 @@ MATCH-VARS: ?token ; ] if ; M: token-parser (compile) ( parser -- quot ) - token-parser-symbol [ parse-token ] curry ; + symbol>> [ parse-token ] curry ; TUPLE: satisfy-parser quot ; @@ -72,7 +72,7 @@ MATCH-VARS: ?quot ; ] ; M: satisfy-parser (compile) ( parser -- quot ) - satisfy-parser-quot \ ?quot satisfy-pattern match-replace ; + quot>> \ ?quot satisfy-pattern match-replace ; TUPLE: range-parser min max ; @@ -100,12 +100,12 @@ TUPLE: seq-parser parsers ; : seq-pattern ( -- quot ) [ dup [ - dup parse-result-remaining ?quot [ - [ parse-result-remaining swap set-parse-result-remaining ] 2keep - parse-result-ast dup ignore = [ + dup remaining>> ?quot [ + [ remaining>> swap (>>remaining) ] 2keep + ast>> dup ignore = [ drop ] [ - swap [ parse-result-ast push ] keep + swap [ ast>> push ] keep ] if ] [ drop f @@ -118,7 +118,7 @@ TUPLE: seq-parser parsers ; M: seq-parser (compile) ( parser -- quot ) [ [ V{ } clone ] % - seq-parser-parsers [ compiled-parser \ ?quot seq-pattern match-replace % ] each + parsers>> [ compiled-parser \ ?quot seq-pattern match-replace % ] each ] [ ] make ; TUPLE: choice-parser parsers ; @@ -135,16 +135,16 @@ TUPLE: choice-parser parsers ; M: choice-parser (compile) ( parser -- quot ) [ f , - choice-parser-parsers [ compiled-parser \ ?quot choice-pattern match-replace % ] each + parsers>> [ compiled-parser \ ?quot choice-pattern match-replace % ] each \ nip , ] [ ] make ; TUPLE: repeat0-parser p1 ; : (repeat0) ( quot result -- result ) - 2dup parse-result-remaining swap call [ - [ parse-result-remaining swap set-parse-result-remaining ] 2keep - parse-result-ast swap [ parse-result-ast push ] keep + 2dup remaining>> swap call [ + [ remaining>> swap (>>remaining) ] 2keep + ast>> swap [ ast>> push ] keep (repeat0) ] [ nip @@ -158,7 +158,7 @@ TUPLE: repeat0-parser p1 ; M: repeat0-parser (compile) ( parser -- quot ) [ [ V{ } clone ] % - repeat0-parser-p1 compiled-parser \ ?quot repeat0-pattern match-replace % + p1>> compiled-parser \ ?quot repeat0-pattern match-replace % ] [ ] make ; TUPLE: repeat1-parser p1 ; @@ -166,7 +166,7 @@ TUPLE: repeat1-parser p1 ; : repeat1-pattern ( -- quot ) [ [ ?quot ] swap (repeat0) [ - dup parse-result-ast empty? [ + dup ast>> empty? [ drop f ] when ] [ @@ -177,7 +177,7 @@ TUPLE: repeat1-parser p1 ; M: repeat1-parser (compile) ( parser -- quot ) [ [ V{ } clone ] % - repeat1-parser-p1 compiled-parser \ ?quot repeat1-pattern match-replace % + p1>> compiled-parser \ ?quot repeat1-pattern match-replace % ] [ ] make ; TUPLE: optional-parser p1 ; @@ -188,7 +188,7 @@ TUPLE: optional-parser p1 ; ] ; M: optional-parser (compile) ( parser -- quot ) - optional-parser-p1 compiled-parser \ ?quot optional-pattern match-replace ; + p1>> compiled-parser \ ?quot optional-pattern match-replace ; TUPLE: ensure-parser p1 ; @@ -202,7 +202,7 @@ TUPLE: ensure-parser p1 ; ] ; M: ensure-parser (compile) ( parser -- quot ) - ensure-parser-p1 compiled-parser \ ?quot ensure-pattern match-replace ; + p1>> compiled-parser \ ?quot ensure-pattern match-replace ; TUPLE: ensure-not-parser p1 ; @@ -216,7 +216,7 @@ TUPLE: ensure-not-parser p1 ; ] ; M: ensure-not-parser (compile) ( parser -- quot ) - ensure-not-parser-p1 compiled-parser \ ?quot ensure-not-pattern match-replace ; + p1>> compiled-parser \ ?quot ensure-not-pattern match-replace ; TUPLE: action-parser p1 quot ; @@ -225,13 +225,13 @@ MATCH-VARS: ?action ; : action-pattern ( -- quot ) [ ?quot dup [ - dup parse-result-ast ?action call - swap [ set-parse-result-ast ] keep + dup ast>> ?action call + >>ast ] when ] ; M: action-parser (compile) ( parser -- quot ) - { action-parser-p1 action-parser-quot } get-slots [ compiled-parser ] dip + { p1>> quot>> } get-slots [ compiled-parser ] dip 2array { ?quot ?action } action-pattern match-replace ; : left-trim-slice ( string -- string ) @@ -245,7 +245,7 @@ TUPLE: sp-parser p1 ; M: sp-parser (compile) ( parser -- quot ) [ - \ left-trim-slice , sp-parser-p1 compiled-parser , + \ left-trim-slice , p1>> compiled-parser , ] [ ] make ; TUPLE: delay-parser quot ; @@ -255,7 +255,7 @@ M: delay-parser (compile) ( parser -- quot ) #! This way it is run only once and the #! parser constructed once at run time. [ - delay-parser-quot % \ compile , + quot>> % \ compile , ] [ ] make { } { "word" } memoize-quot [ % \ execute , ] [ ] make ; From 1ec945ba4c3b6380f3fe7a3a6d8decc5ffa315fb Mon Sep 17 00:00:00 2001 From: Chris Double Date: Wed, 26 Mar 2008 16:16:23 +1300 Subject: [PATCH 051/219] Use new slots in peg.ebnf --- extra/peg/ebnf/ebnf.factor | 40 +++++++++++++++++++++----------------- 1 file changed, 22 insertions(+), 18 deletions(-) diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index db478e571f..11e1e2ea64 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -3,7 +3,7 @@ USING: kernel compiler.units parser words arrays strings math.parser sequences quotations vectors namespaces math assocs continuations peg peg.parsers unicode.categories multiline combinators.lib - splitting ; + splitting accessors ; IN: peg.ebnf TUPLE: ebnf-non-terminal symbol ; @@ -16,7 +16,7 @@ TUPLE: ebnf-choice options ; TUPLE: ebnf-sequence elements ; TUPLE: ebnf-repeat0 group ; TUPLE: ebnf-repeat1 group ; -TUPLE: ebnf-optional elements ; +TUPLE: ebnf-optional group ; TUPLE: ebnf-rule symbol elements ; TUPLE: ebnf-action parser code ; TUPLE: ebnf rules ; @@ -198,7 +198,7 @@ DEFER: 'choice' : 'rule' ( -- parser ) [ - 'non-terminal' [ ebnf-non-terminal-symbol ] action , + 'non-terminal' [ symbol>> ] action , "=" syntax , 'choice' , ] seq* [ first2 ] action ; @@ -215,49 +215,53 @@ SYMBOL: main H{ } clone dup dup [ parser set swap (transform) main set ] bind ; M: ebnf (transform) ( ast -- parser ) - ebnf-rules [ (transform) ] map peek ; + rules>> [ (transform) ] map peek ; M: ebnf-rule (transform) ( ast -- parser ) - dup ebnf-rule-elements (transform) [ - swap ebnf-rule-symbol set + dup elements>> (transform) [ + swap symbol>> set ] keep ; M: ebnf-sequence (transform) ( ast -- parser ) - ebnf-sequence-elements [ (transform) ] map seq ; + elements>> [ (transform) ] map seq ; M: ebnf-choice (transform) ( ast -- parser ) - ebnf-choice-options [ (transform) ] map choice ; + options>> [ (transform) ] map choice ; M: ebnf-any-character (transform) ( ast -- parser ) drop any-char ; M: ebnf-range (transform) ( ast -- parser ) - ebnf-range-pattern range-pattern ; + pattern>> range-pattern ; + +: transform-group ( ast -- parser ) + #! convert a ast node with groups to a parser for that group + group>> (transform) ; M: ebnf-ensure (transform) ( ast -- parser ) - ebnf-ensure-group (transform) ensure ; + transform-group ensure ; M: ebnf-ensure-not (transform) ( ast -- parser ) - ebnf-ensure-not-group (transform) ensure-not ; + transform-group ensure-not ; M: ebnf-repeat0 (transform) ( ast -- parser ) - ebnf-repeat0-group (transform) repeat0 ; + transform-group repeat0 ; M: ebnf-repeat1 (transform) ( ast -- parser ) - ebnf-repeat1-group (transform) repeat1 ; + transform-group repeat1 ; M: ebnf-optional (transform) ( ast -- parser ) - ebnf-optional-elements (transform) optional ; + transform-group optional ; M: ebnf-action (transform) ( ast -- parser ) - [ ebnf-action-parser (transform) ] keep - ebnf-action-code string-lines [ parse-lines ] with-compilation-unit action ; + [ parser>> (transform) ] keep + code>> string-lines [ parse-lines ] with-compilation-unit action ; M: ebnf-terminal (transform) ( ast -- parser ) - ebnf-terminal-symbol token sp ; + symbol>> token sp ; M: ebnf-non-terminal (transform) ( ast -- parser ) - ebnf-non-terminal-symbol [ + symbol>> [ , parser get , \ at , ] [ ] make delay sp ; From de3e4e049fdaf177d85553508b888abd9b3a09cf Mon Sep 17 00:00:00 2001 From: Chris Double Date: Wed, 26 Mar 2008 16:21:33 +1300 Subject: [PATCH 052/219] Use cleave instead of get-slots in peg --- extra/peg/peg.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 79c866c768..00271a9ad3 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -3,7 +3,7 @@ USING: kernel sequences strings namespaces math assocs shuffle vectors arrays combinators.lib math.parser match unicode.categories sequences.lib compiler.units parser - words quotations effects memoize accessors ; + words quotations effects memoize accessors combinators.cleave ; IN: peg TUPLE: parse-result remaining ast ; @@ -231,7 +231,7 @@ MATCH-VARS: ?action ; ] ; M: action-parser (compile) ( parser -- quot ) - { p1>> quot>> } get-slots [ compiled-parser ] dip + { [ p1>> ] [ quot>> ] } cleave [ compiled-parser ] dip 2array { ?quot ?action } action-pattern match-replace ; : left-trim-slice ( string -- string ) From 2f73edb3a21a72ddc015c998a9bf29538f971547 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Mar 2008 22:26:33 -0500 Subject: [PATCH 053/219] Fix stat on linux/x86.64 --- extra/unix/stat/linux/64/64.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/unix/stat/linux/64/64.factor b/extra/unix/stat/linux/64/64.factor index be6ad1e3fc..a374551385 100644 --- a/extra/unix/stat/linux/64/64.factor +++ b/extra/unix/stat/linux/64/64.factor @@ -27,5 +27,5 @@ C-STRUCT: stat FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ; FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ; -: stat ( pathname buf -- int ) 3 -rot __xstat ; -: lstat ( pathname buf -- int ) 3 -rot __lxstat ; \ No newline at end of file +: stat ( pathname buf -- int ) 1 -rot __xstat ; +: lstat ( pathname buf -- int ) 1 -rot __lxstat ; From 257a03ace5ca43014f3bae8322bbdf0c9b1aab26 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 26 Mar 2008 01:30:44 -0500 Subject: [PATCH 054/219] Fix multi-methods load error --- extra/multi-methods/multi-methods.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index 9a74cc65e8..42ade34186 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math sequences vectors classes combinators -arrays words assocs parser namespaces definitions +USING: kernel math sequences vectors classes classes.algebra +combinators arrays words assocs parser namespaces definitions prettyprint prettyprint.backend quotations arrays.lib debugger io compiler.units kernel.private effects ; IN: multi-methods From e1ad21a439532b7d60e44c6321abb97b59cd0c75 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 26 Mar 2008 03:57:48 -0500 Subject: [PATCH 055/219] Working on shapes --- core/assocs/assocs-tests.factor | 11 +++ core/assocs/assocs.factor | 6 +- core/bootstrap/compiler/compiler.factor | 2 +- core/bootstrap/image/image.factor | 39 ++++++--- core/bootstrap/layouts/layouts.factor | 5 +- core/bootstrap/primitives.factor | 65 ++++++++++++-- core/classes/classes.factor | 7 -- core/compiler/constants/constants.factor | 2 +- core/cpu/ppc/intrinsics/intrinsics.factor | 12 ++- core/cpu/x86/intrinsics/intrinsics.factor | 17 ++-- core/inference/known-words/known-words.factor | 11 +-- core/inference/transforms/transforms.factor | 4 +- core/kernel/kernel.factor | 39 ++++----- core/optimizer/known-words/known-words.factor | 7 +- core/prettyprint/backend/backend.factor | 5 +- core/quotations/quotations.factor | 4 +- core/slots/slots-docs.factor | 2 +- core/slots/slots.factor | 2 +- core/tuples/tuples-docs.factor | 14 +-- core/tuples/tuples.factor | 87 +++++++++++-------- extra/tools/deploy/shaker/shaker.factor | 1 - vm/data_gc.c | 10 ++- vm/debug.c | 31 ++++++- vm/image.c | 56 ++++++++---- vm/layouts.h | 25 +++++- vm/primitives.c | 3 +- vm/run.c | 5 +- vm/types.c | 66 ++++++++------ vm/types.h | 28 +++++- 29 files changed, 378 insertions(+), 188 deletions(-) mode change 100644 => 100755 core/assocs/assocs-tests.factor diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor old mode 100644 new mode 100755 index a0a60e875a..574002921a --- a/core/assocs/assocs-tests.factor +++ b/core/assocs/assocs-tests.factor @@ -93,3 +93,14 @@ unit-test ] [ F{ 1.0 2.0 } [ dup ] H{ } map>assoc ] unit-test + +[ { 3 } ] [ + [ + 3 + H{ } clone + 2 [ + 2dup [ , f ] cache + ] times + 2drop + ] make +] unit-test diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index ff0938e001..196ec614b7 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -134,11 +134,11 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) (substitute) map ; : cache ( key assoc quot -- value ) - 2over at [ + 2over at* [ >r 3drop r> ] [ - pick rot >r >r call dup r> r> set-at - ] if* ; inline + drop pick rot >r >r call dup r> r> set-at + ] if ; inline : change-at ( key assoc quot -- ) [ >r at r> call ] 3keep drop set-at ; inline diff --git a/core/bootstrap/compiler/compiler.factor b/core/bootstrap/compiler/compiler.factor index 04d57dff16..af2cc79579 100755 --- a/core/bootstrap/compiler/compiler.factor +++ b/core/bootstrap/compiler/compiler.factor @@ -36,7 +36,7 @@ nl { roll -roll declare not - tuple-class-eq? array? hashtable? vector? + array? hashtable? vector? tuple? sbuf? node? tombstone? array-capacity array-nth set-array-nth diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 6aa4b9212d..7fd4361246 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -4,7 +4,7 @@ USING: alien arrays bit-arrays byte-arrays generic assocs hashtables assocs hashtables.private io kernel kernel.private math namespaces parser prettyprint sequences sequences.private strings sbufs vectors words quotations assocs system layouts -splitting growable classes tuples words.private +splitting growable classes tuples tuples.private words.private io.binary io.files vocabs vocabs.loader source-files definitions debugger float-arrays quotations.private sequences.private combinators io.encodings.binary ; @@ -294,17 +294,14 @@ M: bit-array ' bit-array emit-dummy-array ; M: float-array ' float-array emit-dummy-array ; -! Arrays -: emit-array ( list type tag -- pointer ) - >r >r [ ' ] map r> r> [ - dup length emit-fixnum - emit-seq - ] emit-object ; - -: emit-tuple ( obj -- pointer ) +! Tuples +: emit-tuple ( tuple -- pointer ) [ - [ tuple>array unclip transfer-word , % ] { } make - tuple type-number dup emit-array + [ + dup class transfer-word tuple-layout ' , + tuple>array 1 tail-slice [ ' ] map % + ] { } make + tuple type-number dup [ emit-seq ] emit-object ] ! Hack over class word-name "tombstone" = @@ -312,11 +309,31 @@ M: float-array ' float-array emit-dummy-array ; M: tuple ' emit-tuple ; +M: tuple-layout ' + objects get [ + [ + dup layout-hashcode ' , + dup layout-class ' , + dup layout-size ' , + dup layout-superclasses ' , + layout-echelon ' , + ] { } make + \ tuple-layout type-number + object tag-number [ emit-seq ] emit-object + ] cache ; + M: tombstone ' delegate "((tombstone))" "((empty))" ? "hashtables.private" lookup word-def first objects get [ emit-tuple ] cache ; +! Arrays +: emit-array ( list type tag -- pointer ) + >r >r [ ' ] map r> r> [ + dup length emit-fixnum + emit-seq + ] emit-object ; + M: array ' array type-number object tag-number emit-array ; diff --git a/core/bootstrap/layouts/layouts.factor b/core/bootstrap/layouts/layouts.factor index e15a7b4d7c..316fa3cd72 100755 --- a/core/bootstrap/layouts/layouts.factor +++ b/core/bootstrap/layouts/layouts.factor @@ -2,13 +2,13 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces math words kernel alien byte-arrays hashtables vectors strings sbufs arrays bit-arrays -float-arrays quotations assocs layouts tuples ; +float-arrays quotations assocs layouts tuples tuples.private ; BIN: 111 tag-mask set 8 num-tags set 3 tag-bits set -19 num-types set +20 num-types set H{ { fixnum BIN: 000 } @@ -33,4 +33,5 @@ tag-numbers get H{ { alien 16 } { word 17 } { byte-array 18 } + { tuple-layout 19 } } union type-numbers set diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 0f38839c87..253f23238a 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -3,8 +3,8 @@ USING: alien arrays byte-arrays generic hashtables hashtables.private io kernel math namespaces parser sequences strings vectors words quotations assocs layouts classes tuples -kernel.private vocabs vocabs.loader source-files definitions -slots.deprecated classes.union compiler.units +tuples.private kernel.private vocabs vocabs.loader source-files +definitions slots.deprecated classes.union compiler.units bootstrap.image.private io.files ; IN: bootstrap.primitives @@ -33,7 +33,6 @@ H{ } clone changed-words set H{ } clone root-cache set H{ } clone source-files set H{ } clone update-map set -num-types get f builtins set init-caches ! Vocabulary for slot accessors @@ -47,6 +46,9 @@ call call call +! After we execute bootstrap/layouts +num-types get f builtins set + ! Create some empty vocabs where the below primitives and ! classes will go { @@ -141,8 +143,6 @@ call "bignum" "math" create { } define-builtin "bignum" "math" create ">bignum" "math" create 1quotation "coercer" set-word-prop -"tuple" "kernel" create { } define-builtin - "ratio" "math" create { { { "integer" "math" } @@ -178,8 +178,6 @@ call "f" "syntax" lookup { } define-builtin -! do not word... - "array" "arrays" create { } define-builtin "wrapper" "kernel" create { @@ -293,6 +291,48 @@ define-builtin "callstack" "kernel" create { } define-builtin +"tuple-layout" "tuples.private" create { + { + { "fixnum" "math" } + "hashcode" + { "layout-hashcode" "tuples.private" } + f + } + { + { "word" "words" } + "class" + { "layout-class" "tuples.private" } + f + } + { + { "fixnum" "math" } + "size" + { "layout-size" "tuples.private" } + f + } + { + { "array" "arrays" } + "superclasses" + { "layout-superclasses" "tuples.private" } + f + } + { + { "fixnum" "math" } + "echelon" + { "layout-echelon" "tuples.private" } + f + } +} define-builtin + +"tuple" "kernel" create { + { + { "tuple-layout" "tuples.private" } + "layout" + { "tuple-layout" "tuples.private" } + f + } +} define-builtin + ! Define general-t type, which is any object that is not f. "general-t" "kernel" create "f" "syntax" lookup builtins get remove [ ] subset f union-class @@ -439,6 +479,10 @@ builtins get num-tags get tail f union-class define-class } } define-tuple-class +"curry" "kernel" lookup +dup f "inline" set-word-prop +dup tuple-layout [ ] curry define + "compose" "kernel" create { { @@ -454,6 +498,10 @@ builtins get num-tags get tail f union-class define-class } } define-tuple-class +"compose" "kernel" lookup +dup f "inline" set-word-prop +dup tuple-layout [ ] curry define + ! Primitive words : make-primitive ( word vocab n -- ) >r create dup reset-word r> @@ -628,11 +676,10 @@ builtins get num-tags get tail f union-class define-class { "" "kernel" } { "(clone)" "kernel" } { "" "strings" } - { "(>tuple)" "tuples.private" } { "array>quotation" "quotations.private" } { "quotation-xt" "quotations" } { "" "tuples.private" } - { "tuple>array" "tuples" } + { "" "tuples.private" } { "profiling" "tools.profiler.private" } { "become" "kernel.private" } { "(sleep)" "threads.private" } diff --git a/core/classes/classes.factor b/core/classes/classes.factor index e5039d8050..b6082ad334 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -118,10 +118,3 @@ GENERIC: update-methods ( assoc -- ) GENERIC: class ( object -- class ) inline M: object class type type>class ; - - diff --git a/core/compiler/constants/constants.factor b/core/compiler/constants/constants.factor index 277a64225a..11f64c9373 100755 --- a/core/compiler/constants/constants.factor +++ b/core/compiler/constants/constants.factor @@ -15,7 +15,7 @@ IN: compiler.constants : byte-array-offset 2 bootstrap-cells object tag-number - ; : alien-offset 3 bootstrap-cells object tag-number - ; : underlying-alien-offset bootstrap-cell object tag-number - ; -: tuple-class-offset 2 bootstrap-cells tuple tag-number - ; +: tuple-class-offset bootstrap-cell tuple tag-number - ; : class-hash-offset bootstrap-cell object tag-number - ; : word-xt-offset 8 bootstrap-cells object tag-number - ; : word-code-offset 9 bootstrap-cells object tag-number - ; diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor index 91bf5ed1e3..570cd42576 100755 --- a/core/cpu/ppc/intrinsics/intrinsics.factor +++ b/core/cpu/ppc/intrinsics/intrinsics.factor @@ -479,19 +479,17 @@ IN: cpu.ppc.intrinsics } define-intrinsic \ [ - tuple "n" get 2 + cells %allot - ! Store length - "n" operand 12 LI + tuple "layout" get layout-size 2 + cells %allot + ! Store layout + "layout" operand 12 LOAD32 12 11 cell STW - ! Store class - "class" operand 11 2 cells STW ! Zero out the rest of the tuple f v>operand 12 LI - "n" get 1- [ 12 11 rot 3 + cells STW ] each + "layout" get layout-size [ 12 11 rot 2 + cells STW ] each ! Store tagged ptr in reg "tuple" get tuple %store-tagged ] H{ - { +input+ { { f "class" } { [ inline-array? ] "n" } } } + { +input+ { { [ tuple-layout? ] "layout" } } { +scratch+ { { f "tuple" } } } { +output+ { "tuple" } } } define-intrinsic diff --git a/core/cpu/x86/intrinsics/intrinsics.factor b/core/cpu/x86/intrinsics/intrinsics.factor index 99a89eab05..dfe136fc6e 100755 --- a/core/cpu/x86/intrinsics/intrinsics.factor +++ b/core/cpu/x86/intrinsics/intrinsics.factor @@ -336,19 +336,20 @@ IN: cpu.x86.intrinsics } define-intrinsic \ [ - tuple "n" get 2 + cells [ - ! Store length - 1 object@ "n" operand MOV - ! Store class - 2 object@ "class" operand MOV + tuple "layout" get layout-size 2 + cells [ + ! Store layout + "layout" get "scratch" get load-literal + 1 object@ "scratch" operand MOV ! Zero out the rest of the tuple - "n" operand 1- [ 3 + object@ f v>operand MOV ] each + "layout" get layout-size [ + 2 + object@ f v>operand MOV + ] each ! Store tagged ptr in reg "tuple" get tuple %store-tagged ] %allot ] H{ - { +input+ { { f "class" } { [ inline-array? ] "n" } } } - { +scratch+ { { f "tuple" } } } + { +input+ { { [ tuple-layout? ] "layout" } } } + { +scratch+ { { f "tuple" } { f "scratch" } } } { +output+ { "tuple" } } } define-intrinsic diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index 08fb56ced7..0de1e0bc53 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -135,7 +135,7 @@ M: object infer-call ! Variadic tuple constructor \ [ \ - peek-d value-literal { tuple } + peek-d value-literal layout-size { tuple } make-call-node ] "infer" set-word-prop @@ -565,14 +565,11 @@ set-primitive-effect \ quotation-xt { quotation } { integer } set-primitive-effect \ quotation-xt make-flushable -\ { word integer } { quotation } set-primitive-effect +\ { tuple-layout } { tuple } set-primitive-effect \ make-flushable -\ (>tuple) { array } { tuple } set-primitive-effect -\ (>tuple) make-flushable - -\ tuple>array { tuple } { array } set-primitive-effect -\ tuple>array make-flushable +\ { word fixnum array fixnum } { tuple-layout } set-primitive-effect +\ make-foldable \ datastack { } { array } set-primitive-effect \ datastack make-flushable diff --git a/core/inference/transforms/transforms.factor b/core/inference/transforms/transforms.factor index a829bad47e..b3a2bffcfe 100755 --- a/core/inference/transforms/transforms.factor +++ b/core/inference/transforms/transforms.factor @@ -76,7 +76,7 @@ M: duplicated-slots-error summary \ construct-boa [ dup +inlined+ depends-on - dup tuple-size [ ] 2curry + tuple-layout [ ] curry ] 1 define-transform \ construct-empty [ @@ -84,7 +84,7 @@ M: duplicated-slots-error summary peek-d value? [ pop-literal dup +inlined+ depends-on - dup tuple-size [ ] 2curry + tuple-layout [ ] curry swap infer-quot ] [ \ construct-empty 1 1 make-call-node diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 61574e406f..2d99f0793b 100755 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -67,29 +67,7 @@ DEFER: if [ >r tuck 2slip r> while ] [ 2nip call ] if ; inline -! Quotation building -USE: tuples.private - -: curry ( obj quot -- curry ) - \ curry 4 ; - -: 2curry ( obj1 obj2 quot -- curry ) - curry curry ; inline - -: 3curry ( obj1 obj2 obj3 quot -- curry ) - curry curry curry ; inline - -: with ( param obj quot -- obj curry ) - swapd [ swapd call ] 2curry ; inline - -: compose ( quot1 quot2 -- curry ) - \ compose 4 ; - -: 3compose ( quot1 quot2 quot3 -- curry ) - compose compose ; inline - ! Object protocol - GENERIC: delegate ( obj -- delegate ) M: object delegate drop f ; @@ -118,7 +96,6 @@ M: object clone ; M: callstack clone (clone) ; ! Tuple construction - GENERIC# get-slots 1 ( tuple slots -- ... ) GENERIC# set-slots 1 ( ... tuple slots -- ) @@ -132,8 +109,22 @@ GENERIC: construct-boa ( ... class -- tuple ) : construct-delegate ( delegate class -- tuple ) >r { set-delegate } r> construct ; inline -! Booleans +! Quotation building +USE: tuples.private +: 2curry ( obj1 obj2 quot -- curry ) + curry curry ; inline + +: 3curry ( obj1 obj2 obj3 quot -- curry ) + curry curry curry ; inline + +: with ( param obj quot -- obj curry ) + swapd [ swapd call ] 2curry ; inline + +: 3compose ( quot1 quot2 quot3 -- curry ) + compose compose ; inline + +! Booleans : not ( obj -- ? ) f eq? ; inline : >boolean ( obj -- ? ) t f ? ; inline diff --git a/core/optimizer/known-words/known-words.factor b/core/optimizer/known-words/known-words.factor index 0a3442566c..b56f6fdb06 100755 --- a/core/optimizer/known-words/known-words.factor +++ b/core/optimizer/known-words/known-words.factor @@ -11,12 +11,11 @@ classes.algebra optimizer.def-use optimizer.backend optimizer.pattern-match optimizer.inlining float-arrays sequences.private combinators ; -! the output of and has the class which is -! its second-to-last input { } [ [ - dup node-in-d dup length 2 - swap nth node-literal - dup class? [ drop tuple ] unless 1array f + dup node-in-d peek node-literal + dup tuple-layout? [ layout-class ] [ drop tuple ] if + 1array f ] "output-classes" set-word-prop ] each diff --git a/core/prettyprint/backend/backend.factor b/core/prettyprint/backend/backend.factor index 226595aa4d..5d7b967fc4 100755 --- a/core/prettyprint/backend/backend.factor +++ b/core/prettyprint/backend/backend.factor @@ -4,7 +4,7 @@ USING: arrays byte-arrays byte-vectors bit-arrays bit-vectors generic hashtables io assocs kernel math namespaces sequences strings sbufs io.styles vectors words prettyprint.config prettyprint.sections quotations io io.files math.parser effects -tuples classes float-arrays float-vectors ; +tuples tuples.private classes float-arrays float-vectors ; IN: prettyprint.backend GENERIC: pprint* ( obj -- ) @@ -202,3 +202,6 @@ M: wrapper pprint* ] [ pprint-object ] if ; + +M: tuple-layout pprint* + "( tuple layout )" swap present-text ; diff --git a/core/quotations/quotations.factor b/core/quotations/quotations.factor index 65c6da2b06..693e337959 100755 --- a/core/quotations/quotations.factor +++ b/core/quotations/quotations.factor @@ -7,9 +7,9 @@ IN: quotations M: quotation call (call) ; -M: curry call dup 4 slot swap 5 slot call ; +M: curry call dup 3 slot swap 4 slot call ; -M: compose call dup 4 slot swap 5 slot slip call ; +M: compose call dup 3 slot swap 4 slot slip call ; M: wrapper equal? over wrapper? [ [ wrapped ] 2apply = ] [ 2drop f ] if ; diff --git a/core/slots/slots-docs.factor b/core/slots/slots-docs.factor index e4bb307829..5de765313b 100755 --- a/core/slots/slots-docs.factor +++ b/core/slots/slots-docs.factor @@ -12,7 +12,7 @@ ARTICLE: "accessors" "Slot accessors" } "In addition, two utility words are defined for each distinct slot name used in the system:" { $list - { "The " { $emphasis "setter" } " is named " { $snippet "(>>" { $emphasis "slot" } ")" } " and stores a value into a slot. It has stack effect " { $snippet "( object value -- object )" } "." } + { "The " { $emphasis "setter" } " is named " { $snippet ">>" { $emphasis "slot" } } " and stores a value into a slot. It has stack effect " { $snippet "( object value -- object )" } "." } { "The " { $emphasis "changer" } " is named " { $snippet "change-" { $emphasis "slot" } } ". It applies a quotation to the current slot value and stores the result back in the slot; it has stack effect " { $snippet "( object quot -- object )" } "." } } "Since the reader and writer are generic, words can be written which do not depend on the specific class of tuple passed in, but instead work on any tuple that defines slots with certain names." diff --git a/core/slots/slots.factor b/core/slots/slots.factor index ed5de3a439..dfd5c1b32a 100755 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -46,7 +46,7 @@ C: slot-spec : define-writer ( class slot name -- ) writer-word [ set-slot ] define-slot-word ; -: setter-effect T{ effect f { "object" "value" } { "value" } } ; inline +: setter-effect T{ effect f { "object" "value" } { "object" } } ; inline : setter-word ( name -- word ) ">>" prepend setter-effect create-accessor ; diff --git a/core/tuples/tuples-docs.factor b/core/tuples/tuples-docs.factor index 09d93884ad..427c7fbf60 100755 --- a/core/tuples/tuples-docs.factor +++ b/core/tuples/tuples-docs.factor @@ -153,10 +153,6 @@ HELP: tuple= { $description "Low-level tuple equality test. User code should use " { $link = } " instead." } { $warning "This word is in the " { $vocab-link "tuples.private" } " vocabulary because it does not do any type checking. Passing values which are not tuples can result in memory corruption." } ; -HELP: tuple-class-eq? -{ $values { "obj" object } { "class" tuple-class } { "?" "a boolean" } } -{ $description "Tests if " { $snippet "obj" } " is an instance of " { $snippet "class" } "." } ; - HELP: permutation { $values { "seq1" sequence } { "seq2" sequence } { "permutation" "a sequence whose elements are integers or " { $link f } } } { $description "Outputs a permutation for taking " { $snippet "seq1" } " to " { $snippet "seq2" } "." } ; @@ -246,9 +242,13 @@ HELP: tuple>array ( tuple -- array ) { $values { "tuple" tuple } { "array" array } } { $description "Outputs an array having the tuple's slots as elements. The first element is the tuple class word and the second is the delegate; the remainder are declared slots." } ; -HELP: ( class n -- tuple ) -{ $values { "class" tuple-class } { "n" "a non-negative integer" } { "tuple" tuple } } -{ $description "Low-level tuple constructor. User code should never call this directly, and instead use the constructor word which is defined for each tuple. See " { $link "tuples" } "." } ; +HELP: ( layout -- tuple ) +{ $values { "layout" tuple-layout } { "tuple" tuple } } +{ $description "Low-level tuple constructor. User code should never call this directly, and instead use " { $link construct-empty } "." } ; + +HELP: ( ... layout -- tuple ) +{ $values { "..." "values" } { "layout" tuple-layout } { "tuple" tuple } } +{ $description "Low-level tuple constructor. User code should never call this directly, and instead use " { $link construct-boa } "." } ; HELP: construct-empty { $values { "class" tuple-class } { "tuple" tuple } } diff --git a/core/tuples/tuples.factor b/core/tuples/tuples.factor index 02ce49d779..56fb12fffc 100755 --- a/core/tuples/tuples.factor +++ b/core/tuples/tuples.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2007 Slava Pestov. +! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays definitions hashtables kernel kernel.private math namespaces sequences sequences.private @@ -7,33 +7,55 @@ classes classes.private slots slots.deprecated slots.private compiler.units ; IN: tuples -M: tuple delegate 3 slot ; +M: tuple delegate 2 slot ; -M: tuple set-delegate 3 set-slot ; +M: tuple set-delegate 2 set-slot ; -M: tuple class class-of-tuple ; +M: tuple class 1 slot 2 slot { word } declare ; + +ERROR: no-tuple-class class ; + + + +: check-tuple ( class -- ) + dup tuple-class? + [ drop ] [ no-tuple-class ] if ; + +: tuple>array ( tuple -- array ) + dup tuple-layout + [ layout-size swap [ array-nth ] curry map ] keep + layout-class add* ; + +: >tuple ( sequence -- tuple ) + dup first tuple-layout [ + >r 1 tail-slice dup length r> + [ tuple-size min ] keep + [ set-array-nth ] curry + 2each + ] keep ; r over r> array-nth >r array-nth r> = ] 2curry all-integers? ] [ - 3drop f + 2drop f ] if ; -: tuple-class-eq? ( obj class -- ? ) - over tuple? [ swap 2 slot eq? ] [ 2drop f ] if ; inline - : permutation ( seq1 seq2 -- permutation ) swap [ index ] curry map ; : reshape-tuple ( oldtuple permutation -- newtuple ) >r tuple>array 2 cut r> [ [ swap ?nth ] [ drop f ] if* ] with map - append (>tuple) ; + append >tuple ; : reshape-tuples ( class newslots -- ) >r dup "slot-names" word-prop r> permutation @@ -64,42 +86,42 @@ M: tuple class class-of-tuple ; ] unless ] when 2drop ; -GENERIC: tuple-size ( class -- size ) - -M: tuple-class tuple-size "slot-names" word-prop length 2 + ; - -PRIVATE> +M: tuple-class tuple-layout "layout" word-prop ; : define-tuple-predicate ( class -- ) - dup [ tuple-class-eq? ] curry define-predicate ; + dup tuple-layout + [ over tuple? [ swap 1 slot eq? ] [ 2drop f ] if ] curry + define-predicate ; : delegate-slot-spec T{ slot-spec f object "delegate" - 3 + 2 delegate set-delegate } ; : define-tuple-slots ( class slots -- ) - dupd 4 simple-slots + dupd 3 simple-slots 2dup [ slot-spec-name ] map "slot-names" set-word-prop 2dup delegate-slot-spec add* "slots" set-word-prop 2dup define-slots define-accessors ; -ERROR: no-tuple-class class ; +: define-tuple-layout ( class -- ) + dup + dup "slot-names" word-prop length 1+ { } 0 + "layout" set-word-prop ; -: check-tuple ( class -- ) - dup tuple-class? - [ drop ] [ no-tuple-class ] if ; +PRIVATE> : define-tuple-class ( class slots -- ) 2dup check-shape over f tuple tuple-class define-class - over define-tuple-predicate - define-tuple-slots ; + dupd define-tuple-slots + dup define-tuple-layout + define-tuple-predicate ; M: tuple clone (clone) dup delegate clone over set-delegate ; @@ -107,21 +129,14 @@ M: tuple clone M: tuple equal? over tuple? [ tuple= ] [ 2drop f ] if ; -: (delegates) ( obj -- ) - [ dup , delegate (delegates) ] when* ; - : delegates ( obj -- seq ) [ dup ] [ [ delegate ] keep ] [ ] unfold nip ; : is? ( obj quot -- ? ) >r delegates r> contains? ; inline -: >tuple ( seq -- tuple ) - >vector dup first tuple-size over set-length - >array (>tuple) ; - M: tuple hashcode* [ - dup array-capacity -rot 0 -rot [ + dup tuple-size -rot 0 -rot [ swapd array-nth hashcode* bitxor ] 2curry reduce ] recursive-hashcode ; @@ -131,7 +146,7 @@ M: tuple hashcode* ! Definition protocol M: tuple-class reset-class { - "metaclass" "superclass" "slot-names" "slots" + "metaclass" "superclass" "slot-names" "slots" "layout" } reset-props ; M: object get-slots ( obj slots -- ... ) @@ -141,10 +156,10 @@ M: object set-slots ( ... obj slots -- ) get-slots ; M: object construct-empty ( class -- tuple ) - dup tuple-size ; + tuple-layout ; M: object construct ( ... slots class -- tuple ) construct-empty [ swap set-slots ] keep ; M: object construct-boa ( ... class -- tuple ) - dup tuple-size ; + tuple-layout ; diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor index f731f5d694..cf23e42283 100755 --- a/extra/tools/deploy/shaker/shaker.factor +++ b/extra/tools/deploy/shaker/shaker.factor @@ -155,7 +155,6 @@ IN: tools.deploy.shaker layouts:tag-numbers layouts:type-numbers lexer-factory - lexer-factory listener:listener-hook root-cache vocab-roots diff --git a/vm/data_gc.c b/vm/data_gc.c index 342bbb6af4..0a1fad575a 100755 --- a/vm/data_gc.c +++ b/vm/data_gc.c @@ -156,10 +156,12 @@ CELL untagged_object_size(CELL pointer) /* Size of the data area of an object pointed to by an untagged pointer */ CELL unaligned_object_size(CELL pointer) { + F_TUPLE *tuple; + F_TUPLE_LAYOUT *layout; + switch(untag_header(get(pointer))) { case ARRAY_TYPE: - case TUPLE_TYPE: case BIGNUM_TYPE: return array_size(array_capacity((F_ARRAY*)pointer)); case BYTE_ARRAY_TYPE: @@ -173,6 +175,10 @@ CELL unaligned_object_size(CELL pointer) float_array_capacity((F_FLOAT_ARRAY*)pointer)); case STRING_TYPE: return string_size(string_capacity((F_STRING*)pointer)); + case TUPLE_TYPE: + tuple = untag_object(pointer); + layout = untag_object(tuple->layout); + return tuple_size(layout); case QUOTATION_TYPE: return sizeof(F_QUOTATION); case WORD_TYPE: @@ -192,6 +198,8 @@ CELL unaligned_object_size(CELL pointer) case CALLSTACK_TYPE: return callstack_size( untag_fixnum_fast(((F_CALLSTACK *)pointer)->length)); + case TUPLE_LAYOUT_TYPE: + return sizeof(F_TUPLE_LAYOUT); default: critical_error("Invalid header",pointer); return -1; /* can't happen */ diff --git a/vm/debug.c b/vm/debug.c index 279d925bd7..7e18738afc 100755 --- a/vm/debug.c +++ b/vm/debug.c @@ -57,6 +57,35 @@ void print_array(F_ARRAY* array, CELL nesting) printf("..."); } +void print_tuple(F_TUPLE* tuple, CELL nesting) +{ + F_TUPLE_LAYOUT *layout = untag_object(tuple->layout); + CELL length = to_fixnum(layout->size); + + printf(" "); + print_nested_obj(layout->class,nesting); + + CELL i; + bool trimmed; + + if(length > 10) + { + trimmed = true; + length = 10; + } + else + trimmed = false; + + for(i = 0; i < length; i++) + { + printf(" "); + print_nested_obj(tuple_nth(tuple,i),nesting); + } + + if(trimmed) + printf("..."); +} + void print_nested_obj(CELL obj, F_FIXNUM nesting) { if(nesting <= 0) @@ -83,7 +112,7 @@ void print_nested_obj(CELL obj, F_FIXNUM nesting) break; case TUPLE_TYPE: printf("T{"); - print_array(untag_object(obj),nesting - 1); + print_tuple(untag_object(obj),nesting - 1); printf(" }"); break; case ARRAY_TYPE: diff --git a/vm/image.c b/vm/image.c index d9f8ac2461..28c6c40c1d 100755 --- a/vm/image.c +++ b/vm/image.c @@ -216,25 +216,45 @@ void fixup_callstack_object(F_CALLSTACK *stack) /* Initialize an object in a newly-loaded image */ void relocate_object(CELL relocating) { - do_slots(relocating,data_fixup); - - switch(untag_header(get(relocating))) + /* Tuple relocation is a bit trickier; we have to fix up the + fixup object before we can get the tuple size, so do_slots is + out of the question */ + if(untag_header(get(relocating)) == TUPLE_TYPE) { - case WORD_TYPE: - fixup_word((F_WORD *)relocating); - break; - case QUOTATION_TYPE: - fixup_quotation((F_QUOTATION *)relocating); - break; - case DLL_TYPE: - ffi_dlopen((F_DLL *)relocating); - break; - case ALIEN_TYPE: - fixup_alien((F_ALIEN *)relocating); - break; - case CALLSTACK_TYPE: - fixup_callstack_object((F_CALLSTACK *)relocating); - break; + data_fixup((CELL *)relocating + 1); + + CELL scan = relocating + 2 * CELLS; + CELL size = untagged_object_size(relocating); + CELL end = relocating + size; + + while(scan < end) + { + data_fixup((CELL *)scan); + scan += CELLS; + } + } + else + { + do_slots(relocating,data_fixup); + + switch(untag_header(get(relocating))) + { + case WORD_TYPE: + fixup_word((F_WORD *)relocating); + break; + case QUOTATION_TYPE: + fixup_quotation((F_QUOTATION *)relocating); + break; + case DLL_TYPE: + ffi_dlopen((F_DLL *)relocating); + break; + case ALIEN_TYPE: + fixup_alien((F_ALIEN *)relocating); + break; + case CALLSTACK_TYPE: + fixup_callstack_object((F_CALLSTACK *)relocating); + break; + } } } diff --git a/vm/layouts.h b/vm/layouts.h index 5ed7c83df2..ff938309e7 100755 --- a/vm/layouts.h +++ b/vm/layouts.h @@ -58,8 +58,9 @@ typedef signed long long s64; #define ALIEN_TYPE 16 #define WORD_TYPE 17 #define BYTE_ARRAY_TYPE 18 +#define TUPLE_LAYOUT_TYPE 19 -#define TYPE_COUNT 19 +#define TYPE_COUNT 20 INLINE bool immediate_p(CELL obj) { @@ -224,3 +225,25 @@ typedef struct /* Frame size in bytes */ CELL size; } F_STACK_FRAME; + +typedef struct +{ + CELL header; + /* tagged fixnum */ + CELL hashcode; + /* tagged */ + CELL class; + /* tagged fixnum */ + CELL size; + /* tagged array */ + CELL superclasses; + /* tagged fixnum */ + CELL echelon; +} F_TUPLE_LAYOUT; + +typedef struct +{ + CELL header; + /* tagged layout */ + CELL layout; +} F_TUPLE; diff --git a/vm/primitives.c b/vm/primitives.c index ce26c20f63..203ebb7f6b 100755 --- a/vm/primitives.c +++ b/vm/primitives.c @@ -169,11 +169,10 @@ void *primitives[] = { primitive_wrapper, primitive_clone, primitive_string, - primitive_to_tuple, primitive_array_to_quotation, primitive_quotation_xt, primitive_tuple, - primitive_tuple_to_array, + primitive_tuple_layout, primitive_profiling, primitive_become, primitive_sleep, diff --git a/vm/run.c b/vm/run.c index 2e541a5b6c..d03d999ffd 100755 --- a/vm/run.c +++ b/vm/run.c @@ -320,8 +320,9 @@ DEFINE_PRIMITIVE(class_hash) CELL tag = TAG(obj); if(tag == TUPLE_TYPE) { - F_WORD *class = untag_object(get(SLOT(obj,2))); - drepl(class->hashcode); + F_TUPLE *tuple = untag_object(obj); + F_TUPLE_LAYOUT *layout = untag_object(tuple->layout); + drepl(layout->hashcode); } else if(tag == OBJECT_TYPE) drepl(get(UNTAG(obj))); diff --git a/vm/types.c b/vm/types.c index fb61213385..24bb4cb3ca 100755 --- a/vm/types.c +++ b/vm/types.c @@ -379,45 +379,61 @@ DEFINE_PRIMITIVE(resize_float_array) dpush(tag_object(reallot_float_array(array,capacity))); } +/* Tuple layouts */ +DEFINE_PRIMITIVE(tuple_layout) +{ + F_TUPLE_LAYOUT *layout = allot_object(TUPLE_LAYOUT_TYPE,sizeof(F_TUPLE_LAYOUT)); + layout->echelon = dpop(); + layout->superclasses = dpop(); + layout->size = dpop(); + layout->class = dpop(); + layout->hashcode = untag_word(layout->class)->hashcode; + dpush(tag_object(layout)); +} + /* Tuples */ /* push a new tuple on the stack */ +F_TUPLE *allot_tuple(F_TUPLE_LAYOUT *layout) +{ + REGISTER_UNTAGGED(layout); + F_TUPLE *tuple = allot_object(TUPLE_TYPE,tuple_size(layout)); + UNREGISTER_UNTAGGED(layout); + tuple->layout = tag_object(layout); + return tuple; +} + DEFINE_PRIMITIVE(tuple) { - CELL size = unbox_array_size(); - F_ARRAY *array = allot_array(TUPLE_TYPE,size,F); - set_array_nth(array,0,dpop()); - dpush(tag_tuple(array)); + F_TUPLE_LAYOUT *layout = untag_object(dpop()); + F_FIXNUM size = to_fixnum(layout->size); + + F_TUPLE *tuple = allot_tuple(layout); + F_FIXNUM i; + for(i = size - 1; i >= 0; i--) + put(AREF(tuple,i),F); + + dpush(tag_tuple(tuple)); } /* push a new tuple on the stack, filling its slots from the stack */ DEFINE_PRIMITIVE(tuple_boa) { - CELL size = unbox_array_size(); - F_ARRAY *array = allot_array(TUPLE_TYPE,size,F); - set_array_nth(array,0,dpop()); + F_TUPLE_LAYOUT *layout = untag_object(dpop()); + F_FIXNUM size = to_fixnum(layout->size); - CELL i; - for(i = size - 1; i >= 2; i--) - set_array_nth(array,i,dpop()); + REGISTER_UNTAGGED(layout); + F_TUPLE *tuple = allot_tuple(layout); + UNREGISTER_UNTAGGED(layout); - dpush(tag_tuple(array)); -} + /* set delegate slot */ + put(AREF(tuple,0),F); -DEFINE_PRIMITIVE(tuple_to_array) -{ - CELL object = dpeek(); - type_check(TUPLE_TYPE,object); - object = RETAG(clone(object),OBJECT_TYPE); - set_slot(object,0,tag_header(ARRAY_TYPE)); - drepl(object); -} + F_FIXNUM i; + for(i = size - 1; i >= 1; i--) + put(AREF(tuple,i),dpop()); -DEFINE_PRIMITIVE(to_tuple) -{ - CELL object = RETAG(clone(dpeek()),TUPLE_TYPE); - set_slot(object,0,tag_header(TUPLE_TYPE)); - drepl(object); + dpush(tag_tuple(tuple)); } /* Strings */ diff --git a/vm/types.h b/vm/types.h index 62b2e06dd0..03ac84d5a5 100755 --- a/vm/types.h +++ b/vm/types.h @@ -96,11 +96,34 @@ DEFINE_UNTAG(F_QUOTATION,QUOTATION_TYPE,quotation) DEFINE_UNTAG(F_WORD,WORD_TYPE,word) -INLINE CELL tag_tuple(F_ARRAY *tuple) +INLINE CELL tag_tuple(F_TUPLE *tuple) { return RETAG(tuple,TUPLE_TYPE); } +INLINE F_TUPLE *untag_tuple(CELL object) +{ + type_check(TUPLE_TYPE,object); + return untag_object(object); +} + +INLINE CELL tuple_size(F_TUPLE_LAYOUT *layout) +{ + CELL size = untag_fixnum_fast(layout->size); + return sizeof(F_TUPLE) + size * CELLS; +} + +INLINE CELL tuple_nth(F_TUPLE *tuple, CELL slot) +{ + return get(AREF(tuple,slot)); +} + +INLINE void set_tuple_nth(F_TUPLE *tuple, CELL slot, CELL value) +{ + put(AREF(tuple,slot),value); + write_barrier((CELL)tuple); +} + /* Prototypes */ DLLEXPORT void box_boolean(bool value); DLLEXPORT bool to_boolean(CELL value); @@ -116,12 +139,11 @@ CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4); DECLARE_PRIMITIVE(array); DECLARE_PRIMITIVE(tuple); DECLARE_PRIMITIVE(tuple_boa); +DECLARE_PRIMITIVE(tuple_layout); DECLARE_PRIMITIVE(byte_array); DECLARE_PRIMITIVE(bit_array); DECLARE_PRIMITIVE(float_array); DECLARE_PRIMITIVE(clone); -DECLARE_PRIMITIVE(tuple_to_array); -DECLARE_PRIMITIVE(to_tuple); F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill); DECLARE_PRIMITIVE(resize_array); From 64203f762d23849b23f0421f20b6123bcd0e6665 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 26 Mar 2008 14:41:09 -0400 Subject: [PATCH 056/219] Docs improvements; simplification of design of io.encodings.8-bit --- core/io/encodings/encodings-docs.factor | 15 +++++--- extra/help/handbook/handbook.factor | 11 ++++-- extra/io/encodings/8-bit/8-bit-docs.factor | 8 +++-- extra/io/encodings/8-bit/8-bit.factor | 41 ++++++++-------------- extra/io/encodings/utf16/utf16-docs.factor | 12 ++++--- 5 files changed, 47 insertions(+), 40 deletions(-) diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor index 07e0f9f401..bdd9e56d87 100644 --- a/core/io/encodings/encodings-docs.factor +++ b/core/io/encodings/encodings-docs.factor @@ -19,20 +19,23 @@ HELP: { $values { "stream" "an output stream" } { "encoding" "an encoding descriptor" } { "newstream" "an encoded output stream" } } -{ $description "Wraps the given stream in a new stream using the given encoding for all output. The encoding descriptor can either be a class or an instance of something conforming to the " { $link "encodings-protocol" } "." } ; +{ $description "Wraps the given stream in a new stream using the given encoding for all output. The encoding descriptor can either be a class or an instance of something conforming to the " { $link "encodings-protocol" } "." } +$low-level-note ; HELP: { $values { "stream" "an input stream" } { "encoding" "an encoding descriptor" } { "newstream" "an encoded output stream" } } -{ $description "Wraps the given stream in a new stream using the given encoding for all input. The encoding descriptor can either be a class or an instance of something conforming to the " { $link "encodings-protocol" } "." } ; +{ $description "Wraps the given stream in a new stream using the given encoding for all input. The encoding descriptor can either be a class or an instance of something conforming to the " { $link "encodings-protocol" } "." } +$low-level-note ; HELP: { $values { "stream-in" "an input stream" } { "stream-out" "an output stream" } { "encoding" "an encoding descriptor" } { "duplex" "an encoded duplex stream" } } -{ $description "Wraps the given streams in an encoder or decoder stream, and puts them together in a duplex stream for input and output. If either input stream is already encoded, that encoding is stripped off before it is reencoded. The encoding descriptor must conform to the " { $link "encodings-protocol" } "." } ; +{ $description "Wraps the given streams in an encoder or decoder stream, and puts them together in a duplex stream for input and output. If either input stream is already encoded, that encoding is stripped off before it is reencoded. The encoding descriptor must conform to the " { $link "encodings-protocol" } "." } +$low-level-note ; { } related-words @@ -58,12 +61,14 @@ ARTICLE: "encodings-protocol" "Encoding protocol" HELP: decode-char { $values { "stream" "an underlying input stream" } { "encoding" "An encoding descriptor tuple" } { "char/f" "a code point or " { $link f } } } -{ $description "Reads a single code point from the underlying stream, interpreting it by the encoding. This should not be used directly." } ; +{ $contract "Reads a single code point from the underlying stream, interpreting it by the encoding." } +$low-level-note ; HELP: encode-char { $values { "char" "a character" } { "stream" "an underlying output stream" } { "encoding" "an encoding descriptor" } } -{ $description "Writes the code point in the encoding to the underlying stream given. This should not be used directly." } ; +{ $contract "Writes the code point in the encoding to the underlying stream given." } +$low-level-note ; { encode-char decode-char } related-words diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index 4079386d7f..8963c2b1ad 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -178,9 +178,16 @@ ARTICLE: "encodings-introduction" "An introduction to encodings" "Not all encodings can represent all Unicode code points, but Unicode can represent basically everything that exists in modern encodings. Some encodings are language-specific, and some can represent everything in Unicode. Though the world is moving toward Unicode and UTF-8, the reality today is that there are several encodings which must be taken into account." $nl "Factor uses a system of encoding descriptors to denote encodings. Encoding descriptors are objects which describe encodings. Examples are " { $link utf8 } ", " { $link ascii } " and " { $link binary } ". Encoding descriptors can be passed around independently. Each encoding descriptor has some method for constructing an encoded or decoded stream, and the resulting stream has an encoding descriptor stored which has methods for reading or writing characters." $nl "Constructors for streams which deal with bytes usually take an encoding as an explicit parameter. For example, to open a text file for reading whose contents are in UTF-8, use the following" -{ $code "\"filename\" utf8 " } +{ $code "\"file.txt\" utf8 " } "If there is an error in the encoded stream, a replacement character (0xFFFD) will be inserted. To throw an exception upon error, use a strict encoding as follows" -{ $code "\"filename\" utf8 strict " } ; +{ $code "\"file.txt\" utf8 strict " } +"In a similar way, encodings can be specified when opening a file for writing." +{ $code "\"file.txt\" ascii " } +"An encoding is also needed for some words that don't return streams, such as " { $link file-contents } ", for example" +{ $code "\"file.txt\" utf16 file-contents" } +"Encoding descriptors are also used by " { $link "io.streams.byte-array" } " and taken by combinators like " { $link with-file-writer } " and " { $link with-byte-reader } " which deal with streams. It is " { $emphasis "not" } " used with " { $link "io.streams.string" } " because these deal with abstract text." +$nl +"When the " { $link binary } " encoding is used, a " { $link byte-array } " is expected for writing and returned for reading, since the stream deals with bytes. All other encodings deal with strings, since they are used to represent text." ; ARTICLE: "io" "Input and output" { $heading "Streams" } diff --git a/extra/io/encodings/8-bit/8-bit-docs.factor b/extra/io/encodings/8-bit/8-bit-docs.factor index 8e5fd815bc..e8dadc13f7 100644 --- a/extra/io/encodings/8-bit/8-bit-docs.factor +++ b/extra/io/encodings/8-bit/8-bit-docs.factor @@ -24,14 +24,18 @@ ARTICLE: "io.encodings.8-bit" "8-bit encodings" { $subsection windows-1252 } { $subsection ebcdic } { $subsection mac-roman } -"Other encodings can be defined using the following utility" +"Words used in defining these" +{ $subsection 8-bit } { $subsection define-8-bit-encoding } ; 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: define-8-bit-encoding { $values { "name" "a string" } { "path" "a path" } } -{ $description "Creates a new encoding with the given name, using the resource file at the path to tell how to encode and decode octets. The resource file should be in a similar format to those at ftp://ftp.unicode.org/Public/MAPPINGS/ISO8859/" } ; +{ $description "Creates a new encoding with the given name, using the resource file at the path to tell how to encode and decode octets. The resource file should be in a similar format to those at " { $url "ftp://ftp.unicode.org/Public/MAPPINGS/ISO8859/" } } ; 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." } diff --git a/extra/io/encodings/8-bit/8-bit.factor b/extra/io/encodings/8-bit/8-bit.factor index c041e699a2..2e33075df0 100644 --- a/extra/io/encodings/8-bit/8-bit.factor +++ b/extra/io/encodings/8-bit/8-bit.factor @@ -3,7 +3,7 @@ USING: math.parser arrays io.encodings sequences kernel assocs hashtables io.encodings.ascii combinators.cleave generic parser tuples words io io.files splitting namespaces -classes quotations math compiler.units ; +classes quotations math compiler.units accessors ; IN: io.encodings.8-bit ch ] [ ch>byte ] bi ; -: empty-tuple-class ( string -- class ) - in get create - dup { f } "slots" set-word-prop - dup predicate-word drop - dup { } define-tuple-class ; +TUPLE: 8-bit name decode encode ; -: data-quot ( class word data -- quot ) - >r [ word-name ] 2apply "/" swap 3append - "/data" append in get create dup 1quotation swap r> - 1quotation define ; +: encode-8-bit ( char stream assoc -- ) + swapd at* [ encode-error ] unless swap stream-write1 ; -: method-with-data ( class data word quot -- ) - >r swap >r 2dup r> data-quot r> - compose >r create-method r> define ; +M: 8-bit encode-char + encode>> encode-8-bit ; -: encode-8-bit ( char stream encoding assoc -- ) - nip swapd at* [ encode-error ] unless swap stream-write1 ; - -: define-encode-char ( class assoc -- ) - \ encode-char [ encode-8-bit ] method-with-data ; - -: decode-8-bit ( stream encoding array -- char/f ) - nip swap stream-read1 +: decode-8-bit ( stream array -- char/f ) + swap stream-read1 dup [ swap nth [ replacement-char ] unless* ] - [ drop f ] if* ; + [ nip ] if ; -: define-decode-char ( class array -- ) - \ decode-char [ decode-8-bit ] method-with-data ; +M: 8-bit decode-char + decode>> decode-8-bit ; -: 8-bit-methods ( class byte>ch ch>byte -- ) - >r over r> define-encode-char define-decode-char ; +: make-8-bit ( word byte>ch ch>byte -- ) + [ 8-bit construct-boa ] 2curry dupd curry define ; : define-8-bit-encoding ( name path -- ) - >r empty-tuple-class r> parse-file 8-bit-methods ; + >r in get create r> parse-file make-8-bit ; PRIVATE> diff --git a/extra/io/encodings/utf16/utf16-docs.factor b/extra/io/encodings/utf16/utf16-docs.factor index 7198cb2b27..bc0e943415 100644 --- a/extra/io/encodings/utf16/utf16-docs.factor +++ b/extra/io/encodings/utf16/utf16-docs.factor @@ -11,15 +11,19 @@ ARTICLE: "io.encodings.utf16" "UTF-16" ABOUT: "io.encodings.utf16" HELP: utf16le -{ $class-description "The encoding descriptor for UTF-16LE, that is, UTF-16 in little endian, without a byte order mark. Streams can be made which read or write wth this encoding." } ; +{ $class-description "The encoding descriptor for UTF-16LE, that is, UTF-16 in little endian, without a byte order mark. Streams can be made which read or write wth this encoding." } +{ $see-also "encodings-introduction" } ; HELP: utf16be -{ $class-description "The encoding descriptor for UTF-16BE, that is, UTF-16 in big endian, without a byte order mark. Streams can be made which read or write wth this encoding." } ; +{ $class-description "The encoding descriptor for UTF-16BE, that is, UTF-16 in big endian, without a byte order mark. Streams can be made which read or write wth this encoding." } +{ $see-also "encodings-introduction" } ; HELP: utf16 -{ $class-description "The encoding descriptor for UTF-16, that is, UTF-16 with a byte order mark. This is the most useful for general input and output in UTF-16. Streams can be made which read or write wth this encoding." } ; +{ $class-description "The encoding descriptor for UTF-16, that is, UTF-16 with a byte order mark. This is the most useful for general input and output in UTF-16. Streams can be made which read or write wth this encoding." } +{ $see-also "encodings-introduction" } ; HELP: utf16n -{ $class-description "The encoding descriptor for UTF-16 without a byte order mark in native endian order. This is useful mostly for FFI calls which take input of strings in of wide_t*." } ; +{ $class-description "The encoding descriptor for UTF-16 without a byte order mark in native endian order. This is useful mostly for FFI calls which take input of strings in of wide_t*." } +{ $see-also "encodings-introduction" } ; { utf16 utf16le utf16be utf16n } related-words From 24466cfc57cd1e7cda29130fef91288e22963f16 Mon Sep 17 00:00:00 2001 From: erg Date: Wed, 26 Mar 2008 22:39:16 -0500 Subject: [PATCH 057/219] normalize-pathname all ova tha place --- core/io/files/files-tests.factor | 7 ++----- core/io/files/files.factor | 6 +++--- extra/io/unix/files/files.factor | 4 ++-- extra/io/unix/launcher/launcher-tests.factor | 14 +++++++++++++- extra/io/unix/launcher/launcher.factor | 5 +++-- extra/io/windows/files/files.factor | 5 ++++- extra/io/windows/windows.factor | 2 +- 7 files changed, 28 insertions(+), 15 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 51bf79e29c..bb8e997c68 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -132,15 +132,12 @@ io.encodings.utf8 ; [ t ] [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test [ t ] [ - temp-directory [ "hi" "test41" utf8 set-file-contents ] with-directory + temp-directory [ "hi41" "test41" utf8 set-file-contents ] with-directory temp-directory "test41" append-path utf8 file-contents "hi41" = ] unit-test [ t ] [ - temp-directory [ - "test43" utf8 [ "hi43" write ] with-stream - ] with-directory - temp-directory "test43" append-path utf8 file-contents "hi43" = + temp-directory [ "test41" file-info size>> ] with-directory 4 = ] unit-test [ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 64d8e25ee2..78f1612cb8 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -13,13 +13,13 @@ HOOK: (file-writer) io-backend ( path -- stream ) HOOK: (file-appender) io-backend ( path -- stream ) : ( path encoding -- stream ) - swap (file-reader) swap ; + swap normalize-pathname (file-reader) swap ; : ( path encoding -- stream ) - swap (file-writer) swap ; + swap normalize-pathname (file-writer) swap ; : ( path encoding -- stream ) - swap (file-appender) swap ; + swap normalize-pathname (file-appender) swap ; : file-lines ( path encoding -- seq ) lines ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 1e7d682314..2888231e20 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -94,7 +94,7 @@ M: unix-io copy-file ( from to -- ) \ file-info construct-boa ; M: unix-io file-info ( path -- info ) - stat* stat>file-info ; + normalize-pathname stat* stat>file-info ; M: unix-io link-info ( path -- info ) - lstat* stat>file-info ; + normalize-pathname lstat* stat>file-info ; diff --git a/extra/io/unix/launcher/launcher-tests.factor b/extra/io/unix/launcher/launcher-tests.factor index 9e19245d01..7e527196be 100755 --- a/extra/io/unix/launcher/launcher-tests.factor +++ b/extra/io/unix/launcher/launcher-tests.factor @@ -1,7 +1,7 @@ IN: io.unix.launcher.tests USING: io.files tools.test io.launcher arrays io namespaces continuations math io.encodings.binary io.encodings.ascii -accessors kernel sequences ; +accessors kernel sequences io.encodings.utf8 ; [ ] [ [ "launcher-test-1" temp-file delete-file ] ignore-errors @@ -95,3 +95,15 @@ accessors kernel sequences ; +replace-environment+ >>environment-mode ascii lines ] unit-test + +[ "hi\n" ] [ + temp-directory [ + [ "aloha" delete-file ] ignore-errors + + { "echo" "hi" } >>command + "aloha" >>stdout + try-process + ] with-directory + temp-directory "aloha" append-path + utf8 file-contents +] unit-test diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 0cbb78b881..1292f2cacf 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -37,7 +37,8 @@ USE: unix 2nip reset-fd ; : redirect-file ( obj mode fd -- ) - >r file-mode open dup io-error r> redirect-fd ; + >r >r normalize-pathname r> file-mode + open dup io-error r> redirect-fd ; : redirect-closed ( obj mode fd -- ) >r >r drop "/dev/null" r> r> redirect-file ; @@ -67,9 +68,9 @@ USE: unix : spawn-process ( process -- * ) [ - current-directory get cd setup-priority setup-redirection + current-directory get cd dup pass-environment? [ dup get-environment set-os-envs ] when diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 094014fac6..b4513f7da8 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -89,4 +89,7 @@ SYMBOLS: +read-only+ +hidden+ +system+ ] if ; M: windows-nt-io file-info ( path -- info ) - get-file-information-stat ; + normalize-pathname get-file-information-stat ; + +M: windows-nt-io link-info ( path -- info ) + file-info ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index dac55664a4..635a992777 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -51,7 +51,7 @@ M: win32-file close-handle ( handle -- ) ! Clean up resources (open handle) if add-completion fails : open-file ( path access-mode create-mode flags -- handle ) [ - >r >r >r normalize-pathname r> + >r >r share-mode security-attributes-inherit r> r> CreateFile-flags f CreateFile dup invalid-handle? dup close-later dup add-completion From 5bab5de16d64a49e9157f4e9835a185cd3638c02 Mon Sep 17 00:00:00 2001 From: erg Date: Wed, 26 Mar 2008 22:47:13 -0500 Subject: [PATCH 058/219] make directory work inside with-directory --- core/io/backend/backend.factor | 4 ++-- core/io/files/files-tests.factor | 6 ++++++ 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 8cfcbb71de..151dbc7df7 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -17,10 +17,10 @@ HOOK: io-multiplex io-backend ( ms -- ) HOOK: normalize-directory io-backend ( str -- newstr ) -M: object normalize-directory ; - HOOK: normalize-pathname io-backend ( str -- newstr ) +M: object normalize-directory normalize-pathname ; + : set-io-backend ( io-backend -- ) io-backend set-global init-io init-stdio ; diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index bb8e997c68..369ecc6868 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -83,6 +83,12 @@ io.encodings.utf8 ; "delete-tree-test" temp-file delete-tree ] unit-test +[ { { "kernel" t } } ] [ + "core" resource-path [ + "." directory [ first "kernel" = ] subset + ] with-directory +] unit-test + [ ] [ "copy-tree-test/a/b/c" temp-file make-directories ] unit-test From f05fef0a630c73b13e60caedae3dec6931d092e0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 26 Mar 2008 23:11:55 -0500 Subject: [PATCH 059/219] Fix PowerPC compiler backend --- core/cpu/ppc/intrinsics/intrinsics.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor index 570cd42576..8a2f41ec12 100755 --- a/core/cpu/ppc/intrinsics/intrinsics.factor +++ b/core/cpu/ppc/intrinsics/intrinsics.factor @@ -489,7 +489,7 @@ IN: cpu.ppc.intrinsics ! Store tagged ptr in reg "tuple" get tuple %store-tagged ] H{ - { +input+ { { [ tuple-layout? ] "layout" } } + { +input+ { { [ tuple-layout? ] "layout" } } } { +scratch+ { { f "tuple" } } } { +output+ { "tuple" } } } define-intrinsic From caf3ebb31d9278970cf78bdcc80e98f0f320c121 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 27 Mar 2008 00:32:41 -0400 Subject: [PATCH 060/219] Fixing 8-bit encodings --- extra/io/encodings/8-bit/8-bit.factor | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/extra/io/encodings/8-bit/8-bit.factor b/extra/io/encodings/8-bit/8-bit.factor index 2e33075df0..d29760a3e0 100644 --- a/extra/io/encodings/8-bit/8-bit.factor +++ b/extra/io/encodings/8-bit/8-bit.factor @@ -3,7 +3,7 @@ USING: math.parser arrays io.encodings sequences kernel assocs hashtables io.encodings.ascii combinators.cleave generic parser tuples words io io.files splitting namespaces -classes quotations math compiler.units accessors ; +math compiler.units accessors ; IN: io.encodings.8-bit ] map ] map ; + [ "\t" split 2 head [ 2 tail-if hex> ] map ] map ; : byte>ch ( assoc -- array ) 256 replacement-char @@ -77,4 +77,8 @@ M: 8-bit decode-char PRIVATE> -[ mappings [ full-path define-8-bit-encoding ] assoc-each ] with-compilation-unit +[ + "io.encodings.8-bit" in [ + mappings [ full-path define-8-bit-encoding ] assoc-each + ] with-variable +] with-compilation-unit From 15c68a23f85a16480cdfe4b8bc74849510153a47 Mon Sep 17 00:00:00 2001 From: erg Date: Wed, 26 Mar 2008 23:47:51 -0500 Subject: [PATCH 061/219] remove ?resource-path and resource-exists? --- core/bootstrap/stage1.factor | 2 +- core/io/files/files-docs.factor | 9 --------- core/io/files/files-tests.factor | 4 ++++ core/io/files/files.factor | 20 +++++++++++-------- core/parser/parser.factor | 4 ++-- core/source-files/source-files.factor | 2 +- core/vocabs/loader/loader.factor | 2 +- extra/editors/editors.factor | 4 ++-- .../templating/fhtml/fhtml-tests.factor | 2 +- .../http/server/templating/fhtml/fhtml.factor | 2 +- extra/project-euler/project-euler.factor | 2 +- extra/tools/deploy/test/3/3.factor | 2 +- extra/tools/vocabs/vocabs.factor | 17 ++++++++-------- extra/ui/freetype/freetype.factor | 2 +- 14 files changed, 36 insertions(+), 38 deletions(-) diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor index 74b4d03cbb..34f758c9df 100755 --- a/core/bootstrap/stage1.factor +++ b/core/bootstrap/stage1.factor @@ -39,7 +39,7 @@ vocabs.loader system debugger continuations ; [ "resource:core/bootstrap/stage2.factor" - dup resource-exists? [ + dup exists? [ [ run-file ] [ :c diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 1a3bde0e5c..1953569223 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -20,9 +20,6 @@ ARTICLE: "pathnames" "Pathname manipulation" { $subsection file-name } { $subsection last-path-separator } { $subsection append-path } -"Pathnames relative to Factor's install directory:" -{ $subsection resource-path } -{ $subsection ?resource-path } "Pathnames relative to Factor's temporary files directory:" { $subsection temp-directory } { $subsection temp-file } @@ -248,12 +245,6 @@ HELP: resource-path { $values { "path" "a pathname string" } { "newpath" "a pathname string" } } { $description "Resolve a path relative to the Factor source code location. This first checks if the " { $link resource-path } " variable is set to a path, and if not, uses the parent directory of the current image." } ; -HELP: ?resource-path -{ $values { "path" "a pathname string" } { "newpath" "a string" } } -{ $description "If the path is prefixed with " { $snippet "\"resource:\"" } ", prepends the resource path." } ; - -{ resource-path ?resource-path } related-words - HELP: pathname { $class-description "Class of pathname presentations. Path name presentations can be created by calling " { $link } ". Instances can be passed to " { $link write-object } " to output a clickable pathname." } ; diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 369ecc6868..9af82a5672 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -205,3 +205,7 @@ io.encodings.utf8 ; [ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path ] unit-test [ "bar/foo" ] [ "bar/baz" "./..//foo" append-path ] unit-test [ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test + +[ t ] [ "resource:core" absolute-path? ] unit-test +[ t ] [ "/foo" absolute-path? ] unit-test +[ f ] [ "" absolute-path? ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 78f1612cb8..0090f90e4c 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -99,7 +99,12 @@ ERROR: no-parent-directory path ; PRIVATE> : absolute-path? ( path -- ? ) - dup empty? [ drop f ] [ first path-separator? ] if ; + { + { [ dup empty? ] [ f ] } + { [ dup "resource:" head? ] [ t ] } + { [ dup first path-separator? ] [ t ] } + { [ t ] [ f ] } + } cond nip ; : append-path ( str1 str2 -- str ) { @@ -258,12 +263,6 @@ DEFER: copy-tree-into "resource-path" get [ image parent-directory ] unless* prepend-path ; -: ?resource-path ( path -- newpath ) - "resource:" ?head [ left-trim-separators resource-path ] when ; - -: resource-exists? ( path -- ? ) - ?resource-path exists? ; - : temp-directory ( -- path ) "temp" resource-path dup exists? not @@ -273,7 +272,12 @@ DEFER: copy-tree-into : temp-file ( name -- path ) temp-directory prepend-path ; M: object normalize-pathname ( path -- path' ) - current-directory get prepend-path ; + "resource:" ?head [ + left-trim-separators resource-path + normalize-pathname + ] [ + current-directory get prepend-path + ] if ; ! Pathname presentations TUPLE: pathname string ; diff --git a/core/parser/parser.factor b/core/parser/parser.factor index bb3ad254da..f6e351a42e 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -520,7 +520,7 @@ SYMBOL: interactive-vocabs [ [ [ parsing-file ] keep - [ ?resource-path utf8 ] keep + [ utf8 ] keep parse-stream ] with-compiler-errors ] [ @@ -532,7 +532,7 @@ SYMBOL: interactive-vocabs [ dup parse-file call ] assert-depth drop ; : ?run-file ( path -- ) - dup resource-exists? [ run-file ] [ drop ] if ; + dup exists? [ run-file ] [ drop ] if ; : bootstrap-file ( path -- ) [ parse-file % ] [ run-file ] if-bootstrapping ; diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index f4428e4e8b..8dea367b6b 100755 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -48,7 +48,7 @@ uses definitions ; : reset-checksums ( -- ) source-files get [ - swap ?resource-path dup exists? [ + swap dup exists? [ utf8 file-lines swap record-checksum ] [ 2drop ] if ] assoc-each ; diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 9478c1f4f7..57947eefb0 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -25,7 +25,7 @@ V{ : vocab-dir? ( root name -- ? ) over [ - ".factor" vocab-dir+ append-path resource-exists? + ".factor" vocab-dir+ append-path exists? ] [ 2drop f ] if ; diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index 4ee906bccb..89aef4d819 100755 --- a/extra/editors/editors.factor +++ b/extra/editors/editors.factor @@ -26,7 +26,7 @@ SYMBOL: edit-hook : edit-location ( file line -- ) edit-hook get [ - >r >r ?resource-path r> r> call + call ] [ no-edit-hook edit-location ] if* ; @@ -39,7 +39,7 @@ SYMBOL: edit-hook : :edit ( -- ) error get delegates [ parse-error? ] find-last nip [ - dup parse-error-file source-file-path ?resource-path + dup parse-error-file source-file-path swap parse-error-line edit-location ] when* ; diff --git a/extra/http/server/templating/fhtml/fhtml-tests.factor b/extra/http/server/templating/fhtml/fhtml-tests.factor index 2e253d9132..9d8a6f4617 100755 --- a/extra/http/server/templating/fhtml/fhtml-tests.factor +++ b/extra/http/server/templating/fhtml/fhtml-tests.factor @@ -9,7 +9,7 @@ IN: http.server.templating.fhtml.tests [ ".fhtml" append [ run-template ] with-string-writer ] keep - ".html" append ?resource-path utf8 file-contents = ; + ".html" append utf8 file-contents = ; [ t ] [ "example" test-template ] unit-test [ t ] [ "bug" test-template ] unit-test diff --git a/extra/http/server/templating/fhtml/fhtml.factor b/extra/http/server/templating/fhtml/fhtml.factor index 630054ccfa..f3d9d54a25 100755 --- a/extra/http/server/templating/fhtml/fhtml.factor +++ b/extra/http/server/templating/fhtml/fhtml.factor @@ -83,7 +83,7 @@ DEFER: <% delimiter templating-vocab use+ ! so that reload works properly dup source-file file set - ?resource-path utf8 file-contents + utf8 file-contents [ eval-template ] [ html-error. drop ] recover ] with-file-vocabs ] assert-depth ; diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 04339ad5b7..9325e74d93 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -31,7 +31,7 @@ IN: project-euler : solution-path ( n -- str/f ) number>euler "project-euler." prepend - vocab where dup [ first ?resource-path ] when ; + vocab where dup [ first ] when ; PRIVATE> diff --git a/extra/tools/deploy/test/3/3.factor b/extra/tools/deploy/test/3/3.factor index 443e82f7d9..2f07f4ede5 100755 --- a/extra/tools/deploy/test/3/3.factor +++ b/extra/tools/deploy/test/3/3.factor @@ -3,6 +3,6 @@ USING: io.encodings.ascii io.files kernel ; : deploy-test-3 "resource:extra/tools/deploy/test/3/3.factor" - ?resource-path ascii file-contents drop ; + ascii file-contents drop ; MAIN: deploy-test-3 diff --git a/extra/tools/vocabs/vocabs.factor b/extra/tools/vocabs/vocabs.factor index b086b30a5e..d7c3d2be20 100755 --- a/extra/tools/vocabs/vocabs.factor +++ b/extra/tools/vocabs/vocabs.factor @@ -8,12 +8,12 @@ IN: tools.vocabs : vocab-tests-file ( vocab -- path ) dup "-tests.factor" vocab-dir+ vocab-append-path dup - [ dup resource-exists? [ drop f ] unless ] [ drop f ] if ; + [ dup exists? [ drop f ] unless ] [ drop f ] if ; : vocab-tests-dir ( vocab -- paths ) dup vocab-dir "tests" append-path vocab-append-path dup [ - dup resource-exists? [ - dup ?resource-path directory keys + dup exists? [ + dup directory keys [ ".factor" tail? ] subset [ append-path ] with map ] [ drop f ] if @@ -34,7 +34,7 @@ IN: tools.vocabs : source-modified? ( path -- ? ) dup source-files get at [ - dup source-file-path ?resource-path + dup source-file-path dup exists? [ utf8 file-lines lines-crc32 swap source-file-checksum = not @@ -42,7 +42,7 @@ IN: tools.vocabs 2drop f ] if ] [ - resource-exists? + exists? ] ?if ; : modified ( seq quot -- seq ) @@ -104,15 +104,14 @@ SYMBOL: sources-changed? "" refresh f sources-changed? set-global ; MEMO: (vocab-file-contents) ( path -- lines ) - ?resource-path dup exists? - [ utf8 file-lines ] [ drop f ] if ; + dup exists? [ utf8 file-lines ] [ drop f ] if ; : vocab-file-contents ( vocab name -- seq ) vocab-append-path dup [ (vocab-file-contents) ] when ; : set-vocab-file-contents ( seq vocab name -- ) dupd vocab-append-path [ - ?resource-path utf8 set-file-lines + utf8 set-file-lines \ (vocab-file-contents) reset-memoized ] [ "The " swap vocab-name @@ -171,7 +170,7 @@ M: vocab-link summary vocab-summary ; directory [ second ] subset keys natural-sort ; : (all-child-vocabs) ( root name -- vocabs ) - [ vocab-dir append-path ?resource-path subdirs ] keep + [ vocab-dir append-path subdirs ] keep dup empty? [ drop ] [ diff --git a/extra/ui/freetype/freetype.factor b/extra/ui/freetype/freetype.factor index dc56009b87..1963f5670a 100755 --- a/extra/ui/freetype/freetype.factor +++ b/extra/ui/freetype/freetype.factor @@ -62,7 +62,7 @@ M: freetype-renderer free-fonts ( world -- ) } at ; : ttf-path ( name -- string ) - "resource:fonts/" swap ".ttf" 3append ?resource-path ; + "resource:fonts/" swap ".ttf" 3append ; : (open-face) ( path length -- face ) #! We use FT_New_Memory_Face, not FT_New_Face, since From 8903ba3a32257e4c99ac3c41496ea7f0527a13ff Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 01:41:22 -0500 Subject: [PATCH 062/219] Fix Windows bootstrap --- extra/io/windows/files/files.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index b4513f7da8..655b5f9daf 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types io.files io.windows kernel +USING: alien.c-types io.backend io.files io.windows kernel math windows windows.kernel32 combinators.cleave windows.time calendar combinators math.functions sequences namespaces words symbols ; From 5aae4516dde997ff042211b9a584de02bb9db9e3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 01:42:13 -0500 Subject: [PATCH 063/219] Working on slot inheritance --- core/bootstrap/primitives.factor | 18 +++++--- core/classes/classes.factor | 3 ++ core/mirrors/mirrors.factor | 2 +- core/tuples/tuples-tests.factor | 26 ++++++++++-- core/tuples/tuples.factor | 71 ++++++++++++++++++++++---------- 5 files changed, 89 insertions(+), 31 deletions(-) diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 3f6fedb40c..baa85032bc 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -324,14 +324,20 @@ define-builtin } } define-builtin -"tuple" "kernel" create { +"tuple" "kernel" create { } define-builtin + +"tuple" "kernel" lookup +{ { - { "tuple-layout" "tuples.private" } - "layout" - { "tuple-layout" "tuples.private" } - f + { "object" "kernel" } + "delegate" + { "delegate" "kernel" } + { "set-delegate" "kernel" } } -} define-builtin +} +define-tuple-slots + +"tuple" "kernel" lookup define-tuple-layout ! Define general-t type, which is any object that is not f. "general-t" "kernel" create diff --git a/core/classes/classes.factor b/core/classes/classes.factor index c2c19836cd..c21dd452ac 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -57,6 +57,9 @@ PREDICATE: predicate < word "predicating" word-prop >boolean ; #! Output f for non-classes to work with algebra code dup class? [ "superclass" word-prop ] [ drop f ] if ; +: superclasses ( class -- supers ) + [ dup ] [ dup superclass swap ] [ ] unfold reverse nip ; + : members ( class -- seq ) #! Output f for non-classes to work with algebra code dup class? [ "members" word-prop ] [ drop f ] if ; diff --git a/core/mirrors/mirrors.factor b/core/mirrors/mirrors.factor index 8f12bbb2f4..7176076c7c 100755 --- a/core/mirrors/mirrors.factor +++ b/core/mirrors/mirrors.factor @@ -10,7 +10,7 @@ GENERIC: object-slots ( obj -- seq ) M: object object-slots class "slots" word-prop ; M: tuple object-slots - dup class "slots" word-prop + dup class superclasses [ "slots" word-prop ] map concat swap delegate [ 1 tail-slice ] unless ; TUPLE: mirror object slots ; diff --git a/core/tuples/tuples-tests.factor b/core/tuples/tuples-tests.factor index 2d28697b70..e670c26c25 100755 --- a/core/tuples/tuples-tests.factor +++ b/core/tuples/tuples-tests.factor @@ -246,6 +246,7 @@ C: erg's-reshape-problem ! Inheritance TUPLE: computer cpu ram ; +C: computer [ "TUPLE: computer cpu ram ;" ] [ [ \ computer see ] with-string-writer string-lines second @@ -264,11 +265,23 @@ C: laptop [ t ] [ "laptop" get computer? ] unit-test [ t ] [ "laptop" get tuple? ] unit-test +[ "Pentium" ] [ "laptop" get cpu>> ] unit-test +[ 128 ] [ "laptop" get ram>> ] unit-test +[ t ] [ "laptop" get battery>> 3 hours = ] unit-test + +[ laptop ] [ + "laptop" get tuple-layout + dup layout-echelon swap + layout-superclasses nth +] unit-test + [ "TUPLE: laptop < computer battery ;" ] [ [ \ laptop see ] with-string-writer string-lines second ] unit-test -TUPLE: server < computer rackmount? ; +[ { tuple computer laptop } ] [ laptop superclasses ] unit-test + +TUPLE: server < computer rackmount ; C: server [ t ] [ server tuple-class? ] unit-test @@ -276,11 +289,15 @@ C: server [ t ] [ server computer class< ] unit-test [ t ] [ server computer classes-intersect? ] unit-test -[ ] [ "Pentium" 128 "1U" "server" set ] unit-test +[ ] [ "PowerPC" 64 "1U" "server" set ] unit-test [ t ] [ "server" get server? ] unit-test [ t ] [ "server" get computer? ] unit-test [ t ] [ "server" get tuple? ] unit-test +[ "PowerPC" ] [ "server" get cpu>> ] unit-test +[ 64 ] [ "server" get ram>> ] unit-test +[ "1U" ] [ "server" get rackmount>> ] unit-test + [ f ] [ "server" get laptop? ] unit-test [ f ] [ "laptop" get server? ] unit-test @@ -288,7 +305,10 @@ C: server [ f ] [ laptop server class< ] unit-test [ f ] [ laptop server classes-intersect? ] unit-test -[ "TUPLE: server < computer rackmount? ;" ] [ +[ f ] [ 1 2 laptop? ] unit-test +[ f ] [ \ + server? ] unit-test + +[ "TUPLE: server < computer rackmount ;" ] [ [ \ server see ] with-string-writer string-lines second ] unit-test diff --git a/core/tuples/tuples.factor b/core/tuples/tuples.factor index 83f398242a..09dd03de2f 100755 --- a/core/tuples/tuples.factor +++ b/core/tuples/tuples.factor @@ -4,7 +4,7 @@ USING: arrays definitions hashtables kernel kernel.private math namespaces sequences sequences.private strings vectors words quotations memory combinators generic classes classes.private slots.deprecated slots.private slots -compiler.units ; +compiler.units math.private ; IN: tuples M: tuple delegate 2 slot ; @@ -17,6 +17,12 @@ ERROR: no-tuple-class class ; @@ -49,33 +55,56 @@ PRIVATE> 2drop f ] if ; -M: tuple-class tuple-layout "layout" word-prop ; +! Predicate generation. We optimize at the expense of simplicity + +: (tuple-predicate-quot) ( class -- quot ) + #! 4 slot == layout-superclasses + #! 5 slot == layout-echelon + [ + [ 1 slot dup 5 slot ] % + dup tuple-layout layout-echelon , + [ fixnum>= ] % + [ + dup tuple-layout layout-echelon , + [ swap 4 slot array-nth ] % + literalize , + [ eq? ] % + ] [ ] make , + [ drop f ] , + \ if , + ] [ ] make ; + +: tuple-predicate-quot ( class -- quot ) + [ + [ dup tuple? ] % + (tuple-predicate-quot) , + [ drop f ] , + \ if , + ] [ ] make ; : define-tuple-predicate ( class -- ) - dup tuple-layout - [ over tuple? [ swap 1 slot eq? ] [ 2drop f ] if ] curry - define-predicate ; + dup tuple-predicate-quot define-predicate ; -: delegate-slot-spec - T{ slot-spec f - object - "delegate" - 2 - delegate - set-delegate - } ; +: superclass-size ( class -- n ) + superclasses 1 head-slice* + [ "slot-names" word-prop length ] map sum ; + +: generate-tuple-slots ( class slots -- slot-specs slot-names ) + over superclass-size 2 + simple-slots + dup [ slot-spec-name ] map ; : define-tuple-slots ( class slots -- ) - dupd 3 simple-slots - 2dup [ slot-spec-name ] map "slot-names" set-word-prop - 2dup delegate-slot-spec add* "slots" set-word-prop - 2dup define-slots - define-accessors ; + dupd generate-tuple-slots + >r dupd "slots" set-word-prop + r> dupd "slot-names" set-word-prop + dup "slots" word-prop 2dup define-slots define-accessors ; + +: make-tuple-layout ( class -- layout ) + dup superclass-size over "slot-names" word-prop length + + over superclasses dup length 1- ; : define-tuple-layout ( class -- ) - dup - dup "slot-names" word-prop length 1+ { } 0 - "layout" set-word-prop ; + dup make-tuple-layout "layout" set-word-prop ; : removed-slots ( class newslots -- seq ) swap "slot-names" word-prop seq-diff ; From f1ee3dcb32e61b47f92fe5de911f4a24ea4bc7d8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 02:12:15 -0500 Subject: [PATCH 064/219] Clean up temp-directory --- core/io/files/files.factor | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 78f1612cb8..7cdf41674d 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -265,12 +265,10 @@ DEFER: copy-tree-into ?resource-path exists? ; : temp-directory ( -- path ) - "temp" resource-path - dup exists? not - [ dup make-directory ] - when ; + "temp" resource-path dup make-directories ; -: temp-file ( name -- path ) temp-directory prepend-path ; +: temp-file ( name -- path ) + temp-directory prepend-path ; M: object normalize-pathname ( path -- path' ) current-directory get prepend-path ; From b008f69c25c4c39b394559b107830ed44e6c6bc1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 03:27:22 -0500 Subject: [PATCH 065/219] Fix serialize --- extra/serialize/serialize.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/serialize/serialize.factor b/extra/serialize/serialize.factor index 7bcc336962..a86eee71e3 100755 --- a/extra/serialize/serialize.factor +++ b/extra/serialize/serialize.factor @@ -269,7 +269,7 @@ SYMBOL: deserialized [ ] tri ; : copy-seq-to-tuple ( seq tuple -- ) - >r dup length [ 1+ ] map r> [ set-array-nth ] curry 2each ; + >r dup length r> [ set-array-nth ] curry 2each ; : deserialize-tuple ( -- array ) #! Ugly because we have to intern the tuple before reading From febcd88459f0e8a04189eb365c5a530b94a05493 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 05:13:52 -0500 Subject: [PATCH 066/219] Unit test fixes --- core/assocs/assocs-tests.factor | 4 ++-- core/classes/algebra/algebra-docs.factor | 2 +- core/compiler/tests/templates.factor | 4 ++-- core/mirrors/mirrors-tests.factor | 2 +- core/mirrors/mirrors.factor | 10 ++++------ core/tuples/tuples-docs.factor | 2 +- core/tuples/tuples.factor | 2 +- extra/inverse/inverse.factor | 4 ++-- extra/tuple-syntax/tuple-syntax.factor | 5 ++--- extra/tuples/lib/lib.factor | 6 +++--- 10 files changed, 19 insertions(+), 22 deletions(-) mode change 100644 => 100755 extra/tuples/lib/lib.factor diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor index 574002921a..c4db604784 100755 --- a/core/assocs/assocs-tests.factor +++ b/core/assocs/assocs-tests.factor @@ -99,8 +99,8 @@ unit-test 3 H{ } clone 2 [ - 2dup [ , f ] cache + 2dup [ , f ] cache drop ] times 2drop - ] make + ] { } make ] unit-test diff --git a/core/classes/algebra/algebra-docs.factor b/core/classes/algebra/algebra-docs.factor index 632af1d040..87c72048f4 100755 --- a/core/classes/algebra/algebra-docs.factor +++ b/core/classes/algebra/algebra-docs.factor @@ -30,7 +30,7 @@ HELP: class-types { $description "Outputs a sequence of builtin type numbers whose instances can possibly be instances of the given class." } ; HELP: class< -{ $values { "class1" "a class" } { "class2" "a class" } { "?" "a boolean" } } +{ $values { "first" "a class" } { "second" "a class" } { "?" "a boolean" } } { $description "Tests if all instances of " { $snippet "class1" } " are also instances of " { $snippet "class2" } "." } { $notes "Classes are partially ordered. This means that if " { $snippet "class1 <= class2" } " and " { $snippet "class2 <= class1" } ", then " { $snippet "class1 = class2" } ". Also, if " { $snippet "class1 <= class2" } " and " { $snippet "class2 <= class3" } ", then " { $snippet "class1 <= class3" } "." } ; diff --git a/core/compiler/tests/templates.factor b/core/compiler/tests/templates.factor index 1c19730ec0..8a33d57fe7 100755 --- a/core/compiler/tests/templates.factor +++ b/core/compiler/tests/templates.factor @@ -81,8 +81,8 @@ unit-test -12 -13 [ [ 0 swap fixnum- ] 2apply ] compile-call ] unit-test -[ 2 ] [ - SBUF" " [ 2 slot 2 [ slot ] keep ] compile-call nip +[ 1 ] [ + SBUF" " [ 1 slot 1 [ slot ] keep ] compile-call nip ] unit-test ! Test slow shuffles diff --git a/core/mirrors/mirrors-tests.factor b/core/mirrors/mirrors-tests.factor index 8f2964b19d..11e5772000 100755 --- a/core/mirrors/mirrors-tests.factor +++ b/core/mirrors/mirrors-tests.factor @@ -5,7 +5,7 @@ TUPLE: foo bar baz ; C: foo -[ { "bar" "baz" } ] [ 1 2 keys ] unit-test +[ { "delegate" "bar" "baz" } ] [ 1 2 keys ] unit-test [ 1 t ] [ "bar" 1 2 at* ] unit-test diff --git a/core/mirrors/mirrors.factor b/core/mirrors/mirrors.factor index 7176076c7c..3c5a0aa3c7 100755 --- a/core/mirrors/mirrors.factor +++ b/core/mirrors/mirrors.factor @@ -5,13 +5,11 @@ arrays classes slots slots.private tuples math vectors quotations sorting prettyprint ; IN: mirrors -GENERIC: object-slots ( obj -- seq ) +: all-slots ( class -- slots ) + superclasses [ "slots" word-prop ] map concat ; -M: object object-slots class "slots" word-prop ; - -M: tuple object-slots - dup class superclasses [ "slots" word-prop ] map concat - swap delegate [ 1 tail-slice ] unless ; +: object-slots ( obj -- seq ) + class all-slots ; TUPLE: mirror object slots ; diff --git a/core/tuples/tuples-docs.factor b/core/tuples/tuples-docs.factor index 6e0f319c9a..55e15d6dc6 100755 --- a/core/tuples/tuples-docs.factor +++ b/core/tuples/tuples-docs.factor @@ -191,7 +191,7 @@ HELP: define-tuple-predicate $low-level-note ; HELP: redefine-tuple-class -{ $values { "class" class } { "superclass" class } { "newslots" "a sequence of strings" } } +{ $values { "class" class } { "superclass" class } { "slots" "a sequence of strings" } } { $description "If the new slot layout differs from the existing one, updates all existing instances of this tuple class, and forgets any slot accessor words which are no longer needed." $nl "If the class is not a tuple class word, this word does nothing." } diff --git a/core/tuples/tuples.factor b/core/tuples/tuples.factor index 09dd03de2f..89aff6f185 100755 --- a/core/tuples/tuples.factor +++ b/core/tuples/tuples.factor @@ -36,7 +36,7 @@ PRIVATE> [ layout-size swap [ array-nth ] curry map ] keep layout-class add* ; -: >tuple ( sequence -- tuple ) +: >tuple ( seq -- tuple ) dup first tuple-layout [ >r 1 tail-slice dup length r> [ tuple-size min ] keep diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 1468065ebe..308bf36bf4 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -1,7 +1,7 @@ USING: kernel words inspector slots quotations sequences assocs math arrays inference effects shuffle continuations debugger tuples namespaces vectors bit-arrays byte-arrays strings sbufs -math.functions macros sequences.private combinators ; +math.functions macros sequences.private combinators mirrors ; IN: inverse TUPLE: fail ; @@ -191,7 +191,7 @@ MACRO: undo ( quot -- ) [undo] ; "predicate" word-prop [ dupd call assure ] curry ; : slot-readers ( class -- quot ) - "slots" word-prop 1 tail ! tail gets rid of delegate + all-slots 1 tail ! tail gets rid of delegate [ slot-spec-reader 1quotation [ keep ] curry ] map concat [ ] like [ drop ] compose ; diff --git a/extra/tuple-syntax/tuple-syntax.factor b/extra/tuple-syntax/tuple-syntax.factor index 2f0ba6bde5..f06bb55899 100755 --- a/extra/tuple-syntax/tuple-syntax.factor +++ b/extra/tuple-syntax/tuple-syntax.factor @@ -1,5 +1,5 @@ USING: kernel sequences slots parser words classes -slots.private ; +slots.private mirrors ; IN: tuple-syntax ! TUPLE: foo bar baz ; @@ -10,8 +10,7 @@ IN: tuple-syntax : parse-slot-writer ( tuple -- slot# ) scan dup "}" = [ 2drop f ] [ - 1 head* swap class "slots" word-prop - [ slot-spec-name = ] with find nip slot-spec-offset + 1 head* swap object-slots slot-named slot-spec-offset ] if ; : parse-slots ( accum tuple -- accum tuple ) diff --git a/extra/tuples/lib/lib.factor b/extra/tuples/lib/lib.factor old mode 100644 new mode 100755 index 5075c1d94a..4c007c8bb1 --- a/extra/tuples/lib/lib.factor +++ b/extra/tuples/lib/lib.factor @@ -1,16 +1,16 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel macros sequences slots words ; +USING: kernel macros sequences slots words mirrors ; IN: tuples.lib : reader-slots ( seq -- quot ) [ slot-spec-reader ] map [ get-slots ] curry ; MACRO: >tuple< ( class -- ) - "slots" word-prop 1 tail-slice reader-slots ; + all-slots 1 tail-slice reader-slots ; MACRO: >tuple*< ( class -- ) - "slots" word-prop + all-slots [ slot-spec-name "*" tail? ] subset reader-slots ; From 65bfc092652a60152af35e87cad5cb0ccec911dd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 05:18:07 -0500 Subject: [PATCH 067/219] Fix HTTP server --- extra/http/server/static/static.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/extra/http/server/static/static.factor b/extra/http/server/static/static.factor index 37c3a63d76..2f48e7ac87 100755 --- a/extra/http/server/static/static.factor +++ b/extra/http/server/static/static.factor @@ -39,7 +39,9 @@ TUPLE: file-responder root hook special ; [ 2drop <304> ] [ file-responder get hook>> call ] if ; : serving-path ( filename -- filename ) - "" or file-responder get root>> prepend-path ; + file-responder get root>> right-trim-separators + "/" + rot "" or left-trim-separators 3append ; : serve-file ( filename -- response ) dup mime-type From e39894155c1d983e2a6dd5aa358b747305a06806 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 27 Mar 2008 09:00:59 -0500 Subject: [PATCH 068/219] add windows-absolute-path? and move unit tests --- core/io/files/files.factor | 10 +++++++++- extra/io/windows/nt/files/files-tests.factor | 11 +++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) create mode 100644 extra/io/windows/nt/files/files-tests.factor diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 3913f3c8d5..94401f3e1f 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -3,7 +3,7 @@ USING: io.backend io.files.private io hashtables kernel math memory namespaces sequences strings assocs arrays definitions system combinators splitting sbufs continuations io.encodings -io.encodings.binary init ; +io.encodings.binary init unicode.categories ; IN: io.files HOOK: (file-reader) io-backend ( path -- stream ) @@ -98,11 +98,19 @@ ERROR: no-parent-directory path ; PRIVATE> +: windows-absolute-path? ( path -- path ? ) + { + { [ dup length 2 < ] [ f ] } + { [ dup first2 >r Letter? r> CHAR: : = and ] [ t ] } + { [ t ] [ f ] } + } cond ; + : absolute-path? ( path -- ? ) { { [ dup empty? ] [ f ] } { [ dup "resource:" head? ] [ t ] } { [ dup first path-separator? ] [ t ] } + { [ windows? ] [ windows-absolute-path? ] } { [ t ] [ f ] } } cond nip ; diff --git a/extra/io/windows/nt/files/files-tests.factor b/extra/io/windows/nt/files/files-tests.factor new file mode 100644 index 0000000000..a96bd6dad8 --- /dev/null +++ b/extra/io/windows/nt/files/files-tests.factor @@ -0,0 +1,11 @@ +USING: kernel tools.test ; +IN: io.windows.nt.files.tests + +[ f ] [ "" root-directory? ] unit-test +[ t ] [ "\\" root-directory? ] unit-test +[ t ] [ "\\\\" root-directory? ] unit-test +[ t ] [ "\\\\\\\\\\\\" root-directory? ] unit-test +[ t ] [ "/" root-directory? ] unit-test +[ t ] [ "//" root-directory? ] unit-test +[ t ] [ "//////////////" root-directory? ] unit-test +[ t ] [ "\\foo" absolute-path? ] unit-test From f54d12682a6608d5fe7ab7b279ef16e21875f896 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 27 Mar 2008 09:01:48 -0500 Subject: [PATCH 069/219] add more unit tests for windows --- extra/io/windows/nt/files/files-tests.factor | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/extra/io/windows/nt/files/files-tests.factor b/extra/io/windows/nt/files/files-tests.factor index a96bd6dad8..3b31d73e4a 100644 --- a/extra/io/windows/nt/files/files-tests.factor +++ b/extra/io/windows/nt/files/files-tests.factor @@ -9,3 +9,7 @@ IN: io.windows.nt.files.tests [ t ] [ "//" root-directory? ] unit-test [ t ] [ "//////////////" root-directory? ] unit-test [ t ] [ "\\foo" absolute-path? ] unit-test +[ t ] [ "\\\\?\\foo" absolute-path? ] unit-test +[ t ] [ "c:\\foo" absolute-path? ] unit-test +[ t ] [ "c:" absolute-path? ] unit-test + From 15139b06ec4c15db960ae6047a0fbbf1152c4343 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 27 Mar 2008 09:06:06 -0500 Subject: [PATCH 070/219] can't use unicode or ascii in io.files.. --- core/io/files/files.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 94401f3e1f..f6888bf78d 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -3,7 +3,7 @@ USING: io.backend io.files.private io hashtables kernel math memory namespaces sequences strings assocs arrays definitions system combinators splitting sbufs continuations io.encodings -io.encodings.binary init unicode.categories ; +io.encodings.binary init ; IN: io.files HOOK: (file-reader) io-backend ( path -- stream ) @@ -101,7 +101,7 @@ PRIVATE> : windows-absolute-path? ( path -- path ? ) { { [ dup length 2 < ] [ f ] } - { [ dup first2 >r Letter? r> CHAR: : = and ] [ t ] } + { [ dup second CHAR: : = ] [ t ] } { [ t ] [ f ] } } cond ; From 783d7a20da52645acbf2711e3aea0513a7c3819d Mon Sep 17 00:00:00 2001 From: "U-FROGGER\\erg" Date: Wed, 26 Mar 2008 10:17:20 -0500 Subject: [PATCH 071/219] fix windows bootstrap --- extra/io/windows/nt/files/files.factor | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 1c8d88c872..c6cbf292b3 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -65,12 +65,17 @@ ERROR: empty-pathname ; USE: tools.walker M: windows-nt-io normalize-pathname ( string -- string ) - dup string? [ nonstring-pathname ] unless - dup empty? [ empty-pathname ] when - { { CHAR: / CHAR: \\ } } substitute - current-directory get swap windows-append-path - [ "/\\." member? ] right-trim - dup peek CHAR: : = [ "\\" append ] when ; + "resource:" ?head [ + left-trim-separators resource-path + normalize-pathname + ] [ + dup string? [ nonstring-pathname ] unless + dup empty? [ empty-pathname ] when + { { CHAR: / CHAR: \\ } } substitute + current-directory get swap windows-append-path + [ "/\\." member? ] right-trim + dup peek CHAR: : = [ "\\" append ] when + ] if ; M: windows-nt-io CreateFile-flags ( DWORD -- DWORD ) FILE_FLAG_OVERLAPPED bitor ; From ecee19e6edc5bf33877da05419e923395e0823a6 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 26 Mar 2008 12:00:09 -0600 Subject: [PATCH 072/219] Add a docs file for openssl. Mention where to get OpenSSL for Windows. --- extra/openssl/openssl-docs.factor | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 extra/openssl/openssl-docs.factor diff --git a/extra/openssl/openssl-docs.factor b/extra/openssl/openssl-docs.factor new file mode 100644 index 0000000000..dd31bfd001 --- /dev/null +++ b/extra/openssl/openssl-docs.factor @@ -0,0 +1,10 @@ + +USING: help.syntax help.markup ; + +IN: openssl + +ARTICLE: "openssl" "OpenSSL" + +"Factor on Windows has been tested with this version of OpenSSL: " + +{ $url "http://www.openssl.org/related/binaries.html" } ; \ No newline at end of file From c300d4482a3038533b4324e4f941fbe830d0574b Mon Sep 17 00:00:00 2001 From: sheeple Date: Thu, 27 Mar 2008 11:14:40 -0500 Subject: [PATCH 073/219] rm staging files in temp/ --- misc/factor.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/misc/factor.sh b/misc/factor.sh index 1fe003994c..09531350f3 100755 --- a/misc/factor.sh +++ b/misc/factor.sh @@ -306,7 +306,7 @@ update_boot_images() { echo "Deleting old images..." rm checksums.txt* > /dev/null 2>&1 rm $BOOT_IMAGE.* > /dev/null 2>&1 - rm staging.*.image > /dev/null 2>&1 + rm temp/staging.*.image > /dev/null 2>&1 if [[ -f $BOOT_IMAGE ]] ; then get_url http://factorcode.org/images/latest/checksums.txt factorcode_md5=`cat checksums.txt|grep $BOOT_IMAGE|cut -f2 -d' '`; From f0a900d11b7446dc7cbbb0d617c517818232ae3d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 17:12:39 -0500 Subject: [PATCH 074/219] Fix Windows bootstrap --- core/io/backend/backend.factor | 6 ++++-- core/io/files/files.factor | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 151dbc7df7..6bcd448385 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: init kernel system namespaces io io.encodings io.encodings.utf8 ; +USING: init kernel system namespaces io io.encodings +io.encodings.utf8 init assocs ; IN: io.backend SYMBOL: io-backend @@ -22,7 +23,8 @@ HOOK: normalize-pathname io-backend ( str -- newstr ) M: object normalize-directory normalize-pathname ; : set-io-backend ( io-backend -- ) - io-backend set-global init-io init-stdio ; + io-backend set-global init-io init-stdio + "io.files" init-hooks get at call ; [ init-io embedded? [ init-stdio ] unless ] "io.backend" add-init-hook diff --git a/core/io/files/files.factor b/core/io/files/files.factor index f6888bf78d..436bf8598d 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -170,7 +170,7 @@ SYMBOL: current-directory M: object cwd ( -- path ) "." ; -[ cwd current-directory set-global ] "current-directory" add-init-hook +[ cwd current-directory set-global ] "io.files" add-init-hook : with-directory ( path quot -- ) current-directory swap with-variable ; inline From 2ff18ddea8f0ae5653eeb979afc5bc13a93f25b6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 17:12:47 -0500 Subject: [PATCH 075/219] Fix editors.jedit --- extra/editors/jedit/jedit.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 extra/editors/jedit/jedit.factor diff --git a/extra/editors/jedit/jedit.factor b/extra/editors/jedit/jedit.factor old mode 100644 new mode 100755 index 7b6066df7c..92320addef --- a/extra/editors/jedit/jedit.factor +++ b/extra/editors/jedit/jedit.factor @@ -8,7 +8,7 @@ io.encodings.utf8 ; IN: editors.jedit : jedit-server-info ( -- port auth ) - home "/.jedit/server" append-path ascii [ + home ".jedit/server" append-path ascii [ readln drop readln string>number readln string>number From 8c5e01703d21074d262cc94663b8efb4178053dc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 17:19:48 -0500 Subject: [PATCH 076/219] Fixing deployment --- extra/tools/deploy/macosx/macosx.factor | 17 +++++++++-------- extra/tools/deploy/shaker/shaker.factor | 2 +- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/extra/tools/deploy/macosx/macosx.factor b/extra/tools/deploy/macosx/macosx.factor index 9fe35647fe..6d9c8e9d8a 100755 --- a/extra/tools/deploy/macosx/macosx.factor +++ b/extra/tools/deploy/macosx/macosx.factor @@ -62,11 +62,12 @@ T{ macosx-deploy-implementation } deploy-implementation set-global M: macosx-deploy-implementation deploy* ( vocab -- ) ".app deploy tool" assert.app - "." resource-path cd - dup deploy-config [ - bundle-name dup exists? [ delete-tree ] [ drop ] if - [ bundle-name create-app-dir ] keep - [ bundle-name deploy.app-image ] keep - namespace make-deploy-image - bundle-name show-in-finder - ] bind ; + "resource:" [ + dup deploy-config [ + bundle-name dup exists? [ delete-tree ] [ drop ] if + [ bundle-name create-app-dir ] keep + [ bundle-name deploy.app-image ] keep + namespace make-deploy-image + bundle-name show-in-finder + ] bind + ] with-directory ; diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor index cf23e42283..ee9c2b9fab 100755 --- a/extra/tools/deploy/shaker/shaker.factor +++ b/extra/tools/deploy/shaker/shaker.factor @@ -81,7 +81,7 @@ IN: tools.deploy.shaker [ "class" , "metaclass" , - "slot-names" , + "layout" , deploy-ui? get [ "gestures" , "commands" , From f09547ece13321bcc61dd1fa733daf02909472b5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 17:47:04 -0500 Subject: [PATCH 077/219] Fix mirrors docs --- core/mirrors/mirrors-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/mirrors/mirrors-docs.factor b/core/mirrors/mirrors-docs.factor index 29ed153a2e..725a757e61 100755 --- a/core/mirrors/mirrors-docs.factor +++ b/core/mirrors/mirrors-docs.factor @@ -36,7 +36,7 @@ HELP: "TUPLE: circle center radius ;" "C: circle" "{ 100 50 } 15 >alist ." - "{ { \"center\" { 100 50 } } { \"radius\" 15 } }" + "{ { \"delegate\" f } { \"center\" { 100 50 } } { \"radius\" 15 } }" } } ; From 7616eefbfcadc3c4ef551702788267372b4b2782 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 18:00:55 -0500 Subject: [PATCH 078/219] Fix editor integration --- extra/editors/editors.factor | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index 89aef4d819..67e515ebc1 100755 --- a/extra/editors/editors.factor +++ b/extra/editors/editors.factor @@ -25,11 +25,8 @@ SYMBOL: edit-hook require ; : edit-location ( file line -- ) - edit-hook get [ - call - ] [ - no-edit-hook edit-location - ] if* ; + >r current-directory get prepend-path r> + edit-hook get [ call ] [ no-edit-hook edit-location ] if* ; : edit ( defspec -- ) where [ first2 edit-location ] when* ; From d8fc44662286db830264df286be0bb84e91151c0 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 27 Mar 2008 18:13:55 -0500 Subject: [PATCH 079/219] add unit tests and fix lots of words for normalize-pathname --- core/io/files/files-tests.factor | 50 ++++++++++++++++++++++++++++++++ extra/io/unix/files/files.factor | 18 +++++++----- 2 files changed, 60 insertions(+), 8 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index b732495541..b78f7667a6 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -7,6 +7,56 @@ io.encodings.utf8 ; [ ] [ "blahblah" temp-file make-directory ] unit-test [ t ] [ "blahblah" temp-file directory? ] unit-test +[ t ] [ + [ temp-directory "loldir" append-path delete-directory ] ignore-errors + temp-directory [ + "loldir" make-directory + ] with-directory + temp-directory "loldir" append-path exists? +] unit-test + +[ ] [ + [ temp-directory "loldir" append-path delete-directory ] ignore-errors + temp-directory [ + "loldir" make-directory + "loldir" delete-directory + ] with-directory +] unit-test + +[ "file1 contents" ] [ + [ temp-directory "loldir" append-path delete-directory ] ignore-errors + temp-directory [ + "file1 contents" "file1" utf8 set-file-contents + "file1" "file2" copy-file + "file2" utf8 file-contents + ] with-directory + "file1" temp-file delete-file + "file2" temp-file delete-file +] unit-test + +[ "file3 contents" ] [ + temp-directory [ + "file3 contents" "file3" utf8 set-file-contents + "file3" "file4" move-file + "file4" utf8 file-contents + ] with-directory + "file4" temp-file delete-file +] unit-test + +[ ] [ + temp-directory [ + "file5" touch-file + "file5" delete-file + ] with-directory +] unit-test + +[ ] [ + temp-directory [ + "file6" touch-file + "file6" link-info drop + ] with-directory +] unit-test + [ "passwd" ] [ "/etc/passwd" file-name ] unit-test [ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test [ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 2888231e20..ca5d7a7bf1 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -7,11 +7,11 @@ calendar io.encodings.binary ; IN: io.unix.files -M: unix-io cwd +M: unix-io cwd ( -- path ) MAXPATHLEN [ ] [ ] bi getcwd [ (io-error) ] unless* ; -M: unix-io cd +M: unix-io cd ( path -- ) chdir io-error ; : read-flags O_RDONLY ; inline @@ -39,25 +39,26 @@ M: unix-io (file-writer) ( path -- stream ) M: unix-io (file-appender) ( path -- stream ) open-append ; -: touch-mode +: touch-mode ( -- n ) { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable M: unix-io touch-file ( path -- ) + normalize-pathname touch-mode file-mode open dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when close ; M: unix-io move-file ( from to -- ) - rename io-error ; + [ normalize-pathname ] 2apply rename io-error ; M: unix-io delete-file ( path -- ) - unlink io-error ; + normalize-pathname unlink io-error ; M: unix-io make-directory ( path -- ) - OCT: 777 mkdir io-error ; + normalize-pathname OCT: 777 mkdir io-error ; M: unix-io delete-directory ( path -- ) - rmdir io-error ; + normalize-pathname rmdir io-error ; : (copy-file) ( from to -- ) dup parent-directory make-directories @@ -68,8 +69,9 @@ M: unix-io delete-directory ( path -- ) ] with-disposal ; M: unix-io copy-file ( from to -- ) + [ normalize-pathname ] 2apply [ (copy-file) ] - [ swap file-info file-info-permissions chmod io-error ] + [ swap file-info file-info-permissions chmod io-error ] 2bi ; : stat>type ( stat -- type ) From b2a430629b2121fd764031d36f7a8b92001fb51d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 26 Mar 2008 14:55:04 -0500 Subject: [PATCH 080/219] fix wordpad --- extra/editors/editors.factor | 7 ++++--- extra/editors/wordpad/wordpad.factor | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index 67e515ebc1..bfbfe1b6ca 100755 --- a/extra/editors/editors.factor +++ b/extra/editors/editors.factor @@ -1,8 +1,9 @@ -! Copyright (C) 2005, 2007 Slava Pestov. +! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: parser kernel namespaces sequences definitions io.files inspector continuations tuples tools.crossref tools.vocabs -io prettyprint source-files assocs vocabs vocabs.loader ; +io prettyprint source-files assocs vocabs vocabs.loader +io.backend splitting ; IN: editors TUPLE: no-edit-hook ; @@ -25,7 +26,7 @@ SYMBOL: edit-hook require ; : edit-location ( file line -- ) - >r current-directory get prepend-path r> + >r normalize-pathname "\\\\?\\" ?head drop r> edit-hook get [ call ] [ no-edit-hook edit-location ] if* ; : edit ( defspec -- ) diff --git a/extra/editors/wordpad/wordpad.factor b/extra/editors/wordpad/wordpad.factor index d1f979e0f3..3f3dd6cab1 100755 --- a/extra/editors/wordpad/wordpad.factor +++ b/extra/editors/wordpad/wordpad.factor @@ -5,10 +5,10 @@ IN: editors.wordpad : wordpad-path ( -- path ) \ wordpad-path get [ - program-files "\\Windows NT\\Accessories\\wordpad.exe" append-path + program-files "Windows NT\\Accessories\\wordpad.exe" append-path ] unless* ; : wordpad ( file line -- ) - drop wordpad-path swap 2array run-detached drop ; + drop wordpad-path swap 2array dup . run-detached drop ; [ wordpad ] edit-hook set-global From 8939dd49718c6573e674fb5d7e1914f05ec8b137 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 26 Mar 2008 14:57:35 -0500 Subject: [PATCH 081/219] add path-separator --- core/io/files/files.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 60943be48c..48098e612d 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -45,6 +45,8 @@ HOOK: (file-appender) io-backend ( path -- stream ) ! Pathnames : path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ; +: path-separator ( -- string ) windows? "\\" "/" ? ; + : right-trim-separators ( str -- newstr ) [ path-separator? ] right-trim ; From eed26edf23777bdf445316a9258294ca1b4f1452 Mon Sep 17 00:00:00 2001 From: erg Date: Wed, 26 Mar 2008 15:24:54 -0500 Subject: [PATCH 082/219] fix bootstrap --- core/io/files/files-tests.factor | 10 ++++++---- core/io/files/files.factor | 18 +++++++++--------- extra/ui/freetype/freetype.factor | 2 +- 3 files changed, 16 insertions(+), 14 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index e3765fead0..7af1b602d0 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -178,10 +178,10 @@ io.files.unique sequences strings accessors ; [ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test [ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test -[ "foo/" ] [ "foo/bar/." parent-directory ] unit-test -[ "foo/" ] [ "foo/bar/./" parent-directory ] unit-test -[ "foo/" ] [ "foo/bar/baz/.." parent-directory ] unit-test -[ "foo/" ] [ "foo/bar/baz/../" parent-directory ] unit-test +[ "foo/bar/." parent-directory ] must-fail +[ "foo/bar/./" parent-directory ] must-fail +[ "foo/bar/baz/.." parent-directory ] must-fail +[ "foo/bar/baz/../" parent-directory ] must-fail [ "." parent-directory ] must-fail [ "./" parent-directory ] must-fail @@ -190,6 +190,8 @@ io.files.unique sequences strings accessors ; [ "../../" parent-directory ] must-fail [ "foo/.." parent-directory ] must-fail [ "foo/../" parent-directory ] must-fail +[ "" parent-directory ] must-fail +[ "." ] [ "boot.x86.64.image" parent-directory ] unit-test [ "bar/foo" ] [ "bar/baz" "..///foo" append-path ] unit-test [ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 8595f227bf..6500bdb387 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -66,14 +66,12 @@ ERROR: no-parent-directory path ; right-trim-separators dup last-path-separator [ 1+ cut - { - { "." [ 1 head* parent-directory ] } - { ".." [ - 2 head* parent-directory parent-directory - ] } - [ drop ] - } case - ] [ no-parent-directory ] if + ] [ + drop "." swap + ] if + { "" "." ".." } member? [ + no-parent-directory + ] when ] unless ; Date: Wed, 26 Mar 2008 15:25:20 -0500 Subject: [PATCH 083/219] remove a unit test --- extra/io/unix/files/files-tests.factor | 1 - 1 file changed, 1 deletion(-) diff --git a/extra/io/unix/files/files-tests.factor b/extra/io/unix/files/files-tests.factor index 98de09e8f1..22b29b7a51 100755 --- a/extra/io/unix/files/files-tests.factor +++ b/extra/io/unix/files/files-tests.factor @@ -6,7 +6,6 @@ IN: io.unix.files.tests [ "/" ] [ "/etc/" parent-directory ] unit-test [ "/" ] [ "/etc" parent-directory ] unit-test [ "/" ] [ "/" parent-directory ] unit-test -[ "asdf" parent-directory ] must-fail [ f ] [ "" root-directory? ] unit-test [ t ] [ "/" root-directory? ] unit-test From 65a12660a73f23e98920377b9e959d8dd1a34627 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 26 Mar 2008 15:55:55 -0500 Subject: [PATCH 084/219] implement priorities on windows --- extra/io/launcher/launcher.factor | 1 + extra/io/unix/launcher/launcher.factor | 1 + extra/io/windows/launcher/launcher.factor | 12 ++++++++++++ extra/windows/kernel32/kernel32.factor | 1 - 4 files changed, 14 insertions(+), 1 deletion(-) diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor index ac8dc15661..79382091ab 100755 --- a/extra/io/launcher/launcher.factor +++ b/extra/io/launcher/launcher.factor @@ -38,6 +38,7 @@ SYMBOL: +low-priority+ SYMBOL: +normal-priority+ SYMBOL: +high-priority+ SYMBOL: +highest-priority+ +SYMBOL: +realtime-priority+ : ( -- process ) process construct-empty diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index e16ecde6fa..11c608c68f 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -24,6 +24,7 @@ USE: unix { +normal-priority+ 0 } { +high-priority+ -10 } { +highest-priority+ -20 } + { +realtime-priority+ -20 } } at set-priority ] when* ; diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index ca8f5f3e59..2d281d0fe8 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -49,6 +49,17 @@ TUPLE: CreateProcess-args : join-arguments ( args -- cmd-line ) [ escape-argument ] map " " join ; +: lookup-priority ( process -- n ) + priority>> { + { +lowest-priority+ [ IDLE_PRIORITY_CLASS ] } + { +low-priority+ [ BELOW_NORMAL_PRIORITY_CLASS ] } + { +normal-priority+ [ NORMAL_PRIORITY_CLASS ] } + { +high-priority+ [ ABOVE_NORMAL_PRIORITY_CLASS ] } + { +highest-priority+ [ HIGH_PRIORITY_CLASS ] } + { +realtime-priority+ [ REALTIME_PRIORITY_CLASS ] } + [ drop f ] + } case ; + : app-name/cmd-line ( process -- app-name cmd-line ) command>> dup string? [ " " split1 @@ -71,6 +82,7 @@ TUPLE: CreateProcess-args 0 pick pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when pick detached>> winnt? and [ DETACHED_PROCESS bitor ] when + pick lookup-priority [ bitor ] when* >>dwCreateFlags ; : fill-lpEnvironment ( process args -- process args ) diff --git a/extra/windows/kernel32/kernel32.factor b/extra/windows/kernel32/kernel32.factor index 22a86818cf..ec70b14e68 100644 --- a/extra/windows/kernel32/kernel32.factor +++ b/extra/windows/kernel32/kernel32.factor @@ -125,7 +125,6 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION : OF_REOPEN 32768 ; : OF_VERIFY 1024 ; - : INFINITE HEX: FFFFFFFF ; inline ! From C:\cygwin\usr\include\w32api\winbase.h From 603a55bde5c20ccbf318c01fe1c849a95c841a0d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 26 Mar 2008 15:59:11 -0500 Subject: [PATCH 085/219] run deploy as +low-priority+ --- extra/tools/deploy/backend/backend.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/extra/tools/deploy/backend/backend.factor b/extra/tools/deploy/backend/backend.factor index 172a80b612..b019326ed5 100755 --- a/extra/tools/deploy/backend/backend.factor +++ b/extra/tools/deploy/backend/backend.factor @@ -21,6 +21,7 @@ IN: tools.deploy.backend swap >>command +stdout+ >>stderr +closed+ >>stdin + +low-priority+ >>priority utf8 dup copy-lines process>> wait-for-process zero? [ From d4dd93e3168182ad05c1b94a1c74eac90ed95a3c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 26 Mar 2008 16:22:34 -0500 Subject: [PATCH 086/219] move some io files unit tests to unix --- core/io/files/files-tests.factor | 8 -------- extra/io/unix/files/files-tests.factor | 10 ++++++++++ 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 7af1b602d0..36b32ea34c 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -10,8 +10,6 @@ io.files.unique sequences strings accessors ; [ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test [ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test [ "" ] [ "" file-name ] unit-test -[ "/" ] [ "/" file-name ] unit-test -[ "///" ] [ "///" file-name ] unit-test [ ] [ { "Hello world." } @@ -156,18 +154,12 @@ io.files.unique sequences strings accessors ; [ "/usr/lib/" ] [ "/usr" "./lib/" append-path ] unit-test [ "/lib" ] [ "/usr" "../lib" append-path ] unit-test [ "/lib/" ] [ "/usr" "../lib/" append-path ] unit-test -[ "/lib" ] [ "/" "../lib" append-path ] unit-test -[ "/lib/" ] [ "/" "../lib/" append-path ] unit-test [ "" ] [ "" "." append-path ] unit-test [ "" ".." append-path ] must-fail [ "/" ] [ "/" "./." append-path ] unit-test [ "/" ] [ "/" "././" append-path ] unit-test -[ "/" ] [ "/" "../.." append-path ] unit-test -[ "/" ] [ "/" "../../" append-path ] unit-test -[ "/lib" ] [ "/" "../../lib" append-path ] unit-test -[ "/lib/" ] [ "/" "../../lib/" append-path ] unit-test [ "/a/b/lib" ] [ "/a/b/c/d/e/f/" "../../../../lib" append-path ] unit-test [ "/a/b/lib/" ] [ "/a/b/c/d/e/f/" "../../../../lib/" append-path ] unit-test diff --git a/extra/io/unix/files/files-tests.factor b/extra/io/unix/files/files-tests.factor index 22b29b7a51..bb2039adfb 100755 --- a/extra/io/unix/files/files-tests.factor +++ b/extra/io/unix/files/files-tests.factor @@ -11,3 +11,13 @@ IN: io.unix.files.tests [ t ] [ "/" root-directory? ] unit-test [ t ] [ "//" root-directory? ] unit-test [ t ] [ "///////" root-directory? ] unit-test + +[ "/" ] [ "/" file-name ] unit-test +[ "///" ] [ "///" file-name ] unit-test + +[ "/" ] [ "/" "../.." append-path ] unit-test +[ "/" ] [ "/" "../../" append-path ] unit-test +[ "/lib" ] [ "/" "../lib" append-path ] unit-test +[ "/lib/" ] [ "/" "../lib/" append-path ] unit-test +[ "/lib" ] [ "/" "../../lib" append-path ] unit-test +[ "/lib/" ] [ "/" "../../lib/" append-path ] unit-test From 4844bae31a36bba5193d863c61b3b50514efe4db Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 26 Mar 2008 16:38:31 -0500 Subject: [PATCH 087/219] Tuple redefinition fixes --- core/tuples/tuples-tests.factor | 152 +++++++++++++++++--------------- core/tuples/tuples.factor | 91 ++++++++++--------- 2 files changed, 132 insertions(+), 111 deletions(-) diff --git a/core/tuples/tuples-tests.factor b/core/tuples/tuples-tests.factor index fec3bdbc6f..322974c3fd 100755 --- a/core/tuples/tuples-tests.factor +++ b/core/tuples/tuples-tests.factor @@ -2,18 +2,18 @@ USING: definitions generic kernel kernel.private math math.constants parser sequences tools.test words assocs namespaces quotations sequences.private classes continuations generic.standard effects tuples tuples.private arrays vectors -strings compiler.units ; +strings compiler.units accessors ; IN: tuples.tests TUPLE: rect x y w h ; : rect construct-boa ; -: move ( x rect -- ) - [ rect-x + ] keep set-rect-x ; +: move ( x rect -- rect ) + [ + ] change-x ; -[ f ] [ 10 20 30 40 dup clone 5 swap [ move ] keep = ] unit-test +[ f ] [ 10 20 30 40 dup clone 5 swap move = ] unit-test -[ t ] [ 10 20 30 40 dup clone 0 swap [ move ] keep = ] unit-test +[ t ] [ 10 20 30 40 dup clone 0 swap move = ] unit-test GENERIC: delegation-test M: object delegation-test drop 3 ; @@ -34,27 +34,46 @@ TUPLE: quuux-tuple-2 ; [ 4 ] [ delegation-test-2 ] unit-test +! Make sure we handle tuple class redefinition +TUPLE: redefinition-test ; + +C: redefinition-test + + "redefinition-test" set + +[ t ] [ "redefinition-test" get redefinition-test? ] unit-test + +"IN: tuples.tests TUPLE: redefinition-test ;" eval + +[ t ] [ "redefinition-test" get redefinition-test? ] unit-test + ! Make sure we handle changing shapes! TUPLE: point x y ; C: point -100 200 "p" set +[ ] [ 100 200 "p" set ] unit-test ! Use eval to sequence parsing explicitly -"IN: tuples.tests TUPLE: point x y z ;" eval +[ ] [ "IN: tuples.tests TUPLE: point x y z ;" eval ] unit-test -[ 100 ] [ "p" get point-x ] unit-test -[ 200 ] [ "p" get point-y ] unit-test -[ f ] [ "p" get "point-z" "tuples.tests" lookup execute ] unit-test +[ 100 ] [ "p" get x>> ] unit-test +[ 200 ] [ "p" get y>> ] unit-test +[ f ] [ "p" get "z>>" "accessors" lookup execute ] unit-test -300 "p" get "set-point-z" "tuples.tests" lookup execute +"p" get 300 ">>z" "accessors" lookup execute drop + +[ 4 ] [ "p" get tuple-size ] unit-test + +[ 300 ] [ "p" get "z>>" "accessors" lookup execute ] unit-test "IN: tuples.tests TUPLE: point z y ;" eval -[ "p" get point-x ] must-fail -[ 200 ] [ "p" get point-y ] unit-test -[ 300 ] [ "p" get "point-z" "tuples.tests" lookup execute ] unit-test +[ 3 ] [ "p" get tuple-size ] unit-test + +[ "p" get x>> ] must-fail +[ 200 ] [ "p" get y>> ] unit-test +[ 300 ] [ "p" get "z>>" "accessors" lookup execute ] unit-test TUPLE: predicate-test ; @@ -68,10 +87,10 @@ PREDICATE: tuple silly-pred class \ rect = ; GENERIC: area -M: silly-pred area dup rect-w swap rect-h * ; +M: silly-pred area dup w>> swap h>> * ; TUPLE: circle radius ; -M: circle area circle-radius sq pi * ; +M: circle area radius>> sq pi * ; [ 200 ] [ T{ rect f 0 0 10 20 } area ] unit-test @@ -88,7 +107,7 @@ TUPLE: delegate-clone ; [ T{ delegate-clone T{ empty f } } clone ] unit-test ! Compiler regression -[ t length ] [ no-method-object t eq? ] must-fail-with +[ t length ] [ object>> t eq? ] must-fail-with [ "" ] [ "TUPLE: constructor-test ; C: constructor-test" eval word word-name ] unit-test @@ -96,7 +115,7 @@ TUPLE: delegate-clone ; TUPLE: size-test a b c d ; [ t ] [ - T{ size-test } array-capacity + T{ size-test } tuple-size size-test tuple-size = ] unit-test @@ -213,55 +232,50 @@ C: erg's-reshape-problem ! tuples are reshaped : cons-test-1 \ erg's-reshape-problem construct-empty ; : cons-test-2 \ erg's-reshape-problem construct-boa ; -: cons-test-3 - { set-erg's-reshape-problem-a } - \ erg's-reshape-problem construct ; -"IN: tuples.tests TUPLE: erg's-reshape-problem a b c d e f ;" eval - -[ ] [ 1 2 3 4 5 6 cons-test-2 "a" set ] unit-test - -[ t ] [ cons-test-1 array-capacity "a" get array-capacity = ] unit-test - -[ t ] [ 1 cons-test-3 array-capacity "a" get array-capacity = ] unit-test - -[ - "IN: tuples.tests SYMBOL: not-a-class C: not-a-class" eval -] [ [ no-tuple-class? ] is? ] must-fail-with - -! Hardcore unit tests -USE: threads - -\ thread "slot-names" word-prop "slot-names" set - -[ ] [ - [ - \ thread { "xxx" } "slot-names" get append - define-tuple-class - ] with-compilation-unit - - [ 1337 sleep ] "Test" spawn drop - - [ - \ thread "slot-names" get - define-tuple-class - ] with-compilation-unit -] unit-test - -USE: vocabs - -\ vocab "slot-names" word-prop "slot-names" set - -[ ] [ - [ - \ vocab { "xxx" } "slot-names" get append - define-tuple-class - ] with-compilation-unit - - all-words drop - - [ - \ vocab "slot-names" get - define-tuple-class - ] with-compilation-unit -] unit-test +! "IN: tuples.tests TUPLE: erg's-reshape-problem a b c d e f ;" eval +! +! [ ] [ 1 2 3 4 5 6 cons-test-2 "a" set ] unit-test +! +! [ t ] [ cons-test-1 tuple-size "a" get tuple-size = ] unit-test +! +! [ +! "IN: tuples.tests SYMBOL: not-a-class C: not-a-class" eval +! ] [ [ no-tuple-class? ] is? ] must-fail-with +! +! ! Hardcore unit tests +! USE: threads +! +! \ thread "slot-names" word-prop "slot-names" set +! +! [ ] [ +! [ +! \ thread { "xxx" } "slot-names" get append +! define-tuple-class +! ] with-compilation-unit +! +! [ 1337 sleep ] "Test" spawn drop +! +! [ +! \ thread "slot-names" get +! define-tuple-class +! ] with-compilation-unit +! ] unit-test +! +! USE: vocabs +! +! \ vocab "slot-names" word-prop "slot-names" set +! +! [ ] [ +! [ +! \ vocab { "xxx" } "slot-names" get append +! define-tuple-class +! ] with-compilation-unit +! +! all-words drop +! +! [ +! \ vocab "slot-names" get +! define-tuple-class +! ] with-compilation-unit +! ] unit-test diff --git a/core/tuples/tuples.factor b/core/tuples/tuples.factor index 56fb12fffc..84b4f2eae5 100755 --- a/core/tuples/tuples.factor +++ b/core/tuples/tuples.factor @@ -3,7 +3,7 @@ USING: arrays definitions hashtables kernel kernel.private math namespaces sequences sequences.private strings vectors words quotations memory combinators generic -classes classes.private slots slots.deprecated slots.private +classes classes.private slots.deprecated slots.private slots compiler.units ; IN: tuples @@ -49,43 +49,6 @@ PRIVATE> 2drop f ] if ; -: permutation ( seq1 seq2 -- permutation ) - swap [ index ] curry map ; - -: reshape-tuple ( oldtuple permutation -- newtuple ) - >r tuple>array 2 cut r> - [ [ swap ?nth ] [ drop f ] if* ] with map - append >tuple ; - -: reshape-tuples ( class newslots -- ) - >r dup "slot-names" word-prop r> permutation - [ - >r [ swap class eq? ] curry instances dup r> - [ reshape-tuple ] curry map - become - ] 2curry after-compilation ; - -: old-slots ( class newslots -- seq ) - swap "slots" word-prop 1 tail-slice - [ slot-spec-name swap member? not ] with subset ; - -: forget-slots ( class newslots -- ) - dupd old-slots [ - 2dup - slot-spec-reader 2array forget - slot-spec-writer 2array forget - ] with each ; - -: check-shape ( class newslots -- ) - over tuple-class? [ - over "slot-names" word-prop over = [ - 2dup forget-slots - 2dup reshape-tuples - over changed-word - over redefined - ] unless - ] when 2drop ; - M: tuple-class tuple-layout "layout" word-prop ; : define-tuple-predicate ( class -- ) @@ -114,15 +77,59 @@ M: tuple-class tuple-layout "layout" word-prop ; dup "slot-names" word-prop length 1+ { } 0 "layout" set-word-prop ; -PRIVATE> +: removed-slots ( class newslots -- seq ) + swap "slot-names" word-prop seq-diff ; -: define-tuple-class ( class slots -- ) - 2dup check-shape - over f tuple tuple-class define-class +: forget-slots ( class newslots -- ) + dupd removed-slots [ + 2dup + reader-word forget-method + writer-word forget-method + ] with each ; + +: permutation ( seq1 seq2 -- permutation ) + swap [ index ] curry map ; + +: reshape-tuple ( oldtuple permutation -- newtuple ) + >r tuple>array 2 cut r> + [ [ swap ?nth ] [ drop f ] if* ] with map + append >tuple ; + +: reshape-tuples ( class newslots -- ) + >r dup "slot-names" word-prop r> permutation + [ + >r [ swap class eq? ] curry instances dup r> + [ reshape-tuple ] curry map + become + ] 2curry after-compilation ; + +: tuple-class-unchanged 2drop ; + +: prepare-tuple-class ( class slots -- ) dupd define-tuple-slots dup define-tuple-layout define-tuple-predicate ; +: redefine-tuple-class ( class slots -- ) + 2dup forget-slots + 2dup reshape-tuples + over changed-word + over redefined + prepare-tuple-class ; + +: define-new-tuple-class ( class slots -- ) + over f tuple tuple-class define-class + prepare-tuple-class ; + +PRIVATE> + +: define-tuple-class ( class slots -- ) + { + { [ over tuple-class? not ] [ define-new-tuple-class ] } + { [ over "slot-names" word-prop over = ] [ tuple-class-unchanged ] } + { [ t ] [ redefine-tuple-class ] } + } cond ; + M: tuple clone (clone) dup delegate clone over set-delegate ; From 89a531d4a2ba2a5c6e95978bfac0e72ebedd605d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 26 Mar 2008 17:07:50 -0500 Subject: [PATCH 088/219] Fixing unit tests --- core/bootstrap/primitives.factor | 12 +++- core/io/encodings/encodings-tests.factor | 8 +-- core/io/io-tests.factor | 8 +-- core/parser/parser.factor | 8 +++ core/syntax/syntax.factor | 8 +-- core/tuples/tuples-tests.factor | 92 ++++++++++++------------ core/tuples/tuples.factor | 18 +++-- extra/combinators/lib/lib.factor | 33 ++++----- extra/io/encodings/8-bit/8-bit.factor | 6 +- extra/openssl/openssl-tests.factor | 10 +-- 10 files changed, 110 insertions(+), 93 deletions(-) mode change 100644 => 100755 extra/io/encodings/8-bit/8-bit.factor diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 253f23238a..3f6fedb40c 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -358,7 +358,9 @@ builtins get num-tags get tail f union-class define-class "null" "kernel" create { } f union-class define-class ! Create special tombstone values -"tombstone" "hashtables.private" create { } define-tuple-class +"tombstone" "hashtables.private" create +"tuple" "kernel" lookup +{ } define-tuple-class "((empty))" "hashtables.private" create "tombstone" "hashtables.private" lookup f @@ -370,6 +372,7 @@ builtins get num-tags get tail f union-class define-class ! Some tuple classes "hashtable" "hashtables" create +"tuple" "kernel" lookup { { { "array-capacity" "sequences.private" } @@ -390,6 +393,7 @@ builtins get num-tags get tail f union-class define-class } define-tuple-class "sbuf" "sbufs" create +"tuple" "kernel" lookup { { { "string" "strings" } @@ -405,6 +409,7 @@ builtins get num-tags get tail f union-class define-class } define-tuple-class "vector" "vectors" create +"tuple" "kernel" lookup { { { "array" "arrays" } @@ -420,6 +425,7 @@ builtins get num-tags get tail f union-class define-class } define-tuple-class "byte-vector" "byte-vectors" create +"tuple" "kernel" lookup { { { "byte-array" "byte-arrays" } @@ -435,6 +441,7 @@ builtins get num-tags get tail f union-class define-class } define-tuple-class "bit-vector" "bit-vectors" create +"tuple" "kernel" lookup { { { "bit-array" "bit-arrays" } @@ -450,6 +457,7 @@ builtins get num-tags get tail f union-class define-class } define-tuple-class "float-vector" "float-vectors" create +"tuple" "kernel" lookup { { { "float-array" "float-arrays" } @@ -465,6 +473,7 @@ builtins get num-tags get tail f union-class define-class } define-tuple-class "curry" "kernel" create +"tuple" "kernel" lookup { { { "object" "kernel" } @@ -484,6 +493,7 @@ dup f "inline" set-word-prop dup tuple-layout [ ] curry define "compose" "kernel" create +"tuple" "kernel" lookup { { { "object" "kernel" } diff --git a/core/io/encodings/encodings-tests.factor b/core/io/encodings/encodings-tests.factor index 73d2efa7d4..397d1ea89c 100755 --- a/core/io/encodings/encodings-tests.factor +++ b/core/io/encodings/encodings-tests.factor @@ -6,7 +6,7 @@ IN: io.streams.encodings.tests resource-path ascii ; [ { } ] -[ "/core/io/test/empty-file.txt" lines ] +[ "core/io/test/empty-file.txt" lines ] unit-test : lines-test ( stream -- line1 line2 ) @@ -16,21 +16,21 @@ unit-test "This is a line." "This is another line." ] [ - "/core/io/test/windows-eol.txt" lines-test + "core/io/test/windows-eol.txt" lines-test ] unit-test [ "This is a line." "This is another line." ] [ - "/core/io/test/mac-os-eol.txt" lines-test + "core/io/test/mac-os-eol.txt" lines-test ] unit-test [ "This is a line." "This is another line." ] [ - "/core/io/test/unix-eol.txt" lines-test + "core/io/test/unix-eol.txt" lines-test ] unit-test [ diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index 91e51f25b0..6662ac41d7 100755 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -4,7 +4,7 @@ io.encodings.binary ; IN: io.tests [ f ] [ - "resource:/core/io/test/no-trailing-eol.factor" run-file + "resource:core/io/test/no-trailing-eol.factor" run-file "foo" "io.tests" lookup ] unit-test @@ -14,14 +14,14 @@ IN: io.tests [ "This is a line.\rThis is another line.\r" ] [ - "/core/io/test/mac-os-eol.txt" + "core/io/test/mac-os-eol.txt" [ 500 read ] with-stream ] unit-test [ 255 ] [ - "/core/io/test/binary.txt" + "core/io/test/binary.txt" [ read1 ] with-stream >fixnum ] unit-test @@ -36,7 +36,7 @@ IN: io.tests } ] [ [ - "/core/io/test/separator-test.txt" [ + "core/io/test/separator-test.txt" [ "J" read-until 2array , "i" read-until 2array , "X" read-until 2array , diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 28822db708..0a00c742a0 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -288,6 +288,14 @@ M: no-word summary : CREATE-METHOD ( -- method ) scan-word bootstrap-word scan-word create-method-in ; +: parse-tuple-definition ( -- class superclass slots ) + CREATE-CLASS + scan { + { ";" [ tuple f ] } + { "<" [ scan-word ";" parse-tokens ] } + [ >r tuple ";" parse-tokens r> add* ] + } case ; + ERROR: staging-violation word ; M: staging-violation summary diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 843f372542..17b3b86269 100755 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -154,7 +154,7 @@ IN: bootstrap.syntax ] define-syntax "TUPLE:" [ - CREATE-CLASS ";" parse-tokens define-tuple-class + parse-tuple-definition define-tuple-class ] define-syntax "C:" [ @@ -164,9 +164,9 @@ IN: bootstrap.syntax ] define-syntax "ERROR:" [ - CREATE-CLASS dup ";" parse-tokens define-tuple-class - dup save-location - dup [ construct-boa throw ] curry define + parse-tuple-definition + pick save-location + define-error-class ] define-syntax "FORGET:" [ diff --git a/core/tuples/tuples-tests.factor b/core/tuples/tuples-tests.factor index 322974c3fd..702557e257 100755 --- a/core/tuples/tuples-tests.factor +++ b/core/tuples/tuples-tests.factor @@ -233,49 +233,49 @@ C: erg's-reshape-problem : cons-test-1 \ erg's-reshape-problem construct-empty ; : cons-test-2 \ erg's-reshape-problem construct-boa ; -! "IN: tuples.tests TUPLE: erg's-reshape-problem a b c d e f ;" eval -! -! [ ] [ 1 2 3 4 5 6 cons-test-2 "a" set ] unit-test -! -! [ t ] [ cons-test-1 tuple-size "a" get tuple-size = ] unit-test -! -! [ -! "IN: tuples.tests SYMBOL: not-a-class C: not-a-class" eval -! ] [ [ no-tuple-class? ] is? ] must-fail-with -! -! ! Hardcore unit tests -! USE: threads -! -! \ thread "slot-names" word-prop "slot-names" set -! -! [ ] [ -! [ -! \ thread { "xxx" } "slot-names" get append -! define-tuple-class -! ] with-compilation-unit -! -! [ 1337 sleep ] "Test" spawn drop -! -! [ -! \ thread "slot-names" get -! define-tuple-class -! ] with-compilation-unit -! ] unit-test -! -! USE: vocabs -! -! \ vocab "slot-names" word-prop "slot-names" set -! -! [ ] [ -! [ -! \ vocab { "xxx" } "slot-names" get append -! define-tuple-class -! ] with-compilation-unit -! -! all-words drop -! -! [ -! \ vocab "slot-names" get -! define-tuple-class -! ] with-compilation-unit -! ] unit-test +"IN: tuples.tests TUPLE: erg's-reshape-problem a b c d e f ;" eval + +[ ] [ 1 2 3 4 5 6 cons-test-2 "a" set ] unit-test + +[ t ] [ cons-test-1 tuple-size "a" get tuple-size = ] unit-test + +[ + "IN: tuples.tests SYMBOL: not-a-class C: not-a-class" eval +] [ [ no-tuple-class? ] is? ] must-fail-with + +! Hardcore unit tests +USE: threads + +\ thread "slot-names" word-prop "slot-names" set + +[ ] [ + [ + \ thread { "xxx" } "slot-names" get append + define-tuple-class + ] with-compilation-unit + + [ 1337 sleep ] "Test" spawn drop + + [ + \ thread "slot-names" get + define-tuple-class + ] with-compilation-unit +] unit-test + +USE: vocabs + +\ vocab "slot-names" word-prop "slot-names" set + +[ ] [ + [ + \ vocab { "xxx" } "slot-names" get append + define-tuple-class + ] with-compilation-unit + + all-words drop + + [ + \ vocab "slot-names" get + define-tuple-class + ] with-compilation-unit +] unit-test diff --git a/core/tuples/tuples.factor b/core/tuples/tuples.factor index 84b4f2eae5..8318c0ede1 100755 --- a/core/tuples/tuples.factor +++ b/core/tuples/tuples.factor @@ -103,33 +103,39 @@ M: tuple-class tuple-layout "layout" word-prop ; become ] 2curry after-compilation ; -: tuple-class-unchanged 2drop ; +: tuple-class-unchanged ( class superclass slots -- ) 3drop ; : prepare-tuple-class ( class slots -- ) dupd define-tuple-slots dup define-tuple-layout define-tuple-predicate ; -: redefine-tuple-class ( class slots -- ) +: redefine-tuple-class ( class superclass slots -- ) + nip 2dup forget-slots 2dup reshape-tuples over changed-word over redefined prepare-tuple-class ; -: define-new-tuple-class ( class slots -- ) +: define-new-tuple-class ( class superclass slots -- ) + nip over f tuple tuple-class define-class prepare-tuple-class ; PRIVATE> -: define-tuple-class ( class slots -- ) +: define-tuple-class ( class superclass slots -- ) { - { [ over tuple-class? not ] [ define-new-tuple-class ] } - { [ over "slot-names" word-prop over = ] [ tuple-class-unchanged ] } + { [ pick tuple-class? not ] [ define-new-tuple-class ] } + { [ pick "slot-names" word-prop over = ] [ tuple-class-unchanged ] } { [ t ] [ redefine-tuple-class ] } } cond ; +: define-error-class ( class superclass slots -- ) + pick >r define-tuple-class r> + dup [ construct-boa throw ] curry define ; + M: tuple clone (clone) dup delegate clone over set-delegate ; diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 459938c885..9fe19555c5 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -1,7 +1,8 @@ -! Copyright (C) 2007 Slava Pestov, Chris Double, Doug Coleman, -! Eduardo Cavazos, Daniel Ehrenberg. +! Copyright (C) 2007, 2008 Slava Pestov, Chris Double, +! Doug Coleman, Eduardo Cavazos, +! Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel combinators namespaces quotations hashtables +USING: kernel combinators fry namespaces quotations hashtables sequences assocs arrays inference effects math math.ranges arrays.lib shuffle macros bake combinators.cleave continuations ; @@ -34,9 +35,8 @@ MACRO: nwith ( quot n -- ) MACRO: napply ( n -- ) 2 [a,b] - [ [ ] [ 1- ] bi - [ , ntuck , nslip ] - bake ] + [ [ 1- ] [ ] bi + '[ , ntuck , nslip ] ] map concat >quotation [ call ] append ; : 3apply ( obj obj obj quot -- ) 3 napply ; inline @@ -88,26 +88,21 @@ MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ; ! ifte ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +MACRO: preserving ( predicate -- quot ) + dup infer effect-in + dup 1+ + '[ , , nkeep , nrot ] ; + MACRO: ifte ( quot quot quot -- ) - pick infer effect-in - dup 1+ swap - [ >r >r , nkeep , nrot r> r> if ] - bake ; + '[ , preserving , , if ] ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! switch ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: preserving ( predicate -- quot ) - dup infer effect-in - dup 1+ spin - [ , , nkeep , nrot ] - bake ; - MACRO: switch ( quot -- ) - [ [ preserving ] [ ] bi* ] assoc-map - [ , cond ] - bake ; + [ [ [ preserving ] curry ] dip ] assoc-map + [ cond ] curry ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/io/encodings/8-bit/8-bit.factor b/extra/io/encodings/8-bit/8-bit.factor old mode 100644 new mode 100755 index 2cc6b2e57c..ec75dc600a --- a/extra/io/encodings/8-bit/8-bit.factor +++ b/extra/io/encodings/8-bit/8-bit.factor @@ -54,10 +54,8 @@ IN: io.encodings.8-bit [ byte>ch ] [ ch>byte ] bi ; : empty-tuple-class ( string -- class ) - in get create - dup { f } "slots" set-word-prop - dup predicate-word drop - dup { } define-tuple-class ; + "io.encodings.8-bit" create + dup tuple { } define-tuple-class ; : data-quot ( class word data -- quot ) >r [ word-name ] 2apply "/" swap 3append diff --git a/extra/openssl/openssl-tests.factor b/extra/openssl/openssl-tests.factor index 2d0f5bb5d0..c689f729d1 100755 --- a/extra/openssl/openssl-tests.factor +++ b/extra/openssl/openssl-tests.factor @@ -25,7 +25,7 @@ namespaces math math.parser openssl prettyprint sequences tools.test ; [ ] [ ssl-v23 new-ctx ] unit-test -[ ] [ get-ctx "/extra/openssl/test/server.pem" resource-path use-cert-chain ] unit-test +[ ] [ get-ctx "extra/openssl/test/server.pem" resource-path use-cert-chain ] unit-test ! TODO: debug 'Memory protection fault at address 6c' ! get-ctx 1024 "char" malloc-array 1024 0 f password-cb set-default-passwd @@ -33,10 +33,10 @@ namespaces math math.parser openssl prettyprint sequences tools.test ; [ ] [ get-ctx "password" string>char-alien set-default-passwd-userdata ] unit-test ! Enter PEM pass phrase: password -[ ] [ get-ctx "/extra/openssl/test/server.pem" resource-path +[ ] [ get-ctx "extra/openssl/test/server.pem" resource-path SSL_FILETYPE_PEM use-private-key ] unit-test -[ ] [ get-ctx "/extra/openssl/test/root.pem" resource-path f +[ ] [ get-ctx "extra/openssl/test/root.pem" resource-path f verify-load-locations ] unit-test [ ] [ get-ctx 1 set-verify-depth ] unit-test @@ -45,7 +45,7 @@ verify-load-locations ] unit-test ! Load Diffie-Hellman parameters ! ========================================================= -[ ] [ "/extra/openssl/test/dh1024.pem" resource-path "r" bio-new-file ] unit-test +[ ] [ "extra/openssl/test/dh1024.pem" resource-path "r" bio-new-file ] unit-test [ ] [ get-bio f f f read-pem-dh-params ] unit-test @@ -129,7 +129,7 @@ verify-load-locations ] unit-test ! Dump errors to file ! ========================================================= -[ ] [ "/extra/openssl/test/errors.txt" resource-path "w" bio-new-file ] unit-test +[ ] [ "extra/openssl/test/errors.txt" resource-path "w" bio-new-file ] unit-test [ 6 ] [ get-bio "Hello\n" bio-print ] unit-test From 85a3ee3e5bfe49f316a01140592d9ac174decf6e Mon Sep 17 00:00:00 2001 From: Chris Double Date: Wed, 26 Mar 2008 16:43:03 +1300 Subject: [PATCH 089/219] Remove memoization in 'compile' word in pegs This creates issues when recompiling a an existing EBNF parser for reasons I've not yet tracked down. Disabling it slows things down but makes things work correctly till I investigate the issue. --- extra/peg/peg.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 00271a9ad3..e9477dc408 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -28,7 +28,7 @@ GENERIC: (compile) ( parser -- quot ) [ swap compiled-parsers get set-at ] keep ] if* ; -MEMO: compile ( parser -- word ) +: compile ( parser -- word ) H{ } clone compiled-parsers [ [ compiled-parser ] with-compilation-unit ] with-variable ; From c793a381fe651b9d09e0b5689c20703de546aca2 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Wed, 26 Mar 2008 17:38:30 +1300 Subject: [PATCH 090/219] Add hook for packrat implementation --- extra/peg/peg.factor | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index e9477dc408..af26f888f1 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -17,6 +17,12 @@ SYMBOL: compiled-parsers GENERIC: (compile) ( parser -- quot ) +: run-parser ( input quot -- result ) + #! Eventually this will be replaced with something that + #! can do packrat parsing by memoizing the results of + #! a parser. For now, it just calls the quotation. + call ; inline + : compiled-parser ( parser -- word ) #! Look to see if the given parser has been compiled. #! If not, compile it to a temporary word, cache it, @@ -24,7 +30,7 @@ GENERIC: (compile) ( parser -- quot ) dup compiled-parsers get at [ nip ] [ - dup (compile) define-temp + dup (compile) [ run-parser ] curry define-temp [ swap compiled-parsers get set-at ] keep ] if* ; From bd33e2fef9e77195aefa384639978b33179aab45 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 27 Mar 2008 11:23:19 +1300 Subject: [PATCH 091/219] Fix cache to handle the case of 'f' being a valid cached value --- core/assocs/assocs.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index ff0938e001..196ec614b7 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -134,11 +134,11 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) (substitute) map ; : cache ( key assoc quot -- value ) - 2over at [ + 2over at* [ >r 3drop r> ] [ - pick rot >r >r call dup r> r> set-at - ] if* ; inline + drop pick rot >r >r call dup r> r> set-at + ] if ; inline : change-at ( key assoc quot -- ) [ >r at r> call ] 3keep drop set-at ; inline From 690621ffb653807c68457b5caf83933a38fb207e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 26 Mar 2008 18:23:19 -0500 Subject: [PATCH 092/219] Change PREDICATE: syntax --- core/alien/alien.factor | 4 +- core/arrays/arrays.factor | 2 +- core/classes/algebra/algebra-docs.factor | 6 +- core/classes/algebra/algebra-tests.factor | 2 +- core/classes/classes-tests.factor | 2 +- core/classes/classes.factor | 8 +-- core/classes/mixin/mixin.factor | 2 +- core/classes/predicate/predicate-docs.factor | 2 +- core/classes/predicate/predicate.factor | 8 +-- core/classes/union/union.factor | 2 +- core/cpu/architecture/architecture.factor | 6 +- core/cpu/arm/assembler/assembler.factor | 2 +- core/cpu/x86/32/32.factor | 2 +- core/cpu/x86/64/64.factor | 2 +- core/cpu/x86/assembler/assembler.factor | 24 +++++--- core/debugger/debugger.factor | 2 +- core/generic/generic-tests.factor | 2 +- core/generic/generic.factor | 7 ++- core/generic/math/math.factor | 4 +- core/generic/standard/standard.factor | 6 +- core/inference/dataflow/dataflow.factor | 6 +- core/parser/parser-tests.factor | 2 +- core/parser/parser.factor | 2 +- core/prettyprint/prettyprint-tests.factor | 6 ++ core/prettyprint/prettyprint.factor | 3 +- core/sequences/sequences.factor | 2 +- core/slots/deprecated/deprecated.factor | 4 +- core/syntax/syntax-docs.factor | 10 ++- core/syntax/syntax.factor | 5 +- core/tuples/tuples-docs.factor | 10 +-- core/tuples/tuples-tests.factor | 65 ++++++++++++++++++-- core/tuples/tuples.factor | 8 ++- core/words/words.factor | 6 +- extra/delegate/delegate.factor | 2 +- extra/help/markup/markup.factor | 2 +- extra/help/topics/topics.factor | 2 +- extra/inverse/inverse.factor | 6 +- extra/io/nonblocking/nonblocking.factor | 4 +- extra/locals/locals.factor | 14 ++--- extra/macros/macros.factor | 2 +- extra/memoize/memoize.factor | 2 +- extra/multi-methods/multi-methods.factor | 11 ++-- extra/opengl/shaders/shaders.factor | 8 +-- extra/singleton/singleton.factor | 5 +- extra/ui/commands/commands.factor | 2 +- extra/ui/operations/operations.factor | 2 +- extra/unicode/syntax/syntax.factor | 2 +- extra/xml-rpc/xml-rpc.factor | 2 +- extra/xml/data/data.factor | 4 +- 49 files changed, 184 insertions(+), 110 deletions(-) mode change 100644 => 100755 core/arrays/arrays.factor mode change 100644 => 100755 extra/ui/operations/operations.factor mode change 100644 => 100755 extra/xml-rpc/xml-rpc.factor mode change 100644 => 100755 extra/xml/data/data.factor diff --git a/core/alien/alien.factor b/core/alien/alien.factor index 436d73e874..777bf523a5 100755 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -7,7 +7,7 @@ IN: alien ! Some predicate classes used by the compiler for optimization ! purposes -PREDICATE: alien simple-alien +PREDICATE: simple-alien < alien underlying-alien not ; UNION: simple-c-ptr @@ -18,7 +18,7 @@ alien POSTPONE: f byte-array bit-array float-array ; DEFER: pinned-c-ptr? -PREDICATE: alien pinned-alien +PREDICATE: pinned-alien < alien underlying-alien pinned-c-ptr? ; UNION: pinned-c-ptr diff --git a/core/arrays/arrays.factor b/core/arrays/arrays.factor old mode 100644 new mode 100755 index 714973e7ca..414c64581e --- a/core/arrays/arrays.factor +++ b/core/arrays/arrays.factor @@ -31,4 +31,4 @@ INSTANCE: array sequence : 4array ( w x y z -- array ) { } 4sequence ; flushable -PREDICATE: array pair length 2 number= ; +PREDICATE: pair < array length 2 number= ; diff --git a/core/classes/algebra/algebra-docs.factor b/core/classes/algebra/algebra-docs.factor index c21098916d..632af1d040 100755 --- a/core/classes/algebra/algebra-docs.factor +++ b/core/classes/algebra/algebra-docs.factor @@ -39,15 +39,15 @@ HELP: sort-classes { $description "Outputs a topological sort of a sequence of classes. Larger classes come before their subclasses." } ; HELP: class-or -{ $values { "class1" class } { "class2" class } { "class" class } } +{ $values { "first" class } { "second" class } { "class" class } } { $description "Outputs the smallest anonymous class containing both " { $snippet "class1" } " and " { $snippet "class2" } "." } ; HELP: class-and -{ $values { "class1" class } { "class2" class } { "class" class } } +{ $values { "first" class } { "second" class } { "class" class } } { $description "Outputs the largest anonymous class contained in both " { $snippet "class1" } " and " { $snippet "class2" } "." } ; HELP: classes-intersect? -{ $values { "class1" class } { "class2" class } { "?" "a boolean" } } +{ $values { "first" class } { "second" class } { "?" "a boolean" } } { $description "Tests if two classes have a non-empty intersection. If the intersection is empty, no object can be an instance of both classes at once." } ; HELP: min-class diff --git a/core/classes/algebra/algebra-tests.factor b/core/classes/algebra/algebra-tests.factor index 24a18559fe..cdf817e31d 100755 --- a/core/classes/algebra/algebra-tests.factor +++ b/core/classes/algebra/algebra-tests.factor @@ -51,7 +51,7 @@ UNION: both first-one union-class ; [ f ] [ \ reversed \ slice class< ] unit-test [ f ] [ \ slice \ reversed class< ] unit-test -PREDICATE: word no-docs "documentation" word-prop not ; +PREDICATE: no-docs < word "documentation" word-prop not ; UNION: no-docs-union no-docs integer ; diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index 8f43aa3336..ae9e6ec154 100755 --- a/core/classes/classes-tests.factor +++ b/core/classes/classes-tests.factor @@ -28,7 +28,7 @@ M: union-1 generic-update-test drop "union-1" ; [ f ] [ union-1 number class< ] unit-test [ "union-1" ] [ { 1.0 } generic-update-test ] unit-test -"IN: classes.tests USE: math PREDICATE: integer union-1 even? ;" eval +"IN: classes.tests USE: math PREDICATE: union-1 < integer even? ;" eval [ f ] [ union-1 union-class? ] unit-test [ t ] [ union-1 predicate-class? ] unit-test diff --git a/core/classes/classes.factor b/core/classes/classes.factor index b6082ad334..c2c19836cd 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -25,15 +25,15 @@ SYMBOL: class-or-cache class-and-cache get clear-assoc class-or-cache get clear-assoc ; -PREDICATE: word class ( obj -- ? ) "class" word-prop ; +PREDICATE: class < word ( obj -- ? ) "class" word-prop ; SYMBOL: update-map SYMBOL: builtins -PREDICATE: class builtin-class +PREDICATE: builtin-class < class "metaclass" word-prop builtin-class eq? ; -PREDICATE: class tuple-class +PREDICATE: tuple-class < class "metaclass" word-prop tuple-class eq? ; : classes ( -- seq ) all-words [ class? ] subset ; @@ -47,7 +47,7 @@ PREDICATE: class tuple-class : predicate-effect 1 { "?" } ; -PREDICATE: word predicate "predicating" word-prop >boolean ; +PREDICATE: predicate < word "predicating" word-prop >boolean ; : define-predicate ( class quot -- ) >r "predicate" word-prop first diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index f9b987eb78..780f76f0f8 100755 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -4,7 +4,7 @@ USING: classes classes.union words kernel sequences definitions combinators arrays ; IN: classes.mixin -PREDICATE: union-class mixin-class "mixin" word-prop ; +PREDICATE: mixin-class < union-class "mixin" word-prop ; M: mixin-class reset-class { "metaclass" "members" "mixin" } reset-props ; diff --git a/core/classes/predicate/predicate-docs.factor b/core/classes/predicate/predicate-docs.factor index a65392773d..d03d97cd4c 100755 --- a/core/classes/predicate/predicate-docs.factor +++ b/core/classes/predicate/predicate-docs.factor @@ -14,7 +14,7 @@ ARTICLE: "predicates" "Predicate classes" ABOUT: "predicates" HELP: define-predicate-class -{ $values { "superclass" class } { "class" class } { "definition" "a quotation with stack effect " { $snippet "( superclass -- ? )" } } } +{ $values { "class" class } { "superclass" class } { "definition" "a quotation with stack effect " { $snippet "( superclass -- ? )" } } } { $description "Defines a predicate class. This is the run time equivalent of " { $link POSTPONE: PREDICATE: } "." } { $notes "This word must be called from inside " { $link with-compilation-unit } "." } { $side-effects "class" } ; diff --git a/core/classes/predicate/predicate.factor b/core/classes/predicate/predicate.factor index 6d1c727ee2..9f5961895a 100755 --- a/core/classes/predicate/predicate.factor +++ b/core/classes/predicate/predicate.factor @@ -1,9 +1,9 @@ -! Copyright (C) 2004, 2007 Slava Pestov. +! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: classes kernel namespaces words ; IN: classes.predicate -PREDICATE: class predicate-class +PREDICATE: predicate-class < class "metaclass" word-prop predicate-class eq? ; : predicate-quot ( class -- quot ) @@ -13,8 +13,8 @@ PREDICATE: class predicate-class "predicate-definition" word-prop , [ drop f ] , \ if , ] [ ] make ; -: define-predicate-class ( superclass class definition -- ) - >r dup f roll predicate-class define-class r> +: define-predicate-class ( class superclass definition -- ) + >r >r dup f r> predicate-class define-class r> dupd "predicate-definition" set-word-prop dup predicate-quot define-predicate ; diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor index c1c82d158b..3a791c22d0 100755 --- a/core/classes/union/union.factor +++ b/core/classes/union/union.factor @@ -4,7 +4,7 @@ USING: words sequences kernel assocs combinators classes generic.standard namespaces arrays math quotations ; IN: classes.union -PREDICATE: class union-class +PREDICATE: union-class < class "metaclass" word-prop union-class eq? ; ! Union classes for dispatch on multiple classes. diff --git a/core/cpu/architecture/architecture.factor b/core/cpu/architecture/architecture.factor index cd6c8b61f7..8d1e1f281f 100755 --- a/core/cpu/architecture/architecture.factor +++ b/core/cpu/architecture/architecture.factor @@ -153,11 +153,11 @@ M: f v>operand drop \ f tag-number ; M: object load-literal v>operand load-indirect ; -PREDICATE: integer small-slot cells small-enough? ; +PREDICATE: small-slot < integer cells small-enough? ; -PREDICATE: integer small-tagged v>operand small-enough? ; +PREDICATE: small-tagged < integer v>operand small-enough? ; -PREDICATE: integer inline-array 32 < ; +PREDICATE: inline-array < integer 32 < ; : if-small-struct ( n size true false -- ? ) >r >r over not over struct-small-enough? and diff --git a/core/cpu/arm/assembler/assembler.factor b/core/cpu/arm/assembler/assembler.factor index d10b24de4e..5a69f93d85 100755 --- a/core/cpu/arm/assembler/assembler.factor +++ b/core/cpu/arm/assembler/assembler.factor @@ -27,7 +27,7 @@ SYMBOL: R15 { R0 R1 R2 R3 R4 R5 R6 R7 R8 R9 R10 R11 R12 R13 R14 R15 } define-registers -PREDICATE: word register register >boolean ; +PREDICATE: register < word register >boolean ; GENERIC: register ( register -- n ) M: word register "register" word-prop ; diff --git a/core/cpu/x86/32/32.factor b/core/cpu/x86/32/32.factor index 81a7d7cd02..f4af421cdd 100755 --- a/core/cpu/x86/32/32.factor +++ b/core/cpu/x86/32/32.factor @@ -8,7 +8,7 @@ alien.compiler combinators command-line compiler compiler.units io vocabs.loader accessors ; IN: cpu.x86.32 -PREDICATE: x86-backend x86-32-backend +PREDICATE: x86-32-backend < x86-backend x86-backend-cell 4 = ; ! We implement the FFI for Linux, OS X and Windows all at once. diff --git a/core/cpu/x86/64/64.factor b/core/cpu/x86/64/64.factor index 25e32225d4..c2af60e983 100755 --- a/core/cpu/x86/64/64.factor +++ b/core/cpu/x86/64/64.factor @@ -8,7 +8,7 @@ layouts alien alien.accessors alien.compiler alien.structs slots splitting assocs ; IN: cpu.x86.64 -PREDICATE: x86-backend amd64-backend +PREDICATE: amd64-backend < x86-backend x86-backend-cell 8 = ; M: amd64-backend ds-reg R14 ; diff --git a/core/cpu/x86/assembler/assembler.factor b/core/cpu/x86/assembler/assembler.factor index 65caec412e..796388ffe1 100755 --- a/core/cpu/x86/assembler/assembler.factor +++ b/core/cpu/x86/assembler/assembler.factor @@ -52,13 +52,23 @@ GENERIC: extended? ( op -- ? ) M: object extended? drop f ; -PREDICATE: word register "register" word-prop ; +PREDICATE: register < word + "register" word-prop ; -PREDICATE: register register-8 "register-size" word-prop 8 = ; -PREDICATE: register register-16 "register-size" word-prop 16 = ; -PREDICATE: register register-32 "register-size" word-prop 32 = ; -PREDICATE: register register-64 "register-size" word-prop 64 = ; -PREDICATE: register register-128 "register-size" word-prop 128 = ; +PREDICATE: register-8 < register + "register-size" word-prop 8 = ; + +PREDICATE: register-16 < register + "register-size" word-prop 16 = ; + +PREDICATE: register-32 < register + "register-size" word-prop 32 = ; + +PREDICATE: register-64 < register + "register-size" word-prop 64 = ; + +PREDICATE: register-128 < register + "register-size" word-prop 128 = ; M: register extended? "register" word-prop 7 > ; @@ -285,7 +295,7 @@ GENERIC: (MOV-I) ( src dst -- ) M: register (MOV-I) t HEX: b8 short-operand cell, ; M: operand (MOV-I) BIN: 000 t HEX: c7 1-operand 4, ; -PREDICATE: word callable register? not ; +PREDICATE: callable < word register? not ; GENERIC: MOV ( dst src -- ) M: integer MOV swap (MOV-I) ; diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor index 4775093ba7..3361073d35 100755 --- a/core/debugger/debugger.factor +++ b/core/debugger/debugger.factor @@ -156,7 +156,7 @@ M: relative-overflow summary : primitive-error. "Unimplemented primitive" print drop ; -PREDICATE: array kernel-error ( obj -- ? ) +PREDICATE: kernel-error < array { { [ dup empty? ] [ drop f ] } { [ dup first "kernel-error" = not ] [ drop f ] } diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor index 853a03d184..6a7f8f29fc 100755 --- a/core/generic/generic-tests.factor +++ b/core/generic/generic-tests.factor @@ -44,7 +44,7 @@ M: object funny drop 0 ; [ 2 ] [ [ { } ] funny ] unit-test [ 0 ] [ { } funny ] unit-test -PREDICATE: funnies very-funny number? ; +PREDICATE: very-funny < funnies number? ; GENERIC: gooey ( x -- y ) M: very-funny gooey sq ; diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 36ca0358b7..131b7e57c9 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -19,7 +19,8 @@ M: object perform-combination GENERIC: make-default-method ( generic combination -- method ) -PREDICATE: word generic "combination" word-prop >boolean ; +PREDICATE: generic < word + "combination" word-prop >boolean ; M: generic definition drop f ; @@ -30,7 +31,7 @@ M: generic definition drop f ; : method ( class generic -- method/f ) "methods" word-prop at ; -PREDICATE: pair method-spec +PREDICATE: method-spec < pair first2 generic? swap class? and ; : order ( generic -- seq ) @@ -55,7 +56,7 @@ TUPLE: check-method class generic ; : method-word-name ( class word -- string ) word-name "/" rot word-name 3append ; -PREDICATE: word method-body +PREDICATE: method-body < word "method-generic" word-prop >boolean ; M: method-body stack-effect diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor index 93c89af25c..85bd736139 100755 --- a/core/generic/math/math.factor +++ b/core/generic/math/math.factor @@ -5,7 +5,7 @@ math namespaces sequences words quotations layouts combinators sequences.private classes classes.algebra definitions ; IN: generic.math -PREDICATE: class math-class ( object -- ? ) +PREDICATE: math-class < class dup null bootstrap-word eq? [ drop f ] [ @@ -79,7 +79,7 @@ M: math-combination perform-combination ] if nip ] math-vtable nip ; -PREDICATE: generic math-generic ( word -- ? ) +PREDICATE: math-generic < generic ( word -- ? ) "combination" word-prop math-combination? ; M: math-generic definer drop \ MATH: f ; diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index 4105a05cb1..4447c5a264 100755 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -174,13 +174,13 @@ M: hook-combination perform-combination : define-simple-generic ( word -- ) T{ standard-combination f 0 } define-generic ; -PREDICATE: generic standard-generic +PREDICATE: standard-generic < generic "combination" word-prop standard-combination? ; -PREDICATE: standard-generic simple-generic +PREDICATE: simple-generic < standard-generic "combination" word-prop standard-combination-# zero? ; -PREDICATE: generic hook-generic +PREDICATE: hook-generic < generic "combination" word-prop hook-combination? ; GENERIC: dispatch# ( word -- n ) diff --git a/core/inference/dataflow/dataflow.factor b/core/inference/dataflow/dataflow.factor index 23b5343c9c..0b6cf04028 100755 --- a/core/inference/dataflow/dataflow.factor +++ b/core/inference/dataflow/dataflow.factor @@ -102,7 +102,7 @@ TUPLE: #label word loop? ; : #label ( word label -- node ) \ #label param-node [ set-#label-word ] keep ; -PREDICATE: #label #loop #label-loop? ; +PREDICATE: #loop < #label #label-loop? ; TUPLE: #entry ; @@ -309,9 +309,9 @@ SYMBOL: node-stack DEFER: #tail? -PREDICATE: #merge #tail-merge node-successor #tail? ; +PREDICATE: #tail-merge < #merge node-successor #tail? ; -PREDICATE: #values #tail-values node-successor #tail? ; +PREDICATE: #tail-values < #values node-successor #tail? ; UNION: #tail POSTPONE: f #return #tail-values #tail-merge #terminate ; diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index f024eda54c..670740fff0 100755 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -389,7 +389,7 @@ IN: parser.tests ] with-scope [ ] [ - "IN: parser.tests USE: kernel PREDICATE: object foo ( x -- y ) ;" eval + "IN: parser.tests USE: kernel PREDICATE: foo < object ( x -- y ) ;" eval ] unit-test [ t ] [ diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 0a00c742a0..bb3ad254da 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -214,7 +214,7 @@ SYMBOL: in ERROR: unexpected want got ; -PREDICATE: unexpected unexpected-eof +PREDICATE: unexpected-eof < unexpected unexpected-got not ; : unexpected-eof ( word -- * ) f unexpected ; diff --git a/core/prettyprint/prettyprint-tests.factor b/core/prettyprint/prettyprint-tests.factor index 8df97effb6..35b30ac46f 100755 --- a/core/prettyprint/prettyprint-tests.factor +++ b/core/prettyprint/prettyprint-tests.factor @@ -329,3 +329,9 @@ M: f generic-see-test-with-f ; [ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [ [ \ f \ generic-see-test-with-f method see ] with-string-writer ] unit-test + +PREDICATE: predicate-see-test < integer even? ; + +[ "USING: math ;\nIN: prettyprint.tests\nPREDICATE: predicate-see-test < integer even? ;\n" ] [ + [ \ predicate-see-test see ] with-string-writer +] unit-test diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 8bce81650f..26c6076769 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -247,8 +247,9 @@ M: mixin-class see-class* M: predicate-class see-class* block> ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 14674ba2f2..111cf74ea2 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -60,7 +60,7 @@ INSTANCE: immutable-sequence sequence #! A bit of a pain; can't call cell-bits here 7 getenv 8 * 5 - 2^ 1- ; foldable -PREDICATE: fixnum array-capacity +PREDICATE: array-capacity < fixnum 0 max-array-capacity between? ; : array-capacity ( array -- n ) diff --git a/core/slots/deprecated/deprecated.factor b/core/slots/deprecated/deprecated.factor index cc93aeeff2..2ec8f3d0d1 100755 --- a/core/slots/deprecated/deprecated.factor +++ b/core/slots/deprecated/deprecated.factor @@ -8,7 +8,7 @@ IN: slots.deprecated : reader-effect ( class spec -- effect ) >r ?word-name 1array r> slot-spec-name 1array ; -PREDICATE: word slot-reader "reading" word-prop >boolean ; +PREDICATE: slot-reader < word "reading" word-prop >boolean ; : set-reader-props ( class spec -- ) 2dup reader-effect @@ -30,7 +30,7 @@ PREDICATE: word slot-reader "reading" word-prop >boolean ; : writer-effect ( class spec -- effect ) slot-spec-name swap ?word-name 2array 0 ; -PREDICATE: word slot-writer "writing" word-prop >boolean ; +PREDICATE: slot-writer < word "writing" word-prop >boolean ; : set-writer-props ( class spec -- ) 2dup writer-effect diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index c0ceb4119a..3874cecf71 100755 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -543,8 +543,8 @@ HELP: INSTANCE: { $description "Makes " { $snippet "instance" } " an instance of " { $snippet "mixin" } "." } ; HELP: PREDICATE: -{ $syntax "PREDICATE: superclass class predicate... ;" } -{ $values { "superclass" "an existing class word" } { "class" "a new class word to define" } { "predicate" "membership test with stack effect " { $snippet "( superclass -- ? )" } } } +{ $syntax "PREDICATE: class < superclass predicate... ;" } +{ $values { "class" "a new class word to define" } { "superclass" "an existing class word" } { "predicate" "membership test with stack effect " { $snippet "( superclass -- ? )" } } } { $description "Defines a predicate class deriving from " { $snippet "superclass" } "." $nl @@ -557,11 +557,9 @@ HELP: PREDICATE: } ; HELP: TUPLE: -{ $syntax "TUPLE: class slots... ;" } +{ $syntax "TUPLE: class slots... ;" "TUPLE: class < superclass slots ... ;" } { $values { "class" "a new tuple class to define" } { "slots" "a list of slot names" } } -{ $description "Defines a new tuple class." -$nl -"Tuples are user-defined classes with instances composed of named slots. All tuple classes are subtypes of the built-in " { $link tuple } " type." } ; +{ $description "Defines a new tuple class. The superclass is optional; if left unspecified, it defaults to " { $link tuple } "." } ; HELP: ERROR: { $syntax "ERROR: class slots... ;" } diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 17b3b86269..9190b9676d 100755 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -6,7 +6,7 @@ namespaces parser sequences strings sbufs vectors words quotations io assocs splitting tuples generic.standard generic.math classes io.files vocabs float-arrays float-vectors classes.union classes.mixin classes.predicate compiler.units -combinators ; +combinators debugger ; IN: bootstrap.syntax ! These words are defined as a top-level form, instead of with @@ -148,8 +148,9 @@ IN: bootstrap.syntax ] define-syntax "PREDICATE:" [ - scan-word CREATE-CLASS + scan "<" assert= + scan-word parse-definition define-predicate-class ] define-syntax diff --git a/core/tuples/tuples-docs.factor b/core/tuples/tuples-docs.factor index 427c7fbf60..6e0f319c9a 100755 --- a/core/tuples/tuples-docs.factor +++ b/core/tuples/tuples-docs.factor @@ -165,7 +165,7 @@ HELP: reshape-tuples { $values { "class" tuple-class } { "newslots" "a sequence of strings" } } { $description "Changes the shape of every instance of " { $snippet "class" } " for a new slot layout." } ; -HELP: old-slots +HELP: removed-slots { $values { "class" tuple-class } { "newslots" "a sequence of strings" } { "seq" "a sequence of strings" } } { $description "Outputs the sequence of existing tuple slot names not in " { $snippet "newslots" } "." } ; @@ -190,8 +190,8 @@ HELP: define-tuple-predicate { $description "Defines a predicate word that tests if the top of the stack is an instance of " { $snippet "class" } ". This will only work if " { $snippet "class" } " is a tuple class." } $low-level-note ; -HELP: check-shape -{ $values { "class" class } { "newslots" "a sequence of strings" } } +HELP: redefine-tuple-class +{ $values { "class" class } { "superclass" class } { "newslots" "a sequence of strings" } } { $description "If the new slot layout differs from the existing one, updates all existing instances of this tuple class, and forgets any slot accessor words which are no longer needed." $nl "If the class is not a tuple class word, this word does nothing." } @@ -214,8 +214,8 @@ HELP: check-tuple { $error-description "Thrown if " { $link POSTPONE: C: } " is called with a word which does not name a tuple class." } ; HELP: define-tuple-class -{ $values { "class" word } { "slots" "a sequence of strings" } } -{ $description "Defines a tuple class with slots named by " { $snippet "slots" } ". This is the run time equivalent of " { $link POSTPONE: TUPLE: } "." } +{ $values { "class" word } { "superclass" class } { "slots" "a sequence of strings" } } +{ $description "Defines a tuple class inheriting from " { $snippet "superclass" } " with slots named by " { $snippet "slots" } ". This is the run time equivalent of " { $link POSTPONE: TUPLE: } "." } { $notes "This word must be called from inside " { $link with-compilation-unit } "." } { $side-effects "class" } ; diff --git a/core/tuples/tuples-tests.factor b/core/tuples/tuples-tests.factor index 702557e257..e7ad44a264 100755 --- a/core/tuples/tuples-tests.factor +++ b/core/tuples/tuples-tests.factor @@ -2,7 +2,8 @@ USING: definitions generic kernel kernel.private math math.constants parser sequences tools.test words assocs namespaces quotations sequences.private classes continuations generic.standard effects tuples tuples.private arrays vectors -strings compiler.units accessors ; +strings compiler.units accessors classes.algebra calendar +prettyprint io.streams.string ; IN: tuples.tests TUPLE: rect x y w h ; @@ -83,7 +84,7 @@ C: predicate-test [ t ] [ predicate-test? ] unit-test -PREDICATE: tuple silly-pred +PREDICATE: silly-pred < tuple class \ rect = ; GENERIC: area @@ -243,6 +244,58 @@ C: erg's-reshape-problem "IN: tuples.tests SYMBOL: not-a-class C: not-a-class" eval ] [ [ no-tuple-class? ] is? ] must-fail-with +! Inheritance +TUPLE: computer cpu ram ; + +[ "IN: tuples.tests TUPLE: computer cpu ram ;\n" ] [ + [ \ computer see ] with-string-writer +] unit-test + +TUPLE: laptop < computer battery ; +C: laptop + +[ t ] [ laptop tuple-class? ] unit-test +[ t ] [ laptop tuple class< ] unit-test +[ t ] [ laptop computer class< ] unit-test +[ t ] [ laptop computer classes-intersect? ] unit-test + +[ ] [ "Pentium" 128 3 hours "laptop" set ] unit-test +[ t ] [ "laptop" get laptop? ] unit-test +[ t ] [ "laptop" get computer? ] unit-test +[ t ] [ "laptop" get tuple? ] unit-test + +[ "IN: tuples.tests TUPLE: laptop < computer battery ;\n" ] [ + [ \ laptop see ] with-string-writer +] unit-test + +TUPLE: server < computer rackmount? ; +C: server + +[ t ] [ server tuple-class? ] unit-test +[ t ] [ server tuple class< ] unit-test +[ t ] [ server computer class< ] unit-test +[ t ] [ server computer classes-intersect? ] unit-test + +[ ] [ "Pentium" 128 "1U" "server" set ] unit-test +[ t ] [ "server" get server? ] unit-test +[ t ] [ "server" get computer? ] unit-test +[ t ] [ "server" get tuple? ] unit-test + +[ f ] [ "server" get laptop? ] unit-test +[ f ] [ "laptop" get server? ] unit-test + +[ f ] [ server laptop class< ] unit-test +[ f ] [ laptop server class< ] unit-test +[ f ] [ laptop server classes-intersect? ] unit-test + +[ "IN: tuples.tests TUPLE: server < computer rackmount ;\n" ] [ + [ \ server see ] with-string-writer +] unit-test + +[ + "IN: tuples.tests TUPLE: bad-superclass < word ;" eval +] must-fail + ! Hardcore unit tests USE: threads @@ -250,14 +303,14 @@ USE: threads [ ] [ [ - \ thread { "xxx" } "slot-names" get append + \ thread tuple { "xxx" } "slot-names" get append define-tuple-class ] with-compilation-unit [ 1337 sleep ] "Test" spawn drop [ - \ thread "slot-names" get + \ thread tuple "slot-names" get define-tuple-class ] with-compilation-unit ] unit-test @@ -268,14 +321,14 @@ USE: vocabs [ ] [ [ - \ vocab { "xxx" } "slot-names" get append + \ vocab tuple { "xxx" } "slot-names" get append define-tuple-class ] with-compilation-unit all-words drop [ - \ vocab "slot-names" get + \ vocab tuple "slot-names" get define-tuple-class ] with-compilation-unit ] unit-test diff --git a/core/tuples/tuples.factor b/core/tuples/tuples.factor index 8318c0ede1..83f398242a 100755 --- a/core/tuples/tuples.factor +++ b/core/tuples/tuples.factor @@ -110,8 +110,11 @@ M: tuple-class tuple-layout "layout" word-prop ; dup define-tuple-layout define-tuple-predicate ; +: change-superclass "not supported" throw ; + : redefine-tuple-class ( class superclass slots -- ) - nip + >r 2dup swap superclass eq? + [ drop ] [ dupd change-superclass ] if r> 2dup forget-slots 2dup reshape-tuples over changed-word @@ -119,8 +122,7 @@ M: tuple-class tuple-layout "layout" word-prop ; prepare-tuple-class ; : define-new-tuple-class ( class superclass slots -- ) - nip - over f tuple tuple-class define-class + >r dupd f swap tuple-class define-class r> prepare-tuple-class ; PRIVATE> diff --git a/core/words/words.factor b/core/words/words.factor index de253e6fee..5c0d84d4cc 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -23,17 +23,17 @@ M: word definition word-def ; ERROR: undefined ; -PREDICATE: word deferred ( obj -- ? ) +PREDICATE: deferred < word ( obj -- ? ) word-def [ undefined ] = ; M: deferred definer drop \ DEFER: f ; M: deferred definition drop f ; -PREDICATE: word symbol ( obj -- ? ) +PREDICATE: symbol < word ( obj -- ? ) dup 1array swap word-def sequence= ; M: symbol definer drop \ SYMBOL: f ; M: symbol definition drop f ; -PREDICATE: word primitive ( obj -- ? ) +PREDICATE: primitive < word ( obj -- ? ) word-def [ do-primitive ] tail? ; M: primitive definer drop \ PRIMITIVE: f ; M: primitive definition drop f ; diff --git a/extra/delegate/delegate.factor b/extra/delegate/delegate.factor index 67b8a39320..7f24d6258f 100755 --- a/extra/delegate/delegate.factor +++ b/extra/delegate/delegate.factor @@ -10,7 +10,7 @@ IN: delegate CREATE-WORD dup define-symbol parse-definition swap define-protocol ; parsing -PREDICATE: word protocol "protocol-words" word-prop ; +PREDICATE: protocol < word "protocol-words" word-prop ; GENERIC: group-words ( group -- words ) diff --git a/extra/help/markup/markup.factor b/extra/help/markup/markup.factor index 9c3615f629..5dc7255eed 100755 --- a/extra/help/markup/markup.factor +++ b/extra/help/markup/markup.factor @@ -14,7 +14,7 @@ IN: help.markup ! Element types are words whose name begins with $. -PREDICATE: array simple-element +PREDICATE: simple-element < array dup empty? [ drop t ] [ first word? not ] if ; SYMBOL: last-element diff --git a/extra/help/topics/topics.factor b/extra/help/topics/topics.factor index 4a86d49a28..c12c392eb3 100755 --- a/extra/help/topics/topics.factor +++ b/extra/help/topics/topics.factor @@ -16,7 +16,7 @@ M: link >link ; M: vocab-spec >link ; M: object >link link construct-boa ; -PREDICATE: link word-link link-name word? ; +PREDICATE: word-link < link link-name word? ; M: link summary [ diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 4bb620083f..1468065ebe 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -54,9 +54,9 @@ M: no-inverse summary : undo-literal ( object -- quot ) [ =/fail ] curry ; -PREDICATE: word normal-inverse "inverse" word-prop ; -PREDICATE: word math-inverse "math-inverse" word-prop ; -PREDICATE: word pop-inverse "pop-length" word-prop ; +PREDICATE: normal-inverse < word "inverse" word-prop ; +PREDICATE: math-inverse < word "math-inverse" word-prop ; +PREDICATE: pop-inverse < word "pop-length" word-prop ; UNION: explicit-inverse normal-inverse math-inverse pop-inverse ; : inline-word ( word -- ) diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index 8f5babeff7..ed98665e06 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -22,8 +22,8 @@ M: port set-timeout set-port-timeout ; SYMBOL: closed -PREDICATE: port input-port port-type input-port eq? ; -PREDICATE: port output-port port-type output-port eq? ; +PREDICATE: input-port < port port-type input-port eq? ; +PREDICATE: output-port < port port-type output-port eq? ; GENERIC: init-handle ( handle -- ) GENERIC: close-handle ( handle -- ) diff --git a/extra/locals/locals.factor b/extra/locals/locals.factor index 640ae0c9ea..455f39d2b5 100755 --- a/extra/locals/locals.factor +++ b/extra/locals/locals.factor @@ -29,23 +29,23 @@ TUPLE: wlet bindings body ; C: wlet -PREDICATE: word local "local?" word-prop ; +PREDICATE: local < word "local?" word-prop ; : ( name -- word ) #! Create a local variable identifier f dup t "local?" set-word-prop ; -PREDICATE: word local-word "local-word?" word-prop ; +PREDICATE: local-word < word "local-word?" word-prop ; : ( name -- word ) f dup t "local-word?" set-word-prop ; -PREDICATE: word local-reader "local-reader?" word-prop ; +PREDICATE: local-reader < word "local-reader?" word-prop ; : ( name -- word ) f dup t "local-reader?" set-word-prop ; -PREDICATE: word local-writer "local-writer?" word-prop ; +PREDICATE: local-writer < word "local-writer?" word-prop ; : ( reader -- word ) dup word-name "!" append f @@ -357,7 +357,7 @@ M: wlet pprint* \ [wlet pprint-let ; M: let* pprint* \ [let* pprint-let ; -PREDICATE: word lambda-word +PREDICATE: lambda-word < word "lambda" word-prop >boolean ; M: lambda-word definer drop \ :: \ ; ; @@ -373,7 +373,7 @@ M: lambda-word definition M: lambda-word synopsis* lambda-word-synopsis ; -PREDICATE: macro lambda-macro +PREDICATE: lambda-macro < macro "lambda" word-prop >boolean ; M: lambda-macro definer drop \ MACRO:: \ ; ; @@ -383,7 +383,7 @@ M: lambda-macro definition M: lambda-macro synopsis* lambda-word-synopsis ; -PREDICATE: method-body lambda-method +PREDICATE: lambda-method < method-body "lambda" word-prop >boolean ; M: lambda-method definer drop \ M:: \ ; ; diff --git a/extra/macros/macros.factor b/extra/macros/macros.factor index 87b3acd47c..b242f91d3b 100755 --- a/extra/macros/macros.factor +++ b/extra/macros/macros.factor @@ -17,7 +17,7 @@ IN: macros : MACRO: (:) define-macro ; parsing -PREDICATE: word macro "macro" word-prop >boolean ; +PREDICATE: macro < word "macro" word-prop >boolean ; M: macro definer drop \ MACRO: \ ; ; diff --git a/extra/memoize/memoize.factor b/extra/memoize/memoize.factor index ab915ae7d5..45ae2cc959 100755 --- a/extra/memoize/memoize.factor +++ b/extra/memoize/memoize.factor @@ -42,7 +42,7 @@ IN: memoize : MEMO: CREATE-WORD parse-definition define-memoized ; parsing -PREDICATE: word memoized "memoize" word-prop ; +PREDICATE: memoized < word "memoize" word-prop ; M: memoized definer drop \ MEMO: \ ; ; M: memoized definition "memo-quot" word-prop ; diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index 42ade34186..ed82d2478e 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -64,7 +64,8 @@ GENERIC: method-prologue ( combination -- quot ) TUPLE: method word def classes generic loc ; -PREDICATE: word method-body "multi-method" word-prop >boolean ; +PREDICATE: method-body < word + "multi-method" word-prop >boolean ; M: method-body stack-effect "multi-method" word-prop method-generic stack-effect ; @@ -209,13 +210,13 @@ M: hook-combination generic-prologue USE: qualified QUALIFIED: syntax -PREDICATE: word generic +PREDICATE: generic < word "multi-combination" word-prop >boolean ; -PREDICATE: word standard-generic +PREDICATE: standard-generic < word "multi-combination" word-prop standard-combination? ; -PREDICATE: word hook-generic +PREDICATE: hook-generic < word "multi-combination" word-prop hook-combination? ; syntax:M: standard-generic definer drop \ GENERIC: f ; @@ -233,7 +234,7 @@ syntax:M: hook-generic synopsis* dup "multi-combination" word-prop hook-combination-var pprint-word stack-effect. ; -PREDICATE: array method-spec +PREDICATE: method-spec < array unclip generic? >r [ class? ] all? r> and ; syntax:M: method-spec where diff --git a/extra/opengl/shaders/shaders.factor b/extra/opengl/shaders/shaders.factor index 7403b7cb05..9d415d8394 100755 --- a/extra/opengl/shaders/shaders.factor +++ b/extra/opengl/shaders/shaders.factor @@ -55,9 +55,9 @@ IN: opengl.shaders : delete-gl-shader ( shader -- ) glDeleteShader ; inline -PREDICATE: integer gl-shader (gl-shader?) ; -PREDICATE: gl-shader vertex-shader (vertex-shader?) ; -PREDICATE: gl-shader fragment-shader (fragment-shader?) ; +PREDICATE: gl-shader < integer (gl-shader?) ; +PREDICATE: vertex-shader < gl-shader (vertex-shader?) ; +PREDICATE: fragment-shader < gl-shader (fragment-shader?) ; ! Programs @@ -126,7 +126,7 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ; MACRO: with-gl-program ( uniforms quot -- ) (make-with-gl-program) ; -PREDICATE: integer gl-program (gl-program?) ; +PREDICATE: gl-program < integer (gl-program?) ; : ( vertex-shader-source fragment-shader-source -- program ) >r check-gl-shader diff --git a/extra/singleton/singleton.factor b/extra/singleton/singleton.factor index 0b77443a50..9ec9f2f4a3 100755 --- a/extra/singleton/singleton.factor +++ b/extra/singleton/singleton.factor @@ -5,8 +5,9 @@ sequences words ; IN: singleton : define-singleton ( token -- ) - \ word swap create-class-in - dup [ eq? ] curry define-predicate-class ; + create-class-in + \ word + over [ eq? ] curry define-predicate-class ; : SINGLETON: scan define-singleton ; parsing diff --git a/extra/ui/commands/commands.factor b/extra/ui/commands/commands.factor index dbb838a5c5..f73276bbe6 100755 --- a/extra/ui/commands/commands.factor +++ b/extra/ui/commands/commands.factor @@ -9,7 +9,7 @@ SYMBOL: +nullary+ SYMBOL: +listener+ SYMBOL: +description+ -PREDICATE: word listener-command +listener+ word-prop ; +PREDICATE: listener-command < word +listener+ word-prop ; GENERIC: invoke-command ( target command -- ) diff --git a/extra/ui/operations/operations.factor b/extra/ui/operations/operations.factor old mode 100644 new mode 100755 index 45cd7732c2..a9009e386e --- a/extra/ui/operations/operations.factor +++ b/extra/ui/operations/operations.factor @@ -19,7 +19,7 @@ TUPLE: operation predicate command translator hook listener? ; set-operation-hook } operation construct ; -PREDICATE: operation listener-operation +PREDICATE: listener-operation < operation dup operation-command listener-command? swap operation-listener? or ; diff --git a/extra/unicode/syntax/syntax.factor b/extra/unicode/syntax/syntax.factor index bd3fd4ae2a..4dc91a73c2 100755 --- a/extra/unicode/syntax/syntax.factor +++ b/extra/unicode/syntax/syntax.factor @@ -35,7 +35,7 @@ IN: unicode.syntax ] [ ] make ; : define-category ( word categories -- ) - [category] fixnum -rot define-predicate-class ; + [category] integer swap define-predicate-class ; : CATEGORY: CREATE ";" parse-tokens define-category ; parsing diff --git a/extra/xml-rpc/xml-rpc.factor b/extra/xml-rpc/xml-rpc.factor old mode 100644 new mode 100755 index ffccb5e0f5..1194ff4df1 --- a/extra/xml-rpc/xml-rpc.factor +++ b/extra/xml-rpc/xml-rpc.factor @@ -17,7 +17,7 @@ M: integer item>xml [ "Integers must fit in 32 bits" throw ] unless number>string "i4" build-tag ; -PREDICATE: object boolean { t f } member? ; +PREDICATE: boolean < object { t f } member? ; M: boolean item>xml "1" "0" ? "boolean" build-tag ; diff --git a/extra/xml/data/data.factor b/extra/xml/data/data.factor old mode 100644 new mode 100755 index 9d73a46cd9..a7c8bf7b73 --- a/extra/xml/data/data.factor +++ b/extra/xml/data/data.factor @@ -139,5 +139,5 @@ M: xml like : ( name attrs -- tag ) f ; -PREDICATE: tag contained-tag tag-children not ; -PREDICATE: tag open-tag tag-children ; +PREDICATE: contained-tag < tag tag-children not ; +PREDICATE: open-tag < tag tag-children ; From 2614792254e590c280f9e5a9c69ba8146a7fa147 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 27 Mar 2008 11:23:58 +1300 Subject: [PATCH 093/219] Implement packrat algorithm --- extra/peg/peg.factor | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index af26f888f1..44a762cec2 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -3,7 +3,8 @@ USING: kernel sequences strings namespaces math assocs shuffle vectors arrays combinators.lib math.parser match unicode.categories sequences.lib compiler.units parser - words quotations effects memoize accessors combinators.cleave ; + words quotations effects memoize accessors + combinators.cleave locals ; IN: peg TUPLE: parse-result remaining ast ; @@ -14,14 +15,22 @@ SYMBOL: ignore parse-result construct-boa ; SYMBOL: compiled-parsers +SYMBOL: packrat +SYMBOL: failed GENERIC: (compile) ( parser -- quot ) +:: run-packrat-parser ( input quot c -- result ) + input slice? [ input slice-from ] [ 0 ] if + quot c [ drop H{ } clone ] cache + [ + drop input quot call + ] cache* ; inline + : run-parser ( input quot -- result ) - #! Eventually this will be replaced with something that - #! can do packrat parsing by memoizing the results of - #! a parser. For now, it just calls the quotation. - call ; inline + #! If a packrat cache is available, use memoization for + #! packrat parsing, otherwise do a standard peg call. + packrat get [ run-packrat-parser ] [ call ] if* ; inline : compiled-parser ( parser -- word ) #! Look to see if the given parser has been compiled. From be5a09c9e39fc1b0a9421364aa28ede77aa055e1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 26 Mar 2008 18:37:28 -0500 Subject: [PATCH 094/219] Inheritance work in progress --- core/prettyprint/prettyprint.factor | 3 +++ core/tuples/tuples-tests.factor | 14 +++++++------- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 26c6076769..7b8c8f2997 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -257,6 +257,9 @@ M: predicate-class see-class* M: tuple-class see-class* ; diff --git a/core/tuples/tuples-tests.factor b/core/tuples/tuples-tests.factor index e7ad44a264..2d28697b70 100755 --- a/core/tuples/tuples-tests.factor +++ b/core/tuples/tuples-tests.factor @@ -3,7 +3,7 @@ math.constants parser sequences tools.test words assocs namespaces quotations sequences.private classes continuations generic.standard effects tuples tuples.private arrays vectors strings compiler.units accessors classes.algebra calendar -prettyprint io.streams.string ; +prettyprint io.streams.string splitting ; IN: tuples.tests TUPLE: rect x y w h ; @@ -247,8 +247,8 @@ C: erg's-reshape-problem ! Inheritance TUPLE: computer cpu ram ; -[ "IN: tuples.tests TUPLE: computer cpu ram ;\n" ] [ - [ \ computer see ] with-string-writer +[ "TUPLE: computer cpu ram ;" ] [ + [ \ computer see ] with-string-writer string-lines second ] unit-test TUPLE: laptop < computer battery ; @@ -264,8 +264,8 @@ C: laptop [ t ] [ "laptop" get computer? ] unit-test [ t ] [ "laptop" get tuple? ] unit-test -[ "IN: tuples.tests TUPLE: laptop < computer battery ;\n" ] [ - [ \ laptop see ] with-string-writer +[ "TUPLE: laptop < computer battery ;" ] [ + [ \ laptop see ] with-string-writer string-lines second ] unit-test TUPLE: server < computer rackmount? ; @@ -288,8 +288,8 @@ C: server [ f ] [ laptop server class< ] unit-test [ f ] [ laptop server classes-intersect? ] unit-test -[ "IN: tuples.tests TUPLE: server < computer rackmount ;\n" ] [ - [ \ server see ] with-string-writer +[ "TUPLE: server < computer rackmount? ;" ] [ + [ \ server see ] with-string-writer string-lines second ] unit-test [ From 7b1bd2f558a7278ad564745dcdc88e07b238af42 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 26 Mar 2008 18:22:25 -0600 Subject: [PATCH 095/219] builder.release: upload binaries to factorcode.org --- extra/builder/release/release.factor | 36 +++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/extra/builder/release/release.factor b/extra/builder/release/release.factor index 0e26abe02f..bb0d16c9da 100644 --- a/extra/builder/release/release.factor +++ b/extra/builder/release/release.factor @@ -1,6 +1,6 @@ USING: kernel system namespaces sequences splitting combinators - io.files io.launcher + io io.files io.launcher bake combinators.cleave builder.common builder.util ; IN: builder.release @@ -91,6 +91,39 @@ IN: builder.release : remove-factor-app ( -- ) macosx? not [ { "rm" "-rf" "Factor.app" } try-process ] when ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: upload-to-factorcode + +: platform ( -- string ) { os cpu- } to-strings "-" join ; + +: remote-location ( -- dest ) + "factorcode.org:/var/www/factorcode.org/newsite/downloads" + platform + append-path ; + +: upload ( -- ) + { "scp" archive-name remote-location } to-strings + [ "Error uploading binary to factorcode" print ] + run-or-bail ; + +: maybe-upload ( -- ) + upload-to-factorcode get + [ upload ] + when ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! : release ( -- ) +! "factor" +! [ +! remove-factor-app +! remove-common-files +! ] +! with-directory +! make-archive +! archive-name releases move-file-into ; + : release ( -- ) "factor" [ @@ -99,6 +132,7 @@ IN: builder.release ] with-directory make-archive + maybe-upload archive-name releases move-file-into ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 9120865157d441f67a8ad8df24624eaf1781373e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 26 Mar 2008 18:47:56 -0500 Subject: [PATCH 096/219] fixing the launcher --- extra/io/unix/launcher/launcher.factor | 3 +- extra/io/windows/files/files.factor | 1 - extra/io/windows/launcher/launcher.factor | 5 ++-- extra/io/windows/nt/files/files.factor | 5 ++-- extra/io/windows/nt/nt-tests.factor | 36 ----------------------- 5 files changed, 8 insertions(+), 42 deletions(-) delete mode 100755 extra/io/windows/nt/nt-tests.factor diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 11c608c68f..0cbb78b881 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -4,7 +4,7 @@ USING: io io.backend io.launcher io.nonblocking io.unix.backend io.unix.files io.nonblocking sequences kernel namespaces math system alien.c-types debugger continuations arrays assocs combinators unix.process strings threads unix -io.unix.launcher.parser accessors ; +io.unix.launcher.parser accessors io.files ; IN: io.unix.launcher ! Search unix first @@ -67,6 +67,7 @@ USE: unix : spawn-process ( process -- * ) [ + current-directory get cd setup-priority setup-redirection dup pass-environment? [ diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 35aaf456a3..094014fac6 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -90,4 +90,3 @@ SYMBOLS: +read-only+ +hidden+ +system+ M: windows-nt-io file-info ( path -- info ) get-file-information-stat ; - diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index 2d281d0fe8..84f8360840 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -5,7 +5,7 @@ io.windows io.windows.nt.pipes libc io.nonblocking io.streams.duplex windows.types math windows.kernel32 windows namespaces io.launcher kernel sequences windows.errors assocs splitting system threads init strings combinators -io.backend accessors concurrency.flags ; +io.backend accessors concurrency.flags io.files ; IN: io.windows.launcher TUPLE: CreateProcess-args @@ -27,7 +27,8 @@ TUPLE: CreateProcess-args "STARTUPINFO" "STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo "PROCESS_INFORMATION" >>lpProcessInformation - TRUE >>bInheritHandles ; + TRUE >>bInheritHandles + current-directory get >>lpCurrentDirectory ; : call-CreateProcess ( CreateProcess-args -- ) { diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 540737004b..1c8d88c872 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -3,7 +3,7 @@ io.timeouts io.nonblocking io.windows io.windows.nt.backend kernel libc math threads windows windows.kernel32 alien.c-types alien.arrays sequences combinators combinators.lib sequences.lib ascii splitting alien strings assocs -combinators.cleave ; +combinators.cleave namespaces ; IN: io.windows.nt.files M: windows-nt-io cwd @@ -63,11 +63,12 @@ ERROR: not-absolute-path ; ERROR: nonstring-pathname ; ERROR: empty-pathname ; +USE: tools.walker M: windows-nt-io normalize-pathname ( string -- string ) dup string? [ nonstring-pathname ] unless dup empty? [ empty-pathname ] when { { CHAR: / CHAR: \\ } } substitute - cwd swap windows-append-path + current-directory get swap windows-append-path [ "/\\." member? ] right-trim dup peek CHAR: : = [ "\\" append ] when ; diff --git a/extra/io/windows/nt/nt-tests.factor b/extra/io/windows/nt/nt-tests.factor deleted file mode 100755 index 6353bfe86e..0000000000 --- a/extra/io/windows/nt/nt-tests.factor +++ /dev/null @@ -1,36 +0,0 @@ -USING: io.files kernel tools.test io.backend -io.windows.nt.files splitting ; -IN: io.windows.nt.tests - -[ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test -[ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test -[ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test -! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing -[ "c:" ] [ "c:\\" parent-directory ] unit-test -[ "Z:" ] [ "Z:\\" parent-directory ] unit-test -[ "c:" ] [ "c:" parent-directory ] unit-test -[ "Z:" ] [ "Z:" parent-directory ] unit-test -[ t ] [ "c:\\" right-trim-separators root-directory? ] unit-test -[ t ] [ "Z:\\" right-trim-separators root-directory? ] unit-test -[ f ] [ "c:\\foo" root-directory? ] unit-test -[ f ] [ "." root-directory? ] unit-test -[ f ] [ ".." root-directory? ] unit-test - -[ ] [ "" resource-path cd ] unit-test - -[ "\\foo\\bar" ] [ "/foo/bar" normalize-pathname ":" split1 nip ] unit-test - -[ "\\\\?\\C:\\builds\\factor\\log.txt" ] [ - "C:\\builds\\factor\\12345\\" - "..\\log.txt" windows-append-path -] unit-test - -[ "\\\\?\\C:\\builds\\" ] [ - "C:\\builds\\factor\\12345\\" - "..\\.." windows-append-path -] unit-test - -[ "\\\\?\\C:\\builds\\" ] [ - "C:\\builds\\factor\\12345\\" - "..\\.." windows-append-path -] unit-test From d823c4a287bf5879b27fc1438fd8abea45c36f87 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 26 Mar 2008 18:48:55 -0500 Subject: [PATCH 097/219] working on random --- extra/random/random.factor | 9 +- .../cryptographic/cryptographic.factor | 29 + extra/windows/advapi32/advapi32.factor | 1554 +++++++++-------- extra/windows/types/types.factor | 1 + 4 files changed, 828 insertions(+), 765 deletions(-) create mode 100644 extra/random/windows/cryptographic/cryptographic.factor diff --git a/extra/random/random.factor b/extra/random/random.factor index 0d8b137fc5..b10e05d415 100755 --- a/extra/random/random.factor +++ b/extra/random/random.factor @@ -4,6 +4,8 @@ USING: alien.c-types kernel math namespaces sequences io.backend ; IN: random +SYMBOL: random-generator + HOOK: os-crypto-random-bytes io-backend ( n -- byte-array ) HOOK: os-random-bytes io-backend ( n -- byte-array ) HOOK: os-crypto-random-32 io-backend ( -- r ) @@ -11,16 +13,15 @@ HOOK: os-random-32 io-backend ( -- r ) GENERIC: seed-random ( tuple seed -- ) GENERIC: random-32 ( tuple -- r ) +GENERIC: random-bytes* ( tuple n -- bytes ) -: (random-bytes) ( tuple n -- byte-array ) +M: object random-bytes* ( tuple n -- byte-array ) [ drop random-32 ] with map >c-uint-array ; -SYMBOL: random-generator - : random-bytes ( n -- r ) [ 4 /mod zero? [ 1+ ] unless - random-generator get swap (random-bytes) + random-generator get swap random-bytes* ] keep head ; : random ( seq -- elt ) diff --git a/extra/random/windows/cryptographic/cryptographic.factor b/extra/random/windows/cryptographic/cryptographic.factor new file mode 100644 index 0000000000..158f939af9 --- /dev/null +++ b/extra/random/windows/cryptographic/cryptographic.factor @@ -0,0 +1,29 @@ +USING: accessors alien.c-types byte-arrays continuations +kernel random windows windows.advapi32 ; +IN: random.windows.cryptographic + +TUPLE: windows-crypto-context handle ; + +C: windows-crypto-context + +M: windows-crypto-context dispose ( tuple -- ) + handle>> 0 CryptReleaseContext win32-error=0/f ; + + +TUPLE: windows-cryptographic-rng context ; + +C: windows-cryptographic-rng + +M: windows-cryptographic-rng dispose ( tuple -- ) + context>> dispose ; + +M: windows-cryptographic-rng random-bytes* ( tuple n -- bytes ) + >r context>> r> dup + [ CryptGenRandom win32-error=0/f ] keep ; + +: acquire-aes-context ( -- bytes ) + "HCRYPTPROV" + dup f f PROV_RSA_AES CRYPT_NEWKEYSET + CryptAcquireContextW win32-error=0/f *void* + ; + diff --git a/extra/windows/advapi32/advapi32.factor b/extra/windows/advapi32/advapi32.factor index d3413b5695..0be82551a1 100644 --- a/extra/windows/advapi32/advapi32.factor +++ b/extra/windows/advapi32/advapi32.factor @@ -1,761 +1,793 @@ -USING: alien.syntax kernel math windows.types math.bitfields ; -IN: windows.advapi32 -LIBRARY: advapi32 - -! : I_ScGetCurrentGroupStateW ; -! : A_SHAFinal ; -! : A_SHAInit ; -! : A_SHAUpdate ; -! : AbortSystemShutdownA ; -! : AbortSystemShutdownW ; -! : AccessCheck ; -! : AccessCheckAndAuditAlarmA ; -! : AccessCheckAndAuditAlarmW ; -! : AccessCheckByType ; -! : AccessCheckByTypeAndAuditAlarmA ; -! : AccessCheckByTypeAndAuditAlarmW ; -! : AccessCheckByTypeResultList ; -! : AccessCheckByTypeResultListAndAuditAlarmA ; -! : AccessCheckByTypeResultListAndAuditAlarmByHandleA ; -! : AccessCheckByTypeResultListAndAuditAlarmByHandleW ; -! : AccessCheckByTypeResultListAndAuditAlarmW ; -! : AddAccessAllowedAce ; -! : AddAccessAllowedAceEx ; -! : AddAccessAllowedObjectAce ; -! : AddAccessDeniedAce ; -! : AddAccessDeniedAceEx ; -! : AddAccessDeniedObjectAce ; -! : AddAce ; -! : AddAuditAccessAce ; -! : AddAuditAccessAceEx ; -! : AddAuditAccessObjectAce ; -! : AddUsersToEncryptedFile ; -! : AdjustTokenGroups ; -FUNCTION: BOOL AdjustTokenPrivileges ( HANDLE TokenHandle, - BOOL DisableAllPrivileges, - PTOKEN_PRIVILEGES NewState, - DWORD BufferLength, - PTOKEN_PRIVILEGES PreviousState, - PDWORD ReturnLength ) ; - -! : AllocateAndInitializeSid ; -! : AllocateLocallyUniqueId ; -! : AreAllAccessesGranted ; -! : AreAnyAccessesGranted ; -! : BackupEventLogA ; -! : BackupEventLogW ; -! : BuildExplicitAccessWithNameA ; -! : BuildExplicitAccessWithNameW ; -! : BuildImpersonateExplicitAccessWithNameA ; -! : BuildImpersonateExplicitAccessWithNameW ; -! : BuildImpersonateTrusteeA ; -! : BuildImpersonateTrusteeW ; -! : BuildSecurityDescriptorA ; -! : BuildSecurityDescriptorW ; -! : BuildTrusteeWithNameA ; -! : BuildTrusteeWithNameW ; -! : BuildTrusteeWithObjectsAndNameA ; -! : BuildTrusteeWithObjectsAndNameW ; -! : BuildTrusteeWithObjectsAndSidA ; -! : BuildTrusteeWithObjectsAndSidW ; -! : BuildTrusteeWithSidA ; -! : BuildTrusteeWithSidW ; -! : CancelOverlappedAccess ; -! : ChangeServiceConfig2A ; -! : ChangeServiceConfig2W ; -! : ChangeServiceConfigA ; -! : ChangeServiceConfigW ; -! : CheckTokenMembership ; -! : ClearEventLogA ; -! : ClearEventLogW ; -! : CloseCodeAuthzLevel ; -! : CloseEncryptedFileRaw ; -! : CloseEventLog ; -! : CloseServiceHandle ; -! : CloseTrace ; -! : CommandLineFromMsiDescriptor ; -! : ComputeAccessTokenFromCodeAuthzLevel ; -! : ControlService ; -! : ControlTraceA ; -! : ControlTraceW ; -! : ConvertAccessToSecurityDescriptorA ; -! : ConvertAccessToSecurityDescriptorW ; -! : ConvertSDToStringSDRootDomainA ; -! : ConvertSDToStringSDRootDomainW ; -! : ConvertSecurityDescriptorToAccessA ; -! : ConvertSecurityDescriptorToAccessNamedA ; -! : ConvertSecurityDescriptorToAccessNamedW ; -! : ConvertSecurityDescriptorToAccessW ; -! : ConvertSecurityDescriptorToStringSecurityDescriptorA ; -! : ConvertSecurityDescriptorToStringSecurityDescriptorW ; -! : ConvertSidToStringSidA ; -! : ConvertSidToStringSidW ; -! : ConvertStringSDToSDDomainA ; -! : ConvertStringSDToSDDomainW ; -! : ConvertStringSDToSDRootDomainA ; -! : ConvertStringSDToSDRootDomainW ; -! : ConvertStringSecurityDescriptorToSecurityDescriptorA ; -! : ConvertStringSecurityDescriptorToSecurityDescriptorW ; -! : ConvertStringSidToSidA ; -! : ConvertStringSidToSidW ; -! : ConvertToAutoInheritPrivateObjectSecurity ; -! : CopySid ; -! : CreateCodeAuthzLevel ; -! : CreatePrivateObjectSecurity ; -! : CreatePrivateObjectSecurityEx ; -! : CreatePrivateObjectSecurityWithMultipleInheritance ; -! : CreateProcessAsUserA ; -! : CreateProcessAsUserSecure ; -! : CreateProcessAsUserW ; -! : CreateProcessWithLogonW ; -! : CreateRestrictedToken ; -! : CreateServiceA ; -! : CreateServiceW ; -! : CreateTraceInstanceId ; -! : CreateWellKnownSid ; -! : CredDeleteA ; -! : CredDeleteW ; -! : CredEnumerateA ; -! : CredEnumerateW ; -! : CredFree ; -! : CredGetSessionTypes ; -! : CredGetTargetInfoA ; -! : CredGetTargetInfoW ; -! : CredIsMarshaledCredentialA ; -! : CredIsMarshaledCredentialW ; -! : CredMarshalCredentialA ; -! : CredMarshalCredentialW ; -! : CredProfileLoaded ; -! : CredReadA ; -! : CredReadDomainCredentialsA ; -! : CredReadDomainCredentialsW ; -! : CredReadW ; -! : CredRenameA ; -! : CredRenameW ; -! : CredUnmarshalCredentialA ; -! : CredUnmarshalCredentialW ; -! : CredWriteA ; -! : CredWriteDomainCredentialsA ; -! : CredWriteDomainCredentialsW ; -! : CredWriteW ; -! : CredpConvertCredential ; -! : CredpConvertTargetInfo ; -! : CredpDecodeCredential ; -! : CredpEncodeCredential ; -! : CryptAcquireContextA ; -! : CryptAcquireContextW ; -! : CryptContextAddRef ; -! : CryptCreateHash ; -! : CryptDecrypt ; -! : CryptDeriveKey ; -! : CryptDestroyHash ; -! : CryptDestroyKey ; -! : CryptDuplicateHash ; -! : CryptDuplicateKey ; -! : CryptEncrypt ; -! : CryptEnumProviderTypesA ; -! : CryptEnumProviderTypesW ; -! : CryptEnumProvidersA ; -! : CryptEnumProvidersW ; -! : CryptExportKey ; -! : CryptGenKey ; -! : CryptGenRandom ; -! : CryptGetDefaultProviderA ; -! : CryptGetDefaultProviderW ; -! : CryptGetHashParam ; -! : CryptGetKeyParam ; -! : CryptGetProvParam ; -! : CryptGetUserKey ; -! : CryptHashData ; -! : CryptHashSessionKey ; -! : CryptImportKey ; -! : CryptReleaseContext ; -! : CryptSetHashParam ; -! : CryptSetKeyParam ; -! : CryptSetProvParam ; -! : CryptSetProviderA ; -! : CryptSetProviderExA ; -! : CryptSetProviderExW ; -! : CryptSetProviderW ; -! : CryptSignHashA ; -! : CryptSignHashW ; -! : CryptVerifySignatureA ; -! : CryptVerifySignatureW ; -! : DecryptFileA ; -! : DecryptFileW ; -! : DeleteAce ; -! : DeleteService ; -! : DeregisterEventSource ; -! : DestroyPrivateObjectSecurity ; -! : DuplicateEncryptionInfoFile ; -! : DuplicateToken ; -! : DuplicateTokenEx ; -! : ElfBackupEventLogFileA ; -! : ElfBackupEventLogFileW ; -! : ElfChangeNotify ; -! : ElfClearEventLogFileA ; -! : ElfClearEventLogFileW ; -! : ElfCloseEventLog ; -! : ElfDeregisterEventSource ; -! : ElfFlushEventLog ; -! : ElfNumberOfRecords ; -! : ElfOldestRecord ; -! : ElfOpenBackupEventLogA ; -! : ElfOpenBackupEventLogW ; -! : ElfOpenEventLogA ; -! : ElfOpenEventLogW ; -! : ElfReadEventLogA ; -! : ElfReadEventLogW ; -! : ElfRegisterEventSourceA ; -! : ElfRegisterEventSourceW ; -! : ElfReportEventA ; -! : ElfReportEventW ; -! : EnableTrace ; -! : EncryptFileA ; -! : EncryptFileW ; -! : EncryptedFileKeyInfo ; -! : EncryptionDisable ; -! : EnumDependentServicesA ; -! : EnumDependentServicesW ; -! : EnumServiceGroupW ; -! : EnumServicesStatusA ; -! : EnumServicesStatusExA ; -! : EnumServicesStatusExW ; -! : EnumServicesStatusW ; -! : EnumerateTraceGuids ; -! : EqualDomainSid ; -! : EqualPrefixSid ; -! : EqualSid ; -! : FileEncryptionStatusA ; -! : FileEncryptionStatusW ; -! : FindFirstFreeAce ; -! : FlushTraceA ; -! : FlushTraceW ; -! : FreeEncryptedFileKeyInfo ; -! : FreeEncryptionCertificateHashList ; -! : FreeInheritedFromArray ; -! : FreeSid ; -! : GetAccessPermissionsForObjectA ; -! : GetAccessPermissionsForObjectW ; -! : GetAce ; -! : GetAclInformation ; -! : GetAuditedPermissionsFromAclA ; -! : GetAuditedPermissionsFromAclW ; -! : GetCurrentHwProfileA ; -! : GetCurrentHwProfileW ; -! : GetEffectiveRightsFromAclA ; -! : GetEffectiveRightsFromAclW ; -! : GetEventLogInformation ; -! : GetExplicitEntriesFromAclA ; -! : GetExplicitEntriesFromAclW ; -! : GetFileSecurityA ; -! : GetFileSecurityW ; -! : GetInformationCodeAuthzLevelW ; -! : GetInformationCodeAuthzPolicyW ; -! : GetInheritanceSourceA ; -! : GetInheritanceSourceW ; -! : GetKernelObjectSecurity ; -! : GetLengthSid ; -! : GetLocalManagedApplicationData ; -! : GetLocalManagedApplications ; -! : GetManagedApplicationCategories ; -! : GetManagedApplications ; -! : GetMultipleTrusteeA ; -! : GetMultipleTrusteeOperationA ; -! : GetMultipleTrusteeOperationW ; -! : GetMultipleTrusteeW ; -! : GetNamedSecurityInfoA ; -! : GetNamedSecurityInfoExA ; -! : GetNamedSecurityInfoExW ; -! : GetNamedSecurityInfoW ; -! : GetNumberOfEventLogRecords ; -! : GetOldestEventLogRecord ; -! : GetOverlappedAccessResults ; -! : GetPrivateObjectSecurity ; -! : GetSecurityDescriptorControl ; -! : GetSecurityDescriptorDacl ; -! : GetSecurityDescriptorGroup ; -! : GetSecurityDescriptorLength ; -! : GetSecurityDescriptorOwner ; -! : GetSecurityDescriptorRMControl ; -! : GetSecurityDescriptorSacl ; -! : GetSecurityInfo ; -! : GetSecurityInfoExA ; -! : GetSecurityInfoExW ; -! : GetServiceDisplayNameA ; -! : GetServiceDisplayNameW ; -! : GetServiceKeyNameA ; -! : GetServiceKeyNameW ; -! : GetSidIdentifierAuthority ; -! : GetSidLengthRequired ; -! : GetSidSubAuthority ; -! : GetSidSubAuthorityCount ; -! : GetTokenInformation ; -! : GetTraceEnableFlags ; -! : GetTraceEnableLevel ; -! : GetTraceLoggerHandle ; -! : GetTrusteeFormA ; -! : GetTrusteeFormW ; -! : GetTrusteeNameA ; -! : GetTrusteeNameW ; -! : GetTrusteeTypeA ; -! : GetTrusteeTypeW ; - -! : GetUserNameA ; -FUNCTION: BOOL GetUserNameW ( LPCTSTR lpBuffer, LPDWORD lpnSize ) ; -: GetUserName GetUserNameW ; - -! : GetWindowsAccountDomainSid ; -! : I_ScIsSecurityProcess ; -! : I_ScPnPGetServiceName ; -! : I_ScSendTSMessage ; -! : I_ScSetServiceBitsA ; -! : I_ScSetServiceBitsW ; -! : IdentifyCodeAuthzLevelW ; -! : ImpersonateAnonymousToken ; -! : ImpersonateLoggedOnUser ; -! : ImpersonateNamedPipeClient ; -! : ImpersonateSelf ; -! : InitializeAcl ; -! : InitializeSecurityDescriptor ; -! : InitializeSid ; -! : InitiateSystemShutdownA ; -! : InitiateSystemShutdownExA ; -! : InitiateSystemShutdownExW ; -! : InitiateSystemShutdownW ; -! : InstallApplication ; -! : IsTextUnicode ; -! : IsTokenRestricted ; -! : IsTokenUntrusted ; -! : IsValidAcl ; -! : IsValidSecurityDescriptor ; -! : IsValidSid ; -! : IsWellKnownSid ; -! : LockServiceDatabase ; -! : LogonUserA ; -! : LogonUserExA ; -! : LogonUserExW ; -! : LogonUserW ; -! : LookupAccountNameA ; -! : LookupAccountNameW ; -! : LookupAccountSidA ; -! : LookupAccountSidW ; -! : LookupPrivilegeDisplayNameA ; -! : LookupPrivilegeDisplayNameW ; -! : LookupPrivilegeNameA ; -! : LookupPrivilegeNameW ; -! : LookupPrivilegeValueA ; -FUNCTION: BOOL LookupPrivilegeValueW ( LPCTSTR lpSystemName, - LPCTSTR lpName, - PLUID lpLuid ) ; -: LookupPrivilegeValue LookupPrivilegeValueW ; - -! : LookupSecurityDescriptorPartsA ; -! : LookupSecurityDescriptorPartsW ; -! : LsaAddAccountRights ; -! : LsaAddPrivilegesToAccount ; -! : LsaClearAuditLog ; -! : LsaClose ; -! : LsaCreateAccount ; -! : LsaCreateSecret ; -! : LsaCreateTrustedDomain ; -! : LsaCreateTrustedDomainEx ; -! : LsaDelete ; -! : LsaDeleteTrustedDomain ; -! : LsaEnumerateAccountRights ; -! : LsaEnumerateAccounts ; -! : LsaEnumerateAccountsWithUserRight ; -! : LsaEnumeratePrivileges ; -! : LsaEnumeratePrivilegesOfAccount ; -! : LsaEnumerateTrustedDomains ; -! : LsaEnumerateTrustedDomainsEx ; -! : LsaFreeMemory ; -! : LsaGetQuotasForAccount ; -! : LsaGetRemoteUserName ; -! : LsaGetSystemAccessAccount ; -! : LsaGetUserName ; -! : LsaICLookupNames ; -! : LsaICLookupNamesWithCreds ; -! : LsaICLookupSids ; -! : LsaICLookupSidsWithCreds ; -! : LsaLookupNames2 ; -! : LsaLookupNames ; -! : LsaLookupPrivilegeDisplayName ; -! : LsaLookupPrivilegeName ; -! : LsaLookupPrivilegeValue ; -! : LsaLookupSids ; -! : LsaNtStatusToWinError ; -! : LsaOpenAccount ; -! : LsaOpenPolicy ; -! : LsaOpenPolicySce ; -! : LsaOpenSecret ; -! : LsaOpenTrustedDomain ; -! : LsaOpenTrustedDomainByName ; -! : LsaQueryDomainInformationPolicy ; -! : LsaQueryForestTrustInformation ; -! : LsaQueryInfoTrustedDomain ; -! : LsaQueryInformationPolicy ; -! : LsaQuerySecret ; -! : LsaQuerySecurityObject ; -! : LsaQueryTrustedDomainInfo ; -! : LsaQueryTrustedDomainInfoByName ; -! : LsaRemoveAccountRights ; -! : LsaRemovePrivilegesFromAccount ; -! : LsaRetrievePrivateData ; -! : LsaSetDomainInformationPolicy ; -! : LsaSetForestTrustInformation ; -! : LsaSetInformationPolicy ; -! : LsaSetInformationTrustedDomain ; -! : LsaSetQuotasForAccount ; -! : LsaSetSecret ; -! : LsaSetSecurityObject ; -! : LsaSetSystemAccessAccount ; -! : LsaSetTrustedDomainInfoByName ; -! : LsaSetTrustedDomainInformation ; -! : LsaStorePrivateData ; -! : MD4Final ; -! : MD4Init ; -! : MD4Update ; -! : MD5Final ; -! : MD5Init ; -! : MD5Update ; -! : MSChapSrvChangePassword2 ; -! : MSChapSrvChangePassword ; -! : MakeAbsoluteSD2 ; -! : MakeAbsoluteSD ; -! : MakeSelfRelativeSD ; -! : MapGenericMask ; -! : NotifyBootConfigStatus ; -! : NotifyChangeEventLog ; -! : ObjectCloseAuditAlarmA ; -! : ObjectCloseAuditAlarmW ; -! : ObjectDeleteAuditAlarmA ; -! : ObjectDeleteAuditAlarmW ; -! : ObjectOpenAuditAlarmA ; -! : ObjectOpenAuditAlarmW ; -! : ObjectPrivilegeAuditAlarmA ; -! : ObjectPrivilegeAuditAlarmW ; -! : OpenBackupEventLogA ; -! : OpenBackupEventLogW ; -! : OpenEncryptedFileRawA ; -! : OpenEncryptedFileRawW ; -! : OpenEventLogA ; -! : OpenEventLogW ; - -! typedef enum _TOKEN_INFORMATION_CLASS { -: TokenUser 1 ; -: TokenGroups 2 ; -: TokenPrivileges 3 ; -: TokenOwner 4 ; -: TokenPrimaryGroup 5 ; -: TokenDefaultDacl 6 ; -: TokenSource 7 ; -: TokenType 8 ; -: TokenImpersonationLevel 9 ; -: TokenStatistics 10 ; -: TokenRestrictedSids 11 ; -: TokenSessionId 12 ; -: TokenGroupsAndPrivileges 13 ; -: TokenSessionReference 14 ; -: TokenSandBoxInert 15 ; -! } TOKEN_INFORMATION_CLASS; - -: DELETE HEX: 00010000 ; inline -: READ_CONTROL HEX: 00020000 ; inline -: WRITE_DAC HEX: 00040000 ; inline -: WRITE_OWNER HEX: 00080000 ; inline -: SYNCHRONIZE HEX: 00100000 ; inline -: STANDARD_RIGHTS_REQUIRED HEX: 000f0000 ; inline - -: STANDARD_RIGHTS_READ READ_CONTROL ; inline -: STANDARD_RIGHTS_WRITE READ_CONTROL ; inline -: STANDARD_RIGHTS_EXECUTE READ_CONTROL ; inline - -: TOKEN_TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline -: TOKEN_ADJUST_GROUPS HEX: 0040 ; inline -: TOKEN_ADJUST_PRIVILEGES HEX: 0020 ; inline -: TOKEN_ADJUST_SESSIONID HEX: 0100 ; inline -: TOKEN_ASSIGN_PRIMARY HEX: 0001 ; inline -: TOKEN_DUPLICATE HEX: 0002 ; inline -: TOKEN_EXECUTE STANDARD_RIGHTS_EXECUTE ; inline -: TOKEN_IMPERSONATE HEX: 0004 ; inline -: TOKEN_QUERY HEX: 0008 ; inline -: TOKEN_QUERY_SOURCE HEX: 0010 ; inline -: TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline -: TOKEN_READ STANDARD_RIGHTS_READ TOKEN_QUERY bitor ; - -: TOKEN_WRITE - { - STANDARD_RIGHTS_WRITE - TOKEN_ADJUST_PRIVILEGES - TOKEN_ADJUST_GROUPS - TOKEN_ADJUST_DEFAULT - } flags ; foldable - -: TOKEN_ALL_ACCESS - { - STANDARD_RIGHTS_REQUIRED - TOKEN_ASSIGN_PRIMARY - TOKEN_DUPLICATE - TOKEN_IMPERSONATE - TOKEN_QUERY - TOKEN_QUERY_SOURCE - TOKEN_ADJUST_PRIVILEGES - TOKEN_ADJUST_GROUPS - TOKEN_ADJUST_SESSIONID - TOKEN_ADJUST_DEFAULT - } flags ; foldable - -FUNCTION: BOOL OpenProcessToken ( HANDLE ProcessHandle, - DWORD DesiredAccess, - PHANDLE TokenHandle ) ; -! : OpenSCManagerA ; -! : OpenSCManagerW ; -! : OpenServiceA ; -! : OpenServiceW ; -FUNCTION: BOOL OpenThreadToken ( HANDLE ThreadHandle, DWORD DesiredAccess, BOOL OpenAsSelf, PHANDLE TokenHandle ) ; -! : OpenTraceA ; -! : OpenTraceW ; -! : PrivilegeCheck ; -! : PrivilegedServiceAuditAlarmA ; -! : PrivilegedServiceAuditAlarmW ; -! : ProcessIdleTasks ; -! : ProcessTrace ; -! : QueryAllTracesA ; -! : QueryAllTracesW ; -! : QueryRecoveryAgentsOnEncryptedFile ; -! : QueryServiceConfig2A ; -! : QueryServiceConfig2W ; -! : QueryServiceConfigA ; -! : QueryServiceConfigW ; -! : QueryServiceLockStatusA ; -! : QueryServiceLockStatusW ; -! : QueryServiceObjectSecurity ; -! : QueryServiceStatus ; -! : QueryServiceStatusEx ; -! : QueryTraceA ; -! : QueryTraceW ; -! : QueryUsersOnEncryptedFile ; -! : QueryWindows31FilesMigration ; -! : ReadEncryptedFileRaw ; -! : ReadEventLogA ; -! : ReadEventLogW ; -! : RegCloseKey ; -! : RegConnectRegistryA ; -! : RegConnectRegistryW ; -! : RegCreateKeyA ; -! : RegCreateKeyExA ; -! : RegCreateKeyExW ; -! : RegCreateKeyW ; -! : RegDeleteKeyA ; -! : RegDeleteKeyW ; -! : RegDeleteValueA ; -! : RegDeleteValueW ; -! : RegDisablePredefinedCache ; -! : RegEnumKeyA ; -! : RegEnumKeyExA ; -! : RegEnumKeyExW ; -! : RegEnumKeyW ; -! : RegEnumValueA ; -! : RegEnumValueW ; -! : RegFlushKey ; -! : RegGetKeySecurity ; -! : RegLoadKeyA ; -! : RegLoadKeyW ; -! : RegNotifyChangeKeyValue ; -! : RegOpenCurrentUser ; -! : RegOpenKeyA ; -! : RegOpenKeyExA ; -! : RegOpenKeyExW ; -! : RegOpenKeyW ; -! : RegOpenUserClassesRoot ; -! : RegOverridePredefKey ; -! : RegQueryInfoKeyA ; -! : RegQueryInfoKeyW ; -! : RegQueryMultipleValuesA ; -! : RegQueryMultipleValuesW ; -! : RegQueryValueA ; -! : RegQueryValueExA ; -! : RegQueryValueExW ; -! : RegQueryValueW ; -! : RegReplaceKeyA ; -! : RegReplaceKeyW ; -! : RegRestoreKeyA ; -! : RegRestoreKeyW ; -! : RegSaveKeyA ; -! : RegSaveKeyExA ; -! : RegSaveKeyExW ; -! : RegSaveKeyW ; -! : RegSetKeySecurity ; -! : RegSetValueA ; -! : RegSetValueExA ; -! : RegSetValueExW ; -! : RegSetValueW ; -! : RegUnLoadKeyA ; -! : RegUnLoadKeyW ; -! : RegisterEventSourceA ; -! : RegisterEventSourceW ; -! : RegisterIdleTask ; -! : RegisterServiceCtrlHandlerA ; -! : RegisterServiceCtrlHandlerExA ; -! : RegisterServiceCtrlHandlerExW ; -! : RegisterServiceCtrlHandlerW ; -! : RegisterTraceGuidsA ; -! : RegisterTraceGuidsW ; -! : RemoveTraceCallback ; -! : RemoveUsersFromEncryptedFile ; -! : ReportEventA ; -! : ReportEventW ; -! : RevertToSelf ; -! : SaferCloseLevel ; -! : SaferComputeTokenFromLevel ; -! : SaferCreateLevel ; -! : SaferGetLevelInformation ; -! : SaferGetPolicyInformation ; -! : SaferIdentifyLevel ; -! : SaferRecordEventLogEntry ; -! : SaferSetLevelInformation ; -! : SaferSetPolicyInformation ; -! : SaferiChangeRegistryScope ; -! : SaferiCompareTokenLevels ; -! : SaferiIsExecutableFileType ; -! : SaferiPopulateDefaultsInRegistry ; -! : SaferiRecordEventLogEntry ; -! : SaferiReplaceProcessThreadTokens ; -! : SaferiSearchMatchingHashRules ; -! : SetAclInformation ; -! : SetEntriesInAccessListA ; -! : SetEntriesInAccessListW ; -! : SetEntriesInAclA ; -! : SetEntriesInAclW ; -! : SetEntriesInAuditListA ; -! : SetEntriesInAuditListW ; -! : SetFileSecurityA ; -! : SetFileSecurityW ; -! : SetInformationCodeAuthzLevelW ; -! : SetInformationCodeAuthzPolicyW ; -! : SetKernelObjectSecurity ; -! : SetNamedSecurityInfoA ; -! : SetNamedSecurityInfoExA ; -! : SetNamedSecurityInfoExW ; -! : SetNamedSecurityInfoW ; -! : SetPrivateObjectSecurity ; -! : SetPrivateObjectSecurityEx ; -! : SetSecurityDescriptorControl ; -! : SetSecurityDescriptorDacl ; -! : SetSecurityDescriptorGroup ; -! : SetSecurityDescriptorOwner ; -! : SetSecurityDescriptorRMControl ; -! : SetSecurityDescriptorSacl ; -! : SetSecurityInfo ; -! : SetSecurityInfoExA ; -! : SetSecurityInfoExW ; -! : SetServiceBits ; -! : SetServiceObjectSecurity ; -! : SetServiceStatus ; -! : SetThreadToken ; -! : SetTokenInformation ; -! : SetTraceCallback ; -! : SetUserFileEncryptionKey ; -! : StartServiceA ; -! : StartServiceCtrlDispatcherA ; -! : StartServiceCtrlDispatcherW ; -! : StartServiceW ; -! : StartTraceA ; -! : StartTraceW ; -! : StopTraceA ; -! : StopTraceW ; -! : SynchronizeWindows31FilesAndWindowsNTRegistry ; -! : SystemFunction001 ; -! : SystemFunction002 ; -! : SystemFunction003 ; -! : SystemFunction004 ; -! : SystemFunction005 ; -! : SystemFunction006 ; -! : SystemFunction007 ; -! : SystemFunction008 ; -! : SystemFunction009 ; -! : SystemFunction010 ; -! : SystemFunction011 ; -! : SystemFunction012 ; -! : SystemFunction013 ; -! : SystemFunction014 ; -! : SystemFunction015 ; -! : SystemFunction016 ; -! : SystemFunction017 ; -! : SystemFunction018 ; -! : SystemFunction019 ; -! : SystemFunction020 ; -! : SystemFunction021 ; -! : SystemFunction022 ; -! : SystemFunction023 ; -! : SystemFunction024 ; -! : SystemFunction025 ; -! : SystemFunction026 ; -! : SystemFunction027 ; -! : SystemFunction028 ; -! : SystemFunction029 ; -! : SystemFunction030 ; -! : SystemFunction031 ; -! : SystemFunction032 ; -! : SystemFunction033 ; -! : SystemFunction034 ; -! : SystemFunction035 ; -! : SystemFunction036 ; -! : SystemFunction040 ; -! : SystemFunction041 ; -! : TraceEvent ; -! : TraceEventInstance ; -! : TraceMessage ; -! : TraceMessageVa ; -! : TreeResetNamedSecurityInfoA ; -! : TreeResetNamedSecurityInfoW ; -! : TrusteeAccessToObjectA ; -! : TrusteeAccessToObjectW ; -! : UninstallApplication ; -! : UnlockServiceDatabase ; -! : UnregisterIdleTask ; -! : UnregisterTraceGuids ; -! : UpdateTraceA ; -! : UpdateTraceW ; -! : WdmWmiServiceMain ; -! : WmiCloseBlock ; -! : WmiCloseTraceWithCursor ; -! : WmiConvertTimestamp ; -! : WmiDevInstToInstanceNameA ; -! : WmiDevInstToInstanceNameW ; -! : WmiEnumerateGuids ; -! : WmiExecuteMethodA ; -! : WmiExecuteMethodW ; -! : WmiFileHandleToInstanceNameA ; -! : WmiFileHandleToInstanceNameW ; -! : WmiFreeBuffer ; -! : WmiGetFirstTraceOffset ; -! : WmiGetNextEvent ; -! : WmiGetTraceHeader ; -! : WmiMofEnumerateResourcesA ; -! : WmiMofEnumerateResourcesW ; -! : WmiNotificationRegistrationA ; -! : WmiNotificationRegistrationW ; -! : WmiOpenBlock ; -! : WmiOpenTraceWithCursor ; -! : WmiParseTraceEvent ; -! : WmiQueryAllDataA ; -! : WmiQueryAllDataMultipleA ; -! : WmiQueryAllDataMultipleW ; -! : WmiQueryAllDataW ; -! : WmiQueryGuidInformation ; -! : WmiQuerySingleInstanceA ; -! : WmiQuerySingleInstanceMultipleA ; -! : WmiQuerySingleInstanceMultipleW ; -! : WmiQuerySingleInstanceW ; -! : WmiReceiveNotificationsA ; -! : WmiReceiveNotificationsW ; -! : WmiSetSingleInstanceA ; -! : WmiSetSingleInstanceW ; -! : WmiSetSingleItemA ; -! : WmiSetSingleItemW ; -! : Wow64Win32ApiEntry ; -! : WriteEncryptedFileRaw ; - - +USING: alien.syntax kernel math windows.types math.bitfields ; +IN: windows.advapi32 +LIBRARY: advapi32 + +: PROV_RSA_FULL 1 ; inline +: PROV_RSA_SIG 2 ; inline +: PROV_DSS 3 ; inline +: PROV_FORTEZZA 4 ; inline +: PROV_MS_EXCHANGE 5 ; inline +: PROV_SSL 6 ; inline +: PROV_RSA_SCHANNEL 12 ; inline +: PROV_DSS_DH 13 ; inline +: PROV_EC_ECDSA_SIG 14 ; inline +: PROV_EC_ECNRA_SIG 15 ; inline +: PROV_EC_ECDSA_FULL 16 ; inline +: PROV_EC_ECNRA_FULL 17 ; inline +: PROV_DH_SCHANNEL 18 ; inline +: PROV_SPYRUS_LYNKS 20 ; inline +: PROV_RNG 21 ; inline +: PROV_INTEL_SEC 22 ; inline +: PROV_REPLACE_OWF 23 ; inline +: PROV_RSA_AES 24 ; inline + +: CRYPT_VERIFYCONTEXT HEX: F0000000 ; inline +: CRYPT_NEWKEYSET HEX: 8 ; inline +: CRYPT_DELETEKEYSET HEX: 10 ; inline +: CRYPT_MACHINE_KEYSET HEX: 20 ; inline +: CRYPT_SILENT HEX: 40 ; inline + + +! : I_ScGetCurrentGroupStateW ; +! : A_SHAFinal ; +! : A_SHAInit ; +! : A_SHAUpdate ; +! : AbortSystemShutdownA ; +! : AbortSystemShutdownW ; +! : AccessCheck ; +! : AccessCheckAndAuditAlarmA ; +! : AccessCheckAndAuditAlarmW ; +! : AccessCheckByType ; +! : AccessCheckByTypeAndAuditAlarmA ; +! : AccessCheckByTypeAndAuditAlarmW ; +! : AccessCheckByTypeResultList ; +! : AccessCheckByTypeResultListAndAuditAlarmA ; +! : AccessCheckByTypeResultListAndAuditAlarmByHandleA ; +! : AccessCheckByTypeResultListAndAuditAlarmByHandleW ; +! : AccessCheckByTypeResultListAndAuditAlarmW ; +! : AddAccessAllowedAce ; +! : AddAccessAllowedAceEx ; +! : AddAccessAllowedObjectAce ; +! : AddAccessDeniedAce ; +! : AddAccessDeniedAceEx ; +! : AddAccessDeniedObjectAce ; +! : AddAce ; +! : AddAuditAccessAce ; +! : AddAuditAccessAceEx ; +! : AddAuditAccessObjectAce ; +! : AddUsersToEncryptedFile ; +! : AdjustTokenGroups ; +FUNCTION: BOOL AdjustTokenPrivileges ( HANDLE TokenHandle, + BOOL DisableAllPrivileges, + PTOKEN_PRIVILEGES NewState, + DWORD BufferLength, + PTOKEN_PRIVILEGES PreviousState, + PDWORD ReturnLength ) ; + +! : AllocateAndInitializeSid ; +! : AllocateLocallyUniqueId ; +! : AreAllAccessesGranted ; +! : AreAnyAccessesGranted ; +! : BackupEventLogA ; +! : BackupEventLogW ; +! : BuildExplicitAccessWithNameA ; +! : BuildExplicitAccessWithNameW ; +! : BuildImpersonateExplicitAccessWithNameA ; +! : BuildImpersonateExplicitAccessWithNameW ; +! : BuildImpersonateTrusteeA ; +! : BuildImpersonateTrusteeW ; +! : BuildSecurityDescriptorA ; +! : BuildSecurityDescriptorW ; +! : BuildTrusteeWithNameA ; +! : BuildTrusteeWithNameW ; +! : BuildTrusteeWithObjectsAndNameA ; +! : BuildTrusteeWithObjectsAndNameW ; +! : BuildTrusteeWithObjectsAndSidA ; +! : BuildTrusteeWithObjectsAndSidW ; +! : BuildTrusteeWithSidA ; +! : BuildTrusteeWithSidW ; +! : CancelOverlappedAccess ; +! : ChangeServiceConfig2A ; +! : ChangeServiceConfig2W ; +! : ChangeServiceConfigA ; +! : ChangeServiceConfigW ; +! : CheckTokenMembership ; +! : ClearEventLogA ; +! : ClearEventLogW ; +! : CloseCodeAuthzLevel ; +! : CloseEncryptedFileRaw ; +! : CloseEventLog ; +! : CloseServiceHandle ; +! : CloseTrace ; +! : CommandLineFromMsiDescriptor ; +! : ComputeAccessTokenFromCodeAuthzLevel ; +! : ControlService ; +! : ControlTraceA ; +! : ControlTraceW ; +! : ConvertAccessToSecurityDescriptorA ; +! : ConvertAccessToSecurityDescriptorW ; +! : ConvertSDToStringSDRootDomainA ; +! : ConvertSDToStringSDRootDomainW ; +! : ConvertSecurityDescriptorToAccessA ; +! : ConvertSecurityDescriptorToAccessNamedA ; +! : ConvertSecurityDescriptorToAccessNamedW ; +! : ConvertSecurityDescriptorToAccessW ; +! : ConvertSecurityDescriptorToStringSecurityDescriptorA ; +! : ConvertSecurityDescriptorToStringSecurityDescriptorW ; +! : ConvertSidToStringSidA ; +! : ConvertSidToStringSidW ; +! : ConvertStringSDToSDDomainA ; +! : ConvertStringSDToSDDomainW ; +! : ConvertStringSDToSDRootDomainA ; +! : ConvertStringSDToSDRootDomainW ; +! : ConvertStringSecurityDescriptorToSecurityDescriptorA ; +! : ConvertStringSecurityDescriptorToSecurityDescriptorW ; +! : ConvertStringSidToSidA ; +! : ConvertStringSidToSidW ; +! : ConvertToAutoInheritPrivateObjectSecurity ; +! : CopySid ; +! : CreateCodeAuthzLevel ; +! : CreatePrivateObjectSecurity ; +! : CreatePrivateObjectSecurityEx ; +! : CreatePrivateObjectSecurityWithMultipleInheritance ; +! : CreateProcessAsUserA ; +! : CreateProcessAsUserSecure ; +! : CreateProcessAsUserW ; +! : CreateProcessWithLogonW ; +! : CreateRestrictedToken ; +! : CreateServiceA ; +! : CreateServiceW ; +! : CreateTraceInstanceId ; +! : CreateWellKnownSid ; +! : CredDeleteA ; +! : CredDeleteW ; +! : CredEnumerateA ; +! : CredEnumerateW ; +! : CredFree ; +! : CredGetSessionTypes ; +! : CredGetTargetInfoA ; +! : CredGetTargetInfoW ; +! : CredIsMarshaledCredentialA ; +! : CredIsMarshaledCredentialW ; +! : CredMarshalCredentialA ; +! : CredMarshalCredentialW ; +! : CredProfileLoaded ; +! : CredReadA ; +! : CredReadDomainCredentialsA ; +! : CredReadDomainCredentialsW ; +! : CredReadW ; +! : CredRenameA ; +! : CredRenameW ; +! : CredUnmarshalCredentialA ; +! : CredUnmarshalCredentialW ; +! : CredWriteA ; +! : CredWriteDomainCredentialsA ; +! : CredWriteDomainCredentialsW ; +! : CredWriteW ; +! : CredpConvertCredential ; +! : CredpConvertTargetInfo ; +! : CredpDecodeCredential ; +! : CredpEncodeCredential ; +! : CryptAcquireContextA ; +FUNCTION: BOOL CryptAcquireContextW ( HCRYPTPROV* phProv, + LPCTSTR pszContainer, + LPCTSTR pszProvider, + DWORD dwProvType, + DWORD dwFlags ) ; + +: CryptAcquireContext CryptAcquireContextW ; +! : CryptContextAddRef ; +! : CryptCreateHash ; +! : CryptDecrypt ; +! : CryptDeriveKey ; +! : CryptDestroyHash ; +! : CryptDestroyKey ; +! : CryptDuplicateHash ; +! : CryptDuplicateKey ; +! : CryptEncrypt ; +! : CryptEnumProviderTypesA ; +! : CryptEnumProviderTypesW ; +! : CryptEnumProvidersA ; +! : CryptEnumProvidersW ; +! : CryptExportKey ; +! : CryptGenKey ; +FUNCTION: BOOL CryptGenRandom ( HCRYPTPROV hProv, DWORD dwLen, BYTE* pbBuffer ) ; +! : CryptGetDefaultProviderA ; +! : CryptGetDefaultProviderW ; +! : CryptGetHashParam ; +! : CryptGetKeyParam ; +! : CryptGetProvParam ; +! : CryptGetUserKey ; +! : CryptHashData ; +! : CryptHashSessionKey ; +! : CryptImportKey ; +FUNCTION: BOOL CryptReleaseContext ( HCRYPTPROV hProv, DWORD dwFlags ) ; +! : CryptSetHashParam ; +! : CryptSetKeyParam ; +! : CryptSetProvParam ; +! : CryptSetProviderA ; +! : CryptSetProviderExA ; +! : CryptSetProviderExW ; +! : CryptSetProviderW ; +! : CryptSignHashA ; +! : CryptSignHashW ; +! : CryptVerifySignatureA ; +! : CryptVerifySignatureW ; +! : DecryptFileA ; +! : DecryptFileW ; +! : DeleteAce ; +! : DeleteService ; +! : DeregisterEventSource ; +! : DestroyPrivateObjectSecurity ; +! : DuplicateEncryptionInfoFile ; +! : DuplicateToken ; +! : DuplicateTokenEx ; +! : ElfBackupEventLogFileA ; +! : ElfBackupEventLogFileW ; +! : ElfChangeNotify ; +! : ElfClearEventLogFileA ; +! : ElfClearEventLogFileW ; +! : ElfCloseEventLog ; +! : ElfDeregisterEventSource ; +! : ElfFlushEventLog ; +! : ElfNumberOfRecords ; +! : ElfOldestRecord ; +! : ElfOpenBackupEventLogA ; +! : ElfOpenBackupEventLogW ; +! : ElfOpenEventLogA ; +! : ElfOpenEventLogW ; +! : ElfReadEventLogA ; +! : ElfReadEventLogW ; +! : ElfRegisterEventSourceA ; +! : ElfRegisterEventSourceW ; +! : ElfReportEventA ; +! : ElfReportEventW ; +! : EnableTrace ; +! : EncryptFileA ; +! : EncryptFileW ; +! : EncryptedFileKeyInfo ; +! : EncryptionDisable ; +! : EnumDependentServicesA ; +! : EnumDependentServicesW ; +! : EnumServiceGroupW ; +! : EnumServicesStatusA ; +! : EnumServicesStatusExA ; +! : EnumServicesStatusExW ; +! : EnumServicesStatusW ; +! : EnumerateTraceGuids ; +! : EqualDomainSid ; +! : EqualPrefixSid ; +! : EqualSid ; +! : FileEncryptionStatusA ; +! : FileEncryptionStatusW ; +! : FindFirstFreeAce ; +! : FlushTraceA ; +! : FlushTraceW ; +! : FreeEncryptedFileKeyInfo ; +! : FreeEncryptionCertificateHashList ; +! : FreeInheritedFromArray ; +! : FreeSid ; +! : GetAccessPermissionsForObjectA ; +! : GetAccessPermissionsForObjectW ; +! : GetAce ; +! : GetAclInformation ; +! : GetAuditedPermissionsFromAclA ; +! : GetAuditedPermissionsFromAclW ; +! : GetCurrentHwProfileA ; +! : GetCurrentHwProfileW ; +! : GetEffectiveRightsFromAclA ; +! : GetEffectiveRightsFromAclW ; +! : GetEventLogInformation ; +! : GetExplicitEntriesFromAclA ; +! : GetExplicitEntriesFromAclW ; +! : GetFileSecurityA ; +! : GetFileSecurityW ; +! : GetInformationCodeAuthzLevelW ; +! : GetInformationCodeAuthzPolicyW ; +! : GetInheritanceSourceA ; +! : GetInheritanceSourceW ; +! : GetKernelObjectSecurity ; +! : GetLengthSid ; +! : GetLocalManagedApplicationData ; +! : GetLocalManagedApplications ; +! : GetManagedApplicationCategories ; +! : GetManagedApplications ; +! : GetMultipleTrusteeA ; +! : GetMultipleTrusteeOperationA ; +! : GetMultipleTrusteeOperationW ; +! : GetMultipleTrusteeW ; +! : GetNamedSecurityInfoA ; +! : GetNamedSecurityInfoExA ; +! : GetNamedSecurityInfoExW ; +! : GetNamedSecurityInfoW ; +! : GetNumberOfEventLogRecords ; +! : GetOldestEventLogRecord ; +! : GetOverlappedAccessResults ; +! : GetPrivateObjectSecurity ; +! : GetSecurityDescriptorControl ; +! : GetSecurityDescriptorDacl ; +! : GetSecurityDescriptorGroup ; +! : GetSecurityDescriptorLength ; +! : GetSecurityDescriptorOwner ; +! : GetSecurityDescriptorRMControl ; +! : GetSecurityDescriptorSacl ; +! : GetSecurityInfo ; +! : GetSecurityInfoExA ; +! : GetSecurityInfoExW ; +! : GetServiceDisplayNameA ; +! : GetServiceDisplayNameW ; +! : GetServiceKeyNameA ; +! : GetServiceKeyNameW ; +! : GetSidIdentifierAuthority ; +! : GetSidLengthRequired ; +! : GetSidSubAuthority ; +! : GetSidSubAuthorityCount ; +! : GetTokenInformation ; +! : GetTraceEnableFlags ; +! : GetTraceEnableLevel ; +! : GetTraceLoggerHandle ; +! : GetTrusteeFormA ; +! : GetTrusteeFormW ; +! : GetTrusteeNameA ; +! : GetTrusteeNameW ; +! : GetTrusteeTypeA ; +! : GetTrusteeTypeW ; + +! : GetUserNameA ; +FUNCTION: BOOL GetUserNameW ( LPCTSTR lpBuffer, LPDWORD lpnSize ) ; +: GetUserName GetUserNameW ; + +! : GetWindowsAccountDomainSid ; +! : I_ScIsSecurityProcess ; +! : I_ScPnPGetServiceName ; +! : I_ScSendTSMessage ; +! : I_ScSetServiceBitsA ; +! : I_ScSetServiceBitsW ; +! : IdentifyCodeAuthzLevelW ; +! : ImpersonateAnonymousToken ; +! : ImpersonateLoggedOnUser ; +! : ImpersonateNamedPipeClient ; +! : ImpersonateSelf ; +! : InitializeAcl ; +! : InitializeSecurityDescriptor ; +! : InitializeSid ; +! : InitiateSystemShutdownA ; +! : InitiateSystemShutdownExA ; +! : InitiateSystemShutdownExW ; +! : InitiateSystemShutdownW ; +! : InstallApplication ; +! : IsTextUnicode ; +! : IsTokenRestricted ; +! : IsTokenUntrusted ; +! : IsValidAcl ; +! : IsValidSecurityDescriptor ; +! : IsValidSid ; +! : IsWellKnownSid ; +! : LockServiceDatabase ; +! : LogonUserA ; +! : LogonUserExA ; +! : LogonUserExW ; +! : LogonUserW ; +! : LookupAccountNameA ; +! : LookupAccountNameW ; +! : LookupAccountSidA ; +! : LookupAccountSidW ; +! : LookupPrivilegeDisplayNameA ; +! : LookupPrivilegeDisplayNameW ; +! : LookupPrivilegeNameA ; +! : LookupPrivilegeNameW ; +! : LookupPrivilegeValueA ; +FUNCTION: BOOL LookupPrivilegeValueW ( LPCTSTR lpSystemName, + LPCTSTR lpName, + PLUID lpLuid ) ; +: LookupPrivilegeValue LookupPrivilegeValueW ; + +! : LookupSecurityDescriptorPartsA ; +! : LookupSecurityDescriptorPartsW ; +! : LsaAddAccountRights ; +! : LsaAddPrivilegesToAccount ; +! : LsaClearAuditLog ; +! : LsaClose ; +! : LsaCreateAccount ; +! : LsaCreateSecret ; +! : LsaCreateTrustedDomain ; +! : LsaCreateTrustedDomainEx ; +! : LsaDelete ; +! : LsaDeleteTrustedDomain ; +! : LsaEnumerateAccountRights ; +! : LsaEnumerateAccounts ; +! : LsaEnumerateAccountsWithUserRight ; +! : LsaEnumeratePrivileges ; +! : LsaEnumeratePrivilegesOfAccount ; +! : LsaEnumerateTrustedDomains ; +! : LsaEnumerateTrustedDomainsEx ; +! : LsaFreeMemory ; +! : LsaGetQuotasForAccount ; +! : LsaGetRemoteUserName ; +! : LsaGetSystemAccessAccount ; +! : LsaGetUserName ; +! : LsaICLookupNames ; +! : LsaICLookupNamesWithCreds ; +! : LsaICLookupSids ; +! : LsaICLookupSidsWithCreds ; +! : LsaLookupNames2 ; +! : LsaLookupNames ; +! : LsaLookupPrivilegeDisplayName ; +! : LsaLookupPrivilegeName ; +! : LsaLookupPrivilegeValue ; +! : LsaLookupSids ; +! : LsaNtStatusToWinError ; +! : LsaOpenAccount ; +! : LsaOpenPolicy ; +! : LsaOpenPolicySce ; +! : LsaOpenSecret ; +! : LsaOpenTrustedDomain ; +! : LsaOpenTrustedDomainByName ; +! : LsaQueryDomainInformationPolicy ; +! : LsaQueryForestTrustInformation ; +! : LsaQueryInfoTrustedDomain ; +! : LsaQueryInformationPolicy ; +! : LsaQuerySecret ; +! : LsaQuerySecurityObject ; +! : LsaQueryTrustedDomainInfo ; +! : LsaQueryTrustedDomainInfoByName ; +! : LsaRemoveAccountRights ; +! : LsaRemovePrivilegesFromAccount ; +! : LsaRetrievePrivateData ; +! : LsaSetDomainInformationPolicy ; +! : LsaSetForestTrustInformation ; +! : LsaSetInformationPolicy ; +! : LsaSetInformationTrustedDomain ; +! : LsaSetQuotasForAccount ; +! : LsaSetSecret ; +! : LsaSetSecurityObject ; +! : LsaSetSystemAccessAccount ; +! : LsaSetTrustedDomainInfoByName ; +! : LsaSetTrustedDomainInformation ; +! : LsaStorePrivateData ; +! : MD4Final ; +! : MD4Init ; +! : MD4Update ; +! : MD5Final ; +! : MD5Init ; +! : MD5Update ; +! : MSChapSrvChangePassword2 ; +! : MSChapSrvChangePassword ; +! : MakeAbsoluteSD2 ; +! : MakeAbsoluteSD ; +! : MakeSelfRelativeSD ; +! : MapGenericMask ; +! : NotifyBootConfigStatus ; +! : NotifyChangeEventLog ; +! : ObjectCloseAuditAlarmA ; +! : ObjectCloseAuditAlarmW ; +! : ObjectDeleteAuditAlarmA ; +! : ObjectDeleteAuditAlarmW ; +! : ObjectOpenAuditAlarmA ; +! : ObjectOpenAuditAlarmW ; +! : ObjectPrivilegeAuditAlarmA ; +! : ObjectPrivilegeAuditAlarmW ; +! : OpenBackupEventLogA ; +! : OpenBackupEventLogW ; +! : OpenEncryptedFileRawA ; +! : OpenEncryptedFileRawW ; +! : OpenEventLogA ; +! : OpenEventLogW ; + +! typedef enum _TOKEN_INFORMATION_CLASS { +: TokenUser 1 ; +: TokenGroups 2 ; +: TokenPrivileges 3 ; +: TokenOwner 4 ; +: TokenPrimaryGroup 5 ; +: TokenDefaultDacl 6 ; +: TokenSource 7 ; +: TokenType 8 ; +: TokenImpersonationLevel 9 ; +: TokenStatistics 10 ; +: TokenRestrictedSids 11 ; +: TokenSessionId 12 ; +: TokenGroupsAndPrivileges 13 ; +: TokenSessionReference 14 ; +: TokenSandBoxInert 15 ; +! } TOKEN_INFORMATION_CLASS; + +: DELETE HEX: 00010000 ; inline +: READ_CONTROL HEX: 00020000 ; inline +: WRITE_DAC HEX: 00040000 ; inline +: WRITE_OWNER HEX: 00080000 ; inline +: SYNCHRONIZE HEX: 00100000 ; inline +: STANDARD_RIGHTS_REQUIRED HEX: 000f0000 ; inline + +: STANDARD_RIGHTS_READ READ_CONTROL ; inline +: STANDARD_RIGHTS_WRITE READ_CONTROL ; inline +: STANDARD_RIGHTS_EXECUTE READ_CONTROL ; inline + +: TOKEN_TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline +: TOKEN_ADJUST_GROUPS HEX: 0040 ; inline +: TOKEN_ADJUST_PRIVILEGES HEX: 0020 ; inline +: TOKEN_ADJUST_SESSIONID HEX: 0100 ; inline +: TOKEN_ASSIGN_PRIMARY HEX: 0001 ; inline +: TOKEN_DUPLICATE HEX: 0002 ; inline +: TOKEN_EXECUTE STANDARD_RIGHTS_EXECUTE ; inline +: TOKEN_IMPERSONATE HEX: 0004 ; inline +: TOKEN_QUERY HEX: 0008 ; inline +: TOKEN_QUERY_SOURCE HEX: 0010 ; inline +: TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline +: TOKEN_READ STANDARD_RIGHTS_READ TOKEN_QUERY bitor ; + +: TOKEN_WRITE + { + STANDARD_RIGHTS_WRITE + TOKEN_ADJUST_PRIVILEGES + TOKEN_ADJUST_GROUPS + TOKEN_ADJUST_DEFAULT + } flags ; foldable + +: TOKEN_ALL_ACCESS + { + STANDARD_RIGHTS_REQUIRED + TOKEN_ASSIGN_PRIMARY + TOKEN_DUPLICATE + TOKEN_IMPERSONATE + TOKEN_QUERY + TOKEN_QUERY_SOURCE + TOKEN_ADJUST_PRIVILEGES + TOKEN_ADJUST_GROUPS + TOKEN_ADJUST_SESSIONID + TOKEN_ADJUST_DEFAULT + } flags ; foldable + +FUNCTION: BOOL OpenProcessToken ( HANDLE ProcessHandle, + DWORD DesiredAccess, + PHANDLE TokenHandle ) ; +! : OpenSCManagerA ; +! : OpenSCManagerW ; +! : OpenServiceA ; +! : OpenServiceW ; +FUNCTION: BOOL OpenThreadToken ( HANDLE ThreadHandle, DWORD DesiredAccess, BOOL OpenAsSelf, PHANDLE TokenHandle ) ; +! : OpenTraceA ; +! : OpenTraceW ; +! : PrivilegeCheck ; +! : PrivilegedServiceAuditAlarmA ; +! : PrivilegedServiceAuditAlarmW ; +! : ProcessIdleTasks ; +! : ProcessTrace ; +! : QueryAllTracesA ; +! : QueryAllTracesW ; +! : QueryRecoveryAgentsOnEncryptedFile ; +! : QueryServiceConfig2A ; +! : QueryServiceConfig2W ; +! : QueryServiceConfigA ; +! : QueryServiceConfigW ; +! : QueryServiceLockStatusA ; +! : QueryServiceLockStatusW ; +! : QueryServiceObjectSecurity ; +! : QueryServiceStatus ; +! : QueryServiceStatusEx ; +! : QueryTraceA ; +! : QueryTraceW ; +! : QueryUsersOnEncryptedFile ; +! : QueryWindows31FilesMigration ; +! : ReadEncryptedFileRaw ; +! : ReadEventLogA ; +! : ReadEventLogW ; +! : RegCloseKey ; +! : RegConnectRegistryA ; +! : RegConnectRegistryW ; +! : RegCreateKeyA ; +! : RegCreateKeyExA ; +! : RegCreateKeyExW ; +! : RegCreateKeyW ; +! : RegDeleteKeyA ; +! : RegDeleteKeyW ; +! : RegDeleteValueA ; +! : RegDeleteValueW ; +! : RegDisablePredefinedCache ; +! : RegEnumKeyA ; +! : RegEnumKeyExA ; +! : RegEnumKeyExW ; +! : RegEnumKeyW ; +! : RegEnumValueA ; +! : RegEnumValueW ; +! : RegFlushKey ; +! : RegGetKeySecurity ; +! : RegLoadKeyA ; +! : RegLoadKeyW ; +! : RegNotifyChangeKeyValue ; +! : RegOpenCurrentUser ; +! : RegOpenKeyA ; +! : RegOpenKeyExA ; +! : RegOpenKeyExW ; +! : RegOpenKeyW ; +! : RegOpenUserClassesRoot ; +! : RegOverridePredefKey ; +! : RegQueryInfoKeyA ; +! : RegQueryInfoKeyW ; +! : RegQueryMultipleValuesA ; +! : RegQueryMultipleValuesW ; +! : RegQueryValueA ; +! : RegQueryValueExA ; +! : RegQueryValueExW ; +! : RegQueryValueW ; +! : RegReplaceKeyA ; +! : RegReplaceKeyW ; +! : RegRestoreKeyA ; +! : RegRestoreKeyW ; +! : RegSaveKeyA ; +! : RegSaveKeyExA ; +! : RegSaveKeyExW ; +! : RegSaveKeyW ; +! : RegSetKeySecurity ; +! : RegSetValueA ; +! : RegSetValueExA ; +! : RegSetValueExW ; +! : RegSetValueW ; +! : RegUnLoadKeyA ; +! : RegUnLoadKeyW ; +! : RegisterEventSourceA ; +! : RegisterEventSourceW ; +! : RegisterIdleTask ; +! : RegisterServiceCtrlHandlerA ; +! : RegisterServiceCtrlHandlerExA ; +! : RegisterServiceCtrlHandlerExW ; +! : RegisterServiceCtrlHandlerW ; +! : RegisterTraceGuidsA ; +! : RegisterTraceGuidsW ; +! : RemoveTraceCallback ; +! : RemoveUsersFromEncryptedFile ; +! : ReportEventA ; +! : ReportEventW ; +! : RevertToSelf ; +! : SaferCloseLevel ; +! : SaferComputeTokenFromLevel ; +! : SaferCreateLevel ; +! : SaferGetLevelInformation ; +! : SaferGetPolicyInformation ; +! : SaferIdentifyLevel ; +! : SaferRecordEventLogEntry ; +! : SaferSetLevelInformation ; +! : SaferSetPolicyInformation ; +! : SaferiChangeRegistryScope ; +! : SaferiCompareTokenLevels ; +! : SaferiIsExecutableFileType ; +! : SaferiPopulateDefaultsInRegistry ; +! : SaferiRecordEventLogEntry ; +! : SaferiReplaceProcessThreadTokens ; +! : SaferiSearchMatchingHashRules ; +! : SetAclInformation ; +! : SetEntriesInAccessListA ; +! : SetEntriesInAccessListW ; +! : SetEntriesInAclA ; +! : SetEntriesInAclW ; +! : SetEntriesInAuditListA ; +! : SetEntriesInAuditListW ; +! : SetFileSecurityA ; +! : SetFileSecurityW ; +! : SetInformationCodeAuthzLevelW ; +! : SetInformationCodeAuthzPolicyW ; +! : SetKernelObjectSecurity ; +! : SetNamedSecurityInfoA ; +! : SetNamedSecurityInfoExA ; +! : SetNamedSecurityInfoExW ; +! : SetNamedSecurityInfoW ; +! : SetPrivateObjectSecurity ; +! : SetPrivateObjectSecurityEx ; +! : SetSecurityDescriptorControl ; +! : SetSecurityDescriptorDacl ; +! : SetSecurityDescriptorGroup ; +! : SetSecurityDescriptorOwner ; +! : SetSecurityDescriptorRMControl ; +! : SetSecurityDescriptorSacl ; +! : SetSecurityInfo ; +! : SetSecurityInfoExA ; +! : SetSecurityInfoExW ; +! : SetServiceBits ; +! : SetServiceObjectSecurity ; +! : SetServiceStatus ; +! : SetThreadToken ; +! : SetTokenInformation ; +! : SetTraceCallback ; +! : SetUserFileEncryptionKey ; +! : StartServiceA ; +! : StartServiceCtrlDispatcherA ; +! : StartServiceCtrlDispatcherW ; +! : StartServiceW ; +! : StartTraceA ; +! : StartTraceW ; +! : StopTraceA ; +! : StopTraceW ; +! : SynchronizeWindows31FilesAndWindowsNTRegistry ; +! : SystemFunction001 ; +! : SystemFunction002 ; +! : SystemFunction003 ; +! : SystemFunction004 ; +! : SystemFunction005 ; +! : SystemFunction006 ; +! : SystemFunction007 ; +! : SystemFunction008 ; +! : SystemFunction009 ; +! : SystemFunction010 ; +! : SystemFunction011 ; +! : SystemFunction012 ; +! : SystemFunction013 ; +! : SystemFunction014 ; +! : SystemFunction015 ; +! : SystemFunction016 ; +! : SystemFunction017 ; +! : SystemFunction018 ; +! : SystemFunction019 ; +! : SystemFunction020 ; +! : SystemFunction021 ; +! : SystemFunction022 ; +! : SystemFunction023 ; +! : SystemFunction024 ; +! : SystemFunction025 ; +! : SystemFunction026 ; +! : SystemFunction027 ; +! : SystemFunction028 ; +! : SystemFunction029 ; +! : SystemFunction030 ; +! : SystemFunction031 ; +! : SystemFunction032 ; +! : SystemFunction033 ; +! : SystemFunction034 ; +! : SystemFunction035 ; +! : SystemFunction036 ; +! : SystemFunction040 ; +! : SystemFunction041 ; +! : TraceEvent ; +! : TraceEventInstance ; +! : TraceMessage ; +! : TraceMessageVa ; +! : TreeResetNamedSecurityInfoA ; +! : TreeResetNamedSecurityInfoW ; +! : TrusteeAccessToObjectA ; +! : TrusteeAccessToObjectW ; +! : UninstallApplication ; +! : UnlockServiceDatabase ; +! : UnregisterIdleTask ; +! : UnregisterTraceGuids ; +! : UpdateTraceA ; +! : UpdateTraceW ; +! : WdmWmiServiceMain ; +! : WmiCloseBlock ; +! : WmiCloseTraceWithCursor ; +! : WmiConvertTimestamp ; +! : WmiDevInstToInstanceNameA ; +! : WmiDevInstToInstanceNameW ; +! : WmiEnumerateGuids ; +! : WmiExecuteMethodA ; +! : WmiExecuteMethodW ; +! : WmiFileHandleToInstanceNameA ; +! : WmiFileHandleToInstanceNameW ; +! : WmiFreeBuffer ; +! : WmiGetFirstTraceOffset ; +! : WmiGetNextEvent ; +! : WmiGetTraceHeader ; +! : WmiMofEnumerateResourcesA ; +! : WmiMofEnumerateResourcesW ; +! : WmiNotificationRegistrationA ; +! : WmiNotificationRegistrationW ; +! : WmiOpenBlock ; +! : WmiOpenTraceWithCursor ; +! : WmiParseTraceEvent ; +! : WmiQueryAllDataA ; +! : WmiQueryAllDataMultipleA ; +! : WmiQueryAllDataMultipleW ; +! : WmiQueryAllDataW ; +! : WmiQueryGuidInformation ; +! : WmiQuerySingleInstanceA ; +! : WmiQuerySingleInstanceMultipleA ; +! : WmiQuerySingleInstanceMultipleW ; +! : WmiQuerySingleInstanceW ; +! : WmiReceiveNotificationsA ; +! : WmiReceiveNotificationsW ; +! : WmiSetSingleInstanceA ; +! : WmiSetSingleInstanceW ; +! : WmiSetSingleItemA ; +! : WmiSetSingleItemW ; +! : Wow64Win32ApiEntry ; +! : WriteEncryptedFileRaw ; + + diff --git a/extra/windows/types/types.factor b/extra/windows/types/types.factor index 7be8d98e61..61b409e8e1 100644 --- a/extra/windows/types/types.factor +++ b/extra/windows/types/types.factor @@ -113,6 +113,7 @@ TYPEDEF: HANDLE HSZ TYPEDEF: HANDLE WINSTA ! MS docs say typedef HANDLE WINSTA ; TYPEDEF: HANDLE HWINSTA ! typo?? TYPEDEF: HANDLE HWND +TYPEDEF: HANDLE HCRYPTPROV TYPEDEF: WORD LANGID TYPEDEF: DWORD LCID TYPEDEF: DWORD LCTYPE From c0f4e3742746573a5ae93df138cd80bf078ad4b6 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 27 Mar 2008 12:58:53 +1300 Subject: [PATCH 098/219] Fix usage of cache in pegs --- extra/peg/peg.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 44a762cec2..dd0b11fce3 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -25,7 +25,7 @@ GENERIC: (compile) ( parser -- quot ) quot c [ drop H{ } clone ] cache [ drop input quot call - ] cache* ; inline + ] cache ; inline : run-parser ( input quot -- result ) #! If a packrat cache is available, use memoization for From 4684c9cacc1c740d908510e327946b2d7bcff8a0 Mon Sep 17 00:00:00 2001 From: erg Date: Wed, 26 Mar 2008 19:40:40 -0500 Subject: [PATCH 099/219] work on normalize-pathname add two failing unit tests --- core/io/backend/backend.factor | 2 -- core/io/files/files-tests.factor | 17 +++++++++++++++-- core/io/files/files.factor | 3 +++ 3 files changed, 18 insertions(+), 4 deletions(-) diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 1595ecd576..8cfcbb71de 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -21,8 +21,6 @@ M: object normalize-directory ; HOOK: normalize-pathname io-backend ( str -- newstr ) -M: object normalize-pathname ; - : set-io-backend ( io-backend -- ) io-backend set-global init-io init-stdio ; diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 36b32ea34c..51bf79e29c 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -1,6 +1,7 @@ IN: io.files.tests -USING: tools.test io.files io threads kernel continuations io.encodings.ascii -io.files.unique sequences strings accessors ; +USING: tools.test io.files io threads kernel continuations +io.encodings.ascii io.files.unique sequences strings accessors +io.encodings.utf8 ; [ ] [ "blahblah" temp-file dup exists? [ delete-directory ] [ drop ] if ] unit-test [ ] [ "blahblah" temp-file make-directory ] unit-test @@ -130,6 +131,18 @@ io.files.unique sequences strings accessors ; [ t ] [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test +[ t ] [ + temp-directory [ "hi" "test41" utf8 set-file-contents ] with-directory + temp-directory "test41" append-path utf8 file-contents "hi41" = +] unit-test + +[ t ] [ + temp-directory [ + "test43" utf8 [ "hi43" write ] with-stream + ] with-directory + temp-directory "test43" append-path utf8 file-contents "hi43" = +] unit-test + [ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test [ ] [ "append-test" temp-file ascii dispose ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 6500bdb387..64d8e25ee2 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -272,6 +272,9 @@ DEFER: copy-tree-into : temp-file ( name -- path ) temp-directory prepend-path ; +M: object normalize-pathname ( path -- path' ) + current-directory get prepend-path ; + ! Pathname presentations TUPLE: pathname string ; From e2f3888389e846843ff8bab2e1cec0f6cd589303 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 26 Mar 2008 20:42:24 -0500 Subject: [PATCH 100/219] UI listener fix --- extra/ui/gadgets/scrollers/scrollers.factor | 5 +++-- extra/ui/tools/listener/listener.factor | 15 +++++++++++++-- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor index 98951b74e3..7966f4e206 100755 --- a/extra/ui/gadgets/scrollers/scrollers.factor +++ b/extra/ui/gadgets/scrollers/scrollers.factor @@ -3,13 +3,14 @@ USING: arrays ui.gadgets ui.gadgets.viewports ui.gadgets.frames ui.gadgets.grids ui.gadgets.theme ui.gadgets.sliders ui.gestures kernel math -namespaces sequences models combinators math.vectors ; +namespaces sequences models combinators math.vectors +tuples ; IN: ui.gadgets.scrollers TUPLE: scroller viewport x y follows ; : find-scroller ( gadget -- scroller/f ) - [ scroller? ] find-parent ; + [ [ scroller? ] is? ] find-parent ; : scroll-up-page scroller-y -1 swap slide-by-page ; diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor index 75401b3861..7db0d63f45 100755 --- a/extra/ui/tools/listener/listener.factor +++ b/extra/ui/tools/listener/listener.factor @@ -6,7 +6,8 @@ kernel models namespaces parser quotations sequences ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.labelled ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.operations vocabs words -prettyprint listener debugger threads boxes concurrency.flags ; +prettyprint listener debugger threads boxes concurrency.flags +math arrays ; IN: ui.tools.listener TUPLE: listener-gadget input output stack ; @@ -23,9 +24,19 @@ TUPLE: listener-gadget input output stack ; : ( listener -- gadget ) listener-gadget-output ; +TUPLE: input-scroller ; + +: ( interactor -- scroller ) + + input-scroller construct-empty + [ set-gadget-delegate ] keep ; + +M: input-scroller pref-dim* + drop { 0 100 } ; + : listener-input, ( -- ) g g-> set-listener-gadget-input - "Input" f track, ; + "Input" f track, ; : welcome. ( -- ) "If this is your first time with Factor, please read the " print From e6da3bc43a66f23b75586c4b320208fed4c59579 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 27 Mar 2008 14:55:14 +1300 Subject: [PATCH 101/219] Use cache in compiled-parser in peg --- extra/peg/peg.factor | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index dd0b11fce3..fe58962f48 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -16,7 +16,6 @@ SYMBOL: ignore SYMBOL: compiled-parsers SYMBOL: packrat -SYMBOL: failed GENERIC: (compile) ( parser -- quot ) @@ -36,12 +35,9 @@ GENERIC: (compile) ( parser -- quot ) #! Look to see if the given parser has been compiled. #! If not, compile it to a temporary word, cache it, #! and return it. Otherwise return the existing one. - dup compiled-parsers get at [ - nip - ] [ - dup (compile) [ run-parser ] curry define-temp - [ swap compiled-parsers get set-at ] keep - ] if* ; + compiled-parsers get [ + (compile) [ run-parser ] curry define-temp + ] cache ; : compile ( parser -- word ) H{ } clone compiled-parsers [ From 7c0535884eeb8d770ad0d09a18221d1438c7b2e4 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 27 Mar 2008 15:21:38 +1300 Subject: [PATCH 102/219] Fix up peg memoization of compiled parsers --- extra/peg/peg.factor | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index fe58962f48..c994c5aa29 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -14,9 +14,14 @@ SYMBOL: ignore : ( remaining ast -- parse-result ) parse-result construct-boa ; -SYMBOL: compiled-parsers SYMBOL: packrat +: compiled-parsers ( -- cache ) + \ compiled-parsers get-global [ H{ } clone dup \ compiled-parsers set-global ] unless* ; + +: reset-compiled-parsers ( -- ) + H{ } clone \ compiled-parsers set-global ; + GENERIC: (compile) ( parser -- quot ) :: run-packrat-parser ( input quot c -- result ) @@ -35,14 +40,12 @@ GENERIC: (compile) ( parser -- quot ) #! Look to see if the given parser has been compiled. #! If not, compile it to a temporary word, cache it, #! and return it. Otherwise return the existing one. - compiled-parsers get [ + compiled-parsers [ (compile) [ run-parser ] curry define-temp ] cache ; : compile ( parser -- word ) - H{ } clone compiled-parsers [ - [ compiled-parser ] with-compilation-unit - ] with-variable ; + [ compiled-parser ] with-compilation-unit ; : parse ( state parser -- result ) compile execute ; From 708726d20838833899ce7ddfb9aae19efa10bc1a Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 27 Mar 2008 15:50:27 +1300 Subject: [PATCH 103/219] Add with-packrat word and more memoization --- extra/peg/parsers/parsers.factor | 17 ++++----- extra/peg/peg-docs.factor | 31 ++++++++++++++++- extra/peg/peg.factor | 60 ++++++++++++++++++++------------ 3 files changed, 77 insertions(+), 31 deletions(-) diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor index 13509e81f7..fa6801dc1c 100755 --- a/extra/peg/parsers/parsers.factor +++ b/extra/peg/parsers/parsers.factor @@ -3,10 +3,11 @@ USING: kernel sequences strings namespaces math assocs shuffle vectors arrays combinators.lib math.parser match unicode.categories sequences.deep peg peg.private - peg.search math.ranges words ; + peg.search math.ranges words memoize ; IN: peg.parsers TUPLE: just-parser p1 ; +M: just-parser equal? 2drop f ; : just-pattern [ @@ -19,7 +20,7 @@ TUPLE: just-parser p1 ; M: just-parser (compile) ( parser -- quot ) just-parser-p1 compiled-parser just-pattern curry ; -: just ( parser -- parser ) +MEMO: just ( parser -- parser ) just-parser construct-boa ; : 1token ( ch -- parser ) 1string token ; @@ -47,10 +48,10 @@ PRIVATE> PRIVATE> -: exactly-n ( parser n -- parser' ) +MEMO: exactly-n ( parser n -- parser' ) swap seq ; -: at-most-n ( parser n -- parser' ) +MEMO: at-most-n ( parser n -- parser' ) dup zero? [ 2drop epsilon ] [ @@ -58,15 +59,15 @@ PRIVATE> -rot 1- at-most-n 2choice ] if ; -: at-least-n ( parser n -- parser' ) +MEMO: at-least-n ( parser n -- parser' ) dupd exactly-n swap repeat0 2seq [ flatten-vectors ] action ; -: from-m-to-n ( parser m n -- parser' ) +MEMO: from-m-to-n ( parser m n -- parser' ) >r [ exactly-n ] 2keep r> swap - at-most-n 2seq [ flatten-vectors ] action ; -: pack ( begin body end -- parser ) +MEMO: pack ( begin body end -- parser ) >r >r hide r> r> hide 3seq [ first ] action ; : surrounded-by ( parser begin end -- parser' ) @@ -83,7 +84,7 @@ PRIVATE> [ CHAR: " = ] satisfy hide , [ CHAR: " = not ] satisfy repeat0 , [ CHAR: " = ] satisfy hide , - ] { } make seq [ first >string ] action ; + ] seq* [ first >string ] action ; : (range-pattern) ( pattern -- string ) #! Given a range pattern, produce a string containing diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor index 9ad375ea04..30e7f0e72f 100644 --- a/extra/peg/peg-docs.factor +++ b/extra/peg/peg-docs.factor @@ -11,7 +11,36 @@ HELP: parse } { $description "Given the input string, parse it using the given parser. The result is a object if " - "the parse was successful, otherwise it is f." } ; + "the parse was successful, otherwise it is f." } +{ $see-also compile with-packrat } ; + +HELP: with-packrat +{ $values + { "quot" "a quotation with stack effect ( input -- result )" } + { "result" "the result of the quotation" } +} +{ $description + "Calls the quotation with a packrat cache in scope. Usually the quotation will " + "call " { $link parse } " or call a word produced by " { $link compile } "." + "The cache is used to avoid the possible exponential time performace that pegs " + "can have, instead giving linear time at the cost of increased memory usage." } +{ $see-also compile parse } ; + +HELP: compile +{ $values + { "parser" "a parser" } + { "word" "a word" } +} +{ $description + "Compile the parser to a word. The word will have stack effect ( input -- result )." + "The mapping from parser to compiled word is kept in a cache. If you later change " + "the definition of a parser you'll need to clear this cache with " + { $link reset-compiled-parsers } " before using " { $link compile } " on that parser again." } +{ $see-also compile with-packrat reset-compiled-parsers } ; + +HELP: reset-compiled-parsers +{ $description + "Reset the cache mapping parsers to compiled words." } ; HELP: token { $values diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index c994c5aa29..10c9ce907d 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -50,10 +50,14 @@ GENERIC: (compile) ( parser -- quot ) : parse ( state parser -- result ) compile execute ; +: with-packrat ( quot -- result ) + #! Run the quotation with a packrat cache active. + [ H{ } clone packrat ] dip with-variable ; + > [ parse-token ] curry ; TUPLE: satisfy-parser quot ; +M: satisfy-parser equal? 2drop f ; MATCH-VARS: ?quot ; @@ -89,6 +94,7 @@ M: satisfy-parser (compile) ( parser -- quot ) quot>> \ ?quot satisfy-pattern match-replace ; TUPLE: range-parser min max ; +M: range-parser equal? 2drop f ; MATCH-VARS: ?min ?max ; @@ -110,6 +116,7 @@ M: range-parser (compile) ( parser -- quot ) T{ range-parser _ ?min ?max } range-pattern match-replace ; TUPLE: seq-parser parsers ; +M: seq-parser equal? 2drop f ; : seq-pattern ( -- quot ) [ @@ -136,6 +143,7 @@ M: seq-parser (compile) ( parser -- quot ) ] [ ] make ; TUPLE: choice-parser parsers ; +M: choice-parser equal? 2drop f ; : choice-pattern ( -- quot ) [ @@ -154,6 +162,7 @@ M: choice-parser (compile) ( parser -- quot ) ] [ ] make ; TUPLE: repeat0-parser p1 ; +M: repeat0-parser equal? 2drop f ; : (repeat0) ( quot result -- result ) 2dup remaining>> swap call [ @@ -176,6 +185,7 @@ M: repeat0-parser (compile) ( parser -- quot ) ] [ ] make ; TUPLE: repeat1-parser p1 ; +M: repeat1-parser equal? 2drop f ; : repeat1-pattern ( -- quot ) [ @@ -195,6 +205,7 @@ M: repeat1-parser (compile) ( parser -- quot ) ] [ ] make ; TUPLE: optional-parser p1 ; +M: optional-parser equal? 2drop f ; : optional-pattern ( -- quot ) [ @@ -205,6 +216,7 @@ M: optional-parser (compile) ( parser -- quot ) p1>> compiled-parser \ ?quot optional-pattern match-replace ; TUPLE: ensure-parser p1 ; +M: ensure-parser equal? 2drop f ; : ensure-pattern ( -- quot ) [ @@ -219,6 +231,7 @@ M: ensure-parser (compile) ( parser -- quot ) p1>> compiled-parser \ ?quot ensure-pattern match-replace ; TUPLE: ensure-not-parser p1 ; +M: ensure-not-parser equal? 2drop f ; : ensure-not-pattern ( -- quot ) [ @@ -233,6 +246,7 @@ M: ensure-not-parser (compile) ( parser -- quot ) p1>> compiled-parser \ ?quot ensure-not-pattern match-replace ; TUPLE: action-parser p1 quot ; +M: action-parser equal? 2drop f ; MATCH-VARS: ?action ; @@ -256,6 +270,7 @@ M: action-parser (compile) ( parser -- quot ) ] unless ; TUPLE: sp-parser p1 ; +M: sp-parser equal? 2drop f ; M: sp-parser (compile) ( parser -- quot ) [ @@ -263,6 +278,7 @@ M: sp-parser (compile) ( parser -- quot ) ] [ ] make ; TUPLE: delay-parser quot ; +M: delay-parser equal? 2drop f ; M: delay-parser (compile) ( parser -- quot ) #! For efficiency we memoize the quotation. @@ -276,70 +292,70 @@ M: delay-parser (compile) ( parser -- quot ) PRIVATE> -: token ( string -- parser ) +MEMO: token ( string -- parser ) token-parser construct-boa ; -: satisfy ( quot -- parser ) +MEMO: satisfy ( quot -- parser ) satisfy-parser construct-boa ; -: range ( min max -- parser ) +MEMO: range ( min max -- parser ) range-parser construct-boa ; -: seq ( seq -- parser ) +MEMO: seq ( seq -- parser ) seq-parser construct-boa ; -: 2seq ( parser1 parser2 -- parser ) +MEMO: 2seq ( parser1 parser2 -- parser ) 2array seq ; -: 3seq ( parser1 parser2 parser3 -- parser ) +MEMO: 3seq ( parser1 parser2 parser3 -- parser ) 3array seq ; -: 4seq ( parser1 parser2 parser3 parser4 -- parser ) +MEMO: 4seq ( parser1 parser2 parser3 parser4 -- parser ) 4array seq ; -: seq* ( quot -- paser ) +MEMO: seq* ( quot -- paser ) { } make seq ; inline -: choice ( seq -- parser ) +MEMO: choice ( seq -- parser ) choice-parser construct-boa ; -: 2choice ( parser1 parser2 -- parser ) +MEMO: 2choice ( parser1 parser2 -- parser ) 2array choice ; -: 3choice ( parser1 parser2 parser3 -- parser ) +MEMO: 3choice ( parser1 parser2 parser3 -- parser ) 3array choice ; -: 4choice ( parser1 parser2 parser3 parser4 -- parser ) +MEMO: 4choice ( parser1 parser2 parser3 parser4 -- parser ) 4array choice ; -: choice* ( quot -- paser ) +MEMO: choice* ( quot -- paser ) { } make choice ; inline -: repeat0 ( parser -- parser ) +MEMO: repeat0 ( parser -- parser ) repeat0-parser construct-boa ; -: repeat1 ( parser -- parser ) +MEMO: repeat1 ( parser -- parser ) repeat1-parser construct-boa ; -: optional ( parser -- parser ) +MEMO: optional ( parser -- parser ) optional-parser construct-boa ; -: ensure ( parser -- parser ) +MEMO: ensure ( parser -- parser ) ensure-parser construct-boa ; -: ensure-not ( parser -- parser ) +MEMO: ensure-not ( parser -- parser ) ensure-not-parser construct-boa ; -: action ( parser quot -- parser ) +MEMO: action ( parser quot -- parser ) action-parser construct-boa ; -: sp ( parser -- parser ) +MEMO: sp ( parser -- parser ) sp-parser construct-boa ; : hide ( parser -- parser ) [ drop ignore ] action ; -: delay ( quot -- parser ) +MEMO: delay ( quot -- parser ) delay-parser construct-boa ; : PEG: From bc5f82255fbdeeb11f3b3cfef555856ec2dcb8cf Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 27 Mar 2008 17:24:05 +1300 Subject: [PATCH 104/219] peg refactorings --- extra/peg/peg.factor | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 10c9ce907d..0ae2aba2ee 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -24,8 +24,13 @@ SYMBOL: packrat GENERIC: (compile) ( parser -- quot ) +: input-from ( input -- n ) + #! Return the index from the original string that the + #! input slice is based on. + dup slice? [ slice-from ] [ drop 0 ] if ; + :: run-packrat-parser ( input quot c -- result ) - input slice? [ input slice-from ] [ 0 ] if + input input-from quot c [ drop H{ } clone ] cache [ drop input quot call From 4c50daed2213b9442954aec3a38abb51586fd05c Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 27 Mar 2008 17:45:59 +1300 Subject: [PATCH 105/219] Testcase for packrat behaviour --- extra/peg/peg-tests.factor | 20 ++++++++++++++++++++ extra/peg/peg.factor | 18 ++++++++++++++---- 2 files changed, 34 insertions(+), 4 deletions(-) diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index 89cc243863..bd4699f097 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -158,3 +158,23 @@ IN: peg.tests "a]" "[" token hide "a" token "]" token hide 3array seq parse ] unit-test + +{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [ + [ + [ "1" token , "-" token , "1" token , ] seq* , + [ "1" token , "+" token , "1" token , ] seq* , + ] choice* + "1-1" over parse parse-result-ast swap + "1+1" swap parse parse-result-ast +] unit-test + +{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [ + [ + [ + [ "1" token , "-" token , "1" token , ] seq* , + [ "1" token , "+" token , "1" token , ] seq* , + ] choice* + "1-1" over parse parse-result-ast swap + "1+1" swap parse parse-result-ast + ] with-packrat +] unit-test \ No newline at end of file diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 0ae2aba2ee..bbd55ec6fa 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -29,12 +29,22 @@ GENERIC: (compile) ( parser -- quot ) #! input slice is based on. dup slice? [ slice-from ] [ drop 0 ] if ; +: input-cache ( quot cache -- cache ) + #! From the packrat cache, obtain the cache for the parser quotation + #! that maps the input string position to the parser result. + [ drop H{ } clone ] cache ; + +: cached-result ( n input-cache input quot -- result ) + #! Get the cached result for input position n + #! from the input cache. If the item is not in the cache, + #! call 'quot' with 'input' on the stack to get the result + #! and store that in the cache and return it. + [ nip ] swap compose curry cache ; inline + :: run-packrat-parser ( input quot c -- result ) input input-from - quot c [ drop H{ } clone ] cache - [ - drop input quot call - ] cache ; inline + quot c input-cache + input quot cached-result ; inline : run-parser ( input quot -- result ) #! If a packrat cache is available, use memoization for From 4e29081e93aadb902ebbcc27d9c2049d73434adb Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 27 Mar 2008 18:07:30 +1300 Subject: [PATCH 106/219] Make left recursion in pegs a failed parse Eventually left recursion will work fine, but this is prevents an infinite loop for now. --- extra/peg/peg-tests.factor | 4 +++- extra/peg/peg.factor | 4 ++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index bd4699f097..bd8abb63e6 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -175,6 +175,8 @@ IN: peg.tests [ "1" token , "+" token , "1" token , ] seq* , ] choice* "1-1" over parse parse-result-ast swap - "1+1" swap parse parse-result-ast ] with-packrat + [ + "1+1" swap parse parse-result-ast + ] with-packrat ] unit-test \ No newline at end of file diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index bbd55ec6fa..1361f9fdbd 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -34,12 +34,12 @@ GENERIC: (compile) ( parser -- quot ) #! that maps the input string position to the parser result. [ drop H{ } clone ] cache ; -: cached-result ( n input-cache input quot -- result ) +:: cached-result ( n input-cache input quot -- result ) #! Get the cached result for input position n #! from the input cache. If the item is not in the cache, #! call 'quot' with 'input' on the stack to get the result #! and store that in the cache and return it. - [ nip ] swap compose curry cache ; inline + n input-cache [ drop input quot call ] cache ; inline :: run-packrat-parser ( input quot c -- result ) input input-from From cb3fdc5c7d6e55a6914ba40298c9badc1c70fe96 Mon Sep 17 00:00:00 2001 From: erg Date: Fri, 28 Mar 2008 21:40:02 -0500 Subject: [PATCH 107/219] fix the Makefile and make targets --- Makefile | 7 +-- {misc => build-support}/factor.sh | 81 ++++++++++++++++--------------- build-support/target | 38 --------------- build-support/wordsize.c | 8 --- 4 files changed, 44 insertions(+), 90 deletions(-) rename {misc => build-support}/factor.sh (87%) delete mode 100755 build-support/target delete mode 100644 build-support/wordsize.c diff --git a/Makefile b/Makefile index ecb333a0b2..7bced81e47 100755 --- a/Makefile +++ b/Makefile @@ -45,8 +45,8 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ EXE_OBJS = $(PLAF_EXE_OBJS) -default: build-support/wordsize - $(MAKE) `./build-support/target` +default: + $(MAKE) `./misc/factor.sh make-target` help: @echo "Run '$(MAKE)' with one of the following parameters:" @@ -162,9 +162,6 @@ factor: $(DLL_OBJS) $(EXE_OBJS) $(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ $(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS) -build-support/wordsize: build-support/wordsize.c - gcc build-support/wordsize.c -o build-support/wordsize - clean: rm -f vm/*.o rm -f factor*.dll libfactor*.* diff --git a/misc/factor.sh b/build-support/factor.sh similarity index 87% rename from misc/factor.sh rename to build-support/factor.sh index 09531350f3..d2a94b8a17 100755 --- a/misc/factor.sh +++ b/build-support/factor.sh @@ -7,6 +7,7 @@ set +e shopt -s nocaseglob #shopt -s nocasematch +ECHO=echo OS= ARCH= WORD= @@ -25,23 +26,23 @@ ensure_program_installed() { installed=0; for i in $* ; do - echo -n "Checking for $i..." + $ECHO -n "Checking for $i..." test_program_installed $i if [[ $? -eq 0 ]]; then echo -n "not " else installed=$(( $installed + 1 )) fi - echo "found!" + $ECHO "found!" done if [[ $installed -eq 0 ]] ; then - echo -n "Install " + $ECHO -n "Install " if [[ $# -eq 1 ]] ; then - echo -n $1 + $ECHO -n $1 else - echo -n "any of [ $* ]" + $ECHO -n "any of [ $* ]" fi - echo " and try again." + $ECHO " and try again." exit 1 fi } @@ -49,22 +50,22 @@ ensure_program_installed() { check_ret() { RET=$? if [[ $RET -ne 0 ]] ; then - echo $1 failed + $ECHO $1 failed exit 2 fi } check_gcc_version() { - echo -n "Checking gcc version..." + $ECHO -n "Checking gcc version..." GCC_VERSION=`$CC --version` check_ret gcc if [[ $GCC_VERSION == *3.3.* ]] ; then - echo "bad!" - echo "You have a known buggy version of gcc (3.3)" - echo "Install gcc 3.4 or higher and try again." + $ECHO "bad!" + $ECHO "You have a known buggy version of gcc (3.3)" + $ECHO "Install gcc 3.4 or higher and try again." exit 3 fi - echo "ok." + $ECHO "ok." } set_downloader() { @@ -125,20 +126,20 @@ check_installed_programs() { check_library_exists() { GCC_TEST=factor-library-test.c GCC_OUT=factor-library-test.out - echo -n "Checking for library $1..." - echo "int main(){return 0;}" > $GCC_TEST + $ECHO -n "Checking for library $1..." + $ECHO "int main(){return 0;}" > $GCC_TEST $CC $GCC_TEST -o $GCC_OUT -l $1 if [[ $? -ne 0 ]] ; then - echo "not found!" - echo "Warning: library $1 not found." - echo "***Factor will compile NO_UI=1" + $ECHO "not found!" + $ECHO "Warning: library $1 not found." + $ECHO "***Factor will compile NO_UI=1" NO_UI=1 fi rm -f $GCC_TEST check_ret rm rm -f $GCC_OUT check_ret rm - echo "found." + $ECHO "found." } check_X11_libraries() { @@ -156,14 +157,14 @@ check_libraries() { check_factor_exists() { if [[ -d "factor" ]] ; then - echo "A directory called 'factor' already exists." - echo "Rename or delete it and try again." + $ECHO "A directory called 'factor' already exists." + $ECHO "Rename or delete it and try again." exit 4 fi } find_os() { - echo "Finding OS..." + $ECHO "Finding OS..." uname_s=`uname -s` check_ret uname case $uname_s in @@ -182,7 +183,7 @@ find_os() { } find_architecture() { - echo "Finding ARCH..." + $ECHO "Finding ARCH..." uname_m=`uname -m` check_ret uname case $uname_m in @@ -201,7 +202,7 @@ write_test_program() { } find_word_size() { - echo "Finding WORD..." + $ECHO "Finding WORD..." C_WORD=factor-word-size write_test_program gcc -o $C_WORD $C_WORD.c @@ -219,26 +220,26 @@ set_factor_binary() { } echo_build_info() { - echo OS=$OS - echo ARCH=$ARCH - echo WORD=$WORD - echo FACTOR_BINARY=$FACTOR_BINARY - echo MAKE_TARGET=$MAKE_TARGET - echo BOOT_IMAGE=$BOOT_IMAGE - echo MAKE_IMAGE_TARGET=$MAKE_IMAGE_TARGET - echo GIT_PROTOCOL=$GIT_PROTOCOL - echo GIT_URL=$GIT_URL - echo DOWNLOADER=$DOWNLOADER - echo CC=$CC - echo MAKE=$MAKE + $ECHO OS=$OS + $ECHO ARCH=$ARCH + $ECHO WORD=$WORD + $ECHO FACTOR_BINARY=$FACTOR_BINARY + $ECHO MAKE_TARGET=$MAKE_TARGET + $ECHO BOOT_IMAGE=$BOOT_IMAGE + $ECHO MAKE_IMAGE_TARGET=$MAKE_IMAGE_TARGET + $ECHO GIT_PROTOCOL=$GIT_PROTOCOL + $ECHO GIT_URL=$GIT_URL + $ECHO DOWNLOADER=$DOWNLOADER + $ECHO CC=$CC + $ECHO MAKE=$MAKE } set_build_info() { if ! [[ -n $OS && -n $ARCH && -n $WORD ]] ; then - echo "OS: $OS" - echo "ARCH: $ARCH" - echo "WORD: $WORD" - echo "OS, ARCH, or WORD is empty. Please report this" + $ECHO "OS: $OS" + $ECHO "ARCH: $ARCH" + $ECHO "WORD: $WORD" + $ECHO "OS, ARCH, or WORD is empty. Please report this" exit 5 fi @@ -452,5 +453,7 @@ case "$1" in bootstrap) get_config_info; bootstrap ;; dlls) get_config_info; maybe_download_dlls;; net-bootstrap) get_config_info; update_boot_images; bootstrap ;; + #make-target) ECHO=`echo #`; find_build_info; echo $MAKE_TARGET ;; + make-target) ECHO=false; find_build_info; echo $MAKE_TARGET ;; *) usage ;; esac diff --git a/build-support/target b/build-support/target deleted file mode 100755 index ffb677b681..0000000000 --- a/build-support/target +++ /dev/null @@ -1,38 +0,0 @@ -#!/usr/bin/env bash - -uname_s=`uname -s` -case $uname_s in - CYGWIN_NT-5.2-WOW64) OS=winnt;; - *CYGWIN_NT*) OS=winnt;; - *CYGWIN*) OS=winnt;; - *darwin*) OS=macosx;; - *Darwin*) OS=macosx;; - *linux*) OS=linux;; - *Linux*) OS=linux;; - *NetBSD*) OS=netbsd;; - *FreeBSD*) OS=freebsd;; - *OpenBSD*) OS=openbsd;; - *DragonFly*) OS=dragonflybsd;; -esac - -uname_m=`uname -m` -case $uname_m in - i386) ARCH=x86;; - i686) ARCH=x86;; - amd64) ARCH=x86;; - *86) ARCH=x86;; - *86_64) ARCH=x86;; - "Power Macintosh") ARCH=ppc;; -esac - -WORD=`./build-support/wordsize` - -MAKE_TARGET=$OS-$ARCH-$WORD -if [[ $OS == macosx && $ARCH == ppc ]] ; then - MAKE_TARGET=$OS-$ARCH -fi -if [[ $OS == linux && $ARCH == ppc ]] ; then - MAKE_TARGET=$OS-$ARCH -fi - -echo $MAKE_TARGET diff --git a/build-support/wordsize.c b/build-support/wordsize.c deleted file mode 100644 index a0e7d0b9c0..0000000000 --- a/build-support/wordsize.c +++ /dev/null @@ -1,8 +0,0 @@ - -#include - -int main () -{ - printf("%d", 8*sizeof(void*)); - return 0; -} From 4feebaa8e8f2f5d4de3a1d28c1ff0679e542b412 Mon Sep 17 00:00:00 2001 From: erg Date: Fri, 28 Mar 2008 21:42:19 -0500 Subject: [PATCH 108/219] remove dead code --- build-support/factor.sh | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/build-support/factor.sh b/build-support/factor.sh index d2a94b8a17..476e885257 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -438,7 +438,7 @@ install_build_system_port() { } usage() { - echo "usage: $0 install|install-x11|install-macosx|self-update|quick-update|update|bootstrap|net-bootstrap" + echo "usage: $0 install|install-x11|install-macosx|self-update|quick-update|update|bootstrap|net-bootstrap|make-target" echo "If you are behind a firewall, invoke as:" echo "env GIT_PROTOCOL=http $0 " } @@ -453,7 +453,6 @@ case "$1" in bootstrap) get_config_info; bootstrap ;; dlls) get_config_info; maybe_download_dlls;; net-bootstrap) get_config_info; update_boot_images; bootstrap ;; - #make-target) ECHO=`echo #`; find_build_info; echo $MAKE_TARGET ;; make-target) ECHO=false; find_build_info; echo $MAKE_TARGET ;; *) usage ;; esac From 37cffc50fa5037b5ff6da39983ecc60fc7e89bc8 Mon Sep 17 00:00:00 2001 From: erg Date: Fri, 28 Mar 2008 22:10:01 -0500 Subject: [PATCH 109/219] fix random add with-secure-random --- extra/random/backend/backend.factor | 24 ++++++++++++ extra/random/dummy/dummy.factor | 2 +- .../mersenne-twister-tests.factor | 2 +- .../mersenne-twister/mersenne-twister.factor | 3 +- extra/random/random-tests.factor | 5 +++ extra/random/random.factor | 38 +++++++++---------- extra/random/unix/unix.factor | 23 ++++++----- .../cryptographic/cryptographic.factor | 28 -------------- extra/random/windows/windows.factor | 30 ++++++++++++++- 9 files changed, 91 insertions(+), 64 deletions(-) create mode 100755 extra/random/backend/backend.factor create mode 100644 extra/random/random-tests.factor delete mode 100644 extra/random/windows/cryptographic/cryptographic.factor diff --git a/extra/random/backend/backend.factor b/extra/random/backend/backend.factor new file mode 100755 index 0000000000..c5243c22bd --- /dev/null +++ b/extra/random/backend/backend.factor @@ -0,0 +1,24 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types kernel math namespaces sequences +io.backend io.binary combinators system vocabs.loader ; +IN: random.backend + +SYMBOL: insecure-random-generator +SYMBOL: secure-random-generator +SYMBOL: random-generator + +GENERIC: seed-random ( tuple seed -- ) +GENERIC: random-32* ( tuple -- r ) +GENERIC: random-bytes* ( n tuple -- bytes ) + +M: object random-bytes* ( n tuple -- byte-array ) + swap [ drop random-32* ] with map >c-uint-array ; + +M: object random-32* ( tuple -- n ) 4 random-bytes* le> ; + +ERROR: no-random-number-generator ; + +M: f random-bytes* ( n obj -- * ) no-random-number-generator ; + +M: f random-32* ( obj -- * ) no-random-number-generator ; diff --git a/extra/random/dummy/dummy.factor b/extra/random/dummy/dummy.factor index 9120381955..a17ef54982 100755 --- a/extra/random/dummy/dummy.factor +++ b/extra/random/dummy/dummy.factor @@ -1,4 +1,4 @@ -USING: kernel random math accessors ; +USING: kernel random math accessors random.backend ; IN: random.dummy TUPLE: random-dummy i ; diff --git a/extra/random/mersenne-twister/mersenne-twister-tests.factor b/extra/random/mersenne-twister/mersenne-twister-tests.factor index 703a0c16e4..9eb546063e 100755 --- a/extra/random/mersenne-twister/mersenne-twister-tests.factor +++ b/extra/random/mersenne-twister/mersenne-twister-tests.factor @@ -1,5 +1,5 @@ USING: kernel math random namespaces random.mersenne-twister -sequences tools.test ; +sequences tools.test random.backend ; IN: random.mersenne-twister.tests : check-random ( max -- ? ) diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index 53ec91b118..f43ef9f852 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -4,7 +4,8 @@ ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c USING: arrays kernel math namespaces sequences system init -accessors math.ranges combinators.cleave random new-effects ; +accessors math.ranges combinators.cleave random new-effects +random.backend ; IN: random.mersenne-twister c-uint-array ; - -M: object random-32* ( tuple -- n ) - 4 random-bytes* le> ; - : random-bytes ( n -- r ) [ - 4 /mod zero? [ 1+ ] unless - random-generator get swap random-bytes* + dup 4 rem zero? [ 1+ ] unless + random-generator get random-bytes* ] keep head ; : random ( seq -- elt ) @@ -41,3 +26,16 @@ M: object random-32* ( tuple -- n ) : with-random ( tuple quot -- ) random-generator swap with-variable ; inline + +: with-secure-random ( quot -- ) + >r secure-random-generator get r> with-random ; inline + +{ + { [ windows? ] [ "random.windows" require ] } + { [ unix? ] [ "random.unix" require ] } +} cond + +[ + [ 32 random-bits ] with-secure-random + random-generator set-global +] "random" add-init-hook diff --git a/extra/random/unix/unix.factor b/extra/random/unix/unix.factor index f41a3ae0e8..78765bc575 100644 --- a/extra/random/unix/unix.factor +++ b/extra/random/unix/unix.factor @@ -1,22 +1,21 @@ USING: alien.c-types io io.files io.nonblocking kernel -namespaces random io.encodings.binary singleton ; +namespaces random.backend io.encodings.binary singleton init +accessors ; IN: random.unix -SINGLETON: unix-random +TUPLE: unix-random path ; + +C: unix-random : file-read-unbuffered ( n path -- bytes ) over default-buffer-size [ binary [ read ] with-stream ] with-variable ; -M: unix-random os-crypto-random-bytes ( n -- byte-array ) - "/dev/random" file-read-unbuffered ; +M: unix-random random-bytes* ( n tuple -- byte-array ) + path>> file-read-unbuffered ; -M: unix-random os-random-bytes ( n -- byte-array ) - "/dev/urandom" file-read-unbuffered ; - -M: unix-random os-crypto-random-32 ( -- r ) - 4 os-crypto-random-bytes *uint ; - -M: unix-random os-random-32 ( -- r ) - 4 os-random-bytes *uint ; +[ + "/dev/random" secure-random-generator set-global + "/dev/urandom" insecure-random-generator set-global +] "random.unix" add-init-hook diff --git a/extra/random/windows/cryptographic/cryptographic.factor b/extra/random/windows/cryptographic/cryptographic.factor deleted file mode 100644 index 3f64209200..0000000000 --- a/extra/random/windows/cryptographic/cryptographic.factor +++ /dev/null @@ -1,28 +0,0 @@ -USING: accessors alien.c-types byte-arrays continuations -kernel random windows windows.advapi32 ; -IN: random.windows.cryptographic - -TUPLE: windows-crypto-context handle ; - -C: windows-crypto-context - -M: windows-crypto-context dispose ( tuple -- ) - handle>> 0 CryptReleaseContext win32-error=0/f ; - - -TUPLE: windows-cryptographic-rng context ; - -C: windows-cryptographic-rng - -M: windows-cryptographic-rng dispose ( tuple -- ) - context>> dispose ; - -M: windows-cryptographic-rng random-bytes* ( tuple n -- bytes ) - >r context>> r> dup - [ CryptGenRandom win32-error=0/f ] keep ; - -: acquire-aes-context ( -- bytes ) - "HCRYPTPROV" - dup f f PROV_RSA_AES CRYPT_NEWKEYSET - CryptAcquireContextW win32-error=0/f *void* - ; diff --git a/extra/random/windows/windows.factor b/extra/random/windows/windows.factor index 8b3c1012c8..2b5caabfed 100644 --- a/extra/random/windows/windows.factor +++ b/extra/random/windows/windows.factor @@ -1,3 +1,31 @@ +USING: accessors alien.c-types byte-arrays continuations +kernel random windows windows.advapi32 init namespaces random ; IN: random.windows -! M: windows-io +TUPLE: windows-crypto-context handle ; + +C: windows-crypto-context + +M: windows-crypto-context dispose ( tuple -- ) + handle>> 0 CryptReleaseContext win32-error=0/f ; + +TUPLE: windows-cryptographic-rng context ; + +C: windows-cryptographic-rng + +M: windows-cryptographic-rng dispose ( tuple -- ) + context>> dispose ; + +M: windows-cryptographic-rng random-bytes* ( tuple n -- bytes ) + >r context>> r> dup + [ CryptGenRandom win32-error=0/f ] keep ; + +: windows-aes-context ( -- context ) + "HCRYPTPROV" + dup f f PROV_RSA_AES CRYPT_NEWKEYSET + CryptAcquireContextW win32-error=0/f *void* + ; + +[ + windows-aes-context secure-random-generator set-global +] "random.windows" add-init-hook From 71856836631c2b081424c095d746da808cb8aa2c Mon Sep 17 00:00:00 2001 From: erg Date: Fri, 28 Mar 2008 22:12:11 -0500 Subject: [PATCH 110/219] test with-secure-random --- extra/random/random-tests.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/extra/random/random-tests.factor b/extra/random/random-tests.factor index 0ceac5f5a7..d85df3e0be 100644 --- a/extra/random/random-tests.factor +++ b/extra/random/random-tests.factor @@ -3,3 +3,6 @@ IN: random.tests [ 4 ] [ 4 random-bytes length ] unit-test [ 7 ] [ 7 random-bytes length ] unit-test + +[ 4 ] [ [ 4 random-bytes length ] with-secure-random ] unit-test +[ 7 ] [ [ 7 random-bytes length ] with-secure-random ] unit-test From 89cacd416b3e6edb3c79ff6135cf3a8673b84340 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Mar 2008 05:51:48 -0500 Subject: [PATCH 111/219] fix load errors on windows --- extra/random/mersenne-twister/mersenne-twister.factor | 2 +- extra/random/windows/windows.factor | 9 +++++---- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index f43ef9f852..4eb93f2941 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -4,7 +4,7 @@ ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c USING: arrays kernel math namespaces sequences system init -accessors math.ranges combinators.cleave random new-effects +accessors math.ranges combinators.cleave new-effects random.backend ; IN: random.mersenne-twister diff --git a/extra/random/windows/windows.factor b/extra/random/windows/windows.factor index 2b5caabfed..ef0d10059e 100644 --- a/extra/random/windows/windows.factor +++ b/extra/random/windows/windows.factor @@ -1,5 +1,6 @@ USING: accessors alien.c-types byte-arrays continuations -kernel random windows windows.advapi32 init namespaces random ; +kernel windows windows.advapi32 init namespaces +random.backend ; IN: random.windows TUPLE: windows-crypto-context handle ; @@ -26,6 +27,6 @@ M: windows-cryptographic-rng random-bytes* ( tuple n -- bytes ) CryptAcquireContextW win32-error=0/f *void* ; -[ - windows-aes-context secure-random-generator set-global -] "random.windows" add-init-hook +! [ + ! windows-aes-context secure-random-generator set-global +! ] "random.windows" add-init-hook From f6b7f8197e5e1bf033157bdcd389aa216383a29e Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 27 Mar 2008 23:54:34 +1300 Subject: [PATCH 112/219] Add tests for left recusion in pegs --- extra/peg/ebnf/ebnf-tests.factor | 30 +++++++++++++++++++++++++++++- extra/peg/ebnf/ebnf.factor | 4 ++-- extra/peg/peg-tests.factor | 18 +++++++++++++++++- extra/peg/peg.factor | 6 +++++- 4 files changed, 53 insertions(+), 5 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index c9b9f5d977..dea549eb37 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -142,4 +142,32 @@ IN: peg.ebnf.tests { f } [ "Z" [EBNF foo=[^A-Z] EBNF] call -] unit-test \ No newline at end of file +] unit-test + +[ + #! Test direct left recursion. Currently left recursion should cause a + #! failure of that parser. + #! Not using packrat, so recursion causes data stack overflow + "1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call +] must-fail + +{ V{ 49 } } [ + #! Test direct left recursion. Currently left recursion should cause a + #! failure of that parser. + #! Using packrat, so first part of expr fails, causing 2nd choice to be used + "1+1" [ [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call ] with-packrat parse-result-ast +] unit-test + +[ + #! Test indirect left recursion. Currently left recursion should cause a + #! failure of that parser. + #! Not using packrat, so recursion causes data stack overflow + "1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call +] must-fail + +{ V{ 49 } } [ + #! Test indirect left recursion. Currently left recursion should cause a + #! failure of that parser. + #! Using packrat, so first part of expr fails, causing 2nd choice to be used + "1+1" [ [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call ] with-packrat parse-result-ast +] unit-test diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index 11e1e2ea64..be4beab3f1 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -266,7 +266,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) ] [ ] make delay sp ; : transform-ebnf ( string -- object ) - 'ebnf' parse parse-result-ast transform ; + 'ebnf' [ parse ] packrat-parse parse-result-ast transform ; : check-parse-result ( result -- result ) dup [ @@ -281,7 +281,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) ] if ; : ebnf>quot ( string -- hashtable quot ) - 'ebnf' parse check-parse-result + 'ebnf' [ parse ] with-packrat check-parse-result parse-result-ast transform dup main swap at compile 1quotation ; : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index bd8abb63e6..cd95bd3b93 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -179,4 +179,20 @@ IN: peg.tests [ "1+1" swap parse parse-result-ast ] with-packrat -] unit-test \ No newline at end of file +] unit-test + +: expr ( -- parser ) + #! Test direct left recursion. Currently left recursion should cause a + #! failure of that parser. + [ expr ] delay "+" token "1" token 3seq "1" token 2choice ; + +[ + #! Not using packrat, so recursion causes data stack overflow + "1+1" expr parse parse-result-ast +] must-fail + +{ "1" } [ + #! Using packrat, so expr fails, causing the 2nd choice to be used. + "1+1" expr [ parse ] with-packrat parse-result-ast +] unit-test + diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 1361f9fdbd..e5632d645c 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -39,7 +39,11 @@ GENERIC: (compile) ( parser -- quot ) #! from the input cache. If the item is not in the cache, #! call 'quot' with 'input' on the stack to get the result #! and store that in the cache and return it. - n input-cache [ drop input quot call ] cache ; inline + n input-cache [ + drop + f n input-cache set-at + input quot call + ] cache ; inline :: run-packrat-parser ( input quot c -- result ) input input-from From fa8b311b277582adbcdf5fe9e6aca747b1cd5322 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 28 Mar 2008 00:04:08 +1300 Subject: [PATCH 113/219] Add packrat-parse, etc --- extra/peg/ebnf/ebnf.factor | 4 ++-- extra/peg/peg-docs.factor | 30 ++++++++++++++++++++++++++---- extra/peg/peg.factor | 10 ++++++++-- 3 files changed, 36 insertions(+), 8 deletions(-) diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index be4beab3f1..ed0dea0410 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -266,7 +266,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) ] [ ] make delay sp ; : transform-ebnf ( string -- object ) - 'ebnf' [ parse ] packrat-parse parse-result-ast transform ; + 'ebnf' packrat-parse parse-result-ast transform ; : check-parse-result ( result -- result ) dup [ @@ -281,7 +281,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) ] if ; : ebnf>quot ( string -- hashtable quot ) - 'ebnf' [ parse ] with-packrat check-parse-result + 'ebnf' packrat-parse check-parse-result parse-result-ast transform dup main swap at compile 1quotation ; : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor index 30e7f0e72f..c93d1af830 100644 --- a/extra/peg/peg-docs.factor +++ b/extra/peg/peg-docs.factor @@ -12,7 +12,7 @@ HELP: parse { $description "Given the input string, parse it using the given parser. The result is a object if " "the parse was successful, otherwise it is f." } -{ $see-also compile with-packrat } ; +{ $see-also compile with-packrat packrat-parse } ; HELP: with-packrat { $values @@ -23,8 +23,30 @@ HELP: with-packrat "Calls the quotation with a packrat cache in scope. Usually the quotation will " "call " { $link parse } " or call a word produced by " { $link compile } "." "The cache is used to avoid the possible exponential time performace that pegs " - "can have, instead giving linear time at the cost of increased memory usage." } -{ $see-also compile parse } ; + "can have, instead giving linear time at the cost of increased memory usage. " + "Use of this packrat option also allows direct and indirect recursion to " + "be handled in the parser without entering an infinite loop." } +{ $see-also compile parse packrat-parse packrat-call } ; + +HELP: packrat-parse +{ $values + { "input" "a string" } + { "parser" "a parser" } + { "result" "a parse-result or f" } +} +{ $description + "Compiles and calls the parser with a packrat cache in scope." } +{ $see-also compile parse packrat-call with-packrat } ; + +HELP: packrat-call +{ $values + { "input" "a string" } + { "quot" "a quotation with stack effect ( input -- result )" } + { "result" "a parse-result or f" } +} +{ $description + "Calls the compiled parser with a packrat cache in scope." } +{ $see-also compile packrat-call packrat-parse with-packrat } ; HELP: compile { $values @@ -36,7 +58,7 @@ HELP: compile "The mapping from parser to compiled word is kept in a cache. If you later change " "the definition of a parser you'll need to clear this cache with " { $link reset-compiled-parsers } " before using " { $link compile } " on that parser again." } -{ $see-also compile with-packrat reset-compiled-parsers } ; +{ $see-also compile with-packrat reset-compiled-parsers packrat-call packrat-parse } ; HELP: reset-compiled-parsers { $description diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index e5632d645c..246dbc7962 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -67,11 +67,17 @@ GENERIC: (compile) ( parser -- quot ) [ compiled-parser ] with-compilation-unit ; : parse ( state parser -- result ) - compile execute ; + compile execute ; inline : with-packrat ( quot -- result ) #! Run the quotation with a packrat cache active. - [ H{ } clone packrat ] dip with-variable ; + [ H{ } clone packrat ] dip with-variable ; inline + +: packrat-parse ( state parser -- result ) + [ parse ] with-packrat ; + +: packrat-call ( state quot -- result ) + with-packrat ; inline Date: Thu, 27 Mar 2008 06:27:36 -0500 Subject: [PATCH 114/219] remove random.backend --- extra/bootstrap/random/random.factor | 3 +- extra/random/backend/backend.factor | 24 -------------- extra/random/dummy/dummy.factor | 2 +- .../mersenne-twister-tests.factor | 2 +- .../mersenne-twister/mersenne-twister.factor | 2 +- extra/random/random.factor | 33 +++++++++++-------- extra/random/unix/unix.factor | 2 +- extra/random/windows/windows.factor | 3 +- 8 files changed, 27 insertions(+), 44 deletions(-) delete mode 100755 extra/random/backend/backend.factor diff --git a/extra/bootstrap/random/random.factor b/extra/bootstrap/random/random.factor index b61e002526..b22ee27ebf 100755 --- a/extra/bootstrap/random/random.factor +++ b/extra/bootstrap/random/random.factor @@ -1,6 +1,6 @@ USING: vocabs.loader sequences system random random.mersenne-twister combinators init -namespaces ; +namespaces random.backend ; "random.mersenne-twister" require @@ -9,5 +9,6 @@ namespaces ; { [ unix? ] [ "random.unix" require ] } } cond +! [ [ 32 random-bits ] with-secure-random random-generator set-global ] [ millis random-generator set-global ] "generator.random" add-init-hook diff --git a/extra/random/backend/backend.factor b/extra/random/backend/backend.factor deleted file mode 100755 index c5243c22bd..0000000000 --- a/extra/random/backend/backend.factor +++ /dev/null @@ -1,24 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types kernel math namespaces sequences -io.backend io.binary combinators system vocabs.loader ; -IN: random.backend - -SYMBOL: insecure-random-generator -SYMBOL: secure-random-generator -SYMBOL: random-generator - -GENERIC: seed-random ( tuple seed -- ) -GENERIC: random-32* ( tuple -- r ) -GENERIC: random-bytes* ( n tuple -- bytes ) - -M: object random-bytes* ( n tuple -- byte-array ) - swap [ drop random-32* ] with map >c-uint-array ; - -M: object random-32* ( tuple -- n ) 4 random-bytes* le> ; - -ERROR: no-random-number-generator ; - -M: f random-bytes* ( n obj -- * ) no-random-number-generator ; - -M: f random-32* ( obj -- * ) no-random-number-generator ; diff --git a/extra/random/dummy/dummy.factor b/extra/random/dummy/dummy.factor index a17ef54982..e0cb83c330 100755 --- a/extra/random/dummy/dummy.factor +++ b/extra/random/dummy/dummy.factor @@ -1,4 +1,4 @@ -USING: kernel random math accessors random.backend ; +USING: kernel random math accessors random ; IN: random.dummy TUPLE: random-dummy i ; diff --git a/extra/random/mersenne-twister/mersenne-twister-tests.factor b/extra/random/mersenne-twister/mersenne-twister-tests.factor index 9eb546063e..703a0c16e4 100755 --- a/extra/random/mersenne-twister/mersenne-twister-tests.factor +++ b/extra/random/mersenne-twister/mersenne-twister-tests.factor @@ -1,5 +1,5 @@ USING: kernel math random namespaces random.mersenne-twister -sequences tools.test random.backend ; +sequences tools.test ; IN: random.mersenne-twister.tests : check-random ( max -- ? ) diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index 4eb93f2941..331ae9af82 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -5,7 +5,7 @@ USING: arrays kernel math namespaces sequences system init accessors math.ranges combinators.cleave new-effects -random.backend ; +random ; IN: random.mersenne-twister c-uint-array ; + +M: object random-32* ( tuple -- n ) 4 random-bytes* le> ; + +ERROR: no-random-number-generator ; + +M: f random-bytes* ( n obj -- * ) no-random-number-generator ; + +M: f random-32* ( obj -- * ) no-random-number-generator ; + : random-bytes ( n -- r ) [ dup 4 rem zero? [ 1+ ] unless @@ -29,13 +46,3 @@ IN: random : with-secure-random ( quot -- ) >r secure-random-generator get r> with-random ; inline - -{ - { [ windows? ] [ "random.windows" require ] } - { [ unix? ] [ "random.unix" require ] } -} cond - -[ - [ 32 random-bits ] with-secure-random - random-generator set-global -] "random" add-init-hook diff --git a/extra/random/unix/unix.factor b/extra/random/unix/unix.factor index 78765bc575..51574887e3 100644 --- a/extra/random/unix/unix.factor +++ b/extra/random/unix/unix.factor @@ -1,5 +1,5 @@ USING: alien.c-types io io.files io.nonblocking kernel -namespaces random.backend io.encodings.binary singleton init +namespaces random io.encodings.binary singleton init accessors ; IN: random.unix diff --git a/extra/random/windows/windows.factor b/extra/random/windows/windows.factor index ef0d10059e..e0c564bc2c 100644 --- a/extra/random/windows/windows.factor +++ b/extra/random/windows/windows.factor @@ -1,6 +1,5 @@ USING: accessors alien.c-types byte-arrays continuations -kernel windows windows.advapi32 init namespaces -random.backend ; +kernel windows windows.advapi32 init namespaces random ; IN: random.windows TUPLE: windows-crypto-context handle ; From f317b97221099653cc805dbda36457d19e70b77c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Mar 2008 06:30:59 -0500 Subject: [PATCH 115/219] stack effect typos --- extra/random/random.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/random/random.factor b/extra/random/random.factor index 56590adb91..e62ab71b92 100755 --- a/extra/random/random.factor +++ b/extra/random/random.factor @@ -10,7 +10,7 @@ SYMBOL: random-generator GENERIC: seed-random ( tuple seed -- ) GENERIC: random-32* ( tuple -- r ) -GENERIC: random-bytes* ( n tuple -- bytes ) +GENERIC: random-bytes* ( n tuple -- byte-array ) M: object random-bytes* ( n tuple -- byte-array ) swap [ drop random-32* ] with map >c-uint-array ; @@ -23,7 +23,7 @@ M: f random-bytes* ( n obj -- * ) no-random-number-generator ; M: f random-32* ( obj -- * ) no-random-number-generator ; -: random-bytes ( n -- r ) +: random-bytes ( n -- byte-array ) [ dup 4 rem zero? [ 1+ ] unless random-generator get random-bytes* From 251fe256891ed44501e821f36e382647876d3719 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Mar 2008 06:36:34 -0500 Subject: [PATCH 116/219] fix bootstrap for random --- extra/bootstrap/random/random.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/bootstrap/random/random.factor b/extra/bootstrap/random/random.factor index b22ee27ebf..daf35b9c03 100755 --- a/extra/bootstrap/random/random.factor +++ b/extra/bootstrap/random/random.factor @@ -1,6 +1,6 @@ USING: vocabs.loader sequences system random random.mersenne-twister combinators init -namespaces random.backend ; +namespaces random ; "random.mersenne-twister" require From b6818e75f492f89d8fcb8f156fba5a339876763b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Mar 2008 16:22:24 -0500 Subject: [PATCH 117/219] cleanup windows normalize-path --- core/io/files/files-tests.factor | 6 +++ core/io/files/files.factor | 4 ++ extra/io/windows/nt/files/files-tests.factor | 48 ++++++++++++++--- extra/io/windows/nt/files/files.factor | 55 +++++++------------- 4 files changed, 69 insertions(+), 44 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 9af82a5672..b732495541 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -89,6 +89,12 @@ io.encodings.utf8 ; ] with-directory ] unit-test +[ { { "kernel" t } } ] [ + "resource:core" [ + "." directory [ first "kernel" = ] subset + ] with-directory +] unit-test + [ ] [ "copy-tree-test/a/b/c" temp-file make-directories ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index f6888bf78d..3ebde42b96 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -173,8 +173,12 @@ M: object cwd ( -- path ) "." ; [ cwd current-directory set-global ] "current-directory" add-init-hook : with-directory ( path quot -- ) + >r normalize-pathname r> current-directory swap with-variable ; inline +: set-current-directory ( path -- ) + normalize-pathname current-directory set ; + ! Creating directories HOOK: make-directory io-backend ( path -- ) diff --git a/extra/io/windows/nt/files/files-tests.factor b/extra/io/windows/nt/files/files-tests.factor index 3b31d73e4a..73d6a0bf7f 100644 --- a/extra/io/windows/nt/files/files-tests.factor +++ b/extra/io/windows/nt/files/files-tests.factor @@ -1,15 +1,47 @@ -USING: kernel tools.test ; +USING: io.files kernel tools.test io.backend +io.windows.nt.files splitting ; IN: io.windows.nt.files.tests -[ f ] [ "" root-directory? ] unit-test -[ t ] [ "\\" root-directory? ] unit-test -[ t ] [ "\\\\" root-directory? ] unit-test -[ t ] [ "\\\\\\\\\\\\" root-directory? ] unit-test -[ t ] [ "/" root-directory? ] unit-test -[ t ] [ "//" root-directory? ] unit-test -[ t ] [ "//////////////" root-directory? ] unit-test [ t ] [ "\\foo" absolute-path? ] unit-test [ t ] [ "\\\\?\\foo" absolute-path? ] unit-test [ t ] [ "c:\\foo" absolute-path? ] unit-test [ t ] [ "c:" absolute-path? ] unit-test +[ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test +[ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test +[ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test +! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing +[ "c:\\" ] [ "c:\\" parent-directory ] unit-test +[ "Z:\\" ] [ "Z:\\" parent-directory ] unit-test +[ "c:" ] [ "c:" parent-directory ] unit-test +[ "Z:" ] [ "Z:" parent-directory ] unit-test + +[ f ] [ "" root-directory? ] unit-test +[ t ] [ "\\" root-directory? ] unit-test +[ t ] [ "\\\\" root-directory? ] unit-test +[ t ] [ "/" root-directory? ] unit-test +[ t ] [ "//" root-directory? ] unit-test +[ t ] [ "c:\\" right-trim-separators root-directory? ] unit-test +[ t ] [ "Z:\\" right-trim-separators root-directory? ] unit-test +[ f ] [ "c:\\foo" root-directory? ] unit-test +[ f ] [ "." root-directory? ] unit-test +[ f ] [ ".." root-directory? ] unit-test + +[ ] [ "" resource-path cd ] unit-test + +[ "\\foo\\bar" ] [ "/foo/bar" normalize-pathname ":" split1 nip ] unit-test + +[ "\\\\?\\C:\\builds\\factor\\log.txt" ] [ + "C:\\builds\\factor\\12345\\" + "..\\log.txt" append-path normalize-pathname +] unit-test + +[ "\\\\?\\C:\\builds\\" ] [ + "C:\\builds\\factor\\12345\\" + "..\\.." append-path normalize-pathname +] unit-test + +[ "\\\\?\\C:\\builds\\" ] [ + "C:\\builds\\factor\\12345\\" + "..\\.." append-path normalize-pathname +] unit-test diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index c6cbf292b3..24111346b6 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -18,12 +18,15 @@ M: windows-nt-io cd "\\\\?\\" ; inline M: windows-nt-io root-directory? ( path -- ? ) - dup length 2 = [ - first2 - [ Letter? ] [ CHAR: : = ] bi* and - ] [ - drop f - ] if ; + { + { [ dup empty? ] [ f ] } + { [ dup [ path-separator? ] all? ] [ t ] } + { [ dup right-trim-separators + { [ dup length 2 = ] [ dup second CHAR: : = ] } && nip ] [ + t + ] } + { [ t ] [ f ] } + } cond nip ; ERROR: not-absolute-path ; : root-directory ( string -- string' ) @@ -36,45 +39,25 @@ ERROR: not-absolute-path ; : prepend-prefix ( string -- string' ) unicode-prefix prepend ; -: windows-append-path ( cwd path -- newpath ) - { - ! empty - { [ dup empty? ] [ drop ] } - ! .. - { [ dup ".." = ] [ drop parent-directory prepend-prefix ] } - ! \\\\?\\c:\\foo - { [ dup unicode-prefix head? ] [ nip ] } - ! ..\\foo - { [ dup "..\\" head? ] [ >r parent-directory r> 3 tail windows-append-path ] } - ! .\\foo - { [ dup ".\\" head? ] [ 1 tail append prepend-prefix ] } - ! \\foo - { [ dup "\\" head? ] [ >r root-directory r> append prepend-prefix ] } - ! c:\\foo - { [ dup ?second CHAR: : = ] [ nip prepend-prefix ] } - ! foo.txt - { [ t ] [ - >r right-trim-separators "\\" r> - left-trim-separators - 3append prepend-prefix - ] } - } cond ; - ERROR: nonstring-pathname ; ERROR: empty-pathname ; -USE: tools.walker M: windows-nt-io normalize-pathname ( string -- string ) "resource:" ?head [ left-trim-separators resource-path normalize-pathname ] [ - dup string? [ nonstring-pathname ] unless dup empty? [ empty-pathname ] when - { { CHAR: / CHAR: \\ } } substitute - current-directory get swap windows-append-path - [ "/\\." member? ] right-trim - dup peek CHAR: : = [ "\\" append ] when + current-directory get prepend-path + dup unicode-prefix head? [ + dup first path-separator? [ + left-trim-separators + current-directory get 2 head + prepend-path + ] when + unicode-prefix prepend + ] unless + { { CHAR: / CHAR: \\ } } substitute ! necessary ] if ; M: windows-nt-io CreateFile-flags ( DWORD -- DWORD ) From af28c3376d1e151578cb4e2bcb9dcaf3d94903c4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 16:24:38 -0500 Subject: [PATCH 118/219] Fix PowerPC intrinsic --- core/cpu/ppc/intrinsics/intrinsics.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor index 8a2f41ec12..0aef15ba99 100755 --- a/core/cpu/ppc/intrinsics/intrinsics.factor +++ b/core/cpu/ppc/intrinsics/intrinsics.factor @@ -481,7 +481,7 @@ IN: cpu.ppc.intrinsics \ [ tuple "layout" get layout-size 2 + cells %allot ! Store layout - "layout" operand 12 LOAD32 + "layout" get 12 load-indirect 12 11 cell STW ! Zero out the rest of the tuple f v>operand 12 LI From 89c76987388ad917247caed9f618c2253dfeb5da Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 28 Mar 2008 11:30:46 +1300 Subject: [PATCH 119/219] Fix MEMO problem with seq* and choice* --- extra/peg/peg.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 246dbc7962..709052b7dd 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -338,7 +338,7 @@ MEMO: 3seq ( parser1 parser2 parser3 -- parser ) MEMO: 4seq ( parser1 parser2 parser3 parser4 -- parser ) 4array seq ; -MEMO: seq* ( quot -- paser ) +: seq* ( quot -- paser ) { } make seq ; inline MEMO: choice ( seq -- parser ) @@ -353,7 +353,7 @@ MEMO: 3choice ( parser1 parser2 parser3 -- parser ) MEMO: 4choice ( parser1 parser2 parser3 parser4 -- parser ) 4array choice ; -MEMO: choice* ( quot -- paser ) +: choice* ( quot -- paser ) { } make choice ; inline MEMO: repeat0 ( parser -- parser ) From 146bdbccbbd12609c165017dac84ddd3bb854f5b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Mar 2008 17:43:00 -0500 Subject: [PATCH 120/219] fix rng on windows --- extra/random/windows/windows.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/random/windows/windows.factor b/extra/random/windows/windows.factor index cd69105e65..65426d4277 100644 --- a/extra/random/windows/windows.factor +++ b/extra/random/windows/windows.factor @@ -46,9 +46,9 @@ M: windows-rng random-bytes* ( n tuple -- bytes ) MS_DEF_PROV PROV_RSA_FULL insecure-random-generator set-global - ! MS_STRONG_PROV - ! PROV_RSA_FULL secure-random-generator set-global + MS_STRONG_PROV + PROV_RSA_FULL secure-random-generator set-global - MS_ENH_RSA_AES_PROV - PROV_RSA_AES secure-random-generator set-global + ! MS_ENH_RSA_AES_PROV + ! PROV_RSA_AES secure-random-generator set-global ] "random.windows" add-init-hook From f96a251f8a1bdae231e4bc87fc7310a3e72e6b7e Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 28 Mar 2008 12:00:36 +1300 Subject: [PATCH 121/219] Refactor pegs to remove MEMO: and use unique id's --- extra/peg/parsers/parsers.factor | 3 +- extra/peg/peg.factor | 139 +++++++++++++++++++------------ 2 files changed, 85 insertions(+), 57 deletions(-) diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor index fa6801dc1c..7a82418c27 100755 --- a/extra/peg/parsers/parsers.factor +++ b/extra/peg/parsers/parsers.factor @@ -7,7 +7,6 @@ USING: kernel sequences strings namespaces math assocs shuffle IN: peg.parsers TUPLE: just-parser p1 ; -M: just-parser equal? 2drop f ; : just-pattern [ @@ -21,7 +20,7 @@ M: just-parser (compile) ( parser -- quot ) just-parser-p1 compiled-parser just-pattern curry ; MEMO: just ( parser -- parser ) - just-parser construct-boa ; + just-parser construct-boa init-parser ; : 1token ( ch -- parser ) 1string token ; diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 709052b7dd..eadbe2528f 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -29,25 +29,24 @@ GENERIC: (compile) ( parser -- quot ) #! input slice is based on. dup slice? [ slice-from ] [ drop 0 ] if ; -: input-cache ( quot cache -- cache ) +: input-cache ( id -- cache ) #! From the packrat cache, obtain the cache for the parser quotation #! that maps the input string position to the parser result. - [ drop H{ } clone ] cache ; + packrat get [ drop H{ } clone ] cache ; -:: cached-result ( n input-cache input quot -- result ) - #! Get the cached result for input position n +:: cached-result ( input-cache input quot -- result ) + #! Get the cached result for input position #! from the input cache. If the item is not in the cache, #! call 'quot' with 'input' on the stack to get the result #! and store that in the cache and return it. - n input-cache [ + input input-from input-cache [ drop - f n input-cache set-at + f input input-from input-cache set-at input quot call ] cache ; inline -:: run-packrat-parser ( input quot c -- result ) - input input-from - quot c input-cache +:: run-packrat-parser ( input quot id -- result ) + id input-cache input quot cached-result ; inline : run-parser ( input quot -- result ) @@ -55,12 +54,28 @@ GENERIC: (compile) ( parser -- quot ) #! packrat parsing, otherwise do a standard peg call. packrat get [ run-packrat-parser ] [ call ] if* ; inline +:: parser-body ( parser -- quot ) + #! Return the body of the word that is the compiled version + #! of the parser. + [let* | parser-quot [ parser (compile) ] + id [ parser id>> ] + | + [ + packrat get [ + parser-quot id run-packrat-parser + ] [ + parser-quot call + ] if + ] + ] ; + : compiled-parser ( parser -- word ) #! Look to see if the given parser has been compiled. #! If not, compile it to a temporary word, cache it, #! and return it. Otherwise return the existing one. compiled-parsers [ - (compile) [ run-parser ] curry define-temp + dup parser-body define-temp + tuck swap "peg" set-word-prop ] cache ; : compile ( parser -- word ) @@ -81,8 +96,34 @@ GENERIC: (compile) ( parser -- quot ) > ] 2apply = ; +C: parser + +: delegates ( -- cache ) + \ delegates get-global [ H{ } clone dup \ delegates set-global ] unless* ; + +: reset-delegates ( -- ) + H{ } clone \ delegates set-global ; + +: init-parser ( parser -- parser ) + #! Set the delegate for the parser. Equivalent parsers + #! get a delegate with the same id. + dup clone delegates [ + drop next-id + ] cache over set-delegate ; + TUPLE: token-parser symbol ; -M: token-parser equal? 2drop f ; MATCH-VARS: ?token ; @@ -98,7 +139,6 @@ M: token-parser (compile) ( parser -- quot ) symbol>> [ parse-token ] curry ; TUPLE: satisfy-parser quot ; -M: satisfy-parser equal? 2drop f ; MATCH-VARS: ?quot ; @@ -119,7 +159,6 @@ M: satisfy-parser (compile) ( parser -- quot ) quot>> \ ?quot satisfy-pattern match-replace ; TUPLE: range-parser min max ; -M: range-parser equal? 2drop f ; MATCH-VARS: ?min ?max ; @@ -141,7 +180,6 @@ M: range-parser (compile) ( parser -- quot ) T{ range-parser _ ?min ?max } range-pattern match-replace ; TUPLE: seq-parser parsers ; -M: seq-parser equal? 2drop f ; : seq-pattern ( -- quot ) [ @@ -168,7 +206,6 @@ M: seq-parser (compile) ( parser -- quot ) ] [ ] make ; TUPLE: choice-parser parsers ; -M: choice-parser equal? 2drop f ; : choice-pattern ( -- quot ) [ @@ -187,7 +224,6 @@ M: choice-parser (compile) ( parser -- quot ) ] [ ] make ; TUPLE: repeat0-parser p1 ; -M: repeat0-parser equal? 2drop f ; : (repeat0) ( quot result -- result ) 2dup remaining>> swap call [ @@ -210,7 +246,6 @@ M: repeat0-parser (compile) ( parser -- quot ) ] [ ] make ; TUPLE: repeat1-parser p1 ; -M: repeat1-parser equal? 2drop f ; : repeat1-pattern ( -- quot ) [ @@ -230,7 +265,6 @@ M: repeat1-parser (compile) ( parser -- quot ) ] [ ] make ; TUPLE: optional-parser p1 ; -M: optional-parser equal? 2drop f ; : optional-pattern ( -- quot ) [ @@ -241,7 +275,6 @@ M: optional-parser (compile) ( parser -- quot ) p1>> compiled-parser \ ?quot optional-pattern match-replace ; TUPLE: ensure-parser p1 ; -M: ensure-parser equal? 2drop f ; : ensure-pattern ( -- quot ) [ @@ -256,7 +289,6 @@ M: ensure-parser (compile) ( parser -- quot ) p1>> compiled-parser \ ?quot ensure-pattern match-replace ; TUPLE: ensure-not-parser p1 ; -M: ensure-not-parser equal? 2drop f ; : ensure-not-pattern ( -- quot ) [ @@ -271,7 +303,6 @@ M: ensure-not-parser (compile) ( parser -- quot ) p1>> compiled-parser \ ?quot ensure-not-pattern match-replace ; TUPLE: action-parser p1 quot ; -M: action-parser equal? 2drop f ; MATCH-VARS: ?action ; @@ -295,7 +326,6 @@ M: action-parser (compile) ( parser -- quot ) ] unless ; TUPLE: sp-parser p1 ; -M: sp-parser equal? 2drop f ; M: sp-parser (compile) ( parser -- quot ) [ @@ -303,7 +333,6 @@ M: sp-parser (compile) ( parser -- quot ) ] [ ] make ; TUPLE: delay-parser quot ; -M: delay-parser equal? 2drop f ; M: delay-parser (compile) ( parser -- quot ) #! For efficiency we memoize the quotation. @@ -317,71 +346,71 @@ M: delay-parser (compile) ( parser -- quot ) PRIVATE> -MEMO: token ( string -- parser ) - token-parser construct-boa ; +: token ( string -- parser ) + token-parser construct-boa init-parser ; -MEMO: satisfy ( quot -- parser ) - satisfy-parser construct-boa ; +: satisfy ( quot -- parser ) + satisfy-parser construct-boa init-parser ; -MEMO: range ( min max -- parser ) - range-parser construct-boa ; +: range ( min max -- parser ) + range-parser construct-boa init-parser ; -MEMO: seq ( seq -- parser ) - seq-parser construct-boa ; +: seq ( seq -- parser ) + seq-parser construct-boa init-parser ; -MEMO: 2seq ( parser1 parser2 -- parser ) +: 2seq ( parser1 parser2 -- parser ) 2array seq ; -MEMO: 3seq ( parser1 parser2 parser3 -- parser ) +: 3seq ( parser1 parser2 parser3 -- parser ) 3array seq ; -MEMO: 4seq ( parser1 parser2 parser3 parser4 -- parser ) +: 4seq ( parser1 parser2 parser3 parser4 -- parser ) 4array seq ; : seq* ( quot -- paser ) { } make seq ; inline -MEMO: choice ( seq -- parser ) - choice-parser construct-boa ; +: choice ( seq -- parser ) + choice-parser construct-boa init-parser ; -MEMO: 2choice ( parser1 parser2 -- parser ) +: 2choice ( parser1 parser2 -- parser ) 2array choice ; -MEMO: 3choice ( parser1 parser2 parser3 -- parser ) +: 3choice ( parser1 parser2 parser3 -- parser ) 3array choice ; -MEMO: 4choice ( parser1 parser2 parser3 parser4 -- parser ) +: 4choice ( parser1 parser2 parser3 parser4 -- parser ) 4array choice ; : choice* ( quot -- paser ) { } make choice ; inline -MEMO: repeat0 ( parser -- parser ) - repeat0-parser construct-boa ; +: repeat0 ( parser -- parser ) + repeat0-parser construct-boa init-parser ; -MEMO: repeat1 ( parser -- parser ) - repeat1-parser construct-boa ; +: repeat1 ( parser -- parser ) + repeat1-parser construct-boa init-parser ; -MEMO: optional ( parser -- parser ) - optional-parser construct-boa ; +: optional ( parser -- parser ) + optional-parser construct-boa init-parser ; -MEMO: ensure ( parser -- parser ) - ensure-parser construct-boa ; +: ensure ( parser -- parser ) + ensure-parser construct-boa init-parser ; -MEMO: ensure-not ( parser -- parser ) - ensure-not-parser construct-boa ; +: ensure-not ( parser -- parser ) + ensure-not-parser construct-boa init-parser ; -MEMO: action ( parser quot -- parser ) - action-parser construct-boa ; +: action ( parser quot -- parser ) + action-parser construct-boa init-parser ; -MEMO: sp ( parser -- parser ) - sp-parser construct-boa ; +: sp ( parser -- parser ) + sp-parser construct-boa init-parser ; : hide ( parser -- parser ) [ drop ignore ] action ; -MEMO: delay ( quot -- parser ) - delay-parser construct-boa ; +: delay ( quot -- parser ) + delay-parser construct-boa init-parser ; : PEG: (:) [ From 36f51b46f252ba639264f3c3fc40e7374f5459a0 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 27 Mar 2008 19:06:24 -0500 Subject: [PATCH 122/219] fix ultraedit --- extra/editors/ultraedit/ultraedit.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/editors/ultraedit/ultraedit.factor b/extra/editors/ultraedit/ultraedit.factor index 1fef9f3350..d0bb789c1b 100755 --- a/extra/editors/ultraedit/ultraedit.factor +++ b/extra/editors/ultraedit/ultraedit.factor @@ -5,7 +5,7 @@ IN: editors.ultraedit : ultraedit-path ( -- path ) \ ultraedit-path get-global [ program-files - "\\IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" append-path + "IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" append-path ] unless* ; : ultraedit ( file line -- ) From 7ad1686590d5f27ba0ac09e835c1d317c0872ea2 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 27 Mar 2008 20:50:41 -0400 Subject: [PATCH 123/219] Factoring out parse-unit --- core/parser/parser.factor | 4 ++++ core/syntax/syntax.factor | 4 +--- extra/help/syntax/syntax.factor | 4 +--- extra/tuple-syntax/tuple-syntax.factor | 5 +---- 4 files changed, 7 insertions(+), 10 deletions(-) diff --git a/core/parser/parser.factor b/core/parser/parser.factor index f6e351a42e..1e66618053 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -366,6 +366,10 @@ ERROR: bad-number ; : (M:) CREATE-METHOD parse-definition ; +: parse-unit ( -- object ) + scan-word dup parsing? + [ V{ } clone swap execute first ] when ; + GENERIC: expected>string ( obj -- str ) M: f expected>string drop "end of input" ; diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 9190b9676d..778a9e7293 100755 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -171,9 +171,7 @@ IN: bootstrap.syntax ] define-syntax "FORGET:" [ - scan-word - dup parsing? [ V{ } clone swap execute first ] when - forget + parse-unit forget ] define-syntax "(" [ diff --git a/extra/help/syntax/syntax.factor b/extra/help/syntax/syntax.factor index e006a9816b..d41b72ee20 100755 --- a/extra/help/syntax/syntax.factor +++ b/extra/help/syntax/syntax.factor @@ -16,6 +16,4 @@ IN: help.syntax over add-article >link r> remember-definition ; parsing : ABOUT: - scan-word dup parsing? [ - V{ } clone swap execute first - ] when in get vocab set-vocab-help ; parsing + parse-unit in get vocab set-vocab-help ; parsing diff --git a/extra/tuple-syntax/tuple-syntax.factor b/extra/tuple-syntax/tuple-syntax.factor index f06bb55899..fe05e5a374 100755 --- a/extra/tuple-syntax/tuple-syntax.factor +++ b/extra/tuple-syntax/tuple-syntax.factor @@ -5,9 +5,6 @@ IN: tuple-syntax ! TUPLE: foo bar baz ; ! TUPLE{ foo bar: 1 baz: 2 } -: parse-object ( -- object ) - scan-word dup parsing? [ V{ } clone swap execute first ] when ; - : parse-slot-writer ( tuple -- slot# ) scan dup "}" = [ 2drop f ] [ 1 head* swap object-slots slot-named slot-spec-offset @@ -15,7 +12,7 @@ IN: tuple-syntax : parse-slots ( accum tuple -- accum tuple ) dup parse-slot-writer - [ parse-object pick rot set-slot parse-slots ] when* ; + [ parse-unit pick rot set-slot parse-slots ] when* ; : TUPLE{ scan-word construct-empty parse-slots parsed ; parsing From 31de812987eeb9c9ef977e230a01481c2aa1ed57 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Thu, 27 Mar 2008 20:52:53 -0400 Subject: [PATCH 124/219] renaming parse-unit to scan-until --- core/parser/parser.factor | 2 +- core/syntax/syntax.factor | 2 +- extra/help/syntax/syntax.factor | 2 +- extra/tuple-syntax/tuple-syntax.factor | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 1e66618053..08f4275e49 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -366,7 +366,7 @@ ERROR: bad-number ; : (M:) CREATE-METHOD parse-definition ; -: parse-unit ( -- object ) +: scan-object ( -- object ) scan-word dup parsing? [ V{ } clone swap execute first ] when ; diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 778a9e7293..5da2d5e4e2 100755 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -171,7 +171,7 @@ IN: bootstrap.syntax ] define-syntax "FORGET:" [ - parse-unit forget + scan-object forget ] define-syntax "(" [ diff --git a/extra/help/syntax/syntax.factor b/extra/help/syntax/syntax.factor index d41b72ee20..9450f87215 100755 --- a/extra/help/syntax/syntax.factor +++ b/extra/help/syntax/syntax.factor @@ -16,4 +16,4 @@ IN: help.syntax over add-article >link r> remember-definition ; parsing : ABOUT: - parse-unit in get vocab set-vocab-help ; parsing + scan-object in get vocab set-vocab-help ; parsing diff --git a/extra/tuple-syntax/tuple-syntax.factor b/extra/tuple-syntax/tuple-syntax.factor index fe05e5a374..2419b8febb 100755 --- a/extra/tuple-syntax/tuple-syntax.factor +++ b/extra/tuple-syntax/tuple-syntax.factor @@ -12,7 +12,7 @@ IN: tuple-syntax : parse-slots ( accum tuple -- accum tuple ) dup parse-slot-writer - [ parse-unit pick rot set-slot parse-slots ] when* ; + [ scan-object pick rot set-slot parse-slots ] when* ; : TUPLE{ scan-word construct-empty parse-slots parsed ; parsing From 6019713ee1d7142bac773f3b393b9f7004bdaf93 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 19:57:16 -0500 Subject: [PATCH 125/219] Tweak --- extra/tools/vocabs/vocabs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/tools/vocabs/vocabs.factor b/extra/tools/vocabs/vocabs.factor index d7c3d2be20..d7610c21c8 100755 --- a/extra/tools/vocabs/vocabs.factor +++ b/extra/tools/vocabs/vocabs.factor @@ -206,7 +206,7 @@ MEMO: all-vocabs-seq ( -- seq ) { [ "editors." ?head ] [ t ] } { [ ".windows" ?tail ] [ t ] } { [ ".unix" ?tail ] [ t ] } - { [ "unix." ?head ] [ t ] } + { [ "unix" ?head ] [ t ] } { [ ".linux" ?tail ] [ t ] } { [ ".bsd" ?tail ] [ t ] } { [ ".macosx" ?tail ] [ t ] } From 17ba5aa2ef2db84eb5416cd4343890c292e20000 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Mar 2008 20:10:16 -0500 Subject: [PATCH 126/219] use resource: --- core/io/files/files.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 3ebde42b96..2b546bdee4 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -276,7 +276,7 @@ DEFER: copy-tree-into prepend-path ; : temp-directory ( -- path ) - "temp" resource-path dup make-directories ; + "resource:temp" dup make-directories ; : temp-file ( name -- path ) temp-directory prepend-path ; From f596aa2d71f1f6dba6b94304b9754e83afde43fc Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 28 Mar 2008 14:10:33 +1300 Subject: [PATCH 127/219] Handle compilation of circular parsers --- extra/peg/peg-tests.factor | 8 +++++++- extra/peg/peg.factor | 12 ++++++++---- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index cd95bd3b93..7e2701bc48 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: kernel tools.test strings namespaces arrays sequences peg peg.private ; +USING: kernel tools.test strings namespaces arrays sequences peg peg.private accessors words ; IN: peg.tests { f } [ @@ -196,3 +196,9 @@ IN: peg.tests "1+1" expr [ parse ] with-packrat parse-result-ast ] unit-test +{ t } [ + #! Ensure a circular parser doesn't loop infinitely + [ f , "a" token , ] seq* + dup parsers>> + dupd 0 swap set-nth compile word? +] unit-test \ No newline at end of file diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index eadbe2528f..9db23d9779 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -73,10 +73,14 @@ GENERIC: (compile) ( parser -- quot ) #! Look to see if the given parser has been compiled. #! If not, compile it to a temporary word, cache it, #! and return it. Otherwise return the existing one. - compiled-parsers [ - dup parser-body define-temp - tuck swap "peg" set-word-prop - ] cache ; + #! Circular parsers are supported by getting the word + #! name and storing it in the cache, before compiling, + #! so it is picked up when re-entered. + dup id>> compiled-parsers [ + drop dup gensym swap 2dup id>> compiled-parsers set-at + 2dup parser-body define + dupd "peg" set-word-prop + ] cache nip ; : compile ( parser -- word ) [ compiled-parser ] with-compilation-unit ; From 749f10ba9fd39954e1d2162ae10ec91880b23921 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 28 Mar 2008 00:50:46 +1300 Subject: [PATCH 128/219] Implement direct left recursion As per VPRI Technical Report TR-2007-002 section 3.2 --- extra/peg/peg.factor | 49 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 46 insertions(+), 3 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 9db23d9779..f93fd5ae9b 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -34,16 +34,59 @@ GENERIC: (compile) ( parser -- quot ) #! that maps the input string position to the parser result. packrat get [ drop H{ } clone ] cache ; +TUPLE: left-recursion detected? ; +C: left-recursion + +USE: prettyprint + +:: handle-left-recursive-result ( result -- result ) + #! If the result is from a left-recursive call, + #! note this and fail, otherwise return normal result + #! See figure 4 of packrat_TR-2007-002.pdf. + result [ + [let* | ast [ result ast>> ] | + ast left-recursion? [ t ast (>>detected?) f ] [ result ] if + ] + ] [ + f + ] if ; + +USE: io + +:: grow-lr ( input quot m -- result ) + #! 'Grow the Seed' algorithm to handle left recursion + [let* | ans [ input quot call ] | + [ ans not ] [ ans [ ans remaining>> input-from m remaining>> input-from <= ] [ f ] if ] 2array || [ + "recursion exiting with = " write ans . "m was " write m . + ans + ] [ + "recursion with = " write ans . + input quot ans grow-lr + ] if + ] ; + :: cached-result ( input-cache input quot -- result ) #! Get the cached result for input position #! from the input cache. If the item is not in the cache, #! call 'quot' with 'input' on the stack to get the result #! and store that in the cache and return it. + #! See figure 4 of packrat_TR-2007-002.pdf. + "cached-result " write input . "quot is " write quot . input input-from input-cache [ drop - f input input-from input-cache set-at - input quot call - ] cache ; inline + [let* | lr [ f ] + m [ input lr ] + ans [ m input input-from input-cache set-at input quot call ] + | + lr detected?>> ans and [ + input quot ans grow-lr + ] [ + ans + ] if + ] + ] cache + "found in cache: " write dup . "for quot " write quot . + handle-left-recursive-result "after handle " write dup . ; :: run-packrat-parser ( input quot id -- result ) id input-cache From d2190fd1ecdfc7c6f3a261b35dc0959a5ac863ac Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 28 Mar 2008 13:40:26 +1300 Subject: [PATCH 129/219] Direct left recurson working --- extra/peg/peg.factor | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index f93fd5ae9b..84ccefdf35 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -38,23 +38,26 @@ TUPLE: left-recursion detected? ; C: left-recursion USE: prettyprint +USE: io + :: handle-left-recursive-result ( result -- result ) #! If the result is from a left-recursive call, #! note this and fail, otherwise return normal result #! See figure 4 of packrat_TR-2007-002.pdf. + ">>handle-left-recursive-result " write result . result [ [let* | ast [ result ast>> ] | ast left-recursion? [ t ast (>>detected?) f ] [ result ] if ] ] [ f - ] if ; + ] if + "<>grow-lr " write input . " for parser " write parser . " m is " write m . [let* | ans [ input quot call ] | [ ans not ] [ ans [ ans remaining>> input-from m remaining>> input-from <= ] [ f ] if ] 2array || [ "recursion exiting with = " write ans . "m was " write m . @@ -63,34 +66,38 @@ USE: io "recursion with = " write ans . input quot ans grow-lr ] if - ] ; + ] + "<>cached-result " write input . " for parser " write parser . input input-from input-cache [ drop [let* | lr [ f ] m [ input lr ] ans [ m input input-from input-cache set-at input quot call ] | + "--lr is " write lr . " ans is " write ans . " for parser " write parser . + ans input input-from input-cache set-at lr detected?>> ans and [ - input quot ans grow-lr + input quot parser ans grow-lr ] [ ans ] if ] ] cache - "found in cache: " write dup . "for quot " write quot . - handle-left-recursive-result "after handle " write dup . ; + dup [ handle-left-recursive-result ] when + "<> input-cache + input quot parser cached-result ; inline : run-parser ( input quot -- result ) #! If a packrat cache is available, use memoization for @@ -101,11 +108,10 @@ USE: io #! Return the body of the word that is the compiled version #! of the parser. [let* | parser-quot [ parser (compile) ] - id [ parser id>> ] | [ packrat get [ - parser-quot id run-packrat-parser + parser-quot parser run-packrat-parser ] [ parser-quot call ] if From 248c88554edcfc8d3f210f8169b38d9f8cbbdfa1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 27 Mar 2008 22:18:43 -0600 Subject: [PATCH 130/219] builder.release: update 'common-files' --- extra/builder/release/release.factor | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/extra/builder/release/release.factor b/extra/builder/release/release.factor index bb0d16c9da..d76eda8013 100644 --- a/extra/builder/release/release.factor +++ b/extra/builder/release/release.factor @@ -20,21 +20,15 @@ IN: builder.release "boot.x86.32.image" "boot.x86.64.image" "boot.macosx-ppc.image" + "boot.linux-ppc.image" "vm" "temp" "logs" ".git" ".gitignore" "Makefile" - "cp_dir" "unmaintained" - "misc/target" - "misc/wordsize" - "misc/wordsize.c" - "misc/macos-release.sh" - "misc/source-release.sh" - "misc/windows-release.sh" - "misc/version.sh" + "build-support" } ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 0934473b72adf14c3c53f8b78996d70fd8926b98 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 27 Mar 2008 22:22:19 -0600 Subject: [PATCH 131/219] builder: cd changed --- extra/builder/builder.factor | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 19734a3266..461d951209 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -13,6 +13,12 @@ IN: builder ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! : cd ( path -- ) current-directory set ; + +: cd ( path -- ) set-current-directory ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + : prepare-build-machine ( -- ) builds make-directory builds cd From bbd1ac71808d72520eed014ab08abfd5e4df2c75 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 28 Mar 2008 01:22:51 -0500 Subject: [PATCH 132/219] Fix launchers --- extra/io/unix/launcher/launcher.factor | 2 +- extra/io/windows/launcher/launcher.factor | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 1292f2cacf..f738bd42c2 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -70,7 +70,7 @@ USE: unix [ setup-priority setup-redirection - current-directory get cd + current-directory get resource-path cd dup pass-environment? [ dup get-environment set-os-envs ] when diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor index 84f8360840..31247e43c3 100755 --- a/extra/io/windows/launcher/launcher.factor +++ b/extra/io/windows/launcher/launcher.factor @@ -23,12 +23,12 @@ TUPLE: CreateProcess-args : default-CreateProcess-args ( -- obj ) CreateProcess-args construct-empty - 0 >>dwCreateFlags "STARTUPINFO" "STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo "PROCESS_INFORMATION" >>lpProcessInformation TRUE >>bInheritHandles - current-directory get >>lpCurrentDirectory ; + 0 >>dwCreateFlags + current-directory get normalize-pathname >>lpCurrentDirectory ; : call-CreateProcess ( CreateProcess-args -- ) { From 1d87e513f554df459c449a9b7de94788e72c7ab4 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 28 Mar 2008 15:51:18 +1300 Subject: [PATCH 133/219] lr2 wip --- extra/peg/peg.factor | 162 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 140 insertions(+), 22 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 84ccefdf35..96fe36f85f 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -15,6 +15,19 @@ SYMBOL: ignore parse-result construct-boa ; SYMBOL: packrat +SYMBOL: lrstack + +TUPLE: phead rule involved-set eval-set ; +C: phead + +: input-from ( input -- n ) + #! Return the index from the original string that the + #! input slice is based on. + dup slice? [ slice-from ] [ drop 0 ] if ; + +: heads ( input -- h ) + input-from \ heads get at ; + : compiled-parsers ( -- cache ) \ compiled-parsers get-global [ H{ } clone dup \ compiled-parsers set-global ] unless* ; @@ -24,17 +37,12 @@ SYMBOL: packrat GENERIC: (compile) ( parser -- quot ) -: input-from ( input -- n ) - #! Return the index from the original string that the - #! input slice is based on. - dup slice? [ slice-from ] [ drop 0 ] if ; - : input-cache ( id -- cache ) #! From the packrat cache, obtain the cache for the parser quotation #! that maps the input string position to the parser result. packrat get [ drop H{ } clone ] cache ; -TUPLE: left-recursion detected? ; +TUPLE: left-recursion seed rule head next ; C: left-recursion USE: prettyprint @@ -54,22 +62,138 @@ USE: io f ] if "<>grow-lr " write input . " for parser " write parser . " m is " write m . - [let* | ans [ input quot call ] | - [ ans not ] [ ans [ ans remaining>> input-from m remaining>> input-from <= ] [ f ] if ] 2array || [ + ">>(grow-lr) " write input . " for parser " write parser . " m is " write m . + [let* | + pos [ input ] + ans [ h involved-set>> clone h (>>eval-set) input quot call ] + | + [ ans not ] [ ans [ pos input-from m remaining>> input-from <= ] [ f ] if ] 2array || [ "recursion exiting with = " write ans . "m was " write m . - ans + m ] [ "recursion with = " write ans . - input quot ans grow-lr + pos quot parser pos ans ast>> h (grow-lr) ] if ] - "<> input-cache at* [ drop not-found ] unless ; + + +:: involved? ( parser h -- ? ) + h rule>> parser = [ + t + ] [ + parser h involved-set>> member? + ] if ; + +:: recall ( input quot parser -- result ) + [let* | + m [ parser input memo ] + h [ input heads ] + | + #! If not growing a seed pass, just return what is stored + #! in the memo table. + h [ + m not-found = parser h involved? not and [ + f + ] [ + parser h eval-set>> member? [ + parser h eval-set>> remove h (>>eval-set) + input quot call + ] [ + m + ] if + ] if + ] [ + m + ] if + ] ; + +:: (setup-lr) ( parser l s -- ) + s head>> l head>> = [ + l head>> s (>>head) + l head>> [ s rule>> add ] change-involved-set drop + parser l s next>> (setup-lr) + ] unless ; + +:: setup-lr ( parser l -- ) + [let* | + s [ lrstack get ] + | + l head>> [ parser V{ } clone V{ } clone l (>>head) ] unless + parser l s (setup-lr) + ] ; + +:: lr-answer ( quot parser input m -- result ) + [let* | + h [ m ast>> head>> ] + | + h rule>> parser = [ + "changing memo ast to seed " write + m [ seed>> ast>> dup . ] change-ast drop + m input input-from parser id>> input-cache set-at + m ast>> not [ + f + ] [ + input quot parser m h grow-lr + ] if + ] [ + m ast>> seed>> + ] if + ] ; + +:: (apply-rule) ( quot parser input -- result ) + [let* | + lr [ f parser f lrstack get ] + m [ lr lrstack set input lr ] + ans [ m input input-from parser id>> input-cache set-at input quot call ] + | + lrstack get next>> lrstack set + lr head>> [ +"setting seed to ans " write ans . + ans lr (>>seed) + quot parser input m lr-answer + ] [ + ans + ] if + ] ; + +:: apply-rule ( quot parser input -- result ) + [let* | + m [ input quot parser recall ] + | + m not-found = [ + quot parser input (apply-rule) + dup input input-from parser id>> input-cache set-at + ] [ + m [ + m ast>> left-recursion? [ + "Found left recursion..." print + parser m ast>> setup-lr m remaining>> m ast>> seed>> + dup input input-from parser id>> input-cache set-at + ] [ + m + dup input input-from parser id>> input-cache set-at + ] if + ] [ + f f input input-from parser id>> input-cache set-at + ] if + ] if + ] ; + :: cached-result ( input-cache input quot parser -- result ) #! Get the cached result for input position #! from the input cache. If the item is not in the cache, @@ -96,13 +220,7 @@ USE: io "<> input-cache - input quot parser cached-result ; inline - -: run-parser ( input quot -- result ) - #! If a packrat cache is available, use memoization for - #! packrat parsing, otherwise do a standard peg call. - packrat get [ run-packrat-parser ] [ call ] if* ; inline + quot parser input apply-rule ; :: parser-body ( parser -- quot ) #! Return the body of the word that is the compiled version @@ -139,7 +257,7 @@ USE: io : with-packrat ( quot -- result ) #! Run the quotation with a packrat cache active. - [ H{ } clone packrat ] dip with-variable ; inline + H{ } clone \ heads [ [ H{ } clone packrat ] dip with-variable ] with-variable ; inline : packrat-parse ( state parser -- result ) [ parse ] with-packrat ; From 4b353c75297e2ab0eb7cf23ed0c9e91caaffe90a Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 28 Mar 2008 23:20:43 +1300 Subject: [PATCH 134/219] Rewrite peg internals --- extra/peg/peg-docs.factor | 43 +---- extra/peg/peg-tests.factor | 21 +-- extra/peg/peg.factor | 323 +++++++++++-------------------------- 3 files changed, 104 insertions(+), 283 deletions(-) diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor index c93d1af830..d2ca353ba1 100644 --- a/extra/peg/peg-docs.factor +++ b/extra/peg/peg-docs.factor @@ -12,41 +12,7 @@ HELP: parse { $description "Given the input string, parse it using the given parser. The result is a object if " "the parse was successful, otherwise it is f." } -{ $see-also compile with-packrat packrat-parse } ; - -HELP: with-packrat -{ $values - { "quot" "a quotation with stack effect ( input -- result )" } - { "result" "the result of the quotation" } -} -{ $description - "Calls the quotation with a packrat cache in scope. Usually the quotation will " - "call " { $link parse } " or call a word produced by " { $link compile } "." - "The cache is used to avoid the possible exponential time performace that pegs " - "can have, instead giving linear time at the cost of increased memory usage. " - "Use of this packrat option also allows direct and indirect recursion to " - "be handled in the parser without entering an infinite loop." } -{ $see-also compile parse packrat-parse packrat-call } ; - -HELP: packrat-parse -{ $values - { "input" "a string" } - { "parser" "a parser" } - { "result" "a parse-result or f" } -} -{ $description - "Compiles and calls the parser with a packrat cache in scope." } -{ $see-also compile parse packrat-call with-packrat } ; - -HELP: packrat-call -{ $values - { "input" "a string" } - { "quot" "a quotation with stack effect ( input -- result )" } - { "result" "a parse-result or f" } -} -{ $description - "Calls the compiled parser with a packrat cache in scope." } -{ $see-also compile packrat-call packrat-parse with-packrat } ; +{ $see-also compile } ; HELP: compile { $values @@ -54,11 +20,12 @@ HELP: compile { "word" "a word" } } { $description - "Compile the parser to a word. The word will have stack effect ( input -- result )." + "Compile the parser to a word. The word will have stack effect ( -- result )." "The mapping from parser to compiled word is kept in a cache. If you later change " "the definition of a parser you'll need to clear this cache with " - { $link reset-compiled-parsers } " before using " { $link compile } " on that parser again." } -{ $see-also compile with-packrat reset-compiled-parsers packrat-call packrat-parse } ; + { $link reset-compiled-parsers } " before using " { $link compile } " on that parser again." +} +{ $see-also parse } ; HELP: reset-compiled-parsers { $description diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index 7e2701bc48..7467a4111a 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -168,32 +168,13 @@ IN: peg.tests "1+1" swap parse parse-result-ast ] unit-test -{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [ - [ - [ - [ "1" token , "-" token , "1" token , ] seq* , - [ "1" token , "+" token , "1" token , ] seq* , - ] choice* - "1-1" over parse parse-result-ast swap - ] with-packrat - [ - "1+1" swap parse parse-result-ast - ] with-packrat -] unit-test - : expr ( -- parser ) #! Test direct left recursion. Currently left recursion should cause a #! failure of that parser. [ expr ] delay "+" token "1" token 3seq "1" token 2choice ; -[ - #! Not using packrat, so recursion causes data stack overflow - "1+1" expr parse parse-result-ast -] must-fail - { "1" } [ - #! Using packrat, so expr fails, causing the 2nd choice to be used. - "1+1" expr [ parse ] with-packrat parse-result-ast + "1+1" expr parse parse-result-ast ] unit-test { t } [ diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 96fe36f85f..81a9ed8ace 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -7,6 +7,8 @@ USING: kernel sequences strings namespaces math assocs shuffle combinators.cleave locals ; IN: peg +USE: prettyprint + TUPLE: parse-result remaining ast ; SYMBOL: ignore @@ -15,18 +17,83 @@ SYMBOL: ignore parse-result construct-boa ; SYMBOL: packrat -SYMBOL: lrstack +SYMBOL: pos +SYMBOL: input +SYMBOL: fail -TUPLE: phead rule involved-set eval-set ; -C: phead +TUPLE: memo-entry ans pos ; +C: memo-entry + +: rule-parser ( rule -- parser ) + #! A rule is the parser compiled down to a word. It has + #! a "peg" property containing the original parser. + "peg" word-prop ; + +: input-slice ( -- slice ) + #! Return a slice of the input from the current parse position + input get pos get tail-slice ; : input-from ( input -- n ) #! Return the index from the original string that the #! input slice is based on. dup slice? [ slice-from ] [ drop 0 ] if ; -: heads ( input -- h ) - input-from \ heads get at ; +: input-cache ( parser -- cache ) + #! From the packrat cache, obtain the cache for the parser + #! that maps the position to the parser result. + id>> packrat get [ drop H{ } clone ] cache ; + +: eval-rule ( rule -- ast ) + #! Evaluate a rule, return an ast resulting from it. + #! Return fail if the rule failed. The rule has + #! stack effect ( input -- parse-result ) + pos get swap + execute [ + nip + [ ast>> ] [ remaining>> ] bi + input-from pos set + ] [ + pos set + fail + ] if* ; + +: memo ( pos rule -- memo-entry ) + #! Return the result from the memo cache. + rule-parser input-cache at ; + +: set-memo ( memo-entry pos rule -- ) + #! Store an entry in the cache + rule-parser input-cache set-at ; + +:: apply-non-memo-rule ( r p -- ast ) + [let* | + ans [ r eval-rule ] + m [ ans pos get ] + | + m p r set-memo ans + ] ; + +: apply-memo-rule ( m -- ast ) + [ ans>> ] [ pos>> ] bi pos set ; + +:: apply-rule ( r p -- ast ) + [let* | + m [ p r memo ] + | + m [ + m apply-memo-rule + ] [ + r p apply-non-memo-rule + ] if + ] ; + +: with-packrat ( input quot -- result ) + #! Run the quotation with a packrat cache active. + swap [ + input set + 0 pos set + H{ } clone packrat set + ] H{ } make-assoc swap bind ; : compiled-parsers ( -- cache ) @@ -35,203 +102,21 @@ C: phead : reset-compiled-parsers ( -- ) H{ } clone \ compiled-parsers set-global ; +reset-compiled-parsers + GENERIC: (compile) ( parser -- quot ) -: input-cache ( id -- cache ) - #! From the packrat cache, obtain the cache for the parser quotation - #! that maps the input string position to the parser result. - packrat get [ drop H{ } clone ] cache ; - -TUPLE: left-recursion seed rule head next ; -C: left-recursion - -USE: prettyprint -USE: io - - -:: handle-left-recursive-result ( result -- result ) - #! If the result is from a left-recursive call, - #! note this and fail, otherwise return normal result - #! See figure 4 of packrat_TR-2007-002.pdf. - ">>handle-left-recursive-result " write result . - result [ - [let* | ast [ result ast>> ] | - ast left-recursion? [ t ast (>>detected?) f ] [ result ] if - ] - ] [ - f - ] if - "<>(grow-lr) " write input . " for parser " write parser . " m is " write m . - [let* | - pos [ input ] - ans [ h involved-set>> clone h (>>eval-set) input quot call ] - | - [ ans not ] [ ans [ pos input-from m remaining>> input-from <= ] [ f ] if ] 2array || [ - "recursion exiting with = " write ans . "m was " write m . - m - ] [ - "recursion with = " write ans . - pos quot parser pos ans ast>> h (grow-lr) - ] if - ] - "<<(grow-lr) " write input . " for parser " write parser . " m is " write m . " result is " write dup . - ; - -:: grow-lr ( input quot parser m h -- result ) - h input input-from \ heads get set-at - input quot parser m h (grow-lr) - f input input-from \ heads get set-at ; - -SYMBOL: not-found - -: memo ( parser input -- result ) - input-from swap id>> input-cache at* [ drop not-found ] unless ; - - -:: involved? ( parser h -- ? ) - h rule>> parser = [ - t - ] [ - parser h involved-set>> member? - ] if ; - -:: recall ( input quot parser -- result ) - [let* | - m [ parser input memo ] - h [ input heads ] - | - #! If not growing a seed pass, just return what is stored - #! in the memo table. - h [ - m not-found = parser h involved? not and [ - f - ] [ - parser h eval-set>> member? [ - parser h eval-set>> remove h (>>eval-set) - input quot call - ] [ - m - ] if - ] if - ] [ - m - ] if - ] ; - -:: (setup-lr) ( parser l s -- ) - s head>> l head>> = [ - l head>> s (>>head) - l head>> [ s rule>> add ] change-involved-set drop - parser l s next>> (setup-lr) - ] unless ; - -:: setup-lr ( parser l -- ) - [let* | - s [ lrstack get ] - | - l head>> [ parser V{ } clone V{ } clone l (>>head) ] unless - parser l s (setup-lr) - ] ; - -:: lr-answer ( quot parser input m -- result ) - [let* | - h [ m ast>> head>> ] - | - h rule>> parser = [ - "changing memo ast to seed " write - m [ seed>> ast>> dup . ] change-ast drop - m input input-from parser id>> input-cache set-at - m ast>> not [ - f - ] [ - input quot parser m h grow-lr - ] if - ] [ - m ast>> seed>> - ] if - ] ; - -:: (apply-rule) ( quot parser input -- result ) - [let* | - lr [ f parser f lrstack get ] - m [ lr lrstack set input lr ] - ans [ m input input-from parser id>> input-cache set-at input quot call ] - | - lrstack get next>> lrstack set - lr head>> [ -"setting seed to ans " write ans . - ans lr (>>seed) - quot parser input m lr-answer - ] [ - ans - ] if - ] ; - -:: apply-rule ( quot parser input -- result ) - [let* | - m [ input quot parser recall ] - | - m not-found = [ - quot parser input (apply-rule) - dup input input-from parser id>> input-cache set-at - ] [ - m [ - m ast>> left-recursion? [ - "Found left recursion..." print - parser m ast>> setup-lr m remaining>> m ast>> seed>> - dup input input-from parser id>> input-cache set-at - ] [ - m - dup input input-from parser id>> input-cache set-at - ] if - ] [ - f f input input-from parser id>> input-cache set-at - ] if - ] if - ] ; - -:: cached-result ( input-cache input quot parser -- result ) - #! Get the cached result for input position - #! from the input cache. If the item is not in the cache, - #! call 'quot' with 'input' on the stack to get the result - #! and store that in the cache and return it. - #! See figure 4 of packrat_TR-2007-002.pdf. - ">>cached-result " write input . " for parser " write parser . - input input-from input-cache [ - drop - [let* | lr [ f ] - m [ input lr ] - ans [ m input input-from input-cache set-at input quot call ] - | - "--lr is " write lr . " ans is " write ans . " for parser " write parser . - ans input input-from input-cache set-at - lr detected?>> ans and [ - input quot parser ans grow-lr - ] [ - ans - ] if - ] - ] cache - dup [ handle-left-recursive-result ] when - "< ] if ] ] ; @@ -253,17 +138,8 @@ SYMBOL: not-found [ compiled-parser ] with-compilation-unit ; : parse ( state parser -- result ) - compile execute ; inline - -: with-packrat ( quot -- result ) - #! Run the quotation with a packrat cache active. - H{ } clone \ heads [ [ H{ } clone packrat ] dip with-variable ] with-variable ; inline - -: packrat-parse ( state parser -- result ) - [ parse ] with-packrat ; - -: packrat-call ( state quot -- result ) - with-packrat ; inline + dup word? [ compile ] unless + [ execute ] curry with-packrat ; parser : reset-delegates ( -- ) H{ } clone \ delegates set-global ; +reset-delegates + : init-parser ( parser -- parser ) #! Set the delegate for the parser. Equivalent parsers #! get a delegate with the same id. @@ -307,15 +185,15 @@ MATCH-VARS: ?token ; ] if ; M: token-parser (compile) ( parser -- quot ) - symbol>> [ parse-token ] curry ; - + [ \ input-slice , symbol>> , \ parse-token , ] [ ] make ; + TUPLE: satisfy-parser quot ; MATCH-VARS: ?quot ; : satisfy-pattern ( -- quot ) [ - dup empty? [ + input-slice dup empty? [ drop f ] [ unclip-slice dup ?quot call [ @@ -335,7 +213,7 @@ MATCH-VARS: ?min ?max ; : range-pattern ( -- quot ) [ - dup empty? [ + input-slice dup empty? [ drop f ] [ 0 over nth dup @@ -355,7 +233,7 @@ TUPLE: seq-parser parsers ; : seq-pattern ( -- quot ) [ dup [ - dup remaining>> ?quot [ + ?quot [ [ remaining>> swap (>>remaining) ] 2keep ast>> dup ignore = [ drop @@ -372,7 +250,7 @@ TUPLE: seq-parser parsers ; M: seq-parser (compile) ( parser -- quot ) [ - [ V{ } clone ] % + [ input-slice V{ } clone ] % parsers>> [ compiled-parser \ ?quot seq-pattern match-replace % ] each ] [ ] make ; @@ -380,24 +258,19 @@ TUPLE: choice-parser parsers ; : choice-pattern ( -- quot ) [ - dup [ - - ] [ - drop dup ?quot - ] if + [ ?quot ] unless* ] ; M: choice-parser (compile) ( parser -- quot ) - [ + [ f , parsers>> [ compiled-parser \ ?quot choice-pattern match-replace % ] each - \ nip , ] [ ] make ; TUPLE: repeat0-parser p1 ; : (repeat0) ( quot result -- result ) - 2dup remaining>> swap call [ + over call [ [ remaining>> swap (>>remaining) ] 2keep ast>> swap [ ast>> push ] keep (repeat0) @@ -412,7 +285,7 @@ TUPLE: repeat0-parser p1 ; M: repeat0-parser (compile) ( parser -- quot ) [ - [ V{ } clone ] % + [ input-slice V{ } clone ] % p1>> compiled-parser \ ?quot repeat0-pattern match-replace % ] [ ] make ; @@ -431,7 +304,7 @@ TUPLE: repeat1-parser p1 ; M: repeat1-parser (compile) ( parser -- quot ) [ - [ V{ } clone ] % + [ input-slice V{ } clone ] % p1>> compiled-parser \ ?quot repeat1-pattern match-replace % ] [ ] make ; @@ -439,7 +312,7 @@ TUPLE: optional-parser p1 ; : optional-pattern ( -- quot ) [ - dup ?quot swap f or + ?quot [ input-slice f ] unless* ] ; M: optional-parser (compile) ( parser -- quot ) @@ -449,7 +322,7 @@ TUPLE: ensure-parser p1 ; : ensure-pattern ( -- quot ) [ - dup ?quot [ + input-slice ?quot [ ignore ] [ drop f @@ -463,7 +336,7 @@ TUPLE: ensure-not-parser p1 ; : ensure-not-pattern ( -- quot ) [ - dup ?quot [ + input-slice ?quot [ drop f ] [ ignore @@ -486,7 +359,7 @@ MATCH-VARS: ?action ; ] ; M: action-parser (compile) ( parser -- quot ) - { [ p1>> ] [ quot>> ] } cleave [ compiled-parser ] dip + [ p1>> compiled-parser ] [ quot>> ] bi 2array { ?quot ?action } action-pattern match-replace ; : left-trim-slice ( string -- string ) @@ -500,7 +373,7 @@ TUPLE: sp-parser p1 ; M: sp-parser (compile) ( parser -- quot ) [ - \ left-trim-slice , p1>> compiled-parser , + \ input-slice , \ left-trim-slice , \ input-from , \ pos , \ set , p1>> compiled-parser , ] [ ] make ; TUPLE: delay-parser quot ; From cca4700e490f26ef8394df099582313537cf575c Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 00:41:41 +1300 Subject: [PATCH 135/219] Fix ebnf for peg changes --- extra/peg/ebnf/ebnf-tests.factor | 16 +--------------- extra/peg/ebnf/ebnf.factor | 6 +++--- 2 files changed, 4 insertions(+), 18 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index dea549eb37..a511e271c2 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -147,27 +147,13 @@ IN: peg.ebnf.tests [ #! Test direct left recursion. Currently left recursion should cause a #! failure of that parser. - #! Not using packrat, so recursion causes data stack overflow "1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call ] must-fail -{ V{ 49 } } [ - #! Test direct left recursion. Currently left recursion should cause a - #! failure of that parser. - #! Using packrat, so first part of expr fails, causing 2nd choice to be used - "1+1" [ [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call ] with-packrat parse-result-ast -] unit-test - [ #! Test indirect left recursion. Currently left recursion should cause a #! failure of that parser. - #! Not using packrat, so recursion causes data stack overflow + #! Using packrat, so first part of expr fails, causing 2nd choice to be used "1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call ] must-fail -{ V{ 49 } } [ - #! Test indirect left recursion. Currently left recursion should cause a - #! failure of that parser. - #! Using packrat, so first part of expr fails, causing 2nd choice to be used - "1+1" [ [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call ] with-packrat parse-result-ast -] unit-test diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index ed0dea0410..3efe2d6979 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -266,7 +266,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) ] [ ] make delay sp ; : transform-ebnf ( string -- object ) - 'ebnf' packrat-parse parse-result-ast transform ; + 'ebnf' parse parse-result-ast transform ; : check-parse-result ( result -- result ) dup [ @@ -281,8 +281,8 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) ] if ; : ebnf>quot ( string -- hashtable quot ) - 'ebnf' packrat-parse check-parse-result - parse-result-ast transform dup main swap at compile 1quotation ; + 'ebnf' parse check-parse-result + parse-result-ast transform dup main swap at compile [ parse ] curry ; : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing From 010ce8007607a2867c6bb2586b7cfb4890fc81c0 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 00:49:39 +1300 Subject: [PATCH 136/219] Handle left recursion by failing again --- extra/peg/ebnf/ebnf-tests.factor | 13 +++++++------ extra/peg/peg.factor | 6 ++++-- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index a511e271c2..aa47d37e55 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -144,16 +144,17 @@ IN: peg.ebnf.tests "Z" [EBNF foo=[^A-Z] EBNF] call ] unit-test -[ +{ V{ 49 } } [ #! Test direct left recursion. Currently left recursion should cause a #! failure of that parser. - "1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call -] must-fail + #! Using packrat, so first part of expr fails, causing 2nd choice to be used + "1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call parse-result-ast +] unit-test -[ +{ V{ 49 } } [ #! Test indirect left recursion. Currently left recursion should cause a #! failure of that parser. #! Using packrat, so first part of expr fails, causing 2nd choice to be used - "1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call -] must-fail + "1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call parse-result-ast +] unit-test diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 81a9ed8ace..1d2f67f52e 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -67,10 +67,12 @@ C: memo-entry :: apply-non-memo-rule ( r p -- ast ) [let* | + m [ fail p dup p r set-memo ] ans [ r eval-rule ] - m [ ans pos get ] | - m p r set-memo ans + ans m (>>ans) + pos get m (>>pos) + ans ] ; : apply-memo-rule ( m -- ast ) From 68cbdf76aa05aa684ecbe966aba04e4ca3797fe4 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 01:17:54 +1300 Subject: [PATCH 137/219] Handle direct left recusion --- extra/peg/peg.factor | 39 +++++++++++++++++++++++++++++++++++---- 1 file changed, 35 insertions(+), 4 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 1d2f67f52e..b24ee0aa62 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -24,6 +24,9 @@ SYMBOL: fail TUPLE: memo-entry ans pos ; C: memo-entry +TUPLE: left-recursion detected? ; +C: left-recursion + : rule-parser ( rule -- parser ) #! A rule is the parser compiled down to a word. It has #! a "peg" property containing the original parser. @@ -48,7 +51,9 @@ C: memo-entry #! Return fail if the rule failed. The rule has #! stack effect ( input -- parse-result ) pos get swap - execute [ + execute +! drop f f + [ nip [ ast>> ] [ remaining>> ] bi input-from pos set @@ -65,18 +70,44 @@ C: memo-entry #! Store an entry in the cache rule-parser input-cache set-at ; +:: (grow-lr) ( r p m h -- ) + p pos set + r eval-rule + dup fail = pos get m pos>> <= or [ + drop + ] [ + m (>>ans) + pos get m (>>pos) + r p m h (grow-lr) + ] if ; + +:: grow-lr ( r p m h -- ast ) + #! Placeholder for full left recursion implementation + r p m h (grow-lr) m pos>> pos set m ans>> + ; + :: apply-non-memo-rule ( r p -- ast ) [let* | - m [ fail p dup p r set-memo ] + lr [ f ] + m [ lr p dup p r set-memo ] ans [ r eval-rule ] | ans m (>>ans) pos get m (>>pos) - ans + lr detected?>> ans fail = not and [ + r p m f grow-lr + ] [ + ans + ] if ] ; : apply-memo-rule ( m -- ast ) - [ ans>> ] [ pos>> ] bi pos set ; + [ ans>> ] [ pos>> ] bi + pos set + dup left-recursion? [ + t swap (>>detected?) + fail + ] when ; :: apply-rule ( r p -- ast ) [let* | From dd979c8b3b42b5da7ed5832bff4b9a2882d3c2ee Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 02:45:21 +1300 Subject: [PATCH 138/219] Indirect Left recursive grammars working --- extra/peg/peg.factor | 102 +++++++++++++++++++++++++++++++++++-------- 1 file changed, 84 insertions(+), 18 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index b24ee0aa62..fd00c3d2ae 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -20,13 +20,18 @@ SYMBOL: packrat SYMBOL: pos SYMBOL: input SYMBOL: fail +SYMBOL: lrstack +SYMBOL: heads TUPLE: memo-entry ans pos ; C: memo-entry -TUPLE: left-recursion detected? ; +TUPLE: left-recursion seed rule head next ; C: left-recursion +TUPLE: peg-head rule involved-set eval-set ; +C: peg-head + : rule-parser ( rule -- parser ) #! A rule is the parser compiled down to a word. It has #! a "peg" property containing the original parser. @@ -72,6 +77,7 @@ C: left-recursion :: (grow-lr) ( r p m h -- ) p pos set + h involved-set>> clone h (>>eval-set) r eval-rule dup fail = pos get m pos>> <= or [ drop @@ -82,39 +88,97 @@ C: left-recursion ] if ; :: grow-lr ( r p m h -- ast ) - #! Placeholder for full left recursion implementation - r p m h (grow-lr) m pos>> pos set m ans>> + h p heads get set-at + r p m h (grow-lr) + p heads get delete-at + m pos>> pos set m ans>> ; +:: (setup-lr) ( r l s -- ) + s head>> l head>> eq? [ + l head>> s (>>head) + l head>> [ s rule>> add ] change-involved-set drop + r l s next>> (setup-lr) + ] unless ; + +:: setup-lr ( r l -- ) + l head>> [ + r V{ } clone V{ } clone l (>>head) + ] unless + r l lrstack get (setup-lr) ; + +:: lr-answer ( r p m -- ast ) + [let* | + h [ m ans>> head>> ] + | + h rule>> r eq? [ + m ans>> seed>> m (>>ans) + m ans>> fail = [ + fail + ] [ + r p m h grow-lr + ] if + ] [ + m ans>> seed>> + ] if + ] ; + +:: recall ( r p -- memo-entry ) + [let* | + m [ p r memo ] + h [ p heads get at ] + | + h [ + m r h involved-set>> h rule>> add member? not and [ + fail p + ] [ + r h eval-set>> member? [ + h [ r swap remove ] change-eval-set drop + r eval-rule + m (>>ans) + pos get m (>>pos) + m + ] [ + m + ] if + ] if + ] [ + m + ] if + ] ; + :: apply-non-memo-rule ( r p -- ast ) [let* | - lr [ f ] - m [ lr p dup p r set-memo ] + lr [ fail r f lrstack get ] + m [ lr lrstack set lr p dup p r set-memo ] ans [ r eval-rule ] | - ans m (>>ans) + lrstack get next>> lrstack set pos get m (>>pos) - lr detected?>> ans fail = not and [ - r p m f grow-lr + lr head>> [ + ans lr (>>seed) + r p m lr-answer ] [ + ans m (>>ans) ans - ] if + ] if ] ; -: apply-memo-rule ( m -- ast ) - [ ans>> ] [ pos>> ] bi - pos set - dup left-recursion? [ - t swap (>>detected?) - fail - ] when ; +:: apply-memo-rule ( r m -- ast ) + m pos>> pos set + m ans>> left-recursion? [ + r m ans>> setup-lr + m ans>> seed>> + ] [ + m ans>> + ] if ; :: apply-rule ( r p -- ast ) [let* | - m [ p r memo ] + m [ r p recall ] | m [ - m apply-memo-rule + r m apply-memo-rule ] [ r p apply-non-memo-rule ] if @@ -125,6 +189,8 @@ C: left-recursion swap [ input set 0 pos set + f lrstack set + H{ } clone heads set H{ } clone packrat set ] H{ } make-assoc swap bind ; From 261539a86ab13a9cc5c3be69cc8de2e317f8d6d9 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 02:47:03 +1300 Subject: [PATCH 139/219] Unit test for left recursive grammar --- extra/peg/peg-tests.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index 7467a4111a..f57fe83220 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -173,8 +173,8 @@ IN: peg.tests #! failure of that parser. [ expr ] delay "+" token "1" token 3seq "1" token 2choice ; -{ "1" } [ - "1+1" expr parse parse-result-ast +{ V{ V{ "1" "+" "1" } "+" "1" } } [ + "1+1+1" expr parse parse-result-ast ] unit-test { t } [ From 25eea7ea1b6d115e749dd9650b8975b3a86495e6 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 02:51:49 +1300 Subject: [PATCH 140/219] Fix ebnf tests for left recursion --- extra/peg/ebnf/ebnf-tests.factor | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index aa47d37e55..fbf13f69a2 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -144,17 +144,21 @@ IN: peg.ebnf.tests "Z" [EBNF foo=[^A-Z] EBNF] call ] unit-test -{ V{ 49 } } [ - #! Test direct left recursion. Currently left recursion should cause a - #! failure of that parser. +{ V{ V{ 49 } "+" V{ 49 } } } [ + #! Test direct left recursion. #! Using packrat, so first part of expr fails, causing 2nd choice to be used "1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call parse-result-ast ] unit-test -{ V{ 49 } } [ - #! Test indirect left recursion. Currently left recursion should cause a - #! failure of that parser. +{ V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [ + #! Test direct left recursion. #! Using packrat, so first part of expr fails, causing 2nd choice to be used - "1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call parse-result-ast + "1+1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call parse-result-ast +] unit-test + +{ V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [ + #! Test indirect left recursion. + #! Using packrat, so first part of expr fails, causing 2nd choice to be used + "1+1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call parse-result-ast ] unit-test From 7bf27a5eb2034ad704ecadd131da0e8c655f69fb Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 03:41:40 +1300 Subject: [PATCH 141/219] EBNF test using Java Primary production --- extra/peg/ebnf/ebnf-tests.factor | 44 ++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index fbf13f69a2..c2c0a50a59 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -162,3 +162,47 @@ IN: peg.ebnf.tests "1+1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call parse-result-ast ] unit-test +EBNF: primary +Primary = PrimaryNoNewArray +PrimaryNoNewArray = ClassInstanceCreationExpression + | MethodInvocation + | FieldAccess + | ArrayAccess + | "this" +ClassInstanceCreationExpression = "new" ClassOrInterfaceType "(" ")" + | Primary "." "new" Identifier "(" ")" +MethodInvocation = Primary "." MethodName "(" ")" + | MethodName "(" ")" +FieldAccess = Primary "." Identifier + | "super" "." Identifier +ArrayAccess = Primary "[" Expression "]" + | ExpressionName "[" Expression "]" +ClassOrInterfaceType = ClassName | InterfaceTypeName +ClassName = "C" | "D" +InterfaceTypeName = "I" | "J" +Identifier = "x" | "y" | ClassOrInterfaceType +MethodName = "m" | "n" +ExpressionName = Identifier +Expression = "i" | "j" +main = Primary +;EBNF + +{ "this" } [ + "this" primary parse-result-ast +] unit-test + +{ V{ "this" "." "x" } } [ + "this.x" primary parse-result-ast +] unit-test + +{ V{ V{ "this" "." "x" } "." "y" } } [ + "this.x.y" primary parse-result-ast +] unit-test + +{ V{ V{ "this" "." "x" } "." "m" "(" ")" } } [ + "this.x.m()" primary parse-result-ast +] unit-test + +{ V{ V{ V{ "x" "[" "i" "]" } "[" "j" "]" } "." "y" } } [ + "x[i][j].y" primary parse-result-ast +] unit-test From 3e2a867c3a743d8d1b8cd03c8ca5f33115ef17ef Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 28 Mar 2008 13:37:05 -0500 Subject: [PATCH 142/219] implement touch-file on windows --- extra/io/windows/files/files.factor | 41 ++++++++++++++++++++++++++++- extra/io/windows/windows.factor | 21 ++++++++++++++- 2 files changed, 60 insertions(+), 2 deletions(-) diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 655b5f9daf..7d88392fdc 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -3,7 +3,8 @@ USING: alien.c-types io.backend io.files io.windows kernel math windows windows.kernel32 combinators.cleave windows.time calendar combinators math.functions -sequences namespaces words symbols ; +sequences namespaces words symbols combinators.lib +io.nonblocking destructors ; IN: io.windows.files SYMBOLS: +read-only+ +hidden+ +system+ @@ -93,3 +94,41 @@ M: windows-nt-io file-info ( path -- info ) M: windows-nt-io link-info ( path -- info ) file-info ; + +: file-times ( path -- timestamp timestamp timestamp ) + [ + normalize-pathname open-existing dup close-always + "FILETIME" + "FILETIME" + "FILETIME" + [ GetFileTime win32-error=0/f ] 3keep + [ FILETIME>timestamp >local-time ] 3apply + ] with-destructors ; + +: (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- ) + [ timestamp>FILETIME ] 3apply + SetFileTime win32-error=0/f ; + +: set-file-times ( path timestamp/f timestamp/f timestamp/f -- ) + #! timestamp order: creation access write + [ + >r >r >r + normalize-pathname open-existing dup close-always + r> r> r> (set-file-times) + ] with-destructors ; + +: set-file-create-time ( path timestamp -- ) + f f set-file-times ; + +: set-file-access-time ( path timestamp -- ) + >r f r> f set-file-times ; + +: set-file-write-time ( path timestamp -- ) + >r f f r> set-file-times ; + +M: windows-nt-io touch-file ( path -- ) + [ + normalize-pathname + maybe-create-file over close-always + [ drop ] [ f now dup (set-file-times) ] if + ] with-destructors ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 635a992777..64c4684e15 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -58,7 +58,8 @@ M: win32-file close-handle ( handle -- ) ] with-destructors ; : open-pipe-r/w ( path -- handle ) - GENERIC_READ GENERIC_WRITE bitor OPEN_EXISTING 0 open-file ; + { GENERIC_READ GENERIC_WRITE } flags + OPEN_EXISTING 0 open-file ; : open-read ( path -- handle length ) GENERIC_READ OPEN_EXISTING 0 open-file 0 ; @@ -69,6 +70,24 @@ M: win32-file close-handle ( handle -- ) : (open-append) ( path -- handle ) GENERIC_WRITE OPEN_ALWAYS 0 open-file ; +: open-existing ( path -- handle ) + { GENERIC_READ GENERIC_WRITE } flags + share-mode + f + OPEN_EXISTING + FILE_FLAG_BACKUP_SEMANTICS + f CreateFileW dup win32-error=0/f ; + +: maybe-create-file ( path -- handle ? ) + #! return true if file was just created + { GENERIC_READ GENERIC_WRITE } flags + share-mode + f + OPEN_ALWAYS + 0 CreateFile-flags + f CreateFileW dup win32-error=0/f + GetLastError ERROR_ALREADY_EXISTS = not ; + : set-file-pointer ( handle length -- ) dupd d>w/w FILE_BEGIN SetFilePointer INVALID_SET_FILE_POINTER = [ From 8cf2fd88a52820650b62cdafeb35575e92127f8a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 28 Mar 2008 13:50:23 -0500 Subject: [PATCH 143/219] allow random-32* or random-bytes* to generate randomness in terms of each other --- .../mersenne-twister/mersenne-twister-tests.factor | 4 ++-- extra/random/mersenne-twister/mersenne-twister.factor | 2 +- extra/random/random.factor | 9 ++++++--- extra/random/windows/cryptographic/cryptographic.factor | 1 - 4 files changed, 9 insertions(+), 7 deletions(-) diff --git a/extra/random/mersenne-twister/mersenne-twister-tests.factor b/extra/random/mersenne-twister/mersenne-twister-tests.factor index 49bf4ad3f3..703a0c16e4 100755 --- a/extra/random/mersenne-twister/mersenne-twister-tests.factor +++ b/extra/random/mersenne-twister/mersenne-twister-tests.factor @@ -16,11 +16,11 @@ IN: random.mersenne-twister.tests [ f ] [ 1234 [ make-100-randoms make-100-randoms = ] test-rng ] unit-test [ 1333075495 ] [ - 0 [ 1000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng + 0 [ 1000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng ] unit-test [ 1575309035 ] [ - 0 [ 10000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng + 0 [ 10000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng ] unit-test diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index ed515716e0..53ec91b118 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -67,7 +67,7 @@ PRIVATE> M: mersenne-twister seed-random ( mt seed -- ) init-mt-seq >>seq drop ; -M: mersenne-twister random-32 ( mt -- r ) +M: mersenne-twister random-32* ( mt -- r ) dup [ seq>> ] [ i>> ] bi dup mt-n < [ drop 0 pick mt-generate ] unless new-nth mt-temper diff --git a/extra/random/random.factor b/extra/random/random.factor index b10e05d415..f4d4022ae9 100755 --- a/extra/random/random.factor +++ b/extra/random/random.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel math namespaces sequences -io.backend ; +io.backend io.binary ; IN: random SYMBOL: random-generator @@ -12,11 +12,14 @@ HOOK: os-crypto-random-32 io-backend ( -- r ) HOOK: os-random-32 io-backend ( -- r ) GENERIC: seed-random ( tuple seed -- ) -GENERIC: random-32 ( tuple -- r ) +GENERIC: random-32* ( tuple -- r ) GENERIC: random-bytes* ( tuple n -- bytes ) M: object random-bytes* ( tuple n -- byte-array ) - [ drop random-32 ] with map >c-uint-array ; + [ drop random-32* ] with map >c-uint-array ; + +M: object random-32* ( tuple -- n ) + 4 random-bytes* le> ; : random-bytes ( n -- r ) [ diff --git a/extra/random/windows/cryptographic/cryptographic.factor b/extra/random/windows/cryptographic/cryptographic.factor index 158f939af9..3f64209200 100644 --- a/extra/random/windows/cryptographic/cryptographic.factor +++ b/extra/random/windows/cryptographic/cryptographic.factor @@ -26,4 +26,3 @@ M: windows-cryptographic-rng random-bytes* ( tuple n -- bytes ) dup f f PROV_RSA_AES CRYPT_NEWKEYSET CryptAcquireContextW win32-error=0/f *void* ; - From 482efc9c58e6c0e348faf5ec6033fbf22f6169fd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 28 Mar 2008 15:09:21 -0500 Subject: [PATCH 144/219] fix load errors --- extra/random/blum-blum-shub/blum-blum-shub.factor | 2 +- extra/random/dummy/dummy.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/random/blum-blum-shub/blum-blum-shub.factor b/extra/random/blum-blum-shub/blum-blum-shub.factor index 2e59b625b1..00bf22d2a9 100755 --- a/extra/random/blum-blum-shub/blum-blum-shub.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub.factor @@ -32,5 +32,5 @@ IN: crypto ! ! #! Cryptographically secure random number using Blum-Blum-Shub 256 ! [ log2 1+ random-bits ] keep dupd >= [ -1 shift ] when ; -M: blum-blum-shub random-32 ( bbs -- r ) +M: blum-blum-shub random-32* ( bbs -- r ) ; diff --git a/extra/random/dummy/dummy.factor b/extra/random/dummy/dummy.factor index 12607456ec..9120381955 100755 --- a/extra/random/dummy/dummy.factor +++ b/extra/random/dummy/dummy.factor @@ -7,5 +7,5 @@ C: random-dummy M: random-dummy seed-random ( seed obj -- ) (>>i) ; -M: random-dummy random-32 ( obj -- r ) +M: random-dummy random-32* ( obj -- r ) [ dup 1+ ] change-i drop ; From a0975b5c463b7575adde3b1f43fcfa1e91bb59f2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 28 Mar 2008 20:28:17 -0500 Subject: [PATCH 145/219] Adding some unit tests --- core/tuples/tuples-tests.factor | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/core/tuples/tuples-tests.factor b/core/tuples/tuples-tests.factor index e670c26c25..09795888a8 100755 --- a/core/tuples/tuples-tests.factor +++ b/core/tuples/tuples-tests.factor @@ -316,6 +316,30 @@ C: server "IN: tuples.tests TUPLE: bad-superclass < word ;" eval ] must-fail +! Reshaping with inheritance +TUPLE: electronic-device ; + +[ ] [ "IN: tuples.tests TUPLE: computer < electronic-device ;" eval ] unit-test + +[ f ] [ electronic-device laptop class< ] unit-test +[ t ] [ server electronic-device class< ] unit-test +[ t ] [ laptop server class-or electronic-device class< ] unit-test + +[ t ] [ "laptop" get electronic-device? ] unit-test +[ t ] [ "laptop" get computer? ] unit-test +[ t ] [ "laptop" get laptop? ] unit-test +[ f ] [ "laptop" get server? ] unit-test + +[ t ] [ "server" get electronic-device? ] unit-test +[ t ] [ "server" get computer? ] unit-test +[ f ] [ "server" get laptop? ] unit-test +[ t ] [ "server" get server? ] unit-test + +[ ] [ "IN: tuples.tests TUPLE: computer ;" eval ] unit-test + +[ f ] [ "laptop" get electronic-device? ] unit-test +[ t ] [ "laptop" get computer? ] unit-test + ! Hardcore unit tests USE: threads From 965c03cec5f793c7539abd1d2710498e1c5bd8ff Mon Sep 17 00:00:00 2001 From: erg Date: Fri, 28 Mar 2008 21:15:41 -0500 Subject: [PATCH 146/219] fix teh bugz --- build-support/target | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build-support/target b/build-support/target index 1fbfb31d11..ffb677b681 100755 --- a/build-support/target +++ b/build-support/target @@ -1,4 +1,4 @@ -#!/bin/sh +#!/usr/bin/env bash uname_s=`uname -s` case $uname_s in From 5f37b4fc72d87336574810cce0e458ddda5ea8c6 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 16:11:08 +1300 Subject: [PATCH 147/219] compiled pegs infer --- extra/peg/peg.factor | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index fd00c3d2ae..8f7522bda9 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -65,7 +65,7 @@ C: peg-head ] [ pos set fail - ] if* ; + ] if* ; inline : memo ( pos rule -- memo-entry ) #! Return the result from the memo cache. @@ -85,14 +85,14 @@ C: peg-head m (>>ans) pos get m (>>pos) r p m h (grow-lr) - ] if ; + ] if ; inline :: grow-lr ( r p m h -- ast ) h p heads get set-at r p m h (grow-lr) p heads get delete-at m pos>> pos set m ans>> - ; + ; inline :: (setup-lr) ( r l s -- ) s head>> l head>> eq? [ @@ -121,7 +121,7 @@ C: peg-head ] [ m ans>> seed>> ] if - ] ; + ] ; inline :: recall ( r p -- memo-entry ) [let* | @@ -145,7 +145,7 @@ C: peg-head ] [ m ] if - ] ; + ] ; inline :: apply-non-memo-rule ( r p -- ast ) [let* | @@ -162,7 +162,7 @@ C: peg-head ans m (>>ans) ans ] if - ] ; + ] ; inline :: apply-memo-rule ( r m -- ast ) m pos>> pos set @@ -182,7 +182,7 @@ C: peg-head ] [ r p apply-non-memo-rule ] if - ] ; + ] ; inline : with-packrat ( input quot -- result ) #! Run the quotation with a packrat cache active. From 0db0d9cd444eaa920088f172844b4fdbc0f690b7 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 16:24:13 +1300 Subject: [PATCH 148/219] Move towards having ebnf infer --- extra/peg/ebnf/ebnf.factor | 2 +- extra/peg/peg.factor | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index 3efe2d6979..76e851efd3 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -282,7 +282,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) : ebnf>quot ( string -- hashtable quot ) 'ebnf' parse check-parse-result - parse-result-ast transform dup main swap at compile [ parse ] curry ; + parse-result-ast transform dup main swap at compile [ compiled-parse ] curry ; : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 8f7522bda9..be4bba25fc 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -192,7 +192,7 @@ C: peg-head f lrstack set H{ } clone heads set H{ } clone packrat set - ] H{ } make-assoc swap bind ; + ] H{ } make-assoc swap bind ; inline : compiled-parsers ( -- cache ) @@ -236,9 +236,11 @@ GENERIC: (compile) ( parser -- quot ) : compile ( parser -- word ) [ compiled-parser ] with-compilation-unit ; +: compiled-parse ( state word -- result ) + swap [ execute ] with-packrat ; inline + : parse ( state parser -- result ) - dup word? [ compile ] unless - [ execute ] curry with-packrat ; + dup word? [ compile ] unless compiled-parse ; Date: Fri, 28 Mar 2008 22:46:14 -0500 Subject: [PATCH 149/219] fix makefile --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 7bced81e47..5f7cdca06d 100755 --- a/Makefile +++ b/Makefile @@ -46,7 +46,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ EXE_OBJS = $(PLAF_EXE_OBJS) default: - $(MAKE) `./misc/factor.sh make-target` + $(MAKE) `./build-support/factor.sh make-target` help: @echo "Run '$(MAKE)' with one of the following parameters:" From d8abb49a9b68f8b3b8fe3f72da9bfd3a107e0a3e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 28 Mar 2008 22:59:48 -0500 Subject: [PATCH 150/219] Working on classes --- core/bootstrap/primitives.factor | 8 ++-- core/classes/classes.factor | 15 ++++--- core/classes/predicate/predicate.factor | 4 +- core/classes/union/union.factor | 2 +- core/tuples/tuples.factor | 60 ++++++++++++++----------- 5 files changed, 50 insertions(+), 39 deletions(-) diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index baa85032bc..50dea27e7b 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -341,7 +341,7 @@ define-tuple-slots ! Define general-t type, which is any object that is not f. "general-t" "kernel" create -"f" "syntax" lookup builtins get remove [ ] subset f union-class +f "f" "syntax" lookup builtins get remove [ ] subset union-class define-class "f" "syntax" create [ not ] "predicate" set-word-prop @@ -353,15 +353,15 @@ define-class ! Catch-all class for providing a default method. "object" "kernel" create [ drop t ] "predicate" set-word-prop "object" "kernel" create -builtins get [ ] subset f union-class define-class +f builtins get [ ] subset union-class define-class ! Class of objects with object tag "hi-tag" "classes.private" create -builtins get num-tags get tail f union-class define-class +f builtins get num-tags get tail union-class define-class ! Null class with no instances. "null" "kernel" create [ drop f ] "predicate" set-word-prop -"null" "kernel" create { } f union-class define-class +"null" "kernel" create f { } union-class define-class ! Create special tombstone values "tombstone" "hashtables.private" create diff --git a/core/classes/classes.factor b/core/classes/classes.factor index c21dd452ac..ccb735f392 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -83,13 +83,12 @@ M: word reset-class drop ; : update-map- ( class -- ) dup class-uses update-map get remove-vertex ; -PRIVATE> - -: define-class-props ( members superclass metaclass -- assoc ) +: define-class-props ( superclass members metaclass -- assoc ) [ - "metaclass" set - dup [ bootstrap-word ] when "superclass" set - [ bootstrap-word ] map "members" set + [ dup [ bootstrap-word ] when "superclass" set ] + [ [ bootstrap-word ] map "members" set ] + [ "metaclass" set ] + tri* ] H{ } make-assoc ; : (define-class) ( word props -- ) @@ -100,6 +99,8 @@ PRIVATE> over "predicating" set-word-prop t "class" set-word-prop ; +PRIVATE> + GENERIC: update-predicate ( class -- ) M: class update-predicate drop ; @@ -109,7 +110,7 @@ M: class update-predicate drop ; GENERIC: update-methods ( assoc -- ) -: define-class ( word members superclass metaclass -- ) +: define-class ( word superclass members metaclass -- ) #! If it was already a class, update methods after. reset-caches define-class-props diff --git a/core/classes/predicate/predicate.factor b/core/classes/predicate/predicate.factor index 9f5961895a..b2a5a03bb4 100755 --- a/core/classes/predicate/predicate.factor +++ b/core/classes/predicate/predicate.factor @@ -14,8 +14,8 @@ PREDICATE: predicate-class < class ] [ ] make ; : define-predicate-class ( class superclass definition -- ) - >r >r dup f r> predicate-class define-class r> - dupd "predicate-definition" set-word-prop + >r dupd f predicate-class define-class + r> dupd "predicate-definition" set-word-prop dup predicate-quot define-predicate ; M: predicate-class reset-class diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor index 3a791c22d0..814ab0e838 100755 --- a/core/classes/union/union.factor +++ b/core/classes/union/union.factor @@ -36,7 +36,7 @@ PREDICATE: union-class < class M: union-class update-predicate define-union-predicate ; : define-union-class ( class members -- ) - dupd f union-class define-class define-union-predicate ; + >r dup f r> union-class define-class define-union-predicate ; M: union-class reset-class { "metaclass" "members" } reset-props ; diff --git a/core/tuples/tuples.factor b/core/tuples/tuples.factor index 89aff6f185..60606357d3 100755 --- a/core/tuples/tuples.factor +++ b/core/tuples/tuples.factor @@ -124,7 +124,8 @@ PRIVATE> [ [ swap ?nth ] [ drop f ] if* ] with map append >tuple ; -: reshape-tuples ( class newslots -- ) +: reshape-tuples ( class superclass newslots -- ) + nip >r dup "slot-names" word-prop r> permutation [ >r [ swap class eq? ] curry instances dup r> @@ -132,36 +133,45 @@ PRIVATE> become ] 2curry after-compilation ; -: tuple-class-unchanged ( class superclass slots -- ) 3drop ; - -: prepare-tuple-class ( class slots -- ) - dupd define-tuple-slots - dup define-tuple-layout - define-tuple-predicate ; - -: change-superclass "not supported" throw ; +: define-new-tuple-class ( class superclass slots -- ) + [ drop f tuple-class define-class ] + [ nip define-tuple-slots ] + [ + 2drop + [ define-tuple-layout ] + [ define-tuple-predicate ] + bi + ] + 3tri ; : redefine-tuple-class ( class superclass slots -- ) - >r 2dup swap superclass eq? - [ drop ] [ dupd change-superclass ] if r> - 2dup forget-slots - 2dup reshape-tuples - over changed-word - over redefined - prepare-tuple-class ; + [ reshape-tuples ] + [ + drop + [ forget-slots ] + [ drop changed-word ] + [ drop redefined ] + 2tri + ] + [ define-new-tuple-class ] + 3tri ; -: define-new-tuple-class ( class superclass slots -- ) - >r dupd f swap tuple-class define-class r> - prepare-tuple-class ; +: tuple-class-unchanged? ( class superclass slots -- ? ) + rot tuck + [ "superclass" word-prop = ] + [ "slot-names" word-prop = ] 2bi* and ; PRIVATE> -: define-tuple-class ( class superclass slots -- ) - { - { [ pick tuple-class? not ] [ define-new-tuple-class ] } - { [ pick "slot-names" word-prop over = ] [ tuple-class-unchanged ] } - { [ t ] [ redefine-tuple-class ] } - } cond ; +GENERIC# define-tuple-class 2 ( class superclass slots -- ) + +M: word define-tuple-class + define-new-tuple-class ; + +M: tuple-class define-tuple-class + 3dup tuple-class-unchanged? + [ 3dup redefine-tuple-class ] unless + 3drop ; : define-error-class ( class superclass slots -- ) pick >r define-tuple-class r> From 1f3e6fd0b72bc89667a7634faad4b573c34403d3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 28 Mar 2008 23:00:20 -0500 Subject: [PATCH 151/219] combinators.cleave is now core --- core/kernel/kernel.factor | 77 +++++++++++++++---- extra/benchmark/benchmark.factor | 2 +- extra/boids/boids.factor | 1 - extra/boids/ui/ui.factor | 1 - extra/bunny/bunny.factor | 15 ++-- extra/bunny/model/model.factor | 10 +-- extra/bunny/outlined/outlined.factor | 7 +- extra/cairo/lib/lib.factor | 3 +- extra/cairo/png/png.factor | 5 +- extra/calendar/format/format.factor | 3 +- extra/calendar/windows/windows.factor | 3 +- extra/cfdg/cfdg.factor | 2 +- extra/colors/hsv/hsv.factor | 3 +- extra/combinators/lib/lib.factor | 3 +- .../distributed/distributed.factor | 5 +- extra/db/postgresql/lib/lib.factor | 8 +- extra/db/postgresql/postgresql.factor | 2 +- extra/db/sqlite/sqlite.factor | 2 +- extra/db/tuples/tuples.factor | 3 +- extra/http/http.factor | 3 +- extra/http/server/actions/actions.factor | 2 +- extra/http/server/auth/login/login.factor | 4 +- extra/http/server/callbacks/callbacks.factor | 3 +- .../http/server/components/components.factor | 2 +- extra/http/server/db/db.factor | 2 +- extra/http/server/server.factor | 2 +- extra/http/server/sessions/sessions.factor | 4 +- .../sessions/storage/assoc/assoc.factor | 5 +- .../http/server/sessions/storage/db/db.factor | 2 +- extra/http/server/static/static.factor | 3 +- .../http/server/validators/validators.factor | 3 +- extra/io/encodings/8-bit/8-bit.factor | 7 +- extra/io/unix/files/files.factor | 4 +- extra/io/windows/files/files.factor | 9 +-- extra/io/windows/nt/files/files.factor | 3 +- extra/locals/locals.factor | 2 +- extra/lsys/strings/interpret/interpret.factor | 2 +- extra/lsys/strings/rewrite/rewrite.factor | 2 +- extra/lsys/strings/strings.factor | 2 +- extra/math/analysis/analysis.factor | 2 +- extra/math/matrices/matrices.factor | 2 +- extra/opengl/demo-support/demo-support.factor | 2 +- extra/opengl/shaders/shaders.factor | 2 +- extra/project-euler/039/039.factor | 2 +- extra/project-euler/075/075.factor | 2 +- extra/random-weighted/random-weighted.factor | 2 +- .../blum-blum-shub/blum-blum-shub.factor | 2 +- .../mersenne-twister/mersenne-twister.factor | 3 +- extra/raptor/cron/cron.factor | 2 +- extra/raptor/cronjobs.factor | 2 +- extra/raptor/raptor.factor | 3 +- extra/reports/noise/noise.factor | 4 +- extra/reports/optimizer/optimizer.factor | 2 +- extra/serialize/serialize.factor | 4 +- extra/springies/springies.factor | 2 +- extra/springies/ui/ui.factor | 2 +- extra/tools/walker/walker.factor | 2 +- extra/ui/tools/walker/walker.factor | 2 +- extra/unix/process/process.factor | 2 +- extra/windows/com/syntax/syntax.factor | 8 +- .../code2html/responder/responder.factor | 2 +- 61 files changed, 151 insertions(+), 126 deletions(-) diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 2d99f0793b..1987597c58 100755 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2007 Slava Pestov. +! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel.private ; IN: kernel @@ -27,24 +27,28 @@ DEFER: if : if ( ? true false -- ) ? call ; -: if* ( cond true false -- ) - pick [ drop call ] [ 2nip call ] if ; inline - -: ?if ( default cond true false -- ) - pick [ roll 2drop call ] [ 2nip call ] if ; inline - +! Single branch : unless ( cond false -- ) swap [ drop ] [ call ] if ; inline -: unless* ( cond false -- ) - over [ drop ] [ nip call ] if ; inline - : when ( cond true -- ) swap [ call ] [ drop ] if ; inline +! Anaphoric +: if* ( cond true false -- ) + pick [ drop call ] [ 2nip call ] if ; inline + : when* ( cond true -- ) over [ call ] [ 2drop ] if ; inline +: unless* ( cond false -- ) + over [ drop ] [ nip call ] if ; inline + +! Default +: ?if ( default cond true false -- ) + pick [ roll 2drop call ] [ 2nip call ] if ; inline + +! Slippers : slip ( quot x -- x ) >r call r> ; inline : 2slip ( quot x y -- x y ) >r >r call r> r> ; inline @@ -53,6 +57,7 @@ DEFER: if : dip ( obj quot -- obj ) swap slip ; inline +! Keepers : keep ( x quot -- x ) over slip ; inline : 2keep ( x y quot -- x y ) 2over 2slip ; inline @@ -60,7 +65,48 @@ DEFER: if : 3keep ( x y z quot -- x y z ) >r 3dup r> -roll 3slip ; inline -: 2apply ( x y quot -- ) tuck 2slip call ; inline +! Cleavers +: bi ( x p q -- p[x] q[x] ) + >r keep r> call ; inline + +: tri ( x p q r -- p[x] q[x] r[x] ) + >r pick >r bi r> r> call ; inline + +! Double cleavers +: 2bi ( x y p q -- p[x,y] q[x,y] ) + >r 2keep r> call ; inline + +: 2tri ( x y p q r -- p[x,y] q[x,y] r[x,y] ) + >r >r 2keep r> 2keep r> call ; inline + +! Triple cleavers +: 3bi ( x y z p q -- p[x,y,z] q[x,y,z] ) + >r 3keep r> call ; inline + +: 3tri ( x y z p q r -- p[x,y,z] q[x,y,z] r[x,y,z] ) + >r >r 3keep r> 3keep r> call ; inline + +! Spreaders +: bi* ( x y p q -- p[x] q[y] ) + >r swap slip r> call ; inline + +: tri* ( x y z p q r -- p[x] q[y] r[z] ) + >r rot >r bi* r> r> call ; inline + +! Double spreaders +: 2bi* ( w x y z p q -- p[w,x] q[y,z] ) + >r -rot 2slip r> call ; inline + +! Appliers +: bi@ ( x y p -- p[x] p[y] ) + tuck 2slip call ; inline + +: tri@ ( x y z p -- p[x] p[y] p[z] ) + tuck >r bi@ r> call ; inline + +! Double appliers +: 2bi@ ( w x y z p -- p[w,x] p[y,z] ) + dup -roll 3slip call ; inline : while ( pred body tail -- ) >r >r dup slip r> r> roll @@ -135,11 +181,11 @@ USE: tuples.private : xor ( obj1 obj2 -- ? ) dup not swap ? ; inline -: both? ( x y quot -- ? ) 2apply and ; inline +: both? ( x y quot -- ? ) bi@ and ; inline -: either? ( x y quot -- ? ) 2apply or ; inline +: either? ( x y quot -- ? ) bi@ or ; inline -: compare ( obj1 obj2 quot -- n ) 2apply <=> ; inline +: compare ( obj1 obj2 quot -- n ) bi@ <=> ; inline : most ( x y quot -- z ) >r 2dup r> call [ drop ] [ nip ] if ; inline @@ -155,3 +201,6 @@ USE: tuples.private : do-primitive ( number -- ) "Improper primitive call" throw ; PRIVATE> + +! Deprecated +: 2apply bi@ ; inline diff --git a/extra/benchmark/benchmark.factor b/extra/benchmark/benchmark.factor index 26f1a9e96d..a75251331f 100755 --- a/extra/benchmark/benchmark.factor +++ b/extra/benchmark/benchmark.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel vocabs vocabs.loader tools.time tools.vocabs arrays assocs io.styles io help.markup prettyprint sequences -continuations debugger combinators.cleave ; +continuations debugger ; IN: benchmark : run-benchmark ( vocab -- result ) diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index 611e00a9b4..efa7216699 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -6,7 +6,6 @@ USING: kernel namespaces math.vectors math.trig combinators arrays sequences random vars - combinators.cleave combinators.lib ; IN: boids diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor index b545f41060..a1feac381d 100755 --- a/extra/boids/ui/ui.factor +++ b/extra/boids/ui/ui.factor @@ -19,7 +19,6 @@ USING: kernel namespaces ui.gadgets.packs ui.gadgets.grids ui.gestures - combinators.cleave assocs.lib vars rewrite-closures boids ; IN: boids.ui diff --git a/extra/bunny/bunny.factor b/extra/bunny/bunny.factor index 963379896d..43b9edcd00 100755 --- a/extra/bunny/bunny.factor +++ b/extra/bunny/bunny.factor @@ -1,11 +1,10 @@ -USING: alien alien.c-types arrays sequences math -math.vectors math.matrices math.parser io io.files kernel opengl -opengl.gl opengl.glu shuffle http.client vectors -namespaces ui.gadgets ui.gadgets.canvas ui.render ui splitting -combinators tools.time system combinators.lib combinators.cleave -float-arrays continuations opengl.demo-support multiline -ui.gestures -bunny.fixed-pipeline bunny.cel-shaded bunny.outlined bunny.model ; +USING: alien alien.c-types arrays sequences math math.vectors +math.matrices math.parser io io.files kernel opengl opengl.gl +opengl.glu shuffle http.client vectors namespaces ui.gadgets +ui.gadgets.canvas ui.render ui splitting combinators tools.time +system combinators.lib float-arrays continuations +opengl.demo-support multiline ui.gestures bunny.fixed-pipeline +bunny.cel-shaded bunny.outlined bunny.model ; IN: bunny TUPLE: bunny-gadget model geom draw-seq draw-n ; diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index 1d90209ed4..79a8a00856 100755 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -1,8 +1,8 @@ -USING: alien alien.c-types arrays sequences math math.vectors math.matrices - math.parser io io.files kernel opengl opengl.gl opengl.glu io.encodings.ascii - opengl.capabilities shuffle http.client vectors splitting tools.time system - combinators combinators.cleave float-arrays continuations namespaces - sequences.lib ; +USING: alien alien.c-types arrays sequences math math.vectors +math.matrices math.parser io io.files kernel opengl opengl.gl +opengl.glu io.encodings.ascii opengl.capabilities shuffle +http.client vectors splitting tools.time system combinators +float-arrays continuations namespaces sequences.lib ; IN: bunny.model : numbers ( str -- seq ) diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor index 6295e3b9de..7cdfba7c79 100755 --- a/extra/bunny/outlined/outlined.factor +++ b/extra/bunny/outlined/outlined.factor @@ -1,7 +1,6 @@ -USING: arrays bunny.model bunny.cel-shaded -combinators.cleave continuations kernel math multiline -opengl opengl.shaders opengl.framebuffers opengl.gl -opengl.capabilities sequences ui.gadgets combinators.cleave ; +USING: arrays bunny.model bunny.cel-shaded continuations kernel +math multiline opengl opengl.shaders opengl.framebuffers +opengl.gl opengl.capabilities sequences ui.gadgets ; IN: bunny.outlined STRING: outlined-pass1-fragment-shader-main-source diff --git a/extra/cairo/lib/lib.factor b/extra/cairo/lib/lib.factor index 1b969978a3..4f532cd9ec 100755 --- a/extra/cairo/lib/lib.factor +++ b/extra/cairo/lib/lib.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types cairo.ffi continuations destructors -kernel libc locals math combinators.cleave shuffle -accessors ; +kernel libc locals math shuffle accessors ; IN: cairo.lib TUPLE: cairo-t alien ; diff --git a/extra/cairo/png/png.factor b/extra/cairo/png/png.factor index 55828cde9c..eaab28e659 100755 --- a/extra/cairo/png/png.factor +++ b/extra/cairo/png/png.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators.cleave kernel -accessors math ui.gadgets ui.render opengl.gl byte-arrays -namespaces opengl cairo.ffi cairo.lib ; +USING: arrays kernel accessors math ui.gadgets ui.render +opengl.gl byte-arrays namespaces opengl cairo.ffi cairo.lib ; IN: cairo.png TUPLE: png surface width height cairo-t array ; diff --git a/extra/calendar/format/format.factor b/extra/calendar/format/format.factor index 0ac0ebb2c3..b0bd7c464f 100755 --- a/extra/calendar/format/format.factor +++ b/extra/calendar/format/format.factor @@ -1,6 +1,5 @@ USING: math math.parser kernel sequences io calendar -accessors arrays io.streams.string combinators accessors -combinators.cleave ; +accessors arrays io.streams.string combinators accessors ; IN: calendar.format GENERIC: day. ( obj -- ) diff --git a/extra/calendar/windows/windows.factor b/extra/calendar/windows/windows.factor index 6986902ff1..8548e4ee52 100755 --- a/extra/calendar/windows/windows.factor +++ b/extra/calendar/windows/windows.factor @@ -1,6 +1,5 @@ USING: calendar.backend namespaces alien.c-types -windows windows.kernel32 kernel math combinators.cleave -combinators ; +windows windows.kernel32 kernel math combinators ; IN: calendar.windows TUPLE: windows-calendar ; diff --git a/extra/cfdg/cfdg.factor b/extra/cfdg/cfdg.factor index c3ada95533..8a1d93aceb 100644 --- a/extra/cfdg/cfdg.factor +++ b/extra/cfdg/cfdg.factor @@ -3,7 +3,7 @@ USING: kernel alien.c-types combinators namespaces arrays sequences sequences.lib namespaces.lib splitting math math.functions math.vectors math.trig opengl.gl opengl.glu opengl ui ui.gadgets.slate - combinators.cleave vars + vars random-weighted colors.hsv cfdg.gl ; IN: cfdg diff --git a/extra/colors/hsv/hsv.factor b/extra/colors/hsv/hsv.factor index 8d91d971e4..dd2811822b 100644 --- a/extra/colors/hsv/hsv.factor +++ b/extra/colors/hsv/hsv.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2007 Eduardo Cavazos ! See http://factorcode.org/license.txt for BSD license. -USING: kernel combinators arrays sequences math math.functions - combinators.cleave ; +USING: kernel combinators arrays sequences math math.functions ; IN: colors.hsv diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 9fe19555c5..deb03f72e2 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -4,8 +4,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel combinators fry namespaces quotations hashtables sequences assocs arrays inference effects math math.ranges -arrays.lib shuffle macros bake combinators.cleave -continuations ; +arrays.lib shuffle macros bake continuations ; IN: combinators.lib diff --git a/extra/concurrency/distributed/distributed.factor b/extra/concurrency/distributed/distributed.factor index c007e9f152..6704272305 100755 --- a/extra/concurrency/distributed/distributed.factor +++ b/extra/concurrency/distributed/distributed.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2005 Chris Double. All Rights Reserved. ! See http://factorcode.org/license.txt for BSD license. -USING: serialize sequences concurrency.messaging -threads io io.server qualified arrays -namespaces kernel io.encodings.binary combinators.cleave +USING: serialize sequences concurrency.messaging threads io +io.server qualified arrays namespaces kernel io.encodings.binary accessors ; QUALIFIED: io.sockets IN: concurrency.distributed diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor index 270be886c5..bfe7dab3ce 100755 --- a/extra/db/postgresql/lib/lib.factor +++ b/extra/db/postgresql/lib/lib.factor @@ -2,10 +2,10 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays continuations db io kernel math namespaces quotations sequences db.postgresql.ffi alien alien.c-types -db.types tools.walker ascii splitting math.parser -combinators combinators.cleave libc shuffle calendar.format -byte-arrays destructors prettyprint accessors -strings serialize io.encodings.binary io.streams.byte-array ; +db.types tools.walker ascii splitting math.parser combinators +libc shuffle calendar.format byte-arrays destructors prettyprint +accessors strings serialize io.encodings.binary +io.streams.byte-array ; IN: db.postgresql.lib : postgresql-result-error-message ( res -- str/f ) diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 8a6f8632ec..f9805560ad 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -5,7 +5,7 @@ kernel math math.parser namespaces prettyprint quotations sequences debugger db db.postgresql.lib db.postgresql.ffi db.tuples db.types tools.annotations math.ranges combinators sequences.lib classes locals words tools.walker -combinators.cleave namespaces.lib ; +namespaces.lib ; IN: db.postgresql TUPLE: postgresql-db host port pgopts pgtty db user pass ; diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index d7d954c0dc..c81448865f 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -5,7 +5,7 @@ hashtables io.files kernel math math.parser namespaces prettyprint sequences strings tuples alien.c-types continuations db.sqlite.lib db.sqlite.ffi db.tuples words combinators.lib db.types combinators -combinators.cleave io namespaces.lib ; +io namespaces.lib ; USE: tools.walker IN: db.sqlite diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 0f69b0fafb..00e8ed8b76 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -3,8 +3,7 @@ USING: arrays assocs classes db kernel namespaces tuples words sequences slots math math.parser io prettyprint db.types continuations -mirrors sequences.lib tools.walker combinators.lib -combinators.cleave ; +mirrors sequences.lib tools.walker combinators.lib ; IN: db.tuples : define-persistent ( class table columns -- ) diff --git a/extra/http/http.factor b/extra/http/http.factor index 0bb983c53d..69c0ba2c9f 100755 --- a/extra/http/http.factor +++ b/extra/http/http.factor @@ -4,8 +4,7 @@ USING: fry hashtables io io.streams.string kernel math namespaces math.parser assocs sequences strings splitting ascii io.encodings.utf8 io.encodings.string namespaces unicode.case combinators vectors sorting accessors calendar -calendar.format quotations arrays combinators.cleave -combinators.lib byte-arrays ; +calendar.format quotations arrays combinators.lib byte-arrays ; IN: http : http-port 80 ; inline diff --git a/extra/http/server/actions/actions.factor b/extra/http/server/actions/actions.factor index f39980037d..fcafa57ff6 100755 --- a/extra/http/server/actions/actions.factor +++ b/extra/http/server/actions/actions.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors sequences kernel assocs combinators http.server http.server.validators http hashtables namespaces -combinators.cleave fry continuations locals ; +fry continuations locals ; IN: http.server.actions SYMBOL: +append-path diff --git a/extra/http/server/auth/login/login.factor b/extra/http/server/auth/login/login.factor index 8c61a9dd47..89984b0e84 100755 --- a/extra/http/server/auth/login/login.factor +++ b/extra/http/server/auth/login/login.factor @@ -6,8 +6,8 @@ http.server.auth.providers http.server.auth.providers.null http.server.actions http.server.components http.server.sessions http.server.templating.fhtml http.server.validators http.server.auth http sequences io.files namespaces hashtables -fry io.sockets combinators.cleave arrays threads locals -qualified continuations destructors ; +fry io.sockets arrays threads locals qualified continuations +destructors ; IN: http.server.auth.login QUALIFIED: smtp diff --git a/extra/http/server/callbacks/callbacks.factor b/extra/http/server/callbacks/callbacks.factor index ab629ae236..e1b737a9c6 100755 --- a/extra/http/server/callbacks/callbacks.factor +++ b/extra/http/server/callbacks/callbacks.factor @@ -3,8 +3,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: html http http.server io kernel math namespaces continuations calendar sequences assocs hashtables -accessors arrays alarms quotations combinators -combinators.cleave fry assocs.lib ; +accessors arrays alarms quotations combinators fry assocs.lib ; IN: http.server.callbacks SYMBOL: responder diff --git a/extra/http/server/components/components.factor b/extra/http/server/components/components.factor index 516abe79a5..828ff8e562 100755 --- a/extra/http/server/components/components.factor +++ b/extra/http/server/components/components.factor @@ -4,7 +4,7 @@ USING: html.elements http.server.validators accessors namespaces kernel io math.parser assocs classes words tuples arrays sequences io.files http.server.templating.fhtml http.server.actions splitting mirrors hashtables -combinators.cleave fry continuations math ; +fry continuations math ; IN: http.server.components SYMBOL: components diff --git a/extra/http/server/db/db.factor b/extra/http/server/db/db.factor index 0b2e9bccc3..a0d732c1ef 100755 --- a/extra/http/server/db/db.factor +++ b/extra/http/server/db/db.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: db http.server kernel accessors -continuations namespaces destructors combinators.cleave ; +continuations namespaces destructors ; IN: http.server.db TUPLE: db-persistence responder db params ; diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor index 81201dd3fe..2cc0f80f03 100755 --- a/extra/http/server/server.factor +++ b/extra/http/server/server.factor @@ -4,7 +4,7 @@ USING: assocs kernel namespaces io io.timeouts strings splitting threads http sequences prettyprint io.server logging calendar html.elements accessors math.parser combinators.lib tools.vocabs debugger html continuations random combinators -destructors io.encodings.8-bit fry combinators.cleave ; +destructors io.encodings.8-bit fry ; IN: http.server GENERIC: call-responder ( path responder -- response ) diff --git a/extra/http/server/sessions/sessions.factor b/extra/http/server/sessions/sessions.factor index aea1bef930..a3d06e8f18 100755 --- a/extra/http/server/sessions/sessions.factor +++ b/extra/http/server/sessions/sessions.factor @@ -3,8 +3,8 @@ USING: assocs calendar kernel math.parser namespaces random accessors http http.server http.server.sessions.storage http.server.sessions.storage.assoc -quotations hashtables sequences fry combinators.cleave -html.elements symbols continuations destructors ; +quotations hashtables sequences fry html.elements symbols +continuations destructors ; IN: http.server.sessions ! ! ! ! ! ! diff --git a/extra/http/server/sessions/storage/assoc/assoc.factor b/extra/http/server/sessions/storage/assoc/assoc.factor index f72f34e4d2..4bdc52b86e 100755 --- a/extra/http/server/sessions/storage/assoc/assoc.factor +++ b/extra/http/server/sessions/storage/assoc/assoc.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs assocs.lib accessors -http.server.sessions.storage combinators.cleave alarms kernel -fry http.server ; +USING: assocs assocs.lib accessors http.server.sessions.storage +alarms kernel fry http.server ; IN: http.server.sessions.storage.assoc TUPLE: sessions-in-memory sessions alarms ; diff --git a/extra/http/server/sessions/storage/db/db.factor b/extra/http/server/sessions/storage/db/db.factor index 4d87aea5a3..471b7fa6df 100755 --- a/extra/http/server/sessions/storage/db/db.factor +++ b/extra/http/server/sessions/storage/db/db.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: assocs accessors http.server.sessions.storage alarms kernel http.server db.tuples db.types singleton -combinators.cleave math.parser ; +math.parser ; IN: http.server.sessions.storage.db SINGLETON: sessions-in-db diff --git a/extra/http/server/static/static.factor b/extra/http/server/static/static.factor index 2f48e7ac87..905c7320ca 100755 --- a/extra/http/server/static/static.factor +++ b/extra/http/server/static/static.factor @@ -3,8 +3,7 @@ USING: calendar html io io.files kernel math math.parser http http.server namespaces parser sequences strings assocs hashtables debugger http.mime sorting html.elements logging -calendar.format accessors io.encodings.binary -combinators.cleave fry ; +calendar.format accessors io.encodings.binary fry ; IN: http.server.static ! special maps mime types to quots with effect ( path -- ) diff --git a/extra/http/server/validators/validators.factor b/extra/http/server/validators/validators.factor index b3710f6439..32a1125809 100755 --- a/extra/http/server/validators/validators.factor +++ b/extra/http/server/validators/validators.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2006, 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: kernel continuations sequences math namespaces -math.parser assocs regexp fry unicode.categories -combinators.cleave sequences ; +math.parser assocs regexp fry unicode.categories sequences ; IN: http.server.validators SYMBOL: validation-failed? diff --git a/extra/io/encodings/8-bit/8-bit.factor b/extra/io/encodings/8-bit/8-bit.factor index d29760a3e0..d2348fd4b0 100755 --- a/extra/io/encodings/8-bit/8-bit.factor +++ b/extra/io/encodings/8-bit/8-bit.factor @@ -1,9 +1,8 @@ ! Copyright (C) 2008 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: math.parser arrays io.encodings sequences kernel -assocs hashtables io.encodings.ascii combinators.cleave -generic parser tuples words io io.files splitting namespaces -math compiler.units accessors ; +USING: math.parser arrays io.encodings sequences kernel assocs +hashtables io.encodings.ascii generic parser tuples words io +io.files splitting namespaces math compiler.units accessors ; IN: io.encodings.8-bit ( root -- responder ) From 211749ed3de2d9140636bd96133767d64642d590 Mon Sep 17 00:00:00 2001 From: erg Date: Fri, 28 Mar 2008 23:20:33 -0500 Subject: [PATCH 152/219] re-add docs for random --- extra/random/random-docs.factor | 44 +++++++++++++++++++++++++++++++++ extra/random/random.factor | 2 +- 2 files changed, 45 insertions(+), 1 deletion(-) create mode 100644 extra/random/random-docs.factor diff --git a/extra/random/random-docs.factor b/extra/random/random-docs.factor new file mode 100644 index 0000000000..78c60fa2cb --- /dev/null +++ b/extra/random/random-docs.factor @@ -0,0 +1,44 @@ +USING: help.markup help.syntax math random.backend ; +IN: random + +ARTICLE: "random-numbers" "Generating random integers" +"The " { $vocab-link "random" } " vocabulary implements the ``Mersenne Twister'' pseudo-random number generator algorithm." +{ $subsection random } ; + +ABOUT: "random-numbers" + +HELP: seed-random +{ $values { "tuple" "a random number generator" } { "seed" "an integer between 0 and 2^32-1" } } +{ $description "Seed the random number generator." } +{ $notes "Not supported on all random number generators." } ; + +HELP: random-32* +{ $values { "tuple" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } } +{ $description "Generates a random 32-bit unsigned integer." } ; + +HELP: random-bytes* +{ $values { "n" "an integer" } { "tuple" "a random number generator" } { "bytes" "a sequence of random bytes" } } +{ $description "Generates a byte-array of random bytes." } ; + +HELP: random +{ $values { "seq" "a sequence" } { "elt" "a random element" } } +{ $description "Outputs a random element of the sequence. If the sequence is empty, always outputs " { $link f } "." } +{ $notes "Since integers are sequences, passing an integer " { $snippet "n" } " yields a random integer in the interval " { $snippet "[0,n)" } "." } ; + +HELP: random-bytes +{ $values { "n" "an integer" } { "bytes" "a random integer" } } +{ $description "Outputs an integer with n bytes worth of bits." } ; + +HELP: random-bits +{ $values { "n" "an integer" } { "r" "a random integer" } } +{ $description "Outputs an random integer n bits in length." } ; + +HELP: with-random +{ $values { "tuple" "a random generator" } { "quot" "a quotation" } } +{ $description "Calls the quotation with the random generator in a dynamic variable. All random numbers will be generated using this random generator." } ; + +HELP: with-secure-random +{ $values { "quot" "a quotation" } } +{ $description "Calls the quotation with the secure random generator in a dynamic variable. All random numbers will be generated using this random generator." } ; + +{ with-random with-secure-random } related-words diff --git a/extra/random/random.factor b/extra/random/random.factor index e62ab71b92..c1701b1c0f 100755 --- a/extra/random/random.factor +++ b/extra/random/random.factor @@ -15,7 +15,7 @@ GENERIC: random-bytes* ( n tuple -- byte-array ) M: object random-bytes* ( n tuple -- byte-array ) swap [ drop random-32* ] with map >c-uint-array ; -M: object random-32* ( tuple -- n ) 4 random-bytes* le> ; +M: object random-32* ( tuple -- r ) 4 random-bytes* le> ; ERROR: no-random-number-generator ; From 2c3c66c6afa0871bda67ab740cb7ff574d77b7e5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 28 Mar 2008 23:37:52 -0500 Subject: [PATCH 153/219] Update peg for words being moved --- extra/peg/peg.factor | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 8f7522bda9..47ca60eef9 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -1,10 +1,9 @@ -! Copyright (C) 2007 Chris Double. +! Copyright (C) 2007, 2008 Chris Double. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences strings namespaces math assocs shuffle vectors arrays combinators.lib math.parser match unicode.categories sequences.lib compiler.units parser - words quotations effects memoize accessors - combinators.cleave locals ; + words quotations effects memoize accessors locals ; IN: peg USE: prettyprint From ea45fe2b454ca53c96e28c2f010f4e24bd9b440c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 28 Mar 2008 23:38:03 -0500 Subject: [PATCH 154/219] Move more cleave stuff into core --- core/combinators/combinators.factor | 20 ++++++ .../transforms/transforms-tests.factor | 24 +++++++ core/inference/transforms/transforms.factor | 6 ++ extra/combinators/cleave/cleave.factor | 70 ------------------- 4 files changed, 50 insertions(+), 70 deletions(-) diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index 807b372e1d..305d03e3cb 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -5,6 +5,26 @@ USING: arrays sequences sequences.private math.private kernel kernel.private math assocs quotations vectors hashtables sorting ; +: cleave ( obj seq -- ) + [ call ] with each ; + +: cleave>quot ( seq -- quot ) + [ [ keep ] curry ] map concat [ drop ] append ; + +: 2cleave ( obj seq -- ) + [ [ call ] 3keep drop ] each 2drop ; + +: 2cleave>quot ( seq -- quot ) + [ [ 2keep ] curry ] map concat [ 2drop ] append ; + +: spread>quot ( seq -- quot ) + [ length [ >r ] concat ] + [ [ [ r> ] prepend ] map concat ] bi + compose ; + +: spread ( seq -- ) + spread>quot call ; + ERROR: no-cond ; : cond ( assoc -- ) diff --git a/core/inference/transforms/transforms-tests.factor b/core/inference/transforms/transforms-tests.factor index 88aac780c1..54a81bfcdd 100755 --- a/core/inference/transforms/transforms-tests.factor +++ b/core/inference/transforms/transforms-tests.factor @@ -32,3 +32,27 @@ TUPLE: a-tuple x y z ; { set-a-tuple-x set-a-tuple-x } set-slots ; [ [ set-slots-test-2 ] infer ] must-fail + +TUPLE: color r g b ; + +C: color + +: cleave-test { [ r>> ] [ g>> ] [ b>> ] } cleave ; + +{ 1 3 } [ cleave-test ] must-infer-as + +[ 1 2 3 ] [ 1 2 3 cleave-test ] unit-test + +[ 1 2 3 ] [ 1 2 3 \ cleave-test word-def call ] unit-test + +: 2cleave-test { [ 2array ] [ + ] [ - ] } 2cleave ; + +[ { 1 2 } 3 -1 ] [ 1 2 2cleave-test ] unit-test + +[ { 1 2 } 3 -1 ] [ 1 2 \ 2cleave-test word-def call ] unit-test + +: spread-test { [ sq ] [ neg ] [ recip ] } spread ; + +[ 16 -3 1/6 ] [ 4 3 6 spread-test ] unit-test + +[ 16 -3 1/6 ] [ 4 3 6 \ spread-test word-def call ] unit-test diff --git a/core/inference/transforms/transforms.factor b/core/inference/transforms/transforms.factor index b3a2bffcfe..e77872ae78 100755 --- a/core/inference/transforms/transforms.factor +++ b/core/inference/transforms/transforms.factor @@ -39,6 +39,12 @@ IN: inference.transforms ] if ] 1 define-transform +\ cleave [ cleave>quot ] 1 define-transform + +\ 2cleave [ 2cleave>quot ] 1 define-transform + +\ spread [ spread>quot ] 1 define-transform + ! Bitfields GENERIC: (bitfield-quot) ( spec -- quot ) diff --git a/extra/combinators/cleave/cleave.factor b/extra/combinators/cleave/cleave.factor index 1bc7480198..9ce7a1f553 100644 --- a/extra/combinators/cleave/cleave.factor +++ b/extra/combinators/cleave/cleave.factor @@ -3,76 +3,6 @@ USING: kernel sequences macros ; IN: combinators.cleave -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! The cleaver family -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: bi ( x p q -- p(x) q(x) ) >r keep r> call ; inline -: tri ( x p q r -- p(x) q(x) r(x) ) >r pick >r bi r> r> call ; inline - -: tetra ( obj quot quot quot quot -- val val val val ) - >r >r pick >r bi r> r> r> bi ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: 2bi ( x y p q -- p(x,y) q(x,y) ) >r 2keep r> call ; inline - -: 2tri ( x y z p q r -- p(x,y,z) q(x,y,z) r(x,y,z) ) - >r >r 2keep r> 2keep r> call ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! General cleave - -MACRO: cleave ( seq -- ) - dup - [ drop [ dup ] ] map concat - swap - dup - [ drop [ >r ] ] map concat - swap - [ [ r> ] append ] map concat - 3append - [ drop ] - append ; - -MACRO: 2cleave ( seq -- ) - dup - [ drop [ 2dup ] ] map concat - swap - dup - [ drop [ >r >r ] ] map concat - swap - [ [ r> r> ] append ] map concat - 3append - [ 2drop ] - append ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! The spread family -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: bi* ( x y p q -- p(x) q(y) ) >r swap slip r> call ; inline - -: 2bi* ( w x y z p q -- p(x) q(y) ) >r -rot 2slip r> call ; inline - -: tri* ( x y z p q r -- p(x) q(y) r(z) ) - >r rot >r bi* r> r> call ; inline - -: tetra* ( obj obj obj obj quot quot quot quot -- val val val val ) - >r roll >r tri* r> r> call ; inline - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! General spread - -MACRO: spread ( seq -- ) - dup - [ drop [ >r ] ] map concat - swap - [ [ r> ] prepend ] map concat - append ; - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Cleave into array ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From cbc68652176d66e0365052dca9318a6c993e9348 Mon Sep 17 00:00:00 2001 From: erg Date: Fri, 28 Mar 2008 23:40:18 -0500 Subject: [PATCH 155/219] fix teh docs --- extra/random/random-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/random/random-docs.factor b/extra/random/random-docs.factor index 78c60fa2cb..905f81b53d 100644 --- a/extra/random/random-docs.factor +++ b/extra/random/random-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax math random.backend ; +USING: help.markup help.syntax math ; IN: random ARTICLE: "random-numbers" "Generating random integers" From 86653e7a46d8da3862bfb520b335195c0065728e Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 17:42:21 +1300 Subject: [PATCH 156/219] Don't use 'delay' parser in ebnf --- extra/peg/ebnf/ebnf.factor | 7 ++++--- extra/peg/peg.factor | 12 ++++++++++++ 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index 76e851efd3..c1e2ce8546 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -262,8 +262,8 @@ M: ebnf-terminal (transform) ( ast -- parser ) M: ebnf-non-terminal (transform) ( ast -- parser ) symbol>> [ - , parser get , \ at , - ] [ ] make delay sp ; + , parser get , \ at , \ sp , + ] [ ] make box ; : transform-ebnf ( string -- object ) 'ebnf' parse parse-result-ast transform ; @@ -282,7 +282,8 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) : ebnf>quot ( string -- hashtable quot ) 'ebnf' parse check-parse-result - parse-result-ast transform dup main swap at compile [ compiled-parse ] curry ; + parse-result-ast transform dup dup parser [ main swap at compile ] with-variable + [ compiled-parse ] curry ; : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index be4bba25fc..5ec934d994 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -489,6 +489,15 @@ M: delay-parser (compile) ( parser -- quot ) { } { "word" } memoize-quot [ % \ execute , ] [ ] make ; +TUPLE: box-parser quot ; + +M: box-parser (compile) ( parser -- quot ) + #! Calls the quotation at compile time + #! to produce the parser to be compiled. + #! This differs from 'delay' which calls + #! it at run time. + quot>> call compiled-parser 1quotation ; + PRIVATE> : token ( string -- parser ) @@ -557,6 +566,9 @@ PRIVATE> : delay ( quot -- parser ) delay-parser construct-boa init-parser ; +: box ( quot -- parser ) + box-parser construct-boa init-parser ; + : PEG: (:) [ [ From 8105e66aece2f6c466523542c0c04b0553d79b67 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 17:45:21 +1300 Subject: [PATCH 157/219] Add box parser to docs --- extra/peg/peg-docs.factor | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor index d2ca353ba1..7b13e06d5a 100644 --- a/extra/peg/peg-docs.factor +++ b/extra/peg/peg-docs.factor @@ -159,4 +159,17 @@ HELP: delay { $description "Delays the construction of a parser until it is actually required to parse. This " "allows for calling a parser that results in a recursive call to itself. The quotation " - "should return the constructed parser." } ; + "should return the constructed parser and is called the first time the parser is run." + "The compiled result is memoized for future runs. See " { $link box } " for a word " + "that calls the quotation at compile time." } ; + +HELP: box +{ $values + { "quot" "a quotation" } + { "parser" "a parser" } +} +{ $description + "Delays the construction of a parser until the parser is compiled. The quotation " + "should return the constructed parser and is called when the parser is compiled." + "The compiled result is memoized for future runs. See " { $link delay } " for a word " + "that calls the quotation at runtime." } ; From ca4f77575611df8c4c6d6f53d1ac25372f8cac7f Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sat, 29 Mar 2008 18:33:37 +1300 Subject: [PATCH 158/219] Fix PEG: --- extra/peg/peg.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 5ec934d994..6f2e5bce95 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -572,7 +572,7 @@ PRIVATE> : PEG: (:) [ [ - call compile 1quotation + call compile [ compiled-parse ] curry [ dup [ parse-result-ast ] [ "Parse failed" throw ] if ] append define ] with-compilation-unit From aec04edbdaa837e04efada721bf8119dcde0e3df Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 00:59:05 -0500 Subject: [PATCH 159/219] Phasing out get-slots and cleaning up some code --- core/classes/mixin/mixin.factor | 5 +- core/combinators/combinators.factor | 2 +- core/continuations/continuations.factor | 15 +-- core/heaps/heaps.factor | 4 +- .../transforms/transforms-tests.factor | 2 +- core/io/encodings/encodings.factor | 12 +- core/parser/parser.factor | 15 +-- extra/calendar/calendar.factor | 4 +- extra/combinators/cleave/cleave-docs.factor | 108 ------------------ extra/io/buffers/buffers-docs.factor | 26 +---- extra/io/buffers/buffers-tests.factor | 44 ++----- extra/io/buffers/buffers.factor | 44 ++----- extra/io/nonblocking/nonblocking.factor | 34 +----- extra/io/unix/backend/backend.factor | 33 +++--- extra/io/unix/select/select.factor | 18 +-- extra/locals/locals.factor | 8 +- 16 files changed, 89 insertions(+), 285 deletions(-) delete mode 100644 extra/combinators/cleave/cleave-docs.factor diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 780f76f0f8..85a6fb241d 100755 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: classes classes.union words kernel sequences -definitions combinators arrays ; +definitions combinators arrays accessors ; IN: classes.mixin PREDICATE: mixin-class < union-class "mixin" word-prop ; @@ -53,8 +53,7 @@ M: mixin-instance equal? } cond 2nip ; M: mixin-instance hashcode* - { mixin-instance-class mixin-instance-mixin } get-slots - 2array hashcode* ; + [ class>> ] [ mixin>> ] bi 2array hashcode* ; : ( class mixin -- definition ) { set-mixin-instance-class set-mixin-instance-mixin } diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index 305d03e3cb..cc03955fd8 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -20,7 +20,7 @@ hashtables sorting ; : spread>quot ( seq -- quot ) [ length [ >r ] concat ] [ [ [ r> ] prepend ] map concat ] bi - compose ; + append ; : spread ( seq -- ) spread>quot call ; diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index 13b31cfde6..a2c296e8ce 100755 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2003, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays vectors kernel kernel.private sequences -namespaces math splitting sorting quotations assocs ; +namespaces math splitting sorting quotations assocs +combinators accessors ; IN: continuations SYMBOL: error @@ -43,12 +44,12 @@ C: continuation : >continuation< ( continuation -- data call retain name catch ) { - continuation-data - continuation-call - continuation-retain - continuation-name - continuation-catch - } get-slots ; + [ data>> ] + [ call>> ] + [ retain>> ] + [ name>> ] + [ catch>> ] + } cleave ; : ifcc ( capture restore -- ) #! After continuation is being captured, the stacks looks diff --git a/core/heaps/heaps.factor b/core/heaps/heaps.factor index caab0d8f8e..34a4dc0d49 100755 --- a/core/heaps/heaps.factor +++ b/core/heaps/heaps.factor @@ -2,7 +2,7 @@ ! Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math sequences arrays assocs sequences.private -growable ; +growable accessors ; IN: heaps MIXIN: priority-queue @@ -161,7 +161,7 @@ M: priority-queue heap-push* ( value key heap -- entry ) [ swapd heap-push ] curry assoc-each ; : >entry< ( entry -- key value ) - { entry-value entry-key } get-slots ; + [ value>> ] [ key>> ] bi ; M: priority-queue heap-peek ( heap -- value key ) data-first >entry< ; diff --git a/core/inference/transforms/transforms-tests.factor b/core/inference/transforms/transforms-tests.factor index 54a81bfcdd..cb8024d3c5 100755 --- a/core/inference/transforms/transforms-tests.factor +++ b/core/inference/transforms/transforms-tests.factor @@ -1,6 +1,6 @@ IN: inference.transforms.tests USING: sequences inference.transforms tools.test math kernel -quotations inference ; +quotations inference accessors combinators words arrays ; : compose-n-quot >quotation ; : compose-n compose-n-quot call ; diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index a781b63ad5..2ef26096e0 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: math kernel sequences sbufs vectors namespaces -growable strings io classes continuations combinators -io.styles io.streams.plain splitting -io.streams.duplex byte-arrays sequences.private ; +USING: math kernel sequences sbufs vectors namespaces growable +strings io classes continuations combinators io.styles +io.streams.plain splitting io.streams.duplex byte-arrays +sequences.private accessors ; IN: io.encodings ! The encoding descriptor protocol @@ -34,7 +34,7 @@ M: tuple-class construct-empty ; M: tuple f decoder construct-boa ; : >decoder< ( decoder -- stream encoding ) - { decoder-stream decoder-code } get-slots ; + [ stream>> ] [ code>> ] bi ; : cr+ t swap set-decoder-cr ; inline @@ -108,7 +108,7 @@ M: tuple-class construct-empty ; M: tuple encoder construct-boa ; : >encoder< ( encoder -- stream encoding ) - { encoder-stream encoder-code } get-slots ; + [ stream>> ] [ code>> ] bi ; M: encoder stream-write1 >encoder< encode-char ; diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 08f4275e49..6bae4e95b4 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -5,16 +5,18 @@ namespaces prettyprint sequences strings vectors words quotations inspector io.styles io combinators sorting splitting math.parser effects continuations debugger io.files io.streams.string vocabs io.encodings.utf8 -source-files classes hashtables compiler.errors compiler.units ; +source-files classes hashtables compiler.errors compiler.units +accessors ; IN: parser TUPLE: lexer text line line-text line-length column ; : next-line ( lexer -- ) - 0 over set-lexer-column - dup lexer-line over lexer-text ?nth over set-lexer-line-text - dup lexer-line-text length over set-lexer-line-length - dup lexer-line 1+ swap set-lexer-line ; + dup [ line>> ] [ text>> ] bi ?nth >>line-text + dup line-text>> length >>line-length + [ 1+ ] change-line + 0 >>column + drop ; : ( text -- lexer ) 0 { set-lexer-text set-lexer-line } lexer construct @@ -159,8 +161,7 @@ TUPLE: parse-error file line col text ; : ( msg -- error ) file get - lexer get - { lexer-line lexer-column lexer-line-text } get-slots + lexer get [ line>> ] [ column>> ] [ line-text>> ] tri parse-error construct-boa [ set-delegate ] keep ; diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor index 06425975d4..6d7007c54a 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -84,10 +84,10 @@ PRIVATE> ] ; : >date< ( timestamp -- year month day ) - { year>> month>> day>> } get-slots ; + [ year>> ] [ month>> ] [ day>> ] tri ; : >time< ( timestamp -- hour minute second ) - { hour>> minute>> second>> } get-slots ; + [ hour>> ] [ minute>> ] [ second>> ] tri ; : instant ( -- dt ) 0 0 0 0 0 0 ; : years ( n -- dt ) instant swap >>year ; diff --git a/extra/combinators/cleave/cleave-docs.factor b/extra/combinators/cleave/cleave-docs.factor deleted file mode 100644 index 46e9abcd9f..0000000000 --- a/extra/combinators/cleave/cleave-docs.factor +++ /dev/null @@ -1,108 +0,0 @@ - -USING: kernel quotations help.syntax help.markup ; - -IN: combinators.cleave - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -ARTICLE: "cleave-combinators" "Cleave Combinators" - -"Basic cleavers:" - -{ $subsection bi } -{ $subsection tri } - -"General cleave: " -{ $subsection cleave } - -"Cleave combinators for quotations with arity 2:" -{ $subsection 2bi } -{ $subsection 2tri } - -{ $notes - "From the Merriam-Webster Dictionary: " - $nl - { $strong "cleave" } - { $list - { $emphasis "To divide by or as if by a cutting blow" } - { $emphasis "To separate into distinct parts and especially into " - "groups having divergent views" } } - $nl - "The Joy programming language has a " { $emphasis "cleave" } " combinator." } - -; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -HELP: bi - - { $values { "x" object } - { "p" quotation } - { "q" quotation } - - { "p(x)" "p applied to x" } - { "q(x)" "q applied to x" } } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -HELP: tri - - { $values { "x" object } - { "p" quotation } - { "q" quotation } - { "r" quotation } - - { "p(x)" "p applied to x" } - { "q(x)" "q applied to x" } - { "r(x)" "r applied to x" } } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -HELP: cleave - -{ $code "( obj { q1 q2 ... qN } -- q1(obj) q2(obj) ... qN(obj) )" } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -{ bi tri cleave 2bi 2tri } related-words - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -ARTICLE: "spread-combinators" "Spread Combinators" - -{ $subsection bi* } -{ $subsection tri* } -{ $subsection spread } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -HELP: bi* - - { $values { "x" object } - { "y" object } - { "p" quotation } - { "q" quotation } - - { "p(x)" "p applied to x" } - { "q(y)" "q applied to y" } } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -HELP: tri* - - { $values { "x" object } - { "y" object } - { "z" object } - { "p" quotation } - { "q" quotation } - { "r" quotation } - - { "p(x)" "p applied to x" } - { "q(y)" "q applied to y" } - { "r(z)" "r applied to z" } } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -HELP: spread - -{ $code "( v1 v2 ... vN { q1 q2 ... qN } -- q1(v1) q2(v2) ... qN(vN) )" } ; \ No newline at end of file diff --git a/extra/io/buffers/buffers-docs.factor b/extra/io/buffers/buffers-docs.factor index 5ce9b71427..a11a7adead 100755 --- a/extra/io/buffers/buffers-docs.factor +++ b/extra/io/buffers/buffers-docs.factor @@ -18,9 +18,7 @@ $nl "Reading from the buffer:" { $subsection buffer-peek } { $subsection buffer-pop } -{ $subsection buffer> } -{ $subsection buffer>> } -{ $subsection buffer-until } +{ $subsection buffer-read } "Writing to the buffer:" { $subsection extend-buffer } { $subsection byte>buffer } @@ -47,10 +45,6 @@ HELP: buffer-free { $description "De-allocates a buffer's underlying storage. The buffer may not be used after being freed." } { $warning "You " { $emphasis "must" } " free a buffer using this word, before letting the GC collect the buffer tuple instance." } ; -HELP: (buffer>>) -{ $values { "buffer" buffer } { "byte-array" byte-array } } -{ $description "Collects the entire contents of the buffer into a string." } ; - HELP: buffer-reset { $values { "n" "a non-negative integer" } { "buffer" buffer } } { $description "Resets the fill pointer to 0 and the position to " { $snippet "count" } "." } ; @@ -67,17 +61,13 @@ HELP: buffer-end { $values { "buffer" buffer } { "alien" alien } } { $description "Outputs the memory address of the current fill-pointer." } ; -HELP: (buffer>) +HELP: (buffer-read) { $values { "n" "a non-negative integer" } { "buffer" buffer } { "byte-array" byte-array } } -{ $description "Outputs a string of the first " { $snippet "n" } " characters at the buffer's current position. If there are less than " { $snippet "n" } " characters available, the output is truncated." } ; +{ $description "Outputs a byte array of the first " { $snippet "n" } " bytes at the buffer's current position. If there are less than " { $snippet "n" } " bytes available, the output is truncated." } ; -HELP: buffer> +HELP: buffer-read { $values { "n" "a non-negative integer" } { "buffer" buffer } { "byte-array" byte-array } } -{ $description "Collects a string of " { $snippet "n" } " characters starting from the buffer's current position, and advances the position accordingly. If there are less than " { $snippet "n" } " characters available, the output is truncated." } ; - -HELP: buffer>> -{ $values { "buffer" buffer } { "byte-array" byte-array } } -{ $description "Collects the contents of the buffer into a string, and resets the position and fill pointer to 0." } ; +{ $description "Collects a byte array of " { $snippet "n" } " bytes starting from the buffer's current position, and advances the position accordingly. If there are less than " { $snippet "n" } " bytes available, the output is truncated." } ; HELP: buffer-length { $values { "buffer" buffer } { "n" "a non-negative integer" } } @@ -103,7 +93,7 @@ HELP: check-overflow HELP: >buffer { $values { "byte-array" byte-array } { "buffer" buffer } } -{ $description "Copies a string to the buffer's fill pointer, and advances it accordingly." } ; +{ $description "Copies a byte array to the buffer's fill pointer, and advances it accordingly." } ; HELP: byte>buffer { $values { "byte" "a byte" } { "buffer" buffer } } @@ -121,7 +111,3 @@ HELP: buffer-peek HELP: buffer-pop { $values { "buffer" buffer } { "byte" "a byte" } } { $description "Outputs the byte at the buffer position and advances the position." } ; - -HELP: buffer-until -{ $values { "separators" "a sequence of bytes" } { "buffer" buffer } { "byte-array" byte-array } { "separator" "a byte or " { $link f } } } -{ $description "Searches the buffer for a byte appearing in " { $snippet "separators" } ", starting from " { $link buffer-pos } ". If a separator is found, all data up to but not including the separator is output, together with the separator itself; otherwise the remainder of the buffer's contents are output together with " { $link f } "." } ; diff --git a/extra/io/buffers/buffers-tests.factor b/extra/io/buffers/buffers-tests.factor index 1f3e262fed..f66f9ed313 100755 --- a/extra/io/buffers/buffers-tests.factor +++ b/extra/io/buffers/buffers-tests.factor @@ -1,6 +1,6 @@ IN: io.buffers.tests USING: alien alien.c-types io.buffers kernel kernel.private libc -sequences tools.test namespaces byte-arrays strings ; +sequences tools.test namespaces byte-arrays strings accessors ; : buffer-set ( string buffer -- ) over >byte-array over buffer-ptr byte-array>memory @@ -9,24 +9,29 @@ sequences tools.test namespaces byte-arrays strings ; : string>buffer ( string -- buffer ) dup length tuck buffer-set ; +: buffer-read-all ( buffer -- byte-array ) + [ [ pos>> ] [ ptr>> ] bi ] + [ buffer-length ] bi + memory>byte-array ; + [ B{ } 65536 ] [ 65536 - dup (buffer>>) + dup buffer-read-all over buffer-capacity rot buffer-free ] unit-test [ "hello world" "" ] [ "hello world" string>buffer - dup (buffer>>) >string + dup buffer-read-all >string 0 pick buffer-reset - over (buffer>>) >string + over buffer-read-all >string rot buffer-free ] unit-test [ "hello" ] [ "hello world" string>buffer - 5 over buffer> >string swap buffer-free + 5 over buffer-read >string swap buffer-free ] unit-test [ 11 ] [ @@ -37,7 +42,7 @@ sequences tools.test namespaces byte-arrays strings ; [ "hello world" ] [ "hello" 1024 [ buffer-set ] keep " world" >byte-array over >buffer - dup (buffer>>) >string swap buffer-free + dup buffer-read-all >string swap buffer-free ] unit-test [ CHAR: e ] [ @@ -45,33 +50,8 @@ sequences tools.test namespaces byte-arrays strings ; 1 over buffer-consume [ buffer-pop ] keep buffer-free ] unit-test -[ "hello" CHAR: \r ] [ - "hello\rworld" string>buffer - "\r" over buffer-until >r >string r> - rot buffer-free -] unit-test - -[ "hello" CHAR: \r ] [ - "hello\rworld" string>buffer - "\n\r" over buffer-until >r >string r> - rot buffer-free -] unit-test - -[ "hello\rworld" f ] [ - "hello\rworld" string>buffer - "X" over buffer-until >r >string r> - rot buffer-free -] unit-test - -[ "hello" CHAR: \r "world" CHAR: \n ] [ - "hello\rworld\n" string>buffer - [ "\r\n" swap buffer-until >r >string r> ] keep - [ "\r\n" swap buffer-until >r >string r> ] keep - buffer-free -] unit-test - "hello world" string>buffer "b" set -[ "hello world" ] [ 1000 "b" get buffer> >string ] unit-test +[ "hello world" ] [ 1000 "b" get buffer-read >string ] unit-test "b" get buffer-free 100 "b" set diff --git a/extra/io/buffers/buffers.factor b/extra/io/buffers/buffers.factor index 7d51d04d7b..8b00e59d23 100755 --- a/extra/io/buffers/buffers.factor +++ b/extra/io/buffers/buffers.factor @@ -3,7 +3,8 @@ ! See http://factorcode.org/license.txt for BSD license. IN: io.buffers USING: alien alien.accessors alien.c-types alien.syntax kernel -kernel.private libc math sequences byte-arrays strings hints ; +kernel.private libc math sequences byte-arrays strings hints +accessors ; TUPLE: buffer size ptr fill pos ; @@ -37,46 +38,21 @@ TUPLE: buffer size ptr fill pos ; : buffer-pop ( buffer -- byte ) dup buffer-peek 1 rot buffer-consume ; -: (buffer>) ( n buffer -- byte-array ) - [ dup buffer-fill swap buffer-pos - min ] keep +: (buffer-read) ( n buffer -- byte-array ) + [ [ fill>> ] [ pos>> ] bi - min ] keep buffer@ swap memory>byte-array ; -: buffer> ( n buffer -- byte-array ) - [ (buffer>) ] 2keep buffer-consume ; - -: (buffer>>) ( buffer -- byte-array ) - dup buffer-pos over buffer-ptr - over buffer-fill rot buffer-pos - memory>byte-array ; - -: buffer>> ( buffer -- byte-array ) - dup (buffer>>) 0 rot buffer-reset ; - -: search-buffer-until ( start end alien separators -- n ) - [ >r swap alien-unsigned-1 r> memq? ] 2curry find* drop ; - -HINTS: search-buffer-until { fixnum fixnum simple-alien string } ; - -: finish-buffer-until ( buffer n -- byte-array separator ) - [ - over buffer-pos - - over buffer> - swap buffer-pop - ] [ - buffer>> f - ] if* ; - -: buffer-until ( separators buffer -- byte-array separator ) - tuck { buffer-pos buffer-fill buffer-ptr } get-slots roll - search-buffer-until finish-buffer-until ; +: buffer-read ( n buffer -- byte-array ) + [ (buffer-read) ] [ buffer-consume ] 2bi ; : buffer-length ( buffer -- n ) - dup buffer-fill swap buffer-pos - ; + [ fill>> ] [ pos>> ] bi - ; : buffer-capacity ( buffer -- n ) - dup buffer-size swap buffer-fill - ; + [ size>> ] [ fill>> ] bi - ; : buffer-empty? ( buffer -- ? ) - buffer-fill zero? ; + fill>> zero? ; : extend-buffer ( n buffer -- ) 2dup buffer-ptr swap realloc @@ -93,7 +69,7 @@ HINTS: search-buffer-until { fixnum fixnum simple-alien string } ; : byte>buffer ( byte buffer -- ) 1 over check-overflow [ buffer-end 0 set-alien-unsigned-1 ] keep - [ buffer-fill 1+ ] keep set-buffer-fill ; + [ 1+ ] change-fill drop ; : n>buffer ( n buffer -- ) [ buffer-fill + ] keep diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index ed98665e06..b345a98e88 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -73,7 +73,7 @@ M: input-port stream-read1 : read-step ( count port -- byte-array/f ) [ wait-to-read ] 2keep - [ dupd buffer> ] unless-eof nip ; + [ dupd buffer-read ] unless-eof nip ; : read-loop ( count port accum -- ) pick over length - dup 0 > [ @@ -101,38 +101,6 @@ M: input-port stream-read 2nip ] if ; -: read-until-step ( separators port -- byte-array/f separator/f ) - dup wait-to-read1 - dup port-eof? [ - f swap set-port-eof? drop f f - ] [ - buffer-until - ] if ; - -: read-until-loop ( seps port accum -- separator/f ) - 2over read-until-step over [ - >r over push-all r> dup [ - >r 3drop r> - ] [ - drop read-until-loop - ] if - ] [ - >r 2drop 2drop r> - ] if ; - -M: input-port stream-read-until ( seps port -- byte-array/f sep/f ) - 2dup read-until-step dup [ - >r 2nip r> - ] [ - over [ - drop BV{ } like - [ read-until-loop ] keep - B{ } like swap - ] [ - >r 2nip r> - ] if - ] if ; - M: input-port stream-read-partial ( max stream -- byte-array/f ) >r 0 max >fixnum r> read-step ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index c9bd331bcd..63d2adbdf7 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -4,7 +4,7 @@ USING: alien generic assocs kernel kernel.private math io.nonblocking sequences strings structs sbufs threads unix vectors io.buffers io.backend io.encodings io.streams.duplex math.parser continuations system libc -qualified namespaces io.timeouts io.encodings.utf8 ; +qualified namespaces io.timeouts io.encodings.utf8 accessors ; QUALIFIED: io IN: io.unix.backend @@ -13,7 +13,7 @@ MIXIN: unix-io ! I/O tasks TUPLE: io-task port callbacks ; -: io-task-fd io-task-port port-handle ; +: io-task-fd port>> handle>> ; : ( port continuation/f class -- task ) >r [ 1vector ] [ V{ } clone ] if* io-task construct-boa @@ -35,9 +35,9 @@ GENERIC: io-task-container ( mx task -- hashtable ) ! I/O multiplexers TUPLE: mx fd reads writes ; -M: input-task io-task-container drop mx-reads ; +M: input-task io-task-container drop reads>> ; -M: output-task io-task-container drop mx-writes ; +M: output-task io-task-container drop writes>> ; : ( -- mx ) f H{ } clone H{ } clone mx construct-boa ; @@ -90,11 +90,11 @@ M: integer close-handle ( fd -- ) close ; : report-error ( error port -- ) - [ "Error on fd " % dup port-handle # ": " % swap % ] "" make - swap set-port-error ; + [ "Error on fd " % dup handle>> # ": " % swap % ] "" make + >>error drop ; : ignorable-error? ( n -- ? ) - dup EAGAIN number= swap EINTR number= or ; + [ EAGAIN number= ] [ EINTR number= ] bi or ; : defer-error ( port -- ? ) #! Return t if it is an unrecoverable error. @@ -110,26 +110,25 @@ M: integer close-handle ( fd -- ) : handle-timeout ( port mx assoc -- ) >r swap port-handle r> delete-at* [ - "I/O operation cancelled" over io-task-port report-error + "I/O operation cancelled" over port>> report-error pop-callbacks ] [ 2drop ] if ; : cancel-io-tasks ( port mx -- ) - 2dup - dup mx-reads handle-timeout - dup mx-writes handle-timeout ; + [ dup reads>> handle-timeout ] + [ dup writes>> handle-timeout ] 2bi ; M: unix-io cancel-io ( port -- ) mx get-global cancel-io-tasks ; ! Readers : reader-eof ( reader -- ) - dup buffer-empty? [ t over set-port-eof? ] when drop ; + dup buffer-empty? [ t >>eof? ] when drop ; : (refill) ( port -- n ) - dup port-handle over buffer-end rot buffer-capacity read ; + [ handle>> ] [ buffer-end ] [ buffer-capacity ] tri read ; : refill ( port -- ? ) #! Return f if there is a recoverable error @@ -158,7 +157,7 @@ M: input-port (wait-to-read) ! Writers : write-step ( port -- ? ) - dup port-handle over buffer@ pick buffer-length write + dup [ handle>> ] [ buffer@ ] [ buffer-length ] tri write dup 0 >= [ swap buffer-consume f ] [ drop defer-error ] if ; TUPLE: write-task ; @@ -167,7 +166,7 @@ TUPLE: write-task ; write-task ; M: write-task do-io-task - io-task-port dup buffer-empty? over port-error or + io-task-port dup [ buffer-empty? ] [ port-error ] bi or [ 0 swap buffer-reset t ] [ write-step ] if ; : add-write-io-task ( port continuation -- ) @@ -193,7 +192,7 @@ M: unix-io (init-stdio) ( -- ) TUPLE: mx-port mx ; : ( mx -- port ) - dup mx-fd f mx-port + dup fd>> f mx-port { set-mx-port-mx set-delegate } mx-port construct ; TUPLE: mx-task ; @@ -202,7 +201,7 @@ TUPLE: mx-task ; f mx-task ; M: mx-task do-io-task - io-task-port mx-port-mx 0 swap wait-for-events f ; + port>> mx>> 0 swap wait-for-events f ; : multiplexer-error ( n -- ) 0 < [ err_no ignorable-error? [ (io-error) ] unless ] when ; diff --git a/extra/io/unix/select/select.factor b/extra/io/unix/select/select.factor index 77a20beb42..aceee0f311 100755 --- a/extra/io/unix/select/select.factor +++ b/extra/io/unix/select/select.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel io.nonblocking io.unix.backend -bit-arrays sequences assocs unix math namespaces structs ; +bit-arrays sequences assocs unix math namespaces structs +accessors ; IN: io.unix.select TUPLE: select-mx read-fdset write-fdset ; @@ -14,11 +15,11 @@ TUPLE: select-mx read-fdset write-fdset ; : ( -- mx ) select-mx construct-mx - FD_SETSIZE 8 * over set-select-mx-read-fdset - FD_SETSIZE 8 * over set-select-mx-write-fdset ; + FD_SETSIZE 8 * >>read-fdset + FD_SETSIZE 8 * >>write-fdset ; : clear-nth ( n seq -- ? ) - [ nth ] 2keep f -rot set-nth ; + [ nth ] [ f -rot set-nth ] 2bi ; : handle-fd ( fd task fdset mx -- ) roll munge rot clear-nth @@ -32,15 +33,16 @@ TUPLE: select-mx read-fdset write-fdset ; [ >r drop t swap munge r> set-nth ] curry assoc-each ; : read-fdset/tasks - { mx-reads select-mx-read-fdset } get-slots ; + [ reads>> ] [ read-fdset>> ] bi ; : write-fdset/tasks - { mx-writes select-mx-write-fdset } get-slots ; + [ writes>> ] [ write-fdset>> ] bi ; -: max-fd dup assoc-empty? [ drop 0 ] [ keys supremum ] if ; +: max-fd ( assoc -- n ) + dup assoc-empty? [ drop 0 ] [ keys supremum ] if ; : num-fds ( mx -- n ) - dup mx-reads max-fd swap mx-writes max-fd max 1+ ; + [ reads>> max-fd ] [ writes>> max-fd ] bi max 1+ ; : init-fdsets ( mx -- nfds read write except ) [ num-fds ] keep diff --git a/extra/locals/locals.factor b/extra/locals/locals.factor index 25f9e4eaf9..5da0225be9 100755 --- a/extra/locals/locals.factor +++ b/extra/locals/locals.factor @@ -266,13 +266,13 @@ M: object local-rewrite* , ; ] assoc-each local-rewrite* \ call , ; M: let local-rewrite* - { body>> bindings>> } get-slots let-rewrite ; + [ body>> ] [ bindings>> ] bi let-rewrite ; M: let* local-rewrite* - { body>> bindings>> } get-slots let-rewrite ; + [ body>> ] [ bindings>> ] bi let-rewrite ; M: wlet local-rewrite* - { body>> bindings>> } get-slots + [ body>> ] [ bindings>> ] bi [ [ ] curry ] assoc-map let-rewrite ; @@ -340,7 +340,7 @@ M: lambda pprint* : pprint-let ( let word -- ) pprint-word - { body>> bindings>> } get-slots + [ body>> ] [ bindings>> ] bi \ | pprint-word t Date: Sat, 29 Mar 2008 02:46:29 -0500 Subject: [PATCH 160/219] Clean up tuple code and get hierarchy changes working --- core/classes/classes.factor | 21 ++++++---- core/classes/union/union.factor | 4 +- core/prettyprint/prettyprint.factor | 2 +- core/tuples/tuples-tests.factor | 4 +- core/tuples/tuples.factor | 64 ++++++++++++++--------------- extra/json/writer/writer.factor | 2 +- 6 files changed, 51 insertions(+), 46 deletions(-) diff --git a/core/classes/classes.factor b/core/classes/classes.factor index ccb735f392..435c7413a3 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -101,12 +101,12 @@ M: word reset-class drop ; PRIVATE> -GENERIC: update-predicate ( class -- ) +GENERIC: update-class ( class -- ) -M: class update-predicate drop ; +M: class update-class drop ; -: update-predicates ( assoc -- ) - [ drop update-predicate ] assoc-each ; +: update-classes ( assoc -- ) + [ drop update-class ] assoc-each ; GENERIC: update-methods ( assoc -- ) @@ -114,10 +114,15 @@ GENERIC: update-methods ( assoc -- ) #! If it was already a class, update methods after. reset-caches define-class-props - over update-map- - dupd (define-class) - dup update-map+ - class-usages dup update-predicates update-methods ; + [ drop update-map- ] + [ (define-class) ] [ + drop + [ update-map+ ] [ + class-usages + [ update-classes ] + [ update-methods ] bi + ] bi + ] 2tri ; GENERIC: class ( object -- class ) inline diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor index 814ab0e838..e9b98770dc 100755 --- a/core/classes/union/union.factor +++ b/core/classes/union/union.factor @@ -33,10 +33,10 @@ PREDICATE: union-class < class : define-union-predicate ( class -- ) dup members union-predicate-quot define-predicate ; -M: union-class update-predicate define-union-predicate ; +M: union-class update-class define-union-predicate ; : define-union-class ( class members -- ) - >r dup f r> union-class define-class define-union-predicate ; + f swap union-class define-class ; M: union-class reset-class { "metaclass" "members" } reset-props ; diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 7b8c8f2997..675841816f 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -260,7 +260,7 @@ M: tuple-class see-class* dup superclass tuple eq? [ "<" text dup superclass pprint-word ] unless - "slot-names" word-prop [ text ] each + slot-names [ text ] each pprint-; block> ; M: word see-class* drop ; diff --git a/core/tuples/tuples-tests.factor b/core/tuples/tuples-tests.factor index 09795888a8..2ae53ee05d 100755 --- a/core/tuples/tuples-tests.factor +++ b/core/tuples/tuples-tests.factor @@ -343,7 +343,7 @@ TUPLE: electronic-device ; ! Hardcore unit tests USE: threads -\ thread "slot-names" word-prop "slot-names" set +\ thread slot-names "slot-names" set [ ] [ [ @@ -361,7 +361,7 @@ USE: threads USE: vocabs -\ vocab "slot-names" word-prop "slot-names" set +\ vocab slot-names "slot-names" set [ ] [ [ diff --git a/core/tuples/tuples.factor b/core/tuples/tuples.factor index 60606357d3..f4ab215bf0 100755 --- a/core/tuples/tuples.factor +++ b/core/tuples/tuples.factor @@ -4,7 +4,7 @@ USING: arrays definitions hashtables kernel kernel.private math namespaces sequences sequences.private strings vectors words quotations memory combinators generic classes classes.private slots.deprecated slots.private slots -compiler.units math.private ; +compiler.units math.private accessors ; IN: tuples M: tuple delegate 2 slot ; @@ -44,6 +44,9 @@ PRIVATE> 2each ] keep ; +: slot-names ( class -- seq ) + "slots" word-prop [ name>> ] map ; + : superclass-size ( class -- n ) superclasses 1 head-slice* - [ "slot-names" word-prop length ] map sum ; + [ slot-names length ] map sum ; -: generate-tuple-slots ( class slots -- slot-specs slot-names ) - over superclass-size 2 + simple-slots - dup [ slot-spec-name ] map ; +: generate-tuple-slots ( class slots -- slots ) + over superclass-size 2 + simple-slots ; : define-tuple-slots ( class slots -- ) dupd generate-tuple-slots - >r dupd "slots" set-word-prop - r> dupd "slot-names" set-word-prop - dup "slots" word-prop 2dup define-slots define-accessors ; + [ "slots" set-word-prop ] + [ define-accessors ] + [ define-slots ] 2tri ; : make-tuple-layout ( class -- layout ) - dup superclass-size over "slot-names" word-prop length + - over superclasses dup length 1- ; + [ ] + [ [ superclass-size ] [ "slots" word-prop length ] bi + ] + [ superclasses dup length 1- ] tri + ; : define-tuple-layout ( class -- ) dup make-tuple-layout "layout" set-word-prop ; : removed-slots ( class newslots -- seq ) - swap "slot-names" word-prop seq-diff ; + swap slot-names seq-diff ; -: forget-slots ( class newslots -- ) +: forget-slots ( class slots -- ) dupd removed-slots [ - 2dup - reader-word forget-method - writer-word forget-method + [ reader-word forget-method ] + [ writer-word forget-method ] 2bi ] with each ; : permutation ( seq1 seq2 -- permutation ) @@ -126,28 +129,29 @@ PRIVATE> : reshape-tuples ( class superclass newslots -- ) nip - >r dup "slot-names" word-prop r> permutation + >r dup slot-names r> permutation [ - >r [ swap class eq? ] curry instances dup r> - [ reshape-tuple ] curry map + >r "predicate" word-prop instances dup + r> [ reshape-tuple ] curry map become ] 2curry after-compilation ; : define-new-tuple-class ( class superclass slots -- ) [ drop f tuple-class define-class ] - [ nip define-tuple-slots ] - [ + [ nip define-tuple-slots ] [ 2drop - [ define-tuple-layout ] - [ define-tuple-predicate ] - bi - ] - 3tri ; + class-usages [ + drop + [ define-tuple-layout ] + [ define-tuple-predicate ] + bi + ] assoc-each + ] 3tri ; : redefine-tuple-class ( class superclass slots -- ) [ reshape-tuples ] [ - drop + nip [ forget-slots ] [ drop changed-word ] [ drop redefined ] @@ -157,9 +161,7 @@ PRIVATE> 3tri ; : tuple-class-unchanged? ( class superclass slots -- ? ) - rot tuck - [ "superclass" word-prop = ] - [ "slot-names" word-prop = ] 2bi* and ; + rot tuck [ superclass = ] [ slot-names = ] 2bi* and ; PRIVATE> @@ -199,9 +201,7 @@ M: tuple hashcode* ! Definition protocol M: tuple-class reset-class - { - "metaclass" "superclass" "slot-names" "slots" "layout" - } reset-props ; + { "metaclass" "superclass" "slots" "layout" } reset-props ; M: object get-slots ( obj slots -- ... ) [ execute ] with each ; diff --git a/extra/json/writer/writer.factor b/extra/json/writer/writer.factor index 4f3bd09613..110e9b843c 100644 --- a/extra/json/writer/writer.factor +++ b/extra/json/writer/writer.factor @@ -42,7 +42,7 @@ M: sequence json-print ( array -- string ) : slots ( object -- values names ) #! Given an object return an array of slots names and a sequence of slot values #! the slot name and the slot value. - [ tuple-slots ] keep class "slot-names" word-prop ; + [ tuple-slots ] keep class slot-names ; : slots>fields ( values names -- array ) #! Convert the arrays containing the slot names and values From adb1dd14d0f696ff7ed5bc8b09559b7e263b51c4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 03:34:48 -0500 Subject: [PATCH 161/219] Rename tuples vocab to classes.tuple for consistency --- core/alien/alien.factor | 3 +- core/bootstrap/compiler/compiler.factor | 4 +-- core/bootstrap/image/image.factor | 9 +++--- core/bootstrap/layouts/layouts.factor | 2 +- core/bootstrap/primitives.factor | 30 +++++++++---------- core/{tuples => classes/tuple}/authors.txt | 0 core/{tuples => classes/tuple}/summary.txt | 0 .../tuple/tuple-docs.factor} | 6 ++-- .../tuple/tuple-tests.factor} | 30 +++++++++---------- .../tuple/tuple.factor} | 4 +-- core/cpu/arm/intrinsics/intrinsics.factor | 4 +-- core/cpu/ppc/intrinsics/intrinsics.factor | 6 ++-- core/cpu/x86/intrinsics/intrinsics.factor | 4 +-- core/debugger/debugger.factor | 2 +- core/inference/inference-tests.factor | 6 ++-- core/inference/known-words/known-words.factor | 6 ++-- core/inference/transforms/transforms.factor | 2 +- core/kernel/kernel.factor | 2 -- core/listener/listener.factor | 2 +- core/mirrors/mirrors.factor | 2 +- core/optimizer/known-words/known-words.factor | 2 +- core/optimizer/optimizer-tests.factor | 2 +- core/parser/parser-tests.factor | 3 +- core/prettyprint/backend/backend.factor | 3 +- core/prettyprint/prettyprint.factor | 4 +-- core/refs/refs.factor | 6 ++-- core/slots/slots-docs.factor | 2 +- core/syntax/syntax-docs.factor | 4 +-- core/syntax/syntax.factor | 2 +- core/vocabs/loader/loader-tests.factor | 2 +- core/words/words-tests.factor | 3 +- extra/bake/bake.factor | 2 +- extra/calendar/calendar.factor | 4 +-- .../{tuples => classes/tuple}/lib/authors.txt | 0 .../tuple}/lib/lib-docs.factor | 6 ++-- .../tuple}/lib/lib-tests.factor | 4 +-- .../{tuples => classes/tuple}/lib/lib.factor | 2 +- extra/db/db.factor | 2 +- extra/db/sql/sql.factor | 2 +- extra/db/sqlite/sqlite.factor | 2 +- extra/db/tuples/tuples.factor | 2 +- extra/db/types/types.factor | 2 +- extra/editors/editors.factor | 4 +-- extra/help/help.factor | 6 ++-- .../http/server/components/components.factor | 10 +++---- extra/inverse/inverse.factor | 5 ++-- extra/io/encodings/8-bit/8-bit.factor | 4 +-- extra/io/nonblocking/nonblocking-docs.factor | 8 ----- extra/io/windows/nt/backend/backend.factor | 2 +- extra/io/windows/nt/sockets/sockets.factor | 2 +- extra/json/writer/writer.factor | 2 +- extra/match/match.factor | 2 +- extra/models/models-docs.factor | 2 +- extra/serialize/serialize.factor | 12 ++++---- .../disassembler/disassembler-tests.factor | 2 +- extra/tuple-arrays/tuple-arrays.factor | 3 +- extra/ui/gadgets/buttons/buttons.factor | 4 +-- extra/ui/gadgets/canvas/canvas.factor | 2 +- extra/ui/gadgets/frames/frames-docs.factor | 2 +- extra/ui/gadgets/gadgets-docs.factor | 2 +- extra/ui/gadgets/labelled/labelled.factor | 3 +- extra/ui/gadgets/lists/lists.factor | 2 +- extra/ui/gadgets/packs/packs-docs.factor | 4 +-- extra/ui/gadgets/panes/panes.factor | 2 +- .../presentations/presentations-tests.factor | 2 +- extra/ui/gadgets/scrollers/scrollers.factor | 2 +- extra/ui/gadgets/tracks/tracks-docs.factor | 2 +- extra/ui/gestures/gestures.factor | 3 +- extra/ui/tools/interactor/interactor.factor | 2 +- extra/ui/tools/search/search.factor | 2 +- extra/ui/x11/x11.factor | 2 +- 71 files changed, 141 insertions(+), 144 deletions(-) rename core/{tuples => classes/tuple}/authors.txt (100%) rename core/{tuples => classes/tuple}/summary.txt (100%) rename core/{tuples/tuples-docs.factor => classes/tuple/tuple-docs.factor} (98%) rename core/{tuples/tuples-tests.factor => classes/tuple/tuple-tests.factor} (89%) rename core/{tuples/tuples.factor => classes/tuple/tuple.factor} (98%) rename extra/{tuples => classes/tuple}/lib/authors.txt (100%) rename extra/{tuples => classes/tuple}/lib/lib-docs.factor (86%) rename extra/{tuples => classes/tuple}/lib/lib-tests.factor (70%) rename extra/{tuples => classes/tuple}/lib/lib.factor (94%) diff --git a/core/alien/alien.factor b/core/alien/alien.factor index 777bf523a5..d0adec1fcf 100755 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs kernel math namespaces sequences system -kernel.private tuples bit-arrays byte-arrays float-arrays -arrays ; +kernel.private bit-arrays byte-arrays float-arrays arrays ; IN: alien ! Some predicate classes used by the compiler for optimization diff --git a/core/bootstrap/compiler/compiler.factor b/core/bootstrap/compiler/compiler.factor index af2cc79579..7d4db3c473 100755 --- a/core/bootstrap/compiler/compiler.factor +++ b/core/bootstrap/compiler/compiler.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: compiler cpu.architecture vocabs.loader system sequences namespaces parser kernel kernel.private classes classes.private -arrays hashtables vectors tuples sbufs inference.dataflow -hashtables.private sequences.private math tuples.private +arrays hashtables vectors classes.tuple sbufs inference.dataflow +hashtables.private sequences.private math classes.tuple.private growable namespaces.private assocs words generator command-line vocabs io prettyprint libc compiler.units ; IN: bootstrap.compiler diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 7fd4361246..deb54fdeeb 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -4,10 +4,11 @@ USING: alien arrays bit-arrays byte-arrays generic assocs hashtables assocs hashtables.private io kernel kernel.private math namespaces parser prettyprint sequences sequences.private strings sbufs vectors words quotations assocs system layouts -splitting growable classes tuples tuples.private words.private -io.binary io.files vocabs vocabs.loader source-files -definitions debugger float-arrays quotations.private -sequences.private combinators io.encodings.binary ; +splitting growable classes classes.tuple classes.tuple.private +words.private io.binary io.files vocabs vocabs.loader +source-files definitions debugger float-arrays +quotations.private sequences.private combinators +io.encodings.binary ; IN: bootstrap.image : my-arch ( -- arch ) diff --git a/core/bootstrap/layouts/layouts.factor b/core/bootstrap/layouts/layouts.factor index 316fa3cd72..846cce153b 100755 --- a/core/bootstrap/layouts/layouts.factor +++ b/core/bootstrap/layouts/layouts.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces math words kernel alien byte-arrays hashtables vectors strings sbufs arrays bit-arrays -float-arrays quotations assocs layouts tuples tuples.private ; +float-arrays quotations assocs layouts classes.tuple.private ; BIN: 111 tag-mask set 8 num-tags set diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 50dea27e7b..2e1a7f9f57 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -2,10 +2,10 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien arrays byte-arrays generic hashtables hashtables.private io kernel math namespaces parser sequences -strings vectors words quotations assocs layouts classes tuples -tuples.private kernel.private vocabs vocabs.loader source-files -definitions slots.deprecated classes.union compiler.units -bootstrap.image.private io.files ; +strings vectors words quotations assocs layouts classes +classes.tuple classes.tuple.private kernel.private vocabs +vocabs.loader source-files definitions slots.deprecated +classes.union compiler.units bootstrap.image.private io.files ; IN: bootstrap.primitives "Creating primitives and basic runtime structures..." print flush @@ -60,6 +60,8 @@ num-types get f builtins set "byte-arrays" "byte-vectors" "classes.private" + "classes.tuple" + "classes.tuple.private" "compiler.units" "continuations.private" "float-arrays" @@ -91,8 +93,6 @@ num-types get f builtins set "system.private" "threads.private" "tools.profiler.private" - "tuples" - "tuples.private" "words" "words.private" "vectors" @@ -291,35 +291,35 @@ define-builtin "callstack" "kernel" create { } define-builtin -"tuple-layout" "tuples.private" create { +"tuple-layout" "classes.tuple.private" create { { { "fixnum" "math" } "hashcode" - { "layout-hashcode" "tuples.private" } + { "layout-hashcode" "classes.tuple.private" } f } { { "word" "words" } "class" - { "layout-class" "tuples.private" } + { "layout-class" "classes.tuple.private" } f } { { "fixnum" "math" } "size" - { "layout-size" "tuples.private" } + { "layout-size" "classes.tuple.private" } f } { { "array" "arrays" } "superclasses" - { "layout-superclasses" "tuples.private" } + { "layout-superclasses" "classes.tuple.private" } f } { { "fixnum" "math" } "echelon" - { "layout-echelon" "tuples.private" } + { "layout-echelon" "classes.tuple.private" } f } } define-builtin @@ -694,13 +694,13 @@ dup tuple-layout [ ] curry define { "" "strings" } { "array>quotation" "quotations.private" } { "quotation-xt" "quotations" } - { "" "tuples.private" } - { "" "tuples.private" } + { "" "classes.tuple.private" } + { "" "classes.tuple.private" } { "profiling" "tools.profiler.private" } { "become" "kernel.private" } { "(sleep)" "threads.private" } { "" "float-arrays" } - { "" "tuples.private" } + { "" "classes.tuple.private" } { "class-hash" "kernel.private" } { "callstack>array" "kernel" } { "innermost-frame-quot" "kernel.private" } diff --git a/core/tuples/authors.txt b/core/classes/tuple/authors.txt similarity index 100% rename from core/tuples/authors.txt rename to core/classes/tuple/authors.txt diff --git a/core/tuples/summary.txt b/core/classes/tuple/summary.txt similarity index 100% rename from core/tuples/summary.txt rename to core/classes/tuple/summary.txt diff --git a/core/tuples/tuples-docs.factor b/core/classes/tuple/tuple-docs.factor similarity index 98% rename from core/tuples/tuples-docs.factor rename to core/classes/tuple/tuple-docs.factor index 55e15d6dc6..a747008fa2 100755 --- a/core/tuples/tuples-docs.factor +++ b/core/classes/tuple/tuple-docs.factor @@ -1,7 +1,7 @@ USING: generic help.markup help.syntax kernel -tuples.private classes slots quotations words arrays +classes.tuple.private classes slots quotations words arrays generic.standard sequences definitions compiler.units ; -IN: tuples +IN: classes.tuple ARTICLE: "tuple-constructors" "Constructors" "Tuples are created by calling one of two words:" @@ -151,7 +151,7 @@ HELP: set-delegate HELP: tuple= { $values { "tuple1" tuple } { "tuple2" tuple } { "?" "a boolean" } } { $description "Low-level tuple equality test. User code should use " { $link = } " instead." } -{ $warning "This word is in the " { $vocab-link "tuples.private" } " vocabulary because it does not do any type checking. Passing values which are not tuples can result in memory corruption." } ; +{ $warning "This word is in the " { $vocab-link "classes.tuple.private" } " vocabulary because it does not do any type checking. Passing values which are not tuples can result in memory corruption." } ; HELP: permutation { $values { "seq1" sequence } { "seq2" sequence } { "permutation" "a sequence whose elements are integers or " { $link f } } } diff --git a/core/tuples/tuples-tests.factor b/core/classes/tuple/tuple-tests.factor similarity index 89% rename from core/tuples/tuples-tests.factor rename to core/classes/tuple/tuple-tests.factor index 2ae53ee05d..2e37655f1d 100755 --- a/core/tuples/tuples-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -1,10 +1,10 @@ USING: definitions generic kernel kernel.private math math.constants parser sequences tools.test words assocs namespaces quotations sequences.private classes continuations -generic.standard effects tuples tuples.private arrays vectors -strings compiler.units accessors classes.algebra calendar -prettyprint io.streams.string splitting ; -IN: tuples.tests +generic.standard effects classes.tuple classes.tuple.private +arrays vectors strings compiler.units accessors classes.algebra +calendar prettyprint io.streams.string splitting ; +IN: classes.tuple.tests TUPLE: rect x y w h ; : rect construct-boa ; @@ -44,7 +44,7 @@ C: redefinition-test [ t ] [ "redefinition-test" get redefinition-test? ] unit-test -"IN: tuples.tests TUPLE: redefinition-test ;" eval +"IN: classes.tuple.tests TUPLE: redefinition-test ;" eval [ t ] [ "redefinition-test" get redefinition-test? ] unit-test @@ -56,7 +56,7 @@ C: point [ ] [ 100 200 "p" set ] unit-test ! Use eval to sequence parsing explicitly -[ ] [ "IN: tuples.tests TUPLE: point x y z ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: point x y z ;" eval ] unit-test [ 100 ] [ "p" get x>> ] unit-test [ 200 ] [ "p" get y>> ] unit-test @@ -68,7 +68,7 @@ C: point [ 300 ] [ "p" get "z>>" "accessors" lookup execute ] unit-test -"IN: tuples.tests TUPLE: point z y ;" eval +"IN: classes.tuple.tests TUPLE: point z y ;" eval [ 3 ] [ "p" get tuple-size ] unit-test @@ -124,7 +124,7 @@ GENERIC: TUPLE: yo-momma ; -"IN: tuples.tests C: yo-momma" eval +"IN: classes.tuple.tests C: yo-momma" eval [ f ] [ \ generic? ] unit-test @@ -213,12 +213,12 @@ M: vector silly "z" ; SYMBOL: not-a-tuple-class [ - "IN: tuples.tests C: not-a-tuple-class" + "IN: classes.tuple.tests C: not-a-tuple-class" eval ] must-fail [ t ] [ - "not-a-tuple-class" "tuples.tests" lookup symbol? + "not-a-tuple-class" "classes.tuple.tests" lookup symbol? ] unit-test ! Missing check @@ -234,14 +234,14 @@ C: erg's-reshape-problem : cons-test-1 \ erg's-reshape-problem construct-empty ; : cons-test-2 \ erg's-reshape-problem construct-boa ; -"IN: tuples.tests TUPLE: erg's-reshape-problem a b c d e f ;" eval +"IN: classes.tuple.tests TUPLE: erg's-reshape-problem a b c d e f ;" eval [ ] [ 1 2 3 4 5 6 cons-test-2 "a" set ] unit-test [ t ] [ cons-test-1 tuple-size "a" get tuple-size = ] unit-test [ - "IN: tuples.tests SYMBOL: not-a-class C: not-a-class" eval + "IN: classes.tuple.tests SYMBOL: not-a-class C: not-a-class" eval ] [ [ no-tuple-class? ] is? ] must-fail-with ! Inheritance @@ -313,13 +313,13 @@ C: server ] unit-test [ - "IN: tuples.tests TUPLE: bad-superclass < word ;" eval + "IN: classes.tuple.tests TUPLE: bad-superclass < word ;" eval ] must-fail ! Reshaping with inheritance TUPLE: electronic-device ; -[ ] [ "IN: tuples.tests TUPLE: computer < electronic-device ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device ;" eval ] unit-test [ f ] [ electronic-device laptop class< ] unit-test [ t ] [ server electronic-device class< ] unit-test @@ -335,7 +335,7 @@ TUPLE: electronic-device ; [ f ] [ "server" get laptop? ] unit-test [ t ] [ "server" get server? ] unit-test -[ ] [ "IN: tuples.tests TUPLE: computer ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: computer ;" eval ] unit-test [ f ] [ "laptop" get electronic-device? ] unit-test [ t ] [ "laptop" get computer? ] unit-test diff --git a/core/tuples/tuples.factor b/core/classes/tuple/tuple.factor similarity index 98% rename from core/tuples/tuples.factor rename to core/classes/tuple/tuple.factor index f4ab215bf0..28dbfdb372 100755 --- a/core/tuples/tuples.factor +++ b/core/classes/tuple/tuple.factor @@ -4,8 +4,8 @@ USING: arrays definitions hashtables kernel kernel.private math namespaces sequences sequences.private strings vectors words quotations memory combinators generic classes classes.private slots.deprecated slots.private slots -compiler.units math.private accessors ; -IN: tuples +compiler.units math.private accessors assocs ; +IN: classes.tuple M: tuple delegate 2 slot ; diff --git a/core/cpu/arm/intrinsics/intrinsics.factor b/core/cpu/arm/intrinsics/intrinsics.factor index 29210afaa5..e9902888eb 100755 --- a/core/cpu/arm/intrinsics/intrinsics.factor +++ b/core/cpu/arm/intrinsics/intrinsics.factor @@ -5,8 +5,8 @@ cpu.arm.architecture cpu.arm.allot kernel kernel.private math math.private namespaces sequences words quotations byte-arrays hashtables.private hashtables generator generator.registers generator.fixup sequences.private sbufs -sbufs.private vectors vectors.private system tuples.private -layouts strings.private slots.private ; +sbufs.private vectors vectors.private system +classes.tuple.private layouts strings.private slots.private ; IN: cpu.arm.intrinsics : %slot-literal-known-tag diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor index 0aef15ba99..7aa78ce52e 100755 --- a/core/cpu/ppc/intrinsics/intrinsics.factor +++ b/core/cpu/ppc/intrinsics/intrinsics.factor @@ -6,9 +6,9 @@ kernel.private math math.private namespaces sequences words generic quotations byte-arrays hashtables hashtables.private generator generator.registers generator.fixup sequences.private sbufs vectors system layouts math.floats.private -classes tuples tuples.private sbufs.private vectors.private -strings.private slots.private combinators bit-arrays -float-arrays compiler.constants ; +classes classes.tuple classes.tuple.private sbufs.private +vectors.private strings.private slots.private combinators +bit-arrays float-arrays compiler.constants ; IN: cpu.ppc.intrinsics : %slot-literal-known-tag diff --git a/core/cpu/x86/intrinsics/intrinsics.factor b/core/cpu/x86/intrinsics/intrinsics.factor index dfe136fc6e..f5409a24f5 100755 --- a/core/cpu/x86/intrinsics/intrinsics.factor +++ b/core/cpu/x86/intrinsics/intrinsics.factor @@ -6,8 +6,8 @@ kernel.private math math.private namespaces quotations sequences words generic byte-arrays hashtables hashtables.private generator generator.registers generator.fixup sequences.private sbufs sbufs.private vectors vectors.private layouts system -tuples.private strings.private slots.private compiler.constants -; +classes.tuple.private strings.private slots.private +compiler.constants ; IN: cpu.x86.intrinsics ! Type checks diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor index 3361073d35..a7937cdb9d 100755 --- a/core/debugger/debugger.factor +++ b/core/debugger/debugger.factor @@ -3,7 +3,7 @@ USING: arrays definitions generic hashtables inspector io kernel math namespaces prettyprint sequences assocs sequences.private strings io.styles vectors words system splitting math.parser -tuples continuations continuations.private combinators +classes.tuple continuations continuations.private combinators generic.math io.streams.duplex classes compiler.units generic.standard vocabs threads threads.private init kernel.private libc io.encodings ; diff --git a/core/inference/inference-tests.factor b/core/inference/inference-tests.factor index 4f5d199264..1cc1548a3d 100755 --- a/core/inference/inference-tests.factor +++ b/core/inference/inference-tests.factor @@ -3,9 +3,9 @@ inference.dataflow kernel classes kernel.private math math.parser math.private namespaces namespaces.private parser sequences strings vectors words quotations effects tools.test continuations generic.standard sorting assocs definitions -prettyprint io inspector tuples classes.union classes.predicate -debugger threads.private io.streams.string io.timeouts -io.thread sequences.private ; +prettyprint io inspector classes.tuple classes.union +classes.predicate debugger threads.private io.streams.string +io.timeouts io.thread sequences.private ; IN: inference.tests { 0 2 } [ 2 "Hello" ] must-infer-as diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index 0de1e0bc53..79e41c8ae4 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -9,9 +9,9 @@ kernel.private math math.private memory namespaces namespaces.private parser prettyprint quotations quotations.private sbufs sbufs.private sequences sequences.private slots.private strings strings.private system -threads.private tuples tuples.private vectors vectors.private -words words.private assocs inspector compiler.units -system.private ; +threads.private classes.tuple classes.tuple.private vectors +vectors.private words words.private assocs inspector +compiler.units system.private ; IN: inference.known-words ! Shuffle words diff --git a/core/inference/transforms/transforms.factor b/core/inference/transforms/transforms.factor index e77872ae78..200208c6a5 100755 --- a/core/inference/transforms/transforms.factor +++ b/core/inference/transforms/transforms.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel words sequences generic math namespaces quotations assocs combinators math.bitfields inference.backend -inference.dataflow inference.state tuples.private effects +inference.dataflow inference.state classes.tuple.private effects inspector hashtables ; IN: inference.transforms diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 1987597c58..cbabeb6bfa 100755 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -156,8 +156,6 @@ GENERIC: construct-boa ( ... class -- tuple ) >r { set-delegate } r> construct ; inline ! Quotation building -USE: tuples.private - : 2curry ( obj1 obj2 quot -- curry ) curry curry ; inline diff --git a/core/listener/listener.factor b/core/listener/listener.factor index 16ee2705fe..bf262b77a2 100755 --- a/core/listener/listener.factor +++ b/core/listener/listener.factor @@ -3,7 +3,7 @@ USING: arrays hashtables io kernel math math.parser memory namespaces parser sequences strings io.styles io.streams.duplex vectors words generic system combinators -tuples continuations debugger definitions compiler.units ; +continuations debugger definitions compiler.units ; IN: listener SYMBOL: quit-flag diff --git a/core/mirrors/mirrors.factor b/core/mirrors/mirrors.factor index 3c5a0aa3c7..fde8728858 100755 --- a/core/mirrors/mirrors.factor +++ b/core/mirrors/mirrors.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs hashtables kernel sequences generic words -arrays classes slots slots.private tuples math vectors +arrays classes slots slots.private classes.tuple math vectors quotations sorting prettyprint ; IN: mirrors diff --git a/core/optimizer/known-words/known-words.factor b/core/optimizer/known-words/known-words.factor index b56f6fdb06..aef48452de 100755 --- a/core/optimizer/known-words/known-words.factor +++ b/core/optimizer/known-words/known-words.factor @@ -6,7 +6,7 @@ inference.class kernel assocs math math.private kernel.private sequences words parser vectors strings sbufs io namespaces assocs quotations sequences.private io.binary io.crc32 io.streams.string layouts splitting math.intervals -math.floats.private tuples tuples.private classes +math.floats.private classes.tuple classes.tuple.private classes classes.algebra optimizer.def-use optimizer.backend optimizer.pattern-match optimizer.inlining float-arrays sequences.private combinators ; diff --git a/core/optimizer/optimizer-tests.factor b/core/optimizer/optimizer-tests.factor index 89cea45aee..aa081e8e2c 100755 --- a/core/optimizer/optimizer-tests.factor +++ b/core/optimizer/optimizer-tests.factor @@ -2,7 +2,7 @@ USING: arrays compiler.units generic hashtables inference kernel kernel.private math optimizer prettyprint sequences sbufs strings tools.test vectors words sequences.private quotations optimizer.backend classes classes.algebra inference.dataflow -tuples.private continuations growable optimizer.inlining +classes.tuple.private continuations growable optimizer.inlining namespaces hints ; IN: optimizer.tests diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 670740fff0..a15da82718 100755 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -1,7 +1,8 @@ USING: arrays math parser tools.test kernel generic words io.streams.string namespaces classes effects source-files assocs sequences strings io.files definitions continuations -sorting tuples compiler.units debugger vocabs vocabs.loader ; +sorting classes.tuple compiler.units debugger vocabs +vocabs.loader ; IN: parser.tests [ diff --git a/core/prettyprint/backend/backend.factor b/core/prettyprint/backend/backend.factor index 5d7b967fc4..c9019b029d 100755 --- a/core/prettyprint/backend/backend.factor +++ b/core/prettyprint/backend/backend.factor @@ -4,7 +4,8 @@ USING: arrays byte-arrays byte-vectors bit-arrays bit-vectors generic hashtables io assocs kernel math namespaces sequences strings sbufs io.styles vectors words prettyprint.config prettyprint.sections quotations io io.files math.parser effects -tuples tuples.private classes float-arrays float-vectors ; +classes.tuple classes.tuple.private classes float-arrays +float-vectors ; IN: prettyprint.backend GENERIC: pprint* ( obj -- ) diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 675841816f..6c557d873d 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2003, 2007 Slava Pestov. +! Copyright (C) 2003, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: prettyprint USING: alien arrays generic generic.standard assocs io kernel math namespaces sequences strings io.styles io.streams.string vectors words prettyprint.backend prettyprint.sections prettyprint.config sorting splitting math.parser vocabs -definitions effects tuples io.files classes continuations +definitions effects classes.tuple io.files classes continuations hashtables classes.mixin classes.union classes.predicate combinators quotations ; diff --git a/core/refs/refs.factor b/core/refs/refs.factor index fb67db9332..c52c5daf9e 100644 --- a/core/refs/refs.factor +++ b/core/refs/refs.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2007 Slava Pestov +! Copyright (C) 2007, 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: tuples kernel assocs ; +USING: classes.tuple kernel assocs accessors ; IN: refs TUPLE: ref assoc key ; @@ -8,7 +8,7 @@ TUPLE: ref assoc key ; : ( assoc key class -- tuple ) >r ref construct-boa r> construct-delegate ; inline -: >ref< ( ref -- key assoc ) dup ref-key swap ref-assoc ; +: >ref< ( ref -- key assoc ) [ key>> ] [ assoc>> ] bi ; : delete-ref ( ref -- ) >ref< delete-at ; GENERIC: get-ref ( ref -- obj ) diff --git a/core/slots/slots-docs.factor b/core/slots/slots-docs.factor index 5de765313b..2b0d721f3e 100755 --- a/core/slots/slots-docs.factor +++ b/core/slots/slots-docs.factor @@ -1,6 +1,6 @@ USING: help.markup help.syntax generic kernel.private parser words kernel quotations namespaces sequences words arrays -effects generic.standard tuples slots.private classes +effects generic.standard classes.tuple slots.private classes strings math ; IN: slots diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 3874cecf71..bd349953df 100755 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -1,6 +1,6 @@ USING: generic help.syntax help.markup kernel math parser words -effects classes generic.standard tuples generic.math arrays -io.files vocabs.loader io sequences assocs ; +effects classes generic.standard classes.tuple generic.math +arrays io.files vocabs.loader io sequences assocs ; IN: syntax ARTICLE: "parser-algorithm" "Parser algorithm" diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 5da2d5e4e2..19fdf0e45f 100755 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -3,7 +3,7 @@ USING: alien arrays bit-arrays bit-vectors byte-arrays byte-vectors definitions generic hashtables kernel math namespaces parser sequences strings sbufs vectors words -quotations io assocs splitting tuples generic.standard +quotations io assocs splitting classes.tuple generic.standard generic.math classes io.files vocabs float-arrays float-vectors classes.union classes.mixin classes.predicate compiler.units combinators debugger ; diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index 85399ca9e7..fd3b616b87 100755 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -2,7 +2,7 @@ IN: vocabs.loader.tests USING: vocabs.loader tools.test continuations vocabs math kernel arrays sequences namespaces io.streams.string -parser source-files words assocs tuples definitions +parser source-files words assocs classes.tuple definitions debugger compiler.units tools.vocabs ; ! This vocab should not exist, but just in case... diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 4d9933147b..cef6b19943 100755 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -1,6 +1,7 @@ USING: arrays generic assocs kernel math namespaces sequences tools.test words definitions parser quotations -vocabs continuations tuples compiler.units io.streams.string ; +vocabs continuations classes.tuple compiler.units +io.streams.string ; IN: words.tests [ 4 ] [ diff --git a/extra/bake/bake.factor b/extra/bake/bake.factor index 19d89f67f0..987122f05c 100644 --- a/extra/bake/bake.factor +++ b/extra/bake/bake.factor @@ -1,6 +1,6 @@ USING: kernel parser namespaces quotations arrays vectors strings - sequences assocs tuples math combinators ; + sequences assocs classes.tuple math combinators ; IN: bake diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor index 6d7007c54a..0a808f53bd 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math math.functions namespaces sequences -strings tuples system vocabs.loader calendar.backend threads -accessors combinators locals ; +strings system vocabs.loader calendar.backend threads +accessors combinators locals classes.tuple ; IN: calendar TUPLE: timestamp year month day hour minute second gmt-offset ; diff --git a/extra/tuples/lib/authors.txt b/extra/classes/tuple/lib/authors.txt similarity index 100% rename from extra/tuples/lib/authors.txt rename to extra/classes/tuple/lib/authors.txt diff --git a/extra/tuples/lib/lib-docs.factor b/extra/classes/tuple/lib/lib-docs.factor similarity index 86% rename from extra/tuples/lib/lib-docs.factor rename to extra/classes/tuple/lib/lib-docs.factor index 75df1550f4..20431da07b 100644 --- a/extra/tuples/lib/lib-docs.factor +++ b/extra/classes/tuple/lib/lib-docs.factor @@ -1,11 +1,11 @@ USING: help.syntax help.markup kernel prettyprint sequences ; -IN: tuples.lib +IN: classes.tuple.lib HELP: >tuple< { $values { "class" "a tuple class" } } { $description "Explodes the tuple so that tuple slots are on the stack in the order listed in the tuple." } { $example - "USING: kernel prettyprint tuples.lib ;" + "USING: kernel prettyprint classes.tuple.lib ;" "TUPLE: foo a b c ;" "1 2 3 \\ foo construct-boa \\ foo >tuple< .s" "1\n2\n3" @@ -17,7 +17,7 @@ HELP: >tuple*< { $values { "class" "a tuple class" } } { $description "Explodes the tuple so that tuple slots ending with '*' are on the stack in the order listed in the tuple." } { $example - "USING: kernel prettyprint tuples.lib ;" + "USING: kernel prettyprint classes.tuple.lib ;" "TUPLE: foo a bb* ccc dddd* ;" "1 2 3 4 \\ foo construct-boa \\ foo >tuple*< .s" "2\n4" diff --git a/extra/tuples/lib/lib-tests.factor b/extra/classes/tuple/lib/lib-tests.factor similarity index 70% rename from extra/tuples/lib/lib-tests.factor rename to extra/classes/tuple/lib/lib-tests.factor index 5d90f25bd7..328f83d714 100644 --- a/extra/tuples/lib/lib-tests.factor +++ b/extra/classes/tuple/lib/lib-tests.factor @@ -1,5 +1,5 @@ -USING: kernel tools.test tuples.lib ; -IN: tuples.lib.tests +USING: kernel tools.test classes.tuple.lib ; +IN: classes.tuple.lib.tests TUPLE: foo a b* c d* e f* ; diff --git a/extra/tuples/lib/lib.factor b/extra/classes/tuple/lib/lib.factor similarity index 94% rename from extra/tuples/lib/lib.factor rename to extra/classes/tuple/lib/lib.factor index 4c007c8bb1..38104a45db 100755 --- a/extra/tuples/lib/lib.factor +++ b/extra/classes/tuple/lib/lib.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel macros sequences slots words mirrors ; -IN: tuples.lib +IN: classes.tuple.lib : reader-slots ( seq -- quot ) [ slot-spec-reader ] map [ get-slots ] curry ; diff --git a/extra/db/db.factor b/extra/db/db.factor index f9e946fc20..55e672ec80 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs classes continuations kernel math -namespaces sequences sequences.lib tuples words strings +namespaces sequences sequences.lib classes.tuple words strings tools.walker accessors ; IN: db diff --git a/extra/db/sql/sql.factor b/extra/db/sql/sql.factor index 1de4bdfb5a..99dde99280 100755 --- a/extra/db/sql/sql.factor +++ b/extra/db/sql/sql.factor @@ -1,4 +1,4 @@ -USING: kernel parser quotations tuples words +USING: kernel parser quotations classes.tuple words namespaces.lib namespaces sequences arrays combinators prettyprint strings math.parser sequences.lib math symbols ; USE: tools.walker diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index c81448865f..9b3185bcf2 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien arrays assocs classes compiler db hashtables io.files kernel math math.parser namespaces -prettyprint sequences strings tuples alien.c-types +prettyprint sequences strings classes.tuple alien.c-types continuations db.sqlite.lib db.sqlite.ffi db.tuples words combinators.lib db.types combinators io namespaces.lib ; diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 00e8ed8b76..7fc059c9b3 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs classes db kernel namespaces -tuples words sequences slots math +classes.tuple words sequences slots math math.parser io prettyprint db.types continuations mirrors sequences.lib tools.walker combinators.lib ; IN: db.tuples diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index 94a8d6f392..3c73a933e9 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -3,7 +3,7 @@ USING: arrays assocs db kernel math math.parser sequences continuations sequences.deep sequences.lib words namespaces tools.walker slots slots.private classes -mirrors tuples combinators calendar.format symbols +mirrors classes.tuple combinators calendar.format symbols singleton ; IN: db.types diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index bfbfe1b6ca..85d58e7572 100755 --- a/extra/editors/editors.factor +++ b/extra/editors/editors.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: parser kernel namespaces sequences definitions io.files -inspector continuations tuples tools.crossref tools.vocabs +inspector continuations tools.crossref tools.vocabs io prettyprint source-files assocs vocabs vocabs.loader -io.backend splitting ; +io.backend splitting classes.tuple ; IN: editors TUPLE: no-edit-hook ; diff --git a/extra/help/help.factor b/extra/help/help.factor index 9e4d02802b..4e8424f7a3 100755 --- a/extra/help/help.factor +++ b/extra/help/help.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays io kernel namespaces parser prettyprint sequences words assocs definitions generic quotations effects slots -continuations tuples debugger combinators vocabs help.stylesheet -help.topics help.crossref help.markup sorting classes -vocabs.loader ; +continuations classes.tuple debugger combinators vocabs +help.stylesheet help.topics help.crossref help.markup sorting +classes vocabs.loader ; IN: help GENERIC: word-help* ( word -- content ) diff --git a/extra/http/server/components/components.factor b/extra/http/server/components/components.factor index 828ff8e562..bd95bf4407 100755 --- a/extra/http/server/components/components.factor +++ b/extra/http/server/components/components.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: html.elements http.server.validators accessors -namespaces kernel io math.parser assocs classes words tuples -arrays sequences io.files http.server.templating.fhtml -http.server.actions splitting mirrors hashtables -fry continuations math ; +USING: html.elements http.server.validators accessors namespaces +kernel io math.parser assocs classes words classes.tuple arrays +sequences io.files http.server.templating.fhtml +http.server.actions splitting mirrors hashtables fry +continuations math ; IN: http.server.components SYMBOL: components diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 308bf36bf4..36b2e90778 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -1,7 +1,8 @@ USING: kernel words inspector slots quotations sequences assocs math arrays inference effects shuffle continuations debugger -tuples namespaces vectors bit-arrays byte-arrays strings sbufs -math.functions macros sequences.private combinators mirrors ; +classes.tuple namespaces vectors bit-arrays byte-arrays strings +sbufs math.functions macros sequences.private combinators +mirrors ; IN: inverse TUPLE: fail ; diff --git a/extra/io/encodings/8-bit/8-bit.factor b/extra/io/encodings/8-bit/8-bit.factor index d2348fd4b0..259173fec4 100755 --- a/extra/io/encodings/8-bit/8-bit.factor +++ b/extra/io/encodings/8-bit/8-bit.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. USING: math.parser arrays io.encodings sequences kernel assocs -hashtables io.encodings.ascii generic parser tuples words io -io.files splitting namespaces math compiler.units accessors ; +hashtables io.encodings.ascii generic parser classes.tuple words +io io.files splitting namespaces math compiler.units accessors ; IN: io.encodings.8-bit [ gadget? ] is? diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor index 7966f4e206..99bd1be876 100755 --- a/extra/ui/gadgets/scrollers/scrollers.factor +++ b/extra/ui/gadgets/scrollers/scrollers.factor @@ -4,7 +4,7 @@ USING: arrays ui.gadgets ui.gadgets.viewports ui.gadgets.frames ui.gadgets.grids ui.gadgets.theme ui.gadgets.sliders ui.gestures kernel math namespaces sequences models combinators math.vectors -tuples ; +classes.tuple ; IN: ui.gadgets.scrollers TUPLE: scroller viewport x y follows ; diff --git a/extra/ui/gadgets/tracks/tracks-docs.factor b/extra/ui/gadgets/tracks/tracks-docs.factor index 967e8a29a1..f10996135d 100755 --- a/extra/ui/gadgets/tracks/tracks-docs.factor +++ b/extra/ui/gadgets/tracks/tracks-docs.factor @@ -1,5 +1,5 @@ USING: ui.gadgets.packs help.markup help.syntax ui.gadgets -arrays kernel quotations tuples ; +arrays kernel quotations classes.tuple ; IN: ui.gadgets.tracks HELP: track diff --git a/extra/ui/gestures/gestures.factor b/extra/ui/gestures/gestures.factor index 574b71c44d..412a61bcb5 100755 --- a/extra/ui/gestures/gestures.factor +++ b/extra/ui/gestures/gestures.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs kernel math models namespaces sequences words strings system hashtables math.parser -math.vectors tuples classes ui.gadgets combinators.lib boxes +math.vectors classes.tuple classes ui.gadgets combinators.lib +boxes calendar alarms symbols ; IN: ui.gestures diff --git a/extra/ui/tools/interactor/interactor.factor b/extra/ui/tools/interactor/interactor.factor index 9e43460aa9..06fc3c87a0 100755 --- a/extra/ui/tools/interactor/interactor.factor +++ b/extra/ui/tools/interactor/interactor.factor @@ -4,7 +4,7 @@ USING: arrays assocs combinators continuations documents hashtables io io.styles kernel math math.vectors models namespaces parser prettyprint quotations sequences sequences.lib strings threads listener -tuples ui.commands ui.gadgets ui.gadgets.editors +classes.tuple ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds ui.gestures definitions boxes calendar concurrency.flags ui.tools.workspace ; IN: ui.tools.interactor diff --git a/extra/ui/tools/search/search.factor b/extra/ui/tools/search/search.factor index 45ac645392..23697bbf3f 100755 --- a/extra/ui/tools/search/search.factor +++ b/extra/ui/tools/search/search.factor @@ -4,7 +4,7 @@ USING: assocs ui.tools.interactor ui.tools.listener ui.tools.workspace help help.topics io.files io.styles kernel models namespaces prettyprint quotations sequences sorting source-files definitions strings tools.completion tools.crossref -tuples ui.commands ui.gadgets ui.gadgets.editors +classes.tuple ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.operations vocabs words vocabs.loader tools.vocabs unicode.case calendar ui ; diff --git a/extra/ui/x11/x11.factor b/extra/ui/x11/x11.factor index 158a48a1c0..eaf87acace 100755 --- a/extra/ui/x11/x11.factor +++ b/extra/ui/x11/x11.factor @@ -5,7 +5,7 @@ ui.backend ui.clipboards ui.gadgets.worlds assocs kernel math namespaces opengl sequences strings x11.xlib x11.events x11.xim x11.glx x11.clipboard x11.constants x11.windows io.encodings.string io.encodings.utf8 combinators debugger system command-line -ui.render math.vectors tuples opengl.gl threads ; +ui.render math.vectors classes.tuple opengl.gl threads ; IN: ui.x11 TUPLE: x11-ui-backend ; From 9e13e61a74c150eff97c4da1ed0c9cbc3d924c3d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 04:07:06 -0500 Subject: [PATCH 162/219] Fix some load errors --- extra/bunny/model/model.factor | 23 +++++++++++++---------- extra/bunny/outlined/outlined.factor | 2 +- extra/combinators/cleave/cleave.factor | 2 +- extra/opengl/shaders/shaders.factor | 4 ++-- 4 files changed, 17 insertions(+), 14 deletions(-) diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index 79a8a00856..2cb0df5ca1 100755 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -64,16 +64,19 @@ TUPLE: bunny-buffers array element-array nv ni ; bunny-dlist construct-boa ; : ( model -- geom ) - [ - [ first concat ] [ second concat ] bi - append >float-array - GL_ARRAY_BUFFER swap GL_STATIC_DRAW - ] [ - third concat >c-uint-array - GL_ELEMENT_ARRAY_BUFFER swap GL_STATIC_DRAW - ] - [ first length 3 * ] [ third length 3 * ] tetra - bunny-buffers construct-boa ; + { + [ + [ first concat ] [ second concat ] bi + append >float-array + GL_ARRAY_BUFFER swap GL_STATIC_DRAW + ] + [ + third concat >c-uint-array + GL_ELEMENT_ARRAY_BUFFER swap GL_STATIC_DRAW + ] + [ first length 3 * ] + [ third length 3 * ] + } cleave bunny-buffers construct-boa ; GENERIC: bunny-geom ( geom -- ) GENERIC: draw-bunny ( geom draw -- ) diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor index 7cdfba7c79..6a2f54cceb 100755 --- a/extra/bunny/outlined/outlined.factor +++ b/extra/bunny/outlined/outlined.factor @@ -1,6 +1,6 @@ USING: arrays bunny.model bunny.cel-shaded continuations kernel math multiline opengl opengl.shaders opengl.framebuffers -opengl.gl opengl.capabilities sequences ui.gadgets ; +opengl.gl opengl.capabilities sequences ui.gadgets combinators ; IN: bunny.outlined STRING: outlined-pass1-fragment-shader-main-source diff --git a/extra/combinators/cleave/cleave.factor b/extra/combinators/cleave/cleave.factor index 9ce7a1f553..d99fe7e1d2 100644 --- a/extra/combinators/cleave/cleave.factor +++ b/extra/combinators/cleave/cleave.factor @@ -1,5 +1,5 @@ -USING: kernel sequences macros ; +USING: kernel sequences macros combinators ; IN: combinators.cleave diff --git a/extra/opengl/shaders/shaders.factor b/extra/opengl/shaders/shaders.factor index 4ed43d393b..e352eabc10 100755 --- a/extra/opengl/shaders/shaders.factor +++ b/extra/opengl/shaders/shaders.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: kernel opengl.gl alien.c-types continuations namespaces -assocs alien libc opengl math sequences combinators.lib -macros arrays ; +assocs alien libc opengl math sequences combinators +combinators.lib macros arrays ; IN: opengl.shaders : with-gl-shader-source-ptr ( string quot -- ) From 47c91e379ea25f30d1b8261f0be5979d6ad0aa7e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 05:03:04 -0500 Subject: [PATCH 163/219] Fix predicate clobberage --- core/classes/tuple/tuple-tests.factor | 13 +++++++++++++ core/classes/tuple/tuple.factor | 5 ++--- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 2e37655f1d..9b8228155b 100755 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -340,6 +340,19 @@ TUPLE: electronic-device ; [ f ] [ "laptop" get electronic-device? ] unit-test [ t ] [ "laptop" get computer? ] unit-test +! Redefinition problem +TUPLE: redefinition-problem ; + +UNION: redefinition-problem' redefinition-problem integer ; + +[ t ] [ 3 redefinition-problem'? ] unit-test + +TUPLE: redefinition-problem-2 ; + +"IN: classes.tuple.tests TUPLE: redefinition-problem < redefinition-problem-2 ;" eval + +[ t ] [ 3 redefinition-problem'? ] unit-test + ! Hardcore unit tests USE: threads diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 28dbfdb372..a452d0eeec 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -140,12 +140,11 @@ PRIVATE> [ drop f tuple-class define-class ] [ nip define-tuple-slots ] [ 2drop - class-usages [ - drop + class-usages keys [ tuple-class? ] subset [ [ define-tuple-layout ] [ define-tuple-predicate ] bi - ] assoc-each + ] each ] 3tri ; : redefine-tuple-class ( class superclass slots -- ) From 189a9323cddd7bfb26c294710b1a8efd0731762b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 05:03:17 -0500 Subject: [PATCH 164/219] Fix tree shaker issue --- core/parser/parser-docs.factor | 8 +++++--- core/parser/parser.factor | 6 +++--- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 4d200c17d2..cc4e2c0a42 100755 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -333,12 +333,14 @@ HELP: CREATE { $errors "Throws an error if the end of the line is reached." } $parsing-note ; -HELP: no-word -{ $values { "name" string } { "newword" word } } -{ $description "Throws a " { $link no-word } " error." } +HELP: no-word-error { $error-description "Thrown if the parser encounters a token which does not name a word in the current vocabulary search path. If any words with this name exist in vocabularies not part of the search path, a number of restarts will offer to add those vocabularies to the search path and use the chosen word." } { $notes "Apart from a missing " { $link POSTPONE: USE: } ", this error can also indicate an ordering issue. In Factor, words must be defined before they can be called. Mutual recursion can be implemented via " { $link POSTPONE: DEFER: } "." } ; +HELP: no-word +{ $values { "name" string } { "newword" word } } +{ $description "Throws a " { $link no-word-error } "." } ; + HELP: search { $values { "str" string } { "word/f" "a word or " { $link f } } } { $description "Searches for a word by name in the current vocabulary search path. If no such word could be found, outputs " { $link f } "." } diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 6bae4e95b4..6e5023f74a 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -252,13 +252,13 @@ PREDICATE: unexpected-eof < unexpected [ "Use the word " swap summary append ] keep ] { } map>assoc ; -TUPLE: no-word name ; +ERROR: no-word-error name ; -M: no-word summary +M: no-word-error summary drop "Word not found in current vocabulary search path" ; : no-word ( name -- newword ) - dup \ no-word construct-boa + dup no-word-error construct-boa swap words-named [ forward-reference? not ] subset word-restarts throw-restarts dup word-vocabulary (use+) ; From 01fd99fd71637eacc7082e5b1937d917fdd62a29 Mon Sep 17 00:00:00 2001 From: slava Date: Sat, 29 Mar 2008 05:30:25 -0500 Subject: [PATCH 165/219] Starting work on Solaris port --- vm/os-solaris-x86.32.h | 10 ++++++++++ vm/os-solaris-x86.64.h | 10 ++++++++++ vm/os-solaris.h | 2 ++ vm/platform.h | 10 +++++++++- 4 files changed, 31 insertions(+), 1 deletion(-) create mode 100644 vm/os-solaris-x86.32.h create mode 100644 vm/os-solaris-x86.64.h diff --git a/vm/os-solaris-x86.32.h b/vm/os-solaris-x86.32.h new file mode 100644 index 0000000000..1f4ec74e17 --- /dev/null +++ b/vm/os-solaris-x86.32.h @@ -0,0 +1,10 @@ +#include + +INLINE void *ucontext_stack_pointer(void *uap) +{ + ucontext_t *ucontext = (ucontext_t *)uap; + return (void *)ucontext->uc_mcontext.gregs[ESP]; +} + +#define UAP_PROGRAM_COUNTER(ucontext) \ + (((ucontext_t *)(ucontext))->uc_mcontext.gregs[EIP]) diff --git a/vm/os-solaris-x86.64.h b/vm/os-solaris-x86.64.h new file mode 100644 index 0000000000..54d1866d50 --- /dev/null +++ b/vm/os-solaris-x86.64.h @@ -0,0 +1,10 @@ +#include + +INLINE void *ucontext_stack_pointer(void *uap) +{ + ucontext_t *ucontext = (ucontext_t *)uap; + return (void *)ucontext->uc_mcontext.gregs[RSP]; +} + +#define UAP_PROGRAM_COUNTER(ucontext) \ + (((ucontext_t *)(ucontext))->uc_mcontext.gregs[RIP]) diff --git a/vm/os-solaris.h b/vm/os-solaris.h index 788a78090b..909cc3f4e9 100644 --- a/vm/os-solaris.h +++ b/vm/os-solaris.h @@ -1,2 +1,4 @@ #define UNKNOWN_TYPE_P(file) 1 #define DIRECTORY_P(file) 0 + +extern char **environ; diff --git a/vm/platform.h b/vm/platform.h index 7678d483d6..a8c8ba756f 100644 --- a/vm/platform.h +++ b/vm/platform.h @@ -95,8 +95,16 @@ #endif #elif defined(__SVR4) && defined(sun) #define FACTOR_OS_STRING "solaris" + + #if defined(FACTOR_X86) + #include "os-solaris-x86.32.h" + #elif defined(FACTOR_AMD64) + #incluide "os-solaris-x86.64.h" + #else + #error "Unsupported Solaris flavor" + #endif + #include "os-solaris.h" - #include "os-unix-ucontext.h" #else #error "Unsupported OS" #endif From cee0eb5be35153212da887ab09e903b9400b3101 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 29 Mar 2008 14:25:57 -0500 Subject: [PATCH 166/219] fix secure-random-generator for windows --- extra/random/windows/windows.factor | 57 ++++++++++++++++++-------- extra/windows/advapi32/advapi32.factor | 34 +++++++++++++++ 2 files changed, 74 insertions(+), 17 deletions(-) diff --git a/extra/random/windows/windows.factor b/extra/random/windows/windows.factor index e0c564bc2c..cd69105e65 100644 --- a/extra/random/windows/windows.factor +++ b/extra/random/windows/windows.factor @@ -1,31 +1,54 @@ USING: accessors alien.c-types byte-arrays continuations -kernel windows windows.advapi32 init namespaces random ; +kernel windows windows.advapi32 init namespaces random +destructors locals ; +USE: tools.walker IN: random.windows -TUPLE: windows-crypto-context handle ; +TUPLE: windows-rng provider type ; +C: windows-rng +TUPLE: windows-crypto-context handle ; C: windows-crypto-context M: windows-crypto-context dispose ( tuple -- ) handle>> 0 CryptReleaseContext win32-error=0/f ; -TUPLE: windows-cryptographic-rng context ; +: factor-crypto-container ( -- string ) "FactorCryptoContainer" ; inline -C: windows-cryptographic-rng +:: (acquire-crypto-context) ( provider type flags -- handle ) + [let | handle [ "HCRYPTPROV" ] | + handle + factor-crypto-container + provider + type + flags + CryptAcquireContextW win32-error=0/f + handle *void* ] ; -M: windows-cryptographic-rng dispose ( tuple -- ) - context>> dispose ; +: acquire-crypto-context ( provider type -- handle ) + [ 0 (acquire-crypto-context) ] + [ drop CRYPT_NEWKEYSET (acquire-crypto-context) ] recover ; -M: windows-cryptographic-rng random-bytes* ( tuple n -- bytes ) - >r context>> r> dup - [ CryptGenRandom win32-error=0/f ] keep ; -: windows-aes-context ( -- context ) - "HCRYPTPROV" - dup f f PROV_RSA_AES CRYPT_NEWKEYSET - CryptAcquireContextW win32-error=0/f *void* - ; +: windows-crypto-context ( provider type -- context ) + acquire-crypto-context ; -! [ - ! windows-aes-context secure-random-generator set-global -! ] "random.windows" add-init-hook +M: windows-rng random-bytes* ( n tuple -- bytes ) + [ + [ provider>> ] [ type>> ] bi + windows-crypto-context + dup add-always-destructor handle>> + swap dup + [ CryptGenRandom win32-error=0/f ] keep + ] with-destructors ; + +[ + MS_DEF_PROV + PROV_RSA_FULL insecure-random-generator set-global + + ! MS_STRONG_PROV + ! PROV_RSA_FULL secure-random-generator set-global + + MS_ENH_RSA_AES_PROV + PROV_RSA_AES secure-random-generator set-global +] "random.windows" add-init-hook diff --git a/extra/windows/advapi32/advapi32.factor b/extra/windows/advapi32/advapi32.factor index 0be82551a1..28091d3d9d 100644 --- a/extra/windows/advapi32/advapi32.factor +++ b/extra/windows/advapi32/advapi32.factor @@ -21,6 +21,40 @@ LIBRARY: advapi32 : PROV_REPLACE_OWF 23 ; inline : PROV_RSA_AES 24 ; inline +: MS_DEF_DH_SCHANNEL_PROV + "Microsoft DH Schannel Cryptographic Provider" ; inline + +: MS_DEF_DSS_DH_PROV + "Microsoft Base DSS and Diffie-Hellman Cryptographic Provider" ; inline + +: MS_DEF_DSS_PROV + "Microsoft Base DSS Cryptographic Provider" ; inline + +: MS_DEF_PROV + "Microsoft Base Cryptographic Provider v1.0" ; inline + +: MS_DEF_RSA_SCHANNEL_PROV + "Microsoft RSA Schannel Cryptographic Provider" ; inline + +! Unsupported (!) +: MS_DEF_RSA_SIG_PROV + "Microsoft RSA Signature Cryptographic Provider" ; inline + +: MS_ENH_DSS_DH_PROV + "Microsoft Enhanced DSS and Diffie-Hellman Cryptographic Provider" ; inline + +: MS_ENH_RSA_AES_PROV + "Microsoft Enhanced RSA and AES Cryptographic Provider" ; inline + +: MS_ENHANCED_PROV + "Microsoft Enhanced Cryptographic Provider v1.0" ; inline + +: MS_SCARD_PROV + "Microsoft Base Smart Card Crypto Provider" ; inline + +: MS_STRONG_PROV + "Microsoft Strong Cryptographic Provider" ; inline + : CRYPT_VERIFYCONTEXT HEX: F0000000 ; inline : CRYPT_NEWKEYSET HEX: 8 ; inline : CRYPT_DELETEKEYSET HEX: 10 ; inline From a15159af6944c1a341b581b81592cd997b2aac3b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 29 Mar 2008 14:50:52 -0500 Subject: [PATCH 167/219] add summary on error --- extra/random/random.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/extra/random/random.factor b/extra/random/random.factor index c1701b1c0f..1168a4dd45 100755 --- a/extra/random/random.factor +++ b/extra/random/random.factor @@ -19,6 +19,9 @@ M: object random-32* ( tuple -- r ) 4 random-bytes* le> ; ERROR: no-random-number-generator ; +M: no-random-number-generator summary + drop "Random number generator is not defined." ; + M: f random-bytes* ( n obj -- * ) no-random-number-generator ; M: f random-32* ( obj -- * ) no-random-number-generator ; From 72cedcaf477c3aa119bbf2cf8cceb5cd5c31d66f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 29 Mar 2008 14:51:50 -0500 Subject: [PATCH 168/219] add using --- extra/random/random.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/random/random.factor b/extra/random/random.factor index 1168a4dd45..b1c57ede60 100755 --- a/extra/random/random.factor +++ b/extra/random/random.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel math namespaces sequences -io.backend io.binary combinators system vocabs.loader ; +io.backend io.binary combinators system vocabs.loader +inspector ; IN: random SYMBOL: insecure-random-generator From fbdf62bb1cf45809ed64061220c7aa9569cc64d9 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 29 Mar 2008 16:18:46 -0400 Subject: [PATCH 169/219] Making [ mpg ] undo work --- extra/inverse/inverse.factor | 55 +++++++++++++++++++--------------- extra/units/units-tests.factor | 4 +-- extra/units/units.factor | 6 ++++ 3 files changed, 38 insertions(+), 27 deletions(-) diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index 308bf36bf4..f4bd403b75 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -1,7 +1,8 @@ USING: kernel words inspector slots quotations sequences assocs math arrays inference effects shuffle continuations debugger tuples namespaces vectors bit-arrays byte-arrays strings sbufs -math.functions macros sequences.private combinators mirrors ; +math.functions macros sequences.private combinators mirrors +combinators.lib ; IN: inverse TUPLE: fail ; @@ -59,38 +60,44 @@ PREDICATE: math-inverse < word "math-inverse" word-prop ; PREDICATE: pop-inverse < word "pop-length" word-prop ; UNION: explicit-inverse normal-inverse math-inverse pop-inverse ; -: inline-word ( word -- ) - { - { [ dup word? not over symbol? or ] [ , ] } - { [ dup explicit-inverse? ] [ , ] } - ! { [ dup compound? over { if dispatch } member? not and ] - ! [ word-def [ inline-word ] each ] } - { [ dup word? over { if dispatch } member? not and ] - [ word-def [ inline-word ] each ] } - { [ drop t ] [ "Quotation is not invertible" throw ] } - } cond ; +: enough? ( stack quot -- ? ) + [ >r length r> 1quotation infer effect-in >= ] [ 3drop f ] + recover ; -: math-exp? ( n n word -- ? ) - { + - * / ^ } member? -rot [ number? ] both? and ; +: fold-word ( stack quot -- stack ) + 2dup enough? + [ 1quotation with-datastack ] [ >r % r> , { } ] if ; -: (fold-constants) ( quot -- ) - dup length 3 < [ % ] [ - dup first3 3dup math-exp? - [ execute , 3 ] [ 2drop , 1 ] if - tail-slice (fold-constants) - ] if ; +: fold ( quot -- folded-quot ) + [ { } swap [ fold-word ] each % ] [ ] make ; -: fold-constants ( quot -- folded ) - [ (fold-constants) ] [ ] make ; +: flattenable? ( object -- ? ) + [ [ word? ] [ primitive? not ] and? ] [ + { "inverse" "math-inverse" "pop-inverse" } + [ word-prop ] with contains? not + ] and? ; -: do-inlining ( quot -- inlined-quot ) - [ [ inline-word ] each ] [ ] make fold-constants ; +: (flatten) ( quot -- ) + [ dup flattenable? [ word-def (flatten) ] [ , ] if ] each ; + + : retain-stack-overflow? ( error -- ? ) + { "kernel-error" 14 f f } = ; + +: flatten ( quot -- expanded ) + [ [ (flatten) ] [ ] make ] [ + dup retain-stack-overflow? + [ drop "No inverse defined on recursive word" ] when + throw + ] recover ; GENERIC: inverse ( revquot word -- revquot* quot ) M: object inverse undo-literal ; + M: symbol inverse undo-literal ; +M: word inverse drop "Inverse is undefined" throw ; + M: normal-inverse inverse "inverse" word-prop ; @@ -108,7 +115,7 @@ M: pop-inverse inverse [ unclip-slice inverse % (undo) ] if ; : [undo] ( quot -- undo ) - do-inlining reverse [ (undo) ] [ ] make ; + flatten fold reverse [ (undo) ] [ ] make ; MACRO: undo ( quot -- ) [undo] ; diff --git a/extra/units/units-tests.factor b/extra/units/units-tests.factor index 9f0e704157..9b450ed18b 100755 --- a/extra/units/units-tests.factor +++ b/extra/units/units-tests.factor @@ -15,9 +15,7 @@ IN: units.tests [ t ] [ 1 m 2 m 3 m 3array d-product 6 m^3 = ] unit-test [ t ] [ 3 m d-recip 1/3 { } { m } = ] unit-test -! I want these to work, Dan - : km/L km 1 L d/ ; : mpg miles 1 gallons d/ ; -! [ t ] [ 100 10 / km/L [ mpg ] undo 23 1 ~ ] unit-test +[ t ] [ 100 10 / km/L [ mpg ] undo 23 1 ~ ] unit-test diff --git a/extra/units/units.factor b/extra/units/units.factor index 13d0a5d1cf..b92cbb659a 100755 --- a/extra/units/units.factor +++ b/extra/units/units.factor @@ -95,3 +95,9 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ; : d-infimum ( v -- d ) unclip-slice [ d-min ] reduce ; : d-supremum ( v -- d ) unclip-slice [ d-max ] reduce ; + +\ d+ [ d- ] [ d- ] define-math-inverse +\ d- [ d+ ] [ d- ] define-math-inverse +\ d* [ d/ ] [ d/ ] define-math-inverse +\ d/ [ d* ] [ d/ ] define-math-inverse +\ d-recip [ d-recip ] define-inverse From 606445f790e290fae775a00c4f5ccb257a713a0b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 29 Mar 2008 15:31:31 -0500 Subject: [PATCH 170/219] improve png --- extra/cairo/ffi/ffi.factor | 3 +++ extra/cairo/png/png.factor | 27 ++++++++++++++++++++++++--- 2 files changed, 27 insertions(+), 3 deletions(-) diff --git a/extra/cairo/ffi/ffi.factor b/extra/cairo/ffi/ffi.factor index 76ce27975b..c319ade93b 100644 --- a/extra/cairo/ffi/ffi.factor +++ b/extra/cairo/ffi/ffi.factor @@ -203,6 +203,9 @@ C-ENUM: CAIRO_HINT_METRICS_ON ; +FUNCTION: char* cairo_status_to_string ( cairo_status_t status ) ; +FUNCTION: cairo_status_t cairo_status ( cairo_t* cr ) ; + : cairo_create ( cairo_surface_t -- cairo_t ) "cairo_t*" "cairo" "cairo_create" [ "void*" ] alien-invoke ; diff --git a/extra/cairo/png/png.factor b/extra/cairo/png/png.factor index eaab28e659..774a1afe8e 100755 --- a/extra/cairo/png/png.factor +++ b/extra/cairo/png/png.factor @@ -1,16 +1,34 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel accessors math ui.gadgets ui.render -opengl.gl byte-arrays namespaces opengl cairo.ffi cairo.lib ; +opengl.gl byte-arrays namespaces opengl cairo.ffi cairo.lib +inspector sequences combinators io.backend ; IN: cairo.png TUPLE: png surface width height cairo-t array ; TUPLE: png-gadget png ; +ERROR: cairo-error string ; + +: check-zero + dup zero? [ + "PNG dimension is 0" cairo-error + ] when ; + +: cairo-png-error ( n -- ) + { + { [ dup CAIRO_STATUS_NO_MEMORY = ] [ "Cairo: no memory" cairo-error ] } + { [ dup CAIRO_STATUS_FILE_NOT_FOUND = ] [ "Cairo: file not found" cairo-error ] } + { [ dup CAIRO_STATUS_READ_ERROR = ] [ "Cairo: read error" cairo-error ] } + { [ t ] [ drop ] } + } cond ; + : ( path -- png ) + normalize-pathname cairo_image_surface_create_from_png - dup [ cairo_image_surface_get_width ] - [ cairo_image_surface_get_height ] [ ] tri + dup cairo_surface_status cairo-png-error + dup [ cairo_image_surface_get_width check-zero ] + [ cairo_image_surface_get_height check-zero ] [ ] tri cairo-surface>array png construct-boa ; : write-png ( png path -- ) @@ -33,6 +51,7 @@ M: png-gadget draw-gadget* ( gadget -- ) png>> [ width>> ] [ height>> GL_RGBA GL_UNSIGNED_BYTE ] + ! [ height>> GL_BGRA GL_UNSIGNED_BYTE ] [ array>> ] tri glDrawPixels ] with-translation ; @@ -42,3 +61,5 @@ M: png-gadget graft* ( gadget -- ) M: png-gadget ungraft* ( gadget -- ) png>> surface>> cairo_destroy ; + +! "resource:misc/icons/Factor_1x16.png" USE: cairo.png gadget. From 7174e8cbc4e51dddfc6b258d80e4681428952462 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 15:50:50 -0500 Subject: [PATCH 171/219] Fixing unit test failures --- core/parser/parser-tests.factor | 4 ++-- core/parser/parser.factor | 2 +- core/vocabs/loader/loader-tests.factor | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index a15da82718..6bd4abb7e1 100755 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -322,7 +322,7 @@ IN: parser.tests [ "IN: parser.tests \\ class-fwd-test" "redefining-a-class-3" parse-stream drop - ] [ [ no-word? ] is? ] must-fail-with + ] [ [ no-word-error? ] is? ] must-fail-with [ ] [ "IN: parser.tests TUPLE: class-fwd-test ; SYMBOL: class-fwd-test" @@ -332,7 +332,7 @@ IN: parser.tests [ "IN: parser.tests \\ class-fwd-test" "redefining-a-class-3" parse-stream drop - ] [ [ no-word? ] is? ] must-fail-with + ] [ [ no-word-error? ] is? ] must-fail-with [ "IN: parser.tests : foo ; TUPLE: foo ;" diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 6e5023f74a..f8836217b5 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -252,7 +252,7 @@ PREDICATE: unexpected-eof < unexpected [ "Use the word " swap summary append ] keep ] { } map>assoc ; -ERROR: no-word-error name ; +TUPLE: no-word-error name ; M: no-word-error summary drop "Word not found in current vocabulary search path" ; diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index fd3b616b87..4b978932bc 100755 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -68,7 +68,7 @@ IN: vocabs.loader.tests "resource:core/vocabs/loader/test/a/a.factor" parse-stream -] [ [ no-word? ] is? ] must-fail-with +] [ [ no-word-error? ] is? ] must-fail-with 0 "count-me" set-global From 0e6f753b2f17bc677a3c6329a0741a623298d818 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 16:04:46 -0500 Subject: [PATCH 172/219] Fix help --- core/classes/tuple/tuple-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor index a747008fa2..7123d5c7c8 100755 --- a/core/classes/tuple/tuple-docs.factor +++ b/core/classes/tuple/tuple-docs.factor @@ -162,7 +162,7 @@ HELP: reshape-tuple { $description "Permutes the slots of a tuple. If a tuple class is redefined at runtime, this word is called on every instance to change its shape to conform to the new layout." } ; HELP: reshape-tuples -{ $values { "class" tuple-class } { "newslots" "a sequence of strings" } } +{ $values { "class" tuple-class } { "superclass" class } { "newslots" "a sequence of strings" } } { $description "Changes the shape of every instance of " { $snippet "class" } " for a new slot layout." } ; HELP: removed-slots @@ -170,7 +170,7 @@ HELP: removed-slots { $description "Outputs the sequence of existing tuple slot names not in " { $snippet "newslots" } "." } ; HELP: forget-slots -{ $values { "class" tuple-class } { "newslots" "a sequence of strings" } } +{ $values { "class" tuple-class } { "slots" "a sequence of strings" } } { $description "Forgets accessor words for existing tuple slots which are not in " { $snippet "newslots" } "." } ; HELP: tuple From 8ea195d8ce8693e1b892c65fa1864272a472caa3 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sat, 29 Mar 2008 16:08:08 -0600 Subject: [PATCH 173/219] hashtables: use cleavers in hashtables --- core/hashtables/hashtables.factor | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index 7d8c6f0b5f..1fabc1aab7 100755 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -95,11 +95,12 @@ IN: hashtables [ swap pick (set-hash) drop f ] find-pair 2drop 2drop ; : hash-large? ( hash -- ? ) - dup hash-count 3 fixnum*fast - swap hash-array array-capacity > ; + [ hash-count 3 fixnum*fast ] + [ hash-array array-capacity ] bi > ; : hash-stale? ( hash -- ? ) - dup hash-deleted 10 fixnum*fast swap hash-count fixnum> ; + [ hash-deleted 10 fixnum*fast ] + [ hash-count ] bi fixnum> ; : grow-hash ( hash -- ) [ dup hash-array swap assoc-size 1+ ] keep @@ -183,10 +184,13 @@ M: hashtable assoc-like [ 3drop ] [ dupd dupd set-at swap push ] if ; inline : prune ( seq -- newseq ) - dup length over length - rot [ >r 2dup r> (prune) ] each nip ; + [ length ] + [ length ] + [ ] tri + [ >r 2dup r> (prune) ] each nip ; : all-unique? ( seq -- ? ) - dup prune [ length ] 2apply = ; + [ length ] + [ prune length ] bi = ; INSTANCE: hashtable assoc From 691d26068d850b4331ad0d7a028f076cf3242989 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sun, 30 Mar 2008 14:00:45 +1300 Subject: [PATCH 174/219] Refactor peg compiler cache Instead of a cache stored in a global variable, the compiled parser is stored in a slot in the parser delegate. --- extra/peg/peg-docs.factor | 7 ------- extra/peg/peg.factor | 28 ++++++++++------------------ 2 files changed, 10 insertions(+), 25 deletions(-) diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor index 7b13e06d5a..e7bd255569 100644 --- a/extra/peg/peg-docs.factor +++ b/extra/peg/peg-docs.factor @@ -21,16 +21,9 @@ HELP: compile } { $description "Compile the parser to a word. The word will have stack effect ( -- result )." - "The mapping from parser to compiled word is kept in a cache. If you later change " - "the definition of a parser you'll need to clear this cache with " - { $link reset-compiled-parsers } " before using " { $link compile } " on that parser again." } { $see-also parse } ; -HELP: reset-compiled-parsers -{ $description - "Reset the cache mapping parsers to compiled words." } ; - HELP: token { $values { "string" "a string" } diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index c9de46aa86..247a64eac2 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -10,6 +10,10 @@ USE: prettyprint TUPLE: parse-result remaining ast ; +TUPLE: parser id compiled ; +M: parser equal? [ id>> ] 2apply = ; +C: parser + SYMBOL: ignore : ( remaining ast -- parse-result ) @@ -194,14 +198,6 @@ C: peg-head ] H{ } make-assoc swap bind ; inline -: compiled-parsers ( -- cache ) - \ compiled-parsers get-global [ H{ } clone dup \ compiled-parsers set-global ] unless* ; - -: reset-compiled-parsers ( -- ) - H{ } clone \ compiled-parsers set-global ; - -reset-compiled-parsers - GENERIC: (compile) ( parser -- quot ) @@ -226,11 +222,11 @@ GENERIC: (compile) ( parser -- quot ) #! Circular parsers are supported by getting the word #! name and storing it in the cache, before compiling, #! so it is picked up when re-entered. - dup id>> compiled-parsers [ - drop dup gensym swap 2dup id>> compiled-parsers set-at - 2dup parser-body define - dupd "peg" set-word-prop - ] cache nip ; + dup compiled>> [ + nip + ] [ + gensym tuck >>compiled 2dup parser-body define dupd "peg" set-word-prop + ] if* ; : compile ( parser -- word ) [ compiled-parser ] with-compilation-unit ; @@ -253,10 +249,6 @@ SYMBOL: id 1 id set-global 0 ] if* ; -TUPLE: parser id ; -M: parser equal? [ id>> ] 2apply = ; -C: parser - : delegates ( -- cache ) \ delegates get-global [ H{ } clone dup \ delegates set-global ] unless* ; @@ -269,7 +261,7 @@ reset-delegates #! Set the delegate for the parser. Equivalent parsers #! get a delegate with the same id. dup clone delegates [ - drop next-id + drop next-id f ] cache over set-delegate ; TUPLE: token-parser symbol ; From 9df74f9b6fa31cfb0f9a8bd9390b8ad01be4f9ae Mon Sep 17 00:00:00 2001 From: erg Date: Sat, 29 Mar 2008 20:12:22 -0500 Subject: [PATCH 175/219] help lint fixes for random --- extra/random/random-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/random/random-docs.factor b/extra/random/random-docs.factor index 905f81b53d..a8a214dcc7 100644 --- a/extra/random/random-docs.factor +++ b/extra/random/random-docs.factor @@ -17,7 +17,7 @@ HELP: random-32* { $description "Generates a random 32-bit unsigned integer." } ; HELP: random-bytes* -{ $values { "n" "an integer" } { "tuple" "a random number generator" } { "bytes" "a sequence of random bytes" } } +{ $values { "n" "an integer" } { "tuple" "a random number generator" } { "byte-array" "a sequence of random bytes" } } { $description "Generates a byte-array of random bytes." } ; HELP: random @@ -26,7 +26,7 @@ HELP: random { $notes "Since integers are sequences, passing an integer " { $snippet "n" } " yields a random integer in the interval " { $snippet "[0,n)" } "." } ; HELP: random-bytes -{ $values { "n" "an integer" } { "bytes" "a random integer" } } +{ $values { "n" "an integer" } { "byte-array" "a random integer" } } { $description "Outputs an integer with n bytes worth of bits." } ; HELP: random-bits From db7939d68cc3804dfde59dda9ef8960ef8a94199 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 20:28:07 -0500 Subject: [PATCH 176/219] Cleanup --- core/hashtables/hashtables.factor | 23 +++++++++-------------- 1 file changed, 9 insertions(+), 14 deletions(-) diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index 1fabc1aab7..4527d2044d 100755 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -18,14 +18,9 @@ IN: hashtables : (key@) ( key keys i -- array n ? ) 3dup swap array-nth dup ((empty)) eq? - [ 3drop nip f f ] - [ - = - [ rot drop t ] - [ probe (key@) ] - if - ] - if ; inline + [ 3drop nip f f ] [ + = [ rot drop t ] [ probe (key@) ] if + ] if ; inline : key@ ( key hash -- array n ? ) hash-array 2dup hash@ (key@) ; inline @@ -89,7 +84,8 @@ IN: hashtables ] if ] if ; inline -: find-pair ( array quot -- key value ? ) 0 rot (find-pair) ; inline +: find-pair ( array quot -- key value ? ) + 0 rot (find-pair) ; inline : (rehash) ( hash array -- ) [ swap pick (set-hash) drop f ] find-pair 2drop 2drop ; @@ -99,8 +95,7 @@ IN: hashtables [ hash-array array-capacity ] bi > ; : hash-stale? ( hash -- ? ) - [ hash-deleted 10 fixnum*fast ] - [ hash-count ] bi fixnum> ; + [ hash-deleted 10 fixnum*fast ] [ hash-count ] bi fixnum> ; : grow-hash ( hash -- ) [ dup hash-array swap assoc-size 1+ ] keep @@ -185,12 +180,12 @@ M: hashtable assoc-like : prune ( seq -- newseq ) [ length ] - [ length ] - [ ] tri + [ length ] + [ ] tri [ >r 2dup r> (prune) ] each nip ; : all-unique? ( seq -- ? ) - [ length ] + [ length ] [ prune length ] bi = ; INSTANCE: hashtable assoc From c22af5c7a6fe94e6550debfd0593425f271011b7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 20:36:58 -0500 Subject: [PATCH 177/219] Rename 2apply to bi@ --- core/alien/alien.factor | 2 +- core/assocs/assocs.factor | 2 +- core/bit-arrays/bit-arrays-tests.factor | 2 +- core/bootstrap/stage2.factor | 2 +- core/classes/algebra/algebra.factor | 2 +- core/classes/mixin/mixin.factor | 4 ++-- core/compiler/tests/curry.factor | 2 +- core/compiler/tests/templates.factor | 4 ++-- core/cpu/arm/architecture/architecture.factor | 6 +++--- core/cpu/ppc/allot/allot.factor | 2 +- core/cpu/ppc/architecture/architecture.factor | 8 ++++---- core/cpu/x86/allot/allot.factor | 2 +- core/cpu/x86/architecture/architecture.factor | 8 ++++---- core/debugger/debugger.factor | 2 +- core/dlists/dlists-tests.factor | 2 +- core/effects/effects.factor | 4 ++-- core/generator/registers/registers.factor | 14 ++++++------- core/hashtables/hashtables.factor | 2 +- core/heaps/heaps-tests.factor | 4 ++-- core/inference/class/class.factor | 4 ++-- core/inference/inference-tests.factor | 2 +- core/io/files/files-tests.factor | 2 +- core/kernel/kernel-docs.factor | 6 +++--- core/kernel/kernel.factor | 3 --- core/math/intervals/intervals-tests.factor | 6 +++--- core/math/intervals/intervals.factor | 20 +++++++++---------- core/optimizer/def-use/def-use-tests.factor | 2 +- core/optimizer/math/math.factor | 4 ++-- core/parser/parser.factor | 2 +- core/prettyprint/prettyprint.factor | 2 +- core/quotations/quotations.factor | 2 +- core/sequences/sequences-tests.factor | 6 +++--- core/sequences/sequences.factor | 12 +++++------ core/sorting/sorting.factor | 2 +- core/splitting/splitting.factor | 2 +- core/vectors/vectors-tests.factor | 2 +- core/vocabs/vocabs.factor | 2 +- extra/benchmark/raytracer/raytracer.factor | 4 ++-- .../reverse-complement-tests.factor | 2 +- .../spectral-norm/spectral-norm.factor | 2 +- extra/bitfields/bitfields.factor | 2 +- extra/boids/boids.factor | 2 +- extra/builder/benchmark/benchmark.factor | 4 ++-- extra/builder/util/util.factor | 2 +- extra/calendar/calendar.factor | 8 ++++---- extra/calendar/format/format.factor | 2 +- extra/cocoa/dialogs/dialogs.factor | 2 +- extra/crypto/rsa/rsa.factor | 2 +- extra/crypto/sha1/sha1.factor | 2 +- extra/documents/documents.factor | 6 +++--- extra/faq/faq.factor | 2 +- extra/fry/fry-docs.factor | 2 +- extra/help/lint/lint.factor | 2 +- extra/http/http.factor | 2 +- extra/icfp/2006/2006.factor | 4 ++-- extra/inverse/inverse.factor | 4 ++-- extra/io/encodings/utf16/utf16.factor | 2 +- extra/io/nonblocking/nonblocking.factor | 2 +- extra/io/sockets/impl/impl.factor | 4 ++-- extra/io/unix/files/files.factor | 4 ++-- extra/io/windows/ce/backend/backend.factor | 2 +- extra/io/windows/windows.factor | 4 ++-- extra/jamshred/tunnel/tunnel.factor | 2 +- extra/koszul/koszul.factor | 10 +++++----- extra/lazy-lists/lazy-lists.factor | 2 +- extra/levenshtein/levenshtein.factor | 4 ++-- extra/lint/lint.factor | 4 ++-- extra/match/match.factor | 4 ++-- extra/math/complex/complex.factor | 6 +++--- extra/math/functions/functions.factor | 4 ++-- extra/math/polynomials/polynomials.factor | 16 +++++++-------- extra/math/quaternions/quaternions.factor | 2 +- extra/math/ratios/ratios.factor | 4 ++-- extra/math/statistics/statistics.factor | 4 ++-- extra/maze/maze.factor | 2 +- extra/money/money.factor | 4 ++-- extra/multi-methods/multi-methods.factor | 2 +- extra/opengl/demo-support/demo-support.factor | 2 +- extra/opengl/opengl.factor | 6 +++--- .../parser-combinators.factor | 4 ++-- extra/peg/parsers/parsers.factor | 2 +- extra/peg/peg.factor | 2 +- extra/project-euler/009/009.factor | 2 +- extra/project-euler/014/014.factor | 2 +- extra/project-euler/026/026.factor | 2 +- extra/project-euler/027/027.factor | 2 +- extra/project-euler/033/033.factor | 4 ++-- extra/project-euler/044/044.factor | 2 +- extra/project-euler/079/079.factor | 2 +- extra/random-tester/random/random.factor | 2 +- extra/regexp/regexp.factor | 2 +- extra/regexp2/regexp2.factor | 2 +- extra/reports/noise/noise.factor | 2 +- extra/roman/roman.factor | 4 ++-- extra/semantic-db/semantic-db-tests.factor | 2 +- extra/serialize/serialize.factor | 2 +- extra/shufflers/shufflers.factor | 2 +- extra/sudoku/sudoku.factor | 2 +- extra/tar/tar.factor | 2 +- extra/tools/completion/completion.factor | 4 ++-- extra/tools/deploy/shaker/strip-cocoa.factor | 2 +- extra/ui/gadgets/borders/borders.factor | 2 +- extra/ui/gadgets/editors/editors.factor | 2 +- extra/ui/gadgets/gadgets.factor | 2 +- extra/ui/gadgets/grids/grids-tests.factor | 4 ++-- extra/ui/gadgets/scrollers/scrollers.factor | 2 +- extra/unicode/breaks/breaks.factor | 4 ++-- extra/unicode/case/case.factor | 2 +- extra/unicode/normalize/normalize.factor | 2 +- extra/units/units.factor | 14 ++++++------- extra/xmode/catalog/catalog.factor | 2 +- 111 files changed, 196 insertions(+), 199 deletions(-) diff --git a/core/alien/alien.factor b/core/alien/alien.factor index d0adec1fcf..cfa9fb2e16 100755 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -39,7 +39,7 @@ M: alien equal? 2dup [ expired? ] either? [ [ expired? ] both? ] [ - [ alien-address ] 2apply = + [ alien-address ] bi@ = ] if ] [ 2drop f diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 196ec614b7..b911faf672 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -115,7 +115,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) swap [ swapd set-at ] curry assoc-each ; : union ( assoc1 assoc2 -- union ) - 2dup [ assoc-size ] 2apply + pick new-assoc + 2dup [ assoc-size ] bi@ + pick new-assoc [ rot update ] keep [ swap update ] keep ; : diff ( assoc1 assoc2 -- diff ) diff --git a/core/bit-arrays/bit-arrays-tests.factor b/core/bit-arrays/bit-arrays-tests.factor index 5774b86e45..e28c16c3c2 100755 --- a/core/bit-arrays/bit-arrays-tests.factor +++ b/core/bit-arrays/bit-arrays-tests.factor @@ -21,7 +21,7 @@ IN: bit-arrays.tests { t f t } { f t f } ] [ { t f t } >bit-array dup clone dup [ not ] change-each - [ >array ] 2apply + [ >array ] bi@ ] unit-test [ diff --git a/core/bootstrap/stage2.factor b/core/bootstrap/stage2.factor index f472e0158f..bbb2e44843 100755 --- a/core/bootstrap/stage2.factor +++ b/core/bootstrap/stage2.factor @@ -23,7 +23,7 @@ SYMBOL: bootstrap-time : load-components ( -- ) "exclude" "include" - [ get-global " " split [ empty? not ] subset ] 2apply + [ get-global " " split [ empty? not ] subset ] bi@ seq-diff [ "bootstrap." prepend require ] each ; diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index e2206213a6..2945bd2546 100755 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -67,7 +67,7 @@ C: anonymous-complement members>> [ class< ] with all? ; : anonymous-complement< ( first second -- ? ) - [ class>> ] 2apply swap class< ; + [ class>> ] bi@ swap class< ; : (class<) ( first second -- -1/0/1 ) { diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 85a6fb241d..eb6b3bd6e2 100755 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -47,8 +47,8 @@ TUPLE: mixin-instance loc class mixin ; M: mixin-instance equal? { { [ over mixin-instance? not ] [ f ] } - { [ 2dup [ mixin-instance-class ] 2apply = not ] [ f ] } - { [ 2dup [ mixin-instance-mixin ] 2apply = not ] [ f ] } + { [ 2dup [ mixin-instance-class ] bi@ = not ] [ f ] } + { [ 2dup [ mixin-instance-mixin ] bi@ = not ] [ f ] } { [ t ] [ t ] } } cond 2nip ; diff --git a/core/compiler/tests/curry.factor b/core/compiler/tests/curry.factor index d2e7115f8f..61d20fd8ab 100755 --- a/core/compiler/tests/curry.factor +++ b/core/compiler/tests/curry.factor @@ -10,7 +10,7 @@ IN: compiler.tests [ 3 ] [ 5 2 [ [ - ] 2curry 9 swap call /i ] compile-call ] unit-test [ 3 ] [ 5 2 [ [ - ] 2curry >r 9 r> call /i ] compile-call ] unit-test -[ -10 -20 ] [ 10 20 -1 [ [ * ] curry 2apply ] compile-call ] unit-test +[ -10 -20 ] [ 10 20 -1 [ [ * ] curry bi@ ] compile-call ] unit-test [ [ 5 2 - ] ] [ 5 [ [ 2 - ] curry ] compile-call >quotation ] unit-test [ [ 5 2 - ] ] [ [ 5 [ 2 - ] curry ] compile-call >quotation ] unit-test diff --git a/core/compiler/tests/templates.factor b/core/compiler/tests/templates.factor index 8a33d57fe7..081a8fd47c 100755 --- a/core/compiler/tests/templates.factor +++ b/core/compiler/tests/templates.factor @@ -72,13 +72,13 @@ unit-test ] unit-test [ 12 13 ] [ - -12 -13 [ [ 0 swap fixnum-fast ] 2apply ] compile-call + -12 -13 [ [ 0 swap fixnum-fast ] bi@ ] compile-call ] unit-test [ -1 2 ] [ 1 2 [ >r 0 swap fixnum- r> ] compile-call ] unit-test [ 12 13 ] [ - -12 -13 [ [ 0 swap fixnum- ] 2apply ] compile-call + -12 -13 [ [ 0 swap fixnum- ] bi@ ] compile-call ] unit-test [ 1 ] [ diff --git a/core/cpu/arm/architecture/architecture.factor b/core/cpu/arm/architecture/architecture.factor index 8742a693cb..563dd10bc4 100755 --- a/core/cpu/arm/architecture/architecture.factor +++ b/core/cpu/arm/architecture/architecture.factor @@ -63,7 +63,7 @@ M: arm-backend load-indirect ( obj reg -- ) M: immediate load-literal over v>operand small-enough? [ - [ v>operand ] 2apply swap MOV + [ v>operand ] bi@ swap MOV ] [ v>operand load-indirect ] if ; @@ -322,10 +322,10 @@ M: arm-backend fp-shadows-int? ( -- ? ) f ; ! Alien intrinsics M: arm-backend %unbox-byte-array ( dst src -- ) - [ v>operand ] 2apply byte-array-offset ADD ; + [ v>operand ] bi@ byte-array-offset ADD ; M: arm-backend %unbox-alien ( dst src -- ) - [ v>operand ] 2apply alien-offset <+> LDR ; + [ v>operand ] bi@ alien-offset <+> LDR ; M: arm-backend %unbox-f ( dst src -- ) drop v>operand 0 MOV ; diff --git a/core/cpu/ppc/allot/allot.factor b/core/cpu/ppc/allot/allot.factor index df0a08a86d..6c37fce4f1 100755 --- a/core/cpu/ppc/allot/allot.factor +++ b/core/cpu/ppc/allot/allot.factor @@ -33,7 +33,7 @@ IN: cpu.ppc.allot f fresh-object ; M: ppc-backend %box-float ( dst src -- ) - [ v>operand ] 2apply %allot-float 12 MR ; + [ v>operand ] bi@ %allot-float 12 MR ; : %allot-bignum ( #digits -- ) #! 1 cell header, 1 cell length, 1 cell sign, + digits diff --git a/core/cpu/ppc/architecture/architecture.factor b/core/cpu/ppc/architecture/architecture.factor index 1daf3ac622..903ac32df9 100755 --- a/core/cpu/ppc/architecture/architecture.factor +++ b/core/cpu/ppc/architecture/architecture.factor @@ -71,7 +71,7 @@ M: ds-loc loc>operand ds-loc-n cells neg ds-reg swap ; M: rs-loc loc>operand rs-loc-n cells neg rs-reg swap ; M: immediate load-literal - [ v>operand ] 2apply LOAD ; + [ v>operand ] bi@ LOAD ; M: ppc-backend load-indirect ( obj reg -- ) [ 0 swap LOAD32 rc-absolute-ppc-2/2 rel-literal ] keep @@ -138,7 +138,7 @@ M: ppc-backend %replace >r v>operand r> loc>operand STW ; M: ppc-backend %unbox-float ( dst src -- ) - [ v>operand ] 2apply float-offset LFD ; + [ v>operand ] bi@ float-offset LFD ; M: ppc-backend %inc-d ( n -- ) ds-reg dup rot cells ADDI ; @@ -291,10 +291,10 @@ M: ppc-backend %unbox-small-struct ! Alien intrinsics M: ppc-backend %unbox-byte-array ( dst src -- ) - [ v>operand ] 2apply byte-array-offset ADDI ; + [ v>operand ] bi@ byte-array-offset ADDI ; M: ppc-backend %unbox-alien ( dst src -- ) - [ v>operand ] 2apply alien-offset LWZ ; + [ v>operand ] bi@ alien-offset LWZ ; M: ppc-backend %unbox-f ( dst src -- ) drop 0 swap v>operand LI ; diff --git a/core/cpu/x86/allot/allot.factor b/core/cpu/x86/allot/allot.factor index f837a92504..5519a9a8d5 100755 --- a/core/cpu/x86/allot/allot.factor +++ b/core/cpu/x86/allot/allot.factor @@ -101,6 +101,6 @@ M: x86-backend %box-alien ( dst src -- ) ] %allot "end" get JMP "f" resolve-label - f [ v>operand ] 2apply MOV + f [ v>operand ] bi@ MOV "end" resolve-label ] with-scope ; diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor index f993639c05..31fa4c8e4b 100755 --- a/core/cpu/x86/architecture/architecture.factor +++ b/core/cpu/x86/architecture/architecture.factor @@ -109,9 +109,9 @@ M: x86-backend %dispatch-label ( word -- ) 0 cell, rc-absolute-cell rel-word ; M: x86-backend %unbox-float ( dst src -- ) - [ v>operand ] 2apply float-offset [+] MOVSD ; + [ v>operand ] bi@ float-offset [+] MOVSD ; -M: x86-backend %peek [ v>operand ] 2apply MOV ; +M: x86-backend %peek [ v>operand ] bi@ MOV ; M: x86-backend %replace swap %peek ; @@ -162,10 +162,10 @@ M: x86-backend %return ( -- ) 0 %unwind ; ! Alien intrinsics M: x86-backend %unbox-byte-array ( dst src -- ) - [ v>operand ] 2apply byte-array-offset [+] LEA ; + [ v>operand ] bi@ byte-array-offset [+] LEA ; M: x86-backend %unbox-alien ( dst src -- ) - [ v>operand ] 2apply alien-offset [+] MOV ; + [ v>operand ] bi@ alien-offset [+] MOV ; M: x86-backend %unbox-f ( dst src -- ) drop v>operand 0 MOV ; diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor index a7937cdb9d..033ae0680c 100755 --- a/core/debugger/debugger.factor +++ b/core/debugger/debugger.factor @@ -82,7 +82,7 @@ ERROR: assert got expect ; : depth ( -- n ) datastack length ; : trim-datastacks ( seq1 seq2 -- seq1' seq2' ) - 2dup [ length ] 2apply min tuck tail >r tail r> ; + 2dup [ length ] bi@ min tuck tail >r tail r> ; ERROR: relative-underflow stack ; diff --git a/core/dlists/dlists-tests.factor b/core/dlists/dlists-tests.factor index 2bc0e6a3fb..28db6e1cbd 100755 --- a/core/dlists/dlists-tests.factor +++ b/core/dlists/dlists-tests.factor @@ -63,7 +63,7 @@ IN: dlists.tests [ 0 ] [ 1 over push-front dup pop-front* dlist-length ] unit-test : assert-same-elements - [ prune natural-sort ] 2apply assert= ; + [ prune natural-sort ] bi@ assert= ; : dlist-push-all [ push-front ] curry each ; diff --git a/core/effects/effects.factor b/core/effects/effects.factor index 23e8daf122..aed4a64c6c 100755 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -18,8 +18,8 @@ TUPLE: effect in out terminated? ; { [ dup not ] [ t ] } { [ over effect-terminated? ] [ t ] } { [ dup effect-terminated? ] [ f ] } - { [ 2dup [ effect-in length ] 2apply > ] [ f ] } - { [ 2dup [ effect-height ] 2apply = not ] [ f ] } + { [ 2dup [ effect-in length ] bi@ > ] [ f ] } + { [ 2dup [ effect-height ] bi@ = not ] [ f ] } { [ t ] [ t ] } } cond 2nip ; diff --git a/core/generator/registers/registers.factor b/core/generator/registers/registers.factor index e03923e860..aac1b2cdc6 100755 --- a/core/generator/registers/registers.factor +++ b/core/generator/registers/registers.factor @@ -79,7 +79,7 @@ M: ds-loc minimal-ds-loc* ds-loc-n min ; M: ds-loc operand-class* ds-loc-class ; M: ds-loc set-operand-class set-ds-loc-class ; M: ds-loc live-loc? - over ds-loc? [ [ ds-loc-n ] 2apply = not ] [ 2drop t ] if ; + over ds-loc? [ [ ds-loc-n ] bi@ = not ] [ 2drop t ] if ; ! A retain stack location. TUPLE: rs-loc n class ; @@ -89,7 +89,7 @@ TUPLE: rs-loc n class ; M: rs-loc operand-class* rs-loc-class ; M: rs-loc set-operand-class set-rs-loc-class ; M: rs-loc live-loc? - over rs-loc? [ [ rs-loc-n ] 2apply = not ] [ 2drop t ] if ; + over rs-loc? [ [ rs-loc-n ] bi@ = not ] [ 2drop t ] if ; UNION: loc ds-loc rs-loc ; @@ -206,7 +206,7 @@ INSTANCE: constant value %move ; : %move ( dst src -- ) - 2dup [ move-spec ] 2apply 2array { + 2dup [ move-spec ] bi@ 2array { { { f f } [ %move-bug ] } { { f unboxed-c-ptr } [ %move-bug ] } { { f unboxed-byte-array } [ %move-bug ] } @@ -318,7 +318,7 @@ M: phantom-stack cut-phantom : phantoms ( -- phantom phantom ) phantom-d get phantom-r get ; -: each-phantom ( quot -- ) phantoms rot 2apply ; inline +: each-phantom ( quot -- ) phantoms rot bi@ ; inline : finalize-heights ( -- ) [ finalize-height ] each-phantom ; @@ -442,7 +442,7 @@ M: loc lazy-store : fast-shuffle? ( live-locs -- ? ) #! Test if we have enough free registers to load all #! shuffle inputs at once. - T{ int-regs } free-vregs [ length ] 2apply <= ; + T{ int-regs } free-vregs [ length ] bi@ <= ; : finalize-locs ( -- ) #! Perform any deferred stack shuffling. @@ -488,7 +488,7 @@ M: loc lazy-store : phantom&spec ( phantom spec -- phantom' spec' ) [ length f pad-left ] keep - [ ] 2apply ; inline + [ ] bi@ ; inline : phantom&spec-agree? ( phantom spec quot -- ? ) >r phantom&spec r> 2all? ; inline @@ -520,7 +520,7 @@ M: loc lazy-store swap lazy-load ; : output-vregs ( -- seq seq ) - +output+ +clobber+ [ get [ get ] map ] 2apply ; + +output+ +clobber+ [ get [ get ] map ] bi@ ; : clash? ( seq -- ? ) phantoms append [ diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index 4527d2044d..5ac49ffa2f 100755 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -156,7 +156,7 @@ M: hashtable clone M: hashtable equal? over hashtable? [ - 2dup [ assoc-size ] 2apply number= + 2dup [ assoc-size ] bi@ number= [ assoc= ] [ 2drop f ] if ] [ 2drop f ] if ; diff --git a/core/heaps/heaps-tests.factor b/core/heaps/heaps-tests.factor index 0b3123c87b..77560c7444 100755 --- a/core/heaps/heaps-tests.factor +++ b/core/heaps/heaps-tests.factor @@ -66,8 +66,8 @@ IN: heaps.tests dup heap-data clone swap ] keep 3 /i [ 2dup >r delete-random r> heap-delete ] times heap-data - [ [ entry-key ] map ] 2apply - [ natural-sort ] 2apply ; + [ [ entry-key ] map ] bi@ + [ natural-sort ] bi@ ; 11 [ [ t ] swap [ 2^ delete-test sequence= ] curry unit-test diff --git a/core/inference/class/class.factor b/core/inference/class/class.factor index 7764fd4fd1..ed36ca4890 100755 --- a/core/inference/class/class.factor +++ b/core/inference/class/class.factor @@ -26,8 +26,8 @@ C: literal-constraint M: literal-constraint equal? over literal-constraint? [ 2dup - [ literal-constraint-literal ] 2apply eql? >r - [ literal-constraint-value ] 2apply = r> and + [ literal-constraint-literal ] bi@ eql? >r + [ literal-constraint-value ] bi@ = r> and ] [ 2drop f ] if ; diff --git a/core/inference/inference-tests.factor b/core/inference/inference-tests.factor index 1cc1548a3d..84014512aa 100755 --- a/core/inference/inference-tests.factor +++ b/core/inference/inference-tests.factor @@ -224,7 +224,7 @@ DEFER: do-crap* MATH: xyz M: fixnum xyz 2array ; M: float xyz - [ 3 ] 2apply swapd >r 2array swap r> 2array swap ; + [ 3 ] bi@ swapd >r 2array swap r> 2array swap ; [ [ xyz ] infer ] [ inference-error? ] must-fail-with diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index b78f7667a6..9920d8d25c 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -117,7 +117,7 @@ io.encodings.utf8 ; [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test -[ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] 2apply move-file ] unit-test +[ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] bi@ move-file ] unit-test [ t ] [ "quux-test.txt" temp-file exists? ] unit-test [ ] [ "quux-test.txt" temp-file delete-file ] unit-test diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 0babb14fa7..457313724c 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -60,8 +60,8 @@ $nl { $subsection keep } { $subsection 2keep } { $subsection 3keep } -{ $subsection 2apply } -"A pair of utility words built from " { $link 2apply } ":" +{ $subsection bi@ } +"A pair of utility words built from " { $link bi@ } ":" { $subsection both? } { $subsection either? } "A looping combinator:" @@ -376,7 +376,7 @@ HELP: 3keep { $values { "quot" "a quotation with stack effect " { $snippet "( x y z -- )" } } { "x" object } { "y" object } { "z" object } } { $description "Call a quotation with three values on the stack, restoring the values when the quotation returns." } ; -HELP: 2apply +HELP: bi@ { $values { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } { "x" object } { "y" object } } { $description "Applies the quotation to " { $snippet "x" } ", then to " { $snippet "y" } "." } ; diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index cbabeb6bfa..e2e0c0171a 100755 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -199,6 +199,3 @@ GENERIC: construct-boa ( ... class -- tuple ) : do-primitive ( number -- ) "Improper primitive call" throw ; PRIVATE> - -! Deprecated -: 2apply bi@ ; inline diff --git a/core/math/intervals/intervals-tests.factor b/core/math/intervals/intervals-tests.factor index 5a3fe777b6..f6317e7475 100755 --- a/core/math/intervals/intervals-tests.factor +++ b/core/math/intervals/intervals-tests.factor @@ -169,7 +169,7 @@ IN: math.intervals.tests : random-interval ( -- interval ) 1000 random dup 2 1000 random + + - 1 random zero? [ [ neg ] 2apply swap ] when + 1 random zero? [ [ neg ] bi@ swap ] when 4 random { { 0 [ [a,b] ] } { 1 [ [a,b) ] } @@ -197,7 +197,7 @@ IN: math.intervals.tests 0 pick interval-contains? over first { / /i } member? and [ 3drop t ] [ - [ >r [ random-element ] 2apply ! 2dup . . + [ >r [ random-element ] bi@ ! 2dup . . r> first execute ] 3keep second execute interval-contains? ] if ; @@ -214,7 +214,7 @@ IN: math.intervals.tests : comparison-test random-interval random-interval random-comparison - [ >r [ random-element ] 2apply r> first execute ] 3keep + [ >r [ random-element ] bi@ r> first execute ] 3keep second execute dup incomparable eq? [ 2drop t ] [ diff --git a/core/math/intervals/intervals.factor b/core/math/intervals/intervals.factor index d1c458065f..cc51060f63 100755 --- a/core/math/intervals/intervals.factor +++ b/core/math/intervals/intervals.factor @@ -67,7 +67,7 @@ C: interval : (interval-op) ( p1 p2 quot -- p3 ) 2over >r >r - >r [ first ] 2apply r> call + >r [ first ] bi@ r> call r> r> [ second ] both? 2array ; inline : interval-op ( i1 i2 quot -- i3 ) @@ -108,7 +108,7 @@ C: interval : interval-intersect ( i1 i2 -- i3 ) 2dup and [ - [ interval>points ] 2apply swapd + [ interval>points ] bi@ swapd [ swap endpoint> ] most >r [ swap endpoint< ] most r> make-interval @@ -118,7 +118,7 @@ C: interval : interval-union ( i1 i2 -- i3 ) 2dup and [ - [ interval>points 2array ] 2apply append points>interval + [ interval>points 2array ] bi@ append points>interval ] [ 2drop f ] if ; @@ -131,17 +131,17 @@ C: interval : interval-singleton? ( int -- ? ) interval>points - 2dup [ second ] 2apply and - [ [ first ] 2apply = ] + 2dup [ second ] bi@ and + [ [ first ] bi@ = ] [ 2drop f ] if ; : interval-length ( int -- n ) dup - [ interval>points [ first ] 2apply swap - ] + [ interval>points [ first ] bi@ swap - ] [ drop 0 ] if ; : interval-closure ( i1 -- i2 ) - dup [ interval>points [ first ] 2apply [a,b] ] when ; + dup [ interval>points [ first ] bi@ [a,b] ] when ; : interval-shift ( i1 i2 -- i3 ) #! Inaccurate; could be tighter @@ -163,7 +163,7 @@ C: interval [ min ] interval-op interval-closure ; : interval-interior ( i1 -- i2 ) - interval>points [ first ] 2apply (a,b) ; + interval>points [ first ] bi@ (a,b) ; : interval-division-op ( i1 i2 quot -- i3 ) >r 0 over interval-closure interval-contains? @@ -186,13 +186,13 @@ SYMBOL: incomparable : left-endpoint-< ( i1 i2 -- ? ) [ swap interval-subset? ] 2keep [ nip interval-singleton? ] 2keep - [ interval-from ] 2apply = + [ interval-from ] bi@ = and and ; : right-endpoint-< ( i1 i2 -- ? ) [ interval-subset? ] 2keep [ drop interval-singleton? ] 2keep - [ interval-to ] 2apply = + [ interval-to ] bi@ = and and ; : (interval<) over interval-from over interval-from endpoint< ; diff --git a/core/optimizer/def-use/def-use-tests.factor b/core/optimizer/def-use/def-use-tests.factor index d5e8e2d75d..f22cce9fa8 100755 --- a/core/optimizer/def-use/def-use-tests.factor +++ b/core/optimizer/def-use/def-use-tests.factor @@ -99,7 +99,7 @@ namespaces assocs kernel sequences math tools.test words ; ] unit-test : regression-2 ( x y -- x.y ) - [ p1 ] 2apply [ + [ p1 ] bi@ [ [ rot [ 2swap [ swapd * -rot p2 +@ ] 2keep ] diff --git a/core/optimizer/math/math.factor b/core/optimizer/math/math.factor index 349cf88f17..abe48ec272 100755 --- a/core/optimizer/math/math.factor +++ b/core/optimizer/math/math.factor @@ -113,7 +113,7 @@ generic.standard system ; : post-process ( class interval node -- classes intervals ) dupd won't-overflow? [ >r dup { f integer } member? [ drop fixnum ] when r> ] when - [ dup [ 1array ] when ] 2apply ; + [ dup [ 1array ] when ] bi@ ; : math-output-interval-1 ( node word -- interval ) dup [ @@ -147,7 +147,7 @@ generic.standard system ; ] each : intervals ( node -- i1 i2 ) - node-in-d first2 [ value-interval* ] 2apply ; + node-in-d first2 [ value-interval* ] bi@ ; : math-output-interval-2 ( node word -- interval ) dup [ diff --git a/core/parser/parser.factor b/core/parser/parser.factor index f8836217b5..36e5decd05 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -475,7 +475,7 @@ SYMBOL: interactive-vocabs : removed-definitions ( -- definitions ) new-definitions old-definitions - [ get first2 union ] 2apply diff ; + [ get first2 union ] bi@ diff ; : smudged-usage ( -- usages referenced removed ) removed-definitions filter-moved keys [ diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 6c557d873d..d294f95be6 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -114,7 +114,7 @@ SYMBOL: -> : remove-breakpoints ( quot pos -- quot' ) over quotation? [ - 1+ cut [ (remove-breakpoints) ] 2apply + 1+ cut [ (remove-breakpoints) ] bi@ [ -> ] swap 3append ] [ drop diff --git a/core/quotations/quotations.factor b/core/quotations/quotations.factor index 693e337959..c0f15a9388 100755 --- a/core/quotations/quotations.factor +++ b/core/quotations/quotations.factor @@ -12,7 +12,7 @@ M: curry call dup 3 slot swap 4 slot call ; M: compose call dup 3 slot swap 4 slot slip call ; M: wrapper equal? - over wrapper? [ [ wrapped ] 2apply = ] [ 2drop f ] if ; + over wrapper? [ [ wrapped ] bi@ = ] [ 2drop f ] if ; UNION: callable quotation curry compose ; diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index c545a9baee..3a30824084 100755 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -169,13 +169,13 @@ unit-test [ f ] [ { "a" "b" "c" } { "a" "b" "c" } mismatch ] unit-test -[ V{ } V{ } ] [ { "a" "b" } { "a" "b" } drop-prefix [ >vector ] 2apply ] unit-test +[ V{ } V{ } ] [ { "a" "b" } { "a" "b" } drop-prefix [ >vector ] bi@ ] unit-test -[ V{ "C" } V{ "c" } ] [ { "a" "b" "C" } { "a" "b" "c" } drop-prefix [ >vector ] 2apply ] unit-test +[ V{ "C" } V{ "c" } ] [ { "a" "b" "C" } { "a" "b" "c" } drop-prefix [ >vector ] bi@ ] unit-test [ -1 1 "abc" ] must-fail -[ V{ "a" "b" } V{ } ] [ { "X" "a" "b" } { "X" } drop-prefix [ >vector ] 2apply ] unit-test +[ V{ "a" "b" } V{ } ] [ { "X" "a" "b" } { "X" } drop-prefix [ >vector ] bi@ ] unit-test [ -1 ] [ "ab" "abc" <=> ] unit-test [ 1 ] [ "abc" "ab" <=> ] unit-test diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 111cf74ea2..1f2a6c5501 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -300,9 +300,9 @@ M: immutable-sequence clone-like like ; : change-nth ( i seq quot -- ) [ >r nth r> call ] 3keep drop set-nth ; inline -: min-length ( seq1 seq2 -- n ) [ length ] 2apply min ; inline +: min-length ( seq1 seq2 -- n ) [ length ] bi@ min ; inline -: max-length ( seq1 seq2 -- n ) [ length ] 2apply max ; inline +: max-length ( seq1 seq2 -- n ) [ length ] bi@ max ; inline (2each) each-integer ; inline : 2reverse-each ( seq1 seq2 quot -- ) - >r [ ] 2apply r> 2each ; inline + >r [ ] bi@ r> 2each ; inline : 2reduce ( seq1 seq2 identity quot -- result ) >r -rot r> 2each ; inline @@ -460,7 +460,7 @@ M: sequence <=> [ -rot 2nth-unsafe <=> ] [ [ length ] compare ] if* ; : sequence= ( seq1 seq2 -- ? ) - 2dup [ length ] 2apply number= + 2dup [ length ] bi@ number= [ mismatch not ] [ 2drop f ] if ; inline : move ( to from seq -- ) @@ -620,12 +620,12 @@ M: sequence <=> [ drop nip ] [ 2drop first ] [ >r drop first2 r> call ] - [ >r drop first3 r> 2apply ] + [ >r drop first3 r> bi@ ] } dispatch ] [ drop >r >r halves r> r> - [ [ binary-reduce ] 2curry 2apply ] keep + [ [ binary-reduce ] 2curry bi@ ] keep call ] if ; inline diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor index ab2ce21010..5f81b17187 100755 --- a/core/sorting/sorting.factor +++ b/core/sorting/sorting.factor @@ -32,7 +32,7 @@ DEFER: sort ] if ; inline : merge ( sorted1 sorted2 quot -- result ) - >r [ [ ] 2apply ] 2keep r> + >r [ [ ] bi@ ] 2keep r> rot length rot length + [ (merge) ] keep underlying ; inline diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor index 419a30dda4..9be1d5fc64 100755 --- a/core/splitting/splitting.factor +++ b/core/splitting/splitting.factor @@ -56,7 +56,7 @@ INSTANCE: groups sequence ] if ; : last-split1 ( seq subseq -- before after ) - [ ] 2apply split1 [ reverse ] 2apply + [ ] bi@ split1 [ reverse ] bi@ dup [ swap ] when ; : (split) ( separators n seq -- ) diff --git a/core/vectors/vectors-tests.factor b/core/vectors/vectors-tests.factor index d990f5f31c..18aa0f3fa7 100755 --- a/core/vectors/vectors-tests.factor +++ b/core/vectors/vectors-tests.factor @@ -77,7 +77,7 @@ IN: vectors.tests [ f ] [ V{ 1 2 3 4 } dup clone - [ underlying ] 2apply eq? + [ underlying ] bi@ eq? ] unit-test [ 0 ] [ diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index f111b5bc74..886417b715 100755 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -94,7 +94,7 @@ TUPLE: vocab-link name ; M: vocab-link equal? over vocab-link? - [ [ vocab-link-name ] 2apply = ] [ 2drop f ] if ; + [ [ vocab-link-name ] bi@ = ] [ 2drop f ] if ; M: vocab-link hashcode* vocab-link-name hashcode* ; diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor index dbd1f5131b..3ec8cb4245 100755 --- a/extra/benchmark/raytracer/raytracer.factor +++ b/extra/benchmark/raytracer/raytracer.factor @@ -133,7 +133,7 @@ DEFER: create ( level c r -- scene ) pick 1 = [ nip ] [ create-group ] if ; : ss-point ( dx dy -- point ) - [ oversampling /f ] 2apply 0.0 3float-array ; + [ oversampling /f ] bi@ 0.0 3float-array ; : ss-grid ( -- ss-grid ) oversampling [ oversampling [ ss-point ] with map ] map ; @@ -150,7 +150,7 @@ DEFER: create ( level c r -- scene ) : pixel-grid ( -- grid ) size reverse [ size [ - [ size 0.5 * - ] 2apply swap size + [ size 0.5 * - ] bi@ swap size 3float-array ] with map ] map ; diff --git a/extra/benchmark/reverse-complement/reverse-complement-tests.factor b/extra/benchmark/reverse-complement/reverse-complement-tests.factor index c8d4714802..c66de87cb5 100755 --- a/extra/benchmark/reverse-complement/reverse-complement-tests.factor +++ b/extra/benchmark/reverse-complement/reverse-complement-tests.factor @@ -5,7 +5,7 @@ io.files kernel ; [ "c071aa7e007a9770b2fb4304f55a17e5" ] [ "extra/benchmark/reverse-complement/reverse-complement-test-in.txt" "extra/benchmark/reverse-complement/reverse-complement-test-out.txt" - [ resource-path ] 2apply + [ resource-path ] bi@ reverse-complement "extra/benchmark/reverse-complement/reverse-complement-test-out.txt" diff --git a/extra/benchmark/spectral-norm/spectral-norm.factor b/extra/benchmark/spectral-norm/spectral-norm.factor index 42bae7d0d1..7eddeefc1b 100644 --- a/extra/benchmark/spectral-norm/spectral-norm.factor +++ b/extra/benchmark/spectral-norm/spectral-norm.factor @@ -7,7 +7,7 @@ IN: benchmark.spectral-norm : fast-truncate >fixnum >float ; inline : eval-A ( i j -- n ) - [ >float ] 2apply + [ >float ] bi@ dupd + dup 1+ * 2 /f fast-truncate + 1+ recip ; inline diff --git a/extra/bitfields/bitfields.factor b/extra/bitfields/bitfields.factor index 175f66f4a6..114809377b 100644 --- a/extra/bitfields/bitfields.factor +++ b/extra/bitfields/bitfields.factor @@ -63,7 +63,7 @@ M: check< summary drop "Number exceeds upper bound" ; [ range>accessor ] map ; : clear-range ( range -- num ) - first2 dupd + [ 2^ 1- ] 2apply bitnot bitor ; + first2 dupd + [ 2^ 1- ] bi@ bitnot bitor ; : range>setter ( range -- quot ) [ diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index efa7216699..4ea20629c1 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -80,7 +80,7 @@ VAR: separation-radius ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: relative-position ( self other -- v ) swap [ boid-pos ] 2apply v- ; +: relative-position ( self other -- v ) swap [ boid-pos ] bi@ v- ; : relative-angle ( self other -- angle ) over boid-vel -rot relative-position angle-between ; diff --git a/extra/builder/benchmark/benchmark.factor b/extra/builder/benchmark/benchmark.factor index 2f38462976..9e5e932831 100644 --- a/extra/builder/benchmark/benchmark.factor +++ b/extra/builder/benchmark/benchmark.factor @@ -19,11 +19,11 @@ IN: builder.benchmark 2array ; : compare-tables ( old new -- table ) - [ passing-benchmarks ] 2apply + [ passing-benchmarks ] bi@ [ benchmark-difference ] with map ; : benchmark-deltas ( -- table ) - "../benchmarks" "benchmarks" [ eval-file ] 2apply + "../benchmarks" "benchmarks" [ eval-file ] bi@ compare-tables sort-values ; diff --git a/extra/builder/util/util.factor b/extra/builder/util/util.factor index 55ff38d408..92b9af41ef 100644 --- a/extra/builder/util/util.factor +++ b/extra/builder/util/util.factor @@ -88,7 +88,7 @@ USING: bootstrap.image bootstrap.image.download io.streams.null ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: longer? ( seq seq -- ? ) [ length ] 2apply > ; +: longer? ( seq seq -- ? ) [ length ] bi@ > ; : maybe-tail* ( seq n -- seq ) 2dup longer? diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor index 0a808f53bd..6c29c0d1ac 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -185,7 +185,7 @@ M: number +second ( timestamp n -- timestamp ) [ month>> +month ] keep [ year>> +year ] keep ; inline -: +slots [ 2apply + ] curry 2keep ; inline +: +slots [ bi@ + ] curry 2keep ; inline PRIVATE> @@ -244,9 +244,9 @@ M: timestamp <=> ( ts1 ts2 -- n ) [ >gmt tuple-slots ] compare ; : (time-) ( timestamp timestamp -- n ) - [ >gmt ] 2apply - [ [ >date< julian-day-number ] 2apply - 86400 * ] 2keep - [ >time< >r >r 3600 * r> 60 * r> + + ] 2apply - + ; + [ >gmt ] bi@ + [ [ >date< julian-day-number ] bi@ - 86400 * ] 2keep + [ >time< >r >r 3600 * r> 60 * r> + + ] bi@ - + ; M: timestamp time- #! Exact calendar-time difference diff --git a/extra/calendar/format/format.factor b/extra/calendar/format/format.factor index b0bd7c464f..26ed873fd3 100755 --- a/extra/calendar/format/format.factor +++ b/extra/calendar/format/format.factor @@ -182,7 +182,7 @@ M: timestamp year. ( timestamp -- ) [ [ month>> month-abbreviations nth write ] keep bl [ day>> number>string 2 32 pad-left write ] keep bl - dup now [ year>> ] 2apply = [ + dup now [ year>> ] bi@ = [ [ hour>> write-00 ] keep ":" write minute>> write-00 ] [ diff --git a/extra/cocoa/dialogs/dialogs.factor b/extra/cocoa/dialogs/dialogs.factor index ea77c496a2..606526a240 100644 --- a/extra/cocoa/dialogs/dialogs.factor +++ b/extra/cocoa/dialogs/dialogs.factor @@ -26,7 +26,7 @@ IN: cocoa.dialogs [ -> filenames CF>string-array ] [ drop f ] if ; : split-path ( path -- dir file ) - "/" last-split1 [ ] 2apply ; + "/" last-split1 [ ] bi@ ; : save-panel ( path -- paths ) dup diff --git a/extra/crypto/rsa/rsa.factor b/extra/crypto/rsa/rsa.factor index ffb2a64b76..ccf17da4e8 100644 --- a/extra/crypto/rsa/rsa.factor +++ b/extra/crypto/rsa/rsa.factor @@ -24,7 +24,7 @@ C: rsa : modulus-phi ( numbits -- n phi ) #! Loop until phi is not divisible by the public key. dup rsa-primes [ * ] 2keep - [ 1- ] 2apply * + [ 1- ] bi@ * dup public-key gcd nip 1 = [ rot drop ] [ diff --git a/extra/crypto/sha1/sha1.factor b/extra/crypto/sha1/sha1.factor index af3671e7d9..8f3d3e6ecc 100755 --- a/extra/crypto/sha1/sha1.factor +++ b/extra/crypto/sha1/sha1.factor @@ -124,5 +124,5 @@ SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ; : byte-array>sha1-interleave ( string -- seq ) [ zero? ] left-trim dup length odd? [ 1 tail ] when - seq>2seq [ byte-array>sha1 ] 2apply + seq>2seq [ byte-array>sha1 ] bi@ swap 2seq>seq ; diff --git a/extra/documents/documents.factor b/extra/documents/documents.factor index 60ae592d4c..14f0dc41ac 100755 --- a/extra/documents/documents.factor +++ b/extra/documents/documents.factor @@ -12,7 +12,7 @@ IN: documents : =line ( n loc -- newloc ) second 2array ; -: lines-equal? ( loc1 loc2 -- ? ) [ first ] 2apply number= ; +: lines-equal? ( loc1 loc2 -- ? ) [ first ] bi@ number= ; TUPLE: document locs ; @@ -46,7 +46,7 @@ TUPLE: document locs ; 2over = [ 3drop ] [ - >r [ first ] 2apply 1+ dup r> each + >r [ first ] bi@ 1+ dup r> each ] if ; inline : start/end-on-line ( from to line# -- n1 n2 ) @@ -85,7 +85,7 @@ TUPLE: document locs ; : (set-doc-range) ( newlines from to lines -- ) [ prepare-insert ] 3keep - >r [ first ] 2apply 1+ r> + >r [ first ] bi@ 1+ r> replace-slice ; : set-doc-range ( string from to document -- ) diff --git a/extra/faq/faq.factor b/extra/faq/faq.factor index d7624466f7..c6d9cd04d2 100644 --- a/extra/faq/faq.factor +++ b/extra/faq/faq.factor @@ -91,7 +91,7 @@ C: faq : faq-sections, ( question-lists -- ) unclip question-list-seq length 1+ dupd [ question-list-seq length + ] accumulate nip - 0 -rot [ pick question-list>html [ , nl, ] 2apply 1+ ] 2each drop ; + 0 -rot [ pick question-list>html [ , nl, ] bi@ 1+ ] 2each drop ; : faq>html ( faq -- div ) "div" [ diff --git a/extra/fry/fry-docs.factor b/extra/fry/fry-docs.factor index 739e7d012c..84d02d529d 100755 --- a/extra/fry/fry-docs.factor +++ b/extra/fry/fry-docs.factor @@ -69,7 +69,7 @@ $nl { { $link curry } { $snippet ": curry '[ , @ ] ;" } } { { $link with } { $snippet ": with swapd '[ , _ @ ] ;" } } { { $link compose } { $snippet ": compose '[ @ @ ] ;" } } - { { $link 2apply } { $snippet ": 2apply tuck '[ , @ , @ ] call ;" } } + { { $link bi@ } { $snippet ": bi@ tuck '[ , @ , @ ] call ;" } } } ; ARTICLE: "fry.philosophy" "Fried quotation philosophy" diff --git a/extra/help/lint/lint.factor b/extra/help/lint/lint.factor index b65e44fda4..01e08473c6 100755 --- a/extra/help/lint/lint.factor +++ b/extra/help/lint/lint.factor @@ -59,7 +59,7 @@ IN: help.lint : check-see-also ( word element -- ) nip \ $see-also swap elements [ - 1 tail dup prune [ length ] 2apply assert= + 1 tail dup prune [ length ] bi@ assert= ] each ; : vocab-exists? ( name -- ? ) diff --git a/extra/http/http.factor b/extra/http/http.factor index 69c0ba2c9f..6ff4829b48 100755 --- a/extra/http/http.factor +++ b/extra/http/http.factor @@ -106,7 +106,7 @@ IN: http : query>assoc ( query -- assoc ) dup [ "&" split [ - "=" split1 [ dup [ url-decode ] when ] 2apply + "=" split1 [ dup [ url-decode ] when ] bi@ ] H{ } map>assoc ] when ; diff --git a/extra/icfp/2006/2006.factor b/extra/icfp/2006/2006.factor index 1740e8a523..e88301c7f8 100755 --- a/extra/icfp/2006/2006.factor +++ b/extra/icfp/2006/2006.factor @@ -51,14 +51,14 @@ SYMBOL: open-arrays : binary-op ( quot -- ? ) >r get-cba r> - swap >r >r [ reg-val ] 2apply swap r> call r> + swap >r >r [ reg-val ] bi@ swap r> call r> set-reg f ; inline : op1 ( opcode -- ? ) [ swap arr-val ] binary-op ; : op2 ( opcode -- ? ) - get-cba >r [ reg-val ] 2apply r> reg-val set-arr f ; + get-cba >r [ reg-val ] bi@ r> reg-val set-arr f ; : op3 ( opcode -- ? ) [ + >32bit ] binary-op ; diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index d524180471..1b7badd94a 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -151,10 +151,10 @@ MACRO: undo ( quot -- ) [undo] ; \ - [ + ] [ - ] define-math-inverse \ * [ / ] [ / ] define-math-inverse \ / [ * ] [ / ] define-math-inverse -\ ^ [ recip ^ ] [ [ log ] 2apply / ] define-math-inverse +\ ^ [ recip ^ ] [ [ log ] bi@ / ] define-math-inverse \ ? 2 [ - [ assert-literal ] 2apply + [ assert-literal ] bi@ [ swap >r over = r> swap [ 2drop f ] [ = [ t ] [ fail ] if ] if ] 2curry ] define-pop-inverse diff --git a/extra/io/encodings/utf16/utf16.factor b/extra/io/encodings/utf16/utf16.factor index e8ca04af35..fbc296e57c 100755 --- a/extra/io/encodings/utf16/utf16.factor +++ b/extra/io/encodings/utf16/utf16.factor @@ -78,7 +78,7 @@ M: utf16le decode-char swap BIN: 11111111 bitand ; : stream-write2 ( stream char1 char2 -- ) - rot [ stream-write1 ] curry 2apply ; + rot [ stream-write1 ] curry bi@ ; : char>utf16be ( stream char -- ) dup HEX: FFFF > [ diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index b345a98e88..85319ad8ef 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -161,5 +161,5 @@ TUPLE: datagram-port addr packet packet-addr ; : check-datagram-send ( packet addrspec port -- ) dup check-datagram-port - datagram-port-addr [ class ] 2apply assert= + datagram-port-addr [ class ] bi@ assert= class byte-array assert= ; diff --git a/extra/io/sockets/impl/impl.factor b/extra/io/sockets/impl/impl.factor index 77e8e098b1..8480fcd856 100755 --- a/extra/io/sockets/impl/impl.factor +++ b/extra/io/sockets/impl/impl.factor @@ -64,8 +64,8 @@ M: inet6 inet-ntop ( data addrspec -- str ) M: inet6 inet-pton ( str addrspec -- data ) drop "::" split1 - [ [ ":" split [ hex> dup 0 ? ] map ] [ f ] if* ] 2apply - 2dup [ length ] 2apply + 8 swap - 0 swap 3append + [ [ ":" split [ hex> dup 0 ? ] map ] [ f ] if* ] bi@ + 2dup [ length ] bi@ + 8 swap - 0 swap 3append [ 2 >be ] map concat >byte-array ; M: inet6 address-size drop 16 ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 3b493d2fe4..b0b0ba456a 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -49,7 +49,7 @@ M: unix-io touch-file ( path -- ) close ; M: unix-io move-file ( from to -- ) - [ normalize-pathname ] 2apply rename io-error ; + [ normalize-pathname ] bi@ rename io-error ; M: unix-io delete-file ( path -- ) normalize-pathname unlink io-error ; @@ -69,7 +69,7 @@ M: unix-io delete-directory ( path -- ) ] with-disposal ; M: unix-io copy-file ( from to -- ) - [ normalize-pathname ] 2apply + [ normalize-pathname ] bi@ [ (copy-file) ] [ swap file-info file-info-permissions chmod io-error ] 2bi ; diff --git a/extra/io/windows/ce/backend/backend.factor b/extra/io/windows/ce/backend/backend.factor index f51521dfcc..152e76a6c7 100755 --- a/extra/io/windows/ce/backend/backend.factor +++ b/extra/io/windows/ce/backend/backend.factor @@ -46,5 +46,5 @@ M: windows-ce-io (init-stdio) ( -- ) 1 _getstdfilex _fileno 2 _getstdfilex _fileno ] if [ f ] 3apply - rot -rot [ ] 2apply + rot -rot [ ] bi@ ] with-variable ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 64c4684e15..27917cedfa 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -135,14 +135,14 @@ M: windows-io (file-appender) ( path -- stream ) open-append ; M: windows-io move-file ( from to -- ) - [ normalize-pathname ] 2apply MoveFile win32-error=0/f ; + [ normalize-pathname ] bi@ MoveFile win32-error=0/f ; M: windows-io delete-file ( path -- ) normalize-pathname DeleteFile win32-error=0/f ; M: windows-io copy-file ( from to -- ) dup parent-directory make-directories - [ normalize-pathname ] 2apply 0 CopyFile win32-error=0/f ; + [ normalize-pathname ] bi@ 0 CopyFile win32-error=0/f ; M: windows-io make-directory ( path -- ) normalize-pathname diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 61fef7959c..7be406d37a 100755 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -72,7 +72,7 @@ TUPLE: segment number color radius ; : sub-tunnel ( from to sements -- segments ) #! return segments between from and to, after clamping from and to to #! valid values - [ sequence-index-range [ clamp-to-range ] curry 2apply ] keep ; + [ sequence-index-range [ clamp-to-range ] curry bi@ ] keep ; : nearer-segment ( segment segment oint -- segment ) #! return whichever of the two segments is nearer to the oint diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor index 71cbb1d951..f286690d37 100755 --- a/extra/koszul/koszul.factor +++ b/extra/koszul/koszul.factor @@ -57,7 +57,7 @@ SYMBOL: terms terms get [ [ swap +@ ] assoc-each ] bind ; : alt+ ( x y -- x+y ) - [ >alt ] 2apply [ (alt+) (alt+) ] with-terms ; + [ >alt ] bi@ [ (alt+) (alt+) ] with-terms ; ! Multiplication : alt*n ( vec n -- vec ) @@ -79,7 +79,7 @@ SYMBOL: terms ] curry each ; : duplicates? ( seq -- ? ) - dup prune [ length ] 2apply > ; + dup prune [ length ] bi@ > ; : (wedge) ( n basis1 basis2 -- n basis ) append dup duplicates? [ @@ -90,7 +90,7 @@ SYMBOL: terms ] if ; : wedge ( x y -- x.y ) - [ >alt ] 2apply [ + [ >alt ] bi@ [ swap [ [ 2swap [ @@ -200,7 +200,7 @@ DEFER: (d) ] with map ; : bigraded-betti ( u-generators z-generators -- seq ) - [ basis graded ] 2apply tensor bigraded-ker/im-d + [ basis graded ] bi@ tensor bigraded-ker/im-d [ [ [ first ] map ] map ] keep [ [ second ] map 2 head* { 0 0 } prepend ] map 1 tail dup first length 0 add @@ -278,7 +278,7 @@ DEFER: (d) ] with map ; : bigraded-laplacian ( u-generators z-generators quot -- seq ) - >r [ basis graded ] 2apply tensor bigraded-triples r> + >r [ basis graded ] bi@ tensor bigraded-triples r> [ [ first3 ] swap compose map ] curry map ; inline : bigraded-laplacian-betti ( u-generators z-generators -- seq ) diff --git a/extra/lazy-lists/lazy-lists.factor b/extra/lazy-lists/lazy-lists.factor index 07cd34b4df..52cca64b2f 100644 --- a/extra/lazy-lists/lazy-lists.factor +++ b/extra/lazy-lists/lazy-lists.factor @@ -52,7 +52,7 @@ M: cons nil? ( cons -- bool ) TUPLE: lazy-cons car cdr ; : lazy-cons ( car cdr -- promise ) - [ promise ] 2apply \ lazy-cons construct-boa + [ promise ] bi@ \ lazy-cons construct-boa T{ promise f f t f } clone [ set-promise-value ] keep ; diff --git a/extra/levenshtein/levenshtein.factor b/extra/levenshtein/levenshtein.factor index 07e16fb862..98b376593c 100644 --- a/extra/levenshtein/levenshtein.factor +++ b/extra/levenshtein/levenshtein.factor @@ -17,7 +17,7 @@ SYMBOL: d SYMBOL: costs : init-d ( str1 str2 -- ) - [ length 1+ ] 2apply 2dup d set + [ length 1+ ] bi@ 2dup d set [ 0 over ->d ] each [ dup 0 ->d ] each ; inline @@ -39,7 +39,7 @@ SYMBOL: costs [ 2dup init-d 2dup compute-costs - [ length ] 2apply [ + [ length ] bi@ [ [ levenshtein-step ] curry each ] with each levenshtein-result diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor index a220eece01..dcf52f723a 100644 --- a/extra/lint/lint.factor +++ b/extra/lint/lint.factor @@ -71,7 +71,7 @@ def-hash get-global [ ! Remove set-alien-cell, etc. [ - drop [ accessor-words swap seq-diff ] keep [ length ] 2apply = + drop [ accessor-words swap seq-diff ] keep [ length ] bi@ = ] assoc-subset ! Remove trivial defs @@ -148,7 +148,7 @@ GENERIC: run-lint ( obj -- obj ) : filter-symbols ( alist -- alist ) [ nip first dup def-hash get at - [ first ] 2apply literalize = not + [ first ] bi@ literalize = not ] assoc-subset ; M: sequence run-lint ( seq -- seq ) diff --git a/extra/match/match.factor b/extra/match/match.factor index fef925431d..2c6923a6ba 100755 --- a/extra/match/match.factor +++ b/extra/match/match.factor @@ -32,10 +32,10 @@ SYMBOL: _ { [ 2dup = ] [ 2drop t ] } { [ 2dup [ _ eq? ] either? ] [ 2drop t ] } { [ 2dup [ sequence? ] both? ] [ - 2dup [ length ] 2apply = + 2dup [ length ] bi@ = [ [ (match) ] 2all? ] [ 2drop f ] if ] } { [ 2dup [ tuple? ] both? ] - [ [ tuple>array ] 2apply [ (match) ] 2all? ] } + [ [ tuple>array ] bi@ [ (match) ] 2all? ] } { [ t ] [ 2drop f ] } } cond ; diff --git a/extra/math/complex/complex.factor b/extra/math/complex/complex.factor index 236d9df7a0..588f34d3fc 100755 --- a/extra/math/complex/complex.factor +++ b/extra/math/complex/complex.factor @@ -8,11 +8,11 @@ math.functions.private sequences parser ; M: real real-part ; M: real imaginary-part drop 0 ; -M: complex absq >rect [ sq ] 2apply + ; +M: complex absq >rect [ sq ] bi@ + ; : 2>rect ( x y -- xr yr xi yi ) - [ [ real-part ] 2apply ] 2keep - [ imaginary-part ] 2apply ; inline + [ [ real-part ] bi@ ] 2keep + [ imaginary-part ] bi@ ; inline M: complex number= 2>rect number= [ number= ] [ 2drop f ] if ; diff --git a/extra/math/functions/functions.factor b/extra/math/functions/functions.factor index 85e07fe73f..dcbccb4316 100755 --- a/extra/math/functions/functions.factor +++ b/extra/math/functions/functions.factor @@ -101,7 +101,7 @@ M: real absq sq ; >r - abs r> < ; : ~rel ( x y epsilon -- ? ) - >r [ - abs ] 2keep [ abs ] 2apply + r> * < ; + >r [ - abs ] 2keep [ abs ] bi@ + r> * < ; : ~ ( x y epsilon -- ? ) { @@ -124,7 +124,7 @@ M: real absq sq ; : arg ( z -- arg ) >float-rect swap fatan2 ; inline : >polar ( z -- abs arg ) - >float-rect [ [ sq ] 2apply + fsqrt ] 2keep swap fatan2 ; + >float-rect [ [ sq ] bi@ + fsqrt ] 2keep swap fatan2 ; inline : cis ( arg -- z ) dup fcos swap fsin rect> ; inline diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor index 000d97f2a6..d6ac71e629 100644 --- a/extra/math/polynomials/polynomials.factor +++ b/extra/math/polynomials/polynomials.factor @@ -13,10 +13,10 @@ IN: math.polynomials : p= ( p p -- ? ) pextend = ; @@ -24,7 +24,7 @@ PRIVATE> : ptrim ( p -- p ) dup singleton? [ [ zero? ] right-trim ] unless ; -: 2ptrim ( p p -- p p ) [ ptrim ] 2apply ; +: 2ptrim ( p p -- p p ) [ ptrim ] bi@ ; : p+ ( p p -- p ) pextend v+ ; : p- ( p p -- p ) pextend v- ; : n*p ( n p -- n*p ) n*v ; @@ -32,7 +32,7 @@ PRIVATE> ! convolution : pextend-conv ( p p -- p p ) #! extend to: p_m + p_n - 1 - 2dup [ length ] 2apply + 1- 2pad-right [ >vector ] 2apply ; + 2dup [ length ] bi@ + 1- 2pad-right [ >vector ] bi@ ; : p* ( p p -- p ) #! Multiply two polynomials. @@ -46,13 +46,13 @@ PRIVATE> : p/mod-setup ( p p -- p p n ) 2ptrim - 2dup [ length ] 2apply - + 2dup [ length ] bi@ - dup 1 < [ drop 1 ] when [ over length + 0 pad-left pextend ] keep 1+ ; : /-last ( seq seq -- a ) #! divide the last two numbers in the sequences - [ peek ] 2apply / ; + [ peek ] bi@ / ; : (p/mod) 2dup /-last @@ -74,7 +74,7 @@ PRIVATE> ] if ; : pgcd ( p p -- p q ) - swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) [ >array ] 2apply ; + swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) [ >array ] bi@ ; : pdiff ( p -- p' ) #! Polynomial derivative. diff --git a/extra/math/quaternions/quaternions.factor b/extra/math/quaternions/quaternions.factor index d61afd17c3..f121e4a0d1 100755 --- a/extra/math/quaternions/quaternions.factor +++ b/extra/math/quaternions/quaternions.factor @@ -14,7 +14,7 @@ IN: math.quaternions : ** conjugate * ; inline -: 2q ( u v -- u' u'' v' v'' ) [ first2 ] 2apply ; inline +: 2q ( u v -- u' u'' v' v'' ) [ first2 ] bi@ ; inline : q*a ( u v -- a ) 2q swapd ** >r * r> - ; inline diff --git a/extra/math/ratios/ratios.factor b/extra/math/ratios/ratios.factor index 5d07bd046f..3c430111ff 100755 --- a/extra/math/ratios/ratios.factor +++ b/extra/math/ratios/ratios.factor @@ -7,7 +7,7 @@ USING: kernel kernel.private math math.functions math.private ; dup numerator swap denominator ; inline : 2>fraction ( a/b c/d -- a c b d ) - [ >fraction ] 2apply swapd ; inline + [ >fraction ] bi@ swapd ; inline r /i r> fraction> ] if ; diff --git a/extra/math/statistics/statistics.factor b/extra/math/statistics/statistics.factor index 4c60363be0..f7295604cd 100644 --- a/extra/math/statistics/statistics.factor +++ b/extra/math/statistics/statistics.factor @@ -46,13 +46,13 @@ IN: math.statistics : ((r)) ( mean(x) mean(y) {x} {y} -- (r) ) ! finds sigma((xi-mean(x))(yi-mean(y)) - 0 [ [ >r pick r> swap - ] 2apply * + ] 2reduce 2nip ; + 0 [ [ >r pick r> swap - ] bi@ * + ] 2reduce 2nip ; : (r) ( mean(x) mean(y) {x} {y} sx sy -- r ) * recip >r [ ((r)) ] keep length 1- / r> * ; : [r] ( {{x,y}...} -- mean(x) mean(y) {x} {y} sx sy ) - first2 [ [ [ mean ] 2apply ] 2keep ] 2keep [ std ] 2apply ; + first2 [ [ [ mean ] bi@ ] 2keep ] 2keep [ std ] bi@ ; : r ( {{x,y}...} -- r ) [r] (r) ; diff --git a/extra/maze/maze.factor b/extra/maze/maze.factor index 14a493cec5..5d7bb9a1a2 100644 --- a/extra/maze/maze.factor +++ b/extra/maze/maze.factor @@ -22,7 +22,7 @@ SYMBOL: visited : random-neighbour ( cell -- newcell ) choices random ; : vertex ( pair -- ) - first2 [ 0.5 + line-width * ] 2apply glVertex2d ; + first2 [ 0.5 + line-width * ] bi@ glVertex2d ; : (draw-maze) ( cell -- ) dup vertex diff --git a/extra/money/money.factor b/extra/money/money.factor index 4058ee9e6a..4584daf592 100644 --- a/extra/money/money.factor +++ b/extra/money/money.factor @@ -23,9 +23,9 @@ TUPLE: not-a-decimal ; : parse-decimal ( str -- ratio ) "." split1 >r dup "-" head? [ drop t "0" ] [ f swap ] if r> - [ dup empty? [ drop "0" ] when ] 2apply + [ dup empty? [ drop "0" ] when ] bi@ dup length - >r [ string>number dup [ not-a-decimal ] unless ] 2apply r> + >r [ string>number dup [ not-a-decimal ] unless ] bi@ r> 10 swap ^ / + swap [ neg ] when ; : DECIMAL: diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index ed82d2478e..ac62fb08f9 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -113,7 +113,7 @@ TUPLE: no-method arguments generic ; ] curry assoc-map ; : sorted-methods ( alist -- alist' ) - [ [ first ] 2apply classes< ] topological-sort ; + [ [ first ] bi@ classes< ] topological-sort ; : niceify-method [ dup \ f eq? [ drop f ] when ] map ; diff --git a/extra/opengl/demo-support/demo-support.factor b/extra/opengl/demo-support/demo-support.factor index 61d3be0e15..84515305c8 100755 --- a/extra/opengl/demo-support/demo-support.factor +++ b/extra/opengl/demo-support/demo-support.factor @@ -38,7 +38,7 @@ M: demo-gadget pref-dim* ( gadget -- dim ) : demo-gadget-frustum ( -- -x x -y y near far ) FOV-RATIO NEAR-PLANE FOV / v*n - first2 [ -+ ] 2apply NEAR-PLANE FAR-PLANE ; + first2 [ -+ ] bi@ NEAR-PLANE FAR-PLANE ; : demo-gadget-set-matrices ( gadget -- ) GL_PROJECTION glMatrixMode diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index 08e3cb204b..36d24e1300 100755 --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -8,9 +8,9 @@ math.parser opengl.gl opengl.glu combinators arrays sequences splitting words byte-arrays assocs combinators.lib ; IN: opengl -: coordinates [ first2 ] 2apply ; +: coordinates [ first2 ] bi@ ; -: fix-coordinates [ first2 [ >fixnum ] 2apply ] 2apply ; +: fix-coordinates [ first2 [ >fixnum ] bi@ ] bi@ ; : gl-color ( color -- ) first4 glColor4d ; inline @@ -85,7 +85,7 @@ MACRO: all-enabled-client-state ( seq quot -- ) : unit-circle dup [ sin ] map swap [ cos ] map ; -: adjust-points [ [ 1 + 0.5 * ] map ] 2apply ; +: adjust-points [ [ 1 + 0.5 * ] map ] bi@ ; : scale-points 2array flip [ v* ] with map [ v+ ] with map ; diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor index bf06708e09..d6aacf9645 100755 --- a/extra/parser-combinators/parser-combinators.factor +++ b/extra/parser-combinators/parser-combinators.factor @@ -35,7 +35,7 @@ C: parse-result ] if ; : string= ( str1 str2 ignore-case -- ? ) - [ [ >upper ] 2apply ] when sequence= ; + [ [ >upper ] bi@ ] when sequence= ; : string-head? ( str head ignore-case -- ? ) 2over shorter? [ @@ -327,7 +327,7 @@ LAZY: <(+)> ( parser -- parser ) nonempty-list-of { } succeed <|> ; LAZY: surrounded-by ( parser start end -- parser' ) - [ token ] 2apply swapd pack ; + [ token ] bi@ swapd pack ; : exactly-n ( parser n -- parser' ) swap [ flatten ] <@ ; diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor index 7a82418c27..49035ea43c 100755 --- a/extra/peg/parsers/parsers.factor +++ b/extra/peg/parsers/parsers.factor @@ -70,7 +70,7 @@ MEMO: pack ( begin body end -- parser ) >r >r hide r> r> hide 3seq [ first ] action ; : surrounded-by ( parser begin end -- parser' ) - [ token ] 2apply swapd pack ; + [ token ] bi@ swapd pack ; : 'digit' ( -- parser ) [ digit? ] satisfy [ digit> ] action ; diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 247a64eac2..d6d573da79 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -11,7 +11,7 @@ USE: prettyprint TUPLE: parse-result remaining ast ; TUPLE: parser id compiled ; -M: parser equal? [ id>> ] 2apply = ; +M: parser equal? [ id>> ] bi@ = ; C: parser SYMBOL: ignore diff --git a/extra/project-euler/009/009.factor b/extra/project-euler/009/009.factor index f09643d290..690fed9012 100644 --- a/extra/project-euler/009/009.factor +++ b/extra/project-euler/009/009.factor @@ -31,7 +31,7 @@ IN: project-euler.009 : abc ( p q -- triplet ) [ 2dup * , ! a = p * q - [ sq ] 2apply 2dup - 2 / , ! b = (p² - q²) / 2 + [ sq ] bi@ 2dup - 2 / , ! b = (p² - q²) / 2 + 2 / , ! c = (p² + q²) / 2 ] { } make natural-sort ; diff --git a/extra/project-euler/014/014.factor b/extra/project-euler/014/014.factor index 02c5dbb9d3..32b1aa5549 100644 --- a/extra/project-euler/014/014.factor +++ b/extra/project-euler/014/014.factor @@ -39,7 +39,7 @@ IN: project-euler.014 dup even? [ 2 / ] [ 3 * 1+ ] if ; : longest ( seq seq -- seq ) - 2dup [ length ] 2apply > [ drop ] [ nip ] if ; + 2dup [ length ] bi@ > [ drop ] [ nip ] if ; PRIVATE> diff --git a/extra/project-euler/026/026.factor b/extra/project-euler/026/026.factor index 3ad1908aa6..f1f546ec1c 100644 --- a/extra/project-euler/026/026.factor +++ b/extra/project-euler/026/026.factor @@ -58,7 +58,7 @@ PRIVATE> : max-period ( seq -- elt n ) dup [ period-length ] map dup supremum - over index [ swap nth ] curry 2apply ; + over index [ swap nth ] curry bi@ ; PRIVATE> diff --git a/extra/project-euler/027/027.factor b/extra/project-euler/027/027.factor index 2bc7894684..2d99204bf3 100644 --- a/extra/project-euler/027/027.factor +++ b/extra/project-euler/027/027.factor @@ -60,7 +60,7 @@ IN: project-euler.027 : max-consecutive ( seq -- elt n ) dup [ first2 consecutive-primes ] map dup supremum - over index [ swap nth ] curry 2apply ; + over index [ swap nth ] curry bi@ ; PRIVATE> diff --git a/extra/project-euler/033/033.factor b/extra/project-euler/033/033.factor index 6f29c3519e..35b1c87e7a 100644 --- a/extra/project-euler/033/033.factor +++ b/extra/project-euler/033/033.factor @@ -33,10 +33,10 @@ IN: project-euler.033 10 99 [a,b] dup cartesian-product [ first2 < ] subset ; : safe? ( ax xb -- ? ) - [ 10 /mod ] 2apply -roll = rot zero? not and nip ; + [ 10 /mod ] bi@ -roll = rot zero? not and nip ; : ax/xb ( ax xb -- z/f ) - 2dup safe? [ [ 10 /mod ] 2apply 2nip / ] [ 2drop f ] if ; + 2dup safe? [ [ 10 /mod ] bi@ 2nip / ] [ 2drop f ] if ; : curious? ( m n -- ? ) 2dup / [ ax/xb ] dip = ; diff --git a/extra/project-euler/044/044.factor b/extra/project-euler/044/044.factor index 62e516e4b0..bc8aec8bde 100644 --- a/extra/project-euler/044/044.factor +++ b/extra/project-euler/044/044.factor @@ -31,7 +31,7 @@ IN: project-euler.044 dup 3 * 1- * 2 / ; : sum-and-diff? ( m n -- ? ) - 2dup + -rot - [ pentagonal? ] 2apply and ; + 2dup + -rot - [ pentagonal? ] bi@ and ; PRIVATE> diff --git a/extra/project-euler/079/079.factor b/extra/project-euler/079/079.factor index 30c46de0a0..b4cbd6dbcb 100644 --- a/extra/project-euler/079/079.factor +++ b/extra/project-euler/079/079.factor @@ -35,7 +35,7 @@ IN: project-euler.079 ] { } make ; : find-source ( seq -- elt ) - dup values swap keys [ prune ] 2apply seq-diff + dup values swap keys [ prune ] bi@ seq-diff dup empty? [ "Topological sort failed" throw ] [ first ] if ; : remove-source ( seq elt -- seq ) diff --git a/extra/random-tester/random/random.factor b/extra/random-tester/random/random.factor index 163de69a59..11f2e60d1a 100755 --- a/extra/random-tester/random/random.factor +++ b/extra/random-tester/random/random.factor @@ -54,7 +54,7 @@ IN: random-tester ] if ; : random-ratio ( -- ratio ) - 1000000000 dup [ random ] 2apply 1+ / 50% [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ; + 1000000000 dup [ random ] bi@ 1+ / 50% [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ; : random-float ( -- float ) 50% [ random-ratio ] [ special-floats get random ] if diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor index b57724d1db..fa36a7c6f8 100755 --- a/extra/regexp/regexp.factor +++ b/extra/regexp/regexp.factor @@ -16,7 +16,7 @@ SYMBOL: ignore-case? : char-between?-quot ( ch1 ch2 -- quot ) ignore-case? get - [ [ ch>upper ] 2apply [ >r >r ch>upper r> r> between? ] ] + [ [ ch>upper ] bi@ [ >r >r ch>upper r> r> between? ] ] [ [ between? ] ] if 2curry ; diff --git a/extra/regexp2/regexp2.factor b/extra/regexp2/regexp2.factor index e62eb76cb1..1f2bbde171 100644 --- a/extra/regexp2/regexp2.factor +++ b/extra/regexp2/regexp2.factor @@ -16,7 +16,7 @@ SYMBOL: ignore-case? : char-between?-quot ( ch1 ch2 -- quot ) ignore-case? get - [ [ ch>upper ] 2apply [ >r >r ch>upper r> r> between? ] ] + [ [ ch>upper ] bi@ [ >r >r ch>upper r> r> between? ] ] [ [ between? ] ] if 2curry ; diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor index 2614a774dd..7e9496c90d 100755 --- a/extra/reports/noise/noise.factor +++ b/extra/reports/noise/noise.factor @@ -9,7 +9,7 @@ IN: reports.noise { -nrot 5 } { -roll 4 } { -rot 3 } - { 2apply 1 } + { bi@ 1 } { 2curry 1 } { 2drop 1 } { 2dup 1 } diff --git a/extra/roman/roman.factor b/extra/roman/roman.factor index 7466883c5f..a3e61dd889 100644 --- a/extra/roman/roman.factor +++ b/extra/roman/roman.factor @@ -23,7 +23,7 @@ TUPLE: roman-range-error n ; ] if ; : roman<= ( ch1 ch2 -- ? ) - [ 1string roman-digits index ] 2apply >= ; + [ 1string roman-digits index ] bi@ >= ; : roman>n ( ch -- n ) 1string roman-digits index roman-values nth ; @@ -57,7 +57,7 @@ PRIVATE> ( str1 str2 -- m n ) - [ roman> ] 2apply ; + [ roman> ] bi@ ; : binary-roman-op ( str1 str2 quot -- str3 ) >r 2roman> r> call >roman ; inline diff --git a/extra/semantic-db/semantic-db-tests.factor b/extra/semantic-db/semantic-db-tests.factor index 257133c67f..c523053740 100644 --- a/extra/semantic-db/semantic-db-tests.factor +++ b/extra/semantic-db/semantic-db-tests.factor @@ -60,7 +60,7 @@ test-db [ "charlie" create-node* "charlie" set "gertrude" create-node* "gertrude" set [ t ] [ "adam" get "bob" get parent-child* integer? ] unit-test - { { "eve" "bob" } { "eve" "fran" } { "bob" "gertrude" } { "bob" "fran" } { "fran" "charlie" } } [ first2 [ get ] 2apply parent-child ] each + { { "eve" "bob" } { "eve" "fran" } { "bob" "gertrude" } { "bob" "fran" } { "fran" "charlie" } } [ first2 [ get ] bi@ parent-child ] each [ { "bob" "fran" } ] [ "eve" get children [ node-content ] map ] unit-test [ { "adam" "eve" } ] [ "bob" get parents [ node-content ] map ] unit-test [ "fran" { "charlie" } ] [ "fran" get get-node-hierarchy dup tree-id node-content swap tree-children [ tree-id node-content ] map ] unit-test diff --git a/extra/serialize/serialize.factor b/extra/serialize/serialize.factor index 2865b1fd6c..ac247057f4 100755 --- a/extra/serialize/serialize.factor +++ b/extra/serialize/serialize.factor @@ -24,7 +24,7 @@ C: id M: id hashcode* obj>> hashcode* ; -M: id equal? over id? [ [ obj>> ] 2apply eq? ] [ 2drop f ] if ; +M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ; : add-object ( obj -- ) #! Add an object to the sequence of already serialized diff --git a/extra/shufflers/shufflers.factor b/extra/shufflers/shufflers.factor index 172db1def1..b11668a53e 100644 --- a/extra/shufflers/shufflers.factor +++ b/extra/shufflers/shufflers.factor @@ -20,7 +20,7 @@ IN: shufflers : put-effect ( word -- ) dup word-name "-" split1 - [ >array [ 1string ] map ] 2apply + [ >array [ 1string ] map ] bi@ "declared-effect" set-word-prop ; : in-shuffle ( -- ) in get ".shuffle" append set-in ; diff --git a/extra/sudoku/sudoku.factor b/extra/sudoku/sudoku.factor index db5fb75617..764c4d92f0 100644 --- a/extra/sudoku/sudoku.factor +++ b/extra/sudoku/sudoku.factor @@ -18,7 +18,7 @@ SYMBOL: board : cell-contains? ( n x y i -- ? ) 3 /mod pair+ board> = ; : box-contains? ( n x y -- ? ) - [ 3 /i 3 * ] 2apply + [ 3 /i 3 * ] bi@ 9 [ >r 3dup r> cell-contains? ] contains? >r 3drop r> ; diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index d1c4b148a5..99af06b80f 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -35,7 +35,7 @@ linkname magic version uname gname devmajor devminor prefix ; : header-checksum ( seq -- x ) 148 cut-slice 8 tail-slice - [ sum ] 2apply + 256 + ; + [ sum ] bi@ + 256 + ; TUPLE: checksum-error ; TUPLE: malformed-block-error ; diff --git a/extra/tools/completion/completion.factor b/extra/tools/completion/completion.factor index e44c3c401e..16bde2100f 100755 --- a/extra/tools/completion/completion.factor +++ b/extra/tools/completion/completion.factor @@ -40,7 +40,7 @@ unicode.categories ; : score ( full fuzzy -- n ) dup [ - [ [ length ] 2apply - 15 swap [-] 3 /f ] 2keep + [ [ length ] bi@ - 15 swap [-] 3 /f ] 2keep runs [ [ 0 [ pick score-1 max ] reduce nip ] keep length * + @@ -57,7 +57,7 @@ unicode.categories ; : complete ( full short -- score ) [ dupd fuzzy score ] 2keep - [ ] 2apply + [ ] bi@ dupd fuzzy score max ; : completion ( short candidate -- result ) diff --git a/extra/tools/deploy/shaker/strip-cocoa.factor b/extra/tools/deploy/shaker/strip-cocoa.factor index b37e42f323..de8f8740f0 100755 --- a/extra/tools/deploy/shaker/strip-cocoa.factor +++ b/extra/tools/deploy/shaker/strip-cocoa.factor @@ -14,7 +14,7 @@ global [ sent-messages get super-sent-messages get - [ keys [ objc-methods get at dup ] H{ } map>assoc ] 2apply + [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@ super-message-senders [ intersect ] change message-senders [ intersect ] change diff --git a/extra/ui/gadgets/borders/borders.factor b/extra/ui/gadgets/borders/borders.factor index e58ba343c7..6b548aaf68 100644 --- a/extra/ui/gadgets/borders/borders.factor +++ b/extra/ui/gadgets/borders/borders.factor @@ -24,7 +24,7 @@ M: border pref-dim* ; : scale-rect ( rect vec -- loc dim ) - [ v* ] curry >r rect-bounds r> 2apply ; + [ v* ] curry >r rect-bounds r> bi@ ; : average-rects ( rect1 rect2 weight -- rect ) tuck >r >r scale-rect r> r> { 1 1 } swap v- scale-rect diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor index def6b99b05..b3ecad6aed 100755 --- a/extra/ui/gadgets/editors/editors.factor +++ b/extra/ui/gadgets/editors/editors.factor @@ -135,7 +135,7 @@ M: editor ungraft* dup editor-caret-color gl-color dup caret-loc origin get v+ swap caret-dim over v+ - [ { 0.5 -0.5 } v+ ] 2apply gl-line + [ { 0.5 -0.5 } v+ ] bi@ gl-line ] when ; : line-translation ( n -- loc ) diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index 267f6f0f0f..ddcaa4b979 100755 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -22,7 +22,7 @@ M: array rect-dim drop { 0 0 } ; : rect-extent ( rect -- loc ext ) rect-bounds over v+ ; : 2rect-extent ( rect rect -- loc1 loc2 ext1 ext2 ) - [ rect-extent ] 2apply swapd ; + [ rect-extent ] bi@ swapd ; : ( loc ext -- rect ) over [v-] ; diff --git a/extra/ui/gadgets/grids/grids-tests.factor b/extra/ui/gadgets/grids/grids-tests.factor index 0792d55135..f20275ff25 100644 --- a/extra/ui/gadgets/grids/grids-tests.factor +++ b/extra/ui/gadgets/grids/grids-tests.factor @@ -25,13 +25,13 @@ IN: ui.gadgets.grids.tests [ { 100 200 } ] [ 100x100 100x100 - [ 1array ] 2apply 2array pref-dim + [ 1array ] bi@ 2array pref-dim ] unit-test [ ] [ 100x100 100x100 - [ 1array ] 2apply 2array layout + [ 1array ] bi@ 2array layout ] unit-test [ { 230 120 } { 100 100 } { 100 100 } ] [ diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor index 99bd1be876..d4a1895894 100755 --- a/extra/ui/gadgets/scrollers/scrollers.factor +++ b/extra/ui/gadgets/scrollers/scrollers.factor @@ -57,7 +57,7 @@ scroller H{ 2dup control-value = [ 2drop ] [ set-control-value ] if ; : rect-min ( rect1 rect2 -- rect ) - >r [ rect-loc ] keep r> [ rect-dim ] 2apply vmin ; + >r [ rect-loc ] keep r> [ rect-dim ] bi@ vmin ; : (scroll>rect) ( rect scroller -- ) [ diff --git a/extra/unicode/breaks/breaks.factor b/extra/unicode/breaks/breaks.factor index dfc7bf2264..4c8c6491ca 100644 --- a/extra/unicode/breaks/breaks.factor +++ b/extra/unicode/breaks/breaks.factor @@ -26,7 +26,7 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ; : process-other-extend ( lines -- set ) [ "#" split1 drop ";" split1 drop trim-blank ] map [ empty? not ] subset - [ ".." split1 [ dup ] unless* [ hex> ] 2apply [a,b] ] map + [ ".." split1 [ dup ] unless* [ hex> ] bi@ [a,b] ] map concat >set ; : other-extend-lines ( -- lines ) @@ -83,7 +83,7 @@ VALUE: grapheme-table grapheme-table nth nth not ; : chars ( i str n -- str[i] str[i+n] ) - swap >r dupd + r> [ ?nth ] curry 2apply ; + swap >r dupd + r> [ ?nth ] curry bi@ ; : find-index ( seq quot -- i ) find drop ; inline : find-last-index ( seq quot -- i ) find-last drop ; inline diff --git a/extra/unicode/case/case.factor b/extra/unicode/case/case.factor index 8129ec17f8..092a247204 100755 --- a/extra/unicode/case/case.factor +++ b/extra/unicode/case/case.factor @@ -100,7 +100,7 @@ SYMBOL: locale ! Just casing locale, or overall? >upper >lower ; : insensitive= ( str1 str2 -- ? ) - [ >case-fold ] 2apply = ; + [ >case-fold ] bi@ = ; : lower? ( string -- ? ) dup >lower = ; diff --git a/extra/unicode/normalize/normalize.factor b/extra/unicode/normalize/normalize.factor index 47637e8330..d62beb1a2c 100644 --- a/extra/unicode/normalize/normalize.factor +++ b/extra/unicode/normalize/normalize.factor @@ -38,7 +38,7 @@ IN: unicode.normalize : (insert) ( seq n quot -- ) over 0 = [ 3drop ] [ - [ >r dup 1- rot [ nth ] curry 2apply r> 2apply > ] 3keep + [ >r dup 1- rot [ nth ] curry bi@ r> bi@ > ] 3keep roll [ 3drop ] [ >r [ dup 1- rot exchange ] 2keep 1- r> (insert) ] if ] if ; inline diff --git a/extra/units/units.factor b/extra/units/units.factor index b92cbb659a..cf53ceaee3 100755 --- a/extra/units/units.factor +++ b/extra/units/units.factor @@ -16,7 +16,7 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ; 1array split1 append ; : 2remove-one ( seq seq obj -- seq seq ) - [ remove-one ] curry 2apply ; + [ remove-one ] curry bi@ ; : symbolic-reduce ( seq seq -- seq seq ) 2dup seq-intersect dup empty? @@ -24,7 +24,7 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ; : ( n top bot -- obj ) symbolic-reduce - [ natural-sort ] 2apply + [ natural-sort ] bi@ dimensioned construct-boa ; : >dimensioned< ( d -- n top bot ) @@ -37,10 +37,10 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ; { dimensioned-top dimensioned-bot } get-slots ; : check-dimensions ( d d -- ) - [ dimensions 2array ] 2apply = + [ dimensions 2array ] bi@ = [ dimensions-not-equal ] unless ; -: 2values [ dimensioned-value ] 2apply ; +: 2values [ dimensioned-value ] bi@ ; : ; : d* ( d d -- d ) - [ dup number? [ scalar ] when ] 2apply - [ [ dimensioned-top ] 2apply append ] 2keep - [ [ dimensioned-bot ] 2apply append ] 2keep + [ dup number? [ scalar ] when ] bi@ + [ [ dimensioned-top ] bi@ append ] 2keep + [ [ dimensioned-bot ] bi@ append ] 2keep 2values * dimension-op> ; : d-neg ( d -- d ) -1 d* ; diff --git a/extra/xmode/catalog/catalog.factor b/extra/xmode/catalog/catalog.factor index c7eaafe887..822b290f88 100755 --- a/extra/xmode/catalog/catalog.factor +++ b/extra/xmode/catalog/catalog.factor @@ -63,7 +63,7 @@ SYMBOL: rule-sets over [ dupd update ] [ nip clone ] if ; : import-keywords ( parent child -- ) - over >r [ rule-set-keywords ] 2apply ?update + over >r [ rule-set-keywords ] bi@ ?update r> set-rule-set-keywords ; : import-rules ( parent child -- ) From 48501f1f6e1ef064ff0f494e38b46f48266a8ab4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 23:11:45 -0500 Subject: [PATCH 178/219] Documentation fixes --- core/combinators/combinators-docs.factor | 40 +++- core/hashtables/hashtables-docs.factor | 18 +- core/kernel/kernel-docs.factor | 283 ++++++++++++++++++++--- core/kernel/kernel.factor | 24 +- extra/help/handbook/handbook.factor | 11 - 5 files changed, 322 insertions(+), 54 deletions(-) diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor index f5d4470bde..b088979b4e 100755 --- a/core/combinators/combinators-docs.factor +++ b/core/combinators/combinators-docs.factor @@ -10,18 +10,54 @@ ARTICLE: "combinators-quot" "Quotation construction utilities" { $subsection alist>quot } ; ARTICLE: "combinators" "Additional combinators" -"The " { $vocab-link "combinators" } " vocabulary is usually used because it provides two combinators which abstract out nested chains of " { $link if } ":" +"The " { $vocab-link "combinators" } " vocabulary provides generalizations of certain combinators from the " { $vocab-link "kernel" } " vocabulary." +$nl +"Generalization of " { $link bi } " and " { $link tri } ":" +{ $subsection cleave } +"Generalization of " { $link bi* } " and " { $link tri* } ":" +{ $subsection spread } +"Two combinators which abstract out nested chains of " { $link if } ":" { $subsection cond } { $subsection case } +"The " { $vocab-link "combinators" } " also provides some less frequently-used features." +$nl "A combinator which can help with implementing methods on " { $link hashcode* } ":" { $subsection recursive-hashcode } "An oddball combinator:" { $subsection with-datastack } { $subsection "combinators-quot" } -{ $see-also "quotations" "basic-combinators" } ; +{ $see-also "quotations" "dataflow" } ; ABOUT: "combinators" +HELP: cleave +{ $values { "x" object } { "seq" "a sequence of quotations with stack effect " { $snippet "( x -- ... )" } } } +{ $description "Applies each quotation to the object in turn." } +{ $examples + "The " { $link bi } " combinator takes one value and two quotations; the " { $link tri } " combinator takes one value and three quotations. The " { $link cleave } " combinator takes one value and any number of quotations, and is essentially equivalent to a chain of " { $link keep } " forms:" + { $code + "! Equivalent" + "{ [ p ] [ q ] [ r ] [ s ] } cleave" + "[ p ] keep [ q ] keep [ r ] keep s" + } +} ; + +{ bi tri cleave } related-words + +HELP: spread +{ $values { "obj..." "objects" } { "seq" "a sequence of quotations with stack effect " { $snippet "( x -- ... )" } } } +{ $description "Applies each quotation to the object in turn." } +{ $examples + "The " { $link bi* } " combinator takes two values and two quotations; the " { $link tri* } " combinator takes three values and three quotations. The " { $link spread } " combinator takes " { $snippet "n" } " values and " { $snippet "n" } " quotations, where " { $snippet "n" } " is the length of the input sequence, and is essentially equivalent to series of retain stack manipulations:" + { $code + "! Equivalent" + "{ [ p ] [ q ] [ r ] [ s ] } spread" + ">r >r >r p r> q r> r r> s" + } +} ; + +{ bi* tri* spread } related-words + HELP: alist>quot { $values { "default" "a quotation" } { "assoc" "a sequence of quotation pairs" } { "quot" "a new quotation" } } { $description "Constructs a quotation which calls the first quotation in each pair of " { $snippet "assoc" } " until one of them outputs a true value, and then calls the second quotation in the corresponding pair. Quotations are called in reverse order, and if no quotation outputs a true value then " { $snippet "default" } " is called." } diff --git a/core/hashtables/hashtables-docs.factor b/core/hashtables/hashtables-docs.factor index d62afdffb5..2a4be9c570 100755 --- a/core/hashtables/hashtables-docs.factor +++ b/core/hashtables/hashtables-docs.factor @@ -32,14 +32,28 @@ $nl { $code "H{ } clone" } "To convert an assoc to a hashtable:" { $subsection >hashtable } +"Further topics:" +{ $subsection "hashtables.keys" } +{ $subsection "hashtables.utilities" } +{ $subsection "hashtables.private" } ; + +ARTICLE: "hashtables.keys" "Hashtable keys" +"Hashtables rely on the " { $link hashcode } " word to rapidly locate values associated with keys. The objects used as keys in a hashtable must obey certain restrictions." +$nl +"The " { $link hashcode } " of a key is a function of the its slot values, and if the hashcode changes then the hashtable will be left in an inconsistent state. The easiest way to avoid this problem is to never mutate objects used as hashtable keys." +$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." ; + +ARTICLE: "hashtables.utilities" "Hashtable utilities" "Utility words to create a new hashtable from a single key/value pair:" { $subsection associate } { $subsection ?set-at } "The final two words pertain to sequences but use a hashtable internally. Removing duplicate elements from a sequence in linear time, using a hashtable:" { $subsection prune } "Test if a sequence contains duplicates in linear time:" -{ $subsection all-unique? } -{ $subsection "hashtables.private" } ; +{ $subsection all-unique? } ; ABOUT: "hashtables" diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 457313724c..587839f685 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -43,29 +43,86 @@ $nl "An alternative to using " { $link >r } " and " { $link r> } " is the following:" { $subsection dip } ; -ARTICLE: "basic-combinators" "Basic combinators" -"The following pair of words invoke words and quotations reflectively:" -{ $subsection call } -{ $subsection execute } -"These words are used to implement " { $emphasis "combinators" } ", which are words that take code from the stack. Note that combinator definitions must be followed by the " { $link POSTPONE: inline } " declaration in order to compile in the optimizing compiler; for example:" -{ $code - ": keep ( x quot -- x )" - " over >r call r> ; inline" -} -"Word inlining is documented in " { $link "declarations" } "." +ARTICLE: "cleave-combinators" "Cleave combinators" +"The cleave combinators apply multiple quotations to a single value." $nl -"There are some words that combine shuffle words with " { $link call } ". They are useful for implementing higher-level combinators." -{ $subsection slip } -{ $subsection 2slip } -{ $subsection keep } -{ $subsection 2keep } -{ $subsection 3keep } +"Two quotations:" +{ $subsection bi } +{ $subsection 2bi } +"Three quotations:" +{ $subsection tri } +{ $subsection 2tri } +"Technically, the cleave combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on the top of the stack can be written in one of two ways:" +{ $code + "! First alternative; uses keep" + "[ 1 + ] keep" + "[ 1 - ] keep" + "2 *" + "! Second alternative: uses tri" + "[ 1 + ]" + "[ 1 - ]" + "[ 2 * ] tri" +} +"The latter is more aesthetically pleasing than the former." +$nl +"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "." +$nl +"From the Merriam-Webster Dictionary: " +$nl +{ $strong "cleave" } +{ $list + { $emphasis "To divide by or as if by a cutting blow" } + { $emphasis "To separate into distinct parts and especially into groups having divergent views" } +} ; + +ARTICLE: "spread-combinators" "Spread combinators" +"The spread combinators apply multiple quotations to multiple values. The " { $snippet "*" } " suffix signifies spreading." +$nl +"Two quotations:" +{ $subsection bi* } +{ $subsection 2bi* } +"Three quotations:" +{ $subsection tri* } +"Technically, the spread combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on three related values can be written in one of two ways:" +{ $code + "! First alternative; uses retain stack explicitly" + ">r >r 1 +" + "r> 1 -" + "r> 2 *" + "! Second alternative: uses tri*" + "[ 1 + ]" + "[ 1 - ]" + "[ 2 * ] tri*" +} + +$nl +"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "." ; + +ARTICLE: "apply-combinators" "Apply combinators" +"The apply combinators apply multiple quotations to multiple values. The " { $snippet "@" } " suffix signifies application." +$nl +"Two quotations:" { $subsection bi@ } +{ $subsection 2bi@ } +"Three quotations:" +{ $subsection tri@ } "A pair of utility words built from " { $link bi@ } ":" { $subsection both? } -{ $subsection either? } -"A looping combinator:" -{ $subsection while } +{ $subsection either? } ; + +ARTICLE: "slip-keep-combinators" "The slip and keep combinators" +"The slip combinators invoke a quotation further down on the stack. They are most useful for implementing other combinators:" +{ $subsection slip } +{ $subsection 2slip } +{ $subsection 3slip } +"The dip combinator invokes the quotation at the top of the stack, hiding the value underneath:" +{ $subsection dip } +"The keep combinators invoke a quotation which takes a number of values off the stack, and then they restore those values:" +{ $subsection keep } +{ $subsection 2keep } +{ $subsection 3keep } ; + +ARTICLE: "compositional-combinators" "Compositional combinators" "Quotations can be composed using efficient quotation-specific operations:" { $subsection curry } { $subsection 2curry } @@ -73,8 +130,21 @@ $nl { $subsection with } { $subsection compose } { $subsection 3compose } -"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } "." -{ $see-also "combinators" } ; +"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } "." ; + +ARTICLE: "implementing-combinators" "Implementing combinators" +"The following pair of words invoke words and quotations reflectively:" +{ $subsection call } +{ $subsection execute } +"These words are used to implement combinators. Note that combinator definitions must be followed by the " { $link POSTPONE: inline } " declaration in order to compile in the optimizing compiler; for example:" +{ $code + ": keep ( x quot -- x )" + " over >r call r> ; inline" +} +"Word inlining is documented in " { $link "declarations" } "." +$nl +"A looping combinator:" +{ $subsection while } ; ARTICLE: "booleans" "Booleans" "In Factor, any object that is not " { $link f } " has a true value, and " { $link f } " has a false value. The " { $link t } " object is the canonical true value." @@ -115,15 +185,13 @@ ARTICLE: "conditionals" "Conditionals and logic" { $subsection ?if } "Sometimes instead of branching, you just need to pick one of two values:" { $subsection ? } -"Forms which abstract away common patterns involving multiple nested branches:" -{ $subsection cond } -{ $subsection case } "There are some logical operations on booleans:" { $subsection >boolean } { $subsection not } { $subsection and } { $subsection or } { $subsection xor } +"See " { $link "combinators" } " for forms which abstract away common patterns involving multiple nested branches." { $see-also "booleans" "bitwise-arithmetic" both? either? } ; ARTICLE: "equality" "Equality and comparison testing" @@ -146,7 +214,23 @@ $nl "An object can be cloned; the clone has distinct identity but equal value:" { $subsection clone } ; -! Defined in handbook.factor +ARTICLE: "dataflow" "Data and control flow" +{ $subsection "evaluator" } +{ $subsection "words" } +{ $subsection "effects" } +{ $subsection "booleans" } +{ $subsection "shuffle-words" } +"A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input." +{ $subsection "cleave-combinators" } +{ $subsection "spread-combinators" } +{ $subsection "apply-combinators" } +{ $subsection "slip-keep-combinators" } +{ $subsection "conditionals" } +{ $subsection "combinators" } +"Advanced topics:" +{ $subsection "implementing-combinators" } +{ $subsection "continuations" } ; + ABOUT: "dataflow" HELP: eq? ( obj1 obj2 -- ? ) @@ -242,6 +326,8 @@ HELP: equal? { { $snippet "a = b" } " implies " { $snippet "b = a" } } { { $snippet "a = b" } " and " { $snippet "b = c" } " implies " { $snippet "a = c" } } } + $nl + "If a class defines a custom equality comparison test, it should also define a compatible method for the " { $link hashcode* } " generic word." } { $examples "To define a tuple class such that two instances are only equal if they are both the same instance, we can add a method to " { $link equal? } " which always returns " { $link f } ". Since " { $link = } " handles the case where the two objects are " { $link eq? } ", this method will never be called with two " { $link eq? } " objects, so such a definition is valid:" @@ -376,9 +462,152 @@ HELP: 3keep { $values { "quot" "a quotation with stack effect " { $snippet "( x y z -- )" } } { "x" object } { "y" object } { "z" object } } { $description "Call a quotation with three values on the stack, restoring the values when the quotation returns." } ; +HELP: bi +{ $values { "x" object } { "p" "a quotation with stack effect " { $snippet "( x -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( x -- ... )" } } } +{ $description "Applies " { $snippet "p" } " to " { $snippet "x" } ", then applies " { $snippet "q" } " to " { $snippet "x" } "." } +{ $examples + "If " { $snippet "[ p ]" } " and " { $snippet "[ q ]" } " have stack effect " { $snippet "( x -- )" } ", then the following two lines are equivalent:" + { $code + "[ p ] [ q ] bi" + "dup p q" + } + "If " { $snippet "[ p ]" } " and " { $snippet "[ q ]" } " have stack effect " { $snippet "( x -- y )" } ", then the following two lines are equivalent:" + { $code + "[ p ] [ q ] bi" + "dup p swap q" + } + "In general, the following two lines are equivalent:" + { $code + "[ p ] [ q ] bi" + "[ p ] keep q" + } + +} ; + +HELP: 2bi +{ $values { "x" object } { "y" object } { "p" "a quotation with stack effect " { $snippet "( x y -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( x y -- ... )" } } } +{ $description "Applies " { $snippet "p" } " to the two input values, then applies " { $snippet "q" } " to the two input values." } +{ $examples + "If " { $snippet "[ p ]" } " and " { $snippet "[ q ]" } " have stack effect " { $snippet "( x y -- )" } ", then the following two lines are equivalent:" + { $code + "[ p ] [ q ] 2bi" + "2dup p q" + } + "If " { $snippet "[ p ]" } " and " { $snippet "[ q ]" } " have stack effect " { $snippet "( x y -- z )" } ", then the following two lines are equivalent:" + { $code + "[ p ] [ q ] 2bi" + "2dup p swap q" + } + "In general, the following two lines are equivalent:" + { $code + "[ p ] [ q ] 2bi" + "[ p ] 2keep q" + } +} ; + +HELP: tri +{ $values { "x" object } { "p" "a quotation with stack effect " { $snippet "( x -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( x -- ... )" } } { "r" "a quotation with stack effect " { $snippet "( x -- ... )" } } } +{ $description "Applies " { $snippet "p" } " to " { $snippet "x" } ", then applies " { $snippet "q" } " to " { $snippet "x" } ", and finally applies " { $snippet "r" } " to " { $snippet "x" } "." } +{ $examples + "If " { $snippet "[ p ]" } ", " { $snippet "[ q ]" } " and " { $snippet "[ r ]" } " have stack effect " { $snippet "( x -- )" } ", then the following two lines are equivalent:" + { $code + "[ p ] [ q ] [ r ] tri" + "dup p dup q r" + } + "If " { $snippet "[ p ]" } ", " { $snippet "[ q ]" } " and " { $snippet "[ r ]" } " have stack effect " { $snippet "( x -- y )" } ", then the following two lines are equivalent:" + { $code + "[ p ] [ q ] [ r ] tri" + "dup p over q rot r" + } + "In general, the following two lines are equivalent:" + { $code + "[ p ] [ q ] [ r ] tri" + "[ p ] keep [ q ] keep r" + } +} ; + +HELP: 2tri +{ $values { "x" object } { "y" object } { "p" "a quotation with stack effect " { $snippet "( x y -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( x y -- ... )" } } { "r" "a quotation with stack effect " { $snippet "( x y -- ... )" } } } +{ $description "Applies " { $snippet "p" } " to the two input values, then applies " { $snippet "q" } " to the two input values, and finally applies " { $snippet "r" } " to the two input values." } +{ $examples + "If " { $snippet "[ p ]" } ", " { $snippet "[ q ]" } " and " { $snippet "[ r ]" } " have stack effect " { $snippet "( x y -- )" } ", then the following two lines are equivalent:" + { $code + "[ p ] [ q ] [ r ] 2tri" + "2dup p 2dup q r" + } + "In general, the following two lines are equivalent:" + { $code + "[ p ] [ q ] [ r ] 2tri" + "[ p ] 2keep [ q ] 2keep r" + } +} ; + + +HELP: bi* +{ $values { "x" object } { "y" object } { "p" "a quotation with stack effect " { $snippet "( x -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( y -- ... )" } } } +{ $description "Applies " { $snippet "p" } " to " { $snippet "x" } ", then applies " { $snippet "q" } " to " { $snippet "y" } "." } +{ $examples + "The following two lines are equivalent:" + { $code + "[ p ] [ q ] bi*" + ">r p r> q" + } +} ; + +HELP: 2bi* +{ $values { "w" object } { "x" object } { "y" object } { "z" object } { "p" "a quotation with stack effect " { $snippet "( w x -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( y z -- ... )" } } } +{ $description "Applies " { $snippet "p" } " to " { $snippet "w" } " and " { $snippet "x" } ", then applies " { $snippet "q" } " to " { $snippet "y" } " and " { $snippet "z" } "." } +{ $examples + "The following two lines are equivalent:" + { $code + "[ p ] [ q ] 2bi*" + ">r >r q r> r> q" + } +} ; + +HELP: tri* +{ $values { "x" object } { "y" object } { "z" object } { "p" "a quotation with stack effect " { $snippet "( x -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( y -- ... )" } } { "r" "a quotation with stack effect " { $snippet "( z -- ... )" } } } +{ $description "Applies " { $snippet "p" } " to " { $snippet "x" } ", then applies " { $snippet "q" } " to " { $snippet "y" } ", and finally applies " { $snippet "r" } " to " { $snippet "z" } "." } +{ $examples + "The following two lines are equivalent:" + { $code + "[ p ] [ q ] [ r ] tri*" + ">r >r q r> q r> r" + } +} ; + HELP: bi@ -{ $values { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } { "x" object } { "y" object } } -{ $description "Applies the quotation to " { $snippet "x" } ", then to " { $snippet "y" } "." } ; +{ $values { "x" object } { "y" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } } +{ $description "Applies the quotation to " { $snippet "x" } ", then to " { $snippet "y" } "." } +{ $examples + "The following two lines are equivalent:" + { $code + "[ p ] bi@" + ">r p r> p" + } +} ; + +HELP: 2bi@ +{ $values { "w" object } { "x" object } { "y" object } { "z" object } { "quot" "a quotation with stack effect " { $snippet "( obj1 obj2 -- )" } } } +{ $description "Applies the quotation to " { $snippet "w" } " and " { $snippet "x" } ", then to " { $snippet "y" } " and " { $snippet "z" } "." } +{ $examples + "The following two lines are equivalent:" + { $code + "[ p ] 2bi@" + ">r >r p r> r> p" + } +} ; + +HELP: tri@ +{ $values { "x" object } { "y" object } { "z" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } } +{ $description "Applies the quotation to " { $snippet "x" } ", then to " { $snippet "y" } ", and finally to " { $snippet "z" } "." } +{ $examples + "The following two lines are equivalent:" + { $code + "[ p ] tri@" + ">r >r p r> p r> p" + } +} ; HELP: if ( cond true false -- ) { $values { "cond" "a generalized boolean" } { "true" quotation } { "false" quotation } } diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index e2e0c0171a..70b591e5cf 100755 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -66,46 +66,46 @@ DEFER: if >r 3dup r> -roll 3slip ; inline ! Cleavers -: bi ( x p q -- p[x] q[x] ) +: bi ( x p q -- ) >r keep r> call ; inline -: tri ( x p q r -- p[x] q[x] r[x] ) +: tri ( x p q r -- ) >r pick >r bi r> r> call ; inline ! Double cleavers -: 2bi ( x y p q -- p[x,y] q[x,y] ) +: 2bi ( x y p q -- ) >r 2keep r> call ; inline -: 2tri ( x y p q r -- p[x,y] q[x,y] r[x,y] ) +: 2tri ( x y p q r -- ) >r >r 2keep r> 2keep r> call ; inline ! Triple cleavers -: 3bi ( x y z p q -- p[x,y,z] q[x,y,z] ) +: 3bi ( x y z p q -- ) >r 3keep r> call ; inline -: 3tri ( x y z p q r -- p[x,y,z] q[x,y,z] r[x,y,z] ) +: 3tri ( x y z p q r -- ) >r >r 3keep r> 3keep r> call ; inline ! Spreaders -: bi* ( x y p q -- p[x] q[y] ) +: bi* ( x y p q -- ) >r swap slip r> call ; inline -: tri* ( x y z p q r -- p[x] q[y] r[z] ) +: tri* ( x y z p q r -- ) >r rot >r bi* r> r> call ; inline ! Double spreaders -: 2bi* ( w x y z p q -- p[w,x] q[y,z] ) +: 2bi* ( w x y z p q -- ) >r -rot 2slip r> call ; inline ! Appliers -: bi@ ( x y p -- p[x] p[y] ) +: bi@ ( x y p -- ) tuck 2slip call ; inline -: tri@ ( x y z p -- p[x] p[y] p[z] ) +: tri@ ( x y z p -- ) tuck >r bi@ r> call ; inline ! Double appliers -: 2bi@ ( w x y z p -- p[w,x] p[y,z] ) +: 2bi@ ( w x y z p -- ) dup -roll 3slip call ; inline : while ( pred body tail -- ) diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index 8963c2b1ad..912c3c35f3 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -68,17 +68,6 @@ ARTICLE: "evaluator" "Evaluation semantics" "If the last action performed is the execution of a word, the current quotation is not saved on the call stack; this is known as " { $snippet "tail-recursion" } " and allows iterative algorithms to execute without incurring unbounded call stack usage." { $see-also "compiler" } ; -ARTICLE: "dataflow" "Data and control flow" -{ $subsection "evaluator" } -{ $subsection "words" } -{ $subsection "effects" } -{ $subsection "shuffle-words" } -{ $subsection "booleans" } -{ $subsection "conditionals" } -{ $subsection "basic-combinators" } -{ $subsection "combinators" } -{ $subsection "continuations" } ; - USING: concurrency.combinators concurrency.messaging concurrency.promises From 726806b1c14a6f0972acff54959ace69b61b5213 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 23:11:54 -0500 Subject: [PATCH 179/219] More robust concurrency.distributed unit test --- extra/concurrency/distributed/distributed-tests.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/extra/concurrency/distributed/distributed-tests.factor b/extra/concurrency/distributed/distributed-tests.factor index 0941eb4251..856c37a6bc 100755 --- a/extra/concurrency/distributed/distributed-tests.factor +++ b/extra/concurrency/distributed/distributed-tests.factor @@ -1,7 +1,7 @@ IN: concurrency.distributed.tests USING: tools.test concurrency.distributed kernel io.files arrays io.sockets system combinators threads math sequences -concurrency.messaging ; +concurrency.messaging continuations ; : test-node { @@ -9,6 +9,8 @@ concurrency.messaging ; { [ windows? ] [ "127.0.0.1" 1238 ] } } cond ; +[ ] [ [ "distributed-concurrency-test" temp-file delete-file ] ignore-errors ] unit-test + [ ] [ test-node dup 1array swap (start-node) ] unit-test [ ] [ yield ] unit-test From af9e27823a3840438ab1ba0b74a7bb899e38ff84 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sun, 30 Mar 2008 17:17:31 +1300 Subject: [PATCH 180/219] Add => action rule for an entire sequence --- extra/peg/ebnf/ebnf-tests.factor | 17 +++++++++++++++++ extra/peg/ebnf/ebnf.factor | 23 ++++++++++++++++++----- 2 files changed, 35 insertions(+), 5 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index c2c0a50a59..7aa61e84da 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -144,6 +144,23 @@ IN: peg.ebnf.tests "Z" [EBNF foo=[^A-Z] EBNF] call ] unit-test +{ V{ "1" "+" "foo" } } [ + "1+1" [EBNF foo='1' '+' '1' [[ drop "foo" ]] EBNF] call parse-result-ast +] unit-test + +{ "foo" } [ + "1+1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] EBNF] call parse-result-ast +] unit-test + +{ "foo" } [ + "1+1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call parse-result-ast +] unit-test + +{ "bar" } [ + "1-1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call parse-result-ast +] unit-test + + { V{ V{ 49 } "+" V{ 49 } } } [ #! Test direct left recursion. #! Using packrat, so first part of expr fails, causing 2nd choice to be used diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index c1e2ce8546..af61c3aae0 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -111,7 +111,10 @@ C: ebnf 'range-parser' , 'any-character' , ] choice* , - "=" syntax ensure-not , + [ + "=" syntax ensure-not , + "=>" syntax ensure , + ] choice* , ] seq* [ first ] action ; DEFER: 'choice' @@ -176,7 +179,10 @@ DEFER: 'choice' 'repeat0' sp , 'repeat1' sp , 'optional' sp , - ] choice* ; + ] choice* ; + +: 'action' ( -- parser ) + "[[" 'factor-code' "]]" syntax-pack ; : 'sequence' ( -- parser ) #! A sequence of terminals and non-terminals, including @@ -184,15 +190,21 @@ DEFER: 'choice' [ [ ('sequence') , - "[[" 'factor-code' "]]" syntax-pack , + 'action' , ] seq* [ first2 ] action , ('sequence') , ] choice* repeat1 [ dup length 1 = [ first ] [ ] if ] action ; + +: 'actioned-sequence' ( -- parser ) + [ + [ 'sequence' , "=>" syntax , 'action' , ] seq* [ first2 ] action , + 'sequence' , + ] choice* ; : 'choice' ( -- parser ) - 'sequence' sp "|" token sp list-of [ + 'actioned-sequence' sp "|" token sp list-of [ dup length 1 = [ first ] [ ] if ] action ; @@ -200,7 +212,8 @@ DEFER: 'choice' [ 'non-terminal' [ symbol>> ] action , "=" syntax , - 'choice' , + ">" token ensure-not , + 'choice' , ] seq* [ first2 ] action ; : 'ebnf' ( -- parser ) From d002e029485339ff7c15cdbfb20867e59304c3d0 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sun, 30 Mar 2008 17:23:11 +1300 Subject: [PATCH 181/219] Use left recursive grammar in peg.expr --- extra/peg/expr/expr.factor | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/extra/peg/expr/expr.factor b/extra/peg/expr/expr.factor index 6b690cb5ee..e16d9db0a7 100644 --- a/extra/peg/expr/expr.factor +++ b/extra/peg/expr/expr.factor @@ -4,24 +4,19 @@ USING: kernel arrays strings math.parser sequences peg peg.ebnf peg.parsers memoize math ; IN: peg.expr -: operator-fold ( lhs seq -- value ) - #! Perform a fold of a lhs, followed by a sequence of pairs being - #! { operator rhs } in to a tree structure of the correct precedence. - swap [ first2 swap call ] reduce ; - EBNF: expr -times = "*" [[ drop [ * ] ]] -divide = "/" [[ drop [ / ] ]] -add = "+" [[ drop [ + ] ]] -subtract = "-" [[ drop [ - ] ]] +digit = [0-9] => [[ digit> ]] +number = (digit)+ => [[ 10 digits>integer ]] +value = number + | ("(" exp ")") => [[ second ]] -digit = [0-9] [[ digit> ]] -number = (digit)+ [[ unclip [ swap 10 * + ] reduce ]] +fac = fac "*" value => [[ first3 nip * ]] + | fac "/" value => [[ first3 nip / ]] + | number -value = number | ("(" expr ")") [[ second ]] -product = (value ((times | divide) value)*) [[ first2 operator-fold ]] -sum = (product ((add | subtract) product)*) [[ first2 operator-fold ]] -expr = sum +exp = exp "+" fac => [[ first3 nip + ]] + | exp "-" fac => [[ first3 nip - ]] + | fac ;EBNF : eval-expr ( string -- number ) From a23e0ce15c97e58ea0f4de621ea4f77c5422b791 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sun, 30 Mar 2008 17:35:47 +1300 Subject: [PATCH 182/219] Fix hashcode* on parsers --- extra/peg/peg.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 247a64eac2..8621b43a7f 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -12,6 +12,8 @@ TUPLE: parse-result remaining ast ; TUPLE: parser id compiled ; M: parser equal? [ id>> ] 2apply = ; +M: parser hashcode* ( depth obj -- code ) + id>> hashcode* ; C: parser SYMBOL: ignore From 8eb55b4c591d3da3b316b3c54485eb571c5ed428 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Mar 2008 23:48:06 -0500 Subject: [PATCH 183/219] More doc fixes --- core/kernel/kernel-docs.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 587839f685..a446869096 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -295,12 +295,12 @@ HELP: hashcode* { $values { "depth" integer } { "obj" object } { "code" fixnum } } { $contract "Outputs the hashcode of an object. The hashcode operation must satisfy the following properties:" { $list - { "if two objects are equal under " { $link = } ", they must have equal hashcodes" } - { "if the hashcode of an object depends on the values of its slots, the hashcode of the slots must be computed recursively by calling " { $link hashcode* } " with a " { $snippet "level" } " parameter decremented by one. This avoids excessive work while still computing well-distributed hashcodes. The " { $link recursive-hashcode } " combinator can help with implementing this logic" } - { "the hashcode should be a " { $link fixnum } ", however returning a " { $link bignum } " will not cause any problems other than potential performance degradation." - "the hashcode is only permitted to change between two invocations if the object was mutated in some way" } + { "If two objects are equal under " { $link = } ", they must have equal hashcodes." } + { "If the hashcode of an object depends on the values of its slots, the hashcode of the slots must be computed recursively by calling " { $link hashcode* } " with a " { $snippet "level" } " parameter decremented by one. This avoids excessive work while still computing well-distributed hashcodes. The " { $link recursive-hashcode } " combinator can help with implementing this logic," } + { "The hashcode should be a " { $link fixnum } ", however returning a " { $link bignum } " will not cause any problems other than potential performance degradation." } + { "The hashcode is only permitted to change between two invocations if the object or one of its slot values was mutated." } } -"If mutable objects are used as hashtable keys, they must not be mutated in such a way that their hashcode changes. Doing so will violate bucket sorting invariants and result in undefined behavior." } ; +"If mutable objects are used as hashtable keys, they must not be mutated in such a way that their hashcode changes. Doing so will violate bucket sorting invariants and result in undefined behavior. See " { $link "hashtables.keys" } " for details." } ; HELP: hashcode { $values { "obj" object } { "code" fixnum } } From a89e0b7615a775f0ceb921a464b8f3645fc9ff40 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 00:13:53 -0500 Subject: [PATCH 184/219] Fix deploy tests for AMD64 --- extra/tools/deploy/deploy-tests.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/tools/deploy/deploy-tests.factor b/extra/tools/deploy/deploy-tests.factor index 5030763a3d..f104fb0210 100755 --- a/extra/tools/deploy/deploy-tests.factor +++ b/extra/tools/deploy/deploy-tests.factor @@ -1,7 +1,7 @@ IN: tools.deploy.tests USING: tools.test system io.files kernel tools.deploy.config tools.deploy.backend math sequences io.launcher arrays -namespaces continuations ; +namespaces continuations layouts ; : shake-and-bake ( vocab -- ) [ "test.image" temp-file delete-file ] ignore-errors @@ -17,7 +17,7 @@ namespaces continuations ; [ ] [ "hello-world" shake-and-bake ] unit-test [ t ] [ - 500000 small-enough? + cell 8 = 8 5 ? 100000 * small-enough? ] unit-test [ ] [ "sudoku" shake-and-bake ] unit-test From 2d19b386839095f66ad3f9895b629bdbb1ac1c33 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 00:40:43 -0500 Subject: [PATCH 185/219] Documentation fixes --- core/combinators/combinators-docs.factor | 2 +- core/combinators/combinators.factor | 6 +++--- core/kernel/kernel.factor | 6 +++--- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor index b088979b4e..f497fd20e5 100755 --- a/core/combinators/combinators-docs.factor +++ b/core/combinators/combinators-docs.factor @@ -45,7 +45,7 @@ HELP: cleave { bi tri cleave } related-words HELP: spread -{ $values { "obj..." "objects" } { "seq" "a sequence of quotations with stack effect " { $snippet "( x -- ... )" } } } +{ $values { "objs..." "objects" } { "seq" "a sequence of quotations with stack effect " { $snippet "( x -- ... )" } } } { $description "Applies each quotation to the object in turn." } { $examples "The " { $link bi* } " combinator takes two values and two quotations; the " { $link tri* } " combinator takes three values and three quotations. The " { $link spread } " combinator takes " { $snippet "n" } " values and " { $snippet "n" } " quotations, where " { $snippet "n" } " is the length of the input sequence, and is essentially equivalent to series of retain stack manipulations:" diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index cc03955fd8..e19847dbd4 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -5,13 +5,13 @@ USING: arrays sequences sequences.private math.private kernel kernel.private math assocs quotations vectors hashtables sorting ; -: cleave ( obj seq -- ) +: cleave ( x seq -- ) [ call ] with each ; : cleave>quot ( seq -- quot ) [ [ keep ] curry ] map concat [ drop ] append ; -: 2cleave ( obj seq -- ) +: 2cleave ( x seq -- ) [ [ call ] 3keep drop ] each 2drop ; : 2cleave>quot ( seq -- quot ) @@ -22,7 +22,7 @@ hashtables sorting ; [ [ [ r> ] prepend ] map concat ] bi append ; -: spread ( seq -- ) +: spread ( objs... seq -- ) spread>quot call ; ERROR: no-cond ; diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 70b591e5cf..ab42a1b903 100755 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -98,14 +98,14 @@ DEFER: if >r -rot 2slip r> call ; inline ! Appliers -: bi@ ( x y p -- ) +: bi@ ( x y quot -- ) tuck 2slip call ; inline -: tri@ ( x y z p -- ) +: tri@ ( x y z quot -- ) tuck >r bi@ r> call ; inline ! Double appliers -: 2bi@ ( w x y z p -- ) +: 2bi@ ( w x y z quot -- ) dup -roll 3slip call ; inline : while ( pred body tail -- ) From 4ca0c492807c2a1b58aabd6b97824c4e317125cf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 00:47:48 -0500 Subject: [PATCH 186/219] Fix buggy benchmarks --- extra/benchmark/typecheck2/typecheck2.factor | 2 +- extra/benchmark/typecheck3/typecheck3.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/benchmark/typecheck2/typecheck2.factor b/extra/benchmark/typecheck2/typecheck2.factor index d7977063ee..0fc1debb67 100644 --- a/extra/benchmark/typecheck2/typecheck2.factor +++ b/extra/benchmark/typecheck2/typecheck2.factor @@ -3,7 +3,7 @@ IN: benchmark.typecheck2 TUPLE: hello n ; -: hello-n* dup tuple? [ 4 slot ] [ 3 throw ] if ; +: hello-n* dup tuple? [ 3 slot ] [ 3 throw ] if ; : foo 0 100000000 [ over hello-n* + ] times ; diff --git a/extra/benchmark/typecheck3/typecheck3.factor b/extra/benchmark/typecheck3/typecheck3.factor index e85fb2850c..9a58e0a795 100644 --- a/extra/benchmark/typecheck3/typecheck3.factor +++ b/extra/benchmark/typecheck3/typecheck3.factor @@ -3,7 +3,7 @@ IN: benchmark.typecheck3 TUPLE: hello n ; -: hello-n* dup tag 2 eq? [ 4 slot ] [ 3 throw ] if ; +: hello-n* dup tag 2 eq? [ 3 slot ] [ 3 throw ] if ; : foo 0 100000000 [ over hello-n* + ] times ; From 78633e03a0d9951407e33c01c8e33eac0205657e Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sun, 30 Mar 2008 19:01:47 +1300 Subject: [PATCH 187/219] Allow var names in ebnf but ignore them for now --- extra/peg/ebnf/ebnf.factor | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index af61c3aae0..0ae1430c8c 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -19,6 +19,7 @@ TUPLE: ebnf-repeat1 group ; TUPLE: ebnf-optional group ; TUPLE: ebnf-rule symbol elements ; TUPLE: ebnf-action parser code ; +TUPLE: ebnf-var parser name ; TUPLE: ebnf rules ; C: ebnf-non-terminal @@ -34,6 +35,7 @@ C: ebnf-repeat1 C: ebnf-optional C: ebnf-rule C: ebnf-action +C: ebnf-var C: ebnf : syntax ( string -- parser ) @@ -79,6 +81,7 @@ C: ebnf [ dup CHAR: * = ] [ dup CHAR: + = ] [ dup CHAR: ? = ] + [ dup CHAR: : = ] } || not nip ] satisfy repeat1 [ >string ] action ; @@ -200,6 +203,7 @@ DEFER: 'choice' : 'actioned-sequence' ( -- parser ) [ [ 'sequence' , "=>" syntax , 'action' , ] seq* [ first2 ] action , + [ 'sequence' , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 ] action , 'sequence' , ] choice* ; @@ -270,6 +274,9 @@ M: ebnf-action (transform) ( ast -- parser ) [ parser>> (transform) ] keep code>> string-lines [ parse-lines ] with-compilation-unit action ; +M: ebnf-var (transform) ( ast -- parser ) + parser>> (transform) ; + M: ebnf-terminal (transform) ( ast -- parser ) symbol>> token sp ; From f49d26e8d060c745b31dd72454462d0625cef2eb Mon Sep 17 00:00:00 2001 From: erg Date: Sun, 30 Mar 2008 01:13:29 -0500 Subject: [PATCH 188/219] make copy-tree and delete-tree symlink aware --- core/io/files/files.factor | 30 ++++++++++++++++++------------ extra/io/unix/files/files.factor | 19 +++++++++++++++---- extra/unix/unix.factor | 4 ++++ 3 files changed, 37 insertions(+), 16 deletions(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 48098e612d..4dbbb869c4 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -3,7 +3,7 @@ USING: io.backend io.files.private io hashtables kernel math memory namespaces sequences strings assocs arrays definitions system combinators splitting sbufs continuations io.encodings -io.encodings.binary init ; +io.encodings.binary init accessors ; IN: io.files HOOK: (file-reader) io-backend ( path -- stream ) @@ -145,8 +145,14 @@ PRIVATE> TUPLE: file-info type size permissions modified ; HOOK: file-info io-backend ( path -- info ) + +! Symlinks HOOK: link-info io-backend ( path -- info ) +HOOK: make-link io-backend ( path1 path2 -- ) + +HOOK: read-link io-backend ( path -- info ) + SYMBOL: +regular-file+ SYMBOL: +directory+ SYMBOL: +character-device+ @@ -218,14 +224,14 @@ HOOK: delete-file io-backend ( path -- ) HOOK: delete-directory io-backend ( path -- ) -: (delete-tree) ( path dir? -- ) - [ - dup directory* [ (delete-tree) ] assoc-each - delete-directory - ] [ delete-file ] if ; - : delete-tree ( path -- ) - dup directory? (delete-tree) ; + dup link-info type>> +directory+ = [ + dup directory over [ + [ first delete-tree ] each + ] with-directory delete-directory + ] [ + delete-file + ] if ; : to-directory over file-name append-path ; @@ -258,10 +264,10 @@ M: object copy-file DEFER: copy-tree-into : copy-tree ( from to -- ) - over directory? [ - >r dup directory swap r> [ - >r swap first append-path r> copy-tree-into - ] 2curry each + over link-info type>> +directory+ = [ + >r dup directory r> rot [ + [ >r first r> copy-tree-into ] curry each + ] with-directory ] [ copy-file ] if ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 3b493d2fe4..759ac2bec1 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -3,7 +3,7 @@ USING: io.backend io.nonblocking io.unix.backend io.files io unix unix.stat unix.time kernel math continuations math.bitfields byte-arrays alien combinators calendar -io.encodings.binary ; +io.encodings.binary accessors sequences strings ; IN: io.unix.files @@ -49,7 +49,7 @@ M: unix-io touch-file ( path -- ) close ; M: unix-io move-file ( from to -- ) - [ normalize-pathname ] 2apply rename io-error ; + [ normalize-pathname ] bi@ rename io-error ; M: unix-io delete-file ( path -- ) normalize-pathname unlink io-error ; @@ -69,7 +69,7 @@ M: unix-io delete-directory ( path -- ) ] with-disposal ; M: unix-io copy-file ( from to -- ) - [ normalize-pathname ] 2apply + [ normalize-pathname ] bi@ [ (copy-file) ] [ swap file-info file-info-permissions chmod io-error ] 2bi ; @@ -84,7 +84,7 @@ M: unix-io copy-file ( from to -- ) { [ dup S_ISLNK ] [ +symbolic-link+ ] } { [ dup S_ISSOCK ] [ +socket+ ] } { [ t ] [ +unknown+ ] } - } cond nip ; + } cond nip ; : stat>file-info ( stat -- info ) { @@ -100,3 +100,14 @@ M: unix-io file-info ( path -- info ) M: unix-io link-info ( path -- info ) normalize-pathname lstat* stat>file-info ; + +M: unix-io make-link ( path1 path2 -- ) + normalize-pathname symlink io-error ; + +M: unix-io read-link ( path -- path' ) + normalize-pathname + PATH_MAX [ tuck ] [ ] bi readlink + dup io-error head-slice >string ; + +: copy-link ( path1 path2 -- ) + >r read-link r> make-link ; diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor index bed87ebd0f..ffd102901c 100755 --- a/extra/unix/unix.factor +++ b/extra/unix/unix.factor @@ -77,6 +77,7 @@ FUNCTION: int pclose ( void* file ) ; FUNCTION: int pipe ( int* filedes ) ; FUNCTION: void* popen ( char* command, char* type ) ; FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ; +FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ; FUNCTION: ssize_t recv ( int s, void* buf, size_t nbytes, int flags ) ; FUNCTION: ssize_t recvfrom ( int s, void* buf, size_t nbytes, int flags, sockaddr-in* from, socklen_t* fromlen ) ; FUNCTION: int rename ( char* from, char* to ) ; @@ -93,6 +94,7 @@ FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_ FUNCTION: int setuid ( uid_t uid ) ; FUNCTION: int socket ( int domain, int type, int protocol ) ; FUNCTION: char* strerror ( int errno ) ; +FUNCTION: int symlink ( char* path1, char* path2 ) ; FUNCTION: int system ( char* command ) ; FUNCTION: int unlink ( char* path ) ; FUNCTION: int utimes ( char* path, timeval[2] times ) ; @@ -102,6 +104,8 @@ FUNCTION: int utimes ( char* path, timeval[2] times ) ; FUNCTION: int kill ( pid_t pid, int sig ) ; +: PATH_MAX 1024 ; inline + : PRIO_PROCESS 0 ; inline : PRIO_PGRP 1 ; inline : PRIO_USER 2 ; inline From b4d2a0b1051061b37a68e80a92bd8673eaa30fb5 Mon Sep 17 00:00:00 2001 From: erg Date: Sun, 30 Mar 2008 01:14:28 -0500 Subject: [PATCH 189/219] add constant to grovel --- build-support/grovel.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/build-support/grovel.c b/build-support/grovel.c index 2eee054dab..db16aa9bca 100644 --- a/build-support/grovel.c +++ b/build-support/grovel.c @@ -42,6 +42,7 @@ #include #include #include + #include #include #include #endif @@ -146,6 +147,7 @@ void unix_constants() constant(PROT_WRITE); constant(MAP_FILE); constant(MAP_SHARED); + constant(PATH_MAX); grovel(pid_t); } From 68e49c8770fc2d9f32382250e0b44026d306115a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 02:21:55 -0500 Subject: [PATCH 190/219] Another benchmark fix --- extra/benchmark/typecheck4/typecheck4.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/benchmark/typecheck4/typecheck4.factor b/extra/benchmark/typecheck4/typecheck4.factor index a1362a68ab..eb211e97e7 100644 --- a/extra/benchmark/typecheck4/typecheck4.factor +++ b/extra/benchmark/typecheck4/typecheck4.factor @@ -3,7 +3,7 @@ IN: benchmark.typecheck4 TUPLE: hello n ; -: hello-n* 4 slot ; +: hello-n* 3 slot ; : foo 0 100000000 [ over hello-n* + ] times ; From ea12d45337d6361840f94f9b733d5a59169056ed Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 03:06:28 -0500 Subject: [PATCH 191/219] Update json for inheritance --- extra/json/writer/writer.factor | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/extra/json/writer/writer.factor b/extra/json/writer/writer.factor index f847bbff68..1741b96e75 100644 --- a/extra/json/writer/writer.factor +++ b/extra/json/writer/writer.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. USING: kernel io.streams.string io strings splitting sequences math - math.parser assocs classes.tuple classes words namespaces - hashtables ; + math.parser assocs classes words namespaces prettyprint + hashtables mirrors ; IN: json.writer #! Writes the object out to a stream in JSON format @@ -39,25 +39,19 @@ M: sequence json-print ( array -- string ) #! javascript variable names. [ (jsvar-encode) ] map ; -: slots ( object -- values names ) - #! Given an object return an array of slots names and a sequence of slot values - #! the slot name and the slot value. - [ tuple-slots ] keep class slot-names ; +: tuple>fields ( object -- string ) + [ + [ swap jsvar-encode >json % " : " % >json % ] "" make + ] { } assoc>map ; -: slots>fields ( values names -- array ) - #! Convert the arrays containing the slot names and values - #! to an array of strings suitable for describing that slot - #! as a field in a javascript object. - [ - [ jsvar-encode >json % " : " % >json % ] "" make - ] 2map ; - -M: object json-print ( object -- string ) - CHAR: { write1 slots slots>fields "," join write CHAR: } write1 ; +M: tuple json-print ( tuple -- string ) + CHAR: { write1 tuple>fields "," join write CHAR: } write1 ; M: hashtable json-print ( hashtable -- string ) CHAR: { write1 [ [ swap jsvar-encode >json % CHAR: : , >json % ] "" make ] { } assoc>map "," join write CHAR: } write1 ; - + +M: object json-print ( object -- string ) + unparse json-print ; From bb8198d3d0163e0cacc701e21588c16e858d2b08 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Sun, 30 Mar 2008 23:24:02 +1300 Subject: [PATCH 192/219] Declare stack effects for compiled parsers --- extra/peg/ebnf/ebnf.factor | 4 ++-- extra/peg/peg.factor | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index 0ae1430c8c..41b5a1b655 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -3,7 +3,7 @@ USING: kernel compiler.units parser words arrays strings math.parser sequences quotations vectors namespaces math assocs continuations peg peg.parsers unicode.categories multiline combinators.lib - splitting accessors ; + splitting accessors effects ; IN: peg.ebnf TUPLE: ebnf-non-terminal symbol ; @@ -310,5 +310,5 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) : EBNF: CREATE-WORD dup ";EBNF" parse-multiline-string - ebnf>quot swapd define "ebnf-parser" set-word-prop ; parsing + ebnf>quot swapd 1 1 define-declared "ebnf-parser" set-word-prop ; parsing diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 8621b43a7f..a09962783b 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -3,7 +3,7 @@ USING: kernel sequences strings namespaces math assocs shuffle vectors arrays combinators.lib math.parser match unicode.categories sequences.lib compiler.units parser - words quotations effects memoize accessors locals ; + words quotations effects memoize accessors locals effects ; IN: peg USE: prettyprint @@ -206,7 +206,7 @@ GENERIC: (compile) ( parser -- quot ) :: parser-body ( parser -- quot ) #! Return the body of the word that is the compiled version #! of the parser. - [let* | rule [ parser (compile) define-temp dup parser "peg" set-word-prop ] + [let* | rule [ gensym dup parser (compile) 0 1 define-declared dup parser "peg" set-word-prop ] | [ rule pos get apply-rule dup fail = [ @@ -216,7 +216,7 @@ GENERIC: (compile) ( parser -- quot ) ] if ] ] ; - + : compiled-parser ( parser -- word ) #! Look to see if the given parser has been compiled. #! If not, compile it to a temporary word, cache it, @@ -227,7 +227,7 @@ GENERIC: (compile) ( parser -- quot ) dup compiled>> [ nip ] [ - gensym tuck >>compiled 2dup parser-body define dupd "peg" set-word-prop + gensym tuck >>compiled 2dup parser-body 0 1 define-declared dupd "peg" set-word-prop ] if* ; : compile ( parser -- word ) From 883c54e07765773cf3a30d9478c7f45e14747f39 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 30 Mar 2008 06:45:38 -0500 Subject: [PATCH 193/219] use srandom and prandom on openbsd /dev/random is reserved for hardware rngs.. --- extra/random/unix/unix.factor | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/extra/random/unix/unix.factor b/extra/random/unix/unix.factor index 51574887e3..f3f55007f0 100644 --- a/extra/random/unix/unix.factor +++ b/extra/random/unix/unix.factor @@ -1,6 +1,6 @@ USING: alien.c-types io io.files io.nonblocking kernel namespaces random io.encodings.binary singleton init -accessors ; +accessors system ; IN: random.unix TUPLE: unix-random path ; @@ -15,7 +15,14 @@ C: unix-random M: unix-random random-bytes* ( n tuple -- byte-array ) path>> file-read-unbuffered ; -[ - "/dev/random" secure-random-generator set-global - "/dev/urandom" insecure-random-generator set-global -] "random.unix" add-init-hook +os "openbsd" = [ + [ + "/dev/srandom" secure-random-generator set-global + "/dev/prandom" insecure-random-generator set-global + ] "random.unix" add-init-hook +] [ + [ + "/dev/random" secure-random-generator set-global + "/dev/urandom" insecure-random-generator set-global + ] "random.unix" add-init-hook +] if From 5989680a7b992b392dbb57ca99f3909140f2b879 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Mon, 31 Mar 2008 00:53:33 +1300 Subject: [PATCH 194/219] Ensure box parsers are never cached --- extra/peg/peg.factor | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index a09962783b..e07942a3cd 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -488,8 +488,11 @@ M: box-parser (compile) ( parser -- quot ) #! Calls the quotation at compile time #! to produce the parser to be compiled. #! This differs from 'delay' which calls - #! it at run time. - quot>> call compiled-parser 1quotation ; + #! it at run time. Due to using the runtime + #! environment at compile time, this parser + #! must not be cached, so we clear out the + #! delgates cache. + f >>compiled quot>> call compiled-parser 1quotation ; PRIVATE> @@ -560,7 +563,12 @@ PRIVATE> delay-parser construct-boa init-parser ; : box ( quot -- parser ) - box-parser construct-boa init-parser ; + #! because a box has its quotation run at compile time + #! it must always have a new parser delgate created, + #! not a cached one. This is because the same box, + #! compiled twice can have a different compiled word + #! due to running at compile time. + box-parser construct-boa next-id f over set-delegate ; : PEG: (:) [ From 8bc2589a7a75bdee2e8c5c057b240a74f5eab062 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 08:16:07 -0500 Subject: [PATCH 195/219] Documentation updates --- core/kernel/kernel-docs.factor | 69 ++++++++++++++++++++++++----- extra/help/cookbook/cookbook.factor | 33 ++++++++++---- 2 files changed, 84 insertions(+), 18 deletions(-) diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index a446869096..1c88f5a485 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -7,6 +7,8 @@ IN: kernel ARTICLE: "shuffle-words" "Shuffle words" "Shuffle words rearrange items at the top of the data stack. They control the flow of data between words that perform actions." $nl +"The " { $link "cleave-combinators" } " and " { $link "spread-combinators" } " are closely related to shuffle words and should be used instead where possible because they can result in clearer code; also, see the advice in " { $link "cookbook-philosophy" } "." +$nl "Removing stack elements:" { $subsection drop } { $subsection 2drop } @@ -39,9 +41,28 @@ $nl { $code ": foo ( m ? n -- m+n/n )" " >r [ r> + ] [ drop r> ] if ; ! This is OK" -} -"An alternative to using " { $link >r } " and " { $link r> } " is the following:" -{ $subsection dip } ; +} ; + +ARTICLE: "cleave-shuffle-equivalence" "Expressing shuffle words with cleave combinators" +"Cleave combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to cleave combinators are discussed in the documentation for " { $link bi } ", " { $link 2bi } ", " { $link 3bi } ", " { $link tri } ", " { $link 2tri } " and " { $link 3tri } "." +$nl +"Certain shuffle words can also be expressed in terms of the cleave combinators. Internalizing such identities can help with understanding and writing code using cleave combinators:" +{ $code + ": keep [ ] bi ;" + ": 2keep [ ] 2bi ;" + ": 3keep [ ] 3bi ;" + "" + ": dup [ ] [ ] bi ;" + ": 2dup [ ] [ ] 2bi ;" + ": 3dup [ ] [ ] 3bi ;" + "" + ": tuck [ nip ] [ ] 2bi ;" + ": swap [ nip ] [ drop ] 2bi ;" + "" + ": over [ ] [ drop ] 2bi ;" + ": pick [ ] [ 2drop ] 3bi ;" + ": 2over [ ] [ drop ] 3bi ;" +} ; ARTICLE: "cleave-combinators" "Cleave combinators" "The cleave combinators apply multiple quotations to a single value." @@ -49,9 +70,11 @@ $nl "Two quotations:" { $subsection bi } { $subsection 2bi } +{ $subsection 3bi } "Three quotations:" { $subsection tri } { $subsection 2tri } +{ $subsection 3tri } "Technically, the cleave combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on the top of the stack can be written in one of two ways:" { $code "! First alternative; uses keep" @@ -66,13 +89,38 @@ $nl "The latter is more aesthetically pleasing than the former." $nl "A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "." +{ $subsection "cleave-shuffle-equivalence" } ; + +ARTICLE: "spread-shuffle-equivalence" "Expressing shuffle words with spread combinators" +"Spread combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to spread combinators are discussed in the documentation for " { $link bi* } ", " { $link 2bi* } ", and " { $link tri* } "." $nl -"From the Merriam-Webster Dictionary: " -$nl -{ $strong "cleave" } -{ $list - { $emphasis "To divide by or as if by a cutting blow" } - { $emphasis "To separate into distinct parts and especially into groups having divergent views" } +"Certain shuffle words can also be expressed in terms of the spread combinators. Internalizing such identities can help with understanding and writing code using spread combinators:" +{ $code + ": dip [ ] bi* ;" + "" + ": slip [ call ] [ ] bi* ;" + ": 2slip [ call ] [ ] [ ] tri* ;" + "" + ": nip [ drop ] [ ] bi* ;" + ": 2nip [ drop ] [ drop ] [ ] tri* ;" + "" + ": rot" + " [ [ drop ] [ ] [ drop ] tri* ]" + " [ [ drop ] [ drop ] [ ] tri* ]" + " [ [ ] [ drop ] [ drop ] tri* ]" + " 3tri ;" + "" + ": -rot" + " [ [ drop ] [ drop ] [ ] tri* ]" + " [ [ ] [ drop ] [ drop ] tri* ]" + " [ [ drop ] [ ] [ drop ] tri* ]" + " 3tri ;" + "" + ": spin" + " [ [ drop ] [ drop ] [ ] tri* ]" + " [ [ drop ] [ ] [ drop ] tri* ]" + " [ [ ] [ drop ] [ drop ] tri* ]" + " 3tri ;" } ; ARTICLE: "spread-combinators" "Spread combinators" @@ -96,7 +144,8 @@ $nl } $nl -"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "." ; +"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "." +{ $subsection "spread-shuffle-equivalence" } ; ARTICLE: "apply-combinators" "Apply combinators" "The apply combinators apply multiple quotations to multiple values. The " { $snippet "@" } " suffix signifies application." diff --git a/extra/help/cookbook/cookbook.factor b/extra/help/cookbook/cookbook.factor index 319dd1586b..075ce2d0e8 100755 --- a/extra/help/cookbook/cookbook.factor +++ b/extra/help/cookbook/cookbook.factor @@ -267,16 +267,33 @@ $nl } ; ARTICLE: "cookbook-philosophy" "Factor philosophy" -"Factor is a high-level language with automatic memory management, runtime type checking, and strong typing. Factor code should be as simple as possible, but not simpler. If you are coming to Factor from another programming language, one of your first observations might be related to the amount of code you " { $emphasis "don't" } " have to write." +"Learning a stack language is like learning to ride a bicycle: it takes a bit of practice and you might graze your knees a couple of times, but once you get the hang of it, it becomes second nature." $nl -"If you try to write Factor word definitions which are longer than a couple of lines, you will find it hard to keep track of the stack contents. Well-written Factor code is " { $emphasis "factored" } " into short definitions, where each definition is easy to test interactively, and has a clear purpose. Well-chosen word names are critical, and having a thesaurus on hand really helps." -$nl -"If you run into problems with stack shuffling, take a deep breath and a step back, and reconsider the problem. A much simpler solution is waiting right around the corner, a natural solution which requires far less stack shuffling and far less code. As a last resort, if no simple solution exists, consider defining a domain-specific language." -$nl -"Every time you define a word which simply manipulates sequences, hashtables or objects in an abstract way which is not related to your program domain, check the library to see if you can reuse an existing definition and save yourself some debugging time." -$nl -"In addition to writing short definitions and testing them interactively, a great habit to get into is writing unit tests. Factor provides good support for unit testing; see " { $link "tools.test" } "." +"The most common difficulty encountered by beginners is trouble reading and writing code as a result of trying to place too many values on the stack at a time." $nl +"Keep the following guidelines in mind to avoid losing your sense of balance:" +{ $list + "SImplify, simplify, simplify. Break your program up into small words which operate on a few values at a time. Most word definitions should fit on a single line; very rarely should they exceed two or three lines." + "In addition to keeping your words short, keep them meaningful. Give them good names, and make sure each word only does one thing. Try documenting your words; if the documentation for a word is unclear or complex, chances are the word definition is too. Don't be afraid to refactor your code." + "If your code looks repetitive, factor it some more." + "If after factoring, your code still looks repetitive, introduce combinators." + "If after introducing combinators, your code still looks repetitive, look into using meta-programming techniques." + "Try to place items on the stack in the order in which they are needed. If everything is in the correct order, no shuffling needs to be performed." + "If you find yourself writing a stack comment in the middle of a word, break the word up." + { "Use " { $link "cleave-combinators" } " and " { $link "spread-combinators" } " instead of " { $link "shuffle-words" } " to give your code more structure." } + { "Not everything has to go on the stack. The " { $vocab-link "namespaces" } " vocabulary provides dynamically-scoped variables, and the " { $vocab-link "locals" } " vocabulary provides lexically-scoped variables. Learn both and use them where they make sense, but keep in mind that overuse of variables makes code harder to factor." } + "Every time you define a word which simply manipulates sequences, hashtables or objects in an abstract way which is not related to your program domain, check the library to see if you can reuse an existing definition." + { "Learn to use the " { $link "inference" } " tool." } + { "Write unit tests. Factor provides good support for unit testing; see " { $link "tools.test" } ". Once your program has a good test suite you can refactor with confidence and catch regressions early." } + "Don't write Factor as if it were C. Imperitive programming and indexed loops are almost always not the most idiomatic solution." + { "Use sequences, assocs and objects to group related data. Object allocation is very cheap. Don't be afraid to create tuples, pairs and triples. Don't be afraid of operations which allocate new objects either, such as " { $link append } "." } + { "If you find yourself writing a loop with a sequence and an index, there's almost always a better way. Learn the " { $link "sequences-combinators" } " by heart." } + { "If you find yourself writing a heavily nested loop which performs several steps on each iteration, there is almost always a better way. Break the problem down into a series of passes over the data instead, gradually transforming it into the desired result with a series of simple loops. Factor the loops out and reuse them. If you're working on anything math-related, learn " { $link "math-vectors" } " by heart." } + { "If you find yourself wishing you could iterate over the datastack, or capture the contents of the datastack into a sequence, or push each element of a sequence onto the datastack, there is almost always a better way. Use " { $link "sequences" } " instead." } + "Don't use meta-programming if there's a simpler way." + "Don't worry about efficiency unless your program is too slow. Don't prefer complex code to simple code just because you feel it will be more efficient. The Factor compiler is designed to make idiomatic code run fast." + { "None of the above are hard-and-fast rules: there are exceptions to all of them. But one rule unconditionally holds: " { $emphasis "there is always a simpler way" } "." } +} "Factor tries to implement as much of itself as possible, because this improves simplicity and performance. One consequence is that Factor exposes its internals for extension and study. You even have the option of using low-level features not usually found in high-level languages, such manual memory management, pointer arithmetic, and inline assembly code." $nl "Unsafe features are tucked away so that you will not invoke them by accident, or have to use them to solve conventional programming problems. However when the need arises, unsafe features are invaluable, for example you might have to do some pointer arithmetic when interfacing directly with C libraries." ; From df8dabaf5e56c00fb5eacdb8de167bf6c63d6675 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 08:16:19 -0500 Subject: [PATCH 196/219] Update JSON writer for inheritance --- extra/json/writer/writer.factor | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/extra/json/writer/writer.factor b/extra/json/writer/writer.factor index 1741b96e75..6ad0774e38 100644 --- a/extra/json/writer/writer.factor +++ b/extra/json/writer/writer.factor @@ -26,32 +26,27 @@ M: number json-print ( num -- ) M: integer json-print ( num -- ) number>string write ; -M: sequence json-print ( array -- string ) +M: sequence json-print ( array -- ) CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ; -: (jsvar-encode) ( char -- char ) - #! Convert the given character to a character usable in - #! javascript variable names. - dup H{ { CHAR: - CHAR: _ } } at dup [ nip ] [ drop ] if ; - : jsvar-encode ( string -- string ) #! Convert the string so that it contains characters usable within #! javascript variable names. - [ (jsvar-encode) ] map ; + { { CHAR: - CHAR: _ } } substitute ; -: tuple>fields ( object -- string ) +: tuple>fields ( object -- seq ) [ [ swap jsvar-encode >json % " : " % >json % ] "" make ] { } assoc>map ; -M: tuple json-print ( tuple -- string ) +M: tuple json-print ( tuple -- ) CHAR: { write1 tuple>fields "," join write CHAR: } write1 ; -M: hashtable json-print ( hashtable -- string ) +M: hashtable json-print ( hashtable -- ) CHAR: { write1 [ [ swap jsvar-encode >json % CHAR: : , >json % ] "" make ] { } assoc>map "," join write CHAR: } write1 ; -M: object json-print ( object -- string ) +M: object json-print ( object -- ) unparse json-print ; From 87539b8f4eb4b8be3f3770155dcc9ddf608ceced Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 08:16:30 -0500 Subject: [PATCH 197/219] Clean up db.types --- extra/db/types/types.factor | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index 3c73a933e9..9babfbcdb0 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -131,25 +131,17 @@ TUPLE: no-sql-modifier ; HOOK: bind% db ( spec -- ) -TUPLE: no-slot-named ; -: no-slot-named ( -- * ) T{ no-slot-named } throw ; - -: slot-spec-named ( str class -- slot-spec ) - "slots" word-prop [ slot-spec-name = ] with find nip - [ no-slot-named ] unless* ; - : offset-of-slot ( str obj -- n ) - class slot-spec-named slot-spec-offset ; + class "slots" word-prop slot-named slot-spec-offset ; -: get-slot-named ( str obj -- value ) - tuck offset-of-slot [ no-slot-named ] unless* slot ; +: get-slot-named ( name obj -- value ) + tuck offset-of-slot slot ; -: set-slot-named ( value str obj -- ) - tuck offset-of-slot [ no-slot-named ] unless* set-slot ; +: set-slot-named ( value name obj -- ) + tuck offset-of-slot set-slot ; : tuple>filled-slots ( tuple -- alist ) - dup mirror-slots [ slot-spec-name ] map - swap tuple-slots 2array flip [ nip ] assoc-subset ; + [ nip ] assoc-subset ; : tuple>params ( specs tuple -- obj ) [ From 2d80153b073bca7332f38c15e928c396aa028d7b Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 30 Mar 2008 14:39:13 -0600 Subject: [PATCH 198/219] builder: Add support for gmake --- extra/builder/builder.factor | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 461d951209..75664ce5e5 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -48,15 +48,31 @@ IN: builder : record-git-id ( -- ) git-id "../git-id" utf8 [ . ] with-file-writer ; -: do-make-clean ( -- ) { "make" "clean" } try-process ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: gnu-make ( -- string ) + os { "freebsd" "openbsd" "netbsd" } member? + [ "gmake" ] + [ "make" ] + if ; + +! : do-make-clean ( -- ) { "make" "clean" } try-process ; + +: do-make-clean ( -- ) { gnu-make "clean" } to-strings try-process ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! : make-vm ( -- desc ) +! +! { "make" } >>command +! "../compile-log" >>stdout +! +stdout+ >>stderr ; + : make-vm ( -- desc ) - { "make" } >>command - "../compile-log" >>stdout - +stdout+ >>stderr ; + { gnu-make } to-strings >>command + "../compile-log" >>stdout + +stdout+ >>stderr ; : do-make-vm ( -- ) make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail ; From 856173f54e20f82ab8eb78e99f58e0c4234b930f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 30 Mar 2008 10:46:07 -0500 Subject: [PATCH 199/219] Add unit test --- extra/io/sockets/sockets-tests.factor | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 extra/io/sockets/sockets-tests.factor diff --git a/extra/io/sockets/sockets-tests.factor b/extra/io/sockets/sockets-tests.factor new file mode 100644 index 0000000000..1810b8587b --- /dev/null +++ b/extra/io/sockets/sockets-tests.factor @@ -0,0 +1,4 @@ +IN: io.sockets.tests +USING: io.sockets sequences math tools.test ; + +[ t ] [ "localhost" 80 f resolve-host length 1 >= ] unit-test From cb7d655639a412581b8c7036c68ae8141d900f17 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 30 Mar 2008 10:55:47 -0500 Subject: [PATCH 200/219] move addrinfo into *bsd files --- extra/unix/bsd/bsd.factor | 10 ---------- extra/unix/bsd/freebsd/freebsd.factor | 11 +++++++++++ extra/unix/bsd/macosx/macosx.factor | 11 +++++++++++ extra/unix/bsd/netbsd/netbsd.factor | 11 +++++++++++ extra/unix/bsd/openbsd/openbsd.factor | 11 +++++++++++ 5 files changed, 44 insertions(+), 10 deletions(-) diff --git a/extra/unix/bsd/bsd.factor b/extra/unix/bsd/bsd.factor index cb7b347c20..6cb5d6385b 100755 --- a/extra/unix/bsd/bsd.factor +++ b/extra/unix/bsd/bsd.factor @@ -24,16 +24,6 @@ IN: unix : F_SETFL 4 ; inline : O_NONBLOCK 4 ; inline -C-STRUCT: addrinfo - { "int" "flags" } - { "int" "family" } - { "int" "socktype" } - { "int" "protocol" } - { "socklen_t" "addrlen" } - { "char*" "canonname" } - { "void*" "addr" } - { "addrinfo*" "next" } ; - C-STRUCT: sockaddr-in { "uchar" "len" } { "uchar" "family" } diff --git a/extra/unix/bsd/freebsd/freebsd.factor b/extra/unix/bsd/freebsd/freebsd.factor index 94bb708527..f25cbd1537 100644 --- a/extra/unix/bsd/freebsd/freebsd.factor +++ b/extra/unix/bsd/freebsd/freebsd.factor @@ -1,3 +1,14 @@ +USING: alien.syntax ; IN: unix : FD_SETSIZE 1024 ; + +C-STRUCT: addrinfo + { "int" "flags" } + { "int" "family" } + { "int" "socktype" } + { "int" "protocol" } + { "socklen_t" "addrlen" } + { "char*" "canonname" } + { "void*" "addr" } + { "addrinfo*" "next" } ; diff --git a/extra/unix/bsd/macosx/macosx.factor b/extra/unix/bsd/macosx/macosx.factor index 3c0617ad17..edef2aaa0c 100644 --- a/extra/unix/bsd/macosx/macosx.factor +++ b/extra/unix/bsd/macosx/macosx.factor @@ -1,3 +1,14 @@ +USING: alien.syntax ; IN: unix : FD_SETSIZE 1024 ; inline + +C-STRUCT: addrinfo + { "int" "flags" } + { "int" "family" } + { "int" "socktype" } + { "int" "protocol" } + { "socklen_t" "addrlen" } + { "char*" "canonname" } + { "void*" "addr" } + { "addrinfo*" "next" } ; diff --git a/extra/unix/bsd/netbsd/netbsd.factor b/extra/unix/bsd/netbsd/netbsd.factor index ac18749830..071daa682d 100644 --- a/extra/unix/bsd/netbsd/netbsd.factor +++ b/extra/unix/bsd/netbsd/netbsd.factor @@ -1,3 +1,14 @@ +USING: alien.syntax ; IN: unix : FD_SETSIZE 256 ; inline + +C-STRUCT: addrinfo + { "int" "flags" } + { "int" "family" } + { "int" "socktype" } + { "int" "protocol" } + { "socklen_t" "addrlen" } + { "char*" "canonname" } + { "void*" "addr" } + { "addrinfo*" "next" } ; diff --git a/extra/unix/bsd/openbsd/openbsd.factor b/extra/unix/bsd/openbsd/openbsd.factor index 3c0617ad17..29b44f7da6 100644 --- a/extra/unix/bsd/openbsd/openbsd.factor +++ b/extra/unix/bsd/openbsd/openbsd.factor @@ -1,3 +1,14 @@ +USING: alien.syntax ; IN: unix : FD_SETSIZE 1024 ; inline + +C-STRUCT: addrinfo + { "int" "flags" } + { "int" "family" } + { "int" "socktype" } + { "int" "protocol" } + { "socklen_t" "addrlen" } + { "void*" "addr" } + { "char*" "canonname" } + { "addrinfo*" "next" } ; From d367dc8462397b6de8f162098516d57b18533959 Mon Sep 17 00:00:00 2001 From: sheeple Date: Sun, 30 Mar 2008 12:21:44 -0500 Subject: [PATCH 201/219] fix gdb on freebsd --- extra/tools/disassembler/disassembler.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/extra/tools/disassembler/disassembler.factor b/extra/tools/disassembler/disassembler.factor index 479ae9c42c..927f7111fa 100755 --- a/extra/tools/disassembler/disassembler.factor +++ b/extra/tools/disassembler/disassembler.factor @@ -26,11 +26,14 @@ M: pair make-disassemble-cmd M: method-spec make-disassemble-cmd first2 method make-disassemble-cmd ; +: gdb-binary ( -- string ) + os "freebsd" = "gdb66" "gdb" ? ; + : run-gdb ( -- lines ) +closed+ >>stdin out-file >>stdout - [ "gdb" , "-x" , in-file , "-batch" , ] { } make >>command + [ gdb-binary , "-x" , in-file , "-batch" , ] { } make >>command try-process out-file ascii file-lines ; From 6ece2fbde270b4b1c725f84e09e701fc66723642 Mon Sep 17 00:00:00 2001 From: erg Date: Sun, 30 Mar 2008 14:48:49 -0500 Subject: [PATCH 202/219] fix copy-tree --- core/io/files/files.factor | 20 +++++++++++++------- extra/io/unix/files/files.factor | 3 --- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 4dbbb869c4..458a9145a6 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -153,6 +153,9 @@ HOOK: make-link io-backend ( path1 path2 -- ) HOOK: read-link io-backend ( path -- info ) +: copy-link ( path1 path2 -- ) + >r read-link r> make-link ; + SYMBOL: +regular-file+ SYMBOL: +directory+ SYMBOL: +character-device+ @@ -264,13 +267,16 @@ M: object copy-file DEFER: copy-tree-into : copy-tree ( from to -- ) - over link-info type>> +directory+ = [ - >r dup directory r> rot [ - [ >r first r> copy-tree-into ] curry each - ] with-directory - ] [ - copy-file - ] if ; + over link-info type>> + { + { +symbolic-link+ [ copy-link ] } + { +directory+ [ + >r dup directory r> rot [ + [ >r first r> copy-tree-into ] curry each + ] with-directory + ] } + [ drop copy-file ] + } case ; : copy-tree-into ( from to -- ) to-directory copy-tree ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 759ac2bec1..c4e506d37f 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -108,6 +108,3 @@ M: unix-io read-link ( path -- path' ) normalize-pathname PATH_MAX [ tuck ] [ ] bi readlink dup io-error head-slice >string ; - -: copy-link ( path1 path2 -- ) - >r read-link r> make-link ; From 71283f7fc59ca52e8b63ebae8320d0cdbc79e529 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 17:21:58 -0500 Subject: [PATCH 203/219] Documentation update --- core/kernel/kernel-docs.factor | 39 +++++++++++++++++++++++++++++++++- 1 file changed, 38 insertions(+), 1 deletion(-) diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 1c88f5a485..b1120de8e6 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -545,7 +545,7 @@ HELP: 2bi "If " { $snippet "[ p ]" } " and " { $snippet "[ q ]" } " have stack effect " { $snippet "( x y -- z )" } ", then the following two lines are equivalent:" { $code "[ p ] [ q ] 2bi" - "2dup p swap q" + "2dup p -rot q" } "In general, the following two lines are equivalent:" { $code @@ -554,6 +554,27 @@ HELP: 2bi } } ; +HELP: 3bi +{ $values { "x" object } { "y" object } { "z" object } { "p" "a quotation with stack effect " { $snippet "( x y z -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( x y z -- ... )" } } } +{ $description "Applies " { $snippet "p" } " to the two input values, then applies " { $snippet "q" } " to the two input values." } +{ $examples + "If " { $snippet "[ p ]" } " and " { $snippet "[ q ]" } " have stack effect " { $snippet "( x y z -- )" } ", then the following two lines are equivalent:" + { $code + "[ p ] [ q ] 3bi" + "3dup p q" + } + "If " { $snippet "[ p ]" } " and " { $snippet "[ q ]" } " have stack effect " { $snippet "( x y z -- w )" } ", then the following two lines are equivalent:" + { $code + "[ p ] [ q ] 3bi" + "3dup p -roll q" + } + "In general, the following two lines are equivalent:" + { $code + "[ p ] [ q ] 3bi" + "[ p ] 3keep q" + } +} ; + HELP: tri { $values { "x" object } { "p" "a quotation with stack effect " { $snippet "( x -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( x -- ... )" } } { "r" "a quotation with stack effect " { $snippet "( x -- ... )" } } } { $description "Applies " { $snippet "p" } " to " { $snippet "x" } ", then applies " { $snippet "q" } " to " { $snippet "x" } ", and finally applies " { $snippet "r" } " to " { $snippet "x" } "." } @@ -591,6 +612,22 @@ HELP: 2tri } } ; +HELP: 3tri +{ $values { "x" object } { "y" object } { "z" object } { "p" "a quotation with stack effect " { $snippet "( x y z -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( x y z -- ... )" } } { "r" "a quotation with stack effect " { $snippet "( x y z -- ... )" } } } +{ $description "Applies " { $snippet "p" } " to the three input values, then applies " { $snippet "q" } " to the three input values, and finally applies " { $snippet "r" } " to the three input values." } +{ $examples + "If " { $snippet "[ p ]" } ", " { $snippet "[ q ]" } " and " { $snippet "[ r ]" } " have stack effect " { $snippet "( x y z -- )" } ", then the following two lines are equivalent:" + { $code + "[ p ] [ q ] [ r ] 3tri" + "3dup p 3dup q r" + } + "In general, the following two lines are equivalent:" + { $code + "[ p ] [ q ] [ r ] 3tri" + "[ p ] 3keep [ q ] 3keep r" + } +} ; + HELP: bi* { $values { "x" object } { "y" object } { "p" "a quotation with stack effect " { $snippet "( x -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( y -- ... )" } } } From cd85b545bd28d0c1cde36376a2f60acc98a1cf12 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 17:23:42 -0500 Subject: [PATCH 204/219] Cleaning up tuples --- core/classes/tuple/tuple.factor | 99 ++++++++++++++++++++------------- core/slots/slots.factor | 3 - 2 files changed, 59 insertions(+), 43 deletions(-) diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index a452d0eeec..401a421c51 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -23,8 +23,15 @@ M: class tuple-layout "layout" word-prop ; M: tuple tuple-layout 1 slot ; +M: tuple-layout tuple-layout ; : tuple-size tuple-layout layout-size ; inline +: prepare-tuple>array ( tuple -- n tuple layout ) + [ tuple-size ] [ ] [ tuple-layout ] tri ; + +: copy-tuple-slots ( n tuple first -- array ) + [ array-nth ] curry map r> add* ; + PRIVATE> : check-tuple ( class -- ) @@ -32,28 +39,29 @@ PRIVATE> [ drop ] [ no-tuple-class ] if ; : tuple>array ( tuple -- array ) - dup tuple-layout - [ layout-size swap [ array-nth ] curry map ] keep - layout-class add* ; + prepare-tuple>array >r copy-tuple-slots r> layout-class add* ; -: >tuple ( seq -- tuple ) - dup first tuple-layout [ - >r 1 tail-slice dup length r> - [ tuple-size min ] keep - [ set-array-nth ] curry - 2each +: tuple-slots ( tuple -- array ) + prepare-tuple>array drop copy-tuple-slots ; + +: slots>tuple ( tuple class -- array ) + tuple-layout [ + [ tuple-size ] [ [ set-array-nth ] curry ] bi 2each ] keep ; +: >tuple ( tuple -- array ) + unclip slots>tuple ; + : slot-names ( class -- seq ) - "slots" word-prop [ name>> ] map ; + "slot-names" word-prop ; r over r> array-nth >r array-nth r> = ] 2curry - all-integers? + 2dup [ tuple-layout ] bi@ eq? [ + [ drop tuple-size ] + [ [ [ drop array-nth ] [ nip array-nth ] 3bi = ] 2curry ] + 2bi all-integers? ] [ 2drop f ] if ; @@ -92,18 +100,19 @@ PRIVATE> superclasses 1 head-slice* [ slot-names length ] map sum ; -: generate-tuple-slots ( class slots -- slots ) +: generate-tuple-slots ( class slots -- slot-specs ) over superclass-size 2 + simple-slots ; -: define-tuple-slots ( class slots -- ) - dupd generate-tuple-slots +: define-tuple-slots ( class -- ) + dup dup slot-names generate-tuple-slots [ "slots" set-word-prop ] - [ define-accessors ] - [ define-slots ] 2tri ; + [ define-accessors ] ! new + [ define-slots ] ! old + 2tri ; : make-tuple-layout ( class -- layout ) [ ] - [ [ superclass-size ] [ "slots" word-prop length ] bi + ] + [ [ superclass-size ] [ slot-names length ] bi + ] [ superclasses dup length 1- ] tri ; @@ -113,7 +122,7 @@ PRIVATE> : removed-slots ( class newslots -- seq ) swap slot-names seq-diff ; -: forget-slots ( class slots -- ) +: forget-removed-slots ( class slots -- ) dupd removed-slots [ [ reader-word forget-method ] [ writer-word forget-method ] 2bi @@ -122,36 +131,48 @@ PRIVATE> : permutation ( seq1 seq2 -- permutation ) swap [ index ] curry map ; -: reshape-tuple ( oldtuple permutation -- newtuple ) - >r tuple>array 2 cut r> - [ [ swap ?nth ] [ drop f ] if* ] with map - append >tuple ; +: all-slot-names ( class -- slots ) + superclasses [ slot-names ] map concat \ class add* ; -: reshape-tuples ( class superclass newslots -- ) - nip - >r dup slot-names r> permutation - [ - >r "predicate" word-prop instances dup - r> [ reshape-tuple ] curry map - become - ] 2curry after-compilation ; +: slot-permutation ( class superclass newslots -- n permutation ) + [ all-slot-names ] [ all-slot-names ] [ ] tri* append + [ drop length ] [ permutation ] 2bi ; + +: permute-direct-slots ( oldslots permutation -- newslots ) + [ [ swap ?nth ] [ drop f ] if* ] with map ; + +: permute-all-slots ( oldslots n permutation -- newslots ) + [ >r head r> permute-direct-slots ] [ drop tail ] 3bi append ; + +: change-tuple ( tuple quot -- newtuple ) + >r tuple>array r> call >tuple ; inline + +: update-tuples ( predicate n permutation -- ) + [ permute-all-slots ] 2curry [ change-tuple ] curry + >r "predicate" word-prop instances dup r> map + become ; inline + +: update-tuples-after ( class superclass newslots -- ) + [ 2drop ] [ slot-permutation ] 3bi + [ update-tuples ] 3curry after-compilation ; : define-new-tuple-class ( class superclass slots -- ) [ drop f tuple-class define-class ] - [ nip define-tuple-slots ] [ + [ nip "slot-names" set-word-prop ] [ 2drop class-usages keys [ tuple-class? ] subset [ + [ define-tuple-slots ] [ define-tuple-layout ] [ define-tuple-predicate ] - bi + tri ] each ] 3tri ; : redefine-tuple-class ( class superclass slots -- ) - [ reshape-tuples ] + [ update-tuples-after ] [ nip - [ forget-slots ] + [ forget-removed-slots ] [ drop changed-word ] [ drop redefined ] 2tri @@ -175,7 +196,7 @@ M: tuple-class define-tuple-class 3drop ; : define-error-class ( class superclass slots -- ) - pick >r define-tuple-class r> + [ define-tuple-class ] [ 2drop ] 3bi dup [ construct-boa throw ] curry define ; M: tuple clone @@ -196,8 +217,6 @@ M: tuple hashcode* ] 2curry reduce ] recursive-hashcode ; -: tuple-slots ( tuple -- seq ) tuple>array 2 tail ; - ! Definition protocol M: tuple-class reset-class { "metaclass" "superclass" "slots" "layout" } reset-props ; diff --git a/core/slots/slots.factor b/core/slots/slots.factor index dfd5c1b32a..eeb0926308 100755 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -23,9 +23,6 @@ C: slot-spec [ drop ] [ 1array , \ declare , ] if ] [ ] make ; -: slot-named ( name specs -- spec/f ) - [ slot-spec-name = ] with find nip ; - : create-accessor ( name effect -- word ) >r "accessors" create dup r> "declared-effect" set-word-prop ; From c30a8a68ee6216b3140836e9f77c7306f48a5111 Mon Sep 17 00:00:00 2001 From: erg Date: Sun, 30 Mar 2008 18:22:35 -0500 Subject: [PATCH 205/219] refactor mersenne-twister to not use new-effects --- .../mersenne-twister/mersenne-twister.factor | 38 ++++++++++--------- 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index ad9dae51ae..4c4bc8286f 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -4,11 +4,14 @@ ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c USING: arrays kernel math namespaces sequences system init -accessors math.ranges new-effects random ; +accessors math.ranges random ; IN: random.mersenne-twister r over r> [ curry ] 2bi@ ; + TUPLE: mersenne-twister seq i ; : mt-n 624 ; inline @@ -19,34 +22,33 @@ TUPLE: mersenne-twister seq i ; : wrap ( x n -- y ) 2dup >= [ - ] [ drop ] if ; inline : mt-wrap ( x -- y ) mt-n wrap ; inline -: set-generated ( mt y from-elt to -- ) - >r >r [ 2/ ] [ odd? mt-a 0 ? ] bi - r> bitxor bitxor r> new-set-nth drop ; inline +: set-generated ( y from-elt to seq -- ) + >r >r >r [ 2/ ] [ odd? mt-a 0 ? ] bi + r> bitxor bitxor r> r> set-nth ; inline -: calculate-y ( mt y1 y2 -- y ) - >r over r> - [ new-nth mt-hi ] [ new-nth mt-lo ] 2bi* bitor ; inline +: calculate-y ( y1 y2 mt -- y ) + [ nth mt-hi ] [ nth mt-lo ] curry2 bi* bitor ; inline -: (mt-generate) ( mt-seq n -- y to from-elt ) - [ dup 1+ mt-wrap calculate-y ] - [ mt-m + mt-wrap new-nth ] - [ nip ] 2tri ; +: (mt-generate) ( n mt-seq -- y to from-elt ) + [ >r dup 1+ mt-wrap r> calculate-y ] + [ >r mt-m + mt-wrap r> nth ] + [ drop ] 2tri ; : mt-generate ( mt -- ) - [ seq>> mt-n [ dupd (mt-generate) set-generated ] with each ] + [ >r mt-n r> seq>> [ [ (mt-generate) ] keep set-generated ] curry each ] [ 0 >>i drop ] bi ; : init-mt-first ( seed -- seq ) >r mt-n 0 r> - HEX: ffffffff bitand 0 new-set-nth ; + HEX: ffffffff bitand 0 pick set-nth ; : init-mt-formula ( seq i -- f(seq[i]) ) - tuck new-nth dup -30 shift bitxor 1812433253 * + + tuck swap nth dup -30 shift bitxor 1812433253 * + 1+ HEX: ffffffff bitand ; : init-mt-rest ( seq -- ) mt-n 1- [0,b) [ - dupd [ init-mt-formula ] keep 1+ new-set-nth drop + dupd [ init-mt-formula ] keep 1+ rot set-nth ] with each ; : init-mt-seq ( seed -- seq ) @@ -68,7 +70,7 @@ M: mersenne-twister seed-random ( mt seed -- ) init-mt-seq >>seq drop ; M: mersenne-twister random-32* ( mt -- r ) - dup [ seq>> ] [ i>> ] bi - dup mt-n < [ drop 0 pick mt-generate ] unless - new-nth mt-temper + dup [ i>> ] [ seq>> ] bi + over mt-n < [ nip >r dup mt-generate 0 r> ] unless + nth mt-temper swap [ 1+ ] change-i drop ; From 55a69392faadff0988a49696f734562491e484d0 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Mon, 31 Mar 2008 13:52:42 +1300 Subject: [PATCH 206/219] First cut at variables in ebnf --- extra/peg/ebnf/ebnf.factor | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index 41b5a1b655..e9ec0dc4e2 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -3,7 +3,7 @@ USING: kernel compiler.units parser words arrays strings math.parser sequences quotations vectors namespaces math assocs continuations peg peg.parsers unicode.categories multiline combinators.lib - splitting accessors effects ; + splitting accessors effects sequences.deep ; IN: peg.ebnf TUPLE: ebnf-non-terminal symbol ; @@ -227,15 +227,17 @@ GENERIC: (transform) ( ast -- parser ) SYMBOL: parser SYMBOL: main +SYMBOL: vars : transform ( ast -- object ) - H{ } clone dup dup [ parser set swap (transform) main set ] bind ; + H{ } clone dup dup [ parser set V{ } vars set swap (transform) main set ] bind ; M: ebnf (transform) ( ast -- parser ) rules>> [ (transform) ] map peek ; M: ebnf-rule (transform) ( ast -- parser ) - dup elements>> (transform) [ + dup elements>> + vars get clone vars [ (transform) ] with-variable [ swap symbol>> set ] keep ; @@ -270,12 +272,26 @@ M: ebnf-repeat1 (transform) ( ast -- parser ) M: ebnf-optional (transform) ( ast -- parser ) transform-group optional ; +: build-locals ( string vars -- string ) + dup empty? [ + drop + ] [ + [ + "[let* | " % + [ dup % " [ \"" % % "\" get ] " % ] each + " | " % + % + " ] with-locals" % + ] "" make + ] if ; + M: ebnf-action (transform) ( ast -- parser ) [ parser>> (transform) ] keep - code>> string-lines [ parse-lines ] with-compilation-unit action ; + code>> vars get build-locals string-lines [ parse-lines ] with-compilation-unit action ; M: ebnf-var (transform) ( ast -- parser ) - parser>> (transform) ; + [ parser>> (transform) ] [ name>> ] bi + dup vars get push [ dupd set ] curry action ; M: ebnf-terminal (transform) ( ast -- parser ) symbol>> token sp ; @@ -303,7 +319,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) : ebnf>quot ( string -- hashtable quot ) 'ebnf' parse check-parse-result parse-result-ast transform dup dup parser [ main swap at compile ] with-variable - [ compiled-parse ] curry ; + [ compiled-parse ] curry [ with-scope ] curry ; : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing From a098790634503dfc03eb24969a4fbaff7f7512f5 Mon Sep 17 00:00:00 2001 From: Matthew Willis Date: Sun, 30 Mar 2008 17:58:47 -0700 Subject: [PATCH 207/219] Updated extra/match to use bi@ instead of 2apply. Ran "peg" test for testing. --- extra/match/match.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/match/match.factor b/extra/match/match.factor index dbc42f53e3..825d58c7c2 100755 --- a/extra/match/match.factor +++ b/extra/match/match.factor @@ -70,7 +70,7 @@ MACRO: match-cond ( assoc -- ) dup length zero? not [ 1 tail ] [ drop f ] if ; : (match-first) ( seq pattern-seq -- bindings leftover/f ) - 2dup [ length ] 2apply < [ 2drop f f ] + 2dup [ length ] bi@ < [ 2drop f f ] [ 2dup length head over match [ nip swap ?1-tail ] [ >r 1 tail r> (match-first) ] if* From ee2194d1dc1eb4df9072dae9ce50a9bb13353b98 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Mon, 31 Mar 2008 14:03:16 +1300 Subject: [PATCH 208/219] Allow variable names on elements --- extra/peg/ebnf/ebnf.factor | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index e9ec0dc4e2..f98b08093a 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -102,7 +102,7 @@ C: ebnf "]" syntax , ] seq* [ first >string ] action ; -: 'element' ( -- parser ) +: ('element') ( -- parser ) #! An element of a rule. It can be a terminal or a #! non-terminal but must not be followed by a "=". #! The latter indicates that it is the beginning of a @@ -120,6 +120,12 @@ C: ebnf ] choice* , ] seq* [ first ] action ; +: 'element' ( -- parser ) + [ + [ ('element') , ":" syntax , "a-zA-Z" range-pattern repeat1 [ >string ] action , ] seq* [ first2 ] action , + ('element') , + ] choice* ; + DEFER: 'choice' : grouped ( quot suffix -- parser ) From 729ac1d6dc18ddfd26aebae44d27c6ea62eec767 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Mon, 31 Mar 2008 14:59:22 +1300 Subject: [PATCH 209/219] Some ebnf tweaks and tests to do with variables --- extra/peg/ebnf/ebnf-tests.factor | 9 ++++++++- extra/peg/ebnf/ebnf.factor | 2 +- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index 7aa61e84da..cf16fad2cd 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: kernel tools.test peg peg.ebnf words ; +USING: kernel tools.test peg peg.ebnf words math math.parser ; IN: peg.ebnf.tests { T{ ebnf-non-terminal f "abc" } } [ @@ -160,6 +160,13 @@ IN: peg.ebnf.tests "1-1" [EBNF foo='1' '+' '1' => [[ drop "foo" ]] | '1' '-' '1' => [[ drop "bar" ]] EBNF] call parse-result-ast ] unit-test +{ 6 } [ + "4+2" [EBNF num=[0-9] => [[ digit> ]] foo=num:x '+' num:y => [[ drop x y + ]] EBNF] call parse-result-ast +] unit-test + +{ 6 } [ + "4+2" [EBNF foo=[0-9]:x '+' [0-9]:y => [[ drop x digit> y digit> + ]] EBNF] call parse-result-ast +] unit-test { V{ V{ 49 } "+" V{ 49 } } } [ #! Test direct left recursion. diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index f98b08093a..74b3e3540d 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -283,7 +283,7 @@ M: ebnf-optional (transform) ( ast -- parser ) drop ] [ [ - "[let* | " % + "USING: locals namespaces ; [let* | " % [ dup % " [ \"" % % "\" get ] " % ] each " | " % % From c45eba68987e41ad14e0cc817079801e713af1b8 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Mon, 31 Mar 2008 16:34:59 +1300 Subject: [PATCH 210/219] Add semantic parser --- extra/peg/peg-docs.factor | 13 +++++++++++++ extra/peg/peg.factor | 20 ++++++++++++++++++++ 2 files changed, 33 insertions(+) diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor index e7bd255569..c54a39b7b0 100644 --- a/extra/peg/peg-docs.factor +++ b/extra/peg/peg-docs.factor @@ -95,6 +95,19 @@ HELP: optional "Returns a parser that parses 0 or 1 instances of the 'p1' parser. The AST produced is " "'f' if 0 instances are parsed the AST produced is 'f', otherwise it is the AST produced by 'p1'." } ; +HELP: semantic +{ $values + { "parser" "a parser" } + { "quot" "a quotation with stack effect ( object -- bool )" } +} +{ $description + "Returns a parser that succeeds if the 'p1' parser succeeds and the quotation called with " + "the AST produced by 'p1' on the stack returns true." } +{ $examples + { $example "\"A\" [ drop t ] satisfy [ 66 > ] semantic parse" "f" } + { $example "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse parse-result-ast " "67" } +} ; + HELP: ensure { $values { "parser" "a parser" } diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 43eb9e8d9e..9e35c5b9be 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -414,6 +414,23 @@ TUPLE: optional-parser p1 ; M: optional-parser (compile) ( parser -- quot ) p1>> compiled-parser \ ?quot optional-pattern match-replace ; +TUPLE: semantic-parser p1 quot ; + +MATCH-VARS: ?parser ; + +: semantic-pattern ( -- quot ) + [ + ?parser [ + dup parse-result-ast ?quot call [ drop f ] unless + ] [ + f + ] if* + ] ; + +M: semantic-parser (compile) ( parser -- quot ) + [ p1>> compiled-parser ] [ quot>> ] bi + 2array { ?parser ?quot } semantic-pattern match-replace ; + TUPLE: ensure-parser p1 ; : ensure-pattern ( -- quot ) @@ -546,6 +563,9 @@ PRIVATE> : optional ( parser -- parser ) optional-parser construct-boa init-parser ; +: semantic ( parser quot -- parser ) + semantic-parser construct-boa init-parser ; + : ensure ( parser -- parser ) ensure-parser construct-boa init-parser ; From 8aa676ab1eda35b0d6011fbbb2689e12215664f7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 22:42:36 -0500 Subject: [PATCH 211/219] Documentation fixes --- core/continuations/continuations-docs.factor | 1 + core/debugger/debugger-docs.factor | 10 +++++++++- extra/help/handbook/handbook.factor | 1 + extra/help/markup/markup.factor | 3 +-- 4 files changed, 12 insertions(+), 3 deletions(-) diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor index 7209b7ec4d..ca7af930f2 100755 --- a/core/continuations/continuations-docs.factor +++ b/core/continuations/continuations-docs.factor @@ -29,6 +29,7 @@ $nl { $subsection ignore-errors } "Unhandled errors are reported in the listener and can be debugged using various tools. See " { $link "debugger" } "." { $subsection "errors-restartable" } +{ $subsection "debugger" } { $subsection "errors-post-mortem" } "When Factor encouters a critical error, it calls the following word:" { $subsection die } ; diff --git a/core/debugger/debugger-docs.factor b/core/debugger/debugger-docs.factor index 5e8b6df34a..f8b53d4abc 100755 --- a/core/debugger/debugger-docs.factor +++ b/core/debugger/debugger-docs.factor @@ -86,7 +86,15 @@ HELP: error-hook HELP: try { $values { "quot" "a quotation" } } -{ $description "Calls the quotation. If it throws an error, calls " { $link error-hook } " with the error and restores the data stack." } ; +{ $description "Attempts to call a quotation; if it throws an error, the " { $link error-hook } " gets called, stacks are restored, and execution continues after the call to " { $link try } "." } +{ $examples + "The following example prints an error and keeps going:" + { $code + "[ \"error\" throw ] try" + "\"still running...\" print" + } + { $link "listener" } " uses " { $link try } " to recover from user errors." +} ; HELP: expired-error. { $error-description "Thrown by " { $link alien-address } " and " { $link alien-invoke } " if an " { $link alien } " object passed in as a parameter has expired. Alien objects expire if they are saved an image which is subsequently loaded; this prevents a certain class of programming errors, usually attempts to use uninitialized objects, since holding a C address is meaningless between sessions." } diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index 912c3c35f3..1c2dfde85c 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -206,6 +206,7 @@ ARTICLE: "tools" "Developer tools" { $subsection "tools.vocabs" } "Exploratory tools:" { $subsection "editor" } +{ $subsection "listener" } { $subsection "tools.crossref" } { $subsection "inspector" } "Debugging tools:" diff --git a/extra/help/markup/markup.factor b/extra/help/markup/markup.factor index 5dc7255eed..f8d360fd0a 100755 --- a/extra/help/markup/markup.factor +++ b/extra/help/markup/markup.factor @@ -138,8 +138,7 @@ M: f print-element drop ; link-style get [ write-object ] with-style ; : ($link) ( article -- ) - dup article-name swap >link write-link - span last-element set ; + [ dup article-name swap >link write-link ] ($span) ; : $link ( element -- ) first ($link) ; From f66774e87564aa5f6d66f80dd00c72b2db456700 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Mon, 31 Mar 2008 16:50:05 +1300 Subject: [PATCH 212/219] Add tests for semantic and add syntax for it to ebnf Syntax is ?[ ...]? For example: [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] { 1 2 3 4 5 6 } swap call . --- extra/peg/ebnf/ebnf-tests.factor | 12 ++++++++++++ extra/peg/ebnf/ebnf.factor | 16 ++++++++++++---- extra/peg/peg-tests.factor | 13 +++++++++++-- 3 files changed, 35 insertions(+), 6 deletions(-) diff --git a/extra/peg/ebnf/ebnf-tests.factor b/extra/peg/ebnf/ebnf-tests.factor index cf16fad2cd..4f802c5207 100644 --- a/extra/peg/ebnf/ebnf-tests.factor +++ b/extra/peg/ebnf/ebnf-tests.factor @@ -168,6 +168,18 @@ IN: peg.ebnf.tests "4+2" [EBNF foo=[0-9]:x '+' [0-9]:y => [[ drop x digit> y digit> + ]] EBNF] call parse-result-ast ] unit-test +{ 10 } [ + { 1 2 3 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] call parse-result-ast +] unit-test + +{ f } [ + { "a" 2 3 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] call +] unit-test + +{ 3 } [ + { 1 2 "a" 4 } [EBNF num=. ?[ number? ]? list=list:x num:y => [[ drop x y + ]] | num EBNF] call parse-result-ast +] unit-test + { V{ V{ 49 } "+" V{ 49 } } } [ #! Test direct left recursion. #! Using packrat, so first part of expr fails, causing 2nd choice to be used diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index 74b3e3540d..4f00edbd3c 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -20,6 +20,7 @@ TUPLE: ebnf-optional group ; TUPLE: ebnf-rule symbol elements ; TUPLE: ebnf-action parser code ; TUPLE: ebnf-var parser name ; +TUPLE: ebnf-semantic parser code ; TUPLE: ebnf rules ; C: ebnf-non-terminal @@ -36,6 +37,7 @@ C: ebnf-optional C: ebnf-rule C: ebnf-action C: ebnf-var +C: ebnf-semantic C: ebnf : syntax ( string -- parser ) @@ -156,6 +158,7 @@ DEFER: 'choice' : 'factor-code' ( -- parser ) [ "]]" token ensure-not , + "]?" token ensure-not , [ drop t ] satisfy , ] seq* [ first ] action repeat0 [ >string ] action ; @@ -193,14 +196,15 @@ DEFER: 'choice' : 'action' ( -- parser ) "[[" 'factor-code' "]]" syntax-pack ; +: 'semantic' ( -- parser ) + "?[" 'factor-code' "]?" syntax-pack ; + : 'sequence' ( -- parser ) #! A sequence of terminals and non-terminals, including #! groupings of those. [ - [ - ('sequence') , - 'action' , - ] seq* [ first2 ] action , + [ ('sequence') , 'action' , ] seq* [ first2 ] action , + [ ('sequence') , 'semantic' , ] seq* [ first2 ] action , ('sequence') , ] choice* repeat1 [ dup length 1 = [ first ] [ ] if @@ -295,6 +299,10 @@ M: ebnf-action (transform) ( ast -- parser ) [ parser>> (transform) ] keep code>> vars get build-locals string-lines [ parse-lines ] with-compilation-unit action ; +M: ebnf-semantic (transform) ( ast -- parser ) + [ parser>> (transform) ] keep + code>> vars get build-locals string-lines [ parse-lines ] with-compilation-unit semantic ; + M: ebnf-var (transform) ( ast -- parser ) [ parser>> (transform) ] [ name>> ] bi dup vars get push [ dupd set ] curry action ; diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index f57fe83220..fcec33f7c2 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. ! -USING: kernel tools.test strings namespaces arrays sequences peg peg.private accessors words ; +USING: kernel tools.test strings namespaces arrays sequences peg peg.private accessors words math ; IN: peg.tests { f } [ @@ -182,4 +182,13 @@ IN: peg.tests [ f , "a" token , ] seq* dup parsers>> dupd 0 swap set-nth compile word? -] unit-test \ No newline at end of file +] unit-test + +{ f } [ + "A" [ drop t ] satisfy [ 66 >= ] semantic parse +] unit-test + +{ CHAR: B } [ + "B" [ drop t ] satisfy [ 66 >= ] semantic parse parse-result-ast +] unit-test + From a41f8ef7338d565329ca8d0cb646e3746032ccd2 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Mon, 31 Mar 2008 17:26:42 +1300 Subject: [PATCH 213/219] Mention how to fail from action in pegs --- extra/peg/peg-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor index c54a39b7b0..5f200be78e 100644 --- a/extra/peg/peg-docs.factor +++ b/extra/peg/peg-docs.factor @@ -137,7 +137,7 @@ HELP: action "Returns a parser that calls the 'p1' parser and applies the quotation to the AST resulting " "from that parse. The result of the quotation is then used as the final AST. This can be used " "for manipulating the parse tree to produce a AST better suited for the task at hand rather than " - "the default AST." } + "the default AST. If the quotation returns " { $link fail } " then the parser fails." } { $code "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ; HELP: sp From d87667f903c3dd33fda10e5cc8a74fc3cc0e02de Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 30 Mar 2008 23:54:57 -0500 Subject: [PATCH 214/219] Add inline declaration --- extra/random/mersenne-twister/mersenne-twister.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index 4c4bc8286f..ce1749ce62 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -10,7 +10,7 @@ IN: random.mersenne-twister r over r> [ curry ] 2bi@ ; + >r over r> [ curry ] 2bi@ ; inline TUPLE: mersenne-twister seq i ; From 2ebb7d22718b1b1e90943c5fd35a6a4915fb4e34 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 31 Mar 2008 01:19:21 -0500 Subject: [PATCH 215/219] Clean up bootstrap code a bit --- core/bootstrap/image/image.factor | 116 ++++++++++++++---------------- core/bootstrap/primitives.factor | 49 +++++++------ 2 files changed, 84 insertions(+), 81 deletions(-) diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index deb54fdeeb..5d49203554 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -12,7 +12,7 @@ io.encodings.binary ; IN: bootstrap.image : my-arch ( -- arch ) - cpu dup "ppc" = [ os "-" rot 3append ] when ; + cpu dup "ppc" = [ >r os "-" r> 3append ] when ; : boot-image-name ( arch -- string ) "boot." swap ".image" 3append ; @@ -55,7 +55,7 @@ IN: bootstrap.image : quot-xt@ 3 bootstrap-cells object tag-number - ; : jit-define ( quot rc rt offset name -- ) - >r >r >r >r { } make r> r> r> 4array r> set ; + >r { [ { } make ] [ ] [ ] [ ] } spread 4array r> set ; ! The image being constructed; a vector of word-size integers SYMBOL: image @@ -134,10 +134,10 @@ SYMBOL: undefined-quot : here ( -- size ) heap-size data-base + ; -: here-as ( tag -- pointer ) here swap bitor ; +: here-as ( tag -- pointer ) here bitor ; : align-here ( -- ) - here 8 mod 4 = [ heap-size drop 0 emit ] when ; + here 8 mod 4 = [ 0 emit ] when ; : emit-fixnum ( n -- ) tag-fixnum emit ; @@ -164,7 +164,7 @@ GENERIC: ' ( obj -- ptr ) userenv-size [ f ' emit ] times ; : emit-userenv ( symbol -- ) - dup get ' swap userenv-offset fixup ; + [ get ' ] [ userenv-offset ] bi fixup ; ! Bignums @@ -175,14 +175,15 @@ GENERIC: ' ( obj -- ptr ) : bignum>seq ( n -- seq ) #! n is positive or zero. [ dup 0 > ] - [ dup bignum-bits neg shift swap bignum-radix bitand ] + [ [ bignum-bits neg shift ] [ bignum-radix bitand ] bi ] [ ] unfold nip ; -USE: continuations : emit-bignum ( n -- ) - dup 0 < [ 1 swap neg ] [ 0 swap ] if bignum>seq - dup length 1+ emit-fixnum - swap emit emit-seq ; + dup dup 0 < [ neg ] when bignum>seq + [ nip length 1+ emit-fixnum ] + [ drop 0 < 1 0 ? emit ] + [ nip emit-seq ] + 2tri ; M: bignum ' bignum tag-number dup [ emit-bignum ] emit-object ; @@ -221,28 +222,33 @@ M: f ' ! Words : emit-word ( word -- ) - dup subwords [ emit-word ] each [ - dup hashcode ' , - dup word-name ' , - dup word-vocabulary ' , - dup word-def ' , - dup word-props ' , - f ' , - 0 , ! count - 0 , ! xt - 0 , ! code - 0 , ! profiling - ] { } make - \ word type-number object tag-number - [ emit-seq ] emit-object - swap objects get set-at ; + [ subwords [ emit-word ] each ] + [ + [ + { + [ hashcode , ] + [ word-name , ] + [ word-vocabulary , ] + [ word-def , ] + [ word-props , ] + } cleave + f , + 0 , ! count + 0 , ! xt + 0 , ! code + 0 , ! profiling + ] { } make [ ' ] map + ] bi + \ word type-number object tag-number + [ emit-seq ] emit-object + ] keep objects get set-at ; : word-error ( word msg -- * ) [ % dup word-vocabulary % " " % word-name % ] "" make throw ; : transfer-word ( word -- word ) - dup target-word swap or ; + [ target-word ] keep or ; : fixup-word ( word -- offset ) transfer-word dup objects get at @@ -285,9 +291,10 @@ M: string ' length 0 assert= ; : emit-dummy-array ( obj type -- ptr ) - swap assert-empty - type-number object tag-number - [ 0 emit-fixnum ] emit-object ; + [ assert-empty ] [ + type-number object tag-number + [ 0 emit-fixnum ] emit-object + ] bi* ; M: byte-array ' byte-array emit-dummy-array ; @@ -296,29 +303,28 @@ M: bit-array ' bit-array emit-dummy-array ; M: float-array ' float-array emit-dummy-array ; ! Tuples +: (emit-tuple) ( tuple -- pointer ) + [ tuple>array 1 tail-slice ] + [ class transfer-word tuple-layout ] bi add* [ ' ] map + tuple type-number dup [ emit-seq ] emit-object ; + : emit-tuple ( tuple -- pointer ) - [ - [ - dup class transfer-word tuple-layout ' , - tuple>array 1 tail-slice [ ' ] map % - ] { } make - tuple type-number dup [ emit-seq ] emit-object - ] - ! Hack - over class word-name "tombstone" = - [ objects get swap cache ] [ call ] if ; + dup class word-name "tombstone" = + [ objects get [ (emit-tuple) ] cache ] [ (emit-tuple) ] if ; M: tuple ' emit-tuple ; M: tuple-layout ' objects get [ [ - dup layout-hashcode ' , - dup layout-class ' , - dup layout-size ' , - dup layout-superclasses ' , - layout-echelon ' , - ] { } make + { + [ layout-hashcode , ] + [ layout-class , ] + [ layout-size , ] + [ layout-superclasses , ] + [ layout-echelon , ] + } cleave + ] { } make [ ' ] map \ tuple-layout type-number object tag-number [ emit-seq ] emit-object ] cache ; @@ -329,14 +335,9 @@ M: tombstone ' word-def first objects get [ emit-tuple ] cache ; ! Arrays -: emit-array ( list type tag -- pointer ) - >r >r [ ' ] map r> r> [ - dup length emit-fixnum - emit-seq - ] emit-object ; - M: array ' - array type-number object tag-number emit-array ; + [ ' ] map array type-number object tag-number + [ [ length emit-fixnum ] [ emit-seq ] bi ] emit-object ; ! Quotations @@ -351,13 +352,6 @@ M: quotation ' ] emit-object ] cache ; -! Curries - -M: curry ' - dup curry-quot ' swap curry-obj ' - \ curry type-number object tag-number - [ emit emit ] emit-object ; - ! End of the image : emit-words ( -- ) @@ -437,8 +431,8 @@ M: curry ' : write-image ( image -- ) "Writing image to " write architecture get boot-image-name resource-path - dup write "..." print flush - binary [ (write-image) ] with-stream ; + [ write "..." print flush ] + [ binary [ (write-image) ] with-stream ] bi ; PRIVATE> diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 2e1a7f9f57..bc876c2dec 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -5,7 +5,8 @@ hashtables.private io kernel math namespaces parser sequences strings vectors words quotations assocs layouts classes classes.tuple classes.tuple.private kernel.private vocabs vocabs.loader source-files definitions slots.deprecated -classes.union compiler.units bootstrap.image.private io.files ; +classes.union compiler.units bootstrap.image.private io.files +accessors combinators ; IN: bootstrap.primitives "Creating primitives and basic runtime structures..." print flush @@ -102,33 +103,36 @@ num-types get f builtins set ! Builtin classes : builtin-predicate-quot ( class -- quot ) [ - "type" word-prop dup - \ tag-mask get < \ tag \ type ? , , \ eq? , + "type" word-prop + [ tag-mask get < \ tag \ type ? , ] [ , ] bi + \ eq? , ] [ ] make ; : define-builtin-predicate ( class -- ) - dup - dup builtin-predicate-quot define-predicate - predicate-word make-inline ; + [ dup builtin-predicate-quot define-predicate ] + [ predicate-word make-inline ] + bi ; : lookup-type-number ( word -- n ) global [ target-word ] bind type-number ; : register-builtin ( class -- ) - dup - dup lookup-type-number "type" set-word-prop - dup "type" word-prop builtins get set-nth ; + [ dup lookup-type-number "type" set-word-prop ] + [ dup "type" word-prop builtins get set-nth ] + bi ; : define-builtin-slots ( symbol slotspec -- ) - dupd 1 simple-slots - 2dup "slots" set-word-prop - define-slots ; + [ drop ] [ 1 simple-slots ] 2bi + [ "slots" set-word-prop ] [ define-slots ] 2bi ; : define-builtin ( symbol slotspec -- ) >r - dup register-builtin - dup f f builtin-class define-class - dup define-builtin-predicate + { + [ register-builtin ] + [ f f builtin-class define-class ] + [ define-builtin-predicate ] + [ ] + } cleave r> define-builtin-slots ; ! Forward definitions @@ -335,7 +339,10 @@ define-builtin { "set-delegate" "kernel" } } } -define-tuple-slots +[ drop ] [ generate-tuple-slots ] 2bi +[ [ name>> ] map "slot-names" set-word-prop ] +[ "slots" set-word-prop ] +[ define-slots ] 2tri "tuple" "kernel" lookup define-tuple-layout @@ -495,8 +502,9 @@ f builtins get num-tags get tail union-class define-class } define-tuple-class "curry" "kernel" lookup -dup f "inline" set-word-prop -dup tuple-layout [ ] curry define +[ f "inline" set-word-prop ] +[ ] +[ tuple-layout [ ] curry ] tri define "compose" "kernel" create "tuple" "kernel" lookup @@ -515,8 +523,9 @@ dup tuple-layout [ ] curry define } define-tuple-class "compose" "kernel" lookup -dup f "inline" set-word-prop -dup tuple-layout [ ] curry define +[ f "inline" set-word-prop ] +[ ] +[ tuple-layout [ ] curry ] tri define ! Primitive words : make-primitive ( word vocab n -- ) From 6995e2adf5535194440fe5cac34087da2efda99e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 31 Mar 2008 01:19:34 -0500 Subject: [PATCH 216/219] Tuple reshaping now works with inheritance --- core/classes/tuple/tuple-docs.factor | 14 +---- core/classes/tuple/tuple-tests.factor | 88 +++++++++++++++++++++++--- core/classes/tuple/tuple.factor | 90 ++++++++++++++++----------- core/compiler/units/units.factor | 14 ++--- core/slots/slots.factor | 3 + 5 files changed, 142 insertions(+), 67 deletions(-) diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor index 7123d5c7c8..18c8143654 100755 --- a/core/classes/tuple/tuple-docs.factor +++ b/core/classes/tuple/tuple-docs.factor @@ -153,23 +153,11 @@ HELP: tuple= { $description "Low-level tuple equality test. User code should use " { $link = } " instead." } { $warning "This word is in the " { $vocab-link "classes.tuple.private" } " vocabulary because it does not do any type checking. Passing values which are not tuples can result in memory corruption." } ; -HELP: permutation -{ $values { "seq1" sequence } { "seq2" sequence } { "permutation" "a sequence whose elements are integers or " { $link f } } } -{ $description "Outputs a permutation for taking " { $snippet "seq1" } " to " { $snippet "seq2" } "." } ; - -HELP: reshape-tuple -{ $values { "oldtuple" tuple } { "permutation" "a sequence whose elements are integers or " { $link f } } { "newtuple" tuple } } -{ $description "Permutes the slots of a tuple. If a tuple class is redefined at runtime, this word is called on every instance to change its shape to conform to the new layout." } ; - -HELP: reshape-tuples -{ $values { "class" tuple-class } { "superclass" class } { "newslots" "a sequence of strings" } } -{ $description "Changes the shape of every instance of " { $snippet "class" } " for a new slot layout." } ; - HELP: removed-slots { $values { "class" tuple-class } { "newslots" "a sequence of strings" } { "seq" "a sequence of strings" } } { $description "Outputs the sequence of existing tuple slot names not in " { $snippet "newslots" } "." } ; -HELP: forget-slots +HELP: forget-removed-slots { $values { "class" tuple-class } { "slots" "a sequence of strings" } } { $description "Forgets accessor words for existing tuple slots which are not in " { $snippet "newslots" } "." } ; diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 9b8228155b..0fac0c3779 100755 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -265,9 +265,13 @@ C: laptop [ t ] [ "laptop" get computer? ] unit-test [ t ] [ "laptop" get tuple? ] unit-test -[ "Pentium" ] [ "laptop" get cpu>> ] unit-test -[ 128 ] [ "laptop" get ram>> ] unit-test -[ t ] [ "laptop" get battery>> 3 hours = ] unit-test +: test-laptop-slot-values + [ laptop ] [ "laptop" get class ] unit-test + [ "Pentium" ] [ "laptop" get cpu>> ] unit-test + [ 128 ] [ "laptop" get ram>> ] unit-test + [ t ] [ "laptop" get battery>> 3 hours = ] unit-test ; + +test-laptop-slot-values [ laptop ] [ "laptop" get tuple-layout @@ -294,9 +298,13 @@ C: server [ t ] [ "server" get computer? ] unit-test [ t ] [ "server" get tuple? ] unit-test -[ "PowerPC" ] [ "server" get cpu>> ] unit-test -[ 64 ] [ "server" get ram>> ] unit-test -[ "1U" ] [ "server" get rackmount>> ] unit-test +: test-server-slot-values + [ server ] [ "server" get class ] unit-test + [ "PowerPC" ] [ "server" get cpu>> ] unit-test + [ 64 ] [ "server" get ram>> ] unit-test + [ "1U" ] [ "server" get rackmount>> ] unit-test ; + +test-server-slot-values [ f ] [ "server" get laptop? ] unit-test [ f ] [ "laptop" get server? ] unit-test @@ -316,10 +324,10 @@ C: server "IN: classes.tuple.tests TUPLE: bad-superclass < word ;" eval ] must-fail -! Reshaping with inheritance +! Dynamically changing inheritance hierarchy TUPLE: electronic-device ; -[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram ;" eval ] unit-test [ f ] [ electronic-device laptop class< ] unit-test [ t ] [ server electronic-device class< ] unit-test @@ -335,11 +343,73 @@ TUPLE: electronic-device ; [ f ] [ "server" get laptop? ] unit-test [ t ] [ "server" get server? ] unit-test -[ ] [ "IN: classes.tuple.tests TUPLE: computer ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: computer cpu ram ;" eval ] unit-test [ f ] [ "laptop" get electronic-device? ] unit-test [ t ] [ "laptop" get computer? ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram disk ;" eval ] unit-test + +test-laptop-slot-values +test-server-slot-values + +[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ;" eval ] unit-test + +test-laptop-slot-values +test-server-slot-values + +TUPLE: make-me-some-accessors voltage grounded? ; + +[ f ] [ "laptop" get voltage>> ] unit-test +[ f ] [ "server" get voltage>> ] unit-test + +[ ] [ "laptop" get 220 >>voltage drop ] unit-test +[ ] [ "server" get 110 >>voltage drop ] unit-test + +[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage grounded? ;" eval ] unit-test + +test-laptop-slot-values +test-server-slot-values + +[ 220 ] [ "laptop" get voltage>> ] unit-test +[ 110 ] [ "server" get voltage>> ] unit-test + +[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device grounded? voltage ;" eval ] unit-test + +test-laptop-slot-values +test-server-slot-values + +[ 220 ] [ "laptop" get voltage>> ] unit-test +[ 110 ] [ "server" get voltage>> ] unit-test + +! Reshaping superclass and subclass simultaneously +"IN: classes.tuple.tests TUPLE: electronic-device voltage ; TUPLE: computer < electronic-device cpu ram ;" eval + +test-laptop-slot-values +test-server-slot-values + +[ 220 ] [ "laptop" get voltage>> ] unit-test +[ 110 ] [ "server" get voltage>> ] unit-test + +! Reshape crash +TUPLE: test1 a ; TUPLE: test2 < test1 b ; + +T{ test2 f "a" "b" } "test" set + +: test-a/b + [ "a" ] [ "test" get a>> ] unit-test + [ "b" ] [ "test" get b>> ] unit-test ; + +test-a/b + +[ ] [ "IN: classes.tuple.tests TUPLE: test1 a x ; TUPLE: test2 < test1 b y ;" eval ] unit-test + +test-a/b + +[ ] [ "IN: classes.tuple.tests TUPLE: test1 a ; TUPLE: test2 < test1 b ;" eval ] unit-test + +test-a/b + ! Redefinition problem TUPLE: redefinition-problem ; diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 401a421c51..158ea9fc55 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -24,13 +24,14 @@ M: class tuple-layout "layout" word-prop ; M: tuple tuple-layout 1 slot ; M: tuple-layout tuple-layout ; + : tuple-size tuple-layout layout-size ; inline : prepare-tuple>array ( tuple -- n tuple layout ) [ tuple-size ] [ ] [ tuple-layout ] tri ; -: copy-tuple-slots ( n tuple first -- array ) - [ array-nth ] curry map r> add* ; +: copy-tuple-slots ( n tuple -- array ) + [ array-nth ] curry map ; PRIVATE> @@ -128,48 +129,63 @@ PRIVATE> [ writer-word forget-method ] 2bi ] with each ; -: permutation ( seq1 seq2 -- permutation ) - swap [ index ] curry map ; - : all-slot-names ( class -- slots ) superclasses [ slot-names ] map concat \ class add* ; -: slot-permutation ( class superclass newslots -- n permutation ) - [ all-slot-names ] [ all-slot-names ] [ ] tri* append - [ drop length ] [ permutation ] 2bi ; +: compute-slot-permutation ( class old-slot-names -- permutation ) + >r all-slot-names r> [ index ] curry map ; -: permute-direct-slots ( oldslots permutation -- newslots ) +: apply-slot-permutation ( old-values permutation -- new-values ) [ [ swap ?nth ] [ drop f ] if* ] with map ; -: permute-all-slots ( oldslots n permutation -- newslots ) - [ >r head r> permute-direct-slots ] [ drop tail ] 3bi append ; +: permute-slots ( old-values -- new-values ) + dup first dup outdated-tuples get at + compute-slot-permutation + apply-slot-permutation ; : change-tuple ( tuple quot -- newtuple ) >r tuple>array r> call >tuple ; inline -: update-tuples ( predicate n permutation -- ) - [ permute-all-slots ] 2curry [ change-tuple ] curry - >r "predicate" word-prop instances dup r> map - become ; inline +: update-tuple ( tuple -- newtuple ) + [ permute-slots ] change-tuple ; -: update-tuples-after ( class superclass newslots -- ) - [ 2drop ] [ slot-permutation ] 3bi - [ update-tuples ] 3curry after-compilation ; +: update-tuples ( -- ) + outdated-tuples get + dup assoc-empty? [ drop ] [ + [ >r class r> key? ] curry instances + dup [ update-tuple ] map become + ] if ; + +[ update-tuples ] update-tuples-hook set-global + +: update-tuples-after ( class -- ) + outdated-tuples get [ all-slot-names ] cache drop ; + +: subclasses ( class -- classes ) + class-usages keys [ tuple-class? ] subset ; + +: each-subclass ( class quot -- ) + >r subclasses r> each ; inline + +: define-tuple-shape ( class -- ) + [ define-tuple-slots ] + [ define-tuple-layout ] + [ define-tuple-predicate ] + tri ; : define-new-tuple-class ( class superclass slots -- ) [ drop f tuple-class define-class ] - [ nip "slot-names" set-word-prop ] [ + [ nip "slot-names" set-word-prop ] + [ 2drop - class-usages keys [ tuple-class? ] subset [ - [ define-tuple-slots ] - [ define-tuple-layout ] - [ define-tuple-predicate ] - tri - ] each + [ define-tuple-shape ] each-subclass ] 3tri ; : redefine-tuple-class ( class superclass slots -- ) - [ update-tuples-after ] + [ + 2drop + [ update-tuples-after ] each-subclass + ] [ nip [ forget-removed-slots ] @@ -205,11 +221,6 @@ M: tuple clone M: tuple equal? over tuple? [ tuple= ] [ 2drop f ] if ; -: delegates ( obj -- seq ) - [ dup ] [ [ delegate ] keep ] [ ] unfold nip ; - -: is? ( obj quot -- ? ) >r delegates r> contains? ; inline - M: tuple hashcode* [ dup tuple-size -rot 0 -rot [ @@ -217,21 +228,26 @@ M: tuple hashcode* ] 2curry reduce ] recursive-hashcode ; -! Definition protocol M: tuple-class reset-class { "metaclass" "superclass" "slots" "layout" } reset-props ; M: object get-slots ( obj slots -- ... ) [ execute ] with each ; -M: object set-slots ( ... obj slots -- ) - get-slots ; - M: object construct-empty ( class -- tuple ) tuple-layout ; +M: object construct-boa ( ... class -- tuple ) + tuple-layout ; + +! Deprecated +M: object set-slots ( ... obj slots -- ) + get-slots ; + M: object construct ( ... slots class -- tuple ) construct-empty [ swap set-slots ] keep ; -M: object construct-boa ( ... class -- tuple ) - tuple-layout ; +: delegates ( obj -- seq ) + [ dup ] [ [ delegate ] keep ] [ ] unfold nip ; + +: is? ( obj quot -- ? ) >r delegates r> contains? ; inline diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index 9849ddca7d..f87c1ec985 100755 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -69,21 +69,19 @@ GENERIC: definitions-changed ( assoc obj -- ) dup [ drop crossref? ] assoc-contains? modify-code-heap ; -SYMBOL: post-compile-tasks - -: after-compilation ( quot -- ) - post-compile-tasks get push ; +SYMBOL: outdated-tuples +SYMBOL: update-tuples-hook : call-recompile-hook ( -- ) changed-words get keys compiled-usages recompile-hook get call ; -: call-post-compile-tasks ( -- ) - post-compile-tasks get [ call ] each ; +: call-update-tuples-hook ( -- ) + update-tuples-hook get call ; : finish-compilation-unit ( -- ) call-recompile-hook - call-post-compile-tasks + call-update-tuples-hook dup [ drop crossref? ] assoc-contains? modify-code-heap changed-definitions notify-definition-observers ; @@ -91,7 +89,7 @@ SYMBOL: post-compile-tasks [ H{ } clone changed-words set H{ } clone forgotten-definitions set - V{ } clone post-compile-tasks set + H{ } clone outdated-tuples set new-definitions set old-definitions set [ finish-compilation-unit ] diff --git a/core/slots/slots.factor b/core/slots/slots.factor index eeb0926308..b674ec8c2a 100755 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -79,3 +79,6 @@ C: slot-spec dup slot-spec-offset swap slot-spec-name define-slot-methods ] with each ; + +: slot-named ( name specs -- spec/f ) + [ slot-spec-name = ] with find nip ; From 75497d721219261a7b45a47f018d6314d2fe533a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 31 Mar 2008 01:26:09 -0500 Subject: [PATCH 217/219] Add another unit test --- core/classes/tuple/tuple-tests.factor | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 0fac0c3779..950650dbf0 100755 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -410,6 +410,14 @@ test-a/b test-a/b +! Twice in the same compilation unit +[ + test1 tuple { "a" "x" "y" } define-tuple-class + test1 tuple { "a" "y" } define-tuple-class +] with-compilation-unit + +test-a/b + ! Redefinition problem TUPLE: redefinition-problem ; From 30a7238f71fa930b46fceea9024fc1e9cbceef2a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 31 Mar 2008 02:30:06 -0500 Subject: [PATCH 218/219] Clean up serialization --- extra/serialize/serialize.factor | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/extra/serialize/serialize.factor b/extra/serialize/serialize.factor index ac247057f4..7a2fbfae9e 100755 --- a/extra/serialize/serialize.factor +++ b/extra/serialize/serialize.factor @@ -90,13 +90,13 @@ M: float (serialize) ( obj -- ) M: complex (serialize) ( obj -- ) CHAR: c write1 - dup real-part (serialize) - imaginary-part (serialize) ; + [ real-part (serialize) ] + [ imaginary-part (serialize) ] bi ; M: ratio (serialize) ( obj -- ) CHAR: r write1 - dup numerator (serialize) - denominator (serialize) ; + [ numerator (serialize) ] + [ denominator (serialize) ] bi ; : serialize-seq ( obj code -- ) [ @@ -120,7 +120,8 @@ M: array (serialize) ( obj -- ) M: quotation (serialize) ( obj -- ) [ - CHAR: q write1 [ >array (serialize) ] [ add-object ] bi + CHAR: q write1 + [ >array (serialize) ] [ add-object ] bi ] serialize-shared ; M: hashtable (serialize) ( obj -- ) @@ -234,10 +235,12 @@ SYMBOL: deserialized ] if ; : deserialize-gensym ( -- word ) - gensym - dup intern-object - dup (deserialize) define - dup (deserialize) swap set-word-props ; + gensym { + [ intern-object ] + [ (deserialize) define ] + [ (deserialize) swap set-word-props ] + [ ] + } cleave ; : deserialize-wrapper ( -- wrapper ) (deserialize) ; From 8f0530daa6f8ce5a71dbea6f9edf081229301dc8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 31 Mar 2008 03:40:27 -0500 Subject: [PATCH 219/219] More inheritance fixes --- core/classes/tuple/tuple-tests.factor | 44 ++++++++++++++++++++++++++- core/classes/tuple/tuple.factor | 15 +++++---- 2 files changed, 50 insertions(+), 9 deletions(-) diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 950650dbf0..db0e25f091 100755 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -3,7 +3,7 @@ math.constants parser sequences tools.test words assocs namespaces quotations sequences.private classes continuations generic.standard effects classes.tuple classes.tuple.private arrays vectors strings compiler.units accessors classes.algebra -calendar prettyprint io.streams.string splitting ; +calendar prettyprint io.streams.string splitting inspector ; IN: classes.tuple.tests TUPLE: rect x y w h ; @@ -418,6 +418,48 @@ test-a/b test-a/b +! Moving slots up and down +TUPLE: move-up-1 a b ; +TUPLE: move-up-2 < move-up-1 c ; + +T{ move-up-2 f "a" "b" "c" } "move-up" set + +: test-move-up + [ "a" ] [ "move-up" get a>> ] unit-test + [ "b" ] [ "move-up" get b>> ] unit-test + [ "c" ] [ "move-up" get c>> ] unit-test ; + +test-move-up + +[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a b c ; TUPLE: move-up-2 < move-up-1 ;" eval ] unit-test + +test-move-up + +[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a c ; TUPLE: move-up-2 < move-up-1 b ;" eval ] unit-test + +test-move-up + +[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 c ; TUPLE: move-up-2 < move-up-1 b a ;" eval ] unit-test + +test-move-up + +[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 ; TUPLE: move-up-2 < move-up-1 a b c ;" eval ] unit-test + +! Constructors must be recompiled when changing superclass +TUPLE: constructor-update-1 xxx ; + +TUPLE: constructor-update-2 < constructor-update-1 yyy zzz ; + +C: constructor-update-2 + +{ 3 1 } [ ] must-infer-as + +[ ] [ "IN: classes.tuple.tests TUPLE: constructor-update-1 xxx ttt www ;" eval ] unit-test + +{ 5 1 } [ ] must-infer-as + +[ { f 1 2 3 4 5 } ] [ 1 2 3 4 5 tuple-slots ] unit-test + ! Redefinition problem TUPLE: redefinition-problem ; diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 158ea9fc55..a3d0238d1c 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -184,15 +184,14 @@ PRIVATE> : redefine-tuple-class ( class superclass slots -- ) [ 2drop - [ update-tuples-after ] each-subclass - ] - [ - nip - [ forget-removed-slots ] - [ drop changed-word ] - [ drop redefined ] - 2tri + [ + [ update-tuples-after ] + [ changed-word ] + [ redefined ] + tri + ] each-subclass ] + [ nip forget-removed-slots ] [ define-new-tuple-class ] 3tri ;