diff --git a/examples/dejong.factor b/examples/dejong.factor
new file mode 100644
index 0000000000..0eb755a8f9
--- /dev/null
+++ b/examples/dejong.factor
@@ -0,0 +1,60 @@
+! DeJong attractor renderer.
+! To run this code, start your interpreter like so:
+!
+! ./f -libraries:sdl=libSDL.so -libraries:sdl-gfx=libSDL_gfx.so
+!
+! Then, enter this at the interpreter prompt:
+!
+! "contrib/dejong.factor" run-file
+
+! For details on DeJong attractors, see
+! http://www.complexification.net/gallery/machines/peterdejong/
+
+IN: dejong
+
+USE: sdl
+USE: namespaces
+USE: math
+USE: stack
+
+SYMBOL: a
+SYMBOL: b
+SYMBOL: c
+SYMBOL: d
+
+: next-x ( x y -- x ) a get * sin swap b get * cos - ;
+: next-y ( x y -- y ) swap c get * sin swap d get * cos - ;
+
+: white ( -- rgb )
+    HEX: ffffffff ;
+
+: pixel ( #{ x y } color -- )
+    >r >r surface get r> >rect r> pixelColor ;
+
+: iterate-dejong ( x y -- x y )
+    2dup next-y >r next-x r> ;
+
+: scale-dejong ( x y -- x y )
+    swap width get 4 / * width get 2 / + >fixnum
+    swap height get 4 / * height get 2 / + >fixnum ;
+
+: draw-dejong ( x0 y0 iterations -- )
+    [
+        iterate-dejong 2dup scale-dejong rect> white pixel
+    ] times 2drop ;
+
+: dejong ( -- )
+    ! Fiddle with these four values!
+    1.4 a set
+    -2.3 b set
+    2.4 c set
+    -2.1 d set
+
+    640 480 32 SDL_HWSURFACE [
+        [ 0 0 100000 draw-dejong ] with-surface
+
+        <event> event-loop
+        SDL_Quit
+    ] with-screen ;
+
+dejong
diff --git a/examples/factoroids.factor b/examples/factoroids.factor
new file mode 100644
index 0000000000..335917fd9b
--- /dev/null
+++ b/examples/factoroids.factor
@@ -0,0 +1,269 @@
+! Currently the plugin doesn't handle GENERIC: and M:, so we
+! disable the parser. too many errors :sidekick.parser=none:
+IN: factoroids
+
+USE: combinators
+USE: errors
+USE: hashtables
+USE: kernel
+USE: lists
+USE: logic
+USE: math
+USE: namespaces
+USE: oop
+USE: random
+USE: sdl
+USE: stack
+
+! Game objects
+GENERIC: draw ( -- )
+#! Draw the actor.
+
+GENERIC: tick ( -- ? )
+#! Return f if the actor should be removed.
+
+! Actor attributes
+SYMBOL: x
+SYMBOL: y
+SYMBOL: radius
+SYMBOL: len
+SYMBOL: dx
+SYMBOL: dy
+SYMBOL: color
+
+! The list of actors is divided into layers. Note that an
+! actor's tick method can only add actors to layers other than
+! the actor's layer. The player layer only has one actor.
+SYMBOL: player
+SYMBOL: enemies
+SYMBOL: player-shots
+SYMBOL: enemy-shots
+
+: player-actor ( -- actor )
+    player get car ;
+
+: y-in-screen? ( -- ? ) y get 0 height get between? ;
+: x-in-screen? ( -- ? ) x get 0 width get between? ;
+
+: in-screen? ( -- ? )
+    #! Is the current actor in the screen?
+    x-in-screen? y-in-screen? and ;
+
+: velocity ( -- )
+    #! Add velocity vector to current actor's position vector.
+    dx get x +@  dy get y +@ ;
+
+: actor-tick ( actor -- ? )
+    #! Default tick behavior of an actor. Move actor according
+    #! to velocity, and remove it if it is not in the screen.
+    #! Player's ship always returns t.
+    [
+        velocity
+        namespace player-actor = [ t ] [ in-screen? ] ifte
+    ] bind ;
+
+: screen-xy ( -- x y )
+    x get >fixnum y get >fixnum ;
+
+: actor-xy ( actor -- )
+    #! Copy actor's x/y co-ordinates to this namespace.
+    [ x get y get ] bind y set x set ;
+
+! The player's ship
+TRAITS: ship
+M: ship draw ( -- )
+    [
+        surface get screen-xy radius get color get
+        filledCircleColor
+    ] bind ;M
+
+M: ship tick ( -- ) actor-tick ;M
+
+! Projectiles
+TRAITS: plasma
+M: plasma draw ( -- )
+    [
+        surface get screen-xy dup len get + color get
+        vlineColor
+    ] bind ;M
+
+M: plasma tick ( -- ) actor-tick ;M
+
+: make-plasma ( actor dy -- plasma )
+    <plasma> [
+        dy set
+        0 dx set
+        actor-xy
+        blue color set
+        10 len set
+    ] extend ;
+
+: player-fire ( -- )
+    player-actor -6 make-plasma player-shots cons@ ;
+
+: enemy-fire ( actor -- )
+    5 make-plasma enemy-shots cons@ ;
+
+! Background of stars
+TRAITS: particle
+
+M: particle draw ( -- )
+    [ surface get screen-xy color get pixelColor ] bind ;M
+
+: wrap ( -- )
+    #! If current actor has gone beyond screen bounds, move it
+    #! back.
+    width get x rem@  height get y rem@ ;
+
+M: particle tick ( -- )
+    [ velocity wrap t ] bind ;M
+
+SYMBOL: stars
+: star-count 100 ;
+
+: random-x 0 width get random-int ;
+: random-y 0 height get random-int ;
+: random-byte 0 255 random-int ;
+: random-color random-byte random-byte random-byte 255 rgba ;
+
+: random-star ( -- star )
+    <particle> [
+        random-x x set
+        random-y y set
+        random-color color set
+        2 4 random-int dy set
+        0 dx set
+    ] extend ;
+
+: init-stars ( -- )
+    [ ] star-count [ random-star swons ] times stars set ;
+
+: draw-stars ( -- )
+    stars get [ draw ] each ;
+
+: tick-stars ( -- )
+    stars get [ tick drop ] each ;
+
+! Enemies
+: enemy-chance 50 ;
+
+TRAITS: enemy
+M: enemy draw ( -- )
+    [
+        surface get screen-xy radius get color get
+        filledCircleColor
+    ] bind ;M
+
+: attack-chance 30 ;
+
+: attack ( -- ) attack-chance chance [ enemy-fire ] when ;
+
+SYMBOL: wiggle-x
+
+: wiggle ( -- )
+    #! Wiggle from left to right.
+    -3 3 random-int wiggle-x +@
+    wiggle-x get sgn dx set ;
+
+M: enemy tick ( -- )
+    dup attack [ wiggle velocity y-in-screen? ] bind ;M
+
+: spawn-enemy ( -- )
+    <enemy> [
+        10 y set
+        random-x x set
+        red color set
+        0 wiggle-x set
+        0 dx set
+        1 dy set
+        10 radius set
+    ] extend ;
+
+: spawn-enemies ( -- )
+    enemy-chance chance [ spawn-enemy enemies cons@ ] when ;
+
+! Event handling
+SYMBOL: event
+
+: mouse-motion-event ( event -- )
+    motion-event-x player-actor [ x set ] bind ; 
+
+: mouse-down-event ( event -- )
+    drop player-fire ;
+
+: handle-event ( event -- ? )
+    #! Return if we should continue or stop.
+    [
+        [ event-type SDL_MOUSEBUTTONDOWN = ] [ mouse-down-event t ]
+        [ event-type SDL_MOUSEMOTION = ] [ mouse-motion-event t ]
+        [ event-type SDL_QUIT = ] [ drop f ]
+        [ drop t ] [ drop t ]
+    ] cond ;
+
+: check-event ( -- ? )
+    #! Check if there is a pending event.
+    #! Return if we should continue or stop.
+    event get dup SDL_PollEvent [
+        handle-event [ check-event ] [ f ] ifte
+    ] [
+        drop t
+    ] ifte ;
+
+! Game loop
+: init-player ( -- )
+    <ship> [
+        height get 50 - y set
+        width get 2 /i x set
+        white color set
+        10 radius set
+        0 dx set
+        0 dy set
+    ] extend unit player set ;
+
+: init-events ( -- ) <event> event set ;
+
+: init-game ( -- )
+    #! Init game objects.
+    init-player init-stars init-events ;
+
+: each-layer ( quot -- )
+    #! Apply quotation to each layer.
+    [ enemies enemy-shots player player-shots ] swap each ;
+
+: draw-layer ( layer -- )
+    get [ draw ] each ;
+
+: draw-actors ( -- )
+    [ draw-layer ] each-layer ;
+
+: tick-layer ( layer -- )
+    dup get [ tick ] subset put ;
+
+: tick-actors ( -- )
+    #! Advance game state by one frame.
+    [ tick-layer ] each-layer ;
+
+: render ( -- )
+    #! Draw the scene.
+    [
+        black clear-surface
+        draw-stars
+        draw-actors
+    ] with-surface ;
+
+: advance ( -- )
+    #! Advance game state by one frame.
+    tick-actors tick-stars spawn-enemies ;
+
+: game-loop ( -- )
+    #! Render, advance game state, repeat.
+    render advance check-event [ game-loop ] when ;
+
+: factoroids ( -- )
+    #! Main word.
+    640 480 32 SDL_HWSURFACE [
+        "Factoroids" "Factoroids" SDL_WM_SetCaption
+        init-game game-loop
+    ] with-screen ;
+
+factoroids
diff --git a/examples/infix.factor b/examples/infix.factor
new file mode 100644
index 0000000000..f3d71f3cad
--- /dev/null
+++ b/examples/infix.factor
@@ -0,0 +1,33 @@
+USE: combinators
+USE: lists
+USE: math
+USE: namespaces
+USE: stack
+USE: test
+USE: vectors
+USE: words
+
+SYMBOL: exprs
+DEFER: infix
+: >e exprs get vector-push ;
+: e> exprs get vector-pop ;
+: e@ exprs get dup vector-empty? [ drop f ] [ vector-peek ] ifte ;
+: e, ( obj -- ) dup cons? [ [ e, ] each ] [ , ] ifte ;
+: end ( -- ) exprs get [ e, ] vector-each ;
+: >postfix ( op -- ) e@ word? [ e> e> -rot 3list ] when >e ;
+: token ( obj -- ) dup cons? [ infix ] when >postfix ;
+: (infix) ( list -- ) [ unswons token (infix) ] when* ;
+
+: infix ( list -- quot )
+    #! Convert an infix expression (passed in as a list) to
+    #! postfix.
+    [, 10 <vector> exprs set (infix) end ,] ;
+
+[ [ ] ] [ [ ] infix ] unit-test
+[ [ 1 ] ] [ [ 1 ] infix ] unit-test
+[ [ 2 3 + ] ] [ [ 2 + 3 ] infix ] unit-test
+[ [ 2 3 * 4 + ] ] [ [ 2 * 3 + 4 ] infix ] unit-test
+[ [ 2 3 * 4 + 5 + ] ] [ [ 2 * 3 + 4 + 5 ] infix ] unit-test
+[ [ 2 3 * 4 + ] ] [ [ [ 2 * 3 ] + 4 ] infix ] unit-test
+[ [ 2 3 4 + * ] ] [ [ 2 * [ 3 + 4 ] ] infix ] unit-test
+[ [ 2 3 2 / 4 + * ] ] [ [ 2 * [ [ 3 / 2 ] + 4 ] ] infix ] unit-test
diff --git a/examples/irc.factor b/examples/irc.factor
new file mode 100644
index 0000000000..4f695c7fb5
--- /dev/null
+++ b/examples/irc.factor
@@ -0,0 +1,150 @@
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: irc
+USE: combinators
+USE: errors
+USE: inspector
+USE: listener
+USE: kernel
+USE: lists
+USE: logic
+USE: math
+USE: namespaces
+USE: parser
+USE: prettyprint
+USE: stack
+USE: stdio
+USE: streams
+USE: strings
+USE: words
+USE: unparser
+
+: irc-register ( -- )
+    "USER " write
+    "user" get write " " write
+    "host" get write " " write
+    "server" get write " " write
+    "realname" get write " " print
+
+    "NICK " write
+    "nick" get print ;
+
+: irc-join ( channel -- )
+    "JOIN " write print ;
+
+: irc-message ( message recepients -- )
+    "PRIVMSG " write write " :" write print ;
+
+: irc-action ( message recepients -- )
+    "ACTION " write write " :" write print ;
+
+: keep-datastack ( quot -- )
+    datastack slip set-datastack drop ;
+
+: irc-stream-write ( string -- )
+    dup "buf" get sbuf-append
+    ends-with-newline? [
+        "buf" get sbuf>str
+        0 "buf" get set-sbuf-length
+        "\n" split [ dup f-or-"" [ drop ] [ "recepient" get irc-message ] ifte ] each
+    ] when ;
+
+: <irc-stream> ( stream recepient -- stream )
+    <stream> [
+        "recepient" set
+        "stdio" set
+        100 <sbuf> "buf" set
+        [
+            irc-stream-write
+        ] "fwrite" set
+    ] extend ;
+
+: irc-eval ( line -- )
+    [
+        [
+            eval
+        ] [
+            default-error-handler
+        ] catch
+    ] keep-datastack drop ;
+
+: with-irc-stream ( recepient quot -- )
+    [
+        >r "stdio" get swap <irc-stream> "stdio" set r> call
+    ] with-scope ;
+
+: irc-action-quot ( action -- quot )
+    [
+        [ "eval" swap [ irc-eval ] with-irc-stream ]
+        [ "see" swap [ see terpri ] with-irc-stream ]
+        [ "join" nip irc-join ]
+        [ "quit" 2drop global [ "irc-quit-flag" on ] bind ]
+    ] assoc [ [ 2drop ] ] unless* ;
+
+: irc-action-handler ( recepient message -- )
+    " " split1 swap irc-action-quot call ;
+
+: irc-input ( line -- )
+    #! Handle a line of IRC input.
+    dup
+    " PRIVMSG " split1 nip [
+        ":" split1 dup [
+            irc-action-handler
+        ] [
+            drop
+        ] ifte
+    ] when*
+
+    global [ print ] bind ;
+
+: irc-quit-flag ( -- ? )
+    global [ "irc-quit-flag" get ] bind ;
+
+: clear-irc-quit-flag ( -- ? )
+    global [ "irc-quit-flag" off ] bind ;
+
+: irc-loop ( -- )
+    irc-quit-flag [
+        read [ irc-input irc-loop ] when*
+    ] unless clear-irc-quit-flag ;
+
+: irc ( channels -- )
+    irc-register
+    "identify foobar" "NickServ" irc-message
+    [ irc-join ] each
+    irc-loop ;
+
+: irc-test
+    "factorbot" "user" set
+    "emu" "host" set
+    "irc.freenode.net" "server" set
+    "Factor" "realname" set
+    "factorbot" "nick" set
+    "irc.freenode.net" 6667 <client> [
+        [ "#concatenative" ] irc
+    ] with-stream ;
diff --git a/examples/mandel.factor b/examples/mandel.factor
new file mode 100644
index 0000000000..50d2a183bd
--- /dev/null
+++ b/examples/mandel.factor
@@ -0,0 +1,100 @@
+! Graphical mandelbrot fractal renderer.
+! To run this code, start your interpreter like so:
+!
+! ./f -library:sdl=libSDL.so -library:sdl-gfx=libSDL_gfx.so
+!
+! Then, enter this at the interpreter prompt:
+!
+! "contrib/mandel.factor" run-file
+
+IN: mandel
+
+USE: alien
+USE: combinators
+USE: errors
+USE: kernel
+USE: lists
+USE: logic
+USE: math
+USE: namespaces
+USE: sdl
+USE: stack
+USE: vectors
+USE: prettyprint
+USE: stdio
+USE: test
+
+: scale 255 * >fixnum ;
+
+: scale-rgba ( r g b -- n )
+    scale
+    swap scale 8 shift bitor
+    swap scale 16 shift bitor
+    swap scale 24 shift bitor ;
+
+: sat 0.85 ;
+: val 0.85 ;
+
+: <color-map> ( nb-cols -- map )
+    [,
+        dup [
+            360 * over succ / 360 / sat val
+            hsv>rgb 1.0 scale-rgba ,
+        ] times*
+    ,] list>vector nip ;
+
+: absq >rect swap sq swap sq + ;
+
+: iter ( c z nb-iter -- x )
+    over absq 4 >= over 0 = or [
+        nip nip
+    ] [
+        pred >r sq dupd + r> iter
+    ] ifte ;
+
+: max-color 360 ;
+
+SYMBOL: zoom-fact
+SYMBOL: x-inc
+SYMBOL: y-inc
+SYMBOL: nb-iter
+SYMBOL: cols
+SYMBOL: center
+
+: init-mandel ( -- )
+    width get 200000 zoom-fact get * / x-inc set
+    height get 150000 zoom-fact get * / y-inc set
+    nb-iter get max-color min <color-map> cols set ;
+
+: c ( #{ i j } -- c )
+    >rect >r
+    x-inc get * center get real x-inc get width get 2 / * - + >float
+    r>
+    y-inc get * center get imaginary y-inc get height get 2 / * - + >float
+    rect> ;
+
+: render ( -- )
+    init-mandel
+    width get height get [
+        c 0 nb-iter get iter dup 0 = [
+            drop 0
+        ] [
+            cols get [ vector-length mod ] keep vector-nth
+        ] ifte
+    ] with-pixels ;
+
+: mandel ( -- )
+    640 480 32 SDL_HWSURFACE [
+        [
+            0.8 zoom-fact set
+            -0.65 center set
+            100 nb-iter set
+            [ render ] time
+            "Done." print flush
+        ] with-surface
+
+        <event> event-loop
+        SDL_Quit
+    ] with-screen ;
+
+mandel
diff --git a/examples/oop-test.factor b/examples/oop-test.factor
new file mode 100644
index 0000000000..70f62e7a27
--- /dev/null
+++ b/examples/oop-test.factor
@@ -0,0 +1,35 @@
+IN: scratchpad
+USE: hashtables
+USE: namespaces
+USE: oop
+USE: stack
+USE: test
+
+TRAITS: test-traits
+
+[ t ] [ <test-traits> test-traits? ] unit-test
+[ f ] [ "hello" test-traits? ] unit-test
+[ f ] [ <namespace> test-traits? ] unit-test
+
+GENERIC: foo
+
+M: test-traits foo drop 12 ;M
+
+TRAITS: another-test
+
+M: another-test foo drop 13 ;M
+
+[ 12 ] [ <test-traits> foo ] unit-test
+[ 13 ] [ <another-test> foo ] unit-test
+
+TRAITS: quux
+
+M: quux foo "foo" swap hash ;M
+
+[
+    "Hi"
+] [
+    <quux> [
+        "Hi" "foo" set
+    ] extend foo
+] unit-test
diff --git a/examples/oop.factor b/examples/oop.factor
new file mode 100644
index 0000000000..266a14e314
--- /dev/null
+++ b/examples/oop.factor
@@ -0,0 +1,79 @@
+! :sidekick.parser=none:
+IN: oop
+
+USE: combinators
+USE: errors
+USE: hashtables
+USE: kernel
+USE: lists
+USE: namespaces
+USE: parser
+USE: stack
+USE: strings
+USE: words
+
+SYMBOL: traits
+
+: traits-map ( word -- hash )
+    #! The method map word property maps selector words to
+    #! definitions.
+    "traits-map" word-property ;
+
+: object-map ( obj -- hash )
+    dup has-namespace? [ traits swap get* ] [ drop f ] ifte ;
+
+: init-traits-map ( word -- )
+    <namespace> "traits-map" set-word-property ;
+
+: no-method
+    "No applicable method." throw ;
+
+: method ( traits selector -- quot )
+    #! Execute the method with the traits object on the stack.
+    over object-map hash* [ cdr ] [ [ no-method ] ] ifte* ;
+
+: constructor-word ( word -- word )
+    word-name "<" swap ">" cat3 "in" get create ;
+
+: define-constructor ( word -- )
+    #! <foo> where foo is a traits type creates a new instance
+    #! of foo.
+    [ constructor-word [ <namespace> ] ] keep
+    traits-map [ traits pick set* ] cons append
+    define-compound ;
+
+: predicate-word ( word -- word )
+    word-name "?" cat2 "in" get create ;
+
+: define-predicate ( word -- )
+    #! foo? where foo is a traits type tests if the top of stack
+    #! is of this type.
+    dup predicate-word swap
+    [ object-map ] swap traits-map [ eq? ] cons append
+    define-compound ;
+
+: TRAITS:
+    #! TRAITS: foo creates a new traits type. Instances can be
+    #! created with <foo>, and tested with foo?.
+    CREATE
+    dup define-symbol
+    dup init-traits-map
+    dup define-constructor
+    define-predicate ; parsing
+
+: GENERIC:
+    #! GENERIC: bar creates a generic word bar that calls the
+    #! bar method on the traits object, with the traits object
+    #! on the stack.
+    CREATE
+    dup unit [ car method call ] cons
+    define-compound ; parsing
+
+: M:
+    #! M: foo bar begins a definition of the bar generic word
+    #! specialized to the foo type.
+    scan-word scan-word f ; parsing
+
+: ;M
+    #! ;M ends a method definition.
+    reverse transp traits-map set* ; parsing
diff --git a/examples/quadratic.factor b/examples/quadratic.factor
new file mode 100644
index 0000000000..8ed80ff3c4
--- /dev/null
+++ b/examples/quadratic.factor
@@ -0,0 +1,48 @@
+! :folding=indent:collapseFolds=0:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: math
+USE: combinators
+USE: math
+USE: stack
+
+: quadratic-complete ( a b c -- a b c a b )
+    >r 2dup r> -rot ;
+
+: quadratic-d ( c a b -- sqrt[b^2 - 4*a*c] )
+    sq -rot 4 * * - sqrt ;
+
+: quadratic-root ( x y -- -y/x/2 )
+    neg swap / 2 / ;
+
+: quadratic-roots ( a b d -- alpha beta )
+    3dup - quadratic-root >r + quadratic-root r> ;
+
+: quadratic ( a b c -- alpha beta )
+    #! Finds both roots of the polynomial a*x^2 + b*x + c using
+    #! the quadratic formula.
+    quadratic-complete quadratic-d quadratic-roots ;
diff --git a/examples/simpson.factor b/examples/simpson.factor
new file mode 100644
index 0000000000..963d0ad707
--- /dev/null
+++ b/examples/simpson.factor
@@ -0,0 +1,70 @@
+! :folding=indent:collapseFolds=0:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: math
+USE: combinators
+USE: kernel
+USE: lists
+USE: logic
+USE: math
+USE: stack
+
+: multiplier ( n -- 2|4 )
+    odd? 4 2 ? ;
+
+: (multipliers) ( list n -- list )
+    dup 2 <= [
+        drop
+    ] [
+        dup >r multiplier swons r> pred (multipliers)
+    ] ifte ;
+
+: multipliers ( n -- list )
+    #! The value n must be odd. Makes a list like [ 1 4 2 4 1 ]
+    [ 1 ] swap (multipliers) 1 swons ;
+
+: x-values ( lower upper n -- list )
+    #! The value n must be odd.
+    pred >r over - r> dup succ count [
+        >r 3dup r> swap / * +
+    ] map >r 3drop r> ;
+
+: y-values ( lower upper n quot -- values )
+    >r x-values r> map ;
+
+: (simpson) ( lower upper n quot -- value )
+    over multipliers >r y-values r> *|+ ;
+
+: h ( lower upper n -- h )
+    transp - swap pred / 3 / ;
+
+: simpson ( lower upper n quot -- value )
+    #! Compute the integral between the lower and upper bound,
+    #! using Simpson's method with n steps. The value of n must
+    #! be odd. The quotation must have stack effect
+    #! ( x -- f(x) ).
+    >r 3dup r> (simpson) >r h r> * ;