Remove obsolete examples, module system simplification, fix parse-resource restart when bootstrapping parse-syntax.factor
slava
parent
e816737c99
commit
50ec1d36db
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ) ;
|
||||
|
||||
: <process-stream> ( command mode -- stream )
|
||||
popen dup <c-stream> ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -268,7 +268,7 @@ num-types f <array> builtins set
|
|||
2
|
||||
object
|
||||
{ "word-name" "words" }
|
||||
f
|
||||
{ "set-word-name" "words" }
|
||||
}
|
||||
{
|
||||
3
|
||||
|
|
@ -322,7 +322,7 @@ num-types f <array> 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 <array> 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.
|
||||
|
|
|
|||
|
|
@ -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 <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
|
||||
[ 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+
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 <wrapper> ] 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 <wrapper> ] 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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue