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

View File

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

View File

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

View File

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

View File

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

View File

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