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

Remove obsolete examples, module system simplification, fix parse-resource restart when bootstrapping parse-syntax.factor

darcs
slava 2006-06-19 07:41:42 +00:00
parent e816737c99
commit 50ec1d36db
16 changed files with 111 additions and 281 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
TODO.FACTOR.txt
View File

@ -8,6 +8,7 @@
+ help: + help:
- document module system
- refactor style stack code so that nested styles are handled at a lower-level - refactor style stack code so that nested styles are handled at a lower-level
- with-style & with-stream-style - with-style & with-stream-style
- in HTML, we can nest div tags, etc - in HTML, we can nest div tags, etc

60
contrib/README.txt
View File

@ -1,42 +1,30 @@
This directory contains Factor code that is not part of the core This directory contains Factor code that is not part of the core
library, but is useful enough to ship with the Factor distribution. library, but is useful enough to ship with the Factor distribution.
- contrib/aim/ -- AOL Instant Messenger client library (Doug Coleman) You can load these modules by typing:
- contrib/cairo/ -- cairo bindings (Sampo Vuori) REQUIRE: modulename
- contrib/concurrency/ -- Erlang/Termite-style concurrency (Chris Double) in the listener.
- contrib/crypto/ -- Various cryptographic algorithms (Doug Coleman) - aim -- AOL Instant Messenger client library (Doug Coleman)
- automata -- Graphics demo for the UI (Eduardo Cavazos)
- contrib/factory/ -- X11 window manager (Eduardo Cavazos) - boids -- Graphics demo for the UI (Eduardo Cavazos)
- cairo -- cairo bindings (Sampo Vuori)
- contrib/gap-buffer/ -- Efficient text editor buffer (Alex Chapman) - concurrency -- Erlang/Termite-style concurrency (Chris Double)
- coroutines -- coroutines (Chris Double)
- contrib/httpd/ -- Web framework (HTTP server, client, XML parser, - crypto -- Various cryptographic algorithms (Doug Coleman)
HTML generation...) (Slava Pestov, Chris Double, Daniel Ehrenberg) - dlists -- double-linked-lists (Mackenzie Straight)
- factory -- X11 window manager (Eduardo Cavazos)
- contrib/math/ -- extended math library (Doug Coleman, - gap-buffer -- Efficient text editor buffer (Alex Chapman)
Daniel Ehrenberg, Slava Pestov) - httpd -- Web framework (HTTP server, client, XML parser, HTML generation...) (Slava Pestov, Chris Double, Daniel Ehrenberg)
- math -- extended math library (Doug Coleman, Daniel Ehrenberg, Slava Pestov)
- contrib/parser-combinators/ -- Lazy lists and Haskell-style parser - parser-combinators -- Lazy lists and Haskell-style parser combinators (Chris Double)
combinators (Chris Double) - postgresql -- PostgreSQL binding (Doug Coleman)
- process -- Run external programs (Slava Pestov)
- contrib/postgresql/ -- PostgreSQL binding (Doug Coleman) - random-tester -- Random compiler tester (Doug Coleman)
- slate -- Graphics canvas for the UI (Eduardo Cavazos)
- contrib/random-tester/ -- Random compiler tester (Doug Coleman) - space-invaders -- Intel 8080-based Space Invaders arcade machine emulator (Chris Double)
- splay-trees -- Splay trees (Mackenzie Straight)
- contrib/space-invaders/ -- Intel 8080-based Space Invaders arcade - sqlite -- SQLite binding (Chris Double)
machine emulator (Chris Double) - x11 -- X Window System client library (Eduardo Cavazos)
- contrib/sqlite/ -- SQLite binding (Chris Double)
- contrib/x11/ -- X Window System client library (Eduardo Cavazos)
- contrib/coroutines.factor -- coroutines (Chris Double)
- contrib/dlists.factor -- double-linked-lists (Mackenzie Straight)
- contrib/process.factor -- Run external programs (Slava Pestov)
- contrib/splay-trees.factor -- Splay trees (Mackenzie Straight)

4
contrib/all.factor
View File

@ -5,6 +5,6 @@ crypto dlists embedded gap-buffer httpd math postgresql process
random-tester splay-trees sqlite units ; random-tester splay-trees sqlite units ;
"x11" vocab [ "x11" vocab [
"factory" (require) "factory" require
"x11" (require) "x11" require
] when ] when

4
contrib/process.factor
View File

@ -1,9 +1,9 @@
IN: process IN: process
USING: compiler io io-internals kernel parser ; USING: compiler io io-internals kernel parser ;
FUNCTION: int system ( char* command ) ; compiled FUNCTION: int system ( char* command ) ;
FUNCTION: void* popen ( char* command, char* type ) ; compiled FUNCTION: void* popen ( char* command, char* type ) ;
: <process-stream> ( command mode -- stream ) : <process-stream> ( command mode -- stream )
popen dup <c-stream> ; popen dup <c-stream> ;

80
examples/canvas.factor
View File

@ -1,80 +0,0 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
! This example only runs in the UI listener.
! Pass with-canvas a quotation calling these words:
! - turn-by
! - move-by
! - plot-point
! - line-to
! - new-pen
! plot-string doesn't yet work.
! other GL calls can be made, but be careful.
IN: gadgets-canvas
USING: arrays errors freetype gadgets gadgets-labels
gadgets-layouts gadgets-panes gadgets-theme generic kernel math
namespaces opengl sequences styles ;
SYMBOL: canvas-font
{ "monospaced" plain 12 } canvas-font set-global
: turn-by ( angle -- ) 0 0 1 glRotated ;
: move-by ( distance -- ) 0 0 glTranslated ;
: plot-point ( -- )
GL_POINTS [ 0 0 0 glVertex3d ] do-state ;
: line-to ( distance -- )
dup
GL_LINES [ 0 0 0 glVertex3d 0 0 glVertex3d ] do-state
move-by ;
: plot-string ( string -- )
canvas-font get open-font swap draw-string ;
: new-pen ( quot -- ) GL_MODELVIEW swap do-matrix ; inline
TUPLE: canvas quot id ;
C: canvas ( quot -- )
dup delegate>gadget [ set-canvas-quot ] keep ;
M: canvas add-notify* ( gadget -- )
dup canvas-quot GL_COMPILE [ with-scope ] make-dlist
swap set-canvas-id ;
M: canvas remove-notify* ( gadget -- )
canvas-id 1 glDeleteLists ;
M: canvas draw-gadget* ( gadget -- )
GL_MODELVIEW [
dup rect-dim 2 v/n gl-translate
canvas-id glCallList
] do-matrix ;
: with-canvas ( size quot -- )
<canvas> dup solid-boundary [ set-gadget-dim ] keep gadget. ;
: random-walk ( n -- )
[ 2 random-int 1/2 - 180 * turn-by 10 line-to ] times ;
: regular-polygon ( sides n -- )
[ 360 swap / ] keep [ over line-to dup turn-by ] times 2drop ;
: random-color
4 [ drop 255 random-int 255 /f ] map gl-color ;
: turtle-test
{ 400 400 0 } [
36 [
random-color
10 line-to
10 turn-by [ 60 10 regular-polygon ] new-pen
] times
] with-canvas ;

22
examples/cocoa/pdfkit.factor
View File

@ -1,22 +0,0 @@
IN: cocoa-pdfkit
USING: alien cocoa compiler errors io kernel math objc
objc-NSObject objc-NSWindow objc-PDFDocument objc-PDFView ;
: <PDFDocument> ( url -- document )
<CFURL> [autorelease]
PDFDocument [alloc] swap [initWithURL:] [autorelease] ;
: <PDFView> ( document -- view )
PDFView [alloc] 0 0 500 500 <NSRect> [initWithFrame:]
[ swap [setDocument:] ] keep ;
"PDFKit demo" 10 10 500 500 <NSRect> <NSWindow>
dup
"http://factorcode.org/handbook.pdf" <PDFDocument> <PDFView>
[setContentView:]
f [makeKeyAndOrderFront:]
event-loop

27
examples/cocoa/quicktime.factor
View File

@ -1,27 +0,0 @@
IN: cocoa-quicktime
USING: alien cocoa compiler errors io kernel math objc
objc-NSError objc-NSObject objc-NSURLRequest objc-NSWindow
objc-QTMovie objc-QTMovieView parser sequences threads ;
: <QTMovie> ( url -- movie )
<CFURL> [autorelease]
QTMovie swap f <void*>
[ [movieWithURL:error:] [autorelease] ] keep
*void* [ [localizedDescription] CF>string throw ] when* ;
: <QTMovieView> ( movie -- view )
QTMovieView [alloc] 0 0 100 100 <NSRect> [initWithFrame:]
[ swap [setMovie:] ] keep ;
"Quicktime demo" 10 10 100 50 <NSRect> <NSWindow>
dup
"file:///Users/slava/Media/Mixes/shaundoe1year.mp3"
<QTMovie> <QTMovieView>
dup 1 [setControllerVisible:]
[setContentView:]
f [makeKeyAndOrderFront:]
event-loop

11
examples/cocoa/speech.factor
View File

@ -1,11 +0,0 @@
! Copyright (C) 2006 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
IN: cocoa-speech
USING: cocoa kernel objc-NSObject objc-NSSpeechSynthesizer ;
: say ( string -- )
NSSpeechSynthesizer [alloc] f [initWithVoice:]
swap <NSString> [startSpeakingString:] ;
"Hello from Factor" say drop

23
examples/cocoa/webkit.factor
View File

@ -1,23 +0,0 @@
IN: cocoa-webkit
USING: alien cocoa compiler io kernel math objc objc-NSObject
objc-NSURLRequest objc-NSWindow objc-WebFrame objc-WebView
parser sequences threads ;
: <NSURLRequest> ( string -- id )
NSURLRequest swap <CFURL> [requestWithURL:] ;
: <WebView> ( -- view )
WebView [alloc] 0 0 100 100 <NSRect> f f [initWithFrame:frameName:groupName:] ;
"WebKit demo" 10 10 600 600 <NSRect> <NSWindow>
dup
<WebView>
dup [mainFrame] "http://factorcode.org" <NSURLRequest> [loadRequest:]
[setContentView:]
dup f [makeKeyAndOrderFront:]
event-loop

16
library/bootstrap/boot-stage1.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2004, 2006 Slava Pestov. ! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: image IN: image
USING: errors generic hashtables io kernel kernel-internals USING: arrays errors generic hashtables io kernel
math memory namespaces parser prettyprint sequences kernel-internals math memory namespaces parser prettyprint
vectors words ; sequences vectors words ;
"Bootstrap stage 1..." print flush "Bootstrap stage 1..." print flush
@ -345,10 +345,12 @@ vectors words ;
] [ ] make ] [ ] make
vocabularies get [ vocabularies get [
"!syntax" get "syntax" set "!syntax" get hash>alist [
first2
"syntax" get hash-values [ word? ] subset "syntax" over set-word-vocabulary
[ "syntax" swap set-word-vocabulary ] each >r "!" ?head drop r> 2dup set-word-name
2array
] map alist>hash "syntax" set
] bind ] bind
"!syntax" vocabularies get remove-hash "!syntax" vocabularies get remove-hash

6
library/bootstrap/primitives.factor
View File

@ -268,7 +268,7 @@ num-types f <array> builtins set
2 2
object object
{ "word-name" "words" } { "word-name" "words" }
f { "set-word-name" "words" }
} }
{ {
3 3
@ -322,7 +322,7 @@ num-types f <array> builtins set
"array" "arrays" create 8 "array?" "arrays" create "array" "arrays" create 8 "array?" "arrays" create
{ } define-builtin { } define-builtin
"f" "!syntax" create 9 "not" "kernel" create "!f" "!syntax" create 9 "not" "kernel" create
{ } define-builtin { } define-builtin
"hashtable?" "hashtables" create t "inline" set-word-prop "hashtable?" "hashtables" create t "inline" set-word-prop
@ -417,7 +417,7 @@ num-types f <array> builtins set
! Define general-t type, which is any object that is not f. ! Define general-t type, which is any object that is not f.
"general-t" "kernel" create dup define-symbol "general-t" "kernel" create dup define-symbol
f "f" "!syntax" lookup builtins get remove [ ] subset f "!f" "!syntax" lookup builtins get remove [ ] subset
define-union define-union
! Catch-all class for providing a default method. ! Catch-all class for providing a default method.

22
library/compiler/alien/syntax.factor
View File

@ -1,38 +1,38 @@
! Copyright (C) 2005 Alex Chapman. ! Copyright (C) 2005, 2006 Slava Pestov, Alex Chapman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: !syntax IN: !syntax
USING: alien compiler kernel math namespaces parser USING: alien compiler kernel math namespaces parser
sequences syntax words ; sequences syntax words ;
: DLL" skip-blank parse-string dlopen parsed ; parsing : !DLL" skip-blank parse-string dlopen parsed ; parsing
: ALIEN: scan-word <alien> parsed ; parsing : !ALIEN: scan-word <alien> parsed ; parsing
: LIBRARY: scan "c-library" set ; parsing : !LIBRARY: scan "c-library" set ; parsing
: FUNCTION: : !FUNCTION:
scan "c-library" get scan string-mode on scan "c-library" get scan string-mode on
[ string-mode off define-c-word ] f ; parsing [ string-mode off define-c-word ] f ; parsing
: TYPEDEF: scan scan typedef ; parsing : !TYPEDEF: scan scan typedef ; parsing
: BEGIN-STRUCT: ( -- offset ) : !BEGIN-STRUCT: ( -- offset )
scan "struct-name" set 0 ; parsing scan "struct-name" set 0 ; parsing
: FIELD: ( offset -- offset ) : !FIELD: ( offset -- offset )
scan scan define-field ; parsing scan scan define-field ; parsing
: END-STRUCT ( length -- ) : !END-STRUCT ( length -- )
define-struct-type ; parsing define-struct-type ; parsing
: C-UNION: : !C-UNION:
scan "struct-name" set scan "struct-name" set
string-mode on [ string-mode on [
string-mode off string-mode off
0 [ define-member ] reduce define-struct-type 0 [ define-member ] reduce define-struct-type
] f ; parsing ] f ; parsing
: C-ENUM: : !C-ENUM:
string-mode on [ string-mode on [
string-mode off 0 [ string-mode off 0 [
create-in swap [ unit define-compound ] keep 1+ create-in swap [ unit define-compound ] keep 1+

4
library/help/syntax.factor
View File

@ -3,11 +3,11 @@
IN: !syntax IN: !syntax
USING: arrays help kernel parser sequences syntax words ; USING: arrays help kernel parser sequences syntax words ;
: HELP: : !HELP:
scan-word bootstrap-word dup [ scan-word bootstrap-word dup [
>array unclip swap >r "stack-effect" set-word-prop r> >array unclip swap >r "stack-effect" set-word-prop r>
"help" set-word-prop "help" set-word-prop
] f ; parsing ] f ; parsing
: ARTICLE: : !ARTICLE:
[ >array [ first2 2 ] keep tail add-article ] f ; parsing [ >array [ first2 2 ] keep tail add-article ] f ; parsing

6
library/modules.factor
View File

@ -27,7 +27,7 @@ H{ } clone modules set-global
: module modules get hash ; : module modules get hash ;
: (require) ( name -- ) : require ( name -- )
dup module [ dup module [
drop drop
] [ ] [
@ -35,10 +35,6 @@ H{ } clone modules set-global
module-def run-resource module-def run-resource
] if ; ] if ;
: require ( name -- )
[ \ require on (require) ] with-scope
\ require get [ compile-all ] unless ;
: run-resources ( seq -- ) : run-resources ( seq -- )
bootstrapping? get bootstrapping? get
[ parse-resource % ] [ run-resource ] ? each ; [ parse-resource % ] [ run-resource ] ? each ;

102
library/syntax/parse-syntax.factor
View File

@ -1,80 +1,84 @@
! Copyright (C) 2004, 2006 Slava Pestov. ! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! Bootstrapping trick; see doc/bootstrap.txt. ! We define these words in !syntax with ! prefixes to avoid
! clashing with the host parsing words when we are building the
! target image. The end of boot-stage1.factor renames the
! !syntax vocab to syntax, and removes the ! prefix from each
! word name.
IN: !syntax IN: !syntax
USING: alien arrays errors generic hashtables kernel math USING: alien arrays compiler errors generic hashtables kernel
modules namespaces parser sequences strings syntax vectors words ; math modules namespaces parser sequences strings vectors words ;
: ( : !(
CHAR: ) column [ CHAR: ) column [
line-text get index* dup -1 = line-text get index* dup -1 =
[ "Unterminated (" throw ] when 1+ [ "Unterminated (" throw ] when 1+
] change ; parsing ] change ; parsing
: ! line-text get length column set ; parsing : !! line-text get length column set ; parsing
: #! POSTPONE: ! ; parsing : !#! POSTPONE: ! ; parsing
: IN: scan set-in ; parsing : !IN: scan set-in ; parsing
: USE: scan use+ ; parsing : !USE: scan use+ ; parsing
: USING: string-mode on [ string-mode off add-use ] f ; parsing : !USING: string-mode on [ string-mode off add-use ] f ; parsing
: (BASE) scan swap base> parsed ; : !(BASE) scan swap base> parsed ;
: HEX: 16 (BASE) ; parsing : !HEX: 16 (BASE) ; parsing
: OCT: 8 (BASE) ; parsing : !OCT: 8 (BASE) ; parsing
: BIN: 2 (BASE) ; parsing : !BIN: 2 (BASE) ; parsing
SYMBOL: t SYMBOL: !t
: f f parsed ; parsing : !f f parsed ; parsing
: CHAR: 0 scan next-char nip parsed ; parsing : !CHAR: 0 scan next-char nip parsed ; parsing
: " parse-string parsed ; parsing : !" parse-string parsed ; parsing
: SBUF" skip-blank parse-string >sbuf parsed ; parsing : !SBUF" skip-blank parse-string >sbuf parsed ; parsing
: [ f ; parsing : ![ f ; parsing
: ] >quotation parsed ; parsing : !] >quotation parsed ; parsing
: ; >quotation swap call ; parsing : !; >quotation swap call ; parsing
: } swap call parsed ; parsing : !} swap call parsed ; parsing
: { [ >array ] f ; parsing : !{ [ >array ] f ; parsing
: V{ [ >vector ] f ; parsing : !V{ [ >vector ] f ; parsing
: H{ [ alist>hash ] f ; parsing : !H{ [ alist>hash ] f ; parsing
: C{ [ first2 rect> ] f ; parsing : !C{ [ first2 rect> ] f ; parsing
: T{ [ >tuple ] f ; parsing : !T{ [ >tuple ] f ; parsing
: W{ [ first <wrapper> ] f ; parsing : !W{ [ first <wrapper> ] f ; parsing
: POSTPONE: scan-word parsed ; parsing : !POSTPONE: scan-word parsed ; parsing
: \ scan-word literalize parsed ; parsing : !\ scan-word literalize parsed ; parsing
: parsing word t "parsing" set-word-prop ; parsing : !parsing word t "parsing" set-word-prop ; parsing
: inline word t "inline" set-word-prop ; parsing : !inline word t "inline" set-word-prop ; parsing
: foldable word t "foldable" set-word-prop ; parsing : !foldable word t "foldable" set-word-prop ; parsing
: SYMBOL: CREATE dup reset-generic define-symbol ; parsing : !SYMBOL: CREATE dup reset-generic define-symbol ; parsing
DEFER: PRIMITIVE: parsing DEFER: !PRIMITIVE: parsing
: DEFER: CREATE dup reset-generic drop ; parsing : !DEFER: CREATE dup reset-generic drop ; parsing
: : CREATE dup reset-generic [ define-compound ] f ; parsing : !: CREATE dup reset-generic [ define-compound ] f ; parsing
: GENERIC: CREATE dup reset-word define-generic ; parsing : !GENERIC: CREATE dup reset-word define-generic ; parsing
: G: CREATE dup reset-word [ define-generic* ] f ; parsing : !G: CREATE dup reset-word [ define-generic* ] f ; parsing
: M: scan-word scan-word [ -rot define-method ] f ; parsing : !M: scan-word scan-word [ -rot define-method ] f ; parsing
: UNION: ( -- class predicate definition ) : !UNION: ( -- class predicate definition )
CREATE dup intern-symbol dup predicate-word CREATE dup intern-symbol dup predicate-word
[ dupd unit "predicate" set-word-prop ] keep [ dupd unit "predicate" set-word-prop ] keep
[ define-union ] f ; parsing [ define-union ] f ; parsing
: PREDICATE: ( -- class predicate definition ) : !PREDICATE: ( -- class predicate definition )
scan-word CREATE dup intern-symbol scan-word CREATE dup intern-symbol
dup rot "superclass" set-word-prop dup predicate-word dup rot "superclass" set-word-prop dup predicate-word
[ define-predicate-class ] f ; parsing [ define-predicate-class ] f ; parsing
: TUPLE: : !TUPLE:
scan string-mode on [ string-mode off define-tuple ] f ; scan string-mode on [ string-mode off define-tuple ] f ;
parsing parsing
: C: : !C:
scan-word [ create-constructor ] keep scan-word [ create-constructor ] keep
[ define-constructor ] f ; parsing [ define-constructor ] f ; parsing
: FORGET: scan use get hash-stack [ forget ] when* ; parsing : !FORGET: scan use get hash-stack [ forget ] when* ; parsing
: PROVIDE: : !PROVIDE:
scan [ { { } { } } append first2 provide ] f ; parsing scan [ { { } { } } append first2 provide ] f ; parsing
: REQUIRE: scan require ; parsing : !REQUIRE: scan require compile-all ; parsing
: REQUIRES: : !REQUIRES:
string-mode on string-mode on
[ string-mode off [ (require) ] each ] f ; parsing [ string-mode off [ require ] each ] f ; parsing

4
library/words.factor
View File

@ -161,5 +161,7 @@ SYMBOL: bootstrapping?
: bootstrap-word ( word -- word ) : bootstrap-word ( word -- word )
dup word-name swap word-vocabulary dup word-name swap word-vocabulary
bootstrapping? get [ bootstrapping? get [
dup "syntax" = [ drop "!syntax" ] when dup "syntax" = [
drop "!syntax" >r "!" swap append r>
] when
] when lookup ; ] when lookup ;