From 50ec1d36dbaaf6fbc958f98c1f6eab08b93acb5a Mon Sep 17 00:00:00 2001 From: slava Date: Mon, 19 Jun 2006 07:41:42 +0000 Subject: [PATCH] Remove obsolete examples, module system simplification, fix parse-resource restart when bootstrapping parse-syntax.factor --- TODO.FACTOR.txt | 1 + contrib/README.txt | 60 +++++++--------- contrib/all.factor | 4 +- contrib/process.factor | 4 +- examples/canvas.factor | 80 --------------------- examples/cocoa/pdfkit.factor | 22 ------ examples/cocoa/quicktime.factor | 27 ------- examples/cocoa/speech.factor | 11 --- examples/cocoa/webkit.factor | 23 ------ library/bootstrap/boot-stage1.factor | 16 +++-- library/bootstrap/primitives.factor | 6 +- library/compiler/alien/syntax.factor | 22 +++--- library/help/syntax.factor | 4 +- library/modules.factor | 6 +- library/syntax/parse-syntax.factor | 102 ++++++++++++++------------- library/words.factor | 4 +- 16 files changed, 111 insertions(+), 281 deletions(-) delete mode 100644 examples/canvas.factor delete mode 100644 examples/cocoa/pdfkit.factor delete mode 100644 examples/cocoa/quicktime.factor delete mode 100644 examples/cocoa/speech.factor delete mode 100644 examples/cocoa/webkit.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 0aec89bf06..5b00f00e3b 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -8,6 +8,7 @@ + help: +- document module system - refactor style stack code so that nested styles are handled at a lower-level - with-style & with-stream-style - in HTML, we can nest div tags, etc diff --git a/contrib/README.txt b/contrib/README.txt index cc744ba95f..0bb151e248 100644 --- a/contrib/README.txt +++ b/contrib/README.txt @@ -1,42 +1,30 @@ This directory contains Factor code that is not part of the core 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) - -- contrib/factory/ -- X11 window manager (Eduardo Cavazos) - -- contrib/gap-buffer/ -- Efficient text editor buffer (Alex Chapman) - -- contrib/httpd/ -- Web framework (HTTP server, client, XML parser, - HTML generation...) (Slava Pestov, Chris Double, Daniel Ehrenberg) - -- contrib/math/ -- extended math library (Doug Coleman, - Daniel Ehrenberg, Slava Pestov) - -- contrib/parser-combinators/ -- Lazy lists and Haskell-style parser - combinators (Chris Double) - -- contrib/postgresql/ -- PostgreSQL binding (Doug Coleman) - -- contrib/random-tester/ -- Random compiler tester (Doug Coleman) - -- contrib/space-invaders/ -- Intel 8080-based Space Invaders arcade - machine emulator (Chris Double) - -- 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) +- aim -- AOL Instant Messenger client library (Doug Coleman) +- automata -- Graphics demo for the UI (Eduardo Cavazos) +- boids -- Graphics demo for the UI (Eduardo Cavazos) +- cairo -- cairo bindings (Sampo Vuori) +- concurrency -- Erlang/Termite-style concurrency (Chris Double) +- coroutines -- coroutines (Chris Double) +- crypto -- Various cryptographic algorithms (Doug Coleman) +- dlists -- double-linked-lists (Mackenzie Straight) +- factory -- X11 window manager (Eduardo Cavazos) +- gap-buffer -- Efficient text editor buffer (Alex Chapman) +- 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) +- parser-combinators -- Lazy lists and Haskell-style parser combinators (Chris Double) +- postgresql -- PostgreSQL binding (Doug Coleman) +- process -- Run external programs (Slava Pestov) +- random-tester -- Random compiler tester (Doug Coleman) +- slate -- Graphics canvas for the UI (Eduardo Cavazos) +- space-invaders -- Intel 8080-based Space Invaders arcade machine emulator (Chris Double) +- splay-trees -- Splay trees (Mackenzie Straight) +- sqlite -- SQLite binding (Chris Double) +- x11 -- X Window System client library (Eduardo Cavazos) diff --git a/contrib/all.factor b/contrib/all.factor index 1723733443..e31a62cfdc 100644 --- a/contrib/all.factor +++ b/contrib/all.factor @@ -5,6 +5,6 @@ crypto dlists embedded gap-buffer httpd math postgresql process random-tester splay-trees sqlite units ; "x11" vocab [ - "factory" (require) - "x11" (require) + "factory" require + "x11" require ] when diff --git a/contrib/process.factor b/contrib/process.factor index f27e10adea..fcbd86ecb0 100644 --- a/contrib/process.factor +++ b/contrib/process.factor @@ -1,9 +1,9 @@ IN: process 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 ) ; : ( command mode -- stream ) popen dup ; diff --git a/examples/canvas.factor b/examples/canvas.factor deleted file mode 100644 index 65270eda95..0000000000 --- a/examples/canvas.factor +++ /dev/null @@ -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 -- ) - 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 ; diff --git a/examples/cocoa/pdfkit.factor b/examples/cocoa/pdfkit.factor deleted file mode 100644 index 8c72b942c0..0000000000 --- a/examples/cocoa/pdfkit.factor +++ /dev/null @@ -1,22 +0,0 @@ -IN: cocoa-pdfkit -USING: alien cocoa compiler errors io kernel math objc -objc-NSObject objc-NSWindow objc-PDFDocument objc-PDFView ; - -: ( url -- document ) - [autorelease] - PDFDocument [alloc] swap [initWithURL:] [autorelease] ; - -: ( document -- view ) - PDFView [alloc] 0 0 500 500 [initWithFrame:] - [ swap [setDocument:] ] keep ; - -"PDFKit demo" 10 10 500 500 -dup - -"http://factorcode.org/handbook.pdf" - -[setContentView:] - -f [makeKeyAndOrderFront:] - -event-loop diff --git a/examples/cocoa/quicktime.factor b/examples/cocoa/quicktime.factor deleted file mode 100644 index 5219b44a3d..0000000000 --- a/examples/cocoa/quicktime.factor +++ /dev/null @@ -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 ; - -: ( url -- movie ) - [autorelease] - QTMovie swap f - [ [movieWithURL:error:] [autorelease] ] keep - *void* [ [localizedDescription] CF>string throw ] when* ; - -: ( movie -- view ) - QTMovieView [alloc] 0 0 100 100 [initWithFrame:] - [ swap [setMovie:] ] keep ; - -"Quicktime demo" 10 10 100 50 -dup - -"file:///Users/slava/Media/Mixes/shaundoe1year.mp3" - - -dup 1 [setControllerVisible:] -[setContentView:] - -f [makeKeyAndOrderFront:] - -event-loop diff --git a/examples/cocoa/speech.factor b/examples/cocoa/speech.factor deleted file mode 100644 index 7ecc5d1a4d..0000000000 --- a/examples/cocoa/speech.factor +++ /dev/null @@ -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 [startSpeakingString:] ; - -"Hello from Factor" say drop diff --git a/examples/cocoa/webkit.factor b/examples/cocoa/webkit.factor deleted file mode 100644 index d21c0cb18c..0000000000 --- a/examples/cocoa/webkit.factor +++ /dev/null @@ -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 ; - -: ( string -- id ) - NSURLRequest swap [requestWithURL:] ; - -: ( -- view ) - WebView [alloc] 0 0 100 100 f f [initWithFrame:frameName:groupName:] ; - -"WebKit demo" 10 10 600 600 -dup - - - -dup [mainFrame] "http://factorcode.org" [loadRequest:] - -[setContentView:] - -dup f [makeKeyAndOrderFront:] - -event-loop diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index e4c1a3e9f4..7f257b5f49 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2004, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: image -USING: errors generic hashtables io kernel kernel-internals -math memory namespaces parser prettyprint sequences -vectors words ; +USING: arrays errors generic hashtables io kernel +kernel-internals math memory namespaces parser prettyprint +sequences vectors words ; "Bootstrap stage 1..." print flush @@ -345,10 +345,12 @@ vectors words ; ] [ ] make vocabularies get [ - "!syntax" get "syntax" set - - "syntax" get hash-values [ word? ] subset - [ "syntax" swap set-word-vocabulary ] each + "!syntax" get hash>alist [ + first2 + "syntax" over set-word-vocabulary + >r "!" ?head drop r> 2dup set-word-name + 2array + ] map alist>hash "syntax" set ] bind "!syntax" vocabularies get remove-hash diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index 94f990523b..9c50ad3514 100644 --- a/library/bootstrap/primitives.factor +++ b/library/bootstrap/primitives.factor @@ -268,7 +268,7 @@ num-types f builtins set 2 object { "word-name" "words" } - f + { "set-word-name" "words" } } { 3 @@ -322,7 +322,7 @@ num-types f builtins set "array" "arrays" create 8 "array?" "arrays" create { } define-builtin -"f" "!syntax" create 9 "not" "kernel" create +"!f" "!syntax" create 9 "not" "kernel" create { } define-builtin "hashtable?" "hashtables" create t "inline" set-word-prop @@ -417,7 +417,7 @@ num-types f builtins set ! Define general-t type, which is any object that is not f. "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 ! Catch-all class for providing a default method. diff --git a/library/compiler/alien/syntax.factor b/library/compiler/alien/syntax.factor index bcc3693bf6..e59c935a4b 100644 --- a/library/compiler/alien/syntax.factor +++ b/library/compiler/alien/syntax.factor @@ -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. IN: !syntax USING: alien compiler kernel math namespaces parser sequences syntax words ; -: DLL" skip-blank parse-string dlopen parsed ; parsing +: !DLL" skip-blank parse-string dlopen parsed ; parsing -: ALIEN: scan-word parsed ; parsing +: !ALIEN: scan-word parsed ; parsing -: LIBRARY: scan "c-library" set ; parsing +: !LIBRARY: scan "c-library" set ; parsing -: FUNCTION: +: !FUNCTION: scan "c-library" get scan string-mode on [ 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 -: FIELD: ( offset -- offset ) +: !FIELD: ( offset -- offset ) scan scan define-field ; parsing -: END-STRUCT ( length -- ) +: !END-STRUCT ( length -- ) define-struct-type ; parsing -: C-UNION: +: !C-UNION: scan "struct-name" set string-mode on [ string-mode off 0 [ define-member ] reduce define-struct-type ] f ; parsing -: C-ENUM: +: !C-ENUM: string-mode on [ string-mode off 0 [ create-in swap [ unit define-compound ] keep 1+ diff --git a/library/help/syntax.factor b/library/help/syntax.factor index dde02dc6e6..740bc2d621 100644 --- a/library/help/syntax.factor +++ b/library/help/syntax.factor @@ -3,11 +3,11 @@ IN: !syntax USING: arrays help kernel parser sequences syntax words ; -: HELP: +: !HELP: scan-word bootstrap-word dup [ >array unclip swap >r "stack-effect" set-word-prop r> "help" set-word-prop ] f ; parsing -: ARTICLE: +: !ARTICLE: [ >array [ first2 2 ] keep tail add-article ] f ; parsing diff --git a/library/modules.factor b/library/modules.factor index 6f41ae4db2..c5b90be8a1 100644 --- a/library/modules.factor +++ b/library/modules.factor @@ -27,7 +27,7 @@ H{ } clone modules set-global : module modules get hash ; -: (require) ( name -- ) +: require ( name -- ) dup module [ drop ] [ @@ -35,10 +35,6 @@ H{ } clone modules set-global module-def run-resource ] if ; -: require ( name -- ) - [ \ require on (require) ] with-scope - \ require get [ compile-all ] unless ; - : run-resources ( seq -- ) bootstrapping? get [ parse-resource % ] [ run-resource ] ? each ; diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor index 5e1f3f056c..6acda8455e 100644 --- a/library/syntax/parse-syntax.factor +++ b/library/syntax/parse-syntax.factor @@ -1,80 +1,84 @@ ! Copyright (C) 2004, 2006 Slava Pestov. ! 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 -USING: alien arrays errors generic hashtables kernel math -modules namespaces parser sequences strings syntax vectors words ; +USING: alien arrays compiler errors generic hashtables kernel +math modules namespaces parser sequences strings vectors words ; -: ( +: !( CHAR: ) column [ line-text get index* dup -1 = [ "Unterminated (" throw ] when 1+ ] change ; parsing -: ! line-text get length column set ; parsing -: #! POSTPONE: ! ; parsing -: IN: scan set-in ; parsing -: USE: scan use+ ; parsing -: USING: string-mode on [ string-mode off add-use ] f ; parsing -: (BASE) scan swap base> parsed ; -: HEX: 16 (BASE) ; parsing -: OCT: 8 (BASE) ; parsing -: BIN: 2 (BASE) ; parsing -SYMBOL: t -: f f parsed ; parsing -: CHAR: 0 scan next-char nip parsed ; parsing -: " parse-string parsed ; parsing -: SBUF" skip-blank parse-string >sbuf parsed ; parsing -: [ f ; parsing -: ] >quotation parsed ; parsing -: ; >quotation swap call ; parsing -: } swap call parsed ; parsing -: { [ >array ] f ; parsing -: V{ [ >vector ] f ; parsing -: H{ [ alist>hash ] f ; parsing -: C{ [ first2 rect> ] f ; parsing -: T{ [ >tuple ] f ; parsing -: W{ [ first ] f ; parsing -: POSTPONE: scan-word parsed ; parsing -: \ scan-word literalize parsed ; parsing -: parsing word t "parsing" set-word-prop ; parsing -: inline word t "inline" set-word-prop ; parsing -: foldable word t "foldable" set-word-prop ; parsing -: SYMBOL: CREATE dup reset-generic define-symbol ; parsing +: !! line-text get length column set ; parsing +: !#! POSTPONE: ! ; parsing +: !IN: scan set-in ; parsing +: !USE: scan use+ ; parsing +: !USING: string-mode on [ string-mode off add-use ] f ; parsing +: !(BASE) scan swap base> parsed ; +: !HEX: 16 (BASE) ; parsing +: !OCT: 8 (BASE) ; parsing +: !BIN: 2 (BASE) ; parsing +SYMBOL: !t +: !f f parsed ; parsing +: !CHAR: 0 scan next-char nip parsed ; parsing +: !" parse-string parsed ; parsing +: !SBUF" skip-blank parse-string >sbuf parsed ; parsing +: ![ f ; parsing +: !] >quotation parsed ; parsing +: !; >quotation swap call ; parsing +: !} swap call parsed ; parsing +: !{ [ >array ] f ; parsing +: !V{ [ >vector ] f ; parsing +: !H{ [ alist>hash ] f ; parsing +: !C{ [ first2 rect> ] f ; parsing +: !T{ [ >tuple ] f ; parsing +: !W{ [ first ] f ; parsing +: !POSTPONE: scan-word parsed ; parsing +: !\ scan-word literalize parsed ; parsing +: !parsing word t "parsing" set-word-prop ; parsing +: !inline word t "inline" set-word-prop ; parsing +: !foldable word t "foldable" set-word-prop ; parsing +: !SYMBOL: CREATE dup reset-generic define-symbol ; parsing -DEFER: PRIMITIVE: parsing -: DEFER: CREATE dup reset-generic drop ; parsing -: : CREATE dup reset-generic [ define-compound ] f ; parsing -: GENERIC: CREATE dup reset-word define-generic ; parsing -: G: CREATE dup reset-word [ define-generic* ] f ; parsing -: M: scan-word scan-word [ -rot define-method ] f ; parsing +DEFER: !PRIMITIVE: parsing +: !DEFER: CREATE dup reset-generic drop ; parsing +: !: CREATE dup reset-generic [ define-compound ] f ; parsing +: !GENERIC: CREATE dup reset-word define-generic ; parsing +: !G: CREATE dup reset-word [ define-generic* ] 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 [ dupd unit "predicate" set-word-prop ] keep [ define-union ] f ; parsing -: PREDICATE: ( -- class predicate definition ) +: !PREDICATE: ( -- class predicate definition ) scan-word CREATE dup intern-symbol dup rot "superclass" set-word-prop dup predicate-word [ define-predicate-class ] f ; parsing -: TUPLE: +: !TUPLE: scan string-mode on [ string-mode off define-tuple ] f ; parsing -: C: +: !C: scan-word [ create-constructor ] keep [ 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 -: REQUIRE: scan require ; parsing +: !REQUIRE: scan require compile-all ; parsing -: REQUIRES: +: !REQUIRES: string-mode on - [ string-mode off [ (require) ] each ] f ; parsing + [ string-mode off [ require ] each ] f ; parsing diff --git a/library/words.factor b/library/words.factor index 47ad97feb9..effee1d355 100644 --- a/library/words.factor +++ b/library/words.factor @@ -161,5 +161,7 @@ SYMBOL: bootstrapping? : bootstrap-word ( word -- word ) dup word-name swap word-vocabulary bootstrapping? get [ - dup "syntax" = [ drop "!syntax" ] when + dup "syntax" = [ + drop "!syntax" >r "!" swap append r> + ] when ] when lookup ;