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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2008-07-01 19:31:24 -07:00
parent 5a01439038 5aa78554ad
commit 23bc77ec4c
17 changed files with 134 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
extra/bake/bake.factor
View File

@ -1,61 +1,59 @@
USING: kernel parser namespaces quotations arrays vectors strings
sequences assocs classes.tuple math combinators ;
USING: kernel parser combinators sequences splitting quotations arrays macros
arrays.lib combinators.cleave combinators.conditional newfx ;
IN: bake
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: insert-quot expr ;
SYMBOL: ,
SYMBOL: @
C: <insert-quot> insert-quot
: ,[ \ ] [ >quotation <insert-quot> ] parse-literal ; parsing
: comma? ( obj -- ? ) , = ;
: atsym? ( obj -- ? ) @ = ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: splice-quot expr ;
DEFER: [bake-array]
C: <splice-quot> splice-quot
: %[ \ ] [ >quotation <splice-quot> ] parse-literal ; parsing
: broil-element ( obj -- quot )
{
{ [ comma? ] [ drop [ >r ] ] }
{ [ array? ] [ [bake-array] [ >r ] append ] }
{ [ drop t ] [ [ >r ] prefix-on ] }
}
1cond ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: ,u ( seq -- seq ) unclip building get push ;
: [broil] ( array -- quot )
[ reverse [ broil-element ] map concat ]
[ length [ drop [ r> ] ] map concat ]
[ length [ narray ] prefix-on ]
tri append append
>quotation ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: exemplar
: [simmer] ( array -- quot )
: reset-building ( -- ) 1024 <vector> building set ;
{ @ } split reverse
[ [ [bake-array] [ append ] append [ >r ] append ] map concat ]
[ length [ drop [ r> append ] ] map concat ]
bi
: save-exemplar ( seq -- seq ) dup exemplar set ;
>r 2 head* [ >r ] append r> ! remove the last append
: finish-baking ( -- seq ) building get exemplar get like ;
[ { } ] swap append
DEFER: bake
: bake-item ( item -- )
{ { [ dup \ , = ] [ drop , ] }
{ [ dup \ % = ] [ drop % ] }
{ [ dup \ ,u = ] [ drop ,u ] }
{ [ dup insert-quot? ] [ insert-quot-expr call , ] }
{ [ dup splice-quot? ] [ splice-quot-expr call % ] }
{ [ dup integer? ] [ , ] }
{ [ dup string? ] [ , ] }
{ [ dup tuple? ] [ tuple>array bake >tuple , ] }
{ [ dup assoc? ] [ [ >alist bake ] keep assoc-like , ] }
{ [ dup sequence? ] [ bake , ] }
{ [ t ] [ , ] } }
cond ;
: bake-items ( seq -- ) [ bake-item ] each ;
: bake ( seq -- seq )
[ reset-building save-exemplar bake-items finish-baking ] with-scope ;
append ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: `{ \ } [ >array ] parse-literal \ bake parsed ; parsing
: [bake-array] ( array -- quot ) [ @ member? ] [ [simmer] ] [ [broil] ] 1if ;
MACRO: bake-array ( array -- quot ) [bake-array] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: `{ \ } [ >array ] parse-literal \ bake-array parsed ; parsing

13
extra/bootstrap/image/download/download.factor
View File

@ -1,13 +1,13 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: bootstrap.image.download
USING: http.client checksums checksums.openssl splitting assocs
kernel io.files bootstrap.image sequences io ;
kernel io.files bootstrap.image sequences io urls ;
IN: bootstrap.image.download
: url "http://factorcode.org/images/latest/" ;
: url URL" http://factorcode.org/images/latest/" ;
: download-checksums ( -- alist )
url "checksums.txt" append http-get nip
url "checksums.txt" >url derive-url http-get nip
string-lines [ " " split1 ] { } map>assoc ;
: need-new-image? ( image -- ? )
@ -21,7 +21,10 @@ kernel io.files bootstrap.image sequences io ;
: download-image ( arch -- )
boot-image-name dup need-new-image? [
"Downloading " write dup write "..." print
url prepend download
url over >url derive-url download
need-new-image? [
"Boot image corrupt, or checksums.txt on server out of date" throw
] when
] [
"Boot image up to date" print
drop

2
extra/builder/release/release.factor
View File

@ -1,7 +1,7 @@
USING: kernel debugger system namespaces sequences splitting combinators
io io.files io.launcher prettyprint bootstrap.image
bake combinators.cleave
combinators.cleave
builder.util
builder.common
builder.release.branch

2
extra/builder/util/util.factor
View File

@ -6,7 +6,7 @@ USING: kernel words namespaces classes parser continuations
combinators sequences splitting quotations arrays strings tools.time
sequences.deep accessors assocs.lib
io.encodings.utf8
combinators.cleave bake calendar calendar.format ;
combinators.cleave calendar calendar.format ;
IN: builder.util

17
extra/combinators/conditional/conditional.factor Normal file
View File

@ -0,0 +1,17 @@
USING: kernel combinators sequences macros fry newfx combinators.cleave ;
IN: combinators.conditional
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MACRO: 1if ( test then else -- ) '[ dup @ , , if ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MACRO: 1cond ( tbl -- )
[ [ 1st [ dup ] prepend ] [ 2nd ] bi {2} ] map
[ cond ] prefix-on ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

23
extra/newfx/newfx.factor
View File

@ -196,3 +196,26 @@ METHOD: as-mutate { object object assoc } set-at ;
: adjoin-on ( elt seq -- seq ) tuck sets:adjoin ;
: adjoined ( set elt -- ) swap sets:adjoin ;
: adjoined-on ( elt set -- ) sets:adjoin ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: start ( seq subseq -- i ) swap sequences:start ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: pluck ( seq i -- seq ) cut-slice rest-slice append ;
: pluck-from ( i seq -- seq ) swap pluck ;
: pluck! ( seq i -- seq ) over delete-nth ;
: pluck-from! ( i seq -- seq ) tuck delete-nth ;
: plucked! ( seq i -- ) swap delete-nth ;
: plucked-from! ( i seq -- ) delete-nth ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: snip ( seq a b -- seq ) >r over r> [ head ] [ tail ] 2bi* append ;
: snip-this ( a b seq -- seq ) -rot snip ;
: snip! ( seq a b -- seq ) pick delete-slice ;
: snip-this! ( a b seq -- seq ) -rot pick delete-slice ;
: snipped! ( seq a b -- ) rot delete-slice ;
: snipped-from! ( a b seq -- ) delete-slice ;

6
extra/random-weighted/random-weighted.factor
View File

@ -1,6 +1,6 @@
USING: kernel namespaces arrays quotations sequences assocs combinators
mirrors math math.vectors random macros bake ;
mirrors math math.vectors random macros fry ;
IN: random-weighted
@ -16,5 +16,5 @@ probabilities layers [ 1000 * ] map 1000 random [ > ] curry find drop ;
dup [ second ] map swap [ first ] map random-weighted swap nth ;
MACRO: call-random-weighted ( exp -- )
[ keys ] [ values <enum> >alist ] bi swap
[ , random-weighted , case ] bake ;
[ keys ] [ values <enum> >alist ] bi
'[ , random-weighted , case ] ;

3
extra/raptor/raptor.factor
View File

@ -1,5 +1,6 @@
USING: kernel parser namespaces threads arrays sequences unix unix.process bake ;
USING: kernel parser namespaces threads arrays sequences unix unix.process
bake ;
IN: raptor

30
extra/rewrite-closures/rewrite-closures.factor
View File

@ -1,30 +1,26 @@
USING: kernel parser math quotations namespaces sequences namespaces.lib
inference.transforms ;
USING: kernel parser math quotations namespaces sequences macros fry ;
IN: rewrite-closures
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! : set-parameters ( seq -- ) reverse [ set ] each ;
: [set-parameters] ( seq -- quot ) reverse [ [ set ] curry ] map concat ;
: [set-parameters] ( seq -- quot ) [ [ set ] curry ] map concat ;
: set-parameters ( seq -- ) [set-parameters] call ;
\ set-parameters [ [set-parameters] ] 1 define-transform
: parametric-quot ( parameters quot -- quot )
[ [ swap ] set-parameters [ ] call ] make* ;
: scoped-quot ( quot -- quot ) [ with-scope ] curry ;
: closed-quot ( quot -- quot )
[ namestack >r [ namestack ] set-namestack [ ] call r> set-namestack ] make* ;
MACRO: set-parameters ( seq -- quot ) [set-parameters] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: lambda ( parameters quot -- ) parametric-quot scoped-quot closed-quot ;
: parametric-quot ( parameters quot -- quot ) '[ , set-parameters , call ] ;
: scoped-quot ( quot -- quot ) '[ , with-scope ] ;
: closed-quot ( quot -- quot )
namestack swap '[ namestack [ , set-namestack @ ] dip set-namestack ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: lambda ( parameters quot -- quot ) parametric-quot scoped-quot closed-quot ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

6
extra/size-of/size-of.factor
View File

@ -12,15 +12,15 @@ IN: size-of
VAR: headers
: include-headers ( -- seq )
headers> [ { "#include <" , ">" } bake to-string ] map ;
headers> [ `{ "#include <" , ">" } to-string ] map ;
: size-of-c-program ( type -- lines )
{
`{
"#include <stdio.h>"
include-headers
{ "main() { printf( \"%i\" , sizeof( " , " ) ) ; }" }
}
bake to-strings ;
to-strings ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

2
extra/springies/models/2x2snake/2x2snake.factor
View File

@ -1,6 +1,6 @@
USING: kernel namespaces arrays sequences threads math math.vectors
ui random bake springies springies.ui ;
ui random springies springies.ui ;
IN: springies.models.2x2snake

8
extra/springies/models/3snake/3snake.factor
View File

@ -1,5 +1,5 @@
USING: kernel namespaces arrays sequences threads math ui random bake
USING: kernel namespaces arrays sequences threads math ui random fry
springies springies.ui ;
IN: springies.models.3snake
@ -158,8 +158,10 @@ times
;
: go* ( quot -- )
[ [ [ springies-window* 1000 sleep % ] with-scope ] with-ui ] bake call ;
! : go* ( quot -- )
! [ [ [ springies-window* 1000 sleep % ] with-scope ] with-ui ] bake call ;
: go* ( quot -- ) '[ [ springies-window* 1000 sleep @ ] with-scope ] with-ui ;
! : go ( -- ) [ [ springies-window* 1000 sleep model ] with-scope ] with-ui ;

2
extra/springies/models/belt-tire/belt-tire.factor
View File

@ -1,5 +1,5 @@
USING: kernel namespaces arrays sequences threads math ui random bake
USING: kernel namespaces arrays sequences threads math ui random
springies springies.ui ;
IN: springies.models.belt-tire

2
extra/springies/models/nifty/nifty.factor
View File

@ -1,6 +1,6 @@
USING: kernel namespaces arrays sequences threads math math.vectors
ui random bake springies springies.ui ;
ui random springies springies.ui ;
IN: springies.models.nifty

2
extra/springies/models/urchin/urchin.factor
View File

@ -1,6 +1,6 @@
USING: kernel namespaces arrays sequences threads math math.vectors
ui random bake
ui random
springies springies.ui ;
IN: springies.models.urchin

5
extra/springies/ui/ui.factor
View File

@ -1,7 +1,7 @@
USING: kernel namespaces threads sequences math math.vectors
opengl.gl opengl colors ui ui.gadgets ui.gadgets.slate
bake rewrite-closures vars springies ;
fry rewrite-closures vars springies ;
IN: springies.ui
@ -62,5 +62,4 @@ DEFER: maybe-loop
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: go* ( quot -- )
[ [ [ springies-window* 1000 sleep % ] with-scope ] with-ui ] bake call ;
: go* ( quot -- ) '[ [ springies-window* 1000 sleep @ ] with-scope ] with-ui ;

21
vm/image.c
View File

@ -28,8 +28,14 @@ INLINE void load_data_heap(FILE *file, F_HEADER *h, F_PARAMETERS *p)
F_ZONE *tenured = &data_heap->generations[TENURED];
if(fread((void*)tenured->start,h->data_size,1,file) != 1)
long int bytes_read = fread((void*)tenured->start,1,h->data_size,file);
if(bytes_read != h->data_size)
{
fprintf(stderr,"truncated image: %ld bytes read, %ld bytes expected\n",
bytes_read,h->data_size);
fatal_error("load_data_heap failed",0);
}
tenured->here = tenured->start + h->data_size;
data_relocation_base = h->data_relocation_base;
@ -44,9 +50,16 @@ INLINE void load_code_heap(FILE *file, F_HEADER *h, F_PARAMETERS *p)
init_code_heap(p->code_size);
if(h->code_size != 0
&& fread(first_block(&code_heap),h->code_size,1,file) != 1)
fatal_error("load_code_heap failed",0);
if(h->code_size != 0)
{
long int bytes_read = fread(first_block(&code_heap),1,h->code_size,file);
if(bytes_read != h->code_size)
{
fprintf(stderr,"truncated image: %ld bytes read, %ld bytes expected\n",
bytes_read,h->code_size);
fatal_error("load_code_heap failed",0);
}
}
code_relocation_base = h->code_relocation_base;
build_free_list(&code_heap,h->code_size);