FFI compile errors now reported separately; new kill literals phase design
Slava Pestov
parent
a4e5bc11b5
commit
637600011c
|
|
@ -5,7 +5,8 @@ hashtables kernel math namespaces sequences words
|
|||
inference.state inference.backend inference.dataflow system
|
||||
math.parser classes alien.arrays alien.c-types alien.structs
|
||||
alien.syntax cpu.architecture alien inspector quotations assocs
|
||||
kernel.private threads continuations.private libc combinators ;
|
||||
kernel.private threads continuations.private libc combinators
|
||||
compiler.errors continuations ;
|
||||
IN: alien.compiler
|
||||
|
||||
! Common protocol for alien-invoke/alien-callback/alien-indirect
|
||||
|
|
@ -207,9 +208,21 @@ M: alien-invoke-error summary
|
|||
swap alien-node-parameters parameter-sizes drop
|
||||
number>string 3append ;
|
||||
|
||||
TUPLE: no-such-library name ;
|
||||
|
||||
M: no-such-library summary
|
||||
drop "Library not found" ;
|
||||
|
||||
: no-such-library ( name -- )
|
||||
\ no-such-library +linkage+ (inference-error) ;
|
||||
|
||||
: (alien-invoke-dlsym) ( node -- symbol dll )
|
||||
dup alien-invoke-function
|
||||
swap alien-invoke-library load-library ;
|
||||
swap alien-invoke-library [
|
||||
load-library
|
||||
] [
|
||||
2drop no-such-library
|
||||
] recover ;
|
||||
|
||||
TUPLE: no-such-symbol ;
|
||||
|
||||
|
|
@ -217,7 +230,7 @@ M: no-such-symbol summary
|
|||
drop "Symbol not found" ;
|
||||
|
||||
: no-such-symbol ( -- )
|
||||
\ no-such-symbol inference-error ;
|
||||
\ no-such-symbol +linkage+ (inference-error) ;
|
||||
|
||||
: alien-invoke-dlsym ( node -- symbol dll )
|
||||
dup (alien-invoke-dlsym) 2dup dlsym [
|
||||
|
|
|
|||
|
|
@ -1,14 +1,15 @@
|
|||
IN: compiler.errors
|
||||
USING: help.markup help.syntax vocabs.loader words io
|
||||
quotations ;
|
||||
quotations compiler.errors.private ;
|
||||
|
||||
ARTICLE: "compiler-errors" "Compiler warnings and errors"
|
||||
"The compiler saves compile warnings and errors in a global variable:"
|
||||
"The compiler saves various notifications in a global variable:"
|
||||
{ $subsection compiler-errors }
|
||||
"The warnings and errors can be viewed later:"
|
||||
{ $subsection :warnings }
|
||||
"These notifications can be viewed later:"
|
||||
{ $subsection :errors }
|
||||
"Normally, all warnings and errors are displayed at the end of a batch compilation, such as a call to " { $link require } " or " { $link refresh-all } ". This can be controlled with a combinator:"
|
||||
{ $subsection :warnings }
|
||||
{ $subsection :linkage }
|
||||
"Words such as " { $link require } " and " { $link refresh-all } " use a combinator which counts errors and prints a report at the end:"
|
||||
{ $link with-compiler-errors } ;
|
||||
|
||||
HELP: compiler-errors
|
||||
|
|
@ -16,7 +17,7 @@ HELP: compiler-errors
|
|||
|
||||
HELP: compiler-error
|
||||
{ $values { "error" "an error" } { "word" word } }
|
||||
{ $description "If inside a " { $link with-compiler-errors } ", saves the error for future persual via " { $link :errors } " and " { $link :warnings } ", otherwise ignores the error." } ;
|
||||
{ $description "If inside a " { $link with-compiler-errors } ", saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } ". If not inside a " { $link with-compiler-errors } ", ignores the error." } ;
|
||||
|
||||
HELP: compiler-error.
|
||||
{ $values { "error" "an error" } { "word" word } }
|
||||
|
|
@ -25,24 +26,18 @@ HELP: compiler-error.
|
|||
HELP: compiler-errors.
|
||||
{ $values { "errors" "an assoc mapping words to errors" } }
|
||||
{ $description "Prints a set of compiler errors to the " { $link stdio } " stream." } ;
|
||||
|
||||
HELP: (:errors)
|
||||
{ $values { "seq" "an alist" } }
|
||||
{ $description "Outputs all serious compiler errors from the most recent compile." } ;
|
||||
|
||||
HELP: :errors
|
||||
{ $description "Prints all serious compiler errors from the most recent compile to the " { $link stdio } " stream." } ;
|
||||
|
||||
HELP: (:warnings)
|
||||
{ $values { "seq" "an alist" } }
|
||||
{ $description "Outputs all ignorable compiler warnings from the most recent compile." } ;
|
||||
|
||||
HELP: :warnings
|
||||
{ $description "Prints all ignorable compiler warnings from the most recent compile to the " { $link stdio } " stream." } ;
|
||||
|
||||
{ :errors (:errors) :warnings (:warnings) } related-words
|
||||
HELP: :linkage
|
||||
{ $description "Prints all C library interface linkage errors from the most recent compile to the " { $link stdio } " stream." } ;
|
||||
|
||||
{ :errors :warnings } related-words
|
||||
|
||||
HELP: with-compiler-errors
|
||||
{ $values { "quot" quotation } }
|
||||
{ $description "Calls the quotation and collects any compiler warnings and errors. Compiler warnings and errors are summarized at the end and can be viewed with " { $link :warnings } " and " { $link :errors } "." }
|
||||
{ $description "Calls the quotation and collects any compiler warnings and errors. Compiler warnings and errors are summarized at the end and can be viewed with " { $link :errors } ", " { $link :warnings } ", and " { $link :linkage } "." }
|
||||
{ $notes "Nested calls to " { $link with-compiler-errors } " are ignored, and only the outermost call collects warnings and errors." } ;
|
||||
|
|
|
|||
|
|
@ -4,51 +4,66 @@ USING: kernel namespaces assocs prettyprint io sequences
|
|||
sorting continuations debugger math math.parser ;
|
||||
IN: compiler.errors
|
||||
|
||||
SYMBOL: +error+
|
||||
SYMBOL: +warning+
|
||||
SYMBOL: +linkage+
|
||||
|
||||
GENERIC: compiler-error-type ( error -- ? )
|
||||
|
||||
M: object compiler-error-type drop +error+ ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOL: compiler-errors
|
||||
|
||||
SYMBOL: with-compiler-errors?
|
||||
|
||||
: compiler-error ( error word -- )
|
||||
with-compiler-errors? get [
|
||||
compiler-errors get pick
|
||||
[ set-at ] [ delete-at drop ] if
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: compiler-error. ( error word -- )
|
||||
nl
|
||||
"While compiling " write pprint ": " print
|
||||
nl
|
||||
print-error ;
|
||||
|
||||
: compiler-errors. ( assoc -- )
|
||||
>alist sort-keys [ swap compiler-error. ] assoc-each ;
|
||||
|
||||
GENERIC: compiler-warning? ( error -- ? )
|
||||
|
||||
M: object compiler-warning? drop f ;
|
||||
|
||||
: (:errors) ( -- assoc )
|
||||
: errors-of-type ( type -- assoc )
|
||||
compiler-errors get-global
|
||||
[ nip compiler-warning? not ] assoc-subset ;
|
||||
swap [ >r nip compiler-error-type r> eq? ] curry
|
||||
assoc-subset ;
|
||||
|
||||
: :errors (:errors) compiler-errors. ;
|
||||
: compiler-errors. ( type -- )
|
||||
errors-of-type >alist sort-keys
|
||||
[ swap compiler-error. ] assoc-each ;
|
||||
|
||||
: (:warnings) ( -- seq )
|
||||
compiler-errors get-global
|
||||
[ nip compiler-warning? ] assoc-subset ;
|
||||
|
||||
: :warnings (:warnings) compiler-errors. ;
|
||||
|
||||
: (compiler-report) ( what assoc -- )
|
||||
length dup zero? [ 2drop ] [
|
||||
: (compiler-report) ( what type word -- )
|
||||
over errors-of-type assoc-empty? [ 3drop ] [
|
||||
[
|
||||
":" % over % " - print " % # " compiler " % % "." %
|
||||
":" %
|
||||
%
|
||||
" - print " %
|
||||
errors-of-type assoc-size #
|
||||
" " %
|
||||
%
|
||||
"." %
|
||||
] "" make print
|
||||
] if ;
|
||||
|
||||
: compiler-report ( -- )
|
||||
"errors" (:errors) (compiler-report)
|
||||
"warnings" (:warnings) (compiler-report) ;
|
||||
"semantic errors" +error+ "errors" (compiler-report)
|
||||
"semantic warnings" +warning+ "warnings" (compiler-report)
|
||||
"linkage errors" +linkage+ "linkage" (compiler-report) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: compiler-error ( error word -- )
|
||||
with-compiler-errors? get [
|
||||
compiler-errors get pick
|
||||
[ set-at ] [ delete-at drop ] if
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: :errors +error+ compiler-errors. ;
|
||||
|
||||
: :warnings +warning+ compiler-errors. ;
|
||||
|
||||
: :linkage +linkage+ compiler-errors. ;
|
||||
|
||||
: with-compiler-errors ( quot -- )
|
||||
with-compiler-errors? get "quiet" get or [ call ] [
|
||||
|
|
|
|||
|
|
@ -24,24 +24,24 @@ IN: inference.backend
|
|||
: recursive-quotation? ( quot -- ? )
|
||||
local-recursive-state [ first eq? ] with contains? ;
|
||||
|
||||
TUPLE: inference-error rstate major? ;
|
||||
TUPLE: inference-error rstate type ;
|
||||
|
||||
M: inference-error compiler-warning?
|
||||
inference-error-major? not ;
|
||||
M: inference-error compiler-error-type
|
||||
inference-error-type ;
|
||||
|
||||
: (inference-error) ( ... class important? -- * )
|
||||
: (inference-error) ( ... class type -- * )
|
||||
>r construct-boa r>
|
||||
recursive-state get {
|
||||
set-delegate
|
||||
set-inference-error-major?
|
||||
set-inference-error-type
|
||||
set-inference-error-rstate
|
||||
} \ inference-error construct throw ; inline
|
||||
|
||||
: inference-error ( ... class -- * )
|
||||
t (inference-error) ; inline
|
||||
+error+ (inference-error) ; inline
|
||||
|
||||
: inference-warning ( ... class -- * )
|
||||
f (inference-error) ; inline
|
||||
+warning+ (inference-error) ; inline
|
||||
|
||||
TUPLE: literal-expected ;
|
||||
|
||||
|
|
|
|||
|
|
@ -269,7 +269,17 @@ cell-bits 32 = [
|
|||
\ number= inlined?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ B{ 1 0 } *short 0 { number number } declare number= ]
|
||||
\ number= inlined?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ B{ 1 0 } *short 0 = ]
|
||||
\ number= inlined?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ B{ 1 0 } *short dup number? [ 0 number= ] [ drop f ] if ]
|
||||
\ number= inlined?
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -73,17 +73,27 @@ SYMBOL: value-intervals
|
|||
! Current value --> class mapping
|
||||
SYMBOL: value-classes
|
||||
|
||||
: value-interval* ( value -- interval/f )
|
||||
value-intervals get at ;
|
||||
|
||||
: set-value-interval* ( interval value -- )
|
||||
value-intervals get set-at ;
|
||||
|
||||
: intersect-value-interval ( interval value -- )
|
||||
[ value-interval* interval-intersect ] keep
|
||||
set-value-interval* ;
|
||||
|
||||
M: interval-constraint apply-constraint
|
||||
dup interval-constraint-interval
|
||||
swap interval-constraint-value set-value-interval* ;
|
||||
swap interval-constraint-value intersect-value-interval ;
|
||||
|
||||
: set-class-interval ( class value -- )
|
||||
>r "interval" word-prop dup
|
||||
[ r> set-value-interval* ] [ r> 2drop ] if ;
|
||||
|
||||
: value-class* ( value -- class )
|
||||
value-classes get at object or ;
|
||||
|
||||
: set-value-class* ( class value -- )
|
||||
over [
|
||||
dup value-intervals get at [
|
||||
|
|
@ -93,9 +103,12 @@ M: interval-constraint apply-constraint
|
|||
] when
|
||||
value-classes get set-at ;
|
||||
|
||||
: intersect-value-class ( class value -- )
|
||||
[ value-class* class-and ] keep set-value-class* ;
|
||||
|
||||
M: class-constraint apply-constraint
|
||||
dup class-constraint-class
|
||||
swap class-constraint-value set-value-class* ;
|
||||
swap class-constraint-value intersect-value-class ;
|
||||
|
||||
: set-value-literal* ( literal value -- )
|
||||
over class over set-value-class*
|
||||
|
|
@ -127,16 +140,10 @@ M: literal-constraint constraint-satisfied?
|
|||
dup literal-constraint-value value-literal*
|
||||
[ swap literal-constraint-literal eql? ] [ 2drop f ] if ;
|
||||
|
||||
: value-class* ( value -- class )
|
||||
value-classes get at object or ;
|
||||
|
||||
M: class-constraint constraint-satisfied?
|
||||
dup class-constraint-value value-class*
|
||||
swap class-constraint-class class< ;
|
||||
|
||||
: value-interval* ( value -- interval/f )
|
||||
value-intervals get at ;
|
||||
|
||||
M: pair apply-constraint
|
||||
first2 2dup constraints get set-at
|
||||
constraint-satisfied? [ apply-constraint ] [ drop ] if ;
|
||||
|
|
@ -159,13 +166,10 @@ M: pair constraint-satisfied?
|
|||
2drop ;
|
||||
|
||||
: intersect-classes ( classes values -- )
|
||||
[ [ value-class* class-and ] keep set-value-class* ] 2each ;
|
||||
[ intersect-value-class ] 2each ;
|
||||
|
||||
: intersect-intervals ( intervals values -- )
|
||||
[
|
||||
[ value-interval* interval-intersect ] keep
|
||||
set-value-interval*
|
||||
] 2each ;
|
||||
[ intersect-value-interval ] 2each ;
|
||||
|
||||
: predicate-constraints ( class #call -- )
|
||||
[
|
||||
|
|
@ -220,7 +224,8 @@ M: #dispatch child-constraints
|
|||
] make-constraints ;
|
||||
|
||||
M: #declare infer-classes-before
|
||||
dup node-param swap node-in-d [ set-value-class* ] 2each ;
|
||||
dup node-param swap node-in-d
|
||||
[ intersect-value-class ] 2each ;
|
||||
|
||||
DEFER: (infer-classes)
|
||||
|
||||
|
|
|
|||
|
|
@ -256,6 +256,28 @@ SYMBOL: node-stack
|
|||
] iterate-nodes drop
|
||||
] with-node-iterator ; inline
|
||||
|
||||
: change-children ( node quot -- )
|
||||
over [
|
||||
>r dup node-children dup r>
|
||||
[ map swap set-node-children ] curry
|
||||
[ 2drop ] if
|
||||
] [
|
||||
2drop
|
||||
] if ; inline
|
||||
|
||||
: (transform-nodes) ( prev node quot -- )
|
||||
dup >r call dup [
|
||||
dup rot set-node-successor
|
||||
dup node-successor r> (transform-nodes)
|
||||
] [
|
||||
r> drop f swap set-node-successor drop
|
||||
] if ; inline
|
||||
|
||||
: transform-nodes ( node quot -- new-node )
|
||||
over [
|
||||
[ call dup dup node-successor ] keep (transform-nodes)
|
||||
] [ drop ] if ; inline
|
||||
|
||||
: node-literal? ( node value -- ? )
|
||||
dup value? >r swap node-literals key? r> or ;
|
||||
|
||||
|
|
|
|||
|
|
@ -52,13 +52,7 @@ GENERIC: optimize-node* ( node -- node/t changed? )
|
|||
DEFER: optimize-nodes
|
||||
|
||||
: optimize-children ( node -- )
|
||||
[
|
||||
dup node-children dup [
|
||||
[ optimize-nodes ] map swap set-node-children
|
||||
] [
|
||||
2drop
|
||||
] if
|
||||
] when* ;
|
||||
[ optimize-nodes ] change-children ;
|
||||
|
||||
: optimize-node ( node -- node )
|
||||
dup [
|
||||
|
|
@ -76,39 +70,17 @@ DEFER: optimize-nodes
|
|||
|
||||
M: f set-node-successor 2drop ;
|
||||
|
||||
: (optimize-nodes) ( prev node -- )
|
||||
optimize-node [
|
||||
dup rot set-node-successor
|
||||
dup node-successor (optimize-nodes)
|
||||
] [
|
||||
f swap set-node-successor
|
||||
] if* ;
|
||||
|
||||
: optimize-nodes ( node -- newnode )
|
||||
[
|
||||
class-substitutions [ clone ] change
|
||||
literal-substitutions [ clone ] change
|
||||
dup [
|
||||
optimize-node
|
||||
dup dup node-successor (optimize-nodes)
|
||||
] when optimizer-changed get
|
||||
[ optimize-node ] transform-nodes
|
||||
optimizer-changed get
|
||||
] with-scope optimizer-changed set ;
|
||||
|
||||
: prune-if ( node quot -- successor/t )
|
||||
over >r call [ r> node-successor t ] [ r> drop t f ] if ;
|
||||
inline
|
||||
|
||||
! Generic nodes
|
||||
M: node optimize-node* drop t f ;
|
||||
|
||||
M: #shuffle optimize-node*
|
||||
[
|
||||
dup node-in-d empty? swap node-out-d empty? and
|
||||
] prune-if ;
|
||||
|
||||
M: #push optimize-node*
|
||||
[ node-out-d empty? ] prune-if ;
|
||||
|
||||
: cleanup-inlining ( node -- newnode changed? )
|
||||
node-successor [ node-successor t ] [ t f ] if* ;
|
||||
|
||||
|
|
@ -118,12 +90,6 @@ M: #return optimize-node* cleanup-inlining ;
|
|||
! #values
|
||||
M: #values optimize-node* cleanup-inlining ;
|
||||
|
||||
! #>r
|
||||
M: #>r optimize-node* [ node-in-d empty? ] prune-if ;
|
||||
|
||||
! #r>
|
||||
M: #r> optimize-node* [ node-in-r empty? ] prune-if ;
|
||||
|
||||
! Some utilities for splicing in dataflow IR subtrees
|
||||
: follow ( key assoc -- value )
|
||||
2dup at* [ swap follow nip ] [ 2drop ] if ;
|
||||
|
|
@ -194,10 +160,8 @@ M: node remember-method*
|
|||
|
||||
! Constant branch folding
|
||||
: fold-branch ( node branch# -- node )
|
||||
over drop-inputs >r
|
||||
over node-children nth
|
||||
swap node-successor over substitute-node
|
||||
r> [ set-node-successor ] keep ;
|
||||
swap node-successor over substitute-node ;
|
||||
|
||||
! #if
|
||||
: known-boolean-value? ( node value -- value ? )
|
||||
|
|
@ -213,12 +177,18 @@ M: node remember-method*
|
|||
] if ;
|
||||
|
||||
M: #if optimize-node*
|
||||
dup dup node-in-d first known-boolean-value?
|
||||
[ 0 1 ? fold-branch t ] [ 2drop t f ] if ;
|
||||
dup dup node-in-d first known-boolean-value? [
|
||||
over drop-inputs >r
|
||||
0 1 ? fold-branch
|
||||
r> [ set-node-successor ] keep
|
||||
t
|
||||
] [ 2drop t f ] if ;
|
||||
|
||||
M: #dispatch optimize-node*
|
||||
dup dup node-in-d first 2dup node-literal? [
|
||||
node-literal fold-branch t
|
||||
"Optimizing #dispatch" print
|
||||
node-literal
|
||||
over drop-inputs >r fold-branch r> [ set-node-successor ] keep t
|
||||
] [
|
||||
3drop t f
|
||||
] if ;
|
||||
|
|
@ -322,9 +292,19 @@ DEFER: (flat-length)
|
|||
#! Make #shuffle -> #push -> #return -> successor
|
||||
dupd literal-quot splice-quot ;
|
||||
|
||||
: optimize-predicate ( #call -- node )
|
||||
: evaluate-predicate ( #call -- ? )
|
||||
dup node-param "predicating" word-prop >r
|
||||
dup node-class-first r> class< 1array inline-literals ;
|
||||
node-class-first r> class< ;
|
||||
|
||||
: optimize-predicate ( #call -- node )
|
||||
dup evaluate-predicate swap
|
||||
dup node-successor #if? [
|
||||
dup drop-inputs >r
|
||||
node-successor swap 0 1 ? fold-branch
|
||||
r> [ set-node-successor ] keep
|
||||
] [
|
||||
swap 1array inline-literals
|
||||
] if ;
|
||||
|
||||
: optimizer-hooks ( node -- conditions )
|
||||
node-param "optimizer-hooks" word-prop ;
|
||||
|
|
|
|||
|
|
@ -70,19 +70,66 @@ M: #branch node-def-use
|
|||
#! #values node.
|
||||
dup branch-def-use (node-def-use) ;
|
||||
|
||||
: dead-literals ( -- values )
|
||||
! : dead-literals ( -- values )
|
||||
! def-use get [ >r value? r> empty? and ] assoc-subset ;
|
||||
!
|
||||
! : kill-node* ( node values -- )
|
||||
! [ swap remove-all ] curry modify-values ;
|
||||
!
|
||||
! : kill-node ( node values -- )
|
||||
! dup assoc-empty?
|
||||
! [ 2drop ] [ [ kill-node* ] curry each-node ] if ;
|
||||
!
|
||||
! : kill-values ( node -- )
|
||||
! #! Remove literals which are not actually used anywhere.
|
||||
! dead-literals kill-node ;
|
||||
|
||||
: compute-dead-literals ( -- values )
|
||||
def-use get [ >r value? r> empty? and ] assoc-subset ;
|
||||
|
||||
: kill-node* ( node values -- )
|
||||
[ swap remove-all ] curry modify-values ;
|
||||
DEFER: kill-nodes
|
||||
SYMBOL: dead-literals
|
||||
|
||||
: kill-node ( node values -- )
|
||||
dup assoc-empty?
|
||||
[ 2drop ] [ [ kill-node* ] curry each-node ] if ;
|
||||
GENERIC: kill-node* ( node -- node/t )
|
||||
|
||||
: kill-values ( node -- )
|
||||
M: node kill-node* drop t ;
|
||||
|
||||
: prune-if ( node quot -- successor/t )
|
||||
over >r call [ r> node-successor ] [ r> drop t ] if ;
|
||||
inline
|
||||
|
||||
M: #shuffle kill-node*
|
||||
[
|
||||
dup node-in-d empty? swap node-out-d empty? and
|
||||
] prune-if ;
|
||||
|
||||
M: #push kill-node*
|
||||
[ node-out-d empty? ] prune-if ;
|
||||
|
||||
M: #>r kill-node* [ node-in-d empty? ] prune-if ;
|
||||
|
||||
M: #r> kill-node* [ node-in-r empty? ] prune-if ;
|
||||
|
||||
: kill-node ( node -- node )
|
||||
dup [
|
||||
dup [ dead-literals get swap remove-all ] modify-values
|
||||
dup kill-node* dup t eq? [
|
||||
drop dup [ kill-nodes ] change-children
|
||||
] [
|
||||
nip kill-node
|
||||
] if
|
||||
] when ;
|
||||
|
||||
: kill-nodes ( node -- newnode )
|
||||
[ kill-node ] transform-nodes ;
|
||||
|
||||
: kill-values ( node -- new-node )
|
||||
#! Remove literals which are not actually used anywhere.
|
||||
dead-literals kill-node ;
|
||||
compute-dead-literals dup assoc-empty? [ drop ] [
|
||||
dead-literals [ kill-nodes ] with-variable
|
||||
] if ;
|
||||
|
||||
!
|
||||
|
||||
: sole-consumer ( #call -- node/f )
|
||||
node-out-d first used-by
|
||||
|
|
|
|||
|
|
@ -98,7 +98,7 @@ float-arrays combinators.private combinators ;
|
|||
[
|
||||
num-types get swap [
|
||||
[
|
||||
[ type>class 0 `input class, ] keep
|
||||
[ type>class object or 0 `input class, ] keep
|
||||
0 `output literal,
|
||||
] set-constraints
|
||||
] curry each
|
||||
|
|
|
|||
|
|
@ -4,13 +4,16 @@ USING: kernel namespaces optimizer.backend optimizer.def-use
|
|||
optimizer.known-words optimizer.math inference.class ;
|
||||
IN: optimizer
|
||||
|
||||
SYMBOL: optimize-count
|
||||
|
||||
: optimize-1 ( node -- newnode ? )
|
||||
[
|
||||
global [ optimize-count inc ] bind
|
||||
H{ } clone class-substitutions set
|
||||
H{ } clone literal-substitutions set
|
||||
H{ } clone value-substitutions set
|
||||
dup compute-def-use
|
||||
dup kill-values
|
||||
kill-values
|
||||
dup infer-classes
|
||||
optimizer-changed off
|
||||
optimize-nodes
|
||||
|
|
|
|||
Loading…
Reference in New Issue