2006-03-08 15:03:01 -05:00
|
|
|
! Copyright (C) 2004, 2006 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2004-09-06 22:39:12 -04:00
|
|
|
IN: compiler
|
2006-08-10 16:44:00 -04:00
|
|
|
USING: errors generic hashtables inference io kernel math
|
2006-08-11 16:55:43 -04:00
|
|
|
namespaces optimizer parser prettyprint sequences test threads
|
|
|
|
words ;
|
2004-09-06 22:39:12 -04:00
|
|
|
|
2006-09-23 02:40:25 -04:00
|
|
|
SYMBOL: batch-errors
|
|
|
|
|
|
|
|
GENERIC: batch-begins ( batch-errors -- )
|
|
|
|
|
|
|
|
M: f batch-begins drop ;
|
|
|
|
|
|
|
|
GENERIC: compile-begins ( word batch-errors -- )
|
|
|
|
|
|
|
|
M: f compile-begins drop "Compiling " write . flush ;
|
|
|
|
|
|
|
|
GENERIC: compile-error ( error batch-errors -- )
|
|
|
|
|
|
|
|
M: f compile-error drop error. flush ;
|
|
|
|
|
|
|
|
GENERIC: batch-ends ( batch-errors -- )
|
|
|
|
|
|
|
|
M: f batch-ends drop ;
|
|
|
|
|
2006-08-18 01:35:04 -04:00
|
|
|
: word-dataflow ( word -- dataflow )
|
|
|
|
[
|
2006-08-18 01:50:34 -04:00
|
|
|
dup ?no-effect
|
2006-08-18 01:35:04 -04:00
|
|
|
dup dup add-recursive-state
|
|
|
|
dup specialized-def (dataflow)
|
|
|
|
swap current-effect check-effect
|
|
|
|
] with-infer ;
|
|
|
|
|
2006-01-19 03:03:32 -05:00
|
|
|
: (compile) ( word -- )
|
2006-08-10 14:39:12 -04:00
|
|
|
dup compiling? not over compound? and [
|
2006-09-23 02:40:25 -04:00
|
|
|
dup batch-errors get compile-begins
|
2006-08-18 01:35:04 -04:00
|
|
|
dup word-dataflow optimize generate
|
2006-04-28 18:38:48 -04:00
|
|
|
] [
|
2006-08-10 14:39:12 -04:00
|
|
|
drop
|
2006-04-28 18:38:48 -04:00
|
|
|
] if ;
|
2004-09-08 02:31:03 -04:00
|
|
|
|
2004-09-06 22:39:12 -04:00
|
|
|
: compile ( word -- )
|
2006-08-10 14:39:12 -04:00
|
|
|
[ (compile) ] with-compiler ;
|
2004-09-06 22:39:12 -04:00
|
|
|
|
2004-12-16 19:57:03 -05:00
|
|
|
: try-compile ( word -- )
|
2006-09-23 02:40:25 -04:00
|
|
|
[
|
|
|
|
compile
|
|
|
|
] [
|
|
|
|
batch-errors get compile-error update-xt
|
|
|
|
] recover ;
|
|
|
|
|
|
|
|
: compile-batch ( seq -- )
|
|
|
|
batch-errors get batch-begins
|
|
|
|
dup
|
|
|
|
[ f "no-effect" set-word-prop ] each
|
|
|
|
[ try-compile ] each
|
|
|
|
batch-errors get batch-ends ;
|
2004-12-16 19:57:03 -05:00
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
: compile-vocabs ( seq -- )
|
2006-09-23 02:40:25 -04:00
|
|
|
[ words ] map concat compile-batch ;
|
2006-02-09 20:34:49 -05:00
|
|
|
|
2006-08-17 23:52:59 -04:00
|
|
|
: compile-all ( -- )
|
|
|
|
vocabs compile-vocabs changed-words get clear-hash ;
|
2005-01-06 19:10:02 -05:00
|
|
|
|
2006-03-15 15:58:22 -05:00
|
|
|
: compile-quot ( quot -- word )
|
2006-05-29 04:27:30 -04:00
|
|
|
define-temp "compile" get [ dup compile ] when ;
|
2006-03-15 15:58:22 -05:00
|
|
|
|
|
|
|
: compile-1 ( quot -- ) compile-quot execute ;
|
2006-08-10 16:44:00 -04:00
|
|
|
|
|
|
|
: recompile ( -- )
|
2006-08-11 16:55:43 -04:00
|
|
|
changed-words get [
|
2006-09-23 02:40:25 -04:00
|
|
|
dup hash-keys compile-batch clear-hash
|
2006-08-11 16:55:43 -04:00
|
|
|
] when* ;
|
|
|
|
|
|
|
|
[ recompile ] parse-hook set
|