1 ! Copyright (C) 2008, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators compiler.tree continuations hints
4 kernel locals namespaces quotations sequences
5 stack-checker.backend stack-checker.errors
6 stack-checker.recursive-state stack-checker.state
7 stack-checker.visitor vectors words ;
8 IN: compiler.tree.builder
12 GENERIC: (build-tree) ( quot -- )
14 M: callable (build-tree) infer-quot-here ;
16 : check-no-compile ( word -- )
17 dup "no-compile" word-prop [ do-not-compile ] [ drop ] if ;
19 : word-body ( word -- quot )
20 dup inline-recursive? [ 1quotation ] [ specialized-def ] if ;
24 [ word-body infer-quot-here ]
25 [ required-stack-effect check-effect ] tri ;
27 : build-tree-with ( in-stack word/quot -- nodes )
29 <recursive-state> recursive-state set
30 V{ } clone stack-visitor set
31 [ [ >vector (meta-d) set ] [ length input-count set ] bi ]
38 : build-tree ( word/quot -- nodes )
39 [ f ] dip build-tree-with ;
41 :: build-sub-tree ( in-d out-d word/quot -- nodes/f )
43 in-d word/quot build-tree-with unclip-last in-d>> :> in-d'
46 { [ dup ends-with-terminate? ] [ out-d [ f swap <#push> ] map append ] }
47 [ in-d' out-d [ [ length ] bi@ assert= ] [ <#copy> suffix ] 2bi ]
49 ] [ inference-error? ] ignore-error/f ;