Merge branch 'master' of git://factorcode.org/git/factor
John Benediktsson
commit
0df70f72bd
|
|
@ -6,7 +6,7 @@ math.parser math.order layouts words sequences sequences.private
|
|||
arrays assocs classes classes.algebra combinators generic.math
|
||||
splitting fry locals classes.tuple alien.accessors
|
||||
classes.tuple.private slots.private definitions strings.private
|
||||
vectors hashtables
|
||||
vectors hashtables generic
|
||||
stack-checker.state
|
||||
compiler.tree.comparisons
|
||||
compiler.tree.propagation.info
|
||||
|
|
@ -337,3 +337,12 @@ generic-comparison-ops [
|
|||
bi
|
||||
] [ 2drop object-info ] if
|
||||
] "outputs" set-word-prop
|
||||
|
||||
\ equal? [
|
||||
! If first input has a known type and second input is an
|
||||
! object, we convert this to [ swap equal? ].
|
||||
in-d>> first2 value-info class>> object class= [
|
||||
value-info class>> \ equal? specific-method
|
||||
[ swap equal? ] f ?
|
||||
] [ drop f ] if
|
||||
] "custom-inlining" set-word-prop
|
||||
|
|
|
|||
|
|
@ -640,6 +640,10 @@ MIXIN: empty-mixin
|
|||
[ { fixnum } declare log2 0 >= ] final-classes
|
||||
] unit-test
|
||||
|
||||
[ V{ POSTPONE: f } ] [
|
||||
[ { word object } declare eq? ] final-classes
|
||||
] unit-test
|
||||
|
||||
! [ V{ string } ] [
|
||||
! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
|
||||
! ] unit-test
|
||||
|
|
|
|||
|
|
@ -3,7 +3,8 @@
|
|||
USING: parser words definitions kernel sequences assocs arrays
|
||||
kernel.private fry combinators accessors vectors strings sbufs
|
||||
byte-arrays byte-vectors io.binary io.streams.string splitting
|
||||
math generic generic.standard generic.standard.engines classes ;
|
||||
math generic generic.standard generic.standard.engines classes
|
||||
hashtables ;
|
||||
IN: hints
|
||||
|
||||
GENERIC: specializer-predicate ( spec -- quot )
|
||||
|
|
@ -50,14 +51,10 @@ M: object specializer-declaration class ;
|
|||
] [ drop f ] if ;
|
||||
|
||||
: specialized-def ( word -- quot )
|
||||
dup def>> swap {
|
||||
{
|
||||
[ dup "specializer" word-prop ]
|
||||
[ "specializer" word-prop specialize-quot ]
|
||||
}
|
||||
{ [ dup standard-method? ] [ specialize-method ] }
|
||||
[ drop ]
|
||||
} cond ;
|
||||
[ def>> ] keep
|
||||
[ dup standard-method? [ specialize-method ] [ drop ] if ]
|
||||
[ "specializer" word-prop [ specialize-quot ] when* ]
|
||||
bi ;
|
||||
|
||||
: specialized-length ( specializer -- n )
|
||||
dup [ array? ] all? [ first ] when length ;
|
||||
|
|
@ -120,3 +117,7 @@ M: object specializer-declaration class ;
|
|||
\ >le { { fixnum fixnum } { bignum fixnum } } "specializer" set-word-prop
|
||||
|
||||
\ >be { { bignum fixnum } { fixnum fixnum } } "specializer" set-word-prop
|
||||
|
||||
\ hashtable \ at* method { { fixnum hashtable } { word hashtable } } "specializer" set-word-prop
|
||||
|
||||
\ hashtable \ set-at method { { object fixnum object } { object word object } } "specializer" set-word-prop
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ io.backend.windows io.files.windows io.encodings.utf16n windows
|
|||
windows.kernel32 kernel libc math threads system environment
|
||||
alien.c-types alien.arrays alien.strings sequences combinators
|
||||
combinators.short-circuit ascii splitting alien strings assocs
|
||||
namespaces make accessors tr ;
|
||||
namespaces make accessors tr windows.time ;
|
||||
IN: io.files.windows.nt
|
||||
|
||||
M: winnt cwd
|
||||
|
|
@ -44,8 +44,18 @@ M: winnt normalize-path ( string -- string' )
|
|||
M: winnt CreateFile-flags ( DWORD -- DWORD )
|
||||
FILE_FLAG_OVERLAPPED bitor ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: windows-file-size ( path -- size )
|
||||
normalize-path 0 "WIN32_FILE_ATTRIBUTE_DATA" <c-object>
|
||||
[ GetFileAttributesEx win32-error=0/f ] keep
|
||||
[ WIN32_FILE_ATTRIBUTE_DATA-nFileSizeLow ]
|
||||
[ WIN32_FILE_ATTRIBUTE_DATA-nFileSizeHigh ] bi >64bit ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: winnt open-append
|
||||
0 ! [ dup file-info size>> ] [ drop 0 ] recover
|
||||
[ dup windows-file-size ] [ drop 0 ] recover
|
||||
[ (open-append) ] dip >>ptr ;
|
||||
|
||||
M: winnt home "USERPROFILE" os-env ;
|
||||
|
|
|
|||
|
|
@ -41,8 +41,11 @@ IN: io.launcher.windows.nt.tests
|
|||
try-process
|
||||
] unit-test
|
||||
|
||||
: launcher-test-path ( -- str )
|
||||
"resource:basis/io/launcher/windows/nt/test" ;
|
||||
|
||||
[ ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
|
|
@ -60,7 +63,7 @@ IN: io.launcher.windows.nt.tests
|
|||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
|
|
@ -74,7 +77,7 @@ IN: io.launcher.windows.nt.tests
|
|||
] unit-test
|
||||
|
||||
[ "output" ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"err2.txt" temp-file >>stderr
|
||||
|
|
@ -87,7 +90,7 @@ IN: io.launcher.windows.nt.tests
|
|||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
ascii <process-reader> contents
|
||||
|
|
@ -97,7 +100,7 @@ IN: io.launcher.windows.nt.tests
|
|||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
+replace-environment+ >>environment-mode
|
||||
|
|
@ -109,7 +112,7 @@ IN: io.launcher.windows.nt.tests
|
|||
] unit-test
|
||||
|
||||
[ "B" ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
{ { "A" "B" } } >>environment
|
||||
|
|
@ -120,7 +123,7 @@ IN: io.launcher.windows.nt.tests
|
|||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
{ { "USERPROFILE" "XXX" } } >>environment
|
||||
|
|
@ -146,7 +149,7 @@ IN: io.launcher.windows.nt.tests
|
|||
|
||||
[ "Hello appender\r\nHello appender\r\n" ] [
|
||||
2 [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
launcher-test-path [
|
||||
<process>
|
||||
vm "-script" "append.factor" 3array >>command
|
||||
"append-test" temp-file <appender> >>stdout
|
||||
|
|
|
|||
|
|
@ -15,74 +15,74 @@ TYPEDEF: void* SOCKET
|
|||
: <wsadata> ( -- byte-array )
|
||||
HEX: 190 <byte-array> ;
|
||||
|
||||
: SOCK_STREAM 1 ; inline
|
||||
: SOCK_DGRAM 2 ; inline
|
||||
: SOCK_RAW 3 ; inline
|
||||
: SOCK_RDM 4 ; inline
|
||||
: SOCK_SEQPACKET 5 ; inline
|
||||
CONSTANT: SOCK_STREAM 1
|
||||
CONSTANT: SOCK_DGRAM 2
|
||||
CONSTANT: SOCK_RAW 3
|
||||
CONSTANT: SOCK_RDM 4
|
||||
CONSTANT: SOCK_SEQPACKET 5
|
||||
|
||||
: SO_DEBUG HEX: 1 ; inline
|
||||
: SO_ACCEPTCONN HEX: 2 ; inline
|
||||
: SO_REUSEADDR HEX: 4 ; inline
|
||||
: SO_KEEPALIVE HEX: 8 ; inline
|
||||
: SO_DONTROUTE HEX: 10 ; inline
|
||||
: SO_BROADCAST HEX: 20 ; inline
|
||||
: SO_USELOOPBACK HEX: 40 ; inline
|
||||
: SO_LINGER HEX: 80 ; inline
|
||||
: SO_OOBINLINE HEX: 100 ; inline
|
||||
CONSTANT: SO_DEBUG HEX: 1
|
||||
CONSTANT: SO_ACCEPTCONN HEX: 2
|
||||
CONSTANT: SO_REUSEADDR HEX: 4
|
||||
CONSTANT: SO_KEEPALIVE HEX: 8
|
||||
CONSTANT: SO_DONTROUTE HEX: 10
|
||||
CONSTANT: SO_BROADCAST HEX: 20
|
||||
CONSTANT: SO_USELOOPBACK HEX: 40
|
||||
CONSTANT: SO_LINGER HEX: 80
|
||||
CONSTANT: SO_OOBINLINE HEX: 100
|
||||
: SO_DONTLINGER ( -- n ) SO_LINGER bitnot ; inline
|
||||
|
||||
: SO_SNDBUF HEX: 1001 ; inline
|
||||
: SO_RCVBUF HEX: 1002 ; inline
|
||||
: SO_SNDLOWAT HEX: 1003 ; inline
|
||||
: SO_RCVLOWAT HEX: 1004 ; inline
|
||||
: SO_SNDTIMEO HEX: 1005 ; inline
|
||||
: SO_RCVTIMEO HEX: 1006 ; inline
|
||||
: SO_ERROR HEX: 1007 ; inline
|
||||
: SO_TYPE HEX: 1008 ; inline
|
||||
CONSTANT: SO_SNDBUF HEX: 1001
|
||||
CONSTANT: SO_RCVBUF HEX: 1002
|
||||
CONSTANT: SO_SNDLOWAT HEX: 1003
|
||||
CONSTANT: SO_RCVLOWAT HEX: 1004
|
||||
CONSTANT: SO_SNDTIMEO HEX: 1005
|
||||
CONSTANT: SO_RCVTIMEO HEX: 1006
|
||||
CONSTANT: SO_ERROR HEX: 1007
|
||||
CONSTANT: SO_TYPE HEX: 1008
|
||||
|
||||
: TCP_NODELAY HEX: 1 ; inline
|
||||
CONSTANT: TCP_NODELAY HEX: 1
|
||||
|
||||
: AF_UNSPEC 0 ; inline
|
||||
: AF_UNIX 1 ; inline
|
||||
: AF_INET 2 ; inline
|
||||
: AF_IMPLINK 3 ; inline
|
||||
: AF_PUP 4 ; inline
|
||||
: AF_CHAOS 5 ; inline
|
||||
: AF_NS 6 ; inline
|
||||
: AF_ISO 7 ; inline
|
||||
CONSTANT: AF_UNSPEC 0
|
||||
CONSTANT: AF_UNIX 1
|
||||
CONSTANT: AF_INET 2
|
||||
CONSTANT: AF_IMPLINK 3
|
||||
CONSTANT: AF_PUP 4
|
||||
CONSTANT: AF_CHAOS 5
|
||||
CONSTANT: AF_NS 6
|
||||
CONSTANT: AF_ISO 7
|
||||
ALIAS: AF_OSI AF_ISO
|
||||
: AF_ECMA 8 ; inline
|
||||
: AF_DATAKIT 9 ; inline
|
||||
: AF_CCITT 10 ; inline
|
||||
: AF_SNA 11 ; inline
|
||||
: AF_DECnet 12 ; inline
|
||||
: AF_DLI 13 ; inline
|
||||
: AF_LAT 14 ; inline
|
||||
: AF_HYLINK 15 ; inline
|
||||
: AF_APPLETALK 16 ; inline
|
||||
: AF_NETBIOS 17 ; inline
|
||||
: AF_MAX 18 ; inline
|
||||
: AF_INET6 23 ; inline
|
||||
: AF_IRDA 26 ; inline
|
||||
: AF_BTM 32 ; inline
|
||||
CONSTANT: AF_ECMA 8
|
||||
CONSTANT: AF_DATAKIT 9
|
||||
CONSTANT: AF_CCITT 10
|
||||
CONSTANT: AF_SNA 11
|
||||
CONSTANT: AF_DECnet 12
|
||||
CONSTANT: AF_DLI 13
|
||||
CONSTANT: AF_LAT 14
|
||||
CONSTANT: AF_HYLINK 15
|
||||
CONSTANT: AF_APPLETALK 16
|
||||
CONSTANT: AF_NETBIOS 17
|
||||
CONSTANT: AF_MAX 18
|
||||
CONSTANT: AF_INET6 23
|
||||
CONSTANT: AF_IRDA 26
|
||||
CONSTANT: AF_BTM 32
|
||||
|
||||
: PF_UNSPEC 0 ; inline
|
||||
: PF_LOCAL 1 ; inline
|
||||
: PF_INET 2 ; inline
|
||||
: PF_INET6 23 ; inline
|
||||
CONSTANT: PF_UNSPEC 0
|
||||
CONSTANT: PF_LOCAL 1
|
||||
CONSTANT: PF_INET 2
|
||||
CONSTANT: PF_INET6 23
|
||||
|
||||
: AI_PASSIVE 1 ; inline
|
||||
: AI_CANONNAME 2 ; inline
|
||||
: AI_NUMERICHOST 4 ; inline
|
||||
CONSTANT: AI_PASSIVE 1
|
||||
CONSTANT: AI_CANONNAME 2
|
||||
CONSTANT: AI_NUMERICHOST 4
|
||||
: AI_MASK ( -- n ) { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ;
|
||||
|
||||
: NI_NUMERICHOST 1 ;
|
||||
: NI_NUMERICSERV 2 ;
|
||||
CONSTANT: NI_NUMERICHOST 1
|
||||
CONSTANT: NI_NUMERICSERV 2
|
||||
|
||||
: IPPROTO_TCP 6 ; inline
|
||||
: IPPROTO_UDP 17 ; inline
|
||||
: IPPROTO_RM 113 ; inline
|
||||
CONSTANT: IPPROTO_TCP 6
|
||||
CONSTANT: IPPROTO_UDP 17
|
||||
CONSTANT: IPPROTO_RM 113
|
||||
|
||||
CONSTANT: WSA_FLAG_OVERLAPPED 1
|
||||
ALIAS: WSA_WAIT_EVENT_0 WAIT_OBJECT_0
|
||||
|
|
@ -94,16 +94,16 @@ ALIAS: WSA_WAIT_TIMEOUT WAIT_TIMEOUT
|
|||
ALIAS: WSA_INFINITE INFINITE
|
||||
ALIAS: WSA_IO_PENDING ERROR_IO_PENDING
|
||||
|
||||
: INADDR_ANY 0 ; inline
|
||||
CONSTANT: INADDR_ANY 0
|
||||
|
||||
: INVALID_SOCKET ( -- alien ) -1 <alien> ; inline
|
||||
: SOCKET_ERROR -1 ; inline
|
||||
CONSTANT: SOCKET_ERROR -1
|
||||
|
||||
: SD_RECV 0 ; inline
|
||||
: SD_SEND 1 ; inline
|
||||
: SD_BOTH 2 ; inline
|
||||
CONSTANT: SD_RECV 0
|
||||
CONSTANT: SD_SEND 1
|
||||
CONSTANT: SD_BOTH 2
|
||||
|
||||
: SOL_SOCKET HEX: ffff ; inline
|
||||
CONSTANT: SOL_SOCKET HEX: ffff
|
||||
|
||||
! TYPEDEF: uint in_addr_t
|
||||
! C-STRUCT: in_addr
|
||||
|
|
@ -207,7 +207,7 @@ C-STRUCT: QOS
|
|||
{ "WSABUF" "ProviderSpecific" } ;
|
||||
TYPEDEF: QOS* LPQOS
|
||||
|
||||
: MAX_PROTOCOL_CHAIN 7 ; inline
|
||||
CONSTANT: MAX_PROTOCOL_CHAIN 7
|
||||
|
||||
C-STRUCT: WSAPROTOCOLCHAIN
|
||||
{ "int" "ChainLen" }
|
||||
|
|
@ -215,7 +215,7 @@ C-STRUCT: WSAPROTOCOLCHAIN
|
|||
{ { "DWORD" 7 } "ChainEntries" } ;
|
||||
TYPEDEF: WSAPROTOCOLCHAIN* LPWSAPROTOCOLCHAIN
|
||||
|
||||
: WSAPROTOCOL_LEN 255 ; inline
|
||||
CONSTANT: WSAPROTOCOL_LEN 255
|
||||
|
||||
C-STRUCT: WSAPROTOCOL_INFOW
|
||||
{ "DWORD" "dwServiceFlags1" }
|
||||
|
|
@ -387,7 +387,7 @@ LIBRARY: mswsock
|
|||
FUNCTION: int AcceptEx ( void* listen, void* accept, void* out-buf, int recv-len, int addr-len, int remote-len, void* out-len, void* overlapped ) ;
|
||||
FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, void* f, void* g, void* h ) ;
|
||||
|
||||
: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090 ; inline
|
||||
CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
|
||||
|
||||
: WSAID_CONNECTEX ( -- GUID )
|
||||
"GUID" <c-object>
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@ ARTICLE: "symbols" "Symbols"
|
|||
"Symbols are just compound definitions in disguise. The following two lines are equivalent:"
|
||||
{ $code
|
||||
"SYMBOL: foo"
|
||||
": foo \\ foo ;"
|
||||
": foo ( -- value ) \\ foo ;"
|
||||
} ;
|
||||
|
||||
ARTICLE: "primitives" "Primitives"
|
||||
|
|
|
|||
|
|
@ -112,7 +112,7 @@ M: source-file fuel-pprint path>> fuel-pprint ;
|
|||
error get
|
||||
fuel-eval-result get-global
|
||||
fuel-eval-output get-global
|
||||
3array fuel-pprint ;
|
||||
3array fuel-pprint flush nl "EOT:" write ;
|
||||
|
||||
: fuel-forget-error ( -- ) f error set-global ; inline
|
||||
: fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
|
||||
|
|
|
|||
Binary file not shown.
|
After Width: | Height: | Size: 6.6 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 7.5 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 6.3 KiB |
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 4.7 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 4.6 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 4.3 KiB |
|
|
@ -0,0 +1,368 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: slides help.markup math arrays hashtables namespaces
|
||||
sequences kernel sequences parser memoize io.encodings.binary
|
||||
locals kernel.private tools.vocabs.browser assocs quotations
|
||||
tools.vocabs tools.annotations tools.crossref
|
||||
help.topics math.functions compiler.tree.optimizer
|
||||
compiler.cfg.optimizer fry graphics.bitmap graphics.viewer
|
||||
ui.gadgets.panes tetris tetris.game combinators generalizations
|
||||
multiline sequences.private ;
|
||||
IN: otug-talk
|
||||
|
||||
USING: cairo cairo.samples cairo.ffi cairo.gadgets accessors
|
||||
io.backend ui.gadgets ;
|
||||
|
||||
TUPLE: png-gadget < cairo-gadget surface ;
|
||||
|
||||
: <png-gadget> ( file -- gadget )
|
||||
png-gadget new-gadget
|
||||
swap normalize-path
|
||||
cairo_image_surface_create_from_png >>surface ; inline
|
||||
|
||||
M: png-gadget pref-dim* ( gadget -- )
|
||||
surface>>
|
||||
[ cairo_image_surface_get_width ]
|
||||
[ cairo_image_surface_get_height ]
|
||||
bi 2array ;
|
||||
|
||||
M: png-gadget render-cairo* ( gadget -- )
|
||||
cr swap surface>> 0 0 cairo_set_source_surface
|
||||
cr cairo_paint ;
|
||||
|
||||
M: png-gadget ungraft* ( gadget -- )
|
||||
surface>> cairo_surface_destroy ;
|
||||
|
||||
: $bitmap ( element -- )
|
||||
[ first <png-gadget> gadget. ] ($block) ;
|
||||
|
||||
: $tetris ( element -- )
|
||||
drop [ <default-tetris> <tetris-gadget> gadget. ] ($block) ;
|
||||
|
||||
: otug-slides
|
||||
{
|
||||
{ $slide "Factor!"
|
||||
{ $url "http://factorcode.org" }
|
||||
"Development started in 2003"
|
||||
"Open source (BSD license)"
|
||||
"Influenced by Forth, Lisp, and Smalltalk"
|
||||
"Blurs the line between language and library"
|
||||
"Interactive development"
|
||||
}
|
||||
{ $slide "Part 1: the language" }
|
||||
{ $slide "Basics"
|
||||
"Stack based, dynamically typed"
|
||||
{ "A " { $emphasis "word" } " is a named piece of code" }
|
||||
{ "Values are passed between words on a " { $emphasis "stack" } }
|
||||
"Code evaluates left to right"
|
||||
"Example:"
|
||||
{ $code "2 3 + ." }
|
||||
}
|
||||
{ $slide "Quotations"
|
||||
{ "A " { $emphasis "quotation" } " is a block of code pushed on the stack" }
|
||||
{ "Syntax: " { $snippet "[ ... ]" } }
|
||||
"Example:"
|
||||
{ $code
|
||||
"\"/etc/passwd\" ascii file-lines"
|
||||
"[ \"#\" head? not ] filter"
|
||||
"[ \":\" split first ] map"
|
||||
"."
|
||||
}
|
||||
}
|
||||
{ $slide "Words"
|
||||
{ "We can define new words with " { $snippet ": name ... ;" } " syntax" }
|
||||
{ $code ": remove-comments ( lines -- lines' )" " [ \"#\" head? not ] filter ;" }
|
||||
{ "Words are grouped into " { $emphasis "vocabularies" } }
|
||||
{ $link "vocab-index" }
|
||||
"Libraries and applications are vocabularies"
|
||||
{ $vocab-link "spheres" }
|
||||
}
|
||||
{ $slide "Constructing quotations"
|
||||
{ "Suppose we want a " { $snippet "remove-comments*" } " word" }
|
||||
{ $code ": remove-comments* ( lines string -- lines' )" " [ ??? head? not ] filter ;" }
|
||||
{ "We use " { $link POSTPONE: '[ } " instead of " { $link POSTPONE: [ } }
|
||||
{ "Create “holes” with " { $link _ } }
|
||||
"Holes filled in left to right when quotation pushed on the stack"
|
||||
}
|
||||
{ $slide "Constructing quotations"
|
||||
{ $code ": remove-comments* ( lines string -- lines' )" " '[ _ head? not ] filter ;" "" ": remove-comments ( lines -- lines' )" " \"#\" remove-comments* ;" }
|
||||
{ { $link @ } " inserts a quotation" }
|
||||
{ $code ": replicate ( n quot -- seq )" " '[ drop @ ] map ;" }
|
||||
{ $code "10 [ 1 10 [a,b] random ] replicate ." }
|
||||
}
|
||||
{ $slide "Combinators"
|
||||
{ "A " { $emphasis "combinator" } " is a word taking quotations as input" }
|
||||
{ "Used for control flow, data flow, iteration" }
|
||||
{ $code "100 [ 5 mod 3 = [ \"Fizz!\" print ] when ] each" }
|
||||
{ "Control flow: " { $link if } ", " { $link when } ", " { $link unless } ", " { $link cond } }
|
||||
{ "Iteration: " { $link map } ", " { $link filter } ", " { $link all? } ", ..." }
|
||||
}
|
||||
{ $slide "Data flow combinators - simple example"
|
||||
"All examples so far used “pipeline style”"
|
||||
"What about using a value more than once, or operating on values not at top of stack?"
|
||||
{ $code "{ 10 70 54 } [ sum ] [ length ] bi / ." }
|
||||
{ $code "5 [ 1 + ] [ sqrt ] [ 1 - ] tri 3array ." }
|
||||
}
|
||||
{ $slide "Data flow combinators - cleave family"
|
||||
{ { $link bi } ", " { $link tri } ", " { $link cleave } }
|
||||
{ $bitmap "resource:extra/otug-talk/bi.png" }
|
||||
}
|
||||
{ $slide "Data flow combinators - cleave family"
|
||||
{ { $link 2bi } ", " { $link 2tri } ", " { $link 2cleave } }
|
||||
{ $bitmap "resource:extra/otug-talk/2bi.png" }
|
||||
}
|
||||
{ $slide "Data flow combinators"
|
||||
"First, let's define a data type:"
|
||||
{ $code "TUPLE: person first-name last-name ;" }
|
||||
"Make an instance:"
|
||||
{ $code "person new" " \"Joe\" >>first-name" " \"Sixpack\" >>last-name" }
|
||||
}
|
||||
{ $slide "Data flow combinators"
|
||||
"Let's do stuff with it:"
|
||||
{ $code
|
||||
"[ first-name>> ] [ last-name>> ] bi"
|
||||
"[ 2 head ] [ 5 head ] bi*"
|
||||
"[ >upper ] bi@"
|
||||
"\".\" glue ."
|
||||
}
|
||||
}
|
||||
{ $slide "Data flow combinators - spread family"
|
||||
{ { $link bi* } ", " { $link tri* } ", " { $link spread } }
|
||||
{ $bitmap "resource:extra/otug-talk/bi_star.png" }
|
||||
}
|
||||
{ $slide "Data flow combinators - spread family"
|
||||
{ { $link 2bi* } }
|
||||
{ $bitmap "resource:extra/otug-talk/2bi_star.png" }
|
||||
}
|
||||
{ $slide "Data flow combinators - apply family"
|
||||
{ { $link bi@ } ", " { $link tri@ } ", " { $link napply } }
|
||||
{ $bitmap "resource:extra/otug-talk/bi_at.png" }
|
||||
}
|
||||
{ $slide "Data flow combinators - apply family"
|
||||
{ { $link 2bi@ } }
|
||||
{ $bitmap "resource:extra/otug-talk/2bi_at.png" }
|
||||
}
|
||||
{ $slide "Shuffle words"
|
||||
"When data flow combinators are not enough"
|
||||
{ $link "shuffle-words" }
|
||||
"Lower-level, Forth/PostScript-style stack manipulation"
|
||||
}
|
||||
{ $slide "Locals"
|
||||
"When data flow combinators and shuffle words are not enough"
|
||||
"Name your input parameters"
|
||||
"Used in about 1% of all words"
|
||||
}
|
||||
{ $slide "Locals example"
|
||||
"Area of a triangle using Heron's formula"
|
||||
{ $code
|
||||
<" :: area ( a b c -- x )
|
||||
a b c + + 2 / :> p
|
||||
p
|
||||
p a - *
|
||||
p b - *
|
||||
p c - * sqrt ;">
|
||||
}
|
||||
}
|
||||
{ $slide "Previous example without locals"
|
||||
"A bit unwieldy..."
|
||||
{ $code
|
||||
<" : area ( a b c -- x )
|
||||
[ ] [ + + 2 / ] 3bi
|
||||
[ '[ _ - ] tri@ ] [ neg ] bi
|
||||
* * * sqrt ;"> }
|
||||
}
|
||||
{ $slide "More idiomatic version"
|
||||
"But there's a trick: put the points in an array"
|
||||
{ $code <" : v-n ( v n -- w ) '[ _ - ] map ;
|
||||
|
||||
: area ( points -- x )
|
||||
[ 0 suffix ] [ sum 2 / ] bi
|
||||
v-n product sqrt ;"> }
|
||||
}
|
||||
! { $slide "The parser"
|
||||
! "All data types have a literal syntax"
|
||||
! "Literal hashtables and arrays are very useful in data-driven code"
|
||||
! { $code "H{ { \"cookies\" 12 } { \"milk\" 10 } }" }
|
||||
! "Libraries can define new parsing words"
|
||||
! }
|
||||
{ $slide "Programming without named values"
|
||||
"Minimal glue between words"
|
||||
"Easy multiple return values"
|
||||
{ "Avoid useless variable names: " { $snippet "x" } ", " { $snippet "n" } ", " { $snippet "a" } ", ..." }
|
||||
{ { $link at } " and " { $link at* } }
|
||||
{ $code "at* [ ... ] [ ... ] if" }
|
||||
}
|
||||
{ $slide "Stack language idioms"
|
||||
"Enables new idioms not possible before"
|
||||
"We get the effect of “keyword parameters” for free"
|
||||
{ $vocab-link "smtp-example" }
|
||||
}
|
||||
{ $slide "“Perfect” factoring"
|
||||
{ $table
|
||||
{ { $link head } { $link head-slice } }
|
||||
{ { $link tail } { $link tail-slice } }
|
||||
}
|
||||
{ "Modifier: " { $link from-end } }
|
||||
{ "Modifier: " { $link short } }
|
||||
"4*2*2=16 operations, 6 words!"
|
||||
}
|
||||
{ $slide "Modifiers"
|
||||
"“Modifiers” can express MN combinations using M+N words"
|
||||
{ $code
|
||||
"\"Hello, Joe\" 4 head ."
|
||||
"\"Hello, Joe\" 3 tail ."
|
||||
"\"Hello, Joe\" 3 from-end tail ."
|
||||
}
|
||||
{ $code
|
||||
"\"Hello world\" 5 short head ."
|
||||
"\"Hi\" 5 short tail ."
|
||||
}
|
||||
}
|
||||
{ $slide "Modifiers"
|
||||
{ "C-style " { $snippet "while" } " and " { $snippet "do while" } " loops" }
|
||||
}
|
||||
{ $slide "Modifiers"
|
||||
{ $code ": bank ( n -- n )" " readln string>number +" " dup \"Balance: $\" write . ;" }
|
||||
{ $code "0 [ dup 0 > ] [ bank ] [ ] while" }
|
||||
}
|
||||
{ $slide "Modifiers"
|
||||
{ $code "0 [ dup 0 > ] [ bank ] [ ] do while" }
|
||||
{ { $link do } " executes one iteration of a " { $link while } " loop" }
|
||||
{ { $link while } " calls " { $link do } }
|
||||
}
|
||||
{ $slide "More “pipeline style” code"
|
||||
{ "Suppose we want to get the price of the customer's first order, but any one of the steps along the way could be a nil value (" { $link f } " in Factor):" }
|
||||
{ $code
|
||||
"dup [ orders>> ] when"
|
||||
"dup [ first ] when"
|
||||
"dup [ price>> ] when"
|
||||
}
|
||||
}
|
||||
{ $slide "This is hard with mainstream syntax!"
|
||||
{ $code
|
||||
<" var customer = ...;
|
||||
var orders = (customer == null ? null : customer.orders);
|
||||
var order = (orders == null ? null : orders[0]);
|
||||
var price = (order == null ? null : order.price);"> }
|
||||
}
|
||||
{ $slide "An ad-hoc solution"
|
||||
"Something like..."
|
||||
{ $code "var price = customer.?orders.?[0].?price;" }
|
||||
}
|
||||
! { $slide "Stack languages are fundamental"
|
||||
! "Very simple semantics"
|
||||
! "Easy to generate stack code programatically"
|
||||
! "Everything is almost entirely library code in Factor"
|
||||
! "Factor is easy to extend"
|
||||
! }
|
||||
{ $slide "Part 2: the implementation" }
|
||||
{ $slide "Interactive development"
|
||||
{ $tetris }
|
||||
}
|
||||
{ $slide "Application deployment"
|
||||
{ $vocab-link "webkit-demo" }
|
||||
"Demonstrates Cocoa binding"
|
||||
"Let's deploy a stand-alone binary with the deploy tool"
|
||||
"Deploy tool generates binaries with no external dependencies"
|
||||
}
|
||||
{ $slide "The UI"
|
||||
"Renders with OpenGL"
|
||||
"Backends for Cocoa, Windows, X11: managing windows, input events, clipboard"
|
||||
"Cross-platform API"
|
||||
}
|
||||
{ $slide "UI example"
|
||||
{ $code
|
||||
<" <pile>
|
||||
{ 5 5 } >>gap
|
||||
1 >>fill
|
||||
"Hello world!" <label> add-gadget
|
||||
"Click me!" [ drop beep ]
|
||||
<bevel-button> add-gadget
|
||||
<editor> <scroller> add-gadget
|
||||
"UI test" open-window "> }
|
||||
}
|
||||
{ $slide "Help system"
|
||||
"Help markup is just literal data"
|
||||
{ "Look at the help for " { $link T{ link f + } } }
|
||||
"These slides are built with the help system and a custom style sheet"
|
||||
{ $vocab-link "otug-talk" }
|
||||
}
|
||||
{ $slide "The VM"
|
||||
"Lowest level is the VM: ~12,000 lines of C"
|
||||
"Generational garbage collection"
|
||||
"Non-optimizing compiler"
|
||||
"Loads an image file and runs it"
|
||||
"Initial image generated from another Factor instance:"
|
||||
{ $code "\"x86.32\" make-image" }
|
||||
}
|
||||
{ $slide "The core library"
|
||||
"Core library, ~9,000 lines of Factor"
|
||||
"Source parser, arrays, strings, math, hashtables, basic I/O, ..."
|
||||
"Packaged into boot image because VM doesn't have a parser"
|
||||
}
|
||||
{ $slide "The basis library"
|
||||
"Basis library, ~80,000 lines of Factor"
|
||||
"Bootstrap process loads code from basis, runs compiler, saves image"
|
||||
"Loaded by default: optimizing compiler, tools, help system, UI, ..."
|
||||
"Optional: HTTP server, XML, database access, ..."
|
||||
}
|
||||
{ $slide "Non-optimizing compiler"
|
||||
"Glues together chunks of machine code"
|
||||
"Most words compiled as calls, some inlined"
|
||||
"Used for listener interactions, and bootstrap"
|
||||
}
|
||||
{ $slide "Optimizing compiler"
|
||||
"Converts Factor code into high-level SSA form"
|
||||
"Performs global optimizations"
|
||||
"Converts high-level SSA into low-level SSA"
|
||||
"Performs local optimizations"
|
||||
"Register allocation"
|
||||
"Machine code generation: x86, x86-64, PowerPC"
|
||||
}
|
||||
{ $slide "Optimizing compiler"
|
||||
"Makes high-level language features cheap to use"
|
||||
"Eliminate redundant method dispatch by inferring types"
|
||||
"Eliminate redundant integer overflow checks by inferring ranges"
|
||||
}
|
||||
{ $slide "Optimizing compiler"
|
||||
"Eliminate redundant memory allocation (escape analysis)"
|
||||
"Eliminate redundant loads/stores (alias analysis)"
|
||||
"Eliminate redundant computations (value numbering)"
|
||||
}
|
||||
{ $slide "Project infrastructure"
|
||||
{ $url "http://factorcode.org" }
|
||||
{ $url "http://concatenative.org" }
|
||||
{ $url "http://docs.factorcode.org" }
|
||||
{ $url "http://planet.factorcode.org" }
|
||||
"Uses our HTTP server, SSL, DB, Atom libraries..."
|
||||
}
|
||||
{ $slide "Project infrastructure"
|
||||
"Build farm, written in Factor"
|
||||
"12 platforms"
|
||||
"Builds Factor and all libraries, runs tests, makes binaries"
|
||||
"Good for increasing stability"
|
||||
}
|
||||
{ $slide "Community"
|
||||
"#concatenative irc.freenode.net: 60-70 users"
|
||||
"factor-talk@lists.sf.net: 189 subscribers"
|
||||
"About 30 people have code in the Factor repository"
|
||||
"Easy to get started: binaries, lots of docs, friendly community..."
|
||||
}
|
||||
{ $slide "Selling points"
|
||||
"Expressive language"
|
||||
"Comprehensive library"
|
||||
"Efficient implementation"
|
||||
"Powerful interactive tools"
|
||||
"Stand-alone application deployment"
|
||||
"Moving fast"
|
||||
}
|
||||
{ $slide "That's all, folks"
|
||||
"It is hard to cover everything in a single talk"
|
||||
"Factor has many cool things that I didn't talk about"
|
||||
"Questions?"
|
||||
}
|
||||
} ;
|
||||
|
||||
: otug-talk ( -- ) otug-slides slides-window ;
|
||||
|
||||
MAIN: otug-talk
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slides from a talk at OTUG by Slava Pestov, December 2008
|
||||
|
|
@ -0,0 +1 @@
|
|||
demos
|
||||
|
|
@ -47,8 +47,8 @@ M-x customize-group fuel will show you how many.
|
|||
Quick key reference
|
||||
-------------------
|
||||
|
||||
(Chords ending in a single letter <x> accept also C-<x> (e.g. C-cC-z is
|
||||
the same as C-cz)).
|
||||
(Triple chords ending in a single letter <x> accept also C-<x> (e.g.
|
||||
C-cC-eC-r is the same as C-cC-er)).
|
||||
|
||||
* In factor source files:
|
||||
|
||||
|
|
@ -57,7 +57,8 @@ the same as C-cz)).
|
|||
|
||||
- M-. : edit word at point in Emacs
|
||||
- M-TAB : complete word at point
|
||||
- C-cC-ev : edit vocabulary
|
||||
- C-cC-ev : edit vocabulary (M-x fuel-edit-vocabulary)
|
||||
- C-cC-ew : edit word (M-x fuel-edit-word)
|
||||
|
||||
- C-cr, C-cC-er : eval region
|
||||
- C-M-r, C-cC-ee : eval region, extending it to definition boundaries
|
||||
|
|
|
|||
|
|
@ -143,6 +143,15 @@ terminates a current completion."
|
|||
(vs (and cv `("syntax" ,cv ,@(fuel-syntax--usings)))))
|
||||
(fuel-completion--words prefix vs)))
|
||||
|
||||
(defsubst fuel-completion--all-words-list (prefix)
|
||||
(fuel-completion--words prefix nil))
|
||||
|
||||
(defvar fuel-completion--word-list-func
|
||||
(completion-table-dynamic 'fuel-completion--word-list))
|
||||
|
||||
(defvar fuel-completion--all-words-list-func
|
||||
(completion-table-dynamic 'fuel-completion--all-words-list))
|
||||
|
||||
(defun fuel-completion--complete (prefix)
|
||||
(let* ((words (fuel-completion--word-list prefix))
|
||||
(completions (all-completions prefix words))
|
||||
|
|
@ -150,6 +159,14 @@ terminates a current completion."
|
|||
(partial (if (eq partial t) prefix partial)))
|
||||
(cons completions partial)))
|
||||
|
||||
(defsubst fuel-completion--read-word (prompt &optional default history all)
|
||||
(completing-read prompt
|
||||
(if all fuel-completion--all-words-list-func
|
||||
fuel-completion--word-list-func)
|
||||
nil nil nil
|
||||
history
|
||||
(or default (fuel-syntax-symbol-at-point))))
|
||||
|
||||
(defun fuel-completion--complete-symbol ()
|
||||
"Complete the symbol at point.
|
||||
Perform completion similar to Emacs' complete-symbol."
|
||||
|
|
|
|||
|
|
@ -14,8 +14,11 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-base)
|
||||
(require 'fuel-log)
|
||||
(require 'fuel-base)
|
||||
|
||||
(require 'comint)
|
||||
(require 'advice)
|
||||
|
||||
|
||||
;;; Default connection:
|
||||
|
|
@ -123,19 +126,34 @@
|
|||
|
||||
;;; Connection setup:
|
||||
|
||||
(defun fuel-con--cleanup-connection (c)
|
||||
(fuel-con--connection-cancel-timer c))
|
||||
|
||||
(defun fuel-con--setup-connection (buffer)
|
||||
(set-buffer buffer)
|
||||
(fuel-con--cleanup-connection fuel-con--connection)
|
||||
(let ((conn (fuel-con--make-connection buffer)))
|
||||
(fuel-con--setup-comint)
|
||||
(prog1
|
||||
(setq fuel-con--connection conn)
|
||||
(fuel-con--connection-start-timer conn))))
|
||||
|
||||
(defconst fuel-con--prompt-regex "( .+ ) ")
|
||||
(defconst fuel-con--eot-marker "EOT:")
|
||||
(defconst fuel-con--init-stanza (format "USE: fuel %S write" fuel-con--eot-marker))
|
||||
|
||||
(defconst fuel-con--comint-finished-regex
|
||||
(format "%s%s" fuel-con--eot-marker fuel-con--prompt-regex))
|
||||
|
||||
(defun fuel-con--setup-comint ()
|
||||
(comint-redirect-cleanup)
|
||||
(add-hook 'comint-redirect-filter-functions
|
||||
'fuel-con--comint-redirect-filter t t)
|
||||
(add-hook 'comint-redirect-hook
|
||||
'fuel-con--comint-redirect-hook))
|
||||
'fuel-con--comint-redirect-hook nil t))
|
||||
|
||||
(defadvice comint-redirect-setup (after fuel-con--advice activate)
|
||||
(setq comint-redirect-finished-regexp fuel-con--comint-finished-regex))
|
||||
|
||||
|
||||
;;; Requests handling:
|
||||
|
|
@ -169,6 +187,8 @@
|
|||
(error (fuel-log--error "<%s>: continuation failed %S \n\t%s"
|
||||
id rstr cerr))))))
|
||||
|
||||
(defvar fuel-con--debug-comint-p nil)
|
||||
|
||||
(defun fuel-con--comint-redirect-filter (str)
|
||||
(if (not fuel-con--connection)
|
||||
(fuel-log--error "No connection in buffer (%s)" str)
|
||||
|
|
@ -176,13 +196,13 @@
|
|||
(if (not req) (fuel-log--error "No current request (%s)" str)
|
||||
(fuel-con--request-output req str)
|
||||
(fuel-log--info "<%s>: in progress" (fuel-con--request-id req)))))
|
||||
(fuel--shorten-str str 70))
|
||||
(if fuel-con--debug-comint-p (fuel--shorten-str str 256) ""))
|
||||
|
||||
(defun fuel-con--comint-redirect-hook ()
|
||||
(if (not fuel-con--connection)
|
||||
(fuel-log--error "No connection in buffer")
|
||||
(let ((req (fuel-con--connection-current-request fuel-con--connection)))
|
||||
(if (not req) (fuel-log--error "No current request (%s)" str)
|
||||
(if (not req) (fuel-log--error "No current request")
|
||||
(fuel-con--process-completed-request req)
|
||||
(fuel-con--connection-clean-current-request fuel-con--connection)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -76,7 +76,6 @@
|
|||
((listp usings) `(:array ,@usings))
|
||||
(t (error "Invalid 'usings' (%s)" usings))))
|
||||
|
||||
|
||||
|
||||
;;; Code sending:
|
||||
|
||||
|
|
|
|||
|
|
@ -14,9 +14,10 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-base)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-completion)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-base)
|
||||
|
||||
|
||||
;;; Customization:
|
||||
|
|
@ -108,14 +109,15 @@ displayed in the minibuffer."
|
|||
;;; Help browser history:
|
||||
|
||||
(defvar fuel-help--history
|
||||
(list nil
|
||||
(make-ring fuel-help-history-cache-size)
|
||||
(make-ring fuel-help-history-cache-size)))
|
||||
(list nil ; current
|
||||
(make-ring fuel-help-history-cache-size) ; previous
|
||||
(make-ring fuel-help-history-cache-size))) ; next
|
||||
|
||||
(defvar fuel-help--history-idx 0)
|
||||
|
||||
(defun fuel-help--history-push (term)
|
||||
(when (car fuel-help--history)
|
||||
(when (and (car fuel-help--history)
|
||||
(not (string= (caar fuel-help--history) (car term))))
|
||||
(ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
|
||||
(setcar fuel-help--history term))
|
||||
|
||||
|
|
@ -135,7 +137,7 @@ displayed in the minibuffer."
|
|||
;;; Fuel help buffer and internals:
|
||||
|
||||
(defun fuel-help--help-buffer ()
|
||||
(with-current-buffer (get-buffer-create "*fuel-help*")
|
||||
(with-current-buffer (get-buffer-create "*fuel help*")
|
||||
(fuel-help-mode)
|
||||
(current-buffer)))
|
||||
|
||||
|
|
@ -148,7 +150,9 @@ displayed in the minibuffer."
|
|||
(ask (or (not (memq major-mode '(factor-mode fuel-help-mode)))
|
||||
(not def)
|
||||
fuel-help-always-ask))
|
||||
(def (if ask (read-string prompt nil 'fuel-help--prompt-history def)
|
||||
(def (if ask (fuel-completion--read-word prompt
|
||||
def
|
||||
'fuel-help--prompt-history)
|
||||
def))
|
||||
(cmd `(:fuel* ((:quote ,def) ,(if see 'see 'help)) t)))
|
||||
(message "Looking up '%s' ..." def)
|
||||
|
|
@ -157,7 +161,7 @@ displayed in the minibuffer."
|
|||
(defun fuel-help--show-help-cont (def ret)
|
||||
(let ((out (fuel-eval--retort-output ret)))
|
||||
(if (or (fuel-eval--retort-error ret) (empty-string-p out))
|
||||
(message "No help for '%s'" ret)
|
||||
(message "No help for '%s'" def)
|
||||
(fuel-help--insert-contents def out))))
|
||||
|
||||
(defun fuel-help--insert-contents (def str &optional nopush)
|
||||
|
|
@ -167,14 +171,15 @@ displayed in the minibuffer."
|
|||
(set-buffer hb)
|
||||
(erase-buffer)
|
||||
(insert str)
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward (format "^%s" def) nil t)
|
||||
(beginning-of-line)
|
||||
(kill-region (point-min) (point))
|
||||
(next-line)
|
||||
(open-line 1))
|
||||
(unless nopush
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward (format "^%s" def) nil t)
|
||||
(beginning-of-line)
|
||||
(kill-region (point-min) (point))
|
||||
(next-line)
|
||||
(open-line 1)
|
||||
(fuel-help--history-push (cons def (buffer-string)))))
|
||||
(set-buffer-modified-p nil)
|
||||
(unless nopush (fuel-help--history-push (cons def str)))
|
||||
(pop-to-buffer hb)
|
||||
(goto-char (point-min))
|
||||
(message "%s" def)))
|
||||
|
|
|
|||
|
|
@ -14,9 +14,11 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-base)
|
||||
(require 'fuel-completion)
|
||||
(require 'fuel-connection)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-base)
|
||||
|
||||
(require 'comint)
|
||||
|
||||
|
||||
|
|
@ -63,19 +65,21 @@ buffer."
|
|||
|
||||
(defun fuel-listener--start-process ()
|
||||
(let ((factor (expand-file-name fuel-listener-factor-binary))
|
||||
(image (expand-file-name fuel-listener-factor-image)))
|
||||
(image (expand-file-name fuel-listener-factor-image))
|
||||
(comint-redirect-perform-sanity-check nil))
|
||||
(unless (file-executable-p factor)
|
||||
(error "Could not run factor: %s is not executable" factor))
|
||||
(unless (file-readable-p image)
|
||||
(error "Could not run factor: image file %s not readable" image))
|
||||
(message "Starting FUEL listener ...")
|
||||
(comint-exec (fuel-listener--buffer) "factor"
|
||||
factor nil `("-run=listener" ,(format "-i=%s" image)))
|
||||
(pop-to-buffer (fuel-listener--buffer))
|
||||
(goto-char (point-max))
|
||||
(comint-send-string nil "USE: fuel \"FUEL loaded\\n\" write\n")
|
||||
(fuel-listener--wait-for-prompt 30)
|
||||
(message "FUEL listener up and running!")))
|
||||
(make-comint-in-buffer "fuel listener" (current-buffer) factor nil
|
||||
"-run=listener" (format "-i=%s" image))
|
||||
(fuel-listener--wait-for-prompt 10000)
|
||||
(fuel-con--send-string/wait (current-buffer)
|
||||
fuel-con--init-stanza
|
||||
'(lambda (s) (message "FUEL listener up and running!"))
|
||||
20000)))
|
||||
|
||||
(defun fuel-listener--process (&optional start)
|
||||
(or (and (buffer-live-p (fuel-listener--buffer))
|
||||
|
|
@ -87,21 +91,15 @@ buffer."
|
|||
|
||||
(setq fuel-eval--default-proc-function 'fuel-listener--process)
|
||||
|
||||
|
||||
;;; Prompt chasing
|
||||
|
||||
(defun fuel-listener--wait-for-prompt (&optional timeout)
|
||||
(let ((proc (get-buffer-process (fuel-listener--buffer)))
|
||||
(seen))
|
||||
(with-current-buffer (fuel-listener--buffer)
|
||||
(goto-char (or comint-last-input-end (point-max)))
|
||||
(while (and (not seen)
|
||||
(accept-process-output proc (or timeout 10) nil t))
|
||||
(sleep-for 0 1)
|
||||
(goto-char comint-last-input-end)
|
||||
(setq seen (re-search-forward comint-prompt-regexp nil t)))
|
||||
(goto-char (point-max))
|
||||
(unless seen (error "No prompt found!")))))
|
||||
(defun fuel-listener--wait-for-prompt (timeout)
|
||||
(let ((p (point)) (seen))
|
||||
(while (and (not seen) (> timeout 0))
|
||||
(sleep-for 0.1)
|
||||
(setq timeout (- timeout 100))
|
||||
(goto-char p)
|
||||
(setq seen (re-search-forward comint-prompt-regexp nil t)))
|
||||
(goto-char (point-max))
|
||||
(unless seen (error "No prompt found!"))))
|
||||
|
||||
|
||||
;;; Completion support
|
||||
|
|
@ -132,12 +130,10 @@ buffer."
|
|||
|
||||
;;; Fuel listener mode:
|
||||
|
||||
(defconst fuel-listener--prompt-regex ".* ) ")
|
||||
|
||||
(define-derived-mode fuel-listener-mode comint-mode "Fuel Listener"
|
||||
"Major mode for interacting with an inferior Factor listener process.
|
||||
\\{fuel-listener-mode-map}"
|
||||
(set (make-local-variable 'comint-prompt-regexp) fuel-listener--prompt-regex)
|
||||
(set (make-local-variable 'comint-prompt-regexp) fuel-con--prompt-regex)
|
||||
(set (make-local-variable 'comint-prompt-read-only) t)
|
||||
(fuel-listener--setup-completion))
|
||||
|
||||
|
|
|
|||
|
|
@ -114,18 +114,26 @@ buffer in case of errors."
|
|||
"Opens a new window visiting the definition of the word at point.
|
||||
With prefix, asks for the word to edit."
|
||||
(interactive "P")
|
||||
(let* ((word (fuel-syntax-symbol-at-point))
|
||||
(ask (or arg (not word)))
|
||||
(word (if ask
|
||||
(read-string nil
|
||||
(format "Edit word%s: "
|
||||
(if word (format " (%s)" word) ""))
|
||||
word)
|
||||
word)))
|
||||
(let ((cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
|
||||
(condition-case nil
|
||||
(fuel--try-edit (fuel-eval--send/wait cmd))
|
||||
(error (fuel-edit-vocabulary nil word))))))
|
||||
(let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
|
||||
(fuel-completion--read-word "Edit word: ")))
|
||||
(cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
|
||||
(condition-case nil
|
||||
(fuel--try-edit (fuel-eval--send/wait cmd))
|
||||
(error (fuel-edit-vocabulary nil word)))))
|
||||
|
||||
(defvar fuel-mode--word-history nil)
|
||||
|
||||
(defun fuel-edit-word (&optional arg)
|
||||
"Asks for a word to edit, with completion.
|
||||
With prefix, only words visible in the current vocabulary are
|
||||
offered."
|
||||
(interactive "P")
|
||||
(let* ((word (fuel-completion--read-word "Edit word: "
|
||||
nil
|
||||
fuel-mode--word-history
|
||||
arg))
|
||||
(cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
|
||||
(fuel--try-edit (fuel-eval--send/wait cmd))))
|
||||
|
||||
(defvar fuel--vocabs-prompt-history nil)
|
||||
|
||||
|
|
@ -195,7 +203,7 @@ interacting with a factor listener is at your disposal.
|
|||
(fuel-mode--key ?e ?e 'fuel-eval-extended-region)
|
||||
(fuel-mode--key ?e ?r 'fuel-eval-region)
|
||||
(fuel-mode--key ?e ?v 'fuel-edit-vocabulary)
|
||||
(fuel-mode--key ?e ?w 'fuel-edit-word-at-point)
|
||||
(fuel-mode--key ?e ?w 'fuel-edit-word)
|
||||
(fuel-mode--key ?e ?x 'fuel-eval-definition)
|
||||
|
||||
(fuel-mode--key ?d ?a 'fuel-autodoc-mode)
|
||||
|
|
|
|||
Loading…
Reference in New Issue