working on dataflow optimizer

doc/handbook.tex

@@ -6271,6 +6271,144 @@ The compiler has two limitations you must be aware of. First, if an exception is
 
 The compiler consists of multiple stages -- first, a dataflow graph is inferred, then various optimizations are done on this graph, then it is transformed into a linear representation, further optimizations are done, and finally, machine code is generated from the linear representation.
 
+\section{Dataflow intermediate representation}
+
+The dataflow IR represents nested control structure, and annotates all calls with stack input and output annotations. Such annotations consists of lists of values, where a value abstracts over a possibly unknown computation result. It has a tree shape, where each node is a tuple delegating to an instance of the \verb|node| tuple class.
+
+The \verb|node| tuple has the following slots:
+
+\begin{description}
+\item[\texttt{param}] The meaning is determined by the tuple wrapping the node instance. For example with \verb|#call| nodes, this is the word being called.
+\item[\texttt{in-d}] A list of input values popped the data stack.
+\item[\texttt{in-r}] A list of input values popped the return stack. Only used by \verb|#call >r| nodes.
+\item[\texttt{out-d}] A list of output values pushed on the data stack.
+\item[\texttt{out-r}] A list of output values pushed on the return stack. Only used by \verb|#call r>| nodes.
+\item[\texttt{node-successor}] The direct successor of the node.
+\item[\texttt{node-children}] A list of the node's children, for example if this is a branch or label node. The number of children depends on the type of node.
+\end{description}
+
+Note that nodes are linked by the \verb|node-successor| slot. Nested structure is realized by a list value in the \verb|node-children| slot.
+
+The stack effect inferencer transforms quotations into dataflow IR.
+
+\wordtable{
+\vocabulary{inference}
+\ordinaryword{dataflow}{dataflow ( quot -- node )}
+}
+
+Produces the dataflow IR of a quotation.
+
+\wordtable{
+\vocabulary{inference}
+\ordinaryword{dataflow.}{dataflow.~( node -- )}
+}
+
+Prints dataflow IR in human-readable form.
+
+\subsection{Values}
+
+Values are an abstraction over possibly known computation inputs and outputs. There are three types of values:
+
+\begin{description}
+\item[Literal values] represent a known constant
+\item[Computed values] represent inputs and outputs whose specific value is not known
+\item[Joined values] represent a unification of possible values of a stack slot where branched control flow meets
+\end{description}
+
+The \verb|value| tuple has the following slots:
+
+\begin{description}
+\item[\texttt{recursion}] A list of nested lexical scopes, used to resolve recursive stack effects
+\item[\texttt{safe?}] This is a hack. If this is false, the value's type at that point might not potentially be known, since a entry to this block from another entry point can potentially occur
+\end{description}
+
+\subsection{Straight-line code}
+
+\begin{description}
+
+\item[\texttt{\#push}] Pushes literal values on the data stack.
+
+\begin{tabular}{l|l}
+Slot&Role\\
+\hline
+\verb|node-out-d|&A list of literals.
+\end{tabular}
+
+\item[\texttt{\#drop}] Pops literal values from the data stack.
+
+\begin{tabular}{l|l}
+Slot&Role\\
+\hline
+\verb|node-in-d|&A list of literals.
+\end{tabular}
+
+\item[\texttt{\#call}] Invokes the word identified by \verb|node-param|.
+
+\begin{tabular}{l|l}
+Slot&Role\\
+\hline
+\verb|node-param|&A word.\\
+\verb|node-in-d|&Input values.\\
+\verb|node-out-d|&Output values.
+\end{tabular}
+
+\item[\texttt{\#call-label}] Like \verb|#call| but \verb|node-param| refers to a parent \verb|#label| node.
+
+\end{description}
+
+\subsection{Branching and recursion}
+
+\begin{description}
+
+\item[\texttt{\#ifte}] A conditional expression.
+
+\begin{tabular}{l|l}
+Slot&Role\\
+\hline
+\verb|node-in-d|&A singleton list holding the condition being tested.\\
+\verb|node-children|&A list of two nodes, the true and false branches.
+\end{tabular}
+
+\item[\texttt{\#dispatch}] A jump table.
+
+\begin{tabular}{l|l}
+Slot&Role\\
+\hline
+\verb|node-in-d|&A singleton list holding the jump table index.\\
+\verb|node-children|&A list of nodes, in consecutive jump table order.
+\end{tabular}
+
+\item[\texttt{\#values}] Found at the end of each branch in an \verb|#ifte| or \verb|#dispatch| node.
+
+\begin{tabular}{l|l}
+Slot&Role\\
+\hline
+\verb|node-out-d|&A list of values present on the data stack at the end of the branch.\\
+\end{tabular}
+
+\item[\texttt{\#label}] A named block of code. Child \verb|#call-label| nodes can recurse on this label.
+
+\begin{tabular}{l|l}
+Slot&Role\\
+\hline
+\verb|node-param|&A gensym identifying the label.\\
+\verb|node-children|&A singleton list whose sole element is the labelled node.
+\end{tabular}
+
+\item[\texttt{\#return}] Found at the end of a word's dataflow IR.
+
+\begin{tabular}{l|l}
+Slot&Role\\
+\hline
+\verb|node-out-d|&Values present on the stack when the word returns.
+\end{tabular}
+
+\end{description}
+
+\section{Dataflow optimizer}
+
+\subsection{Killing unused literals}
+
 \section{Linear intermediate representation}
 
 The linear IR is the second of the two intermediate

library/bootstrap/boot-stage1.factor

@@ -90,11 +90,12 @@ parser prettyprint sequences io vectors words ;
         "/library/inference/words.factor"
         "/library/inference/stack.factor"
         "/library/inference/partial-eval.factor"
+        "/library/inference/optimizer.factor"
+        "/library/inference/print-dataflow.factor"
         
         "/library/compiler/assembler.factor"
         "/library/compiler/relocate.factor"
         "/library/compiler/xt.factor"
-        "/library/compiler/optimizer.factor"
         "/library/compiler/vops.factor"
         "/library/compiler/linearizer.factor"
         "/library/compiler/intrinsics.factor"

library/bootstrap/boot-stage3.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 USING: alien assembler command-line compiler compiler-backend
-compiler-frontend io-internals kernel lists math namespaces
+compiler-frontend inference io-internals kernel lists math
-parser sequences io unparser words ;
+namespaces parser sequences io unparser words ;
 
 "Compiling base..." print
 

library/collections/assoc.factor

@@ -14,12 +14,6 @@ IN: lists USING: kernel sequences ;
 
 : assoc ( key alist -- value ) assoc* cdr ;
 
-: assq* ( key alist -- [[ key value ]] )
-    #! Looks up a key/value pair using identity comparison.
-    [ car eq? ] find-with nip ;
-
-: assq ( key alist -- value ) assq* cdr ;
-
 : remove-assoc ( key alist -- alist )
     #! Remove all key/value pairs with this key.
     [ car = not ] subset-with ;

library/collections/sequences-epilogue.factor

@@ -186,9 +186,13 @@ M: object peek ( sequence -- element )
 
 : join ( seq glue -- seq )
     #! The new sequence is of the same type as glue.
-    swap dup length <vector> swap
+    swap dup empty? [
+        swap like
+    ] [
+        dup length <vector> swap
         [ over push 2dup push ] each nip >pop>
-    concat ;
+        concat
+    ] ifte ;
 
 M: object reverse-slice ( seq -- seq ) <reversed> ;
 
@@ -243,6 +247,14 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
     #! Longest sequence length in a sequence of sequences.
     0 [ length max ] reduce ;
 
+: subst ( new old seq -- seq )
+    #! Substitute elements of old in seq with corresponding
+    #! elements from new.
+    [
+        dup pick index dup -1 =
+        [ drop ] [ nip pick nth ] ifte
+    ] map 2nip ;
+
 IN: kernel
 
 : depth ( -- n )

library/compiler/intrinsics.factor

@@ -59,6 +59,8 @@ sequences words ;
 : peek-2 dup length 2 - swap nth ;
 : node-peek-2 ( node -- obj ) node-in-d peek-2 ;
 
+: value-types drop f ;
+
 : typed? ( value -- ? ) value-types length 1 = ;
 
 : slot@ ( node -- n )

library/inference/branches.factor

@@ -4,9 +4,6 @@ IN: inference
 USING: errors generic hashtables interpreter kernel lists math
 matrices namespaces prettyprint sequences strings vectors words ;
 
-: computed-value-vector ( n -- vector )
-    empty-vector [ drop object <computed> ] map ;
-
 : add-inputs ( count stack -- stack )
     #! Add this many inputs to the given stack.
     [ length - computed-value-vector ] keep append ;
@@ -18,10 +15,8 @@ matrices namespaces prettyprint sequences strings vectors words ;
 
 : unify-results ( seq -- value )
     #! If all values in list are equal, return the value.
-    #! Otherwise, unify types.
+    #! Otherwise, unify.
-    dup [ eq? ] fiber?
+    dup [ eq? ] fiber? [ first ] [ <meet> ] ifte ;
-    [ first ]
-    [ [ value-class ] map class-or-list <computed> ] ifte ;
 
 : unify-stacks ( seq -- stack )
     #! Replace differing literals in stacks with unknown
@@ -53,24 +48,19 @@ matrices namespaces prettyprint sequences strings vectors words ;
     [ [ active? ] bind ] subset ;
 
 : unify-effects ( seq -- )
-    filter-terminators [
+    filter-terminators
-        dup datastack-effect callstack-effect
+    [ dup datastack-effect callstack-effect ]
-    ] [
+    [ terminate ] ifte* ;
-        terminate
-    ] ifte* ;
 
 : unify-dataflow ( effects -- nodes )
     [ [ dataflow-graph get ] bind ] map ;
 
-: clone-values ( seq -- seq ) [ clone-value ] map ;
-
 : copy-inference ( -- )
     #! We avoid cloning the same object more than once in order
     #! to preserve identity structure.
-    cloned off
+    meta-r [ clone ] change
-    meta-r [ clone-values ] change
+    meta-d [ clone ] change
-    meta-d [ clone-values ] change
+    d-in [ clone ] change
-    d-in [ clone-values ] change
     dataflow-graph off
     current-node off ;
 
@@ -82,34 +72,31 @@ matrices namespaces prettyprint sequences strings vectors words ;
         copy-inference
         dup value-recursion recursive-state set
         literal-value dup infer-quot
-        active? [
+        active? [ #values node, handle-terminator ] [ drop ] ifte
-            #values node,
-            handle-terminator
-        ] [
-            drop
-        ] ifte
     ] extend ;
 
 : (infer-branches) ( branchlist -- list )
-    [ infer-branch ] map dup unify-effects unify-dataflow ;
+    [ infer-branch ] map dup unify-effects
+    unify-dataflow ;
 
 : infer-branches ( branches node -- )
     #! Recursive stack effect inference is done here. If one of
     #! the branches has an undecidable stack effect, we set the
     #! base case to this stack effect and try again.
-    [ >r (infer-branches) r> set-node-children ] keep node, ;
+    [ >r (infer-branches) r> set-node-children ] keep
+    node, meta-d get >list #merge node, ;
 
 \ ifte [
-    2 #drop node, pop-d pop-d swap 2list
+    2 #drop node, pop-d pop-d swap 2vector
     #ifte pop-d drop infer-branches
 ] "infer" set-word-prop
 
-: vtable>list ( rstate vtable -- list  )
+: vtable-value ( rstate vtable -- seq  )
-    [ swap <literal> ] map-with >list ;
+    [ swap <literal> ] map-with ;
 
 USE: kernel-internals
 
 \ dispatch [
-    pop-literal vtable>list
+    pop-literal vtable-value
     #dispatch pop-d drop infer-branches
 ] "infer" set-word-prop

library/inference/dataflow.factor

@@ -8,16 +8,16 @@ sequences vectors words ;
 ! representations used by Factor. It annotates concatenative
 ! code with stack flow information and types.
 
-TUPLE: node effect param in-d out-d in-r out-r
+TUPLE: node param in-d out-d in-r out-r
        successor children ;
 
 : make-node ( effect param in-d out-d in-r out-r node -- node )
     [ >r f <node> r> set-delegate ] keep ;
 
-: empty-node f f f f f f f f f ;
+: empty-node f f f f f f f f ;
-: param-node ( label) f swap f f f f f ;
+: param-node ( label) f f f f f ;
-: in-d-node ( inputs) >r f f r> f f f f ;
+: in-d-node ( inputs) >r f r> f f f f ;
-: out-d-node ( outputs) >r f f f r> f f f ;
+: out-d-node ( outputs) >r f f r> f f f ;
 
 : d-tail ( n -- list ) meta-d get tail* >list ;
 : r-tail ( n -- list ) meta-r get tail* >list ;
@@ -58,6 +58,10 @@ TUPLE: #dispatch ;
 C: #dispatch make-node ;
 : #dispatch ( in -- node ) 1 d-tail in-d-node <#dispatch> ;
 
+TUPLE: #merge ;
+C: #merge make-node ;
+: #merge ( values -- node ) in-d-node <#merge> ;
+
 : node-inputs ( d-count r-count node -- )
     tuck
     >r r-tail r> set-node-in-r

library/inference/inference.factor

@@ -20,31 +20,14 @@ SYMBOL: d-in
 : pop-literal ( -- rstate obj )
     1 #drop node, pop-d >literal< ;
 
-: (ensure-types) ( typelist n stack -- )
+: computed-value-vector ( n -- vector )
-    pick [
+    empty-vector dup [ drop <computed> ] nmap ;
-        3dup >r >r car r> r> nth value-class-and
-        >r >r cdr r> 1 + r> (ensure-types)
-    ] [
-        3drop
-    ] ifte ;
-
-: ensure-types ( typelist stack -- )
-    dup length pick length - dup 0 < [
-        swap >r neg swap tail 0 r>
-    ] [
-        swap
-    ] ifte (ensure-types) ;
 
 : required-inputs ( typelist stack -- values )
-    >r dup length r> length - dup 0 > [
+    >r length r> length - abs computed-value-vector ;
-        swap head [ <computed> ] map
-    ] [
-        2drop f
-    ] ifte ;
 
 : ensure-d ( typelist -- )
-    dup meta-d get ensure-types
+    meta-d get required-inputs dup
-    meta-d get required-inputs >vector dup
     meta-d [ append ] change
     d-in [ append ] change ;
 
@@ -54,16 +37,9 @@ SYMBOL: d-in
     2slip
     second length 0 rot node-outputs ; inline
 
-: (present-effect) ( vector -- list )
+: present-effect ( [[ d-in meta-d ]] -- [[ in# out# ]] )
-    >list [ value-class ] map ;
-
-: present-effect ( [[ d-in meta-d ]] -- [ in-types out-types ] )
     #! After inference is finished, collect information.
-    uncons >r (present-effect) r> (present-effect) 2list ;
+    uncons length >r length r> 2list ;
-
-: simple-effect ( [[ d-in meta-d ]] -- [[ in# out# ]] )
-    #! After inference is finished, collect information.
-    uncons length >r length r> cons ;
 
 : init-inference ( recursive-state -- )
     init-interpreter

library/inference/optimizer.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-frontend
+IN: inference
 USING: generic hashtables inference kernel lists matrices
-namespaces sequences ;
+namespaces sequences vectors ;
 
 ! The optimizer transforms dataflow IR to dataflow IR. Currently
 ! it removes literals that are eventually dropped, and never
@@ -52,35 +52,31 @@ DEFER: kill-node
         2drop
     ] ifte ;
 
-GENERIC: useless-node? ( node -- ? )
+GENERIC: optimize-node* ( node -- node )
 
-DEFER: prune-nodes
+DEFER: optimize-node ( node -- node/t )
 
-: prune-children ( node -- )
+: optimize-children ( node -- )
-    [ node-children [ prune-nodes ] map ] keep
+    dup node-children [ optimize-node ] map
-    set-node-children ;
+    swap set-node-children ;
 
-: (prune-nodes) ( node -- )
+: keep-optimizing ( node -- node )
-    [
+    dup optimize-node* dup t =
-        dup prune-children
+    [ drop ] [ nip keep-optimizing ] ifte ;
-        dup node-successor dup useless-node? [
-            node-successor over set-node-successor
-        ] [
-            nip
-        ] ifte (prune-nodes)
-    ] when* ;
 
-: prune-nodes ( node -- node )
+: optimize-node ( node -- node )
-    dup useless-node? [
+    keep-optimizing dup [
-        node-successor prune-nodes
+        dup optimize-children
-    ] [
+        dup node-successor optimize-node over set-node-successor
-        [ (prune-nodes) ] keep
+    ] when ;
-    ] ifte ;
 
 : optimize ( dataflow -- dataflow )
     #! Remove redundant literals from the IR. The original IR
     #! is destructively modified.
-    dup kill-set over kill-node prune-nodes ;
+    dup kill-set over kill-node optimize-node ;
+
+: prune-if ( node quot -- successor/t )
+    over >r call [ r> node-successor ] [ r> drop t ] ifte ;
 
 ! Generic nodes
 M: node literals* ( node -- )
@@ -95,11 +91,10 @@ M: node can-kill* ( literal node -- ? )
 M: node kill-node* ( literals node -- )
     2drop ;
 
-M: f useless-node? ( node -- ? )
+M: f optimize-node* drop t ;
-    drop f ;
 
-M: node useless-node? ( node -- ? )
+M: node optimize-node* ( node -- t )
-    drop f ;
+    drop t ;
 
 ! #push
 M: #push literals* ( node -- )
@@ -111,8 +106,8 @@ M: #push can-kill* ( literal node -- ? )
 M: #push kill-node* ( literals node -- )
     [ node-out-d seq-diffq ] keep set-node-out-d ;
 
-M: #push useless-node? ( node -- ? )
+M: #push optimize-node* ( node -- node/t )
-    node-out-d empty? ;
+    [ node-out-d empty? ] prune-if ;
 
 ! #drop
 M: #drop can-kill* ( literal node -- ? )
@@ -121,8 +116,8 @@ M: #drop can-kill* ( literal node -- ? )
 M: #drop kill-node* ( literals node -- )
     [ node-in-d seq-diffq ] keep set-node-in-d ;
 
-M: #drop useless-node? ( node -- ? )
+M: #drop optimize-node*  ( node -- node/t )
-    node-in-d empty? ;
+    [ node-in-d empty? ] prune-if ;
 
 ! #call
 M: #call can-kill* ( literal node -- ? )
@@ -174,8 +169,19 @@ M: #call kill-node* ( literals node -- )
     dup node-param (kill-shuffle)
     [ kill-shuffle ] [ 2drop ] ifte ;
 
-M: #call useless-node? ( node -- ? )
+: optimize-not? ( #call -- ? )
-    node-param not ;
+    dup node-param \ not =
+    [ node-successor #ifte? ] [ drop f ] ifte ;
+
+: flip-branches ( #ifte -- )
+    dup node-children 2unseq swap 2vector swap set-node-children ;
+
+M: #call optimize-node* ( node -- node )
+     dup optimize-not? [
+         node-successor dup flip-branches
+     ] [
+         [ node-param not ] prune-if
+     ] ifte ;
 
 ! #call-label
 M: #call-label can-kill* ( literal node -- ? )
@@ -215,9 +221,45 @@ M: #values can-kill* ( literal node -- ? )
     ] ifte ;
 
 ! #ifte
+: static-branch? ( node -- lit ? )
+    node-in-d first dup safe-literal? ;
+
+: static-branch ( conditional n -- node )
+    >r [ node-in-d in-d-node <#drop> ] keep r>
+    over node-children nth
+    over node-successor over last-node set-node-successor
+    pick set-node-successor drop ;
+
 M: #ifte can-kill* ( literal node -- ? )
     can-kill-branches? ;
 
+M: #ifte optimize-node* ( node -- node )
+    dup static-branch?
+    [ f swap value= 1 0 ? static-branch ] [ 2drop t ] ifte ;
+
 ! #dispatch
 M: #dispatch can-kill* ( literal node -- ? )
     can-kill-branches? ;
+
+! #values
+: subst-values ( new old node -- )
+    dup [
+        3dup [ node-in-d subst ] keep set-node-in-d
+        3dup [ node-in-r subst ] keep set-node-in-r
+        3dup [ node-out-d subst ] keep set-node-out-d
+        3dup [ node-out-r subst ] keep set-node-out-r
+        node-successor subst-values
+    ] [
+        3drop
+    ] ifte ;
+
+: post-split ( #values -- node )
+    #! If a #values is followed by a #merge, we need to replace
+    #! meet values after the merge with their branch value in
+    #! #values.
+    dup node-successor dup node-successor
+    >r >r node-in-d reverse-slice r> node-in-d reverse-slice r>
+    [ subst-values ] keep ;
+
+M: #values optimize-node* ( node -- node )
+    dup node-successor #merge? [ post-split ] [ drop t ] ifte ;

library/inference/print-dataflow.factor

@@ -0,0 +1,70 @@
+IN: inference
+USING: generic inference io kernel kernel-internals math
+namespaces prettyprint sequences vectors words ;
+
+! A simple tool for turning dataflow IR into quotations, for
+! debugging purposes.
+
+GENERIC: node>quot ( node -- )
+
+TUPLE: annotation node text ;
+
+M: annotation prettyprint* ( ann -- )
+    "( " over annotation-text " )" append3
+    swap annotation-node object. ;
+
+: value-str ( values -- str )
+    length "x" <repeated> " " join ;
+
+: effect-str ( node -- str )
+    [
+        dup node-in-d value-str %
+        "-" %
+        node-out-d value-str %
+    ] make-string ;
+
+M: #push node>quot ( node -- )
+    node-out-d [ literal-value ] map % ;
+
+M: #drop node>quot ( node -- )
+    node-in-d length dup 3 > [
+        \ drop <repeated> %
+    ] [
+        { f drop 2drop 3drop } nth ,
+    ] ifte ;
+
+DEFER: dataflow>quot
+
+M: #call node>quot ( node -- )
+    dup node-param , dup effect-str <annotation> , ;
+
+M: #call-label node>quot ( node -- )
+    "#call-label: " over node-param word-name append <annotation> , ;
+
+M: #label node>quot ( node -- )
+    dup "#label: " over node-param word-name append <annotation> ,
+    node-children first dataflow>quot , \ call ,  ;
+
+M: #ifte node>quot ( node -- )
+    dup "#ifte" <annotation> ,
+    node-children [ dataflow>quot ] map % \ ifte , ;
+
+M: #dispatch node>quot ( node -- )
+    dup "#dispatch" <annotation> ,
+    node-children [ dataflow>quot ] map >vector % \ dispatch , ;
+
+M: #return node>quot ( node -- ) "#return" <annotation> , ;
+
+M: #values node>quot ( node -- ) "#values" <annotation> , ;
+
+M: #merge node>quot ( node -- ) "#merge" <annotation> , ;
+
+: (dataflow>quot) ( node -- )
+    [ dup node>quot node-successor (dataflow>quot) ] when* ;
+
+: dataflow>quot ( node -- quot )
+    [ (dataflow>quot) ] make-list ;
+
+: dataflow. ( quot -- )
+    #! Print dataflow IR for a word.
+    dataflow>quot prettyprint ;

library/inference/values.factor

@@ -4,12 +4,8 @@ IN: inference
 USING: generic kernel lists namespaces sequences unparser words ;
 
 GENERIC: value= ( literal value -- ? )
-GENERIC: value-class-and ( class value -- )
 
-SYMBOL: cloned
+TUPLE: value recursion safe? ;
-GENERIC: clone-value ( value -- value )
-
-TUPLE: value class recursion safe? ;
 
 C: value ( recursion -- value )
     [ t swap set-value-safe? ] keep
@@ -17,62 +13,32 @@ C: value ( recursion -- value )
 
 TUPLE: computed ;
 
-C: computed ( class -- value )
+C: computed ( -- value )
-    swap recursive-state get <value> [ set-value-class ] keep
+    recursive-state get <value> over set-delegate ;
-    over set-delegate ;
 
 M: computed value= ( literal value -- ? )
     2drop f ;
 
-: failing-class-and ( class class -- class )
-    2dup class-and dup null = [
-        -rot [
-            word-name % " and " % word-name %
-            " do not intersect" %
-        ] make-string inference-warning
-    ] [
-        2nip
-    ] ifte ;
-
-M: computed value-class-and ( class value -- )
-    [
-        value-class  failing-class-and
-    ] keep set-value-class ;
-
 TUPLE: literal value ;
 
 C: literal ( obj rstate -- value )
-    [
+    [ >r <value> r> set-delegate ] keep
-        >r <value> [ >r dup class r> set-value-class ] keep
-        r> set-delegate
-    ] keep
     [ set-literal-value ] keep ;
 
-M: literal clone-value ( value -- value ) ;
-
 M: literal value= ( literal value -- ? )
     literal-value = ;
 
-M: literal value-class-and ( class value -- )
-    value-class class-and drop ;
-
-M: literal set-value-class ( class value -- )
-    2drop ;
-
-M: computed clone-value ( value -- value )
-    dup cloned get assq [ ] [
-        dup clone [ swap cloned [ acons ] change ] keep
-    ] ?ifte ;
-
-M: computed literal-value ( value -- )
-    "A literal value was expected where a computed value was"
-    " found: " rot unparse append3 inference-error ;
-
-: value-types ( value -- list )
-    value-class builtin-supertypes ;
-
 : >literal< ( literal -- rstate obj )
     dup value-recursion swap literal-value ;
 
+M: value literal-value ( value -- )
+    "A literal value was expected where a computed value was found"
+    inference-error ;
+
+TUPLE: meet values ;
+
+C: meet ( values -- value )
+    [ set-meet-values ] keep f <value> over set-delegate ;
+
 PREDICATE: tuple safe-literal ( obj -- ? )
     dup literal? [ value-safe? ] [ drop f ] ifte ;

library/inference/words.factor

@@ -9,7 +9,7 @@ hashtables parser prettyprint ;
     [ pop-d 2drop ] each ;
 
 : produce-d ( typelist -- )
-    [ <computed> push-d ] each ;
+    [ drop <computed> push-d ] each ;
 
 : consume/produce ( word effect -- )
     #! Add a node to the dataflow graph that consumes and

library/syntax/prettyprint.factor

@@ -12,8 +12,11 @@ SYMBOL: recursion-check
 
 GENERIC: prettyprint* ( indent obj -- indent )
 
+: object. ( str obj -- )
+    presented swons unit format ;
+
 : unparse. ( obj -- )
-    dup unparse swap presented swons unit format ;
+    [ unparse ] keep object. ;
 
 M: object prettyprint* ( indent obj -- indent )
     unparse. ;

library/test/sequences.factor

@@ -58,3 +58,9 @@ USING: kernel lists math sequences strings test vectors ;
 [ "hello world how are you" ]
 [ { "hello" "world" "how" "are" "you" } " " join ]
 unit-test
+
+[ "" ] [ { } "" join ] unit-test
+
+[ { "three" "three" "two" "two" "one" "one" } ]
+[ { "one" "two" "three" } { 1 2 3 } { 3 3 2 2 1 1 } subst ]
+unit-test

library/ui/editors.factor

@@ -54,6 +54,8 @@ TUPLE: editor line caret ;
         [[ [ "LEFT" ] [ [ left ] with-editor ] ]]
         [[ [ "RIGHT" ] [ [ right ] with-editor ] ]]
         [[ [ "CTRL" "k" ] [ [ line-clear ] with-editor ] ]]
+        [[ [ "HOME" ] [ [ home ] with-editor ] ]]
+        [[ [ "END" ] [ [ end ] with-editor ] ]]
     ] swap add-actions ;
 
 : <caret> ( -- caret )

library/ui/line-editor.factor

@@ -117,3 +117,11 @@ SYMBOL: history-index
 : right ( -- )
     #! Call this in the line editor scope.
     caret [ 1 + line-text get length min ] change ;
+
+: home ( -- )
+    #! Call this in the line editor scope.
+    0 caret set ;
+
+: end ( -- )
+    #! Call this in the line editor scope.
+    line-text get length caret set ;