switch some vocabs to 4 spaces.

db4
John Benediktsson 2013-07-24 14:52:09 -07:00
parent 1f5e8f3970
commit c75fc48f23
16 changed files with 1089 additions and 1088 deletions

View File

@ -59,7 +59,7 @@ C: <foo> foo
] with-variables
] unit-test
{ H{ { ?a ?a } } } [
{ H{ { ?a ?a } } }
\ ?a \ ?a match
] unit-test
@ -69,9 +69,7 @@ C: <foo> foo
} match-cond
] unit-test
[
{ 2 1 }
] [
{ { 2 1 } } [
{ "a" 1 2 "b" } { _ ?a ?b _ } { ?b ?a } match-replace
] unit-test

View File

@ -187,13 +187,22 @@ M: real absq sq ; inline
: >=1? ( x -- ? )
dup complex? [ drop f ] [ 1 >= ] if ; inline
<PRIVATE
: fp-normalize ( x -- y exp )
dup abs 0x1.0p-1022 < [ 52 2^ * -52 ] [ 0 ] if ; inline
PRIVATE>
GENERIC: frexp ( x -- y exp )
M: float frexp
dup fp-special? [ dup zero? ] unless* [ 0 ] [
fp-normalize [
double>bits
[ 0x800f,ffff,ffff,ffff bitand 0.5 double>bits bitor bits>double ]
[ -52 shift 0x7ff bitand 1022 - ] bi
] dip +
] if ; inline
M: integer frexp
@ -210,8 +219,9 @@ GENERIC# ldexp 1 ( x exp -- y )
M: float ldexp
over fp-special? [ over zero? ] unless* [ drop ] [
[ double>bits dup -52 shift 0x7ff bitand 1023 - ] dip +
{
[ fp-normalize ] dip
[ double>bits dup -52 shift 0x7ff bitand 1023 - ]
[ + ] [ + ] tri* {
{ [ dup -1074 < ] [ drop 0 copysign ] }
{ [ dup 1023 > ] [ drop 0 < -1/0. 1/0. ? ] }
[

View File

@ -24,7 +24,8 @@ SYMBOL: error-stack
{
{ [ over position>> not ] [ nip ] }
{ [ dup position>> not ] [ drop ] }
[ 2dup [ position>> ] compare {
[
2dup [ position>> ] compare {
{ +lt+ [ nip ] }
{ +gt+ [ drop ] }
{ +eq+ [ messages>> over messages>> union [ position>> ] dip <parse-error> ] }
@ -121,9 +122,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
: memo ( pos id -- memo-entry )
#! Return the result from the memo cache.
packrat at
! " memo result " write dup .
;
packrat at ;
: set-memo ( memo-entry pos id -- )
#! Store an entry in the cache
@ -230,12 +229,9 @@ TUPLE: peg-head rule-id involved-set eval-set ;
] if ;
: apply-rule ( r p -- ast )
! 2dup [ rule-id ] dip 2array "apply-rule: " write .
2dup recall [
! " memoed" print
nip apply-memo-rule
] [
! " not memoed" print
apply-non-memo-rule
] if* ; inline

View File

@ -40,8 +40,7 @@ HELP: (byte-array)
HELP: >byte-array
{ $values { "seq" "a sequence" } { "byte-array" byte-array } }
{ $description
"Outputs a freshly-allocated byte array whose elements have the same signed byte values as a given sequence." }
{ $description "Outputs a freshly-allocated byte array whose elements have the same signed byte values as a given sequence." }
{ $errors "Throws an error if the sequence contains elements other than integers." } ;
HELP: 1byte-array

View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel peg strings sequences math math.parser
namespaces make words quotations arrays hashtables io
io.streams.string assocs ascii peg.parsers words.symbol ;
io.streams.string assocs ascii peg.parsers words.symbol
combinators.short-circuit ;
IN: fjsc
TUPLE: ast-number value ;
@ -21,20 +22,22 @@ TUPLE: ast-in name ;
TUPLE: ast-hashtable elements ;
: identifier-middle? ( ch -- bool )
[ blank? not ] keep
[ "}];\"" member? not ] keep
digit? not
and and ;
{
[ blank? not ]
[ "}];\"" member? not ]
[ digit? not ]
} 1&& ;
: 'identifier-ends' ( -- parser )
[
[ blank? not ] keep
[ CHAR: " = not ] keep
[ CHAR: ; = not ] keep
[ LETTER? not ] keep
[ letter? not ] keep
identifier-middle? not
and and and and and
{
[ blank? not ]
[ CHAR: " = not ]
[ CHAR: ; = not ]
[ LETTER? not ]
[ letter? not ]
[ identifier-middle? not ]
} 1&&
] satisfy repeat0 ;
: 'identifier-middle' ( -- parser )
@ -54,10 +57,11 @@ DEFER: 'expression'
: 'effect-name' ( -- parser )
[
[ blank? not ] keep
[ CHAR: ) = not ] keep
CHAR: - = not
and and
{
[ blank? not ]
[ CHAR: ) = not ]
[ CHAR: - = not ]
} 1&&
] satisfy repeat1 [ >string ] action ;
: 'stack-effect' ( -- parser )

View File

@ -9,12 +9,10 @@ IN: update
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: git-pull-clean ( -- )
image parent-directory
[
image parent-directory [
{ "git" "pull" "git://factorcode.org/git/factor.git" branch-name }
run-command
]
with-directory ;
] with-directory ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -33,28 +31,24 @@ IN: update
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: rebuild ( -- )
image parent-directory
[
image parent-directory [
download-clean-image
make-clean
make
boot
]
with-directory ;
] with-directory ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: update ( -- )
image parent-directory
[
image parent-directory [
git-id
git-pull-clean
git-id
= not
[ rebuild ]
when
]
with-directory ;
] with-directory ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!