commit
ea8ad2b04c
|
@ -347,45 +347,49 @@ SYMBOL: bootstrap-syntax
|
||||||
call
|
call
|
||||||
] with-scope ; inline
|
] with-scope ; inline
|
||||||
|
|
||||||
|
SYMBOL: interactive-vocabs
|
||||||
|
|
||||||
|
{
|
||||||
|
"arrays"
|
||||||
|
"assocs"
|
||||||
|
"combinators"
|
||||||
|
"compiler.errors"
|
||||||
|
"continuations"
|
||||||
|
"debugger"
|
||||||
|
"definitions"
|
||||||
|
"editors"
|
||||||
|
"generic"
|
||||||
|
"help"
|
||||||
|
"inspector"
|
||||||
|
"io"
|
||||||
|
"io.files"
|
||||||
|
"kernel"
|
||||||
|
"listener"
|
||||||
|
"math"
|
||||||
|
"memory"
|
||||||
|
"namespaces"
|
||||||
|
"prettyprint"
|
||||||
|
"sequences"
|
||||||
|
"slicing"
|
||||||
|
"sorting"
|
||||||
|
"strings"
|
||||||
|
"syntax"
|
||||||
|
"tools.annotations"
|
||||||
|
"tools.crossref"
|
||||||
|
"tools.memory"
|
||||||
|
"tools.profiler"
|
||||||
|
"tools.test"
|
||||||
|
"tools.time"
|
||||||
|
"vocabs"
|
||||||
|
"vocabs.loader"
|
||||||
|
"words"
|
||||||
|
"scratchpad"
|
||||||
|
} interactive-vocabs set-global
|
||||||
|
|
||||||
: with-interactive-vocabs ( quot -- )
|
: with-interactive-vocabs ( quot -- )
|
||||||
[
|
[
|
||||||
"scratchpad" in set
|
"scratchpad" in set
|
||||||
{
|
interactive-vocabs get set-use
|
||||||
"arrays"
|
|
||||||
"assocs"
|
|
||||||
"combinators"
|
|
||||||
"compiler.errors"
|
|
||||||
"continuations"
|
|
||||||
"debugger"
|
|
||||||
"definitions"
|
|
||||||
"editors"
|
|
||||||
"generic"
|
|
||||||
"help"
|
|
||||||
"inspector"
|
|
||||||
"io"
|
|
||||||
"io.files"
|
|
||||||
"kernel"
|
|
||||||
"listener"
|
|
||||||
"math"
|
|
||||||
"memory"
|
|
||||||
"namespaces"
|
|
||||||
"prettyprint"
|
|
||||||
"sequences"
|
|
||||||
"slicing"
|
|
||||||
"sorting"
|
|
||||||
"strings"
|
|
||||||
"syntax"
|
|
||||||
"tools.annotations"
|
|
||||||
"tools.crossref"
|
|
||||||
"tools.memory"
|
|
||||||
"tools.profiler"
|
|
||||||
"tools.test"
|
|
||||||
"tools.time"
|
|
||||||
"vocabs"
|
|
||||||
"vocabs.loader"
|
|
||||||
"words"
|
|
||||||
"scratchpad"
|
|
||||||
} set-use
|
|
||||||
call
|
call
|
||||||
] with-scope ; inline
|
] with-scope ; inline
|
||||||
|
|
||||||
|
|
|
@ -51,6 +51,9 @@ unit-test
|
||||||
[ "ab" ] [ 2 "abc" resize-string ] unit-test
|
[ "ab" ] [ 2 "abc" resize-string ] unit-test
|
||||||
[ "abc\0\0\0" ] [ 6 "abc" resize-string ] unit-test
|
[ "abc\0\0\0" ] [ 6 "abc" resize-string ] unit-test
|
||||||
|
|
||||||
|
[ "\u001234b" ] [ 2 "\u001234bc" resize-string ] unit-test
|
||||||
|
[ "\u001234bc\0\0\0" ] [ 6 "\u001234bc" resize-string ] unit-test
|
||||||
|
|
||||||
! Random tester found this
|
! Random tester found this
|
||||||
[ { "kernel-error" 3 12 -7 } ]
|
[ { "kernel-error" 3 12 -7 } ]
|
||||||
[ [ 2 -7 resize-string ] catch ] unit-test
|
[ [ 2 -7 resize-string ] catch ] unit-test
|
||||||
|
@ -88,3 +91,5 @@ unit-test
|
||||||
"\udeadbe" clone
|
"\udeadbe" clone
|
||||||
CHAR: \u123456 over clone set-first
|
CHAR: \u123456 over clone set-first
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: kernel io io.files splitting strings
|
USING: kernel io io.files splitting strings
|
||||||
hashtables sequences assocs math namespaces prettyprint
|
hashtables sequences assocs math namespaces prettyprint
|
||||||
math.parser combinators arrays sorting ;
|
math.parser combinators arrays sorting unicode.case ;
|
||||||
|
|
||||||
IN: benchmark.knucleotide
|
IN: benchmark.knucleotide
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: io io.files io.streams.duplex kernel sequences
|
USING: io io.files io.streams.duplex kernel sequences
|
||||||
sequences.private strings vectors words memoize splitting
|
sequences.private strings vectors words memoize splitting
|
||||||
hints ;
|
hints unicode.case ;
|
||||||
IN: benchmark.reverse-complement
|
IN: benchmark.reverse-complement
|
||||||
|
|
||||||
MEMO: trans-map ( -- str )
|
MEMO: trans-map ( -- str )
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
|
|
||||||
USING: kernel io io.files io.launcher
|
USING: kernel io io.files io.launcher tools.deploy.backend
|
||||||
system namespaces sequences splitting math.parser
|
system namespaces sequences splitting math.parser
|
||||||
unix prettyprint tools.time calendar bake vars ;
|
unix prettyprint tools.time calendar bake vars ;
|
||||||
|
|
||||||
|
@ -31,8 +31,6 @@ SYMBOL: builder-recipients
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: boot-image ( -- filename ) `{ "boot" ,[ cpu ] "image" } "." join ;
|
|
||||||
|
|
||||||
: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
|
: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
@ -61,7 +59,7 @@ if
|
||||||
|
|
||||||
"factor" cd
|
"factor" cd
|
||||||
|
|
||||||
{ "/usr/bin/git" "show" } <process-stream>
|
{ "git" "show" } <process-stream>
|
||||||
[ readln ] with-stream
|
[ readln ] with-stream
|
||||||
" " split second
|
" " split second
|
||||||
"../git-id" <file-writer> [ print ] with-stream
|
"../git-id" <file-writer> [ print ] with-stream
|
||||||
|
@ -76,7 +74,7 @@ if
|
||||||
"builder: vm compile" throw
|
"builder: vm compile" throw
|
||||||
] if
|
] if
|
||||||
|
|
||||||
"wget http://factorcode.org/images/latest/" boot-image append system
|
"wget http://factorcode.org/images/latest/" boot-image-name append system
|
||||||
0 =
|
0 =
|
||||||
[ ]
|
[ ]
|
||||||
[
|
[
|
||||||
|
@ -84,7 +82,11 @@ if
|
||||||
"builder: image download" throw
|
"builder: image download" throw
|
||||||
] if
|
] if
|
||||||
|
|
||||||
[ "./factor -i=" boot-image " -no-user-init > ../boot-log" 3append system ]
|
[
|
||||||
|
"./factor -i=" boot-image-name " -no-user-init > ../boot-log"
|
||||||
|
3append
|
||||||
|
system
|
||||||
|
]
|
||||||
benchmark nip
|
benchmark nip
|
||||||
"../boot-time" <file-writer> [ . ] with-stream
|
"../boot-time" <file-writer> [ . ] with-stream
|
||||||
0 =
|
0 =
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
! Adapted from cryptlib.h
|
! Adapted from cryptlib.h
|
||||||
! Tested with cryptlib 3.3.1.0
|
! Tested with cryptlib 3.3.1.0
|
||||||
USING: cryptlib.libcl kernel hashtables alien math
|
USING: cryptlib.libcl kernel hashtables alien math
|
||||||
namespaces sequences assocs libc alien.c-types continuations ;
|
namespaces sequences assocs libc alien.c-types alien.accessors continuations ;
|
||||||
|
|
||||||
IN: cryptlib
|
IN: cryptlib
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: cryptlib cryptlib.libcl kernel alien sequences continuations
|
USING: cryptlib cryptlib.libcl kernel alien sequences continuations
|
||||||
byte-arrays namespaces io.buffers math generic io strings
|
byte-arrays namespaces io.buffers math generic io strings
|
||||||
io.streams.lines io.streams.plain io.streams.duplex combinators
|
io.streams.lines io.streams.plain io.streams.duplex combinators
|
||||||
alien.c-types ;
|
alien.c-types continuations ;
|
||||||
|
|
||||||
IN: cryptlib.streams
|
IN: cryptlib.streams
|
||||||
|
|
||||||
|
@ -154,4 +154,4 @@ M: crypt-stream dispose ( stream -- )
|
||||||
|
|
||||||
dispose
|
dispose
|
||||||
end
|
end
|
||||||
;
|
;
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel peg strings promises sequences math math.parser
|
USING: kernel peg strings promises sequences math math.parser
|
||||||
namespaces words quotations arrays hashtables io
|
namespaces words quotations arrays hashtables io
|
||||||
io.streams.string assocs memoize ;
|
io.streams.string assocs memoize ascii ;
|
||||||
IN: fjsc
|
IN: fjsc
|
||||||
|
|
||||||
TUPLE: ast-number value ;
|
TUPLE: ast-number value ;
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2007 Slava Pestov.
|
! Copyright (C) 2007 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: parser-combinators regexp lazy-lists sequences kernel
|
USING: parser-combinators regexp lazy-lists sequences kernel
|
||||||
promises strings ;
|
promises strings unicode.case ;
|
||||||
IN: globs
|
IN: globs
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: arrays combinators.lib io io.streams.string
|
USING: arrays combinators.lib io io.streams.string
|
||||||
kernel math math.parser namespaces prettyprint
|
kernel math math.parser namespaces prettyprint
|
||||||
sequences splitting strings ;
|
sequences splitting strings ascii ;
|
||||||
IN: hexdump
|
IN: hexdump
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
|
||||||
USING: io kernel namespaces prettyprint quotations
|
USING: io kernel namespaces prettyprint quotations
|
||||||
sequences strings words xml.writer xml.entities compiler.units effects ;
|
sequences strings words xml.entities compiler.units effects ;
|
||||||
|
|
||||||
IN: html.elements
|
IN: html.elements
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: generic assocs help http io io.styles io.files continuations
|
USING: generic assocs help http io io.styles io.files continuations
|
||||||
io.streams.string kernel math math.parser namespaces
|
io.streams.string kernel math math.parser namespaces
|
||||||
quotations assocs sequences strings words html.elements
|
quotations assocs sequences strings words html.elements
|
||||||
xml.writer xml.entities sbufs ;
|
xml.entities sbufs continuations ;
|
||||||
IN: html
|
IN: html
|
||||||
|
|
||||||
GENERIC: browser-link-href ( presented -- href )
|
GENERIC: browser-link-href ( presented -- href )
|
||||||
|
|
|
@ -14,3 +14,5 @@ IN: temporary
|
||||||
[ "hello world" ] [ "hello world%x" url-decode ] unit-test
|
[ "hello world" ] [ "hello world%x" url-decode ] unit-test
|
||||||
[ "hello%20world" ] [ "hello world" url-encode ] unit-test
|
[ "hello%20world" ] [ "hello world" url-encode ] unit-test
|
||||||
[ "%20%21%20" ] [ " ! " url-encode ] unit-test
|
[ "%20%21%20" ] [ " ! " url-encode ] unit-test
|
||||||
|
|
||||||
|
[ "\u001234hi\u002045" ] [ "\u001234hi\u002045" url-encode url-decode ] unit-test
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2003, 2007 Slava Pestov.
|
! Copyright (C) 2003, 2007 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: hashtables io kernel math namespaces math.parser assocs
|
USING: hashtables io kernel math namespaces math.parser assocs
|
||||||
sequences strings splitting assocs.lib ;
|
sequences strings splitting ascii io.utf8 assocs.lib ;
|
||||||
IN: http
|
IN: http
|
||||||
|
|
||||||
: header-line ( line -- )
|
: header-line ( line -- )
|
||||||
|
@ -20,18 +20,15 @@ IN: http
|
||||||
dup letter?
|
dup letter?
|
||||||
over LETTER? or
|
over LETTER? or
|
||||||
over digit? or
|
over digit? or
|
||||||
swap "/_-?." member? or ; foldable
|
swap "/_-." member? or ; foldable
|
||||||
|
|
||||||
|
: push-utf8 ( string -- )
|
||||||
|
1string encode-utf8 [ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ;
|
||||||
|
|
||||||
: url-encode ( str -- str )
|
: url-encode ( str -- str )
|
||||||
[
|
[ [
|
||||||
[
|
dup url-quotable? [ , ] [ push-utf8 ] if
|
||||||
dup url-quotable? [
|
] each ] "" make ;
|
||||||
,
|
|
||||||
] [
|
|
||||||
CHAR: % , >hex 2 CHAR: 0 pad-left %
|
|
||||||
] if
|
|
||||||
] each
|
|
||||||
] "" make ;
|
|
||||||
|
|
||||||
: url-decode-hex ( index str -- )
|
: url-decode-hex ( index str -- )
|
||||||
2dup length 2 - >= [
|
2dup length 2 - >= [
|
||||||
|
@ -58,7 +55,7 @@ IN: http
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: url-decode ( str -- str )
|
: url-decode ( str -- str )
|
||||||
[ 0 swap url-decode-iter ] "" make ;
|
[ 0 swap url-decode-iter ] "" make decode-utf8 ;
|
||||||
|
|
||||||
: hash>query ( hash -- str )
|
: hash>query ( hash -- str )
|
||||||
[ [ url-encode ] 2apply "=" swap 3append ] { } assoc>map
|
[ [ url-encode ] 2apply "=" swap 3append ] { } assoc>map
|
||||||
|
|
|
@ -25,7 +25,7 @@ M: template-lexer skip-word
|
||||||
{
|
{
|
||||||
{ [ 2dup nth CHAR: " = ] [ drop 1+ ] }
|
{ [ 2dup nth CHAR: " = ] [ drop 1+ ] }
|
||||||
{ [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
|
{ [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
|
||||||
{ [ t ] [ [ blank? ] skip ] }
|
{ [ t ] [ f skip ] }
|
||||||
} cond
|
} cond
|
||||||
] change-column ;
|
] change-column ;
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
|
|
||||||
USING: arrays combinators io io.binary io.files io.paths
|
USING: arrays combinators io io.binary io.files io.paths
|
||||||
io.utf16 kernel math math.parser namespaces sequences
|
io.utf16 kernel math math.parser namespaces sequences
|
||||||
splitting strings assocs ;
|
splitting strings assocs unicode.categories ;
|
||||||
|
|
||||||
IN: id3
|
IN: id3
|
||||||
|
|
||||||
|
|
|
@ -29,7 +29,7 @@ SYMBOL: log-stream
|
||||||
|
|
||||||
: with-log-file ( file quot -- )
|
: with-log-file ( file quot -- )
|
||||||
>r <file-appender> r>
|
>r <file-appender> r>
|
||||||
[ with-log-stream ] with-disposal ; inline
|
[ with-log-stream ] curry with-disposal ; inline
|
||||||
|
|
||||||
: with-log-stdio ( quot -- )
|
: with-log-stdio ( quot -- )
|
||||||
stdio get swap with-log-stream ;
|
stdio get swap with-log-stream ;
|
||||||
|
@ -47,11 +47,11 @@ SYMBOL: log-stream
|
||||||
dup log-client
|
dup log-client
|
||||||
[ swap with-stream ] 2curry concurrency:spawn drop ; inline
|
[ swap with-stream ] 2curry concurrency:spawn drop ; inline
|
||||||
|
|
||||||
: accept-loop ( server quot -- server quot )
|
: accept-loop ( server quot -- )
|
||||||
[ swap accept with-client ] 2keep accept-loop ; inline
|
[ swap accept with-client ] 2keep accept-loop ; inline
|
||||||
|
|
||||||
: server-loop ( server quot -- )
|
: server-loop ( server quot -- )
|
||||||
[ accept-loop ] compose with-disposal ; inline
|
[ accept-loop ] curry with-disposal ; inline
|
||||||
|
|
||||||
: spawn-server ( addrspec quot -- )
|
: spawn-server ( addrspec quot -- )
|
||||||
"Waiting for connections on " pick unparse append
|
"Waiting for connections on " pick unparse append
|
||||||
|
|
|
@ -7,7 +7,7 @@ sequences io.sniffer.backend ;
|
||||||
QUALIFIED: unix
|
QUALIFIED: unix
|
||||||
IN: io.sniffer.bsd
|
IN: io.sniffer.bsd
|
||||||
|
|
||||||
M: unix-io destruct-handle ( obj -- ) close drop ;
|
M: unix-io destruct-handle ( obj -- ) unix:close drop ;
|
||||||
|
|
||||||
C-UNION: ifreq_props "sockaddr-in" "short" "int" "caddr_t" ;
|
C-UNION: ifreq_props "sockaddr-in" "short" "int" "caddr_t" ;
|
||||||
C-STRUCT: ifreq { { "char" 16 } "name" } { "ifreq_props" "props" } ;
|
C-STRUCT: ifreq { { "char" 16 } "name" } { "ifreq_props" "props" } ;
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
|
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: arrays calendar io io.sockets kernel match namespaces
|
USING: arrays calendar io io.sockets kernel match namespaces
|
||||||
sequences splitting strings continuations threads ;
|
sequences splitting strings continuations threads ascii ;
|
||||||
IN: irc
|
IN: irc
|
||||||
|
|
||||||
! "setup" objects
|
! "setup" objects
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel parser-combinators namespaces sequences promises strings
|
USING: kernel parser-combinators namespaces sequences promises strings
|
||||||
assocs math math.parser math.vectors math.functions
|
assocs math math.parser math.vectors math.functions
|
||||||
lazy-lists hashtables ;
|
lazy-lists hashtables ascii ;
|
||||||
IN: json.reader
|
IN: json.reader
|
||||||
|
|
||||||
! Grammar for JSON from RFC 4627
|
! Grammar for JSON from RFC 4627
|
||||||
|
|
|
@ -1,9 +1,8 @@
|
||||||
! Copyright (C) 2007 Doug Coleman.
|
! Copyright (C) 2007 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien arrays assocs combinators.lib io kernel
|
USING: alien alien.accessors arrays assocs combinators.lib io kernel
|
||||||
macros math namespaces prettyprint quotations sequences
|
macros math namespaces prettyprint quotations sequences
|
||||||
vectors vocabs words ;
|
vectors vocabs words html.elements slots.private tar ;
|
||||||
USING: html.elements slots.private tar ;
|
|
||||||
IN: lint
|
IN: lint
|
||||||
|
|
||||||
SYMBOL: def-hash
|
SYMBOL: def-hash
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2006 Chris Double.
|
! Copyright (C) 2006 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel strings math sequences lazy-lists words
|
USING: kernel strings math sequences lazy-lists words
|
||||||
math.parser promises parser-combinators ;
|
math.parser promises parser-combinators unicode.categories ;
|
||||||
IN: parser-combinators.simple
|
IN: parser-combinators.simple
|
||||||
|
|
||||||
: 'digit' ( -- parser )
|
: 'digit' ( -- parser )
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2007 Chris Double.
|
! Copyright (C) 2007 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel parser words arrays strings math.parser sequences
|
USING: kernel parser words arrays strings math.parser sequences
|
||||||
quotations vectors namespaces math assocs continuations peg ;
|
quotations vectors namespaces math assocs continuations peg
|
||||||
|
unicode.categories ;
|
||||||
IN: peg.ebnf
|
IN: peg.ebnf
|
||||||
|
|
||||||
TUPLE: ebnf-non-terminal symbol ;
|
TUPLE: ebnf-non-terminal symbol ;
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2007 Chris Double.
|
! Copyright (C) 2007 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel sequences strings namespaces math assocs shuffle
|
USING: kernel sequences strings namespaces math assocs shuffle
|
||||||
vectors arrays combinators.lib memoize math.parser match ;
|
vectors arrays combinators.lib memoize math.parser match
|
||||||
|
unicode.categories ;
|
||||||
IN: peg
|
IN: peg
|
||||||
|
|
||||||
TUPLE: parse-result remaining ast ;
|
TUPLE: parse-result remaining ast ;
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
! Copyright (c) 2007 Aaron Schaefer.
|
! Copyright (c) 2007 Aaron Schaefer.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: combinators.lib kernel math.ranges math.text.english sequences strings ;
|
USING: combinators.lib kernel math.ranges math.text.english sequences strings
|
||||||
|
ascii ;
|
||||||
IN: project-euler.017
|
IN: project-euler.017
|
||||||
|
|
||||||
! http://projecteuler.net/index.php?section=problems&id=17
|
! http://projecteuler.net/index.php?section=problems&id=17
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (c) 2007 Aaron Schaefer.
|
! Copyright (c) 2007 Aaron Schaefer.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: io.files kernel math math.parser namespaces sequences sorting splitting
|
USING: io.files kernel math math.parser namespaces sequences sorting splitting
|
||||||
strings system vocabs ;
|
strings system vocabs ascii ;
|
||||||
IN: project-euler.022
|
IN: project-euler.022
|
||||||
|
|
||||||
! http://projecteuler.net/index.php?section=problems&id=22
|
! http://projecteuler.net/index.php?section=problems&id=22
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
|
||||||
USING: kernel sequences arrays vectors namespaces math strings
|
USING: kernel sequences arrays vectors namespaces math strings
|
||||||
combinators continuations quotations io assocs ;
|
combinators continuations quotations io assocs ascii ;
|
||||||
|
|
||||||
IN: prolog
|
IN: prolog
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: arrays combinators kernel lazy-lists math math.parser
|
USING: arrays combinators kernel lazy-lists math math.parser
|
||||||
namespaces parser parser-combinators parser-combinators.simple
|
namespaces parser parser-combinators parser-combinators.simple
|
||||||
promises quotations sequences combinators.lib strings
|
promises quotations sequences combinators.lib strings
|
||||||
assocs prettyprint.backend memoize ;
|
assocs prettyprint.backend memoize unicode.case unicode.categories ;
|
||||||
USE: io
|
USE: io
|
||||||
IN: regexp
|
IN: regexp
|
||||||
|
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
|
||||||
USING: arrays assocs kernel math math.vectors namespaces
|
USING: arrays assocs kernel math math.vectors namespaces
|
||||||
quotations sequences sequences.lib sequences.private strings ;
|
quotations sequences sequences.lib sequences.private strings unicode.case ;
|
||||||
IN: roman
|
IN: roman
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2006 Daniel Ehrenberg
|
! Copyright (C) 2006 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel math sequences strings io combinators ;
|
USING: kernel math sequences strings io combinators ascii ;
|
||||||
IN: rot13
|
IN: rot13
|
||||||
|
|
||||||
: rotate ( ch base -- ch ) tuck - 13 + 26 mod + ;
|
: rotate ( ch base -- ch ) tuck - 13 + 26 mod + ;
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: combinators.lib kernel sequences math namespaces assocs
|
USING: combinators.lib kernel sequences math namespaces assocs
|
||||||
random sequences.private shuffle math.functions mirrors ;
|
random sequences.private shuffle math.functions mirrors
|
||||||
USING: arrays math.parser sorting strings ;
|
arrays math.parser sorting strings ascii ;
|
||||||
IN: sequences.lib
|
IN: sequences.lib
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: io io.streams.string kernel math namespaces sequences
|
USING: io io.streams.string kernel math namespaces sequences
|
||||||
strings circular prettyprint debugger ;
|
strings circular prettyprint debugger unicode.categories ;
|
||||||
IN: state-parser
|
IN: state-parser
|
||||||
|
|
||||||
! * Basic underlying words
|
! * Basic underlying words
|
||||||
|
|
|
@ -1,14 +1,14 @@
|
||||||
USING: math arrays sequences kernel splitting strings ;
|
USING: math arrays sequences kernel splitting strings ;
|
||||||
IN: strings.lib
|
IN: strings.lib
|
||||||
|
|
||||||
: char>digit ( c -- i ) 48 - ;
|
! : char>digit ( c -- i ) 48 - ;
|
||||||
|
|
||||||
: string>digits ( s -- seq ) [ char>digit ] { } map-as ;
|
! : string>digits ( s -- seq ) [ char>digit ] { } map-as ;
|
||||||
|
|
||||||
: >Upper ( str -- str )
|
! : >Upper ( str -- str )
|
||||||
dup empty? [
|
! dup empty? [
|
||||||
unclip ch>upper 1string swap append
|
! unclip ch>upper 1string swap append
|
||||||
] unless ;
|
! ] unless ;
|
||||||
|
|
||||||
: >Upper-dashes ( str -- str )
|
! : >Upper-dashes ( str -- str )
|
||||||
"-" split [ >Upper ] map "-" join ;
|
! "-" split [ >Upper ] map "-" join ;
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
USING: combinators io io.files io.streams.duplex continuations
|
<<<<<<< HEAD:extra/tar/tar.factor
|
||||||
io.streams.string kernel math math.parser
|
USING: combinators io io.files io.streams.duplex
|
||||||
namespaces pack prettyprint sequences strings system hexdump ;
|
io.streams.string kernel math math.parser continuations
|
||||||
|
namespaces pack prettyprint sequences strings system ;
|
||||||
|
USING: hexdump tools.interpreter ;
|
||||||
IN: tar
|
IN: tar
|
||||||
|
|
||||||
: zero-checksum 256 ;
|
: zero-checksum 256 ;
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
USING: kernel unicode.data sequences sequences.next namespaces assocs.lib
|
USING: kernel unicode.data sequences sequences.next namespaces
|
||||||
unicode.normalize math unicode.categories combinators assocs ;
|
assocs.lib unicode.normalize math unicode.categories combinators
|
||||||
|
assocs ;
|
||||||
IN: unicode.case
|
IN: unicode.case
|
||||||
|
|
||||||
: ch>lower ( ch -- lower ) simple-lower at-default ;
|
: ch>lower ( ch -- lower ) simple-lower at-default ;
|
||||||
|
@ -20,7 +21,7 @@ SYMBOL: locale ! Just casing locale, or overall?
|
||||||
[ swap dot-over = over "ij" member? and swap , ] if ;
|
[ swap dot-over = over "ij" member? and swap , ] if ;
|
||||||
|
|
||||||
: lithuanian>upper ( string -- lower )
|
: lithuanian>upper ( string -- lower )
|
||||||
[ f swap [ lithuanian-ch>upper ] each-next drop ] "" make* ;
|
[ f swap [ lithuanian-ch>upper ] each-next drop ] "" make ;
|
||||||
|
|
||||||
: mark-above? ( ch -- ? )
|
: mark-above? ( ch -- ? )
|
||||||
combining-class 230 = ;
|
combining-class 230 = ;
|
||||||
|
@ -32,14 +33,14 @@ SYMBOL: locale ! Just casing locale, or overall?
|
||||||
dup , "IJ" member? swap mark-above? and [ dot-over , ] when ;
|
dup , "IJ" member? swap mark-above? and [ dot-over , ] when ;
|
||||||
|
|
||||||
: lithuanian>lower ( string -- lower )
|
: lithuanian>lower ( string -- lower )
|
||||||
[ [ lithuanian-ch>lower ] each-next ] "" make* ;
|
[ [ lithuanian-ch>lower ] each-next ] "" make ;
|
||||||
|
|
||||||
: turk-ch>upper ( ch -- )
|
: turk-ch>upper ( ch -- )
|
||||||
dup CHAR: i =
|
dup CHAR: i =
|
||||||
[ drop CHAR: I , dot-over , ] [ , ] if ;
|
[ drop CHAR: I , dot-over , ] [ , ] if ;
|
||||||
|
|
||||||
: turk>upper ( string -- upper-i )
|
: turk>upper ( string -- upper-i )
|
||||||
[ [ turk-ch>upper ] each ] "" make* ;
|
[ [ turk-ch>upper ] each ] "" make ;
|
||||||
|
|
||||||
: turk-ch>lower ( ? next ch -- ? )
|
: turk-ch>lower ( ? next ch -- ? )
|
||||||
{
|
{
|
||||||
|
@ -52,7 +53,7 @@ SYMBOL: locale ! Just casing locale, or overall?
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
||||||
: turk>lower ( string -- lower-i )
|
: turk>lower ( string -- lower-i )
|
||||||
[ f swap [ turk-ch>lower ] each-next drop ] "" make* ;
|
[ f swap [ turk-ch>lower ] each-next drop ] "" make ;
|
||||||
|
|
||||||
: word-boundary ( prev char -- new ? )
|
: word-boundary ( prev char -- new ? )
|
||||||
dup non-starter? [ drop dup ] when
|
dup non-starter? [ drop dup ] when
|
||||||
|
@ -76,7 +77,7 @@ SYMBOL: locale ! Just casing locale, or overall?
|
||||||
[ -rot nip call , ] ?if
|
[ -rot nip call , ] ?if
|
||||||
] 2keep
|
] 2keep
|
||||||
] each 2drop
|
] each 2drop
|
||||||
] "" make* ; inline
|
] "" make ; inline
|
||||||
|
|
||||||
: >lower ( string -- lower )
|
: >lower ( string -- lower )
|
||||||
i-dot? [ turk>lower ] when
|
i-dot? [ turk>lower ] when
|
||||||
|
|
|
@ -2,17 +2,6 @@ USING: sequences namespaces unicode.data kernel combinators.lib
|
||||||
math arrays ;
|
math arrays ;
|
||||||
IN: unicode.normalize
|
IN: unicode.normalize
|
||||||
|
|
||||||
! Utility word--probably unnecessary
|
|
||||||
: make* ( seq quot exemplar -- newseq )
|
|
||||||
! quot has access to original seq on stack
|
|
||||||
! this just makes the new-resizable the same length as seq
|
|
||||||
[
|
|
||||||
[
|
|
||||||
pick length swap new-resizable
|
|
||||||
[ building set call ] keep
|
|
||||||
] keep like
|
|
||||||
] with-scope ; inline
|
|
||||||
|
|
||||||
! Conjoining Jamo behavior
|
! Conjoining Jamo behavior
|
||||||
|
|
||||||
: hangul-base HEX: ac00 ; inline
|
: hangul-base HEX: ac00 ; inline
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
! Copyright (C) 2007 Slava Pestov.
|
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: namespaces kernel assocs io.files combinators
|
USING: namespaces kernel assocs io.files combinators
|
||||||
arrays io.launcher io http.server.responders webapps.file
|
arrays io.launcher io http.server.responders webapps.file
|
||||||
sequences strings math.parser ;
|
sequences strings math.parser unicode.case ;
|
||||||
IN: webapps.cgi
|
IN: webapps.cgi
|
||||||
|
|
||||||
SYMBOL: cgi-root
|
SYMBOL: cgi-root
|
||||||
|
@ -31,7 +31,7 @@ SYMBOL: cgi-root
|
||||||
|
|
||||||
"method" get >upper "REQUEST_METHOD" set
|
"method" get >upper "REQUEST_METHOD" set
|
||||||
"raw-query" get "QUERY_STRING" set
|
"raw-query" get "QUERY_STRING" set
|
||||||
"Cookie" header-param "HTTP_COOKIE" set
|
"Cookie" header-param "HTTP_COOKIE" set
|
||||||
|
|
||||||
"User-Agent" header-param "HTTP_USER_AGENT" set
|
"User-Agent" header-param "HTTP_USER_AGENT" set
|
||||||
"Accept" header-param "HTTP_ACCEPT" set
|
"Accept" header-param "HTTP_ACCEPT" set
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: calendar furnace furnace.validator io.files kernel
|
USING: calendar furnace furnace.validator io.files kernel
|
||||||
namespaces sequences http.server.responders html math math.parser rss
|
namespaces sequences http.server.responders html math.parser rss
|
||||||
xml.writer xmode.code2html ;
|
xml.writer xmode.code2html math ;
|
||||||
IN: webapps.pastebin
|
IN: webapps.pastebin
|
||||||
|
|
||||||
TUPLE: pastebin pastes ;
|
TUPLE: pastebin pastes ;
|
||||||
|
|
|
@ -12,15 +12,17 @@ SYMBOL: width
|
||||||
|
|
||||||
: (split-chunk) ( words -- )
|
: (split-chunk) ( words -- )
|
||||||
-1 over [ length + 1+ dup width get > ] find drop nip
|
-1 over [ length + 1+ dup width get > ] find drop nip
|
||||||
[ cut-slice swap , (split-chunk) ] [ , ] if* ;
|
[ 1 max cut-slice swap , (split-chunk) ] [ , ] if* ;
|
||||||
|
|
||||||
: split-chunk ( words -- lines )
|
: split-chunk ( words -- lines )
|
||||||
[ (split-chunk) ] { } make ;
|
[ (split-chunk) ] { } make ;
|
||||||
|
|
||||||
|
: join-spaces ( words-seqs -- lines )
|
||||||
|
[ [ " " join ] map ] map concat ;
|
||||||
|
|
||||||
: broken-lines ( string width -- lines )
|
: broken-lines ( string width -- lines )
|
||||||
width [
|
width [
|
||||||
line-chunks
|
line-chunks [ split-chunk ] map join-spaces
|
||||||
[ split-chunk [ " " join ] map ] map concat
|
|
||||||
] with-variable ;
|
] with-variable ;
|
||||||
|
|
||||||
: line-break ( string width -- newstring )
|
: line-break ( string width -- newstring )
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: xml.errors xml.data xml.utilities xml.char-classes
|
USING: xml.errors xml.data xml.utilities xml.char-classes
|
||||||
xml.entities kernel state-parser kernel namespaces strings math
|
xml.entities kernel state-parser kernel namespaces strings math
|
||||||
math.parser sequences assocs arrays splitting combinators ;
|
math.parser sequences assocs arrays splitting combinators unicode.case ;
|
||||||
IN: xml.tokenize
|
IN: xml.tokenize
|
||||||
|
|
||||||
! XML namespace processing: ns = namespace
|
! XML namespace processing: ns = namespace
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: io io.streams.string io.files kernel math namespaces
|
USING: io io.streams.string io.files kernel math namespaces
|
||||||
prettyprint sequences arrays generic strings vectors
|
prettyprint sequences arrays generic strings vectors
|
||||||
xml.char-classes xml.data xml.errors xml.tokenize xml.writer
|
xml.char-classes xml.data xml.errors xml.tokenize xml.writer
|
||||||
xml.utilities state-parser assocs ;
|
xml.utilities state-parser assocs unicode.categories ;
|
||||||
IN: xml
|
IN: xml
|
||||||
|
|
||||||
! -- Overall parser with data tree
|
! -- Overall parser with data tree
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
USING: kernel strings assocs sequences hashtables sorting ;
|
USING: kernel strings assocs sequences hashtables sorting
|
||||||
|
unicode.case unicode.categories ;
|
||||||
IN: xmode.keyword-map
|
IN: xmode.keyword-map
|
||||||
|
|
||||||
! Based on org.gjt.sp.jedit.syntax.KeywordMap
|
! Based on org.gjt.sp.jedit.syntax.KeywordMap
|
||||||
|
|
|
@ -2,7 +2,7 @@ IN: xmode.marker
|
||||||
USING: kernel namespaces xmode.rules xmode.tokens
|
USING: kernel namespaces xmode.rules xmode.tokens
|
||||||
xmode.marker.state xmode.marker.context xmode.utilities
|
xmode.marker.state xmode.marker.context xmode.utilities
|
||||||
xmode.catalog sequences math assocs combinators combinators.lib
|
xmode.catalog sequences math assocs combinators combinators.lib
|
||||||
strings regexp splitting parser-combinators ;
|
strings regexp splitting parser-combinators ascii unicode.case ;
|
||||||
|
|
||||||
! Based on org.gjt.sp.jedit.syntax.TokenMarker
|
! Based on org.gjt.sp.jedit.syntax.TokenMarker
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
USING: xmode.tokens xmode.keyword-map kernel
|
USING: xmode.tokens xmode.keyword-map kernel
|
||||||
sequences vectors assocs strings memoize regexp ;
|
sequences vectors assocs strings memoize regexp unicode.case ;
|
||||||
IN: xmode.rules
|
IN: xmode.rules
|
||||||
|
|
||||||
TUPLE: string-matcher string ignore-case? ;
|
TUPLE: string-matcher string ignore-case? ;
|
||||||
|
|
|
@ -505,7 +505,6 @@ CELL binary_payload_start(CELL pointer)
|
||||||
switch(untag_header(get(pointer)))
|
switch(untag_header(get(pointer)))
|
||||||
{
|
{
|
||||||
/* these objects do not refer to other objects at all */
|
/* these objects do not refer to other objects at all */
|
||||||
case STRING_TYPE:
|
|
||||||
case FLOAT_TYPE:
|
case FLOAT_TYPE:
|
||||||
case BYTE_ARRAY_TYPE:
|
case BYTE_ARRAY_TYPE:
|
||||||
case BIT_ARRAY_TYPE:
|
case BIT_ARRAY_TYPE:
|
||||||
|
@ -522,6 +521,8 @@ CELL binary_payload_start(CELL pointer)
|
||||||
return CELLS * 2;
|
return CELLS * 2;
|
||||||
case QUOTATION_TYPE:
|
case QUOTATION_TYPE:
|
||||||
return sizeof(F_QUOTATION) - CELLS * 2;
|
return sizeof(F_QUOTATION) - CELLS * 2;
|
||||||
|
case STRING_TYPE:
|
||||||
|
return sizeof(F_STRING);
|
||||||
/* everything else consists entirely of pointers */
|
/* everything else consists entirely of pointers */
|
||||||
default:
|
default:
|
||||||
return unaligned_object_size(pointer);
|
return unaligned_object_size(pointer);
|
||||||
|
|
52
vm/types.c
52
vm/types.c
|
@ -431,23 +431,30 @@ CELL string_nth(F_STRING* string, CELL index)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* allocates memory */
|
||||||
void set_string_nth(F_STRING* string, CELL index, CELL value)
|
void set_string_nth(F_STRING* string, CELL index, CELL value)
|
||||||
{
|
{
|
||||||
bput(SREF(string,index),value & 0xff);
|
bput(SREF(string,index),value & 0xff);
|
||||||
|
|
||||||
|
F_BYTE_ARRAY *aux;
|
||||||
|
|
||||||
if(string->aux == F)
|
if(string->aux == F)
|
||||||
{
|
{
|
||||||
if(value <= 0xff)
|
if(value <= 0xff)
|
||||||
return;
|
return;
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
string->aux = tag_object(allot_byte_array(
|
REGISTER_UNTAGGED(string);
|
||||||
|
aux = allot_byte_array(
|
||||||
untag_fixnum_fast(string->length)
|
untag_fixnum_fast(string->length)
|
||||||
* sizeof(u16)));
|
* sizeof(u16));
|
||||||
|
UNREGISTER_UNTAGGED(string);
|
||||||
|
string->aux = tag_object(aux);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
else
|
||||||
|
aux = untag_object(string->aux);
|
||||||
|
|
||||||
F_BYTE_ARRAY *aux = untag_object(string->aux);
|
|
||||||
cput(BREF(aux,index * sizeof(u16)),value >> 8);
|
cput(BREF(aux,index * sizeof(u16)),value >> 8);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -463,20 +470,36 @@ F_STRING* allot_string_internal(CELL capacity)
|
||||||
string->length = tag_fixnum(capacity);
|
string->length = tag_fixnum(capacity);
|
||||||
string->hashcode = F;
|
string->hashcode = F;
|
||||||
string->aux = F;
|
string->aux = F;
|
||||||
|
|
||||||
set_string_nth(string,capacity,0);
|
set_string_nth(string,capacity,0);
|
||||||
|
|
||||||
return string;
|
return string;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* allocates memory */
|
||||||
void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
|
void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
|
||||||
{
|
{
|
||||||
if(fill == 0)
|
if(fill == 0)
|
||||||
memset((void*)SREF(string,start),'\0',capacity - start);
|
{
|
||||||
|
memset((void *)SREF(string,start),'\0',capacity - start);
|
||||||
|
|
||||||
|
if(string->aux != F)
|
||||||
|
{
|
||||||
|
F_BYTE_ARRAY *aux = untag_object(string->aux);
|
||||||
|
memset((void *)BREF(aux,start * sizeof(u16)),'\0',
|
||||||
|
(capacity - start) * sizeof(u16));
|
||||||
|
}
|
||||||
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
CELL i;
|
CELL i;
|
||||||
|
|
||||||
for(i = start; i < capacity; i++)
|
for(i = start; i < capacity; i++)
|
||||||
|
{
|
||||||
|
REGISTER_UNTAGGED(string);
|
||||||
set_string_nth(string,i,fill);
|
set_string_nth(string,i,fill);
|
||||||
|
UNREGISTER_UNTAGGED(string);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -484,7 +507,9 @@ void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
|
||||||
F_STRING *allot_string(CELL capacity, CELL fill)
|
F_STRING *allot_string(CELL capacity, CELL fill)
|
||||||
{
|
{
|
||||||
F_STRING* string = allot_string_internal(capacity);
|
F_STRING* string = allot_string_internal(capacity);
|
||||||
|
REGISTER_UNTAGGED(string);
|
||||||
fill_string(string,0,capacity,fill);
|
fill_string(string,0,capacity,fill);
|
||||||
|
UNREGISTER_UNTAGGED(string);
|
||||||
return string;
|
return string;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -506,7 +531,23 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
|
||||||
UNREGISTER_UNTAGGED(string);
|
UNREGISTER_UNTAGGED(string);
|
||||||
|
|
||||||
memcpy(new_string + 1,string + 1,to_copy);
|
memcpy(new_string + 1,string + 1,to_copy);
|
||||||
|
|
||||||
|
if(string->aux != F)
|
||||||
|
{
|
||||||
|
REGISTER_UNTAGGED(string);
|
||||||
|
REGISTER_UNTAGGED(new_string);
|
||||||
|
F_BYTE_ARRAY *new_aux = allot_byte_array(capacity * sizeof(u16));
|
||||||
|
new_string->aux = tag_object(new_aux);
|
||||||
|
UNREGISTER_UNTAGGED(new_string);
|
||||||
|
UNREGISTER_UNTAGGED(string);
|
||||||
|
|
||||||
|
F_BYTE_ARRAY *aux = untag_object(string->aux);
|
||||||
|
memcpy(new_aux + 1,aux + 1,to_copy * sizeof(u16));
|
||||||
|
}
|
||||||
|
|
||||||
|
REGISTER_UNTAGGED(string);
|
||||||
fill_string(new_string,to_copy,capacity,fill);
|
fill_string(new_string,to_copy,capacity,fill);
|
||||||
|
UNREGISTER_UNTAGGED(string);
|
||||||
|
|
||||||
return new_string;
|
return new_string;
|
||||||
}
|
}
|
||||||
|
@ -529,7 +570,9 @@ DEFINE_PRIMITIVE(resize_string)
|
||||||
CELL i; \
|
CELL i; \
|
||||||
for(i = 0; i < length; i++) \
|
for(i = 0; i < length; i++) \
|
||||||
{ \
|
{ \
|
||||||
|
REGISTER_UNTAGGED(s); \
|
||||||
set_string_nth(s,i,(utype)*string); \
|
set_string_nth(s,i,(utype)*string); \
|
||||||
|
UNREGISTER_UNTAGGED(s); \
|
||||||
string++; \
|
string++; \
|
||||||
} \
|
} \
|
||||||
return s; \
|
return s; \
|
||||||
|
@ -552,6 +595,7 @@ DEFINE_PRIMITIVE(resize_string)
|
||||||
|
|
||||||
MEMORY_TO_STRING(char,u8)
|
MEMORY_TO_STRING(char,u8)
|
||||||
MEMORY_TO_STRING(u16,u16)
|
MEMORY_TO_STRING(u16,u16)
|
||||||
|
MEMORY_TO_STRING(u32,u32)
|
||||||
|
|
||||||
bool check_string(F_STRING *s, CELL max)
|
bool check_string(F_STRING *s, CELL max)
|
||||||
{
|
{
|
||||||
|
|
|
@ -83,8 +83,8 @@ INLINE CELL array_capacity(F_ARRAY* array)
|
||||||
return array->capacity >> TAG_BITS;
|
return array->capacity >> TAG_BITS;
|
||||||
}
|
}
|
||||||
|
|
||||||
#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + index)
|
#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + (index))
|
||||||
#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index)
|
#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + (index))
|
||||||
|
|
||||||
INLINE F_STRING* untag_string(CELL tagged)
|
INLINE F_STRING* untag_string(CELL tagged)
|
||||||
{
|
{
|
||||||
|
|
Loading…
Reference in New Issue