Simplify the compiler

TODO.FACTOR.txt

@@ -1,6 +1,5 @@
 + 0.84:
 
-- fix amd64 backend
 - fix contribs: boids, automata
 - sometimes darcs get fails with the httpd
 - gdb triggers 'mutliple i/o ops on port' error
@@ -67,6 +66,7 @@
 - variable width word wrap
 - slider needs to be modelized
 - structure editor
+- listener tab completion
 
 + module system:
 
@@ -87,6 +87,7 @@
 
 + compiler/ffi:
 
+- more compact relocation info
 - UI dataflow visualizer
 - ppc64 backend
 - we need to optimize  [ dup array? [ array? ] [ array? ] if ]

library/compiler/compiler.factor

@@ -5,19 +5,15 @@ USING: errors hashtables inference io kernel math namespaces
 optimizer prettyprint sequences test threads words ;
 
 : (compile) ( word -- )
-    dup specialized-def dataflow optimize generate ;
+    dup compiling? not over compound? and [
-
+        "Compiling " write dup . flush
-: inform-compile ( word -- ) "Compiling " write . flush ;
+        dup specialized-def dataflow optimize generate
-
-: compile-postponed ( -- )
-    compile-words get dup empty? [
-        drop
     ] [
-        pop dup inform-compile (compile) compile-postponed
+        drop
     ] if ;
 
 : compile ( word -- )
-    [ postpone-word compile-postponed ] with-compiler ;
+    [ (compile) ] with-compiler ;
 
 : compiled ( -- ) "compile" get [ word compile ] when ; parsing
 
@@ -31,8 +27,6 @@ optimizer prettyprint sequences test threads words ;
 
 : compile-all ( -- ) vocabs compile-vocabs ;
 
-: recompile ( word -- ) dup update-xt compile ;
-
 : compile-quot ( quot -- word )
     define-temp "compile" get [ dup compile ] when ;
 

library/compiler/compiler.facts

@@ -27,10 +27,6 @@ HELP: compile-vocabs "( seq -- )"
 HELP: compile-all "( -- )"
 { $description "Compile all words in the dictionary which have not already been compiled. Compile errors are logged to the default stream." } ;
 
-HELP: recompile "( word -- )"
-{ $values { "word" "a word" } }
-{ $description "Compiles a word, discarding a previous compiled definition first." } ;
-
 HELP: compile-quot "( quot -- word )"
 { $values { "quot" "a quotation" } { "word" "a new, uninterned word" } }
 { $description "Creates a new uninterned word having the given quotation as its definition, and compiles it. The returned word can be passed to " { $link execute } "." }

library/compiler/generator/generator.factor

@@ -42,8 +42,7 @@ UNION: #terminal
 : init-generator ( -- )
     V{ } clone relocation-table set
     V{ } clone literal-table set
-    V{ } clone label-table set
+    V{ } clone label-table set ;
-    V{ } clone label-relocation-table set ;
 
 : generate-1 ( word node quot -- | quot: node -- )
     #! Generate the code, then dump three vectors to pass to

library/compiler/generator/xt.factor

@@ -5,16 +5,13 @@ USING: arrays assembler errors generic hashtables kernel
 kernel-internals math namespaces prettyprint queues
 sequences strings vectors words ;
 
+DEFER: (compile)
+
 : compiled-offset ( -- n ) building get length code-format * ;
 
-TUPLE: label # offset ;
+TUPLE: label offset ;
 
-SYMBOL: label-table
+C: label ( -- label ) ;
-
-: push-label ( label -- )
-    label-table get dup length pick set-label-# push ;
-
-C: label ( -- label ) dup push-label ;
 
 : define-label ( name -- ) <label> swap set ;
 
@@ -36,7 +33,7 @@ SYMBOL: literal-table
     ] if ;
 
 SYMBOL: relocation-table
-SYMBOL: label-relocation-table
+SYMBOL: label-table
 
 : rel-absolute-cell 0 ;
 : rel-absolute 1 ;
@@ -73,34 +70,22 @@ SYMBOL: label-relocation-table
     >r add-literal r> 4 rel, ;
 
 : rel-label ( label class -- )
-    compiled-offset 3array label-relocation-table get push ;
+    compiled-offset 3array label-table get push ;
 
 : generate-labels ( -- )
-    label-relocation-table get [
+    label-table get [
         first3 >r >r label-offset r> 6 r> (rel)
         relocation-table get swap nappend
     ] each ;
 
-! When a word is encountered that has not been previously
-! compiled, it is pushed onto this vector. Compilation stops
-! when the vector is empty.
-SYMBOL: compile-words
-
 : compiling? ( word -- ? )
     #! A word that is compiling or already compiled will not be
     #! added to the list of words to be compiled.
-    dup compiled?
+    dup compiled? swap compiled-xts get hash-member? or ;
-    over compile-words get member? or
-    swap compiled-xts get hash-member? or ;
 
 : with-compiler ( quot -- )
     [
         H{ } clone compiled-xts set
-        V{ } clone compile-words set
         call
         compiled-xts get hash>alist finalize-compile
     ] with-scope ;
-
-: postpone-word ( word -- )
-    dup compiling? not over compound? and
-    [ dup compile-words get push ] when drop ;

library/compiler/ppc/architecture.factor

@@ -61,7 +61,7 @@ M: object load-literal ( literal vreg -- )
 
 : %call ( label -- )
     #! Far C call for primitives, near C call for compiled defs.
-    dup postpone-word
+    dup (compile)
     dup primitive? [ word-addr  3 MTLR  BLRL ] [ BL ] if ;
 
 : %jump-label ( label -- )
@@ -69,7 +69,7 @@ M: object load-literal ( literal vreg -- )
     dup primitive? [ word-addr  3 MTCTR  BCTR ] [ B ] if ;
 
 : %jump ( label -- )
-    %epilogue dup postpone-word %jump-label ;
+    %epilogue dup (compile) %jump-label ;
 
 : %jump-t ( label -- )
     0 "flag" operand object-tag CMPI BNE ;

library/compiler/x86/architecture.factor

@@ -97,7 +97,7 @@ M: object load-literal ( literal vreg -- )
     v>operand load-indirect ;
 
 : (%call) ( label -- label )
-    dup postpone-word dup primitive? [ address-operand ] when ;
+    dup (compile) dup primitive? [ address-operand ] when ;
 
 : %call ( label -- ) (%call) CALL ;