Move call( and execute( to core

basis/alien/c-types/c-types.factor

@@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
 namespaces make parser sequences strings words assocs splitting
 math.parser cpu.architecture alien alien.accessors quotations
 layouts system compiler.units io.files io.encodings.binary
-accessors combinators effects continuations fry call classes ;
+accessors combinators effects continuations fry classes ;
 IN: alien.c-types
 
 DEFER: <int>

basis/bootstrap/image/image.factor

@@ -446,6 +446,8 @@ M: quotation '
         quotation type-number object tag-number [
             emit ! array
             f ' emit ! compiled
+            f ' emit ! cached-effect
+            f ' emit ! cache-counter
             0 emit ! xt
             0 emit ! code
         ] emit-object

basis/call/authors.txt

@@ -1,2 +0,0 @@
-Daniel Ehrenberg
-Slava Pestov

basis/call/call-docs.factor

@@ -1,47 +0,0 @@
-! Copyright (C) 2009 Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax quotations effects words call.private ;
-IN: call
-
-ABOUT: "call"
-
-ARTICLE: "call" "Calling code with known stack effects"
-"The " { $vocab-link "call" } " vocabulary allows for arbitrary quotations to be called from code accepted by the optimizing compiler. This is done by specifying the stack effect of the quotation literally. It is checked at runtime that the stack effect is accurate."
-$nl
-"Quotations:"
-{ $subsection POSTPONE: call( }
-{ $subsection call-effect }
-"Words:"
-{ $subsection POSTPONE: execute( }
-{ $subsection execute-effect }
-"Unsafe calls:"
-{ $subsection POSTPONE: execute-unsafe( }
-{ $subsection execute-effect-unsafe } ;
-
-HELP: call(
-{ $syntax "call( stack -- effect )" }
-{ $description "Calls the quotation on the top of the stack, asserting that it has the given stack effect. The quotation does not need to be known at compile time." } ;
-
-HELP: call-effect
-{ $values { "quot" quotation } { "effect" effect } }
-{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." } ;
-
-HELP: execute(
-{ $syntax "execute( stack -- effect )" }
-{ $description "Calls the word on the top of the stack, asserting that it has the given stack effect. The word does not need to be known at compile time." } ;
-
-HELP: execute-effect
-{ $values { "word" word } { "effect" effect } }
-{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." } ;
-
-HELP: execute-unsafe(
-{ $syntax "execute-unsafe( stack -- effect )" }
-{ $description "Calls the word on the top of the stack, blindly declaring that it has the given stack effect. The word does not need to be known at compile time." }
-{ $warning "If the word being executed has an incorrect stack effect, undefined behavior will result. User code should use " { $link POSTPONE: execute( } " instead." } ;
-HELP: execute-effect-unsafe
-{ $values { "word" word } { "effect" effect } }
-{ $description "Given a word and a stack effect, executes the word, blindly declaring at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." }
-{ $warning "If the word being executed has an incorrect stack effect, undefined behavior will result. User code should use " { $link execute-effect-unsafe } " instead." } ;
-    
-{ call-effect execute-effect execute-effect-unsafe } related-words
-{ POSTPONE: call( POSTPONE: execute( POSTPONE: execute-unsafe( } related-words

basis/call/call-tests.factor

@@ -1,33 +0,0 @@
-! Copyright (C) 2009 Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-USING: math tools.test call call.private kernel accessors ;
-IN: call.tests
-
-[ 3 ] [ 1 2 [ + ] call( x y -- z ) ] unit-test
-[ 1 2 [ + ] call( -- z ) ] must-fail
-[ 1 2 [ + ] call( x y -- z a ) ] must-fail
-[ 1 2 3 { 1 2 3 4 } ] [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test
-[ [ + ] call( x y -- z ) ] must-infer
-
-[ 3 ] [ 1 2 \ + execute( x y -- z ) ] unit-test
-[ 1 2 \ + execute( -- z ) ] must-fail
-[ 1 2 \ + execute( x y -- z a ) ] must-fail
-[ \ + execute( x y -- z ) ] must-infer
-
-: compile-execute(-test-1 ( a b -- c ) \ + execute( a b -- c ) ;
-
-[ t ] [ \ compile-execute(-test-1 optimized>> ] unit-test
-[ 4 ] [ 1 3 compile-execute(-test-1 ] unit-test
-
-: compile-execute(-test-2 ( a b w -- c ) execute( a b -- c ) ;
-
-[ t ] [ \ compile-execute(-test-2 optimized>> ] unit-test
-[ 4 ] [ 1 3 \ + compile-execute(-test-2 ] unit-test
-[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
-[ -3 ] [ 1 4 \ - compile-execute(-test-2 ] unit-test
-[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
-
-[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
-[ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
-[ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
-[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test

basis/call/call.factor

@@ -1,74 +0,0 @@
-! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private macros fry summary sequences
-sequences.private accessors effects effects.parser parser words
-make ;
-IN: call
-
-ERROR: wrong-values effect ;
-
-M: wrong-values summary drop "Quotation called with stack effect" ;
-
-<PRIVATE
-
-: parse-call( ( accum word -- accum )
-    [ ")" parse-effect parsed ] dip parsed ;
-
-: call-effect-unsafe ( quot effect -- )
-    drop call ;
-
-: call-unsafe( \ call-effect-unsafe parse-call( ; parsing
-
-PRIVATE>
-
-: (call-effect>quot) ( in out effect -- quot )
-    [
-        [ [ datastack ] dip dip ] %
-        [ [ , ] bi@ \ check-datastack , ] dip [ wrong-values ] curry , \ unless ,
-    ] [ ] make ;
-
-: call-effect>quot ( effect -- quot )
-    [ in>> length ] [ out>> length ] [ ] tri
-    [ (call-effect>quot) ] keep add-effect-input
-    [ call-effect-unsafe ] 2curry ;
-
-MACRO: call-effect ( effect -- quot )
-    call-effect>quot ;
-
-: call( \ call-effect parse-call( ; parsing
-
-<PRIVATE
-
-: execute-effect-unsafe ( word effect -- )
-    drop execute ;
-
-: execute-unsafe( \ execute-effect-unsafe parse-call( ; parsing
-
-: execute-effect-slow ( word effect -- )
-    [ [ execute ] curry ] dip call-effect ; inline
-
-: cache-hit? ( word ic -- ? ) first-unsafe eq? ; inline
-
-: cache-hit ( word effect ic -- ) drop execute-effect-unsafe ; inline
-
-: execute-effect-unsafe? ( word effect -- ? )
-    over optimized>> [ [ stack-effect ] dip effect<= ] [ 2drop f ] if ; inline
-
-: cache-miss ( word effect ic -- )
-    2over execute-effect-unsafe?
-    [ [ nip set-first ] [ drop execute-effect-unsafe ] 3bi ]
-    [ execute-effect-slow ] if ; inline
-
-: execute-effect-ic ( word effect ic -- )
-    #! ic is a mutable cell { effect }
-    3dup nip cache-hit? [ cache-hit ] [ cache-miss ] if ; inline
-
-: execute-effect>quot ( effect -- quot )
-    { f } clone [ execute-effect-ic ] 2curry ;
-
-PRIVATE>
-
-MACRO: execute-effect ( effect -- )
-    execute-effect>quot ;
-
-: execute( \ execute-effect parse-call( ; parsing

basis/call/summary.txt

@@ -1 +0,0 @@
-Calling arbitrary quotations and executing arbitrary words with a static stack effect

basis/call/tags.txt

@@ -1 +0,0 @@
-extensions

basis/cocoa/messages/messages.factor

@@ -5,7 +5,7 @@ continuations combinators compiler compiler.alien stack-checker kernel
 math namespaces make parser quotations sequences strings words
 cocoa.runtime io macros memoize io.encodings.utf8 effects libc
 libc.private parser lexer init core-foundation fry generalizations
-specialized-arrays.direct.alien call ;
+specialized-arrays.direct.alien ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )

basis/compiler/codegen/codegen.factor

@@ -3,7 +3,7 @@
 USING: namespaces make math math.order math.parser sequences accessors
 kernel kernel.private layouts assocs words summary arrays
 combinators classes.algebra alien alien.c-types alien.structs
-alien.strings alien.arrays alien.complex sets libc call
+alien.strings alien.arrays alien.complex sets libc
 continuations.private fry cpu.architecture
 compiler.errors
 compiler.alien

basis/compiler/compiler.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces arrays sequences io words fry
 continuations vocabs assocs dlists definitions math graphs generic
-combinators deques search-deques macros io stack-checker call
+combinators deques search-deques macros io stack-checker
 stack-checker.state stack-checker.inlining combinators.short-circuit
 compiler.errors compiler.units compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.builder compiler.cfg.optimizer

basis/compiler/constants/constants.factor

@@ -20,7 +20,7 @@ CONSTANT: deck-bits 18
 : tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
 : class-hash-offset ( -- n ) bootstrap-cell object tag-number - ; inline
 : word-xt-offset ( -- n ) 9 bootstrap-cells object tag-number - ; inline
-: quot-xt-offset ( -- n ) 3 bootstrap-cells object tag-number - ; inline
+: quot-xt-offset ( -- n ) 5 bootstrap-cells object tag-number - ; inline
 : word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ; inline
 : array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
 : compiled-header-size ( -- n ) 4 bootstrap-cells ; inline

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -1,6 +1,6 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel arrays sequences math math.order call
+USING: accessors kernel arrays sequences math math.order
 math.partial-dispatch generic generic.standard generic.math
 classes.algebra classes.union sets quotations assocs combinators
 words namespaces continuations classes fry combinators.smart

basis/debugger/debugger.factor

@@ -325,3 +325,5 @@ M: bad-literal-tuple summary drop "Bad literal tuple" ;
 M: check-mixin-class summary drop "Not a mixin class" ;
 
 M: not-found-in-roots summary drop "Cannot resolve vocab: path" ;
+
+M: wrong-values summary drop "Quotation called with wrong stack effect" ;

basis/eval/eval.factor

@@ -4,7 +4,7 @@ USING: splitting parser compiler.units kernel namespaces
 debugger io.streams.string fry ;
 IN: eval
 
-: parse-string ( str -- )
+: parse-string ( str -- quot )
     [ string-lines parse-lines ] with-compilation-unit ;
 
 : (eval) ( str -- )

basis/furnace/actions/actions.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors sequences kernel assocs combinators
 validators http hashtables namespaces fry continuations locals
-io arrays math boxes splitting urls call
+io arrays math boxes splitting urls
 xml.entities
 http.server
 http.server.responses

basis/furnace/boilerplate/boilerplate.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2008, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math.order namespaces combinators.short-circuit call
+USING: accessors kernel math.order namespaces combinators.short-circuit
 html.forms
 html.templates
 html.templates.chloe

basis/furnace/referrer/referrer.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel http.server http.server.filters
-http.server.responses furnace.utilities call ;
+http.server.responses furnace.utilities ;
 IN: furnace.referrer
 
 TUPLE: referrer-check < filter-responder quot ;

basis/help/help.factor

@@ -5,7 +5,7 @@ parser prettyprint sequences words words.symbol assocs
 definitions generic quotations effects slots continuations
 classes.tuple debugger combinators vocabs help.stylesheet
 help.topics help.crossref help.markup sorting classes
-vocabs.loader call ;
+vocabs.loader ;
 IN: help
 
 GENERIC: word-help* ( word -- content )

basis/help/lint/lint.factor

@@ -7,7 +7,7 @@ combinators combinators.short-circuit splitting debugger
 hashtables sorting effects vocabs vocabs.loader assocs editors
 continuations classes.predicate macros math sets eval
 vocabs.parser words.symbol values grouping unicode.categories
-sequences.deep call ;
+sequences.deep ;
 IN: help.lint
 
 SYMBOL: vocabs-quot

basis/help/markup/markup.factor

@@ -4,7 +4,7 @@ USING: accessors arrays definitions generic io kernel assocs
 hashtables namespaces make parser prettyprint sequences strings
 io.styles vectors words math sorting splitting classes slots fry
 sets vocabs help.stylesheet help.topics vocabs.loader quotations
-combinators call see ;
+combinators see ;
 IN: help.markup
 
 PREDICATE: simple-element < array

basis/html/forms/forms.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors strings namespaces assocs hashtables io call
+USING: kernel accessors strings namespaces assocs hashtables io
 mirrors math fry sequences words continuations
 xml.entities xml.writer xml.syntax ;
 IN: html.forms

basis/html/templates/chloe/chloe.factor

@@ -4,7 +4,7 @@ USING: accessors kernel sequences combinators kernel fry
 namespaces make classes.tuple assocs splitting words arrays io
 io.files io.files.info io.encodings.utf8 io.streams.string
 unicode.case mirrors math urls present multiline quotations xml
-logging call
+logging
 xml.data xml.writer xml.syntax strings
 html.forms
 html

basis/html/templates/chloe/compiler/compiler.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs namespaces make kernel sequences accessors
 combinators strings splitting io io.streams.string present
-xml.writer xml.data xml.entities html.forms call
+xml.writer xml.data xml.entities html.forms
 html.templates html.templates.chloe.syntax ;
 IN: html.templates.chloe.compiler
 

basis/html/templates/fhtml/fhtml.factor

@@ -3,7 +3,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations sequences kernel namespaces debugger
 combinators math quotations generic strings splitting accessors
-assocs fry vocabs.parser parser lexer io io.files call
+assocs fry vocabs.parser parser lexer io io.files
 io.streams.string io.encodings.utf8 html.templates ;
 IN: html.templates.fhtml
 
@@ -65,7 +65,7 @@ DEFER: <% delimiter
     ] with-file-vocabs ;
 
 : eval-template ( string -- )
-    parse-template call ;
+    parse-template call( -- ) ;
 
 TUPLE: fhtml path ;
 

basis/html/templates/templates.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel fry io io.encodings.utf8 io.files
 debugger prettyprint continuations namespaces boxes sequences
-arrays strings html io.streams.string assocs call
+arrays strings html io.streams.string assocs
 quotations xml.data xml.writer xml.syntax ;
 IN: html.templates
 

basis/http/server/static/static.factor

@@ -6,7 +6,7 @@ sorting logging calendar.format accessors splitting io io.files
 io.files.info io.directories io.pathnames io.encodings.binary
 fry xml.entities destructors urls html xml.syntax
 html.templates.fhtml http http.server http.server.responses
-http.server.redirection xml.writer call ;
+http.server.redirection xml.writer ;
 IN: http.server.static
 
 TUPLE: file-responder root hook special allow-listings ;

basis/inverse/inverse.factor

@@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations
 continuations debugger classes.tuple namespaces make vectors
 bit-arrays byte-arrays strings sbufs math.functions macros
 sequences.private combinators mirrors splitting
-combinators.short-circuit fry words.symbol generalizations call ;
+combinators.short-circuit fry words.symbol generalizations ;
 RENAME: _ fry => __
 IN: inverse
 

basis/io/pipes/pipes.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.encodings io.backend io.ports io.streams.duplex
 io splitting grouping sequences namespaces kernel
-destructors math concurrency.combinators accessors call fry
+destructors math concurrency.combinators accessors fry
 arrays continuations quotations system vocabs.loader combinators ;
 IN: io.pipes
 

basis/io/servers/connection/connection.factor

@@ -7,7 +7,7 @@ fry accessors arrays io io.sockets io.encodings.ascii
 io.sockets.secure io.files io.streams.duplex io.timeouts
 io.encodings threads make concurrency.combinators
 concurrency.semaphores concurrency.flags
-combinators.short-circuit call ;
+combinators.short-circuit ;
 IN: io.servers.connection
 
 TUPLE: threaded-server

basis/listener/listener.factor

@@ -4,7 +4,7 @@ USING: arrays hashtables io kernel math math.parser memory
 namespaces parser lexer sequences strings io.styles
 vectors words generic system combinators continuations debugger
 definitions compiler.units accessors colors prettyprint fry
-sets vocabs.parser call ;
+sets vocabs.parser ;
 IN: listener
 
 GENERIC: stream-read-quot ( stream -- quot/f )

basis/lists/lazy/lazy.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2008 Chris Double, Matthew Willis, James Cash.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences math vectors arrays namespaces make
-quotations promises combinators io lists accessors call ;
+quotations promises combinators io lists accessors ;
 IN: lists.lazy
 
 M: promise car ( promise -- car )

basis/models/arrow/arrow.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors models kernel call ;
+USING: accessors models kernel ;
 IN: models.arrow
 
 TUPLE: arrow < model model quot ;

basis/peg/ebnf/ebnf.factor

@@ -5,7 +5,7 @@ sequences quotations vectors namespaces make math assocs
 continuations peg peg.parsers unicode.categories multiline
 splitting accessors effects sequences.deep peg.search
 combinators.short-circuit lexer io.streams.string stack-checker
-io combinators parser call ;
+io combinators parser ;
 IN: peg.ebnf
 
 : rule ( name word -- parser )

basis/peg/peg.factor

@@ -4,7 +4,7 @@ USING: kernel sequences strings fry namespaces make math assocs
 io vectors arrays math.parser math.order vectors combinators
 classes sets unicode.categories compiler.units parser words
 quotations effects memoize accessors locals effects splitting
-combinators.short-circuit generalizations call ;
+combinators.short-circuit generalizations ;
 IN: peg
 
 TUPLE: parse-result remaining ast ;

basis/regexp/regexp.factor

@@ -4,7 +4,7 @@ USING: accessors combinators kernel kernel.private math sequences
 sequences.private strings sets assocs prettyprint.backend
 prettyprint.custom make lexer namespaces parser arrays fry locals
 regexp.parser splitting sorting regexp.ast regexp.negation
-regexp.compiler compiler.units words call call.private math.ranges ;
+regexp.compiler compiler.units words math.ranges ;
 IN: regexp
 
 TUPLE: regexp
@@ -35,7 +35,7 @@ M: lookbehind question>quot ! Returns ( index string -- ? )
 : match-index-from ( i string regexp -- index/f )
     ! This word is unsafe. It assumes that i is a fixnum
     ! and that string is a string.
-    dup dfa>> execute-unsafe( index string regexp -- i/f ) ; inline
+    dup dfa>> execute( index string regexp -- i/f ) ; inline
 
 GENERIC: end/start ( string regexp -- end start )
 M: regexp end/start drop length 0 ;
@@ -68,7 +68,7 @@ PRIVATE>
 
 : do-next-match ( i string regexp -- i start end ? )
     dup next-match>>
-    execute-unsafe( i string regexp -- i start end ? ) ; inline
+    execute( i string regexp -- i start end ? ) ; inline
 
 :: (each-match) ( i string regexp quot: ( start end string -- ) -- )
     i string regexp do-next-match [| i' start end |

basis/stack-checker/known-words/known-words.factor

@@ -11,7 +11,7 @@ strings.private system threads.private classes.tuple
 classes.tuple.private vectors vectors.private words definitions
 words.private assocs summary compiler.units system.private
 combinators locals locals.backend locals.types words.private
-quotations.private call call.private stack-checker.values
+quotations.private combinators.private stack-checker.values
 stack-checker.alien
 stack-checker.state
 stack-checker.errors
@@ -135,11 +135,6 @@ M: object infer-call*
     peek-d literal value>> second 1+ { tuple } <effect>
     apply-word/effect ;
 
-: infer-(throw) ( -- )
-    \ (throw)
-    peek-d literal value>> 2 + { "*" } <effect>
-    apply-word/effect ;
-
 : infer-effect-unsafe ( word -- )
     pop-literal nip
     add-effect-input
@@ -194,7 +189,6 @@ M: object infer-call*
         { \ if [ infer-if ] }
         { \ dispatch [ infer-dispatch ] }
         { \ <tuple-boa> [ infer-<tuple-boa> ] }
-        { \ (throw) [ infer-(throw) ] }
         { \ exit [ infer-exit ] }
         { \ load-local [ 1 infer->r ] }
         { \ load-locals [ infer-load-locals ] }
@@ -218,7 +212,7 @@ M: object infer-call*
 {
     declare call (call) slip 2slip 3slip dip 2dip 3dip curry compose
     execute (execute) call-effect-unsafe execute-effect-unsafe if
-    dispatch <tuple-boa> (throw) exit load-local load-locals get-local
+    dispatch <tuple-boa> exit load-local load-locals get-local
     drop-locals do-primitive alien-invoke alien-indirect
     alien-callback
 } [ t "special" set-word-prop ] each

basis/stack-checker/transforms/authors.txt

@@ -1 +1,2 @@
 Slava Pestov
+Daniel Ehrenberg

basis/stack-checker/transforms/transforms-tests.factor

@@ -65,4 +65,9 @@ DEFER: curry-folding-test ( quot -- )
 
 { 3 0 } [ [ 1 2 3 ] curry-folding-test ] must-infer-as
 { 3 0 } [ 1 [ 2 3 ] curry curry-folding-test ] must-infer-as
-{ 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as
+{ 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as
+
+[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
+[ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
+[ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
+[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test

basis/stack-checker/transforms/transforms.factor

@@ -1,11 +1,12 @@
-! Copyright (C) 2007, 2009 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: fry accessors arrays kernel words sequences generic math
+USING: fry accessors arrays kernel kernel.private combinators.private
-namespaces make quotations assocs combinators classes.tuple
+words sequences generic math namespaces make quotations assocs
-classes.tuple.private effects summary hashtables classes generic
+combinators classes.tuple classes.tuple.private effects summary
-sets definitions generic.standard slots.private continuations locals
+hashtables classes generic sets definitions generic.standard
-generalizations stack-checker.backend stack-checker.state
+slots.private continuations locals generalizations
-stack-checker.visitor stack-checker.errors stack-checker.values
+stack-checker.backend stack-checker.state stack-checker.visitor
+stack-checker.errors stack-checker.values
 stack-checker.recursive-state ;
 IN: stack-checker.transforms
 
@@ -50,6 +51,47 @@ IN: stack-checker.transforms
     [ nip "transform-n" set-word-prop ]
     3bi ;
 
+! call( and execute(
+: (call-effect>quot) ( in out effect -- quot )
+    [
+        [ [ datastack ] dip dip ] %
+        [ [ , ] bi@ \ check-datastack , ] dip
+        '[ _ wrong-values ] , \ unless ,
+    ] [ ] make ;
+
+: call-effect>quot ( effect -- quot )
+    [ in>> length ] [ out>> length ] [ ] tri
+    [ (call-effect>quot) ] keep add-effect-input
+    [ call-effect-unsafe ] 2curry ;
+
+\ call-effect [ call-effect>quot ] 1 define-transform
+
+: execute-effect-slow ( word effect -- )
+    [ '[ _ execute ] ] dip call-effect ; inline
+
+TUPLE: inline-cache value ;
+
+: cache-hit? ( word ic -- ? ) value>> eq? ; inline
+
+: cache-hit ( word effect ic -- ) drop execute-effect-unsafe ; inline
+
+: execute-effect-unsafe? ( word effect -- ? )
+    over optimized>> [ [ stack-effect ] dip effect<= ] [ 2drop f ] if ; inline
+
+: cache-miss ( word effect ic -- )
+    2over execute-effect-unsafe?
+    [ [ nip (>>value) ] [ drop execute-effect-unsafe ] 3bi ]
+    [ drop execute-effect-slow ] if ; inline
+
+: execute-effect-ic ( word effect ic -- )
+    #! ic is a mutable cell { effect }
+    3dup nip cache-hit? [ cache-hit ] [ cache-miss ] if ; inline
+
+: execute-effect>quot ( effect -- quot )
+    inline-cache new '[ _ _ execute-effect-ic ] ;
+
+\ execute-effect [ execute-effect>quot ] 1 define-transform
+
 ! Combinators
 \ cond [ cond>quot ] 1 define-transform
 
@@ -141,8 +183,12 @@ CONSTANT: bit-member-n 256
     dup bit-member? [
         bit-member-quot
     ] [
-        [ literalize [ t ] ] { } map>assoc
+        dup length 4 <= [
-        [ drop f ] suffix [ case ] curry
+            [ drop f ] swap
+            [ literalize [ t ] ] { } map>assoc linear-case-quot
+        ] [
+            unique [ key? ] curry
+        ] if
     ] if ;
 
 \ member? [

basis/threads/threads.factor

@@ -1,10 +1,10 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! Copyright (C) 2005 Mackenzie Straight.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays hashtables heaps kernel kernel.private math
 namespaces sequences vectors continuations continuations.private
-dlists assocs system combinators init boxes accessors
+dlists assocs system combinators combinators.private init boxes
-math.order deques strings quotations fry ;
+accessors math.order deques strings quotations fry ;
 IN: threads
 
 SYMBOL: initial-thread
@@ -126,7 +126,7 @@ DEFER: stop
         { } set-retainstack
         { } set-datastack
         self quot>> [ call stop ] call-clear
-    ] 2 (throw) ;
+    ] (( namestack thread -- * )) call-effect-unsafe ;
 
 DEFER: next
 

basis/tools/deploy/deploy-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax words alien.c-types assocs
-kernel call call.private tools.deploy.config ;
+kernel combinators combinators.private tools.deploy.config ;
 IN: tools.deploy
 
 ARTICLE: "prepare-deploy" "Preparing to deploy an application"

basis/tools/deploy/test/12/12.factor

@@ -1,10 +1,12 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: call math.parser io math ;
+USING: math.parser io math ;
 IN: tools.deploy.test.12
 
 : execute-test ( a b w -- c ) execute( a b -- c ) ;
 
-: foo ( -- ) 1 2 \ + execute-test number>string print ;
+: call-test ( a b q -- c ) call( a b -- c ) ;
+
+: foo ( -- ) 1 2 \ + execute-test 4 [ * ] call-test number>string print ;
 
 MAIN: foo

basis/tools/walker/walker.factor

@@ -139,7 +139,6 @@ SYMBOL: +stopped+
     { dip [ (step-into-dip) ] }
     { 2dip [ (step-into-2dip) ] }
     { 3dip [ (step-into-3dip) ] }
-    { (throw) [ drop (step-into-quot) ] }
     { execute [ (step-into-execute) ] }
     { if [ (step-into-if) ] }
     { dispatch [ (step-into-dispatch) ] }

basis/ui/backend/cocoa/cocoa.factor

@@ -8,7 +8,7 @@ ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
 ui.backend.cocoa.views core-foundation core-foundation.run-loop
 core-graphics.types threads math.rectangles fry libc
 generalizations alien.c-types cocoa.views
-combinators io.thread locals call ;
+combinators io.thread locals ;
 IN: ui.backend.cocoa
 
 TUPLE: handle ;

basis/ui/commands/commands.factor

@@ -2,8 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions kernel sequences strings
 math assocs words generic namespaces make assocs quotations
-splitting ui.gestures unicode.case unicode.categories tr fry
+splitting ui.gestures unicode.case unicode.categories tr fry ;
-call ;
 IN: ui.commands
 
 SYMBOL: +nullary+

basis/ui/gadgets/buttons/buttons.factor

@@ -6,7 +6,7 @@ classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
 ui.gadgets.borders ui.gadgets.labels ui.gadgets.tracks
 ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.pens ui.pens.solid
 ui.pens.image ui.pens.tile math.rectangles locals fry
-combinators.smart call ;
+combinators.smart ;
 IN: ui.gadgets.buttons
 
 TUPLE: button < border pressed? selected? quot ;

basis/ui/gadgets/editors/editors.factor

@@ -8,7 +8,7 @@ continuations ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
 ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
 ui.gadgets.menus ui.gadgets.wrappers ui.render ui.pens.solid
 ui.gadgets.line-support ui.text ui.gestures ui.baseline-alignment
-math.rectangles splitting unicode.categories fonts grouping call ;
+math.rectangles splitting unicode.categories fonts grouping ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < line-gadget

basis/ui/gadgets/panes/panes.factor

@@ -10,7 +10,7 @@ ui.gadgets.paragraphs ui.gadgets.incremental ui.gadgets.packs
 ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
 ui.text ui.gadgets.presentations ui.gadgets.grids ui.gadgets.tracks
 ui.gadgets.icons ui.gadgets.grid-lines ui.baseline-alignment
-colors call io.styles ;
+colors io.styles ;
 IN: ui.gadgets.panes
 
 TUPLE: pane < track

basis/ui/gadgets/worlds/worlds.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs continuations kernel math models
-call namespaces opengl sequences io combinators
+namespaces opengl sequences io combinators combinators.short-circuit
-combinators.short-circuit fry math.vectors math.rectangles cache
+fry math.vectors math.rectangles cache ui.gadgets ui.gestures
-ui.gadgets ui.gestures ui.render ui.text ui.text.private
+ui.render ui.text ui.text.private ui.backend ui.gadgets.tracks
-ui.backend ui.gadgets.tracks ui.commands ;
+ui.commands ;
 IN: ui.gadgets.worlds
 
 TUPLE: world < track

basis/ui/gestures/gestures.factor

@@ -4,7 +4,7 @@ USING: accessors arrays assocs kernel math math.order models
 namespaces make sequences words strings system hashtables math.parser
 math.vectors classes.tuple classes boxes calendar alarms combinators
 sets columns fry deques ui.gadgets ui.gadgets.private unicode.case
-unicode.categories combinators.short-circuit call ;
+unicode.categories combinators.short-circuit ;
 IN: ui.gestures
 
 GENERIC: handle-gesture ( gesture gadget -- ? )

basis/ui/operations/operations.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions kernel ui.commands
 ui.gestures sequences strings math words generic namespaces
-hashtables help.markup quotations assocs fry call linked-assocs ;
+hashtables help.markup quotations assocs fry linked-assocs ;
 IN: ui.operations
 
 SYMBOL: +keyboard+

basis/ui/ui.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs io kernel math models namespaces make dlists
-deques sequences threads sequences words continuations init call
+deques sequences threads sequences words continuations init
 combinators hashtables concurrency.flags sets accessors calendar fry
 destructors ui.gadgets ui.gadgets.private ui.gadgets.worlds
 ui.gadgets.tracks ui.gestures ui.backend ui.render ui.text

basis/wrap/wrap.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences math arrays locals fry accessors
-lists splitting call make combinators.short-circuit namespaces
+lists splitting make combinators.short-circuit namespaces
 grouping splitting.monotonic ;
 IN: wrap
 

basis/xmode/loader/syntax/syntax.factor

@@ -12,7 +12,7 @@ IN: xmode.loader.syntax
 
 : RULE:
     scan scan-word scan-word [
-        parse-definition { } make
+        [ parse-definition call( -- ) ] { } make
         swap [ (parse-rule-tag) ] 2curry
     ] dip swap define-tag ; parsing
 

core/bootstrap/primitives.factor

@@ -243,6 +243,8 @@ bi
 "quotation" "quotations" create {
     { "array" { "array" "arrays" } read-only }
     { "compiled" read-only }
+    "cached-effect"
+    "cache-counter"
 } define-builtin
 
 "dll" "alien" create {
@@ -491,7 +493,6 @@ tuple
     { "set-alien-double" "alien.accessors" }
     { "alien-cell" "alien.accessors" }
     { "set-alien-cell" "alien.accessors" }
-    { "(throw)" "kernel.private" }
     { "alien-address" "alien" }
     { "set-slot" "slots.private" }
     { "string-nth" "strings.private" }

core/bootstrap/syntax.factor

@@ -78,6 +78,8 @@ IN: bootstrap.syntax
     "call-next-method"
     "initial:"
     "read-only"
+    "call("
+    "execute("
 } [ "syntax" create drop ] each
 
 "t" "syntax" lookup define-symbol

core/combinators/authors.txt

@@ -1 +1,2 @@
 Slava Pestov
+Daniel Ehrenberg

core/combinators/combinators-docs.factor

@@ -1,6 +1,7 @@
 USING: arrays help.markup help.syntax strings sbufs vectors
 kernel quotations generic generic.standard classes
-math assocs sequences sequences.private ;
+math assocs sequences sequences.private combinators.private
+effects words ;
 IN: combinators
 
 ARTICLE: "combinators-quot" "Quotation construction utilities"
@@ -9,6 +10,19 @@ ARTICLE: "combinators-quot" "Quotation construction utilities"
 { $subsection case>quot }
 { $subsection alist>quot } ;
 
+ARTICLE: "call" "Calling code with known stack effects"
+"Arbitrary quotations and words can be called from code accepted by the optimizing compiler. This is done by specifying the stack effect of the quotation literally. It is checked at runtime that the stack effect is accurate."
+$nl
+"Quotations:"
+{ $subsection POSTPONE: call( }
+{ $subsection call-effect }
+"Words:"
+{ $subsection POSTPONE: execute( }
+{ $subsection execute-effect }
+"Unsafe calls:"
+{ $subsection call-effect-unsafe }
+{ $subsection execute-effect-unsafe } ;
+
 ARTICLE: "combinators" "Additional combinators"
 "The " { $vocab-link "combinators" } " vocabulary provides a few useful combinators."
 $nl
@@ -27,11 +41,27 @@ $nl
 $nl
 "A combinator which can help with implementing methods on " { $link hashcode* } ":"
 { $subsection recursive-hashcode }
+{ $subsection "call" }
 { $subsection "combinators-quot" }
 { $see-also "quotations" "dataflow" } ;
 
 ABOUT: "combinators"
 
+HELP: call-effect
+{ $values { "quot" quotation } { "effect" effect } }
+{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." } ;
+
+HELP: execute-effect
+{ $values { "word" word } { "effect" effect } }
+{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." } ;
+
+HELP: execute-effect-unsafe
+{ $values { "word" word } { "effect" effect } }
+{ $description "Given a word and a stack effect, executes the word, blindly declaring at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." }
+{ $warning "If the word being executed has an incorrect stack effect, undefined behavior will result. User code should use " { $link POSTPONE: execute( } " instead." } ;
+    
+{ call-effect call-effect-unsafe execute-effect execute-effect-unsafe } related-words
+
 HELP: cleave
 { $values { "x" object } { "seq" "a sequence of quotations with stack effect " { $snippet "( x -- ... )" } } }
 { $description "Applies each quotation to the object in turn." }

core/combinators/combinators-tests.factor

@@ -3,6 +3,30 @@ namespaces combinators words classes sequences accessors
 math.functions arrays ;
 IN: combinators.tests
 
+[ 3 ] [ 1 2 [ + ] call( x y -- z ) ] unit-test
+[ 1 2 [ + ] call( -- z ) ] must-fail
+[ 1 2 [ + ] call( x y -- z a ) ] must-fail
+[ 1 2 3 { 1 2 3 4 } ] [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test
+[ [ + ] call( x y -- z ) ] must-infer
+
+[ 3 ] [ 1 2 \ + execute( x y -- z ) ] unit-test
+[ 1 2 \ + execute( -- z ) ] must-fail
+[ 1 2 \ + execute( x y -- z a ) ] must-fail
+[ \ + execute( x y -- z ) ] must-infer
+
+: compile-execute(-test-1 ( a b -- c ) \ + execute( a b -- c ) ;
+
+[ t ] [ \ compile-execute(-test-1 optimized>> ] unit-test
+[ 4 ] [ 1 3 compile-execute(-test-1 ] unit-test
+
+: compile-execute(-test-2 ( a b w -- c ) execute( a b -- c ) ;
+
+[ t ] [ \ compile-execute(-test-2 optimized>> ] unit-test
+[ 4 ] [ 1 3 \ + compile-execute(-test-2 ] unit-test
+[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
+[ -3 ] [ 1 4 \ - compile-execute(-test-2 ] unit-test
+[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
+
 ! Compiled
 : cond-test-1 ( obj -- str )
     {

core/combinators/combinators.factor

@@ -1,10 +1,34 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays sequences sequences.private math.private
 kernel kernel.private math assocs quotations vectors
 hashtables sorting words sets math.order make ;
 IN: combinators
 
+<PRIVATE
+
+: call-effect-unsafe ( quot effect -- ) drop call ;
+
+: execute-effect-unsafe ( word effect -- ) drop execute ;
+
+M: object throw 5 getenv [ die ] or (( error -- * )) call-effect-unsafe ;
+
+PRIVATE>
+
+ERROR: wrong-values effect ;
+
+! We can't USE: effects here so we forward reference slots instead
+SLOT: in
+SLOT: out
+
+: call-effect ( quot effect -- )
+    [ [ datastack ] dip dip ] dip
+    [ in>> length ] [ out>> length ] [ ] tri [ check-datastack ] dip
+    [ wrong-values ] curry unless ;
+
+: execute-effect ( word effect -- )
+    [ [ execute ] curry ] dip call-effect ;
+
 ! cleave
 : cleave ( x seq -- )
     [ call ] with each ;

core/continuations/continuations-docs.factor

@@ -83,7 +83,6 @@ $nl
 { $subsection with-return }
 "Reflecting the datastack:"
 { $subsection with-datastack }
-{ $subsection assert-depth }
 "Continuations serve as the building block for a number of higher-level abstractions, such as " { $link "errors" } " and " { $link "threads" } "."
 { $subsection "continuations.private" } ;
 
@@ -217,10 +216,6 @@ HELP: with-datastack
     { $example "USING: continuations math prettyprint ;" "{ 3 7 } [ + ] with-datastack ." "{ 10 }" }
 } ;
 
-HELP: assert-depth
-{ $values { "quot" "a quotation" } }
-{ $description "Runs a quotation. Throws an error if the quotation attempts to take input values from the stack, or leave outputs on the stack." } ;
-
 HELP: attempt-all
 { $values
      { "seq" sequence } { "quot" quotation }

core/continuations/continuations.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2003, 2008 Slava Pestov.
+! Copyright (C) 2003, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays vectors kernel kernel.private sequences
 namespaces make math splitting sorting quotations assocs
-combinators accessors ;
+combinators combinators.private accessors ;
 IN: continuations
 
 SYMBOL: error
@@ -73,7 +73,7 @@ C: <continuation> continuation
 
 <PRIVATE
 
-: (continue) ( continuation -- )
+: (continue) ( continuation -- * )
     >continuation<
     set-catchstack
     set-namestack
@@ -81,19 +81,18 @@ C: <continuation> continuation
     [ set-datastack ] dip
     set-callstack ;
 
-: (continue-with) ( obj continuation -- )
-    swap 4 setenv
-    >continuation<
-    set-catchstack
-    set-namestack
-    set-retainstack
-    [ set-datastack drop 4 getenv f 4 setenv f ] dip
-    set-callstack ;
-
 PRIVATE>
 
 : continue-with ( obj continuation -- * )
-    [ (continue-with) ] 2 (throw) ;
+    [
+        swap 4 setenv
+        >continuation<
+        set-catchstack
+        set-namestack
+        set-retainstack
+        [ set-datastack drop 4 getenv f 4 setenv f ] dip
+        set-callstack
+    ] (( obj continuation -- * )) call-effect-unsafe ;
 
 : continue ( continuation -- * )
     f swap continue-with ;
@@ -111,12 +110,9 @@ SYMBOL: return-continuation
         [
             [ [ { } like set-datastack ] dip call datastack ] dip
             continue-with
-        ] 3 (throw)
+        ] (( stack quot continuation -- * )) call-effect-unsafe
     ] callcc1 2nip ;
 
-: assert-depth ( quot -- )
-    { } swap with-datastack { } assert= ; inline
-
 GENERIC: compute-restarts ( error -- seq )
 
 <PRIVATE
@@ -133,7 +129,7 @@ SYMBOL: thread-error-hook
     dup save-error
     catchstack* empty? [
         thread-error-hook get-global
-        [ 1 (throw) ] [ die ] if*
+        [ (( error -- * )) call-effect-unsafe ] [ die ] if*
     ] when
     c> continue-with ;
 

core/effects/parser/parser.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: lexer sets sequences kernel splitting effects
 combinators arrays parser ;
@@ -26,3 +26,6 @@ ERROR: bad-effect ;
 : parse-effect ( end -- effect )
     parse-effect-tokens { "--" } split1 dup
     [ <effect> ] [ "Stack effect declaration must contain --" throw ] if ;
+
+: parse-call( ( accum word -- accum )
+    [ ")" parse-effect parsed ] dip parsed ;

core/kernel/kernel.factor

@@ -22,6 +22,8 @@ DEFER: 3dip
 ! Combinators
 GENERIC: call ( callable -- )
 
+GENERIC: execute ( word -- )
+
 DEFER: if
 
 : ? ( ? true false -- true/false )
@@ -235,7 +237,7 @@ GENERIC: boa ( ... class -- tuple )
 
 ! Error handling -- defined early so that other files can
 ! throw errors before continuations are loaded
-: throw ( error -- * ) 5 getenv [ die ] or 1 (throw) ;
+GENERIC: throw ( error -- * )
 
 ERROR: assert got expect ;
 

core/parser/parser-tests.factor

@@ -402,9 +402,7 @@ IN: parser.tests
     [ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test
 ] times
 
-[ "vocab:parser/test/assert-depth.factor" run-file ]
+[ "vocab:parser/test/assert-depth.factor" run-file ] must-fail
-[ got>> { 1 2 3 } sequence= ]
-must-fail-with
 
 2 [
     [ ] [

core/parser/parser.factor

@@ -1,11 +1,10 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays definitions generic assocs kernel math namespaces
-sequences strings vectors words words.symbol quotations io
+sequences strings vectors words words.symbol quotations io combinators
-combinators sorting splitting math.parser effects continuations
+sorting splitting math.parser effects continuations io.files vocabs
-io.files vocabs io.encodings.utf8 source-files
+io.encodings.utf8 source-files classes hashtables compiler.errors
-classes hashtables compiler.errors compiler.units accessors sets
+compiler.units accessors sets lexer vocabs.parser slots ;
-lexer vocabs.parser slots ;
 IN: parser
 
 : location ( -- loc )
@@ -90,9 +89,9 @@ SYMBOL: auto-use?
 
 ERROR: staging-violation word ;
 
-: execute-parsing ( word -- )
+: execute-parsing ( accum word -- accum )
     dup changed-definitions get key? [ staging-violation ] when
-    execute ;
+    execute( accum -- accum ) ;
 
 : scan-object ( -- object )
     scan-word dup parsing-word?
@@ -125,7 +124,7 @@ M: f parse-quotation \ ] parse-until >quotation ;
     [ f parse-until >quotation ] with-lexer ;
 
 : parse-lines ( lines -- quot )
-    lexer-factory get call (parse-lines) ;
+    lexer-factory get call( lines -- lexer ) (parse-lines) ;
 
 : parse-literal ( accum end quot -- accum )
     [ parse-until ] dip call parsed ; inline
@@ -214,7 +213,7 @@ print-use-hook [ [ ] ] initialize
     [
         V{ } clone amended-use set
         parse-lines
-        amended-use get empty? [ print-use-hook get assert-depth ] unless
+        amended-use get empty? [ print-use-hook get call( -- ) ] unless
     ] with-file-vocabs ;
 
 : parsing-file ( file -- )
@@ -288,7 +287,7 @@ print-use-hook [ [ ] ] initialize
     ] recover ;
 
 : run-file ( file -- )
-    [ parse-file call ] curry assert-depth ;
+    parse-file call( -- ) ;
 
 : ?run-file ( path -- )
     dup exists? [ run-file ] [ drop ] if ;

core/strings/parser/parser.factor

@@ -29,7 +29,7 @@ name>char-hook [
 : unicode-escape ( str -- ch str' )
     "{" ?head-slice [
         CHAR: } over index cut-slice
-        [ >string name>char-hook get call ] dip
+        [ >string name>char-hook get call( name -- char ) ] dip
         rest-slice
     ] [
         6 cut-slice [ hex> ] dip
@@ -45,10 +45,10 @@ name>char-hook [
 : (parse-string) ( str -- m )
     dup [ "\"\\" member? ] find dup [
         [ cut-slice [ % ] dip rest-slice ] dip
-        dup CHAR: " = [
+        CHAR: " = [
-            drop from>>
+            from>>
         ] [
-            drop next-escape [ , ] dip (parse-string)
+            next-escape [ , ] dip (parse-string)
         ] if
     ] [
         "Unterminated string" throw
@@ -59,8 +59,8 @@ name>char-hook [
         [ swap tail-slice (parse-string) ] "" make swap
     ] change-lexer-column ;
 
-: (unescape-string) ( str -- str' )
+: (unescape-string) ( str -- )
-    dup [ CHAR: \\ = ] find [
+    CHAR: \\ over index dup [
         cut-slice [ % ] dip rest-slice
         next-escape [ , ] dip
         (unescape-string)

core/syntax/syntax-docs.factor

@@ -770,3 +770,13 @@ HELP: call-next-method
 { POSTPONE: call-next-method (call-next-method) next-method } related-words
 
 { POSTPONE: << POSTPONE: >> } related-words
+
+HELP: call(
+{ $syntax "call( stack -- effect )" }
+{ $description "Calls the quotation on the top of the stack, asserting that it has the given stack effect. The quotation does not need to be known at compile time." } ;
+
+HELP: execute(
+{ $syntax "execute( stack -- effect )" }
+{ $description "Calls the word on the top of the stack, asserting that it has the given stack effect. The word does not need to be known at compile time." } ;
+
+{ POSTPONE: call( POSTPONE: execute( } related-words

core/syntax/syntax.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien arrays byte-arrays definitions generic
 hashtables kernel math namespaces parser lexer sequences strings
@@ -246,4 +246,8 @@ IN: bootstrap.syntax
     "initial:" "syntax" lookup define-symbol
     
     "read-only" "syntax" lookup define-symbol
+
+    "call(" [ \ call-effect parse-call( ] define-syntax
+
+    "execute(" [ \ execute-effect parse-call( ] define-syntax
 ] with-compilation-unit

core/vocabs/loader/loader.factor

@@ -64,7 +64,7 @@ SYMBOL: load-help?
         +parsing+ >>source-loaded?
         dup vocab-source-path [ parse-file ] [ [ ] ] if*
         [ +parsing+ >>source-loaded? ] dip
-        [ % ] [ assert-depth ] if-bootstrapping
+        [ % ] [ call( -- ) ] if-bootstrapping
         +done+ >>source-loaded? drop
     ] [ ] [ f >>source-loaded? ] cleanup ;
 

core/vocabs/vocabs.factor

@@ -105,4 +105,4 @@ M: vocab-spec forget* forget-vocab ;
 
 SYMBOL: load-vocab-hook ! ( name -- vocab )
 
-: load-vocab ( name -- vocab ) load-vocab-hook get call ;
+: load-vocab ( name -- vocab ) load-vocab-hook get call( name -- vocab ) ;

core/words/words.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions graphs assocs kernel
 kernel.private slots.private math namespaces sequences strings
@@ -10,8 +10,6 @@ IN: words
 
 : set-word ( word -- ) \ word set-global ;
 
-GENERIC: execute ( word -- )
-
 M: word execute (execute) ;
 
 M: word <=>

extra/4DNav/4DNav.factor

@@ -17,7 +17,6 @@ colors
 colors.constants
 prettyprint
 vars
-call
 quotations
 io
 io.directories

extra/monads/monads-tests.factor

@@ -79,7 +79,7 @@ IN: monads.tests
 LAZY: nats-from ( n -- list )
     dup 1+ nats-from cons ;
 
-: nats 0 nats-from ;
+: nats ( -- list ) 0 nats-from ;
 
 [ 3 ] [
     {

extra/monads/monads.factor

@@ -6,7 +6,7 @@ shuffle ;
 IN: monads
 
 ! Functors
-GENERIC# fmap 1 ( functor quot -- functor' ) inline
+GENERIC# fmap 1 ( functor quot -- functor' )
 
 ! Monads
 
@@ -21,7 +21,7 @@ GENERIC: >>= ( mvalue -- quot )
 M: monad return monad-of return ;
 M: monad fail   monad-of fail   ;
 
-: bind ( mvalue quot -- mvalue' ) swap >>= call ;
+: bind ( mvalue quot -- mvalue' ) swap >>= call( quot -- mvalue ) ;
 : >>   ( mvalue k -- mvalue' ) '[ drop _ ] bind ;
 
 :: lift-m2 ( m1 m2 f monad -- m3 )
@@ -30,14 +30,14 @@ M: monad fail   monad-of fail   ;
 :: apply ( mvalue mquot monad -- result )
     mvalue [| value |
         mquot [| quot |
-            value quot call monad return
+            value quot call( value -- mvalue ) monad return
         ] bind
     ] bind ;
 
 M: monad fmap over '[ @ _ return ] bind ;
 
 ! 'do' notation
-: do ( quots -- result ) unclip dip [ bind ] each ;
+: do ( quots -- result ) unclip [ call( -- mvalue ) ] curry dip [ bind ] each ;
 
 ! Identity
 SINGLETON: identity-monad
@@ -51,7 +51,7 @@ M: identity monad-of drop identity-monad ;
 M: identity-monad return drop identity boa ;
 M: identity-monad fail   "Fail" throw ;
 
-M: identity >>= value>> '[ _ swap call ] ;
+M: identity >>= value>> '[ _ swap call( x -- y ) ] ;
 
 : run-identity ( identity -- value ) value>> ;
 
@@ -73,7 +73,7 @@ M: maybe-monad return drop just ;
 M: maybe-monad fail   2drop nothing ;
 
 M: nothing >>= '[ drop _ ] ;
-M: just    >>= value>> '[ _ swap call ] ;
+M: just    >>= value>> '[ _ swap call( x -- y ) ] ;
 
 : if-maybe ( maybe just-quot nothing-quot -- )
     pick nothing? [ 2nip call ] [ drop [ value>> ] dip call ] if ; inline
@@ -97,7 +97,7 @@ M: either-monad return  drop right ;
 M: either-monad fail    drop left ;
 
 M: left  >>= '[ drop _ ] ;
-M: right >>= value>> '[ _ swap call ] ;
+M: right >>= value>> '[ _ swap call( x -- y ) ] ;
 
 : if-either ( value left-quot right-quot -- )
     [ [ value>> ] [ left? ] bi ] 2dip if ; inline
@@ -140,14 +140,14 @@ M: state monad-of drop state-monad ;
 M: state-monad return drop '[ _ 2array ] state ;
 M: state-monad fail   "Fail" throw ;
 
-: mcall ( state -- ) quot>> call ;
+: mcall ( x state -- y ) quot>> call( x -- y ) ;
 
 M: state >>= '[ _ swap '[ _ mcall first2 @ mcall ] state ] ;
 
 : get-st ( -- state ) [ dup 2array ] state ;
 : put-st ( value -- state ) '[ drop _ f 2array ] state ;
 
-: run-st ( state initial -- ) swap mcall second ;
+: run-st ( state initial -- value ) swap mcall second ;
 
 : return-st ( value -- mvalue ) state-monad return ;
 
@@ -166,7 +166,7 @@ M: reader-monad fail   "Fail" throw ;
 
 M: reader >>= '[ _ swap '[ dup _ mcall @ mcall ] reader ] ;
 
-: run-reader ( reader env -- ) swap mcall ;
+: run-reader ( reader env -- value ) swap quot>> call( env -- value ) ;
 
 : ask ( -- reader ) [ ] reader ;
 : local ( reader quot -- reader' ) swap '[ @ _ mcall ] reader ;
@@ -187,6 +187,6 @@ M: writer-monad fail   "Fail" throw ;
 
 M: writer >>= '[ [ _ run-writer ] dip '[ @ run-writer ] dip append writer ] ;
 
-: pass ( writer -- writer' ) run-writer [ first2 ] dip swap call writer ;
+: pass ( writer -- writer' ) run-writer [ first2 ] dip swap call( x -- y ) writer ;
 : listen ( writer -- writer' ) run-writer [ 2array ] keep writer ;
 : tell ( seq -- writer ) f swap writer ;

extra/promises/promises.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2006 Chris Double, Matthew Willis.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel sequences math vectors arrays namespaces call
+USING: arrays kernel sequences math vectors arrays namespaces
 make quotations parser effects stack-checker words accessors ;
 IN: promises
 

extra/ui/gadgets/lists/lists.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors math.vectors classes.tuple math.rectangles colors
-kernel sequences models opengl math math.order namespaces call
+kernel sequences models opengl math math.order namespaces
 ui.commands ui.gestures ui.render ui.gadgets ui.gadgets.labels
 ui.gadgets.scrollers ui.gadgets.presentations ui.gadgets.viewports
 ui.gadgets.packs ;

vm/cpu-x86.32.S

@@ -29,7 +29,7 @@ and the callstack top is passed in EDX */
 	pop %ebp ; \
 	pop %ebx
 
-#define QUOT_XT_OFFSET 9
+#define QUOT_XT_OFFSET 17
 
 /* We pass a function pointer to memcpy to work around a Mac OS X
 ABI limitation which would otherwise require us to do a bizzaro PC-relative

vm/cpu-x86.64.S

@@ -61,7 +61,7 @@
 
 #endif
 
-#define QUOT_XT_OFFSET 21
+#define QUOT_XT_OFFSET 37
 
 /* We pass a function pointer to memcpy to work around a Mac OS X
 ABI limitation which would otherwise require us to do a bizzaro PC-relative

vm/errors.c

@@ -144,12 +144,6 @@ void misc_signal_handler_impl(void)
 	signal_error(signal_number,signal_callstack_top);
 }
 
-void primitive_throw(void)
-{
-	dpop();
-	throw_impl(dpop(),stack_chain->callstack_top);
-}
-
 void primitive_call_clear(void)
 {
 	throw_impl(dpop(),stack_chain->callstack_bottom);

vm/errors.h

@@ -32,7 +32,6 @@ void signal_error(int signal, F_STACK_FRAME *native_stack);
 void type_error(CELL type, CELL tagged);
 void not_implemented_error(void);
 
-void primitive_throw(void);
 void primitive_call_clear(void);
 
 INLINE void type_check(CELL type, CELL tagged)

vm/layouts.h

@@ -172,6 +172,10 @@ typedef struct {
 	CELL array;
 	/* tagged */
 	CELL compiledp;
+	/* tagged */
+	CELL cached_effect;
+	/* tagged */
+	CELL cache_counter;
 	/* UNTAGGED */
 	XT xt;
 	/* UNTAGGED compiled code block */

vm/primitives.c

@@ -102,7 +102,6 @@ void *primitives[] = {
 	primitive_set_alien_double,
 	primitive_alien_cell,
 	primitive_set_alien_cell,
-	primitive_throw,
 	primitive_alien_address,
 	primitive_set_slot,
 	primitive_string_nth,

vm/quotations.c

@@ -514,6 +514,8 @@ void primitive_array_to_quotation(void)
 	quot->array = dpeek();
 	quot->xt = lazy_jit_compile;
 	quot->compiledp = F;
+	quot->cached_effect = F;
+	quot->cache_counter = F;
 	drepl(tag_object(quot));
 }