steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into modern-harvey3

modern-harvey3-triple
Doug Coleman 2018-08-24 16:49:34 -05:00
parent a526fd0011 4dcfefc0b9
commit fdb5383f19
30 changed files with 94 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/alien/data/data-docs.factor
View File

@ -74,7 +74,7 @@ $nl
"If no initial value is specified, the contents of the allocated memory are undefined." } "If no initial value is specified, the contents of the allocated memory are undefined." }
{ $warning "Reading or writing a scoped allocation buffer outside of the given quotation will cause memory corruption." } { $warning "Reading or writing a scoped allocation buffer outside of the given quotation will cause memory corruption." }
{ $examples { $examples
{ $unchecked-example { $example
"USING: accessors alien.c-types alien.data "USING: accessors alien.c-types alien.data
classes.struct kernel math math.functions classes.struct kernel math math.functions
prettyprint ; prettyprint ;

9
basis/timers/timers-tests.factor
View File

@ -64,3 +64,12 @@ threads tools.test tools.time ;
700 milliseconds sleep dup restart-timer 700 milliseconds sleep dup restart-timer
700 milliseconds sleep stop-timer 500 milliseconds sleep 700 milliseconds sleep stop-timer 500 milliseconds sleep
] unit-test ] unit-test
{ { 2 } } [
{ 0 }
dup '[ 0 _ [ 1 + ] change-nth ] 300 milliseconds f <timer>
dup restart-timer
700 milliseconds sleep
dup restart-timer drop
700 milliseconds sleep
] unit-test

11
basis/timers/timers.factor
View File

@ -88,17 +88,14 @@ PRIVATE>
: stop-timer ( timer -- ) : stop-timer ( timer -- )
dup quotation-running?>> [ dup quotation-running?>> [
f >>thread drop dup thread>> [ interrupt ] when*
] [ ] unless f >>thread drop ;
[ [ interrupt ] when* f ] change-thread drop
] if ;
: restart-timer ( timer -- ) : restart-timer ( timer -- )
t >>restart?
dup quotation-running?>> [ dup quotation-running?>> [
drop t >>restart? drop
] [ ] [
dup thread>> [ nip interrupt ] [ start-timer ] if* dup thread>> [ interrupt ] when* start-timer
] if ; ] if ;
<PRIVATE <PRIVATE

87
build.sh
View File

@ -15,9 +15,11 @@ GIT_PROTOCOL=${GIT_PROTOCOL:="git"}
GIT_URL=${GIT_URL:=$GIT_PROTOCOL"://factorcode.org/git/factor.git"} GIT_URL=${GIT_URL:=$GIT_PROTOCOL"://factorcode.org/git/factor.git"}
SCRIPT_ARGS="$*" SCRIPT_ARGS="$*"
REQUIRE_CLANG_VERSION=3.1
# return 1 on found # return 1 on found
test_program_installed() { test_program_installed() {
if ! [[ -n `type -p $1` ]] ; then if ! [[ -n $(type -p $1) ]] ; then
return 0; return 0;
fi fi
return 1; return 1;
@ -25,9 +27,9 @@ test_program_installed() {
# return 1 on found # return 1 on found
test_programs_installed() { test_programs_installed() {
installed=0; local installed=0;
$ECHO -n "Checking for all($*)..." $ECHO -n "Checking for all($*)..."
for i in $* ; for i in "$@" ;
do do
test_program_installed $i test_program_installed $i
if [[ $? -eq 1 ]]; then if [[ $? -eq 1 ]]; then
@ -52,9 +54,9 @@ exit_script() {
} }
ensure_program_installed() { ensure_program_installed() {
installed=0; local installed=0;
$ECHO -n "Checking for any($*)..." $ECHO -n "Checking for any($*)..."
for i in $* ; for i in "$@" ;
do do
test_program_installed $i test_program_installed $i
if [[ $? -eq 1 ]]; then if [[ $? -eq 1 ]]; then
@ -133,16 +135,16 @@ semver_into() {
} }
clang_version_ok() { clang_version_ok() {
CLANG_VERSION=`clang --version | head -n1` CLANG_VERSION=$(clang --version | head -n1)
CLANG_VERSION_RE='^[a-zA-Z0-9 ]* version (.*)$' # 3.3-5 CLANG_VERSION_RE='^[a-zA-Z0-9 ]* version (.*)$' # 3.3-5
if [[ $CLANG_VERSION =~ $CLANG_VERSION_RE ]] ; then if [[ $CLANG_VERSION =~ $CLANG_VERSION_RE ]] ; then
export "CLANG_VERSION=${BASH_REMATCH[1]}" export "CLANG_VERSION=${BASH_REMATCH[1]}"
local CLANG_MAJOR local CLANG_MINOR local CLANG_PATCH local CLANG_SPECIAL local CLANG_MAJOR CLANG_MINOR CLANG_PATCH CLANG_SPECIAL
semver_into "$CLANG_VERSION" CLANG_MAJOR CLANG_MINOR CLANG_PATCH CLANG_SPECIAL semver_into "$CLANG_VERSION" CLANG_MAJOR CLANG_MINOR CLANG_PATCH CLANG_SPECIAL
if [[ $CLANG_MAJOR -lt 3 if [[ $CLANG_MAJOR -lt 3
|| ( $CLANG_MAJOR -eq 3 && $CLANG_MINOR -le 1 ) || ( $CLANG_MAJOR -eq 3 && $CLANG_MINOR -le 1 )
]] ; then ]] ; then
echo "clang version required >= 3.1, got $CLANG_VERSION" echo "clang version required >= $REQUIRE_CLANG_VERSION, got $CLANG_VERSION"
return 1 return 1
fi fi
else else
@ -241,7 +243,7 @@ check_factor_exists() {
find_os() { find_os() {
if [[ -n $OS ]] ; then return; fi if [[ -n $OS ]] ; then return; fi
$ECHO "Finding OS..." $ECHO "Finding OS..."
uname_s=`uname -s` local uname_s=$(uname -s)
check_ret uname check_ret uname
case $uname_s in case $uname_s in
CYGWIN_NT-5.2-WOW64) OS=windows;; CYGWIN_NT-5.2-WOW64) OS=windows;;
@ -258,7 +260,7 @@ find_os() {
find_architecture() { find_architecture() {
if [[ -n $ARCH ]] ; then return; fi if [[ -n $ARCH ]] ; then return; fi
$ECHO "Finding ARCH..." $ECHO "Finding ARCH..."
uname_m=`uname -m` uname_m=$(uname -m)
check_ret uname check_ret uname
case $uname_m in case $uname_m in
i386) ARCH=x86;; i386) ARCH=x86;;
@ -275,7 +277,7 @@ find_architecture() {
find_num_cores() { find_num_cores() {
$ECHO "Finding num cores..." $ECHO "Finding num cores..."
NUM_CORES=7ZZ NUM_CORES=7ZZ
uname_s=`uname -s` uname_s=$(uname -s)
check_ret uname check_ret uname
case $uname_s in case $uname_s in
CYGWIN_NT-5.2-WOW64 | *CYGWIN_NT* | *CYGWIN* | MINGW32*) NUM_CORES=$NUMBER_OF_PROCESSORS;; CYGWIN_NT-5.2-WOW64 | *CYGWIN_NT* | *CYGWIN* | MINGW32*) NUM_CORES=$NUMBER_OF_PROCESSORS;;
@ -283,20 +285,19 @@ find_num_cores() {
esac esac
} }
write_test_program() { echo_test_program() {
#! Must be 'echo' #! Must be 'echo'
echo "#include <stdio.h>" > $C_WORD.c echo -e "int main(){ return (long)(8*sizeof(void*)); }"
echo "int main(){printf(\"%ld\", (long)(8*sizeof(void*))); return 0; }" >> $C_WORD.c
} }
c_find_word_size() { c_find_word_size() {
$ECHO "Finding WORD..." $ECHO "Finding WORD..."
C_WORD=factor-word-size C_WORD="factor-word-size"
write_test_program echo_test_program | $CC -o $C_WORD -xc -
$CC -o $C_WORD $C_WORD.c check_ret $CC
WORD=$(./$C_WORD) ./$C_WORD
check_ret $C_WORD WORD=$?
$DELETE -f $C_WORD* $DELETE -f $C_WORD
} }
intel_macosx_word_size() { intel_macosx_word_size() {
@ -403,9 +404,9 @@ set_build_info() {
parse_build_info() { parse_build_info() {
ensure_program_installed cut ensure_program_installed cut
$ECHO "Parsing make target from command line: $1" $ECHO "Parsing make target from command line: $1"
OS=`echo $1 | cut -d '-' -f 1` OS=$(echo $1 | cut -d '-' -f 1)
ARCH=`echo $1 | cut -d '-' -f 2` ARCH=$(echo $1 | cut -d '-' -f 2)
WORD=`echo $1 | cut -d '-' -f 3` WORD=$(echo $1 | cut -d '-' -f 3)
if [[ $OS == linux && $ARCH == ppc ]] ; then WORD=32; fi if [[ $OS == linux && $ARCH == ppc ]] ; then WORD=32; fi
if [[ $OS == linux && $ARCH == arm ]] ; then WORD=32; fi if [[ $OS == linux && $ARCH == arm ]] ; then WORD=32; fi
@ -433,7 +434,7 @@ find_build_info() {
} }
invoke_git() { invoke_git() {
git $* git "$@"
check_ret git check_ret git
} }
@ -443,13 +444,13 @@ git_clone() {
} }
update_script_name() { update_script_name() {
$ECHO `dirname $0`/_update.sh $ECHO "$(dirname $0)/_update.sh"
} }
update_script() { update_script() {
update_script=`update_script_name` local -r update_script=$(update_script_name)
bash_path=`which bash` local -r bash_path=$(which bash)
branch=$(current_git_branch) local -r branch=$(current_git_branch)
$ECHO "#!$bash_path" >"$update_script" $ECHO "#!$bash_path" >"$update_script"
$ECHO "git pull \"$GIT_URL\" ${branch}" >>"$update_script" $ECHO "git pull \"$GIT_URL\" ${branch}" >>"$update_script"
$ECHO "if [[ \$? -eq 0 ]]; then exec \"$0\" $SCRIPT_ARGS; else echo \"git pull failed\"; exit 2; fi" \ $ECHO "if [[ \$? -eq 0 ]]; then exec \"$0\" $SCRIPT_ARGS; else echo \"git pull failed\"; exit 2; fi" \
@ -461,16 +462,16 @@ update_script() {
} }
update_script_changed() { update_script_changed() {
invoke_git diff --stat `invoke_git merge-base HEAD FETCH_HEAD` FETCH_HEAD | grep 'build\.sh' >/dev/null invoke_git diff --stat "$(invoke_git merge-base HEAD FETCH_HEAD)" FETCH_HEAD | grep 'build\.sh' >/dev/null
} }
git_fetch_factorcode() { git_fetch_factorcode() {
$ECHO "Fetching the git repository from factorcode.org..." $ECHO "Fetching the git repository from factorcode.org..."
branch=$(current_git_branch) branch=$(current_git_branch)
rm -f `update_script_name` rm -f "$(update_script_name)"
invoke_git fetch --all invoke_git fetch "$GIT_URL" --all
invoke_git fetch --tags invoke_git fetch "$GIT_URL" --tags
if update_script_changed; then if update_script_changed; then
$ECHO "Updating and restarting the build.sh script..." $ECHO "Updating and restarting the build.sh script..."
@ -482,7 +483,7 @@ git_fetch_factorcode() {
} }
cd_factor() { cd_factor() {
cd factor cd "factor"
check_ret cd check_ret cd
} }
@ -522,7 +523,7 @@ check_makefile_exists() {
invoke_make() { invoke_make() {
check_makefile_exists check_makefile_exists
$MAKE $MAKE_OPTS $* $MAKE $MAKE_OPTS "$@"
check_ret $MAKE check_ret $MAKE
} }
@ -546,13 +547,13 @@ current_git_branch() {
check_url() { check_url() {
if [[ $DOWNLOADER_NAME == 'wget' ]]; then if [[ $DOWNLOADER_NAME == 'wget' ]]; then
if [[ `wget -S --spider $1 2>&1 | grep 'HTTP/1.1 200 OK'` ]]; then if [[ $(wget -S --spider $1 2>&1 | grep 'HTTP/1.1 200 OK') ]]; then
return 0 return 0
else else
return 1 return 1
fi fi
elif [[ $DOWNLOADER_NAME == 'curl' ]]; then elif [[ $DOWNLOADER_NAME == 'curl' ]]; then
code=`curl -sL -w "%{http_code}\\n" "$1" -o /dev/null` local code=$(curl -sL -w "%{http_code}\\n" "$1" -o /dev/null)
if [[ $code -eq 200 ]]; then return 0; else return 1; fi if [[ $code -eq 200 ]]; then return 0; else return 1; fi
else else
$ECHO "error: wget or curl required in check_url" $ECHO "error: wget or curl required in check_url"
@ -564,10 +565,10 @@ check_url() {
# Otherwise, just use `master` # Otherwise, just use `master`
set_boot_image_vars() { set_boot_image_vars() {
set_current_branch set_current_branch
url="http://downloads.factorcode.org/images/${CURRENT_BRANCH}/checksums.txt" local url="http://downloads.factorcode.org/images/${CURRENT_BRANCH}/checksums.txt"
check_url $url check_url $url
if [[ $? -eq 0 ]]; then if [[ $? -eq 0 ]]; then
CHECKSUM_URL="http://downloads.factorcode.org/images/${CURRENT_BRANCH}/checksums.txt" CHECKSUM_URL="$url"
BOOT_IMAGE_URL="http://downloads.factorcode.org/images/${CURRENT_BRANCH}/${BOOT_IMAGE}" BOOT_IMAGE_URL="http://downloads.factorcode.org/images/${CURRENT_BRANCH}/${BOOT_IMAGE}"
else else
CHECKSUM_URL="http://downloads.factorcode.org/images/master/checksums.txt" CHECKSUM_URL="http://downloads.factorcode.org/images/master/checksums.txt"
@ -592,9 +593,9 @@ update_boot_image() {
$DELETE temp/staging.*.image > /dev/null 2>&1 $DELETE temp/staging.*.image > /dev/null 2>&1
if [[ -f $BOOT_IMAGE ]] ; then if [[ -f $BOOT_IMAGE ]] ; then
get_url $CHECKSUM_URL get_url $CHECKSUM_URL
factorcode_md5=`cat checksums.txt|grep $BOOT_IMAGE|cut -f2 -d' '` local factorcode_md5=$(cat checksums.txt | grep $BOOT_IMAGE | cut -f2 -d' ')
set_md5sum set_md5sum
disk_md5=`$MD5SUM $BOOT_IMAGE|cut -f1 -d' '` local disk_md5=$($MD5SUM $BOOT_IMAGE | cut -f1 -d' ')
$ECHO "Factorcode md5: $factorcode_md5"; $ECHO "Factorcode md5: $factorcode_md5";
$ECHO "Disk md5: $disk_md5"; $ECHO "Disk md5: $disk_md5";
if [[ "$factorcode_md5" == "$disk_md5" ]] ; then if [[ "$factorcode_md5" == "$disk_md5" ]] ; then
@ -668,12 +669,12 @@ net_bootstrap_no_pull() {
} }
refresh_image() { refresh_image() {
./$FACTOR_BINARY -script -e="USING: vocabs.loader vocabs.refresh system memory ; refresh-all save 0 exit" ./$FACTOR_BINARY -e="USING: vocabs.loader vocabs.refresh system memory ; refresh-all save 0 exit"
check_ret factor check_ret factor
} }
make_boot_image() { make_boot_image() {
./$FACTOR_BINARY -script -e="\"$MAKE_IMAGE_TARGET\" USING: system bootstrap.image memory ; make-image save 0 exit" ./$FACTOR_BINARY -e="\"$MAKE_IMAGE_TARGET\" USING: system bootstrap.image memory ; make-image save 0 exit"
check_ret factor check_ret factor
} }
@ -683,7 +684,7 @@ install_deps_apt() {
} }
install_deps_pacman() { install_deps_pacman() {
sudo pacman --noconfirm -S gcc clang make rlwrap git wget pango glibc gtk2 gtk3 gtkglext gtk-engines gdk-pixbuf2 libx11 screen tmux sudo pacman --noconfirm -Syu gcc clang make rlwrap git wget pango glibc gtk2 gtk3 gtkglext gtk-engines gdk-pixbuf2 libx11 screen tmux
check_ret sudo check_ret sudo
} }

2
core/splitting/splitting-docs.factor
View File

@ -15,6 +15,8 @@ ARTICLE: "sequences-split" "Splitting sequences"
split1-last split1-last
split1-last-slice split1-last-slice
split split
split-indices
split-slice
split-when split-when
split-when-slice split-when-slice
} }

10
extra/rosetta-code/ternary-logic/ternary-logic.factor
View File

@ -43,12 +43,12 @@ M: trit >trit ;
>trit { >trit {
{ t [ >trit ] } { t [ >trit ] }
{ m [ >trit { { t [ m ] } { m [ m ] } { f [ f ] } } case ] } { m [ >trit { { t [ m ] } { m [ m ] } { f [ f ] } } case ] }
{ f [ >trit drop f ] } { f [ drop f ] }
} case ; } case ;
: tor ( trit1 trit2 -- trit ) : tor ( trit1 trit2 -- trit )
>trit { >trit {
{ t [ >trit drop t ] } { t [ drop t ] }
{ m [ >trit { { t [ t ] } { m [ m ] } { f [ m ] } } case ] } { m [ >trit { { t [ t ] } { m [ m ] } { f [ m ] } } case ] }
{ f [ >trit ] } { f [ >trit ] }
} case ; } case ;
@ -56,13 +56,13 @@ M: trit >trit ;
: txor ( trit1 trit2 -- trit ) : txor ( trit1 trit2 -- trit )
>trit { >trit {
{ t [ tnot ] } { t [ tnot ] }
{ m [ >trit drop m ] } { m [ drop m ] }
{ f [ >trit ] } { f [ >trit ] }
} case ; } case ;
: t= ( trit1 trit2 -- trit ) : t= ( trit1 trit2 -- trit )
{ >trit {
{ t [ >trit ] } { t [ >trit ] }
{ m [ >trit drop m ] } { m [ drop m ] }
{ f [ tnot ] } { f [ tnot ] }
} case ; } case ;