Fix conflict
commit
97a522da0e
|
@ -3,7 +3,7 @@
|
|||
USING: concurrency.combinators db.pools db.sqlite db.tuples
|
||||
db.types kernel math random threads tools.test db sequences
|
||||
io prettyprint db.postgresql db.sqlite accessors io.files.temp
|
||||
namespaces fry system ;
|
||||
namespaces fry system math.parser ;
|
||||
IN: db.tester
|
||||
|
||||
: postgresql-test-db ( -- postgresql-db )
|
||||
|
@ -56,6 +56,10 @@ test-2 "TEST2" {
|
|||
{ "z" "Z" { VARCHAR 256 } +not-null+ }
|
||||
} define-persistent
|
||||
|
||||
: test-1-tuple ( -- tuple )
|
||||
f 100 random 100 random 100 random [ number>string ] tri@
|
||||
test-1 boa ;
|
||||
|
||||
: db-tester ( test-db -- )
|
||||
[
|
||||
[
|
||||
|
@ -67,8 +71,7 @@ test-2 "TEST2" {
|
|||
drop
|
||||
10 [
|
||||
dup [
|
||||
f 100 random 100 random 100 random test-1 boa
|
||||
insert-tuple yield
|
||||
test-1-tuple insert-tuple yield
|
||||
] with-db
|
||||
] times
|
||||
] with parallel-each
|
||||
|
@ -84,8 +87,7 @@ test-2 "TEST2" {
|
|||
<db-pool> [
|
||||
10 [
|
||||
10 [
|
||||
f 100 random 100 random 100 random test-1 boa
|
||||
insert-tuple yield
|
||||
test-1-tuple insert-tuple yield
|
||||
] times
|
||||
] parallel-each
|
||||
] with-pooled-db
|
||||
|
|
|
@ -1 +1,2 @@
|
|||
Eduardo Cavazos
|
||||
Doug Coleman
|
||||
|
|
|
@ -2,10 +2,23 @@ USING: help help.syntax help.markup ;
|
|||
IN: editors.emacs
|
||||
|
||||
ARTICLE: "editors.emacs" "Integration with Emacs"
|
||||
"Put this in your " { $snippet ".emacs" } " file:"
|
||||
"Full Emacs integration with Factor requires the use of two executable files -- " { $snippet "emacs" } " and " { $snippet "emacsclient" } ", which act as a client/server pair. To start the server, run the " { $snippet "emacs" } " binary and run " { $snippet "M-x server-start" } " or start " { $snippet "emacs" } " with the following line in your " { $snippet ".emacs" } " file:"
|
||||
{ $code "(server-start)" }
|
||||
"On Windows, if you install Emacs to " { $snippet "Program Files" } " or " { $snippet "Program Files(x86)" } ", Factor will automatically detect the path to " { $snippet "emacsclient.exe" } ". On Unix systems, make sure that " { $snippet "emacsclient" } " is in your path. To set the path manually, use the following snippet:"
|
||||
{ $code "USE: edtiors.emacs"
|
||||
"\"/my/crazy/bin/emacsclient\" emacsclient-path set-global"
|
||||
}
|
||||
|
||||
"If you would like a new window to open when you ask Factor to edit an object, put this in your " { $snippet ".emacs" } " file:"
|
||||
{ $code "(setq server-window 'switch-to-buffer-other-frame)" }
|
||||
{ $see-also "editor" } ;
|
||||
|
||||
ABOUT: "editors.emacs"
|
||||
"To quickly scaffold a " { $snippet ".emacs" } " file, run the following code:"
|
||||
{ $code "USE: tools.scaffold"
|
||||
"scaffold-emacs"
|
||||
}
|
||||
|
||||
{ $see-also "editor" }
|
||||
|
||||
;
|
||||
|
||||
ABOUT: "editors.emacs"
|
||||
|
|
|
@ -4,7 +4,7 @@ io.backend.windows io.files.windows io.encodings.utf16n windows
|
|||
windows.kernel32 kernel libc math threads system environment
|
||||
alien.c-types alien.arrays alien.strings sequences combinators
|
||||
combinators.short-circuit ascii splitting alien strings assocs
|
||||
namespaces make accessors tr windows.time ;
|
||||
namespaces make accessors tr windows.time windows.shell32 ;
|
||||
IN: io.files.windows.nt
|
||||
|
||||
M: winnt cwd
|
||||
|
@ -58,4 +58,9 @@ M: winnt open-append
|
|||
[ dup windows-file-size ] [ drop 0 ] recover
|
||||
[ (open-append) ] dip >>ptr ;
|
||||
|
||||
M: winnt home "USERPROFILE" os-env ;
|
||||
M: winnt home
|
||||
{
|
||||
[ "HOMEDRIVE" os-env "HOMEPATH" os-env append-path ]
|
||||
[ "USERPROFILE" os-env ]
|
||||
[ my-documents ]
|
||||
} 0|| ;
|
||||
|
|
|
@ -22,6 +22,13 @@ test_program_installed() {
|
|||
return 1;
|
||||
}
|
||||
|
||||
exit_script() {
|
||||
if [[ $FIND_MAKE_TARGET -eq true ]] ; then
|
||||
echo $MAKE_TARGET;
|
||||
fi
|
||||
exit $1
|
||||
}
|
||||
|
||||
ensure_program_installed() {
|
||||
installed=0;
|
||||
for i in $* ;
|
||||
|
@ -43,7 +50,7 @@ ensure_program_installed() {
|
|||
$ECHO -n "any of [ $* ]"
|
||||
fi
|
||||
$ECHO " and try again."
|
||||
exit 1
|
||||
exit_script 1;
|
||||
fi
|
||||
}
|
||||
|
||||
|
@ -51,7 +58,7 @@ check_ret() {
|
|||
RET=$?
|
||||
if [[ $RET -ne 0 ]] ; then
|
||||
$ECHO $1 failed
|
||||
exit 2
|
||||
exit_script 2
|
||||
fi
|
||||
}
|
||||
|
||||
|
@ -62,7 +69,7 @@ check_gcc_version() {
|
|||
if [[ $GCC_VERSION == *3.3.* ]] ; then
|
||||
$ECHO "You have a known buggy version of gcc (3.3)"
|
||||
$ECHO "Install gcc 3.4 or higher and try again."
|
||||
exit 3
|
||||
exit_script 3
|
||||
elif [[ $GCC_VERSION == *4.3.* ]] ; then
|
||||
MAKE_OPTS="$MAKE_OPTS SITE_CFLAGS=-fno-forward-propagate"
|
||||
fi
|
||||
|
@ -154,7 +161,7 @@ check_factor_exists() {
|
|||
if [[ -d "factor" ]] ; then
|
||||
$ECHO "A directory called 'factor' already exists."
|
||||
$ECHO "Rename or delete it and try again."
|
||||
exit 4
|
||||
exit_script 4
|
||||
fi
|
||||
}
|
||||
|
||||
|
@ -279,7 +286,7 @@ check_os_arch_word() {
|
|||
$ECHO "OS, ARCH, or WORD is empty. Please report this."
|
||||
|
||||
echo $MAKE_TARGET
|
||||
exit 5
|
||||
exit_script 5
|
||||
fi
|
||||
}
|
||||
|
||||
|
@ -385,7 +392,7 @@ check_makefile_exists() {
|
|||
echo "You are likely in the wrong directory."
|
||||
echo "Run this script from your factor directory:"
|
||||
echo " ./build-support/factor.sh"
|
||||
exit 6
|
||||
exit_script 6
|
||||
fi
|
||||
}
|
||||
|
||||
|
@ -536,6 +543,6 @@ case "$1" in
|
|||
bootstrap) get_config_info; bootstrap ;;
|
||||
report) find_build_info ;;
|
||||
net-bootstrap) get_config_info; update_boot_images; bootstrap ;;
|
||||
make-target) ECHO=false; find_build_info; echo $MAKE_TARGET ;;
|
||||
make-target) FIND_MAKE_TARGET=true; ECHO=false; find_build_info; exit_script ;;
|
||||
*) usage ;;
|
||||
esac
|
||||
|
|
|
@ -3,7 +3,7 @@ io.streams.string kernel math namespaces parser prettyprint
|
|||
sequences strings tools.test vectors words quotations classes
|
||||
classes.private classes.union classes.mixin classes.predicate
|
||||
classes.algebra vectors definitions source-files compiler.units
|
||||
kernel.private sorting vocabs memory eval accessors ;
|
||||
kernel.private sorting vocabs memory eval accessors sets ;
|
||||
IN: classes.tests
|
||||
|
||||
[ t ] [ 3 object instance? ] unit-test
|
||||
|
@ -22,10 +22,11 @@ M: method-forget-class method-forget-test ;
|
|||
[ ] [ [ \ method-forget-class forget ] with-compilation-unit ] unit-test
|
||||
[ t ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ { } { } ] [
|
||||
all-words [ class? ] filter
|
||||
implementors-map get keys
|
||||
[ natural-sort ] bi@ =
|
||||
[ natural-sort ] bi@
|
||||
[ diff ] [ swap diff ] 2bi
|
||||
] unit-test
|
||||
|
||||
! Minor leak
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Maxim Savchenko
|
|
@ -0,0 +1,57 @@
|
|||
! Copyright (C) 2009 Maxim Savchenko
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: kernel accessors continuations lexer vocabs vocabs.parser
|
||||
combinators.short-circuit sandbox tools.test ;
|
||||
|
||||
IN: sandbox.tests
|
||||
|
||||
<< "sandbox.syntax" load-vocab drop >>
|
||||
USE: sandbox.syntax.private
|
||||
|
||||
: run-script ( x lines -- y )
|
||||
H{ { "kernel" "kernel" } { "math" "math" } { "sequences" "sequences" } }
|
||||
parse-sandbox call( x -- x! ) ;
|
||||
|
||||
[ 120 ]
|
||||
[
|
||||
5
|
||||
{
|
||||
"! Simple factorial example"
|
||||
"APPLYING: kernel math sequences ;"
|
||||
"1 swap [ 1+ * ] each"
|
||||
} run-script
|
||||
] unit-test
|
||||
|
||||
[
|
||||
5
|
||||
{
|
||||
"! Jailbreak attempt with USE:"
|
||||
"USE: io"
|
||||
"\"Hello world!\" print"
|
||||
} run-script
|
||||
]
|
||||
[
|
||||
{
|
||||
[ lexer-error? ]
|
||||
[ error>> condition? ]
|
||||
[ error>> error>> no-word-error? ]
|
||||
[ error>> error>> name>> "USE:" = ]
|
||||
} 1&&
|
||||
] must-fail-with
|
||||
|
||||
[
|
||||
5
|
||||
{
|
||||
"! Jailbreak attempt with unauthorized APPLY:"
|
||||
"APPLY: io"
|
||||
"\"Hello world!\" print"
|
||||
} run-script
|
||||
]
|
||||
[
|
||||
{
|
||||
[ lexer-error? ]
|
||||
[ error>> sandbox-error? ]
|
||||
[ error>> vocab>> "io" = ]
|
||||
} 1&&
|
||||
] must-fail-with
|
|
@ -0,0 +1,23 @@
|
|||
! Copyright (C) 2009 Maxim Savchenko.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: kernel sequences vectors assocs namespaces parser lexer vocabs
|
||||
combinators.short-circuit vocabs.parser ;
|
||||
|
||||
IN: sandbox
|
||||
|
||||
SYMBOL: whitelist
|
||||
|
||||
: with-sandbox-vocabs ( quot -- )
|
||||
"sandbox.syntax" load-vocab vocab-words 1vector
|
||||
use [ auto-use? off call ] with-variable ; inline
|
||||
|
||||
: parse-sandbox ( lines assoc -- quot )
|
||||
whitelist [ [ parse-lines ] with-sandbox-vocabs ] with-variable ;
|
||||
|
||||
: reveal-in ( name -- )
|
||||
[ { [ search ] [ no-word ] } 1|| ] keep current-vocab vocab-words set-at ;
|
||||
|
||||
SYNTAX: REVEAL: scan reveal-in ;
|
||||
|
||||
SYNTAX: REVEALING: ";" parse-tokens [ reveal-in ] each ;
|
|
@ -0,0 +1 @@
|
|||
Basic sandboxing
|
|
@ -0,0 +1,26 @@
|
|||
! Copyright (C) 2009 Maxim Savchenko.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: kernel sequences assocs namespaces lexer vocabs.parser sandbox ;
|
||||
IN: sandbox.syntax
|
||||
|
||||
<PRIVATE
|
||||
|
||||
ERROR: sandbox-error vocab ;
|
||||
|
||||
: sandbox-use+ ( alias -- )
|
||||
dup whitelist get at [ use+ ] [ sandbox-error ] ?if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
SYNTAX: APPLY: scan sandbox-use+ ;
|
||||
|
||||
SYNTAX: APPLYING: ";" parse-tokens [ sandbox-use+ ] each ;
|
||||
|
||||
REVEALING:
|
||||
! #!
|
||||
HEX: OCT: BIN: f t CHAR: "
|
||||
[ { T{
|
||||
] } ;
|
||||
|
||||
REVEAL: ;
|
|
@ -1,4 +1,5 @@
|
|||
USING: tools.test sequence-parser ascii kernel accessors ;
|
||||
USING: tools.test sequence-parser unicode.categories kernel
|
||||
accessors ;
|
||||
IN: sequence-parser.tests
|
||||
|
||||
[ "hello" ]
|
||||
|
@ -189,3 +190,15 @@ IN: sequence-parser.tests
|
|||
|
||||
[ "123u" ]
|
||||
[ "123u" <sequence-parser> take-c-integer ] unit-test
|
||||
|
||||
[ 36 ]
|
||||
[
|
||||
" //jofiejoe\n //eoieow\n/*asdf*/\n "
|
||||
<sequence-parser> skip-whitespace/comments n>>
|
||||
] unit-test
|
||||
|
||||
[ f ]
|
||||
[ "\n" <sequence-parser> take-integer ] unit-test
|
||||
|
||||
[ "\n" ] [ "\n" <sequence-parser> [ ] take-while ] unit-test
|
||||
[ f ] [ "\n" <sequence-parser> [ not ] take-while ] unit-test
|
||||
|
|
|
@ -52,7 +52,7 @@ TUPLE: sequence-parser sequence n ;
|
|||
] [
|
||||
[ drop n>> ]
|
||||
[ skip-until ]
|
||||
[ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq
|
||||
[ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq f like
|
||||
] if ; inline
|
||||
|
||||
: take-while ( sequence-parser quot: ( obj -- ? ) -- sequence/f )
|
||||
|
@ -104,6 +104,45 @@ TUPLE: sequence-parser sequence n ;
|
|||
: skip-whitespace ( sequence-parser -- sequence-parser )
|
||||
[ [ current blank? not ] take-until drop ] keep ;
|
||||
|
||||
: skip-whitespace-eol ( sequence-parser -- sequence-parser )
|
||||
[ [ current " \t\r" member? not ] take-until drop ] keep ;
|
||||
|
||||
: take-c-comment ( sequence-parser -- seq/f )
|
||||
[
|
||||
dup "/*" take-sequence [
|
||||
"*/" take-until-sequence*
|
||||
] [
|
||||
drop f
|
||||
] if
|
||||
] with-sequence-parser ;
|
||||
|
||||
: take-c++-comment ( sequence-parser -- seq/f )
|
||||
[
|
||||
dup "//" take-sequence [
|
||||
[
|
||||
[
|
||||
{ [ current CHAR: \n = ] [ sequence-parse-end? ] } 1||
|
||||
] take-until
|
||||
] [
|
||||
advance drop
|
||||
] bi
|
||||
] [
|
||||
drop f
|
||||
] if
|
||||
] with-sequence-parser ;
|
||||
|
||||
: skip-whitespace/comments ( sequence-parser -- sequence-parser )
|
||||
skip-whitespace-eol
|
||||
{
|
||||
{ [ dup take-c-comment ] [ skip-whitespace/comments ] }
|
||||
{ [ dup take-c++-comment ] [ skip-whitespace/comments ] }
|
||||
[ ]
|
||||
} cond ;
|
||||
|
||||
: take-define-identifier ( sequence-parser -- string )
|
||||
skip-whitespace/comments
|
||||
[ current { [ blank? ] [ CHAR: ( = ] } 1|| ] take-until ;
|
||||
|
||||
: take-rest-slice ( sequence-parser -- sequence/f )
|
||||
[ sequence>> ] [ n>> ] bi
|
||||
2dup [ length ] dip < [ 2drop f ] [ tail-slice ] if ; inline
|
||||
|
@ -157,30 +196,6 @@ TUPLE: sequence-parser sequence n ;
|
|||
sequence-parser [ n + ] change-n drop
|
||||
] if ;
|
||||
|
||||
: take-c-comment ( sequence-parser -- seq/f )
|
||||
[
|
||||
dup "/*" take-sequence [
|
||||
"*/" take-until-sequence*
|
||||
] [
|
||||
drop f
|
||||
] if
|
||||
] with-sequence-parser ;
|
||||
|
||||
: take-c++-comment ( sequence-parser -- seq/f )
|
||||
[
|
||||
dup "//" take-sequence [
|
||||
[
|
||||
[
|
||||
{ [ current CHAR: \n = ] [ sequence-parse-end? ] } 1||
|
||||
] take-until
|
||||
] [
|
||||
advance drop
|
||||
] bi
|
||||
] [
|
||||
drop f
|
||||
] if
|
||||
] with-sequence-parser ;
|
||||
|
||||
: c-identifier-begin? ( ch -- ? )
|
||||
CHAR: a CHAR: z [a,b]
|
||||
CHAR: A CHAR: Z [a,b]
|
||||
|
@ -192,29 +207,30 @@ TUPLE: sequence-parser sequence n ;
|
|||
CHAR: 0 CHAR: 9 [a,b]
|
||||
{ CHAR: _ } 4 nappend member? ;
|
||||
|
||||
: take-c-identifier ( state-parser -- string/f )
|
||||
[
|
||||
dup current c-identifier-begin? [
|
||||
[ current c-identifier-ch? ] take-while
|
||||
] [
|
||||
drop f
|
||||
] if
|
||||
] with-sequence-parser ;
|
||||
: (take-c-identifier) ( sequence-parser -- string/f )
|
||||
dup current c-identifier-begin? [
|
||||
[ current c-identifier-ch? ] take-while
|
||||
] [
|
||||
drop f
|
||||
] if ;
|
||||
|
||||
: take-c-identifier ( sequence-parser -- string/f )
|
||||
[ (take-c-identifier) ] with-sequence-parser ;
|
||||
|
||||
<< "length" [ length ] define-sorting >>
|
||||
|
||||
: sort-tokens ( seq -- seq' )
|
||||
{ length>=< <=> } sort-by ;
|
||||
|
||||
: take-first-matching ( state-parser seq -- seq )
|
||||
: take-first-matching ( sequence-parser seq -- seq )
|
||||
swap
|
||||
'[ _ [ swap take-sequence ] with-sequence-parser ] find nip ;
|
||||
|
||||
|
||||
: take-longest ( state-parser seq -- seq )
|
||||
: take-longest ( sequence-parser seq -- seq )
|
||||
sort-tokens take-first-matching ;
|
||||
|
||||
: take-c-integer ( state-parser -- string/f )
|
||||
: take-c-integer ( sequence-parser -- string/f )
|
||||
[
|
||||
dup take-integer [
|
||||
swap
|
||||
|
@ -225,5 +241,19 @@ TUPLE: sequence-parser sequence n ;
|
|||
] if*
|
||||
] with-sequence-parser ;
|
||||
|
||||
CONSTANT: c-punctuators
|
||||
{
|
||||
"[" "]" "(" ")" "{" "}" "." "->"
|
||||
"++" "--" "&" "*" "+" "-" "~" "!"
|
||||
"/" "%" "<<" ">>" "<" ">" "<=" ">=" "==" "!=" "^" "|" "&&" "||"
|
||||
"?" ":" ";" "..."
|
||||
"=" "*=" "/=" "%=" "+=" "-=" "<<=" ">>=" "&=" "^=" "|="
|
||||
"," "#" "##"
|
||||
"<:" ":>" "<%" "%>" "%:" "%:%:"
|
||||
}
|
||||
|
||||
: take-c-punctuator ( sequence-parser -- string/f )
|
||||
c-punctuators take-longest ;
|
||||
|
||||
: write-full ( sequence-parser -- ) sequence>> write ;
|
||||
: write-rest ( sequence-parser -- ) take-rest write ;
|
||||
|
|
|
@ -1,5 +1,3 @@
|
|||
Copyright (C) 2003, 2009 Slava Pestov and friends.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
|
|
Loading…
Reference in New Issue