diff --git a/basis/db/tester/tester.factor b/basis/db/tester/tester.factor
index fcc5abf1cf..56bac7efcd 100644
--- a/basis/db/tester/tester.factor
+++ b/basis/db/tester/tester.factor
@@ -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
diff --git a/basis/editors/emacs/authors.txt b/basis/editors/emacs/authors.txt
index 6cfd5da273..07c1c4a765 100644
--- a/basis/editors/emacs/authors.txt
+++ b/basis/editors/emacs/authors.txt
@@ -1 +1,2 @@
Eduardo Cavazos
+Doug Coleman
diff --git a/basis/editors/emacs/emacs-docs.factor b/basis/editors/emacs/emacs-docs.factor
index f55068e143..adf6d8a7b7 100644
--- a/basis/editors/emacs/emacs-docs.factor
+++ b/basis/editors/emacs/emacs-docs.factor
@@ -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"
\ No newline at end of file
+"To quickly scaffold a " { $snippet ".emacs" } " file, run the following code:"
+{ $code "USE: tools.scaffold"
+ "scaffold-emacs"
+}
+
+{ $see-also "editor" }
+
+;
+
+ABOUT: "editors.emacs"
diff --git a/basis/io/files/windows/nt/nt.factor b/basis/io/files/windows/nt/nt.factor
index 9e449982fb..afc81c784c 100755
--- a/basis/io/files/windows/nt/nt.factor
+++ b/basis/io/files/windows/nt/nt.factor
@@ -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|| ;
diff --git a/build-support/factor.sh b/build-support/factor.sh
index 53aab9ad04..3ece72306a 100755
--- a/build-support/factor.sh
+++ b/build-support/factor.sh
@@ -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
diff --git a/extra/sandbox/authors.txt b/extra/sandbox/authors.txt
new file mode 100644
index 0000000000..f97e1bfbf9
--- /dev/null
+++ b/extra/sandbox/authors.txt
@@ -0,0 +1 @@
+Maxim Savchenko
diff --git a/extra/sandbox/sandbox-tests.factor b/extra/sandbox/sandbox-tests.factor
new file mode 100644
index 0000000000..5d0496e77b
--- /dev/null
+++ b/extra/sandbox/sandbox-tests.factor
@@ -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
diff --git a/extra/sandbox/sandbox.factor b/extra/sandbox/sandbox.factor
new file mode 100644
index 0000000000..097a7c8d8a
--- /dev/null
+++ b/extra/sandbox/sandbox.factor
@@ -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 ;
diff --git a/extra/sandbox/summary.txt b/extra/sandbox/summary.txt
new file mode 100644
index 0000000000..3ca1e25684
--- /dev/null
+++ b/extra/sandbox/summary.txt
@@ -0,0 +1 @@
+Basic sandboxing
diff --git a/extra/sandbox/syntax/syntax.factor b/extra/sandbox/syntax/syntax.factor
new file mode 100644
index 0000000000..2ff5f070c7
--- /dev/null
+++ b/extra/sandbox/syntax/syntax.factor
@@ -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: ;
diff --git a/extra/sequence-parser/sequence-parser-tests.factor b/extra/sequence-parser/sequence-parser-tests.factor
index 3b2fcad5eb..da097f4c00 100644
--- a/extra/sequence-parser/sequence-parser-tests.factor
+++ b/extra/sequence-parser/sequence-parser-tests.factor
@@ -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
diff --git a/extra/sequence-parser/sequence-parser.factor b/extra/sequence-parser/sequence-parser.factor
index 4f57a7ccae..4cc10fd5fd 100644
--- a/extra/sequence-parser/sequence-parser.factor
+++ b/extra/sequence-parser/sequence-parser.factor
@@ -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 ;