now that stack checker works, remove compile-all machinery
Slava Pestov
parent
7161b8c5c6
commit
24e8d2fc2a
|
|
@ -4,7 +4,6 @@
|
|||
- type inference
|
||||
- some way to step over a word in the stepper
|
||||
- step: print NEXT word to execute, not word that JUST executed
|
||||
- once generic inference is done, can-compile is "has stack effect!"
|
||||
|
||||
+ compiler/ffi:
|
||||
|
||||
|
|
|
|||
|
|
@ -1,130 +0,0 @@
|
|||
! :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: compiler
|
||||
USE: combinators
|
||||
USE: errors
|
||||
USE: lists
|
||||
USE: logic
|
||||
USE: namespaces
|
||||
USE: prettyprint
|
||||
USE: stack
|
||||
USE: stdio
|
||||
USE: vectors
|
||||
USE: words
|
||||
|
||||
! A set of words to determine a set of words :-) that can be
|
||||
! compiled.
|
||||
!
|
||||
! The heuristic is rather dumb; it errs on the side of safety
|
||||
! and assumes that any vector or list will potentually contain
|
||||
! words that will be compiled; so it will refuse to recognize
|
||||
! this as being compilable for instance:
|
||||
!
|
||||
! : foo { 1 2 3 call } vector-nth ;
|
||||
!
|
||||
! Even though the instance of 'call' is never compiled here.
|
||||
|
||||
DEFER: can-compile?
|
||||
DEFER: can-compile-list?
|
||||
DEFER: can-compile-vector?
|
||||
|
||||
: can-compile-reference? ( word -- ? )
|
||||
#! We cannot compile a symbol, but we can compile a
|
||||
#! reference to a symbol. Similarly, we can compile a
|
||||
#! reference to a word with special compilation behavior,
|
||||
#! but we cannot compile the word itself.
|
||||
[
|
||||
[ symbol? ] [ drop t ]
|
||||
[ "interpret-only" word-property ] [ drop f ]
|
||||
[ "compiling" word-property ] [ drop t ]
|
||||
[ can-compile? ] [ drop t ]
|
||||
[ drop t ] [ drop f ]
|
||||
] cond ;
|
||||
|
||||
: can-compile-object? ( obj -- ? )
|
||||
[
|
||||
[ word? ] [ can-compile-reference? ]
|
||||
[ list? ] [ can-compile-list? ]
|
||||
[ vector? ] [ can-compile-vector? ]
|
||||
[ drop t ] [ drop t ]
|
||||
] cond ;
|
||||
|
||||
: can-compile-vector? ( quot -- ? )
|
||||
[ can-compile-object? ] vector-all? ;
|
||||
|
||||
: can-compile-list? ( quot -- ? )
|
||||
[ can-compile-object? ] all? ;
|
||||
|
||||
: (can-compile) ( word -- ? )
|
||||
#! We can't actually compile a word itself that has
|
||||
#! special compilation behavior.
|
||||
[
|
||||
[ "interpret-only" word-property ] [ drop f ]
|
||||
[ "compiling" word-property ] [ drop f ]
|
||||
[ compound? ] [ word-parameter can-compile-list? ]
|
||||
[ compiled? ] [ drop t ]
|
||||
[ drop t ] [ drop f ]
|
||||
] cond ;
|
||||
|
||||
: can-compile? ( word -- ? )
|
||||
#! We set it to true, then compute the actual flag, so that
|
||||
#! mutually recursive words are processed without an
|
||||
#! infinite loop.
|
||||
dup "can-compile" word-property [
|
||||
drop t
|
||||
] [
|
||||
dup t "can-compile" set-word-property
|
||||
dup (can-compile)
|
||||
[ "can-compile" set-word-property ] keep
|
||||
] ifte ;
|
||||
|
||||
SYMBOL: compilable-word-list
|
||||
|
||||
: reset-can-compile ( -- )
|
||||
[ f "can-compile" set-word-property ] each-word ;
|
||||
|
||||
: compilable-words ( -- list )
|
||||
#! Make a list of all words that can be compiled.
|
||||
reset-can-compile
|
||||
[
|
||||
[ dup can-compile? [ , ] [ drop ] ifte ] each-word
|
||||
] make-list
|
||||
reset-can-compile ;
|
||||
|
||||
: cannot-compile ( word -- )
|
||||
"verbose-compile" get [
|
||||
"Cannot compile " write .
|
||||
] [
|
||||
drop
|
||||
] ifte ;
|
||||
|
||||
: init-compiler ( -- )
|
||||
#! Compile all words.
|
||||
compilable-word-list get [
|
||||
[ compile ] [ [ cannot-compile ] when ] catch
|
||||
] each ;
|
||||
|
|
@ -224,3 +224,20 @@ SYMBOL: compile-callstack
|
|||
: compiled
|
||||
#! Compile the most recently defined word.
|
||||
word compile ; parsing
|
||||
|
||||
: cannot-compile ( word -- )
|
||||
"verbose-compile" get [
|
||||
"Cannot compile " write .
|
||||
] [
|
||||
drop
|
||||
] ifte ;
|
||||
|
||||
: compile-all ( -- )
|
||||
#! Compile all words.
|
||||
[
|
||||
dup "infer-effect" word-property [
|
||||
[ compile ] [ [ cannot-compile ] when ] catch
|
||||
] [
|
||||
drop
|
||||
] ifte
|
||||
] each-word ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,5 @@
|
|||
! Loaded on non-x86 platforms.
|
||||
IN: compiler
|
||||
|
||||
SYMBOL: compilable-word-list
|
||||
: compilable-words f ;
|
||||
: init-assembler ;
|
||||
: init-compiler ;
|
||||
: compile-all ;
|
||||
|
|
|
|||
|
|
@ -27,14 +27,10 @@
|
|||
|
||||
IN: init
|
||||
USE: combinators
|
||||
USE: compiler
|
||||
USE: errors
|
||||
USE: kernel
|
||||
USE: lists
|
||||
USE: namespaces
|
||||
USE: parser
|
||||
USE: stack
|
||||
USE: strings
|
||||
USE: stdio
|
||||
|
||||
"Cold boot in progress..." print
|
||||
|
|
@ -153,7 +149,6 @@ cpu "x86" = [
|
|||
"/library/compiler/generic.factor"
|
||||
"/library/compiler/stack.factor"
|
||||
"/library/compiler/interpret-only.factor"
|
||||
"/library/compiler/compile-all.factor"
|
||||
"/library/compiler/alien-types.factor"
|
||||
"/library/compiler/alien-macros.factor"
|
||||
"/library/compiler/alien.factor"
|
||||
|
|
@ -174,31 +169,3 @@ cpu "x86" = [
|
|||
] ifte
|
||||
|
||||
"/library/platform/native/init-stage2.factor" dup print run-resource
|
||||
|
||||
IN: init
|
||||
DEFER: warm-boot
|
||||
|
||||
IN: compiler
|
||||
DEFER: compilable-words
|
||||
DEFER: compilable-word-list
|
||||
|
||||
IN: listener
|
||||
DEFER: init-listener
|
||||
|
||||
[
|
||||
warm-boot
|
||||
"interactive" get [ init-listener ] when
|
||||
0 exit*
|
||||
] set-boot
|
||||
|
||||
compilable-words compilable-word-list set
|
||||
|
||||
"Bootstrapping is complete." print
|
||||
"Now, you can run ./f factor.image" print
|
||||
|
||||
! Save a bit of space
|
||||
global [ "stdio" off ] bind
|
||||
|
||||
garbage-collection
|
||||
"factor.image" save-image
|
||||
0 exit*
|
||||
|
|
|
|||
|
|
@ -30,16 +30,20 @@ USE: ansi
|
|||
USE: combinators
|
||||
USE: compiler
|
||||
USE: errors
|
||||
USE: httpd-responder
|
||||
USE: inference
|
||||
USE: kernel
|
||||
USE: listener
|
||||
USE: lists
|
||||
USE: math
|
||||
USE: namespaces
|
||||
USE: parser
|
||||
USE: random
|
||||
USE: stack
|
||||
USE: streams
|
||||
USE: stdio
|
||||
USE: presentation
|
||||
USE: words
|
||||
USE: unparser
|
||||
|
||||
: cli-args ( -- args ) 10 getenv ;
|
||||
|
||||
|
|
@ -69,6 +73,31 @@ USE: words
|
|||
|
||||
"ansi" get [ "stdio" get <ansi-stream> "stdio" set ] when
|
||||
|
||||
"compile" get [ init-compiler ] when
|
||||
"compile" get [ compile-all ] when
|
||||
|
||||
run-user-init ;
|
||||
|
||||
[
|
||||
warm-boot
|
||||
"interactive" get [ init-listener ] when
|
||||
0 exit*
|
||||
] set-boot
|
||||
|
||||
init-error-handler
|
||||
|
||||
0 [ drop succ ] each-word unparse write " words" print
|
||||
|
||||
"Inferring stack effects..." print
|
||||
[ 2 car ] [ ] catch
|
||||
0 [ unit try-infer [ succ ] when ] each-word
|
||||
unparse write " words have a stack effect" print
|
||||
|
||||
"Bootstrapping is complete." print
|
||||
"Now, you can run ./f factor.image" print
|
||||
|
||||
! Save a bit of space
|
||||
global [ "stdio" off ] bind
|
||||
|
||||
garbage-collection
|
||||
"factor.image" save-image
|
||||
0 exit*
|
||||
|
|
|
|||
|
|
@ -130,7 +130,7 @@ DEFER: (infer)
|
|||
call
|
||||
recursive-state uncons@ drop ;
|
||||
|
||||
: infer-word ( word -- )
|
||||
: infer-compound ( word -- effect )
|
||||
#! Infer a word's stack effect, and cache it.
|
||||
[
|
||||
recursive-state get init-inference
|
||||
|
|
@ -145,11 +145,18 @@ DEFER: (infer)
|
|||
|
||||
: apply-compound ( word -- )
|
||||
#! Infer a compound word's stack effect.
|
||||
[
|
||||
infer-word consume/produce
|
||||
dup "inline" word-property [
|
||||
inline-compound
|
||||
] [
|
||||
[ inline-compound ] when
|
||||
] catch ;
|
||||
[
|
||||
infer-compound consume/produce
|
||||
] [
|
||||
[
|
||||
dup t "inline" set-word-property
|
||||
inline-compound
|
||||
] when
|
||||
] catch
|
||||
] ifte ;
|
||||
|
||||
: apply-word ( word -- )
|
||||
#! Apply the word's stack effect to the inferencer state.
|
||||
|
|
|
|||
Loading…
Reference in New Issue