release
import-0.87
nomennescio
parent
c800d28665
commit
76e6ede2ec
22
Makefile
22
Makefile
|
|
@ -3,16 +3,16 @@ CC = gcc
|
|||
BINARY = f
|
||||
IMAGE = factor.image
|
||||
BUNDLE = Factor.app
|
||||
VERSION = 0.86
|
||||
VERSION = 0.87
|
||||
DISK_IMAGE_DIR = Factor-$(VERSION)
|
||||
DISK_IMAGE = Factor-$(VERSION).dmg
|
||||
LIBPATH = -L/usr/X11R6/lib
|
||||
|
||||
ifdef DEBUG
|
||||
CFLAGS = -pg -O1
|
||||
CFLAGS = -g -std=gnu99
|
||||
STRIP = touch
|
||||
else
|
||||
CFLAGS = -Wall -O3 -ffast-math -fomit-frame-pointer $(SITE_CFLAGS)
|
||||
CFLAGS = -Wall -O3 -ffast-math -std=gnu99 $(SITE_CFLAGS)
|
||||
STRIP = strip
|
||||
endif
|
||||
|
||||
|
|
@ -40,7 +40,8 @@ OBJS = $(PLAF_OBJS) \
|
|||
default:
|
||||
@echo "Run 'make' with one of the following parameters:"
|
||||
@echo ""
|
||||
@echo "freebsd"
|
||||
@echo "freebsd-x86"
|
||||
@echo "freebsd-amd64"
|
||||
@echo "linux-x86"
|
||||
@echo "linux-amd64"
|
||||
@echo "linux-ppc"
|
||||
|
|
@ -62,8 +63,11 @@ default:
|
|||
@echo ""
|
||||
@echo "export SITE_CFLAGS=\"-march=pentium4 -ffast-math\""
|
||||
|
||||
freebsd:
|
||||
$(MAKE) $(BINARY) CONFIG=vm/Config.freebsd
|
||||
freebsd-x86:
|
||||
$(MAKE) $(BINARY) CONFIG=vm/Config.freebsd.x86
|
||||
|
||||
freebsd-amd64:
|
||||
$(MAKE) $(BINARY) CONFIG=vm/Config.freebsd.amd64
|
||||
|
||||
macosx-freetype:
|
||||
ln -sf libfreetype.6.dylib \
|
||||
|
|
@ -73,10 +77,10 @@ macosx-ppc: macosx-freetype
|
|||
$(MAKE) $(BINARY) CONFIG=vm/Config.macosx.ppc
|
||||
|
||||
macosx-x86: macosx-freetype
|
||||
$(MAKE) $(BINARY) CONFIG=vm/Config.macosx
|
||||
$(MAKE) $(BINARY) CONFIG=vm/Config.macosx.x86
|
||||
|
||||
linux-x86:
|
||||
$(MAKE) $(BINARY) CONFIG=vm/Config.linux
|
||||
$(MAKE) $(BINARY) CONFIG=vm/Config.linux.x86
|
||||
$(STRIP) $(BINARY)
|
||||
|
||||
linux-amd64:
|
||||
|
|
@ -124,6 +128,7 @@ macosx.dmg:
|
|||
-o -name '*.fgen' \
|
||||
-o -name '*.tex' \
|
||||
-o -name '*.fhtml' \
|
||||
-o -name '*.furnace' \
|
||||
-o -name '*.xml' \
|
||||
-o -name '*.js' \) \
|
||||
-exec ./cp_dir {} $(DISK_IMAGE_DIR)/Factor/{} \;
|
||||
|
|
@ -140,7 +145,6 @@ clean:
|
|||
rm -f vm/*.o
|
||||
|
||||
clean.app:
|
||||
rm -rf $(BUNDLE)/Contents/Resources/
|
||||
rm -f $(BUNDLE)/Contents/MacOS/Factor
|
||||
|
||||
.c.o:
|
||||
|
|
|
|||
23
README.txt
23
README.txt
|
|
@ -160,16 +160,23 @@ the command prompt:
|
|||
|
||||
f.exe boot.image.pentium4 (or boot.image.x86)
|
||||
|
||||
Once bootstrapped, double-clicking f.exe starts the Factor UI. There is
|
||||
no option to run the listener in the command prompt on Windows.
|
||||
Once bootstrapped, double-clicking f.exe starts the Factor UI.
|
||||
|
||||
To run the listener in the command prompt:
|
||||
|
||||
f.exe -shell=tty
|
||||
|
||||
* Source organization
|
||||
|
||||
doc/ - the developer's handbook, and various other bits and pieces
|
||||
contrib/ - various handy libraries not part of the core
|
||||
examples/ - small examples illustrating various language features
|
||||
The following four directories are managed by the module system; consult
|
||||
the documentation for details:
|
||||
|
||||
apps/ - user-contributed applications
|
||||
libs/ - user-contributed libraries
|
||||
demos/ - small examples illustrating various language features
|
||||
core/ - sources for the library, written in Factor
|
||||
|
||||
fonts/ - TrueType fonts used by UI
|
||||
library/ - sources for the library, written in Factor
|
||||
vm/ - sources for the Factor runtime, written in C
|
||||
|
||||
* Community
|
||||
|
|
@ -190,10 +197,6 @@ Doug Coleman: Mersenne Twister RNG, Windows port
|
|||
Eduardo Cavazos: X11 binding
|
||||
Joshua Grams: PowerPC instruction cache flush code
|
||||
Mackenzie Straight: Windows port
|
||||
Trent Buck: Debian package
|
||||
|
||||
A number of contributed libraries not part of the core can be found in
|
||||
contrib/. See contrib/README.txt for details.
|
||||
|
||||
Have fun!
|
||||
|
||||
|
|
|
|||
|
|
@ -1,50 +1,61 @@
|
|||
+ 0.87:
|
||||
|
||||
- fix search unit test
|
||||
- error popup obscures input area
|
||||
- cocoa: international keys don't work
|
||||
- embedded.factor is O(n^2)
|
||||
|
||||
+ 0.88:
|
||||
|
||||
- models: don't do redundant work
|
||||
- test factor on linux/ppc
|
||||
- poorly documented vocabs:
|
||||
- alien
|
||||
- cocoa
|
||||
- command-line
|
||||
- compiler
|
||||
- completion
|
||||
- image
|
||||
- interpreter
|
||||
- objc
|
||||
- optimizer
|
||||
- grid-lines are rendered incorrectly
|
||||
- lisppaste gui
|
||||
- growable data heap
|
||||
- variable width word wrap
|
||||
- graphical crossref tool
|
||||
- inspector where slot values can be changed
|
||||
- compiled call traces do not work if the runtime is built with
|
||||
-fomit-frame-pointer on ppc
|
||||
- use crc32 instead of modification date in reload-modules
|
||||
- top level window positioning on ms windows
|
||||
- these things are "Too Slow":
|
||||
- all-words
|
||||
- make-image
|
||||
- workspace-window
|
||||
- menu should stay up if mouse button released
|
||||
- roundoff is still not quite right with tracks
|
||||
- grid displays quickly now, but constructing large amounts of gadgets
|
||||
is slow: eg, 10000 [ dup number>string ] map describe
|
||||
- completion is not ideal: eg, C+e "buttons"
|
||||
- slider needs to be modelized
|
||||
- better help result ranking
|
||||
- help search looks funny
|
||||
- variable width word wrap
|
||||
- graphical module manager tool
|
||||
- graphical crossref tool
|
||||
- ui browser: show currently selected vocab & words
|
||||
- apropos
|
||||
- 10000 [ dup number>string ] map describe in the UI
|
||||
- available-modules
|
||||
- string-lines
|
||||
- md5, crc32
|
||||
- all-words [ word-name ] map prune [ words-named ] map
|
||||
- 100000 [ "\"hello\" not" eval drop ] times
|
||||
- auto-update browser and help when sources reload
|
||||
- amd64 structs-by-value bug
|
||||
- intrinsic fixnum>float float>fixnum
|
||||
- mac intel: struct returns from objc methods
|
||||
- faster apropos
|
||||
- compiled call traces
|
||||
- workspace window takes too long to come up
|
||||
- new windows don't always have focus, eg focus follows mouse
|
||||
- dataflow for [ ] map [ ] subset looks weird (wrong?)
|
||||
- listener commands from a menu should not include 'hide-glass' etc
|
||||
- bogus compile errors?
|
||||
- recompile get/set/>n/n>/ndrop if needed
|
||||
- cross-word type inference
|
||||
- callback scheduling issue
|
||||
- windows crash
|
||||
- ui docs
|
||||
- some kind of declarative wiring framework for ui
|
||||
- overhaul models, set-model* is crap
|
||||
- allow rebinding styles
|
||||
- fix windows gcc issue
|
||||
- robustify stepper -- see if step back past a throw works
|
||||
- empty callstack: should throw an exception instead of being a critical error
|
||||
- if we're printing a block on multiple lines, break at some words like
|
||||
set off on % # , ... and assembler opcodes
|
||||
- don't end lines with literals, shuffle words or symbols?
|
||||
- see should try to not show ; on a line by itself
|
||||
- IN: on its own line if the entire 'see' form doesn't fit
|
||||
- command buttons: indicate shortcuts
|
||||
- how do we refer to command shortcuts in the docs?
|
||||
|
||||
+ ui:
|
||||
|
||||
- some way of intercepting all gestures
|
||||
- how do we refer to command shortcuts in the docs?
|
||||
- fix top level window positioning
|
||||
- browser tool: dropdown menu button for definition operations
|
||||
- copying pane output
|
||||
- editor:
|
||||
- autoscroll
|
||||
- transpose char/word/line
|
||||
|
|
@ -52,54 +63,35 @@
|
|||
- see if its possible to only repaint dirty regions
|
||||
- structure editor
|
||||
|
||||
+ module system:
|
||||
+ compiler/ffi:
|
||||
|
||||
- track a list of assets loaded from each module's file
|
||||
- C types should be words
|
||||
- TYPEDEF: float { ... } { ... } ; ==> \ float T{ c-type ... } "c-type" swp
|
||||
- TYPEDEF: float FTFloat ; ==> \ float \ FTFloat "c-type" swp
|
||||
- make typedef aliasing explicit
|
||||
- seeing a C struct word should show its def
|
||||
- file out
|
||||
|
||||
+ compiler/ffi:
|
||||
|
||||
- amd64 structs-by-value bug
|
||||
- %allot-bignum-signed-2 is broken on both platforms
|
||||
- we may be able to remove the dlsym primitive
|
||||
- [ [ dup call ] dup call ] infer hangs
|
||||
- stdcall callbacks
|
||||
- callstack overflow when compiling mutually recursive inline words
|
||||
- test what is done in the case of an invalid declaration on an inline
|
||||
recursive
|
||||
- ppc64 backend
|
||||
- arm backend
|
||||
- float= doesn't consider nans equal
|
||||
- C functions returning structs by value
|
||||
- compiled continuations
|
||||
|
||||
+ prettyprinter:
|
||||
|
||||
- clean it up
|
||||
- if we're printing a block on multiple lines, break at some words like
|
||||
set off on % # , ... and assembler opcodes
|
||||
- don't end lines with literals, shuffle words or symbols?
|
||||
- see should try to not show ; on a line by itself
|
||||
- IN: on its own line if the entire 'see' form doesn't fit
|
||||
- don't build entire tree to print first
|
||||
|
||||
+ misc:
|
||||
|
||||
- if a word drops the stack pointer below the bottom, then an error
|
||||
won't be thrown until the next word accesses the stack
|
||||
- prettyprinter: don't build entire tree to print first
|
||||
- automatic help/effects for slot accessors
|
||||
- tuple shape changes
|
||||
- should be possible to reload any source file in library
|
||||
- growable data heap
|
||||
- minor GC takes too long now, we should card mark code heap
|
||||
- buffer-ptr should be an alien
|
||||
- swap nappend ==> nappend
|
||||
- gdb triggers 'multiple i/o ops on port' error
|
||||
- incremental GC
|
||||
- UDP
|
||||
- slice: if sequence or seq start is changed, abstraction violation
|
||||
- hashed generic method dispatch
|
||||
|
||||
+ httpd:
|
||||
|
||||
- remaining HTML issues need fixing
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
This directory contains Factor code that is not part of the core
|
||||
library, but is useful enough to ship with the Factor distribution.
|
||||
|
||||
Modules can be loaded from the listener:
|
||||
|
||||
"apps/modulename" require
|
||||
|
||||
Available applications:
|
||||
|
||||
- automata -- Graphics demo for the UI (Eduardo Cavazos)
|
||||
- benchmarks -- Various performance benchmarks (Slava Pestov)
|
||||
- boids -- Graphics demo for the UI (Eduardo Cavazos)
|
||||
- factory -- X11 window manager (Eduardo Cavazos)
|
||||
- furnace-fjsc -- Web frontend for libs/fjsc (Chris Double)
|
||||
- furnace-onigiri -- Weblog engine (Matthew Willis)
|
||||
- furnace-pastebin -- demo app for Furnace (Slava Pestov)
|
||||
- help-lint -- online documentation typo checker (Slava Pestov)
|
||||
- hexdump -- Hexdump routine (Doug Coleman)
|
||||
- lindenmayer -- L-systems tool (Eduardo Cavazos)
|
||||
- lisppaste -- Lisppaste XML-RPC demo (Slava Pestov)
|
||||
- mandel -- Mandelbrot fractal demo (Slava Pestov)
|
||||
- random-tester -- Random compiler tester (Doug Coleman)
|
||||
- raytracer -- Raytracer demo (Slava Pestov)
|
||||
- rss -- An RSS1, RSS2 and Atom parser and aggregator (Chris Double, Daniel Ehrenberg)
|
||||
- show-dataflow -- Code to print compiler dataflow IR to the console, or show it in the UI (Slava Pestov)
|
||||
- space-invaders -- Intel 8080-based Space Invaders arcade machine emulator (Chris Double)
|
||||
- tetris -- Tetris game (Alex Chapman)
|
||||
- turing -- Turing machine demo (Slava Pestov)
|
||||
- wee-url -- Web app to make short URLs from long ones (Doug Coleman)
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
USING: words kernel modules ;
|
||||
|
||||
REQUIRES: apps/automata apps/benchmarks apps/boids
|
||||
apps/factorbot apps/furnace-fjsc apps/furnace-onigiri
|
||||
apps/furnace-pastebin apps/help-lint apps/hexdump
|
||||
apps/lindenmayer apps/lisppaste apps/mandel apps/random-tester
|
||||
apps/raytracer apps/rss apps/space-invaders apps/tetris
|
||||
apps/turing apps/show-dataflow apps/wee-url ;
|
||||
|
||||
"x11" vocab [
|
||||
"apps/factory" require
|
||||
] when
|
||||
|
||||
PROVIDE: apps/all ;
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
REQUIRES: contrib/vars contrib/slate contrib/lindenmayer/opengl ;
|
||||
REQUIRES: libs/vars libs/slate apps/lindenmayer/opengl ;
|
||||
|
||||
USING: kernel namespaces hashtables sequences generic math arrays
|
||||
threads opengl gadgets
|
||||
|
|
@ -153,7 +153,7 @@ init
|
|||
slate> over set-delegate
|
||||
interesting random-item set-rule ;
|
||||
|
||||
: automata-window ( -- ) <automata-gadget> "Automata" open-titled-window ;
|
||||
: automata-window ( -- ) <automata-gadget> "Automata" open-window ;
|
||||
|
||||
automata-gadget H{
|
||||
{ T{ key-down f f "1" } [ slate-ns [ start-center ] bind ] }
|
||||
|
|
@ -167,4 +167,4 @@ automata-gadget H{
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
PROVIDE: contrib/automata ;
|
||||
PROVIDE: apps/automata ;
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
USING: gadgets-panes hashtables help io kernel namespaces
|
||||
prettyprint sequences test threads words ;
|
||||
prettyprint sequences errors threads words test ;
|
||||
|
||||
[
|
||||
all-articles [
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
PROVIDE: contrib/benchmarks
|
||||
PROVIDE: apps/benchmarks
|
||||
{ +tests+ {
|
||||
"empty-loop.factor"
|
||||
"fac.factor"
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
REQUIRES: contrib/math
|
||||
contrib/vars
|
||||
contrib/lindenmayer/opengl
|
||||
contrib/slate ;
|
||||
REQUIRES: libs/math
|
||||
libs/vars
|
||||
apps/lindenmayer/opengl
|
||||
libs/slate ;
|
||||
|
||||
USING: kernel namespaces math sequences arrays threads opengl gadgets
|
||||
math-contrib vars opengl-contrib slate ;
|
||||
|
|
@ -267,7 +267,7 @@ stop? get [ ] [ run ] if ;
|
|||
<slate> >slate
|
||||
namespace slate> set-slate-ns
|
||||
[ display ] >action
|
||||
slate> "Boids" open-titled-window ;
|
||||
slate> "Boids" open-window ;
|
||||
|
||||
: init-boids ( -- ) 50 random-boids >boids ;
|
||||
|
||||
|
|
@ -275,4 +275,4 @@ slate> "Boids" open-titled-window ;
|
|||
|
||||
: init ( -- ) init-slate init-variables init-world-size init-boids stop? off ;
|
||||
|
||||
PROVIDE: contrib/boids ;
|
||||
PROVIDE: apps/boids ;
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
! Simple IRC bot written in Factor.
|
||||
|
||||
REQUIRES: contrib/httpd ;
|
||||
REQUIRES: libs/httpd ;
|
||||
|
||||
USING: errors generic hashtables help html http io kernel math
|
||||
memory namespaces parser prettyprint sequences strings threads
|
||||
|
|
@ -76,7 +76,7 @@ M: ping handle-irc ( line -- )
|
|||
: factorbot-loop [ factorbot ] try 30000 sleep factorbot-loop ;
|
||||
|
||||
: multiline-respond ( string -- )
|
||||
<string-reader> lines [ respond ] each ;
|
||||
string-lines [ respond ] each ;
|
||||
|
||||
: object-href
|
||||
"http://factorcode.org" swap browser-link-href append ;
|
||||
|
|
@ -93,24 +93,16 @@ IN: factorbot-commands
|
|||
] [
|
||||
nip [
|
||||
dup summary " -- "
|
||||
rot object-href append3 respond
|
||||
rot object-href 3append respond
|
||||
] each
|
||||
] if ;
|
||||
|
||||
: memory ( text -- )
|
||||
drop [ room. ] string-out multiline-respond ;
|
||||
|
||||
: search ( text -- )
|
||||
search-help dup empty? [
|
||||
not-found
|
||||
] [
|
||||
first first dup article-title
|
||||
" -- " rot <link> object-href append3 respond
|
||||
] if ;
|
||||
|
||||
: quit ( text -- )
|
||||
drop speaker get "slava" = [ disconnect ] when ;
|
||||
|
||||
PROVIDE: examples/factorbot ;
|
||||
PROVIDE: apps/factorbot ;
|
||||
|
||||
MAIN: examples/factorbot factorbot ;
|
||||
MAIN: apps/factorbot factorbot ;
|
||||
|
|
@ -1,11 +1,3 @@
|
|||
----------------------------------------------------------------------
|
||||
Loading factory
|
||||
----------------------------------------------------------------------
|
||||
|
||||
Putting factory into your image is as simple as this:
|
||||
|
||||
"contrib/factory" require save
|
||||
|
||||
----------------------------------------------------------------------
|
||||
Running factory in Xnest
|
||||
----------------------------------------------------------------------
|
||||
|
|
@ -17,7 +9,7 @@ can use 2 or greater.
|
|||
|
||||
Start factor and launch factory on the appropriate display:
|
||||
|
||||
"contrib/factory" run-module
|
||||
"libs/factory" run-module
|
||||
|
||||
In a terminal, start an application on the appropriate display:
|
||||
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
REQUIRES: libs/process libs/concurrency libs/x11 libs/vars ;
|
||||
|
||||
PROVIDE: apps/factory { +files+ { "factory.factor" } } ;
|
||||
|
||||
USE: factory
|
||||
|
||||
MAIN: apps/factory f start-factory ;
|
||||
|
|
@ -0,0 +1,76 @@
|
|||
! Copyright (C) 2006 Chris Double. All Rights Reserved.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
IN: furnace:fjsc
|
||||
USING: kernel html furnace xml xml-writer io httpd sequences
|
||||
namespaces file-responder parser-combinators lazy-lists
|
||||
fjsc ;
|
||||
|
||||
: script ( path -- )
|
||||
#! given a path to a javascript file, output the
|
||||
#! script tag that references it.
|
||||
<script "text/javascript" =type =src script> </script> ;
|
||||
|
||||
: fjsc-page ( scripts title quot -- )
|
||||
#! Display a web page importing the given script
|
||||
#! tags and using the title. The body of the page
|
||||
#! is generated by calling the quotation.
|
||||
-rot xhtml-preamble
|
||||
chars>entities
|
||||
<html " xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"" write-html html>
|
||||
<head>
|
||||
<title> write </title>
|
||||
[ script ] each
|
||||
</head>
|
||||
<body>
|
||||
call
|
||||
</body>
|
||||
</html> ;
|
||||
|
||||
: fjsc-render ( template title -- )
|
||||
#! Render the fjsc page importing the required
|
||||
#! scripts.
|
||||
serving-html {
|
||||
"/responder/fjsc-resources/jquery.js"
|
||||
"/responder/fjsc-resources/bootstrap.js"
|
||||
} swap [
|
||||
[
|
||||
f swap render-template
|
||||
] fjsc-page
|
||||
] with-html-stream ;
|
||||
|
||||
: compile ( code -- )
|
||||
#! Compile the facor code as a string, outputting the http
|
||||
#! response containing the javascript.
|
||||
serving-text
|
||||
'expression' parse car parse-result-parsed fjsc-compile
|
||||
write flush ;
|
||||
|
||||
! The 'compile' action results in an URL that looks like
|
||||
! 'responder/fjsc/compile'. It takes one query or post
|
||||
! parameter called 'code'. It calls the 'compile' word
|
||||
! passing the parameter to it on the stack.
|
||||
\ compile {
|
||||
{ "code" v-required }
|
||||
} define-action
|
||||
|
||||
: repl ( -- )
|
||||
#! The main 'repl' page.
|
||||
f "repl" "Factor to Javascript REPL" fjsc-render ;
|
||||
|
||||
! An action called 'repl'
|
||||
\ repl { } define-action
|
||||
|
||||
! Create the web app, providing access
|
||||
! under '/responder/fjsc' which calls the
|
||||
! 'repl' action.
|
||||
"fjsc" "repl" "apps/furnace-fjsc" web-app
|
||||
|
||||
! An URL to the javascript resource files used by
|
||||
! the 'fjsc' responder.
|
||||
"fjsc-resources" [
|
||||
[
|
||||
"libs/fjsc/resources/" resource-path "doc-root" set
|
||||
file-responder
|
||||
] with-scope
|
||||
] add-simple-responder
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
! Copyright (C) 2006 Chris Double. All Rights Reserved.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
REQUIRES: libs/furnace libs/fjsc ;
|
||||
|
||||
PROVIDE: apps/furnace-fjsc
|
||||
{
|
||||
+files+ {
|
||||
"furnace-fjsc.factor"
|
||||
}
|
||||
} {
|
||||
+tests+ {
|
||||
}
|
||||
} ;
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
<table border="0">
|
||||
<tr><td valign="top">
|
||||
<p><b>Enter Factor Code Here</b></p>
|
||||
<form id="toeval" onsubmit="factor.server_eval($('#code').get(0).value);return false;" method="post">
|
||||
<textarea name="code" id="code" cols="64" rows="5">
|
||||
</textarea>
|
||||
<input type="submit" value="Compile"/>
|
||||
</form>
|
||||
<h3>Compiled Code</h3>
|
||||
<textarea id="compiled" cols="64" rows="3">
|
||||
</textarea>
|
||||
<p><b>Stack</b></p>
|
||||
<div id="stack">
|
||||
</div>
|
||||
<p><b>Playground</b></p>
|
||||
<div id="playground">
|
||||
</div>
|
||||
</td>
|
||||
<td valign="top">
|
||||
<p>More information on the Factor to Javascript compiler can be found at these blog posts:
|
||||
<ul>
|
||||
<li><a href="http://www.bluishcoder.co.nz/2006/12/compiling-factor-to-javascript.html">Factor to Javascript Compiler</a></li>
|
||||
<li><a href="http://www.bluishcoder.co.nz/2006/12/factor-to-javascript-compiler-updates.html">Factor to Javascript Compiler Updates</a></li>
|
||||
<li><a href="http://www.bluishcoder.co.nz/2006/12/continuations-added-to-fjsc.html">Continuations added to fjsc</a></li>
|
||||
<li><a href="http://www.bluishcoder.co.nz/2006/12/cross-domain-json-with-fjsc.html">Cross Domain JSON with fjsc</a></li>
|
||||
</ul>
|
||||
</p>
|
||||
<p>Some useful words:
|
||||
<dl>
|
||||
<dt>vocabs ( -- seq )</dt>
|
||||
<dd>Return a sequence of available vocabularies</dd>
|
||||
<dt>words ( string -- seq )</dt>
|
||||
<dd>Return a sequence of words in the given vocabulary</dd>
|
||||
<dt>all-words ( -- seq )</dt>
|
||||
<dd>Return a sequence of all words</dd>
|
||||
</dl>
|
||||
</p>
|
||||
<p>The contents of <a href="/responder/fjsc-resources/bootstrap.factor">bootstrap.factor</a> have been loaded on startup.</p>
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
! Copyright (C) 2006 Matthew Willis. All Rights Reserved.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
REQUIRES: libs/furnace libs/sqlite libs/calendar libs/crypto libs/farkup
|
||||
libs/basic-authentication ;
|
||||
|
||||
PROVIDE: apps/furnace-onigiri
|
||||
{ +files+ {
|
||||
"onigiri.factor"
|
||||
"onigiri.facts"
|
||||
} } ;
|
||||
|
|
@ -0,0 +1,278 @@
|
|||
! Copyright (C) 2006 Matthew Willis. All Rights Reserved.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
!
|
||||
USING: httpd threads kernel namespaces furnace sqlite tuple-db
|
||||
sequences html strings math hashtables crypto io file-responder calendar
|
||||
prettyprint parser errors sha2 basic-authentication ;
|
||||
|
||||
IN: furnace:onigiri
|
||||
|
||||
! start should be removed after doublec's responder-url hits the main repos
|
||||
SYMBOL: responder-url
|
||||
"/" responder-url set
|
||||
! end
|
||||
|
||||
TUPLE: entry title stub body created updated ;
|
||||
entry default-mapping set-mapping
|
||||
|
||||
: any-entry ( -- entry )
|
||||
! useful for tuple-db searching
|
||||
f f f f f <entry> ;
|
||||
|
||||
TUPLE: onigiri-meta value key ;
|
||||
onigiri-meta default-mapping set-mapping
|
||||
|
||||
TUPLE: user name password level ;
|
||||
user default-mapping set-mapping
|
||||
|
||||
DEFER: onigiri
|
||||
: setup-entries ( db-name -- )
|
||||
! create the entries table
|
||||
sqlite-open dup entry create-tuple-table sqlite-close ;
|
||||
|
||||
: setup-meta ( port db-name -- )
|
||||
! create the onigiri metadata table
|
||||
! the port data is necessary, all other data must be entered manually
|
||||
! until we get the CRUD interface
|
||||
sqlite-open [ onigiri-meta create-tuple-table ] keep
|
||||
swap dupd number>string "port" <onigiri-meta> save-tuple sqlite-close ;
|
||||
|
||||
: setup-users ( db-name -- )
|
||||
! create the users table, adding a default admin user with password admin
|
||||
sqlite-open dup user create-tuple-table dup
|
||||
"admin" dup string>sha-256-string over <user> save-tuple sqlite-close ;
|
||||
|
||||
: load-onigiri-meta ( -- )
|
||||
"db" \ onigiri get hash
|
||||
f f <onigiri-meta> find-tuples
|
||||
[
|
||||
dup onigiri-meta-value swap onigiri-meta-key
|
||||
\ onigiri get set-hash
|
||||
] each ;
|
||||
|
||||
: remove-onigiri-meta ( -- )
|
||||
! probably shouldn't use this directly
|
||||
"db" \ onigiri get hash dup f f <onigiri-meta> find-tuples
|
||||
[ delete-tuple ] each-with ;
|
||||
|
||||
: save-onigiri-meta ( -- )
|
||||
remove-onigiri-meta
|
||||
"db" \ onigiri get [ hash ] keep hash-keys
|
||||
[
|
||||
dup \ onigiri get hash dup string?
|
||||
[ swap <onigiri-meta> save-tuple ]
|
||||
[ 3drop ] if
|
||||
] each-with ;
|
||||
|
||||
: title>stub ( title -- stub )
|
||||
! creates a url friendly name based on the title
|
||||
" " split [ [ alpha? ] subset ] map "" swap remove "-" join ;
|
||||
|
||||
: action>url ( action -- url )
|
||||
responder-url get swap append ;
|
||||
|
||||
: stub>url ( stub -- url )
|
||||
"entry-show?entry=" swap append action>url ;
|
||||
|
||||
: stub>entry ( stub -- entry )
|
||||
[
|
||||
"db" \ onigiri get hash swap any-entry [ set-entry-stub ] keep
|
||||
find-tuples dup empty? [ drop f ] [ first ] if
|
||||
] [ f ] if* ;
|
||||
|
||||
: name>user ( name -- user )
|
||||
[
|
||||
"db" \ onigiri get hash swap f f <user> find-tuples
|
||||
dup empty? [ drop f ] [ first ] if
|
||||
] [ f ] if* ;
|
||||
|
||||
: key>meta ( key -- onigiri-meta )
|
||||
[
|
||||
"db" \ onigiri get hash f rot <onigiri-meta> find-tuples
|
||||
dup empty? [ drop f ] [ first ] if
|
||||
] [ f ] if* ;
|
||||
|
||||
: compose-entry ( title body-lines -- )
|
||||
"\n" join over title>stub swap
|
||||
millis number>string dup <entry>
|
||||
"db" \ onigiri get hash swap insert-tuple ;
|
||||
|
||||
: millis>timestamp ( millis -- timestamp )
|
||||
1000 /f seconds unix-1970 swap +dt ;
|
||||
|
||||
: atom ( -- )
|
||||
"text/xml" serving-content
|
||||
f "atom" render-template ;
|
||||
|
||||
: css-path ( -- path )
|
||||
! "text/css" serving-content
|
||||
"css" \ onigiri get hash [ "onigirihouse" ] unless*
|
||||
"apps/furnace-onigiri/resources/" swap ".css" 3append resource-path ;
|
||||
|
||||
: css ( -- )
|
||||
"text/css" serving-content css-path [
|
||||
[
|
||||
file-vocabs
|
||||
dup file set ! so that reload works properly
|
||||
dup <file-reader> contents write
|
||||
] with-scope
|
||||
] assert-depth drop ;
|
||||
|
||||
TUPLE: onigiri-layout title quot ;
|
||||
: onigiri-document ( title quot -- )
|
||||
<onigiri-layout> "front" render-template ;
|
||||
|
||||
: entry-list ( -- )
|
||||
"title" \ onigiri get hash
|
||||
serving-html [
|
||||
[
|
||||
"db" \ onigiri get hash any-entry find-tuples
|
||||
[ [ entry-created string>number ] 2apply <=> neg ] sort
|
||||
[ "entry" render-template ] each
|
||||
] onigiri-document
|
||||
] with-html-stream ;
|
||||
|
||||
: entry-show ( stub -- )
|
||||
stub>entry
|
||||
[
|
||||
dup "title" \ onigiri get hash
|
||||
" - " rot entry-title 3append swap
|
||||
serving-html [
|
||||
[
|
||||
"entry" render-template
|
||||
] curry onigiri-document
|
||||
] with-html-stream
|
||||
] [
|
||||
"title" \ onigiri get hash " - Entry not found" append
|
||||
serving-html [
|
||||
[ f "no-entry" render-template ] onigiri-document
|
||||
] with-html-stream
|
||||
] if* ;
|
||||
|
||||
: entry-edit ( stub -- )
|
||||
[
|
||||
any-entry [ set-entry-stub ] keep "db" \ onigiri get hash
|
||||
swap find-tuples dup length zero?
|
||||
[ drop any-entry "new entry"] [ first dup entry-title ] if
|
||||
] [ any-entry "new entry" ] if*
|
||||
"title" \ onigiri get hash " - editing " append swap append
|
||||
serving-html swap [
|
||||
[
|
||||
"edit" render-template
|
||||
] curry onigiri-document
|
||||
] with-html-stream ;
|
||||
|
||||
: entry-update ( body title stub -- )
|
||||
"onigiri-users" [
|
||||
[
|
||||
stub>entry [ any-entry ] unless*
|
||||
] [ any-entry over title>stub swap [ set-entry-stub ] keep ] if*
|
||||
[ set-entry-title ] keep
|
||||
[ CHAR: \r rot remove swap set-entry-body ] keep
|
||||
millis number>string swap [ set-entry-updated ] 2keep
|
||||
dup entry-created [ nip ] [ [ set-entry-created ] keep ] if
|
||||
"db" \ onigiri get hash swap [ save-tuple ] keep
|
||||
entry-stub "entry-show?entry=" swap append permanent-redirect
|
||||
] with-basic-authentication ;
|
||||
|
||||
: entry-delete ( stub -- )
|
||||
"onigiri-users" [
|
||||
stub>entry [
|
||||
"db" \ onigiri get hash swap delete-tuple
|
||||
] when*
|
||||
"entry-list" permanent-redirect
|
||||
] with-basic-authentication ;
|
||||
|
||||
: user-list ( -- )
|
||||
"onigiri-users" [
|
||||
serving-html [
|
||||
f "admin-header" render-template
|
||||
f "user-list" render-template
|
||||
f "admin-footer" render-template
|
||||
] with-html-stream
|
||||
] with-basic-authentication ;
|
||||
|
||||
: user-edit ( name -- )
|
||||
"onigiri-users" [
|
||||
serving-html [
|
||||
f "admin-header" render-template
|
||||
dup [ name>user nip ] when* "user-edit" render-template
|
||||
f "admin-footer" render-template
|
||||
] with-html-stream
|
||||
] with-basic-authentication ;
|
||||
|
||||
: user-update ( name password level -- )
|
||||
"onigiri-admin" [
|
||||
pick name>user
|
||||
[
|
||||
tuck set-user-level swap string>sha-256-string over
|
||||
set-user-password nip
|
||||
]
|
||||
[ swap string>sha-256-string swap <user> ] if*
|
||||
"db" \ onigiri get hash swap save-tuple
|
||||
"user-list" permanent-redirect
|
||||
] with-basic-authentication ;
|
||||
|
||||
: user-delete ( name -- )
|
||||
"onigiri-admin" [
|
||||
name>user [ "db" \ onigiri get hash swap delete-tuple ] when*
|
||||
"user-list" permanent-redirect
|
||||
] with-basic-authentication ;
|
||||
|
||||
: meta-list ( -- )
|
||||
"onigiri-users" [
|
||||
serving-html [
|
||||
f "admin-header" render-template
|
||||
f "meta-list" render-template
|
||||
f "admin-footer" render-template
|
||||
] with-html-stream
|
||||
] with-basic-authentication ;
|
||||
|
||||
: meta-update ( value key -- )
|
||||
"onigiri-admin" [
|
||||
\ onigiri get set-hash "meta-list" permanent-redirect
|
||||
] with-basic-authentication ;
|
||||
|
||||
: register-actions ( -- )
|
||||
\ entry-list { } define-action
|
||||
\ entry-show { { "entry" } } define-action
|
||||
\ entry-edit { { "entry" } } define-action
|
||||
\ entry-update { { "body" } { "title" } { "stub" } } define-action
|
||||
\ entry-delete { { "entry" } } define-action
|
||||
\ user-list { } define-action
|
||||
\ user-edit { { "name" } } define-action
|
||||
\ user-update { { "name" } { "password" } { "level" } } define-action
|
||||
\ user-delete { { "name" } } define-action
|
||||
\ meta-list { } define-action
|
||||
\ meta-update { { "value" } { "key" } } define-action
|
||||
\ atom { } define-action
|
||||
\ css { } define-action
|
||||
"onigiri" "entry-list" "apps/furnace-onigiri/templates/" web-app ;
|
||||
|
||||
: setup-onigiri ( port db-name -- )
|
||||
tuck setup-meta dup setup-entries setup-users ;
|
||||
|
||||
: stop-onigiri ( -- )
|
||||
! save metadata, close the db, remove the onigirihouse responder,
|
||||
! and if it was the default responder, make "file" the default responder
|
||||
save-onigiri-meta
|
||||
"db" \ onigiri get hash sqlite-close
|
||||
"onigiri" responders get remove-hash
|
||||
"responder" "default" responders get hash hash
|
||||
"onigiri" = [ "file" set-default-responder ] when ;
|
||||
|
||||
: onigiri ( db-name -- )
|
||||
! open the db, load metadata from the db, start httpd [optionally,
|
||||
! with onigiri as the default responder]
|
||||
H{ } clone \ onigiri set
|
||||
sqlite-open "db" \ onigiri get set-hash
|
||||
load-onigiri-meta register-actions
|
||||
"onigiri-as-default-responder" \ onigiri get hash "true" =
|
||||
[ "onigiri" set-default-responder ] when
|
||||
"port" \ onigiri get hash string>number [ httpd ] in-thread drop
|
||||
! add the onigiri users realm
|
||||
[ f <user> "db" \ onigiri get hash swap find-tuples empty? not ]
|
||||
"onigiri-users" add-realm
|
||||
! add the onigiri admins realm
|
||||
[ "admin" <user> "db" \ onigiri get hash swap find-tuples empty? not ]
|
||||
"onigiri-admin" add-realm ;
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
Better xhtml structure
|
||||
Adsense
|
||||
*UI for metadata
|
||||
Plugins
|
||||
Themes
|
||||
Recent posts sidebar
|
||||
Links sidebar
|
||||
Widgets (Onigirihouse feels ...)
|
||||
Tagging
|
||||
Pretty URL's
|
||||
Develop protocol for metadata and their defaults
|
||||
Use wiky to do client-side wikistyle
|
||||
Change furnace to /controller/action/argument1/argument2/.../ style
|
||||
Have posts correlated with users
|
||||
Figure out which user is logged in from inside an action
|
||||
|
||||
----DONE-----
|
||||
|
||||
by 12/31/2006
|
||||
Atom
|
||||
Individual post pages
|
||||
Timestamping and ordering
|
||||
Rename onigirihouse => onigiri
|
||||
Store blog metadata in db
|
||||
Markdown for entries
|
||||
Make Atom feed validate (Add id, updated to atom)
|
||||
Store URL
|
||||
UI for posting
|
||||
Posting interface
|
||||
Switch to plug-in CSS
|
||||
|
||||
1/1/07
|
||||
Stopped using farkup (for now)
|
||||
Moved to controller-action naming convention
|
||||
|
||||
1/2/07
|
||||
Added Users
|
||||
Added CRUD for Users, multiple levels of users
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
body { font: 14px "Trebuchet MS", Arial, Helvetica, sans-serif; }
|
||||
h1, h2, h3, h4, h5, h6 { font-family: lucida grande ; }
|
||||
#header { text-align: center ; }
|
||||
#container { max-width: 720px ; margin: 0 auto; padding: 20px; }
|
||||
.entry { margin-bottom: 75px ; }
|
||||
a { color: #5C832F; text-decoration: none; }
|
||||
a:hover { text-decoration: underline; }
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
</div>
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
<?xml version="1.0"?><!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
|
||||
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
|
||||
<head>
|
||||
<% USING: namespaces io kernel hashtables furnace:onigiri furnace ; %>
|
||||
<title>Onigiri Admin</title>
|
||||
<link rel='stylesheet' type='text/css' href='<% "css" action>url write %>'/>
|
||||
</head>
|
||||
<body>
|
||||
|
||||
<div id="header">
|
||||
<h1><% "title" \ onigiri get hash write %> Admin</h1>
|
||||
<p><a href="<% "entry-list" action>url write %>">Main Page</a> | <a href="<% "entry-edit" action>url write %>">Post</a> | <a href="<% "meta-list" action>url write %>">Meta</a> | <a href="<% "user-list" action>url write %>">Users</a></p>
|
||||
</div>
|
||||
|
||||
<div id="container">
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
<% USING: io namespaces hashtables furnace:onigiri ; %>
|
||||
|
||||
<script src="http://www.google-analytics.com/urchin.js" type="text/javascript">
|
||||
</script>
|
||||
<script type="text/javascript">
|
||||
_uacct = "<% "analytics" \ onigiri get hash write %>";
|
||||
urchinTracker();
|
||||
</script>
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<feed xmlns="http://www.w3.org/2005/Atom">
|
||||
<% USING: io namespaces httpd furnace:onigiri tuple-db
|
||||
math kernel sequences hashtables html calendar ; %>
|
||||
<title><% "title" \ onigiri get hash write %></title>
|
||||
<link rel="self" href="<% "atom" action>url write %>"/>
|
||||
<author>
|
||||
<name><% "author" \ onigiri get hash write %></name>
|
||||
</author>
|
||||
<id><% "atom" action>url write %></id>
|
||||
<% "db" \ onigiri get hash any-entry find-tuples
|
||||
[ [ entry-updated string>number ] 2apply <=> neg ] sort
|
||||
dup empty? [ %>
|
||||
<updated><% dup first entry-updated string>number millis>timestamp timestamp>rfc3339 write %></updated><% ] unless
|
||||
[ [ entry-created string>number ] 2apply <=> neg ] sort
|
||||
[ %>
|
||||
<entry>
|
||||
<title><% dup entry-title write %></title>
|
||||
<id><% dup entry-stub stub>url dup write %></id>
|
||||
<updated><% over entry-updated string>number millis>timestamp timestamp>rfc3339 write %></updated>
|
||||
<link href="<% write %>"/>
|
||||
<summary><% entry-body write %></summary>
|
||||
</entry><% ] each %>
|
||||
</feed>
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
<% USING: namespaces io kernel sequences furnace:onigiri ; %>
|
||||
|
||||
<form method="post" action="entry-update">
|
||||
<% "stub" get [ %><input type="hidden" name="stub" value="<% "stub" get write %>"/><% ] when %>
|
||||
<table><tr><td>Title:</td><td><input type="text" name="title" value="<% "title" get write %>"/></td></tr>
|
||||
<tr><td>Body:</td><td><textarea rows="15" cols="80" name="body"><% "body" get write %></textarea></td></tr>
|
||||
<tr><td><input type="submit" name="post" value="<% "stub" get "update" "post" ? write %>"/></td><% "stub" get [ %><td><a href="<% "entry-delete?entry=" "stub" get append action>url write %>">Delete</a></td><% ] when %></tr>
|
||||
</table>
|
||||
</form>
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
<% USING: furnace:onigiri io namespaces math calendar html kernel ; %>
|
||||
|
||||
<div class="entry">
|
||||
<h2><a href="<% "stub" get stub>url write %>"><% "title" get write %></a></h2>
|
||||
|
||||
<p>posted <% "created" get string>number 1000 /f seconds
|
||||
unix-1970 swap +dt >local-time timestamp>string write %> <a href="entry-edit?entry=<% "stub" get write %>">(edit)</a></p>
|
||||
|
||||
<% "body" get write-html %>
|
||||
</div>
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
<?xml version="1.0"?><!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
|
||||
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
|
||||
<head>
|
||||
<% USING: namespaces io kernel hashtables furnace:onigiri furnace ; %>
|
||||
<title><% "title" get write %></title>
|
||||
<link rel='stylesheet' type='text/css' href='<% "css" action>url write %>'/>
|
||||
<script type='text/javascript' src='/responder/resources/prototype.js'></script>
|
||||
</head>
|
||||
<body>
|
||||
|
||||
<div id="header">
|
||||
<h1><a href="<% "entry-list" action>url write %>"><% "title" \ onigiri get hash write %></a></h1>
|
||||
|
||||
<p>Proudly running on <a href="http://factorcode.org">Factor <% version write %></a></p>
|
||||
|
||||
<p><a href="http://validator.w3.org/check?uri=referer">Valid XHTML 1.0 Strict</a> | <a href="<% "atom" action>url write %>">Subscribe to <% "title" \ onigiri get hash write %></a> | <a href="<% "user-list" action>url write %>">Admin</a> | <a href="<% "entry-edit" action>url write %>">Post</a></p>
|
||||
</div>
|
||||
|
||||
<div id="container">
|
||||
<% "quot" get call %>
|
||||
|
||||
<% "analytics" \ onigiri get hash [ f "analytics" render-template ] when %>
|
||||
</div>
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
<% USING: furnace:onigiri namespaces hashtables sequences kernel strings io ; %>
|
||||
|
||||
<h3>Add/Change Onigiri Metadata</h3>
|
||||
|
||||
<table>
|
||||
<tr><th>Key</th><th>Value</th></tr>
|
||||
|
||||
<form action="meta-update" method="post">
|
||||
<tr><td><input type="text" name="key"/></td><td><input type="text" name="value"/></td><td><input type="submit" name="update" value="update"/></td></tr>
|
||||
</form>
|
||||
|
||||
<% \ onigiri get hash-keys [ %>
|
||||
|
||||
<% dup \ onigiri get hash dup string? [ %>
|
||||
|
||||
<tr><td><% swap write %></td><td><% write %></td></tr>
|
||||
|
||||
<% ] [ 2drop ] if %>
|
||||
|
||||
<% ] each %>
|
||||
|
||||
</table>
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
<% USING: furnace:onigiri io hashtables namespaces ; %>
|
||||
|
||||
<p>The entry you are searching for could not be found.</p>
|
||||
|
||||
<p><a href="<% "" action>url write %>">Back to <% "title" \ onigiri get hash write %></a></p>
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
<% USING: furnace:onigiri namespaces io kernel ; %>
|
||||
|
||||
<form action="<% "user-update" action>url write %>" method=post>
|
||||
<table>
|
||||
<tr><td>Name:</td><td><input type="text" name="name" value="<% "name" get write %>"/></td></tr>
|
||||
<tr><td>Password:</td><td><input type="password" name="password"/></td></tr>
|
||||
|
||||
<tr><td>Level:</td>
|
||||
<td><select name="level">
|
||||
<option value="user" <% "level" get "user" = [ "selected" write ] when %>>User</option>
|
||||
<option value="admin" <% "level" get "admin" = [ "selected" write ] when %>>Admin</option></select></td></tr>
|
||||
|
||||
<tr><td><input type="submit" name="submit" value="submit"/></td></tr>
|
||||
</table>
|
||||
</form>
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
<% USING: furnace:onigiri namespaces io hashtables tuple-db kernel sequences ; %>
|
||||
|
||||
<table>
|
||||
<tr><th>Name</th><th>Level</th></tr>
|
||||
|
||||
<% "db" \ onigiri get hash f f f <user> find-tuples [ %>
|
||||
<tr><td><% dup user-name write %></td>
|
||||
<td><% dup user-level write %></td>
|
||||
<td><a href="<% dup user-name "user-edit?name=" swap append action>url write %>">edit</a></td>
|
||||
<td><a href="<% user-name "user-delete?name=" swap append action>url write %>">delete</a></td></tr>
|
||||
<% ] each %>
|
||||
|
||||
</table>
|
||||
|
||||
<p><a href="<% "user-edit" action>url write %>">Add New User</a></p>
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
REQUIRES: libs/furnace ;
|
||||
|
||||
PROVIDE: apps/furnace-pastebin
|
||||
{ +files+ { "pastebin.factor" } } ;
|
||||
|
|
@ -72,4 +72,4 @@ C: pastebin ( -- pastebin )
|
|||
|
||||
\ annotate-paste [ "n" show-paste ] define-redirect
|
||||
|
||||
"pastebin" "paste-list" "contrib/furnace-pastebin" web-app
|
||||
"pastebin" "paste-list" "apps/furnace-pastebin" web-app
|
||||
|
|
@ -0,0 +1,115 @@
|
|||
! Copyright (C) 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: help-lint
|
||||
USING: sequences parser kernel errors help words modules strings
|
||||
namespaces io prettyprint tools definitions generic ;
|
||||
|
||||
! A quick and dirty tool to check documentation in an automated
|
||||
! fashion.
|
||||
|
||||
! - ensures examples run and produce stated output
|
||||
! - ensures $see-also elements don't contain duplicate entries
|
||||
! (I always make this mistake!)
|
||||
! - ensures $module-link elements point to modules which
|
||||
! actually exist
|
||||
! - ensures that $values match the stack effect declaration
|
||||
! - ensures that word help articles render (this catches broken
|
||||
! links, improper nesting, etc)
|
||||
|
||||
: check-example ( element -- )
|
||||
1 tail
|
||||
[ 1 head* "\n" join eval>string "\n" ?tail drop ] keep
|
||||
peek assert= ;
|
||||
|
||||
: check-examples ( word element -- )
|
||||
nip \ $example swap elements [ check-example ] each ;
|
||||
|
||||
: extract-values ( element -- seq )
|
||||
\ $values swap elements dup empty? [
|
||||
drop { }
|
||||
] [
|
||||
first 1 tail [ first ] map prune natural-sort
|
||||
] if ;
|
||||
|
||||
: effect-values ( word -- seq )
|
||||
stack-effect dup effect-in swap effect-out
|
||||
append [ string? ] subset prune natural-sort ;
|
||||
|
||||
: check-values ( word element -- )
|
||||
\ $shuffle over elements empty?
|
||||
\ $values-x/y over elements empty? not and
|
||||
pick "declared-effect" word-prop and [
|
||||
extract-values >r effect-values r> assert=
|
||||
] [
|
||||
2drop
|
||||
] if ;
|
||||
|
||||
: check-see-also ( word element -- )
|
||||
nip \ $see-also swap elements [
|
||||
1 tail dup prune [ length ] 2apply assert=
|
||||
] each ;
|
||||
|
||||
: check-modules ( word element -- )
|
||||
nip \ $module-link swap elements [
|
||||
second
|
||||
\ available-modules get member?
|
||||
[ "Missing module" throw ] unless
|
||||
] each ;
|
||||
|
||||
: check-rendering ( word element -- )
|
||||
drop [ help ] string-out drop ;
|
||||
|
||||
: all-word-help ( -- seq )
|
||||
all-words [ word-help ] subset ;
|
||||
|
||||
TUPLE: word-help-error word ;
|
||||
|
||||
C: word-help-error
|
||||
[ set-delegate ] keep
|
||||
[ set-word-help-error-word ] keep ;
|
||||
|
||||
DEFER: check-help
|
||||
|
||||
: fix-help ( error -- )
|
||||
dup delegate error.
|
||||
word-help-error-word <link> edit
|
||||
"Press ENTER when done." print flush readln drop
|
||||
reload-modules
|
||||
check-help ;
|
||||
|
||||
: check-1 ( word -- )
|
||||
[
|
||||
dup word-help [
|
||||
2dup check-examples
|
||||
2dup check-values
|
||||
2dup check-see-also
|
||||
2dup check-modules
|
||||
2dup check-rendering
|
||||
] assert-depth 2drop
|
||||
] [
|
||||
<word-help-error> throw
|
||||
] recover ;
|
||||
|
||||
: check-help ( -- )
|
||||
[
|
||||
[
|
||||
available-modules [ module-name ] map
|
||||
\ available-modules set
|
||||
all-word-help [ check-1 ] each
|
||||
] with-scope
|
||||
] [
|
||||
fix-help check-help
|
||||
] recover ;
|
||||
|
||||
: unlinked-words ( -- seq )
|
||||
all-word-help [ parents empty? ] subset ;
|
||||
|
||||
: linked-undocumented-words ( -- seq )
|
||||
all-words
|
||||
[ word-help not ] subset
|
||||
[ parents empty? not ] subset
|
||||
[ "predicating" word-prop not ] subset ;
|
||||
|
||||
PROVIDE: apps/help-lint ;
|
||||
|
||||
MAIN: apps/help-lint check-help ;
|
||||
|
|
@ -1,4 +1,5 @@
|
|||
USING: io kernel math namespaces prettyprint sequences strings ;
|
||||
USING: arrays io kernel math namespaces prettyprint sequences
|
||||
strings ;
|
||||
IN: hexdump-internals
|
||||
|
||||
: header. ( len -- )
|
||||
|
|
@ -8,7 +9,7 @@ IN: hexdump-internals
|
|||
: h-pad. ( digit -- ) >hex 2 CHAR: 0 pad-left write ;
|
||||
: line. ( str n -- )
|
||||
offset. [ [ h-pad. " " write ] each ] keep
|
||||
16 over length - [ " " write ] times
|
||||
16 over length - " " <array> concat write
|
||||
[ dup printable? [ drop CHAR: . ] unless ch>string write ] each
|
||||
terpri ;
|
||||
|
||||
|
|
@ -1,3 +1,3 @@
|
|||
PROVIDE: contrib/hexdump
|
||||
PROVIDE: apps/hexdump
|
||||
{ +files+ { "hexdump.factor" } }
|
||||
{ +tests+ { "test/hexdump.factor" } } ;
|
||||
|
|
@ -1,12 +1,12 @@
|
|||
! Eduardo Cavazos - wayo.cavazos@gmail.com
|
||||
|
||||
REQUIRES: contrib/math
|
||||
contrib/vars
|
||||
contrib/slate
|
||||
contrib/lindenmayer/opengl
|
||||
contrib/lindenmayer/turtle
|
||||
contrib/lindenmayer/camera
|
||||
contrib/lindenmayer/camera-slate ;
|
||||
REQUIRES: libs/math
|
||||
libs/vars
|
||||
libs/slate
|
||||
apps/lindenmayer/opengl
|
||||
apps/lindenmayer/turtle
|
||||
apps/lindenmayer/camera
|
||||
apps/lindenmayer/camera-slate ;
|
||||
|
||||
USING: kernel alien namespaces arrays vectors math opengl sequences threads
|
||||
hashtables strings gadgets
|
||||
|
|
@ -294,7 +294,7 @@ reset-turtle
|
|||
: init-slate ( -- )
|
||||
<camera-slate> >slate
|
||||
namespace slate> set-slate-ns
|
||||
slate> "L-system" open-titled-window
|
||||
slate> "L-system" open-window
|
||||
[ display ] >action ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
PROVIDE: apps/lindenmayer
|
||||
{ +files+ { "lindenmayer.factor" } } ;
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
REQUIRES: contrib/alien ;
|
||||
REQUIRES: libs/alien ;
|
||||
USING: kernel sequences opengl alien-contrib ;
|
||||
IN: opengl-contrib
|
||||
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
REQUIRES: contrib/math contrib/vars ;
|
||||
REQUIRES: libs/math libs/vars ;
|
||||
USING: kernel math namespaces sequences arrays math-contrib vars ;
|
||||
IN: turtle
|
||||
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
IN: lisppaste
|
||||
REQUIRES: libs/xml-rpc ;
|
||||
USING: arrays kernel xml-rpc ;
|
||||
|
||||
: url "http://www.common-lisp.net:8185/RPC2" ;
|
||||
|
||||
: channels ( -- seq )
|
||||
{ } "listchannels" url invoke-method ;
|
||||
|
||||
: lisppaste ( seq -- response )
|
||||
! seq is { channel user title contents }
|
||||
! or { channel user title contents annotation-number }
|
||||
"newpaste" url invoke-method ;
|
||||
|
||||
PROVIDE: apps/lisppaste ;
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
PROVIDE: examples/mandel
|
||||
PROVIDE: apps/mandel
|
||||
{ +files+ { "mandel.factor" } }
|
||||
{ +tests+ { "tests.factor" } } ;
|
||||
|
||||
USE: mandel
|
||||
USE: test
|
||||
|
||||
MAIN: examples/mandel [ "mandel.pnm" run>file ] time ;
|
||||
MAIN: apps/mandel [ "mandel.pnm" run>file ] time ;
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
REQUIRES: libs/lazy-lists libs/shuffle ;
|
||||
PROVIDE: apps/random-tester
|
||||
{ +files+ {
|
||||
"utils.factor"
|
||||
"random.factor"
|
||||
"random-tester.factor"
|
||||
"random-tester2.factor"
|
||||
"type.factor"
|
||||
} } ;
|
||||
|
|
@ -105,10 +105,6 @@ IN: random-tester
|
|||
: 2-complex>complex { * + - /f } ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
SYMBOL: last-quot
|
||||
SYMBOL: first-arg
|
||||
SYMBOL: second-arg
|
||||
|
|
@ -178,10 +174,10 @@ SYMBOL: second-arg
|
|||
|
||||
|
||||
! RANDOM QUOTATIONS TO TEST
|
||||
: random-1-integer>x-quot ( -- quot ) 1-integer>x nth-rand unit ;
|
||||
: random-1-ratio>x-quot ( -- quot ) 1-ratio>x nth-rand unit ;
|
||||
: random-1-float>x-quot ( -- quot ) 1-float>x nth-rand unit ;
|
||||
: random-1-complex>x-quot ( -- quot ) 1-complex>x nth-rand unit ;
|
||||
: random-1-integer>x-quot ( -- quot ) 1-integer>x pick-one unit ;
|
||||
: random-1-ratio>x-quot ( -- quot ) 1-ratio>x pick-one unit ;
|
||||
: random-1-float>x-quot ( -- quot ) 1-float>x pick-one unit ;
|
||||
: random-1-complex>x-quot ( -- quot ) 1-complex>x pick-one unit ;
|
||||
|
||||
: test-1-integer>x ( -- )
|
||||
random-integer random-1-integer>x-quot 1-interpreted-vs-compiled-check ;
|
||||
|
|
@ -193,18 +189,18 @@ SYMBOL: second-arg
|
|||
random-complex random-1-complex>x-quot 1-interpreted-vs-compiled-check ;
|
||||
|
||||
|
||||
: random-1-float>float-quot ( -- obj ) 1-float>float nth-rand unit ;
|
||||
: random-2-float>float-quot ( -- obj ) 2-float>float nth-rand unit ;
|
||||
: random-1-float>float-quot ( -- obj ) 1-float>float pick-one unit ;
|
||||
: random-2-float>float-quot ( -- obj ) 2-float>float pick-one unit ;
|
||||
: nrandom-2-float>float-quot ( -- obj )
|
||||
[
|
||||
5
|
||||
[
|
||||
{
|
||||
[ 2-float>float nth-rand , random-float , ]
|
||||
[ 1-float>float nth-rand , ]
|
||||
[ 2-float>float pick-one , random-float , ]
|
||||
[ 1-float>float pick-one , ]
|
||||
} do-one
|
||||
] times
|
||||
2-float>float nth-rand ,
|
||||
2-float>float pick-one ,
|
||||
] [ ] make ;
|
||||
|
||||
: test-1-float>float ( -- )
|
||||
|
|
@ -220,8 +216,8 @@ SYMBOL: second-arg
|
|||
: test-1-integer>x-runtime ( -- )
|
||||
random-integer random-1-integer>x-quot 1-runtime-check ;
|
||||
|
||||
: random-1-integer>x-throws-quot ( -- obj ) 1-integer>x-throws nth-rand unit ;
|
||||
: random-1-ratio>x-throws-quot ( -- obj ) 1-ratio>x-throws nth-rand unit ;
|
||||
: random-1-integer>x-throws-quot ( -- obj ) 1-integer>x-throws pick-one unit ;
|
||||
: random-1-ratio>x-throws-quot ( -- obj ) 1-ratio>x-throws pick-one unit ;
|
||||
: test-1-integer>x-throws ( -- obj )
|
||||
random-integer random-1-integer>x-throws-quot
|
||||
1-interpreted-vs-compiled-check-catch ;
|
||||
|
|
@ -234,16 +230,9 @@ SYMBOL: second-arg
|
|||
: test-2-integer>x-throws ( -- )
|
||||
[
|
||||
random-integer , random-integer ,
|
||||
2-x>y-throws nth-rand ,
|
||||
2-x>y-throws pick-one ,
|
||||
] [ ] make 2-interpreted-vs-compiled-check-catch ;
|
||||
|
||||
! : test-^-shift ( -- )
|
||||
! [
|
||||
! 100 random-int 50 - ,
|
||||
! 100 random-int 50 - ,
|
||||
! { ^ shift } nth-rand ,
|
||||
! ] [ ] make 2-interpreted-vs-compiled-check-catch ;
|
||||
|
||||
! : test-^-ratio ( -- )
|
||||
! [
|
||||
! random-ratio , random-ratio , \ ^ ,
|
||||
|
|
@ -251,27 +240,27 @@ SYMBOL: second-arg
|
|||
|
||||
: test-0-float?-when
|
||||
[
|
||||
random-number , \ dup , \ float? , 1-float>x nth-rand unit , \ when ,
|
||||
random-number , \ dup , \ float? , 1-float>x pick-one unit , \ when ,
|
||||
] [ ] make 0-runtime-check ;
|
||||
|
||||
: test-1-integer?-when
|
||||
random-integer [
|
||||
\ dup , \ integer? , 1-integer>x nth-rand unit , \ when ,
|
||||
\ dup , \ integer? , 1-integer>x pick-one unit , \ when ,
|
||||
] [ ] make 1-interpreted-vs-compiled-check ;
|
||||
|
||||
: test-1-ratio?-when
|
||||
random-ratio [
|
||||
\ dup , \ ratio? , 1-ratio>x nth-rand unit , \ when ,
|
||||
\ dup , \ ratio? , 1-ratio>x pick-one unit , \ when ,
|
||||
] [ ] make 1-interpreted-vs-compiled-check ;
|
||||
|
||||
: test-1-float?-when
|
||||
random-float [
|
||||
\ dup , \ float? , 1-float>x nth-rand unit , \ when ,
|
||||
\ dup , \ float? , 1-float>x pick-one unit , \ when ,
|
||||
] [ ] make 1-interpreted-vs-compiled-check ;
|
||||
|
||||
: test-1-complex?-when
|
||||
random-complex [
|
||||
\ dup , \ complex? , 1-complex>x nth-rand unit , \ when ,
|
||||
\ dup , \ complex? , 1-complex>x pick-one unit , \ when ,
|
||||
] [ ] make 1-interpreted-vs-compiled-check ;
|
||||
|
||||
|
||||
|
|
@ -308,5 +297,5 @@ SYMBOL: second-arg
|
|||
test-1-complex?-when
|
||||
! full-gc
|
||||
! code-gc
|
||||
} nth-rand dup . execute terpri ;
|
||||
} pick-one dup . execute terpri ;
|
||||
|
||||
|
|
@ -0,0 +1,163 @@
|
|||
USING: compiler errors inference interpreter io
|
||||
kernel math memory namespaces prettyprint random-tester
|
||||
sequences tools words ;
|
||||
USING: arrays definitions generic graphs hashtables ;
|
||||
IN: random-tester2
|
||||
|
||||
SYMBOL: wordbank
|
||||
: w1
|
||||
{
|
||||
die
|
||||
set-walker-hook exit
|
||||
|
||||
xref-words
|
||||
|
||||
times repeat (repeat)
|
||||
supremum infimum assoc rassoc norm-sq
|
||||
product sum curry remove-all member? subseq?
|
||||
|
||||
(next-power-of-2) (^) d>w/w w>h/h millis
|
||||
(random-int) ^n integer, first-bignum
|
||||
most-positive-fixnum ^ init-random next-power-of-2
|
||||
most-negative-fixnum
|
||||
|
||||
clear-hash build-graph
|
||||
|
||||
>r r>
|
||||
|
||||
set-callstack set-word set-word-prop
|
||||
set-catchstack set-namestack set-retainstack
|
||||
set-continuation-retain continuation-catch
|
||||
set-continuation-name catchstack retainstack
|
||||
set-no-math-method-generic
|
||||
set-no-math-method-right
|
||||
set-check-method-class
|
||||
set-check-create-name
|
||||
set-nested-style-stream-style
|
||||
set-pathname-string
|
||||
set-check-create-vocab
|
||||
<check-create> check-create?
|
||||
reset-generic forget-class
|
||||
create forget-word forget-vocab forget forget-tuple
|
||||
remove-word-prop empty-method
|
||||
continue-with <continuation>
|
||||
|
||||
define-compound define make-generic
|
||||
define-method define-predicate-class
|
||||
define-tuple define-temp define-tuple-slots
|
||||
define-writer define-predicate define-generic
|
||||
?make-generic define-reader define-slot define-slots
|
||||
define-typecheck define-slot-word define-union
|
||||
define-generic* with-methods define-constructor
|
||||
predicate-word condition-continuation define-symbol
|
||||
|
||||
ndrop
|
||||
|
||||
set-word-def set-word-name
|
||||
set-word-props set-word-primitive
|
||||
|
||||
stdio
|
||||
close readln (readln) read1 read with-server
|
||||
stream-read stream-readln stream-read1 lines (lines)
|
||||
contents stream-copy stream-flush
|
||||
stream-format set-line-reader-cr
|
||||
|
||||
double>bits float>bits >bignum
|
||||
|
||||
intern-slots class-predicates delete (delete) prune memq?
|
||||
normalize norm vneg vmax vmin v- v+ [v-]
|
||||
|
||||
bin> oct> le> be> hex> string>number
|
||||
|
||||
gensym random-int counter <byte-array>
|
||||
<word> <client-stream> <server> <client>
|
||||
<duplex-stream> <file-writer> <file-reader> ! <file-r/w>
|
||||
init-namespaces unxref-word set-global set off on
|
||||
nest
|
||||
set-restart-obj
|
||||
+@ inc dec
|
||||
|
||||
changed-words
|
||||
callstack namespace namestack global vocabularies
|
||||
|
||||
path+ parent-dir
|
||||
|
||||
.s . word-xt.
|
||||
|
||||
<continuation> continue-with
|
||||
set-delegate
|
||||
|
||||
closure
|
||||
|
||||
tabular-output simple-slots
|
||||
|
||||
join concat (group)
|
||||
}
|
||||
{ "arrays" "errors" "generic" "graphs" "hashtables" "io"
|
||||
"kernel" "math" "namespaces"
|
||||
"queues" "strings" "sequences" "vectors" "words" }
|
||||
[ words ] map concat diff ;
|
||||
|
||||
w1 wordbank set-global
|
||||
|
||||
: databank
|
||||
{
|
||||
! V{ } H{ } V{ 3 } { 3 } { } "" "asdf"
|
||||
pi 1/0. -1/0. 0/0. [ ]
|
||||
f t "" 0 0.0 3.14 2 -3 -7 20 3/4 -3/4 1.2/3 3.5
|
||||
C{ 2 2 } C{ 1/0. 1/0. }
|
||||
} ;
|
||||
|
||||
: setup-test ( #data #code -- data... quot )
|
||||
#! variable stack effect
|
||||
>r [ databank pick-one ] times r>
|
||||
[ drop wordbank get pick-one ] map >quotation ;
|
||||
|
||||
SYMBOL: before
|
||||
SYMBOL: after
|
||||
SYMBOL: quot
|
||||
SYMBOL: err
|
||||
err off
|
||||
|
||||
: test-compiler ( data... quot -- ... )
|
||||
err off
|
||||
dup quot set
|
||||
datastack clone dup pop* before set
|
||||
[ call ] catch drop datastack clone after set
|
||||
clear
|
||||
before get [ ] each
|
||||
quot get [ compile-1 ] [ err on ] recover ;
|
||||
|
||||
: do-test ( data... quot -- )
|
||||
.s flush test-compiler
|
||||
err get [
|
||||
datastack after get 2dup = [
|
||||
2drop
|
||||
] [
|
||||
[ . ] each
|
||||
"--" print
|
||||
[ . ] each quot get .
|
||||
"not =" throw
|
||||
] if
|
||||
] unless
|
||||
clear ;
|
||||
|
||||
: random-test ( #data #code -- )
|
||||
setup-test do-test ;
|
||||
|
||||
: run-random-tester2
|
||||
100000000000000 [ 6 3 random-test ] times ;
|
||||
|
||||
|
||||
! A worthwhile test that has not been run extensively
|
||||
1000 [ drop gensym ] map "syms" set
|
||||
|
||||
: pick-one [ length random-int ] keep nth ;
|
||||
|
||||
: fooify-test
|
||||
"syms" get pick-one
|
||||
2000 random-int >quotation
|
||||
over set-word-def
|
||||
100 random-int zero? [ code-gc ] when
|
||||
compile fooify-test ;
|
||||
|
||||
|
|
@ -22,7 +22,7 @@ IN: random-tester
|
|||
random-int 2 swap ^ random-int ;
|
||||
|
||||
: random-seq ( -- seq )
|
||||
{ [ ] { } V{ } "" } nth-rand
|
||||
{ [ ] { } V{ } "" } pick-one
|
||||
[ max-length random-int [ max-value random-int , ] times ] swap make ;
|
||||
|
||||
: random-string
|
||||
|
|
@ -56,7 +56,7 @@ SYMBOL: special-complexes
|
|||
coin-flip [
|
||||
random-fixnum
|
||||
] [
|
||||
coin-flip [ random-bignum ] [ special-integers nth-rand ] if
|
||||
coin-flip [ random-bignum ] [ special-integers pick-one ] if
|
||||
] if ;
|
||||
|
||||
: random-positive-integer ( -- int )
|
||||
|
|
@ -70,7 +70,7 @@ SYMBOL: special-complexes
|
|||
1000000000 dup [ random-int ] 2apply 1+ / coin-flip [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ;
|
||||
|
||||
: random-float ( -- float )
|
||||
coin-flip [ random-ratio ] [ special-floats nth-rand ] if
|
||||
coin-flip [ random-ratio ] [ special-floats pick-one ] if
|
||||
coin-flip
|
||||
[ .0000000000000000001 /f ] [ coin-flip [ .00000000000000001 * ] when ] if
|
||||
>float ;
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
USING: errors generic io kernel lazy-lists math memory namespaces
|
||||
prettyprint random-tester2 sequences tools words ;
|
||||
IN: random-tester
|
||||
|
||||
: inert ;
|
||||
TUPLE: inert-object ;
|
||||
|
||||
: inputs ( -- seq )
|
||||
{
|
||||
0 -1 -1000000000000000000000000
|
||||
! -268435457
|
||||
inert
|
||||
! T{ inert-object f }
|
||||
-29/2 1000000000000000000000000000000/1111111111111111111111111111111111111111111
|
||||
3/4
|
||||
-1000000000000000000000000/111111111111111111
|
||||
-3.14 1/0. 0.0 -1/0. 3.14 0/0.
|
||||
C{ 1 -1 }
|
||||
W{ 55 }
|
||||
{ }
|
||||
f t
|
||||
H{ }
|
||||
V{ 1 0 65536 }
|
||||
""
|
||||
SBUF" "
|
||||
[ ]
|
||||
! DLL" libm.dylib"
|
||||
! ALIEN: 1
|
||||
T{ inert-object f }
|
||||
} ;
|
||||
|
||||
: word-inputs ( word -- seq )
|
||||
[ stack-effect effect-in length ] [ drop 0 ] recover
|
||||
inputs swap ;
|
||||
|
||||
: type-error? ( exception -- ? )
|
||||
[ swap execute or ] curry
|
||||
>r { no-method? no-math-method? } f r> reduce ;
|
||||
|
||||
: maybe-explode
|
||||
dup sequence? [ [ ] each ] when ; inline
|
||||
|
||||
TUPLE: success quot inputs outputs ;
|
||||
|
||||
SYMBOL: err
|
||||
SYMBOL: type-error
|
||||
SYMBOL: params
|
||||
SYMBOL: last-time
|
||||
SYMBOL: quot
|
||||
: throws? ( data... quot -- ? )
|
||||
dup quot set
|
||||
err off type-error off
|
||||
>r
|
||||
dup clone params set
|
||||
maybe-explode
|
||||
r>
|
||||
! .s flush
|
||||
dup last-time get = [ dup . flush dup last-time set ] unless
|
||||
[ call ] [ err on ] recover
|
||||
err get [
|
||||
dup type-error? dup [
|
||||
! .s
|
||||
] unless
|
||||
type-error set
|
||||
] [
|
||||
datastack clone >r quot get params get r> <success>
|
||||
,
|
||||
] if clear type-error get ;
|
||||
|
||||
: test-inputs ( word -- seq )
|
||||
[
|
||||
[ word-inputs ] keep
|
||||
unit [
|
||||
throws? not clear
|
||||
] curry each-permutation
|
||||
] { } make ;
|
||||
|
||||
: (test1)
|
||||
[
|
||||
[ stack-effect effect-in length ] catch [ 4 < ] unless
|
||||
! ] subset [ [ [ test-inputs , full-gc ] { } make , ] each ] { } make ;
|
||||
! ] subset [ [ [ test-inputs , ] { } make , ] each ] { } make ;
|
||||
] subset [ test-inputs clear ] each ;
|
||||
|
||||
: test1
|
||||
wordbank get (test1) ;
|
||||
|
||||
! full-gc finds corrupted memory faster
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
USING: kernel math sequences namespaces errors hashtables words
|
||||
arrays parser compiler syntax io optimizer inference shuffle
|
||||
tools prettyprint ;
|
||||
IN: random-tester
|
||||
|
||||
: pick-one ( seq -- elt )
|
||||
[ length random-int ] keep nth ;
|
||||
|
||||
! HASHTABLES
|
||||
: random-hash-entry ( hash -- key value )
|
||||
hash>alist pick-one first2 ;
|
||||
|
||||
: coin-flip ( -- bool ) 2 random-int zero? ;
|
||||
: do-one ( seq -- ) pick-one call ; inline
|
||||
|
||||
: nzero-array ( seq -- )
|
||||
dup length >r 0 r> [ pick set-nth ] each-with drop ;
|
||||
|
||||
: zero-array
|
||||
[ drop 0 ] map ;
|
||||
|
||||
TUPLE: p-list seq max count count-vec ;
|
||||
: make-p-list ( seq n -- tuple )
|
||||
>r dup length [ 1- ] keep r>
|
||||
[ ^ 0 swap 2array ] keep
|
||||
zero-array <p-list> ;
|
||||
|
||||
: inc-seq ( seq max -- )
|
||||
2dup [ < ] curry find-last over -1 = [
|
||||
3drop nzero-array
|
||||
] [
|
||||
nipd 1+ 2over swap set-nth
|
||||
1+ over length rot <slice> nzero-array
|
||||
] if ;
|
||||
|
||||
: inc-count ( tuple -- )
|
||||
[ p-list-count first2 >r 1+ r> 2array ] keep
|
||||
set-p-list-count ;
|
||||
|
||||
: get-permutation ( tuple -- seq )
|
||||
[ p-list-seq ] keep p-list-count-vec [ swap nth ] map-with ;
|
||||
|
||||
: p-list-next ( tuple -- seq/f )
|
||||
dup p-list-count first2 < [
|
||||
[
|
||||
[ get-permutation ] keep
|
||||
[ p-list-count-vec ] keep p-list-max
|
||||
inc-seq
|
||||
] keep inc-count
|
||||
] [
|
||||
drop f
|
||||
] if ;
|
||||
|
||||
: (permutations) ( tuple -- )
|
||||
dup p-list-next [ , (permutations) ] [ drop ] if* ;
|
||||
|
||||
: permutations ( seq n -- seq )
|
||||
make-p-list
|
||||
[
|
||||
(permutations)
|
||||
] { } make ;
|
||||
|
||||
: (each-permutation) ( tuple quot -- )
|
||||
over p-list-next [
|
||||
[ rot drop swap call ] 3keep
|
||||
drop (each-permutation)
|
||||
] [
|
||||
2drop
|
||||
] if* ; inline
|
||||
|
||||
: each-permutation ( seq n quot -- )
|
||||
>r make-p-list r> (each-permutation) ;
|
||||
|
||||
|
|
@ -161,6 +161,6 @@ DEFER: create ( level c r -- scene )
|
|||
"Generating " write dup write "..." print
|
||||
<file-writer> [ run write ] with-stream ;
|
||||
|
||||
PROVIDE: examples/raytracer ;
|
||||
PROVIDE: apps/raytracer ;
|
||||
|
||||
MAIN: examples/raytracer [ "raytracer.pnm" run>file ] time ;
|
||||
MAIN: apps/raytracer [ "raytracer.pnm" run>file ] time ;
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<feed xmlns="http://www.w3.org/2005/Atom">
|
||||
<title type="text">dive into mark</title>
|
||||
<subtitle type="html">
|
||||
A <em>lot</em> of effort
|
||||
went into making this effortless
|
||||
</subtitle>
|
||||
<updated>2005-07-31T12:29:29Z</updated>
|
||||
<id>tag:example.org,2003:3</id>
|
||||
<link rel="alternate" type="text/html"
|
||||
hreflang="en" href="http://example.org/"/>
|
||||
<link rel="self" type="application/atom+xml"
|
||||
href="http://example.org/feed.atom"/>
|
||||
<rights>Copyright (c) 2003, Mark Pilgrim</rights>
|
||||
<generator uri="http://www.example.com/" version="1.0">
|
||||
Example Toolkit
|
||||
</generator>
|
||||
<entry>
|
||||
<title>Atom draft-07 snapshot</title>
|
||||
<link rel="alternate" type="text/html"
|
||||
href="http://example.org/2005/04/02/atom"/>
|
||||
<link rel="enclosure" type="audio/mpeg" length="1337"
|
||||
href="http://example.org/audio/ph34r_my_podcast.mp3"/>
|
||||
<id>tag:example.org,2003:3.2397</id>
|
||||
<updated>2005-07-31T12:29:29Z</updated>
|
||||
<published>2003-12-13T08:29:29-04:00</published>
|
||||
<author>
|
||||
<name>Mark Pilgrim</name>
|
||||
<uri>http://example.org/</uri>
|
||||
<email>f8dy@example.com</email>
|
||||
</author>
|
||||
<contributor>
|
||||
<name>Sam Ruby</name>
|
||||
</contributor>
|
||||
<contributor>
|
||||
<name>Joe Gregorio</name>
|
||||
</contributor>
|
||||
<content type="xhtml" xml:lang="en"
|
||||
xml:base="http://diveintomark.org/">
|
||||
<div xmlns="http://www.w3.org/1999/xhtml">
|
||||
<p><i>[Update: The Atom draft is finished.]</i></p>
|
||||
</div>
|
||||
</content>
|
||||
</entry>
|
||||
</feed>
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
REQUIRES: libs/http-client libs/httpd libs/sqlite libs/xml
|
||||
libs/parser-combinators ;
|
||||
PROVIDE: apps/rss
|
||||
{ +files+ {
|
||||
"rss.factor"
|
||||
"rss-reader.factor"
|
||||
} }
|
||||
{ +tests+ {
|
||||
"test.factor"
|
||||
} } ;
|
||||
|
|
@ -72,20 +72,20 @@ SYMBOL: db
|
|||
] show 2drop ;
|
||||
|
||||
: rss>reader-feed ( url rss -- reader-feed )
|
||||
[ rss-title ] keep rss-link <reader-feed> ;
|
||||
[ feed-title ] keep feed-link <reader-feed> ;
|
||||
|
||||
: rss-entry>reader-entry ( url entry -- reader-entry )
|
||||
[ rss-entry-link ] keep
|
||||
[ rss-entry-title ] keep
|
||||
[ rss-entry-description ] keep
|
||||
rss-entry-pub-date
|
||||
[ entry-link ] keep
|
||||
[ entry-title ] keep
|
||||
[ entry-description ] keep
|
||||
entry-pub-date
|
||||
<reader-entry> ;
|
||||
|
||||
: update-feed-database ( url -- )
|
||||
dup remove-feed
|
||||
dup rss-get
|
||||
dup news-get
|
||||
2dup rss>reader-feed db get swap save-tuple
|
||||
rss-entries [
|
||||
feed-entries [
|
||||
dupd rss-entry>reader-entry
|
||||
dup >r reader-entry-link f f f <reader-entry> db get swap find-tuples [ db get swap delete-tuple ] each r>
|
||||
db get swap save-tuple
|
||||
|
|
@ -0,0 +1,89 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: rss
|
||||
USING: kernel http-client xml xml-utils xml-data errors io strings
|
||||
sequences xml-writer parser-combinators lazy-lists ;
|
||||
|
||||
: ?children>string ( tag/f -- string/f )
|
||||
[ children>string ] [ f ] if* ;
|
||||
|
||||
LAZY: '&' ( -- parser )
|
||||
"&" token
|
||||
[ blank? ] satisfy &>
|
||||
[ "&" swap add ] <@ ;
|
||||
|
||||
: &>& ( string -- string )
|
||||
'&' replace ;
|
||||
|
||||
TUPLE: feed title link entries ;
|
||||
TUPLE: entry title link description pub-date ;
|
||||
|
||||
: rss1.0 ( xml -- feed )
|
||||
[
|
||||
"channel" find-tag
|
||||
[ "title" find-tag children>string ] keep
|
||||
"link" find-tag children>string
|
||||
] keep
|
||||
"item" find-tags [
|
||||
[ "title" find-tag children>string ] keep
|
||||
[ "link" find-tag children>string ] keep
|
||||
[ "description" find-tag children>string ] keep
|
||||
f "date" "http://purl.org/dc/elements/1.1/" <name>
|
||||
find-name-tag ?children>string
|
||||
<entry>
|
||||
] map <feed> ;
|
||||
|
||||
: rss2.0 ( xml -- feed )
|
||||
"channel" find-tag
|
||||
[ "title" find-tag children>string ] keep
|
||||
[ "link" find-tag children>string ] keep
|
||||
"item" find-tags [
|
||||
[ "title" find-tag children>string ] keep
|
||||
[ "link" find-tag ] keep
|
||||
[ "guid" find-tag dupd ? children>string ] keep
|
||||
[ "description" find-tag children>string ] keep
|
||||
"pubDate" find-tag children>string <entry>
|
||||
] map <feed> ;
|
||||
|
||||
: atom1.0 ( xml -- feed )
|
||||
[ "title" find-tag children>string ] keep
|
||||
[ "link" find-tag "href" prop-name-tag first ] keep
|
||||
"entry" find-tags [
|
||||
[ "title" find-tag children>string ] keep
|
||||
[ "link" find-tag "href" prop-name-tag first ] keep
|
||||
[
|
||||
dup "content" find-tag
|
||||
[ nip ] [ "summary" find-tag ] if*
|
||||
dup tag-children [ tag? ] contains?
|
||||
[ tag-children [ write-chunk ] string-out ]
|
||||
[ children>string ] if
|
||||
] keep
|
||||
dup "published" find-tag
|
||||
[ nip ] [ "updated" find-tag ] if*
|
||||
children>string <entry>
|
||||
] map <feed> ;
|
||||
|
||||
: feed ( xml -- feed )
|
||||
dup name-tag {
|
||||
{ [ dup "RDF" = ] [ drop rss1.0 ] }
|
||||
{ [ dup "rss" = ] [ drop rss2.0 ] }
|
||||
{ [ "feed" = ] [ atom1.0 ] }
|
||||
{ [ t ] [ "Invalid newsfeed" throw ] }
|
||||
} cond ;
|
||||
|
||||
: read-feed ( string -- feed )
|
||||
! &>& ! this will be uncommented when parser-combinators are fixed
|
||||
string>xml feed ;
|
||||
|
||||
: load-news-file ( filename -- feed )
|
||||
#! Load an news syndication file and process it, returning
|
||||
#! it as an feed tuple.
|
||||
<file-reader> [ contents read-feed ] keep stream-close ;
|
||||
|
||||
: news-get ( url -- feed )
|
||||
#! Retrieve an news syndication file, return as a feed tuple.
|
||||
http-get rot 200 = [
|
||||
nip read-feed
|
||||
] [
|
||||
2drop "Error retrieving newsfeed file" throw
|
||||
] if ;
|
||||
|
|
@ -0,0 +1,67 @@
|
|||
<?xml version="1.0" encoding="utf-8"?>
|
||||
|
||||
<rdf:RDF
|
||||
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
|
||||
xmlns:dc="http://purl.org/dc/elements/1.1/"
|
||||
xmlns:sy="http://purl.org/rss/1.0/modules/syndication/"
|
||||
xmlns:co="http://purl.org/rss/1.0/modules/company/"
|
||||
xmlns:ti="http://purl.org/rss/1.0/modules/textinput/"
|
||||
xmlns="http://purl.org/rss/1.0/"
|
||||
>
|
||||
|
||||
<channel rdf:about="http://meerkat.oreillynet.com/?_fl=rss1.0">
|
||||
<title>Meerkat</title>
|
||||
<link>http://meerkat.oreillynet.com</link>
|
||||
<description>Meerkat: An Open Wire Service</description>
|
||||
<dc:publisher>The O'Reilly Network</dc:publisher>
|
||||
<dc:creator>Rael Dornfest (mailto:rael@oreilly.com)</dc:creator>
|
||||
<dc:rights>Copyright © 2000 O'Reilly & Associates, Inc.</dc:rights>
|
||||
<dc:date>2000-01-01T12:00+00:00</dc:date>
|
||||
<sy:updatePeriod>hourly</sy:updatePeriod>
|
||||
<sy:updateFrequency>2</sy:updateFrequency>
|
||||
<sy:updateBase>2000-01-01T12:00+00:00</sy:updateBase>
|
||||
|
||||
<image rdf:resource="http://meerkat.oreillynet.com/icons/meerkat-powered.jpg" />
|
||||
|
||||
<items>
|
||||
<rdf:Seq>
|
||||
<rdf:li resource="http://c.moreover.com/click/here.pl?r123" />
|
||||
</rdf:Seq>
|
||||
</items>
|
||||
|
||||
<textinput rdf:resource="http://meerkat.oreillynet.com" />
|
||||
|
||||
</channel>
|
||||
|
||||
<image rdf:about="http://meerkat.oreillynet.com/icons/meerkat-powered.jpg">
|
||||
<title>Meerkat Powered!</title>
|
||||
<url>http://meerkat.oreillynet.com/icons/meerkat-powered.jpg</url>
|
||||
<link>http://meerkat.oreillynet.com</link>
|
||||
</image>
|
||||
|
||||
<item rdf:about="http://c.moreover.com/click/here.pl?r123">
|
||||
<title>XML: A Disruptive Technology</title>
|
||||
<link>http://c.moreover.com/click/here.pl?r123</link>
|
||||
<dc:description>
|
||||
XML is placing increasingly heavy loads on the existing technical
|
||||
infrastructure of the Internet.
|
||||
</dc:description>
|
||||
<dc:publisher>The O'Reilly Network</dc:publisher>
|
||||
<dc:creator>Simon St.Laurent (mailto:simonstl@simonstl.com)</dc:creator>
|
||||
<dc:rights>Copyright © 2000 O'Reilly & Associates, Inc.</dc:rights>
|
||||
<dc:subject>XML</dc:subject>
|
||||
<co:name>XML.com</co:name>
|
||||
<co:market>NASDAQ</co:market>
|
||||
<co:symbol>XML</co:symbol>
|
||||
</item>
|
||||
|
||||
<textinput rdf:about="http://meerkat.oreillynet.com">
|
||||
<title>Search Meerkat</title>
|
||||
<description>Search Meerkat's RSS Database...</description>
|
||||
<name>s</name>
|
||||
<link>http://meerkat.oreillynet.com/</link>
|
||||
<ti:function>search</ti:function>
|
||||
<ti:inputType>regex</ti:inputType>
|
||||
</textinput>
|
||||
|
||||
</rdf:RDF>
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
USING: rss io test ;
|
||||
IN: temporary
|
||||
|
||||
[ T{
|
||||
feed
|
||||
f
|
||||
"Meerkat"
|
||||
"http://meerkat.oreillynet.com"
|
||||
V{
|
||||
T{
|
||||
entry
|
||||
f
|
||||
"XML: A Disruptive Technology"
|
||||
"http://c.moreover.com/click/here.pl?r123"
|
||||
"\n XML is placing increasingly heavy loads on the existing technical\n infrastructure of the Internet.\n "
|
||||
f
|
||||
}
|
||||
}
|
||||
} ] [ "apps/rss/rss1.xml" resource-path load-news-file ] unit-test
|
||||
[ T{
|
||||
feed
|
||||
f
|
||||
"dive into mark"
|
||||
"http://example.org/"
|
||||
V{
|
||||
T{
|
||||
entry
|
||||
f
|
||||
"Atom draft-07 snapshot"
|
||||
"http://example.org/2005/04/02/atom"
|
||||
"\n <div xmlns=\"http://www.w3.org/1999/xhtml\">\n <p><i>[Update: The Atom draft is finished.]</i></p>\n </div>\n "
|
||||
|
||||
"2003-12-13T08:29:29-04:00"
|
||||
}
|
||||
}
|
||||
} ] [ "apps/rss/atom.xml" resource-path load-news-file ] unit-test
|
||||
[ " & & hi" ] [ " & & hi" &>& ] unit-test
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
PROVIDE: apps/show-dataflow
|
||||
{ +files+ { "print-dataflow.factor" "show-dataflow.factor" } }
|
||||
{ +tests+ { "tests.factor" } } ;
|
||||
|
|
@ -1,7 +1,9 @@
|
|||
IN: print-dataflow
|
||||
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: show-dataflow
|
||||
USING: generic hashtables inference io kernel kernel-internals
|
||||
math namespaces prettyprint sequences styles vectors words
|
||||
optimizer ;
|
||||
math namespaces prettyprint prettyprint-internals sequences
|
||||
styles vectors words optimizer ;
|
||||
|
||||
! A simple tool for turning dataflow IR into quotations, for
|
||||
! debugging purposes.
|
||||
|
|
@ -11,7 +13,7 @@ GENERIC: node>quot ( ? node -- )
|
|||
TUPLE: comment node text ;
|
||||
|
||||
M: comment pprint*
|
||||
"( " over comment-text " )" append3
|
||||
"( " over comment-text " )" 3append
|
||||
swap comment-node presented associate
|
||||
styled-text ;
|
||||
|
||||
|
|
@ -79,7 +81,7 @@ M: object node>quot dup class word-name comment, ;
|
|||
: dataflow>quot ( node ? -- quot )
|
||||
[ swap (dataflow>quot) ] [ ] make ;
|
||||
|
||||
: dataflow. ( quot ? -- )
|
||||
: print-dataflow ( quot ? -- )
|
||||
#! Print dataflow IR for a quotation. Flag indicates if
|
||||
#! annotations should be printed or not.
|
||||
>r dataflow optimize r> dataflow>quot . ;
|
||||
|
|
@ -1,11 +1,11 @@
|
|||
! Copyright (C) 2006 Slava Pestov.
|
||||
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: gadgets-dataflow
|
||||
IN: show-dataflow
|
||||
USING: namespaces arrays sequences io inference math kernel
|
||||
generic prettyprint words gadgets opengl gadgets-panes
|
||||
gadgets-labels gadgets-theme gadgets-presentations
|
||||
gadgets-buttons gadgets-borders gadgets-scrolling
|
||||
gadgets-workspace optimizer models help ;
|
||||
optimizer models help ;
|
||||
|
||||
GENERIC: node>gadget* ( height node -- gadget )
|
||||
|
||||
|
|
@ -78,8 +78,7 @@ TUPLE: node-gadget value height ;
|
|||
C: node-gadget ( gadget node height -- gadget )
|
||||
[ set-node-gadget-height ] keep
|
||||
[ set-node-gadget-value ] keep
|
||||
swap <default-border> over set-gadget-delegate
|
||||
dup faint-boundary ;
|
||||
swap <default-border> over set-gadget-delegate ;
|
||||
|
||||
M: node-gadget pref-dim*
|
||||
dup delegate pref-dim
|
||||
|
|
@ -111,10 +110,6 @@ M: #push node-presents >#push< first ;
|
|||
<presentation>
|
||||
] 2map ;
|
||||
|
||||
: <node-presentation> ( node -- gadget )
|
||||
class [ word-name <label> ] keep <link>
|
||||
<presentation> ;
|
||||
|
||||
: default-node-content ( node -- gadget )
|
||||
dup node-children <child-nodes>
|
||||
swap class word-name <label> add* make-pile
|
||||
|
|
@ -169,7 +164,7 @@ DEFER: (compute-heights)
|
|||
! Then we create gadgets for every node
|
||||
: node>gadget ( height node -- gadget )
|
||||
[ node>gadget* ] keep node-presents
|
||||
[ <presentation> ] when* ;
|
||||
[ <presentation> dup faint-boundary ] when* ;
|
||||
|
||||
: print-node ( d-height node -- )
|
||||
dup full-height-node? [
|
||||
|
|
@ -177,7 +172,7 @@ DEFER: (compute-heights)
|
|||
] [
|
||||
[ node-in-d length - <height-gadget> ] 2keep
|
||||
node>gadget swap 2array
|
||||
make-pile 1 over set-pack-fill
|
||||
make-filled-pile
|
||||
] if , ;
|
||||
|
||||
: <dataflow-graph> ( node -- gadget )
|
||||
|
|
@ -187,31 +182,25 @@ DEFER: (compute-heights)
|
|||
] { } make
|
||||
make-shelf 1 over set-pack-align ;
|
||||
|
||||
! The UI tool
|
||||
TUPLE: dataflow-gadget history ;
|
||||
|
||||
dataflow-gadget "toolbar" {
|
||||
{ "Back" T{ key-down f { C+ } "b" } [ dataflow-gadget-history go-back ] }
|
||||
{ "Forward" T{ key-down f { C+ } "f" } [ dataflow-gadget-history go-forward ] }
|
||||
} define-commands
|
||||
|
||||
: <dataflow-pane> ( history -- gadget )
|
||||
gadget get dataflow-gadget-history
|
||||
[ <dataflow-graph> gadget. ]
|
||||
<pane-control> ;
|
||||
|
||||
C: dataflow-gadget ( -- gadget )
|
||||
f <history> over set-dataflow-gadget-history {
|
||||
{ [ <dataflow-pane> ] f [ <scroller> ] @center }
|
||||
} make-frame* ;
|
||||
|
||||
M: dataflow-gadget call-tool* ( node dataflow -- )
|
||||
dup dataflow-gadget-history add-history
|
||||
dataflow-gadget-history set-model ;
|
||||
|
||||
M: dataflow-gadget tool-help drop "ui-dataflow" ;
|
||||
|
||||
IN: tools
|
||||
|
||||
: show-dataflow ( quot -- )
|
||||
dataflow optimize dataflow-gadget call-tool ;
|
||||
dataflow optimize <dataflow-graph> gadget. ;
|
||||
|
||||
! Operations
|
||||
[ compound? ] H{
|
||||
{ +name+ "Word dataflow" }
|
||||
{ +quot+ [ word-def show-dataflow ] }
|
||||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
||||
[ quotation? ] H{
|
||||
{ +name+ "Quotation dataflow" }
|
||||
{ +quot+ [ show-dataflow ] }
|
||||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
||||
[ [ node? ] is? ] H{
|
||||
{ +primary+ t }
|
||||
{ +name+ "Show dataflow" }
|
||||
{ +quot+ [ <dataflow-graph> gadget. ] }
|
||||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
IN: temporary
|
||||
USING: show-dataflow math kernel words test kernel-internals ;
|
||||
|
||||
[ ] [ [ 2 ] t print-dataflow ] unit-test
|
||||
[ ] [ [ 3 + ] t print-dataflow ] unit-test
|
||||
[ ] [ [ drop ] t print-dataflow ] unit-test
|
||||
[ ] [ [ [ sq ] [ abs ] if ] t print-dataflow ] unit-test
|
||||
[ ] [ [ { [ sq ] [ abs ] } dispatch ] t print-dataflow ] unit-test
|
||||
[ ] [ [ 0 0 / ] t print-dataflow ] unit-test
|
||||
|
|
@ -1332,7 +1332,7 @@ SYMBOL: $4
|
|||
#! Given an instruction string, return the emulation quotation for
|
||||
#! it. This will later be expanded to produce the disassembly and
|
||||
#! assembly quotations.
|
||||
8080-generator-parser some parse force call ;
|
||||
8080-generator-parser some parse call ;
|
||||
|
||||
SYMBOL: last-instruction
|
||||
SYMBOL: last-opcode
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
REQUIRES: libs/parser-combinators libs/concurrency ;
|
||||
|
||||
PROVIDE: apps/space-invaders
|
||||
{ +files+ {
|
||||
"cpu-8080.factor"
|
||||
"space-invaders.factor"
|
||||
} } ;
|
||||
|
||||
USE: space-invaders
|
||||
|
||||
MAIN: apps/space-invaders run ;
|
||||
|
|
@ -323,5 +323,5 @@ M: invaders-gadget ungraft* ( gadget -- )
|
|||
t swap set-invaders-gadget-quit? ;
|
||||
|
||||
: run ( -- )
|
||||
<space-invaders> "invaders.rom" over load-rom <invaders-gadget>
|
||||
"Space Invaders" open-titled-window ;
|
||||
<space-invaders> "apps/space-invaders/invaders.rom" resource-path over load-rom <invaders-gadget>
|
||||
"Space Invaders" open-window ;
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2006 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
REQUIRES: contrib/lazy-lists ;
|
||||
REQUIRES: libs/lazy-lists ;
|
||||
|
||||
PROVIDE: contrib/tetris
|
||||
PROVIDE: apps/tetris
|
||||
{ +files+ {
|
||||
"tetris-colours.factor"
|
||||
"tetromino.factor"
|
||||
|
|
@ -21,4 +21,4 @@ PROVIDE: contrib/tetris
|
|||
|
||||
USE: tetris-gadget
|
||||
|
||||
MAIN: contrib/tetris tetris-window ;
|
||||
MAIN: apps/tetris tetris-window ;
|
||||
|
|
@ -46,5 +46,5 @@ M: tetris-gadget graft* ( gadget -- )
|
|||
M: tetris-gadget ungraft* ( gadget -- )
|
||||
t swap set-tetris-gadget-quit? ;
|
||||
|
||||
: tetris-window ( -- ) <default-tetris> <tetris-gadget> "Tetris" open-titled-window ;
|
||||
: tetris-window ( -- ) <default-tetris> <tetris-gadget> "Tetris" open-window ;
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue