From c4da07c80da84d9087c0113ae84dedc757402843 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 4 Mar 2005 01:43:55 +0000
Subject: [PATCH] halos

---
 TODO.FACTOR.txt                  |  2 +-
 library/tools/interpreter.factor | 59 ++++++++++-------------------
 library/ui/buttons.factor        |  7 ++--
 library/ui/dialogs.factor        |  1 -
 library/ui/editors.factor        |  2 +-
 library/ui/events.factor         | 12 +++---
 library/ui/gadgets.factor        |  5 ++-
 library/ui/halo.factor           | 65 +++++++++++++++++++++++++-------
 library/ui/hand.factor           | 41 +++++++++++++++++---
 library/ui/inspector.factor      | 12 +++---
 library/ui/menus.factor          |  7 ++++
 library/ui/presentations.factor  |  5 ---
 library/ui/root-menu.factor      |  2 +-
 library/ui/scrolling.factor      |  4 +-
 library/ui/world.factor          | 23 ++++++++---
 native/arithmetic.c              | 47 +++++++++--------------
 native/array.c                   | 28 +++-----------
 native/string.c                  | 14 +++----
 native/string.h                  | 10 ++---
 native/unix/io.c                 |  2 +-
 native/unix/write.c              |  2 +-
 native/write.h                   |  2 +-
 22 files changed, 194 insertions(+), 158 deletions(-)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 3e37cc6500..bed6d10e20 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -17,7 +17,7 @@
 - console: scroll to bottom
 - split preferred size and layouting
 - remove shelf/pile duplication
-- resizing and moving gadgets
+- resizing gadgets
 - faster layout
 - faster repaint
 - closing inspectors
diff --git a/library/tools/interpreter.factor b/library/tools/interpreter.factor
index 7aa137407b..b14d66ab33 100644
--- a/library/tools/interpreter.factor
+++ b/library/tools/interpreter.factor
@@ -82,21 +82,11 @@ SYMBOL: meta-cf
 : do-1 ( obj -- )
     dup word? [ meta-word-1 ] [ push-d ] ifte ;
 
-: (interpret) ( quot -- )
+: interpret ( quot -- )
     #! The quotation is called with each word as its executed.
-    done? [ drop ] [ [ next swap call ] keep (interpret) ] ifte ;
+    done? [ drop ] [ [ next swap call ] keep interpret ] ifte ;
 
-: interpret ( quot quot -- )
-    #! The first quotation is meta-interpreted, with each word
-    #! passed to the second quotation. Pollutes current
-    #! namespace.
-    init-interpreter swap meta-cf set (interpret) ;
-
-: (run) ( -- )
-    [ do ] (interpret) ;
-
-: run ( quot -- )
-    [ do ] interpret ;
+: run ( -- ) [ do ] interpret ;
 
 : set-meta-word ( word quot -- )
     "meta-word" set-word-property ;
@@ -117,23 +107,6 @@ SYMBOL: meta-cf
 
 ! Some useful tools
 
-: report ( obj -- )
-    meta-r get vector-length " " fill write . flush ;
-
-: (trace) ( -- )
-    [ dup report do ] (interpret) ;
-
-: trace ( quot -- )
-    #! Trace execution of a quotation by printing each word as
-    #! its executed, and each literal as its pushed. Each line
-    #! is indented by the call stack height.
-    [
-        init-interpreter
-        meta-cf set
-        (trace)
-        meta-d get set-datastack
-    ] with-scope ;
-
 : &s
     #! Print stepper data stack.
     meta-d get {.} ;
@@ -154,19 +127,27 @@ SYMBOL: meta-cf
     #! Print stepper variable value.
     meta-n get (get) ;
 
-: not-done ( quot -- )
-    done? [ "Stepper is done." print drop ] [ call ] ifte ;
+: stack-report ( -- )
+    meta-r get vector-length "=" fill write
+    meta-d get vector-length "-" fill write ;
 
-: next-report ( -- obj )
-    next dup report meta-cf get report ;
+: not-done ( quot -- )
+    done? [
+        stack-report "Stepper is done." print drop
+    ] [
+        call
+    ] ifte ;
+
+: report ( -- )
+    stack-report meta-cf get . ;
 
 : step
     #! Step into current word.
-    [ next-report do-1 ] not-done ;
+    [ next do-1 report ] not-done ;
 
 : into
     #! Step into current word.
-    [ next-report do ] not-done ;
+    [ next do report ] not-done ;
 
 : walk-banner ( -- )
     "The following words control the single-stepper:" print
@@ -176,9 +157,9 @@ SYMBOL: meta-cf
     " ( var -- value ) inspects the stepper namestack." print
     \ step prettyprint-word " -- single step over" print
     \ into prettyprint-word " -- single step into" print
-    \ (trace) prettyprint-word " -- trace until end" print
-    \ (run) prettyprint-word " -- run until end" print
-    \ exit prettyprint-word " -- exit single-stepper" print ;
+    \ run prettyprint-word " -- run until end" print
+    \ exit prettyprint-word " -- exit single-stepper" print
+    report ;
 
 : walk ( quot -- )
     #! Single-step through execution of a quotation.
diff --git a/library/ui/buttons.factor b/library/ui/buttons.factor
index dd164b1e75..5007c958e6 100644
--- a/library/ui/buttons.factor
+++ b/library/ui/buttons.factor
@@ -4,17 +4,16 @@ IN: gadgets
 USING: generic kernel lists math namespaces prettyprint sdl
 stdio ;
 
-: button-down? ( n -- ? )
-    my-hand hand-buttons contains? ;
+: button-down? ( n -- ? ) hand hand-buttons contains? ;
 
-: mouse-over? ( gadget -- ? ) my-hand hand-gadget child? ;
+: mouse-over? ( gadget -- ? ) hand hand-gadget child? ;
 
 : button-pressed? ( button -- ? )
     #! Return true if the mouse was clicked on the button, and
     #! is currently over the button.
     dup mouse-over? [
         1 button-down? [
-            my-hand hand-clicked child?
+            hand hand-clicked child?
         ] [
             drop f
         ] ifte
diff --git a/library/ui/dialogs.factor b/library/ui/dialogs.factor
index edd24680f2..88e59a639f 100644
--- a/library/ui/dialogs.factor
+++ b/library/ui/dialogs.factor
@@ -20,7 +20,6 @@ TUPLE: dialog continuation delegate ;
     <button> over add-gadget ;
 
 : dialog-actions ( dialog -- )
-    dup moving-actions
     dup [ dialog-ok ] dup set-action
     [ dialog-cancel ] dup set-action ;
 
diff --git a/library/ui/editors.factor b/library/ui/editors.factor
index 17766a5785..d6388cf534 100644
--- a/library/ui/editors.factor
+++ b/library/ui/editors.factor
@@ -50,7 +50,7 @@ TUPLE: editor line caret delegate ;
     [ line-text get x>offset caret set ] with-editor ;
 
 : click-editor ( editor -- )
-    my-hand
+    hand
     2dup relative shape-x pick set-caret-x
     request-focus ;
 
diff --git a/library/ui/events.factor b/library/ui/events.factor
index 84b9468e5b..040a7ef5c8 100644
--- a/library/ui/events.factor
+++ b/library/ui/events.factor
@@ -19,29 +19,29 @@ M: resize-event handle-event ( event -- )
     world get relayout ;
 
 : button-gesture ( button gesture -- [ gesture button ] )
-    swap unit append my-hand hand-clicked handle-gesture drop ;
+    swap unit append hand hand-clicked handle-gesture drop ;
 
 M: button-down-event handle-event ( event -- )
-    button-event-button dup my-hand button/
+    button-event-button dup hand button/
     [ button-down ] button-gesture ;
 
 M: button-up-event handle-event ( event -- )
-    button-event-button dup my-hand button\
+    button-event-button dup hand button\
     [ button-up ] button-gesture ;
 
 : motion-event-pos ( event -- x y )
     dup motion-event-x swap motion-event-y ;
 
 M: motion-event handle-event ( event -- )
-    motion-event-pos my-hand move-hand ;
+    motion-event-pos hand move-hand ;
 
 M: key-down-event handle-event ( event -- )
     dup keyboard-event>binding
-    my-hand hand-focus handle-gesture [
+    hand hand-focus handle-gesture [
         keyboard-event-unicode dup 0 = [
             drop
         ] [
-            my-hand hand-focus user-input drop
+            hand hand-focus user-input drop
         ] ifte
     ] [
         drop
diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index b3e924d8bd..f0e59e172d 100644
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -11,12 +11,15 @@ TUPLE: gadget
     relayout? redraw?
     parent children delegate ;
 
+DEFER: default-actions
+
 C: gadget ( shape -- gadget )
     [ set-gadget-delegate ] keep
     [ <namespace> swap set-gadget-paint ] keep
     [ <namespace> swap set-gadget-gestures ] keep
     [ t swap set-gadget-relayout? ] keep
-    [ t swap set-gadget-redraw? ] keep ;
+    [ t swap set-gadget-redraw? ] keep
+    dup default-actions ;
 
 : <empty-gadget> ( -- gadget )
     0 0 0 0 <rectangle> <gadget> ;
diff --git a/library/ui/halo.factor b/library/ui/halo.factor
index d230626b55..40675e8741 100644
--- a/library/ui/halo.factor
+++ b/library/ui/halo.factor
@@ -1,20 +1,59 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: kernel math namespaces sdl ;
+USING: kernel math namespaces prettyprint sdl ;
 
-! The halo is used to move and resize gadgets.
+TUPLE: halo selected delegate ;
 
-: grab ( gadget hand -- )
-    [ swap screen-pos swap screen-pos - >rect ] 2keep
-    >r [ move-gadget ] keep r> add-gadget ;
+: gadget-menu ( gadget -- assoc )
+    [
+        [[ "Inspect" [ inspect ] ]]
+        [[ "Unparent" [ unparent ] ]]
+        [[ "Move" [ hand grab ] ]]
+    ] actionize ;
 
-: release ( gadget world -- )
-    >r dup screen-pos >r dup unparent
-    r> >rect pick move-gadget
-    r> add-gadget ;
+: halo-menu ( halo -- )
+    halo-selected gadget-menu <menu> show-menu ;
+
+: show-halo* ( gadget -- )
+    #! Show the halo on a specific gadget.
+    halo
+    [ world get add-gadget ] keep
+    [ set-halo-selected ] keep relayout ;
+
+: hide-halo ( -- )
+    halo f over set-halo-selected  unparent ;
+
+: parent-selected? ( gadget halo -- ? )
+    #! See if the parent of a gadget is selected with a halo.
+    halo-selected dup [ swap child? ] [ 2drop f ] ifte ;
+
+: show-halo ( gadget -- )
+    #! If a halo is already showing on the gadget, go to the
+    #! parent.
+    halo halo-selected world get eq? [
+        drop hide-halo
+    ] [
+        dup halo parent-selected? [
+            drop halo halo-selected gadget-parent 
+        ] when show-halo*
+    ] ifte ;
+
+: halo-actions ( gadget -- )
+    dup [ halo-selected hand grab ] [ button-down 1 ] set-action
+    dup [ halo-selected show-halo ] [ button-down 2 ] set-action
+    [ halo-menu ] [ button-down 3 ] set-action ;
+
+C: halo ( -- halo )
+    0 0 0 0 <hollow-rect> <gadget> over set-halo-delegate
+    dup red foreground set-paint-property
+    dup halo-actions ;
+
+M: halo layout* ( halo -- )
+    dup halo-selected
+    2dup screen-pos >rect rot move-gadget
+    dup shape-w swap shape-h rot resize-gadget ;
+
+: default-actions ( gadget -- )
+    [ show-halo ] [ button-down 2 ] set-action ;
 
-: moving-actions ( gadget -- )
-    dup
-    [ my-hand grab ] [ button-down 1 ] set-action
-    [ world get release ] [ button-up 1 ] set-action ;
diff --git a/library/ui/hand.factor b/library/ui/hand.factor
index 2609ee984e..56fe3dd3af 100644
--- a/library/ui/hand.factor
+++ b/library/ui/hand.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: alien generic kernel lists math namespaces sdl sdl-event
-sdl-video ;
+USING: alien generic kernel lists math namespaces prettyprint
+sdl sdl-event sdl-video stdio ;
 
 DEFER: pick-up
 
@@ -50,12 +50,34 @@ TUPLE: hand
     click-pos clicked buttons
     gadget focus delegate ;
 
+: grab ( gadget hand -- )
+    #! Grab hold of a gadget; the gadget will move with the
+    #! hand.
+    2dup set-hand-clicked
+    [ swap screen-pos swap screen-pos - >rect ] 2keep
+    >r [ move-gadget ] keep r> add-gadget ;
+
+: release* ( gadget world -- )
+    >r dup screen-pos >r dup unparent
+    r> >rect pick move-gadget
+    r> add-gadget ;
+
+: release ( hand -- )
+    #! Release the gadget we are holding.
+    dup gadget-children car swap hand-world release* ;
+
+: hand-actions ( hand -- )
+    #! A nice trick is that the hand is only consulted for
+    #! gestures when one of its children is clicked.
+    [ release ] [ button-up 1 ] set-action ;
+
 C: hand ( world -- hand )
     <empty-gadget>
     over set-hand-delegate
     [ set-hand-world ] 2keep
     [ set-gadget-parent ] 2keep
-    [ set-hand-gadget ] keep ;
+    [ set-hand-gadget ] keep
+    [ hand-actions ] keep ;
 
 : button/ ( n hand -- )
     dup hand-gadget over set-hand-clicked
@@ -71,9 +93,16 @@ C: hand ( world -- hand )
 : fire-enter ( oldpos hand -- )
     hand-gadget [ screen-pos - ] keep mouse-enter ;
 
-: update-hand-gadget ( hand -- )
+: find-hand-gadget ( hand -- gadget )
     #! The hand gadget is the gadget under the hand right now.
-    dup dup hand-world pick-up swap set-hand-gadget ;
+    dup gadget-children [ dup hand-world pick-up ] unless ;
+
+: update-hand-gadget ( hand -- )
+    dup find-hand-gadget swap set-hand-gadget ;
+
+: motion-gesture ( hand gadget gesture -- )
+    #! Send a gesture like [ drag 2 ].
+    rot hand-buttons car unit append swap handle-gesture drop ;
 
 : fire-motion ( hand -- )
     #! Fire a motion gesture to the gadget underneath the hand,
@@ -81,7 +110,7 @@ C: hand ( world -- hand )
     #! gadget that was clicked.
     [ motion ] over hand-gadget handle-gesture drop
     dup hand-buttons [
-        [ drag ] swap hand-clicked handle-gesture drop
+        dup hand-clicked [ drag ] motion-gesture
     ] [
         drop
     ] ifte ;
diff --git a/library/ui/inspector.factor b/library/ui/inspector.factor
index 6704f0b788..3d8b493c6a 100644
--- a/library/ui/inspector.factor
+++ b/library/ui/inspector.factor
@@ -43,18 +43,18 @@ GENERIC: custom-sheet ( obj -- gadget )
     over top-sheet over add-gadget
     over slot-sheet over add-gadget
     swap custom-sheet over add-gadget
-    line-border dup moving-actions ;
+    line-border ;
 
 M: object custom-sheet drop <empty-gadget> ;
 
+M: list custom-sheet ( list -- gadget )
+    [ length count ] keep zip alist>sheet "Elements:" <titled> ;
+
 M: array custom-sheet ( array -- gadget )
-    [ array-capacity [ count ] keep ] keep array>list zip
-    alist>sheet
-    "Elements:" <titled> ;
+    [ array-capacity ] keep array>list custom-sheet ;
 
 M: vector custom-sheet ( array -- gadget )
-    dup vector-length count swap vector>list zip alist>sheet
-    "Elements:" <titled> ;
+    vector>list custom-sheet ;
 
 M: hashtable custom-sheet ( array -- gadget )
     hash>alist sort-sheet alist>sheet "Entries:" <titled> ;
diff --git a/library/ui/menus.factor b/library/ui/menus.factor
index 03025afb69..6c42a77033 100644
--- a/library/ui/menus.factor
+++ b/library/ui/menus.factor
@@ -41,3 +41,10 @@ C: menu ( assoc -- gadget )
 ! While a menu is open, clicking anywhere sends the click to
 ! the menu.
 M: menu inside? ( point menu -- ? ) 2drop t ;
+
+: actionize ( obj assoc -- assoc )
+    #! Prepends an object to each cdr of the assoc list. Utility
+    #! word for constructing menu action association lists.
+    [
+        unswons >r >r unit [ car ] cons r> append r> swons
+    ] map-with ;
diff --git a/library/ui/presentations.factor b/library/ui/presentations.factor
index e4949bdeed..faf29d0ce4 100644
--- a/library/ui/presentations.factor
+++ b/library/ui/presentations.factor
@@ -5,11 +5,6 @@ USING: kernel lists namespaces prettyprint stdio unparser ;
 
 DEFER: inspect
 
-: actionize ( obj assoc -- assoc )
-    [
-        unswons >r >r unit [ car ] cons r> append r> swons
-    ] map-with ;
-
 : object-menu ( obj -- assoc )
     [
         [[ "Inspect" [ inspect ] ]]
diff --git a/library/ui/root-menu.factor b/library/ui/root-menu.factor
index 20caab214b..8af4bbd875 100644
--- a/library/ui/root-menu.factor
+++ b/library/ui/root-menu.factor
@@ -9,7 +9,7 @@ SYMBOL: root-menu
     root-menu get <menu> show-menu ;
 
 : <console> ( -- console )
-    <console-pane> <scroller> line-border  dup moving-actions ;
+    <console-pane> <scroller> line-border ;
 
 [
     [[ "Listener" [ <console> world get add-gadget ] ]]
diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index 0ef6a2d0cf..7caa7a5217 100644
--- a/library/ui/scrolling.factor
+++ b/library/ui/scrolling.factor
@@ -57,7 +57,7 @@ TUPLE: thumb offset delegate ;
 
 : hand-y ( gadget -- y )
     #! Vertical offset of hand from gadget.
-    my-hand swap relative shape-y ;
+    hand swap relative shape-y ;
 
 : thumb-click ( thumb -- )
     [ hand-y ] keep set-thumb-offset ;
@@ -73,7 +73,7 @@ TUPLE: thumb offset delegate ;
 : thumb-actions ( thumb -- )
     dup
     [ thumb-click ] [ button-down 1 ] set-action
-    [ thumb-motion ] [ drag ] set-action ;
+    [ thumb-motion ] [ drag 1 ] set-action ;
 
 C: thumb ( -- thumb )
     0 0 0 0 <plain-rect> <gadget> over set-thumb-delegate
diff --git a/library/ui/world.factor b/library/ui/world.factor
index c144bedcc0..0eb0d01f00 100644
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -2,13 +2,13 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: alien errors generic kernel lists math memory namespaces
-sdl sdl-event sdl-video stdio strings threads ;
+prettyprint sdl sdl-event sdl-video stdio strings threads ;
 
 ! The world gadget is the top level gadget that all (visible)
 ! gadgets are contained in. The current world is stored in the
 ! world variable. The menu slot ensures that only one menu is
 ! open at any one time.
-TUPLE: world running? hand menu delegate ;
+TUPLE: world running? hand menu halo delegate ;
 
 : <world-box> ( -- box )
     0 0 0 0 <plain-rect> <gadget> ;
@@ -16,11 +16,13 @@ TUPLE: world running? hand menu delegate ;
 C: world ( -- world )
     <world-box> over set-world-delegate
     t over set-world-running?
-    dup <hand> over set-world-hand ;
+    dup <hand> over set-world-hand
+    dup <halo> over set-world-halo ;
 
 M: world inside? ( point world -- ? ) 2drop t ;
 
-: my-hand ( -- hand ) world get world-hand ;
+: hand world get world-hand ;
+: halo world get world-halo ;
 
 : draw-world ( world -- )
     dup gadget-redraw? [
@@ -35,10 +37,21 @@ M: world inside? ( point world -- ? ) 2drop t ;
 
 DEFER: handle-event
 
+: layout-halo ( world -- )
+    world-halo dup halo-selected dup [
+        dup gadget-parent [
+            drop dup gadget-parent [ relayout ] [ drop ] ifte
+        ] [
+            unparent drop
+        ] ifte
+    ] [
+        2drop
+    ] ifte ;
+
 : layout-world ( world -- )
     dup
     0 0 width get height get <rectangle> clip set-paint-property
-    dup layout world-hand update-hand ;
+    dup layout-halo dup layout world-hand update-hand ;
 
 : world-step ( world -- ? )
     dup world-running? [
diff --git a/native/arithmetic.c b/native/arithmetic.c
index 6d6b1f50b4..c2bb3ed187 100644
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -2,13 +2,8 @@
 
 void primitive_arithmetic_type(void)
 {
-	CELL obj1 = dpeek();
-	CELL obj2 = get(ds - CELLS);
-
-	CELL type1 = TAG(obj1);
-	CELL type2 = TAG(obj2);
-
-	CELL type;
+	CELL obj1 = dpeek(), obj2 = get(ds - CELLS);
+	CELL type1 = TAG(obj1), type2 = TAG(obj2);
 
 	switch(type2)
 	{
@@ -22,72 +17,64 @@ void primitive_arithmetic_type(void)
 			put(ds - CELLS,tag_float(to_float((obj2))));
 			break;
 		}
-		type = type1;
+		dpush(tag_fixnum(type1));
 		break;
 	case BIGNUM_TYPE:
 		switch(type1)
 		{
 		case FIXNUM_TYPE:
 			drepl(tag_bignum(to_bignum(obj1)));
-			type = type2;
+			dpush(tag_fixnum(type2));
 			break;
 		case FLOAT_TYPE:
 			put(ds - CELLS,tag_float(to_float((obj2))));
-			type = type1;
+			dpush(tag_fixnum(type1));
 			break;
 		default:
-			type = type1;
+			dpush(tag_fixnum(type1));
 			break;
 		}
 		break;
 	case RATIO_TYPE:
 		switch(type1)
 		{
-		case FIXNUM_TYPE:
-		case BIGNUM_TYPE:
-			type = type2;
+		case FIXNUM_TYPE: case BIGNUM_TYPE:
+			dpush(tag_fixnum(type2));
 			break;
 		case FLOAT_TYPE:
 			put(ds - CELLS,tag_float(to_float((obj2))));
-			type = type1;
+			dpush(tag_fixnum(type1));
 			break;
 		default:
-			type = type1;
+			dpush(tag_fixnum(type1));
 			break;
 		}
 		break;
 	case FLOAT_TYPE:
 		switch(type1)
 		{
-		case FIXNUM_TYPE:
-		case BIGNUM_TYPE:
-		case RATIO_TYPE:
+		case FIXNUM_TYPE: case BIGNUM_TYPE: case RATIO_TYPE:
 			drepl(tag_float(to_float(obj1)));
-			type = type2;
+			dpush(tag_fixnum(type2));
 			break;
 		default:
-			type = type1;
+			dpush(tag_fixnum(type1));
 			break;
 		}
 		break;
 	case COMPLEX_TYPE:
 		switch(type1)
 		{
-		case FIXNUM_TYPE:
-		case BIGNUM_TYPE:
-		case RATIO_TYPE:
-		case FLOAT_TYPE:
-			type = type2;
+		case FIXNUM_TYPE: case BIGNUM_TYPE: case RATIO_TYPE: case FLOAT_TYPE:
+			dpush(tag_fixnum(type2));
 			break;
 		default:
-			type = type1;
+			dpush(tag_fixnum(type1));
 			break;
 		}
 		break;
 	default:
-		type = type2;
+		dpush(tag_fixnum(type2));
 		break;
 	}
-	
-	dpush(tag_fixnum(type));
 }
diff --git a/native/array.c b/native/array.c
index 6ecf4cf495..98244fcdff 100644
--- a/native/array.c
+++ b/native/array.c
@@ -1,24 +1,17 @@
 #include "factor.h"
 
-/* untagged */
 F_ARRAY* allot_array(CELL type, CELL capacity)
 {
-	F_ARRAY* array;
-	array = allot_object(type,sizeof(F_ARRAY) + capacity * CELLS);
+	F_ARRAY* array = allot_object(type,sizeof(F_ARRAY) + capacity * CELLS);
 	array->capacity = tag_fixnum(capacity);
 	return array;
 }
 
-/* untagged */
 F_ARRAY* array(CELL type, CELL capacity, CELL fill)
 {
-	int i;
-
-	F_ARRAY* array = allot_array(type, capacity);
-
+	int i; F_ARRAY* array = allot_array(type, capacity);
 	for(i = 0; i < capacity; i++)
 		put(AREF(array,i),fill);
-
 	return array;
 }
 
@@ -43,27 +36,20 @@ void primitive_tuple(void)
 F_ARRAY* grow_array(F_ARRAY* array, CELL capacity, CELL fill)
 {
 	/* later on, do an optimization: if end of array is here, just grow */
-	int i;
-	F_ARRAY* new_array;
+	int i; F_ARRAY* new_array;
 	CELL curr_cap = array_capacity(array);
-
 	if(curr_cap >= capacity)
 		return array;
-
 	new_array = allot_array(untag_header(array->header),capacity);
-
 	memcpy(new_array + 1,array + 1,curr_cap * CELLS);
-
 	for(i = curr_cap; i < capacity; i++)
 		put(AREF(new_array,i),fill);
-
 	return new_array;
 }
 
 void primitive_grow_array(void)
 {
-	F_ARRAY* array;
-	CELL capacity;
+	F_ARRAY* array; CELL capacity;
 	maybe_garbage_collection();
 	array = untag_array(dpop());
 	capacity = to_fixnum(dpop());
@@ -79,16 +65,14 @@ F_ARRAY* shrink_array(F_ARRAY* array, CELL capacity)
 
 void fixup_array(F_ARRAY* array)
 {
-	int i = 0;
-	CELL capacity = array_capacity(array);
+	int i = 0; CELL capacity = array_capacity(array);
 	for(i = 0; i < capacity; i++)
 		data_fixup((void*)AREF(array,i));
 }
 
 void collect_array(F_ARRAY* array)
 {
-	int i = 0;
-	CELL capacity = array_capacity(array);
+	int i = 0; CELL capacity = array_capacity(array);
 	for(i = 0; i < capacity; i++)
 		copy_handle((void*)AREF(array,i));
 }
diff --git a/native/string.c b/native/string.c
index b4bb92b3bd..e02ed6c72a 100644
--- a/native/string.c
+++ b/native/string.c
@@ -80,19 +80,19 @@ void primitive_memory_to_string(void)
 }
 
 /* untagged */
-F_STRING* from_c_string(const BYTE* c_string)
+F_STRING* from_c_string(const char* c_string)
 {
-	return memory_to_string(c_string,strlen(c_string));
+	return memory_to_string((BYTE*)c_string,strlen(c_string));
 }
 
 /* FFI calls this */
-void box_c_string(const BYTE* c_string)
+void box_c_string(const char* c_string)
 {
 	dpush(tag_object(from_c_string(c_string)));
 }
 
 /* untagged */
-BYTE* to_c_string(F_STRING* s)
+char* to_c_string(F_STRING* s)
 {
 	CELL i;
 	CELL capacity = string_capacity(s);
@@ -122,18 +122,18 @@ void primitive_string_to_memory(void)
 }
 
 /* untagged */
-BYTE* to_c_string_unchecked(F_STRING* s)
+char* to_c_string_unchecked(F_STRING* s)
 {
 	CELL capacity = string_capacity(s);
 	F_STRING* _c_str = allot_string(capacity / CHARS + 1);
 	BYTE* c_str = (BYTE*)(_c_str + 1);
 	string_to_memory(s,c_str);
 	c_str[capacity] = '\0';
-	return c_str;
+	return (char*)c_str;
 }
 
 /* FFI calls this */
-BYTE* unbox_c_string(void)
+char* unbox_c_string(void)
 {
 	return to_c_string(untag_string(dpop()));
 }
diff --git a/native/string.h b/native/string.h
index 032c1ee961..f9f6adeb90 100644
--- a/native/string.h
+++ b/native/string.h
@@ -26,13 +26,13 @@ F_STRING* allot_string(CELL capacity);
 F_STRING* string(CELL capacity, CELL fill);
 void rehash_string(F_STRING* str);
 F_STRING* grow_string(F_STRING* string, F_FIXNUM capacity, uint16_t fill);
-BYTE* to_c_string(F_STRING* s);
-BYTE* to_c_string_unchecked(F_STRING* s);
+char* to_c_string(F_STRING* s);
+char* to_c_string_unchecked(F_STRING* s);
 void primitive_string_to_memory(void);
-DLLEXPORT void box_c_string(const BYTE* c_string);
-F_STRING* from_c_string(const BYTE* c_string);
+DLLEXPORT void box_c_string(const char* c_string);
+F_STRING* from_c_string(const char* c_string);
 void primitive_memory_to_string(void);
-DLLEXPORT BYTE* unbox_c_string(void);
+DLLEXPORT char* unbox_c_string(void);
 DLLEXPORT uint16_t* unbox_utf16_string(void);
 
 /* untagged & unchecked */
diff --git a/native/unix/io.c b/native/unix/io.c
index 97953dd2a3..a62ce2d462 100644
--- a/native/unix/io.c
+++ b/native/unix/io.c
@@ -83,7 +83,7 @@ bool perform_copy_from_io_task(F_PORT* port, F_PORT* other_port)
 	if(can_write(other_port,port->buf_fill))
 	{
 		write_string_raw(other_port,
-			(BYTE*)(untag_string(port->buffer) + 1),
+			(char*)(untag_string(port->buffer) + 1),
 			port->buf_fill);
 		port->buf_pos = port->buf_fill = 0;
 	}
diff --git a/native/unix/write.c b/native/unix/write.c
index a0dc109946..b25c34b577 100644
--- a/native/unix/write.c
+++ b/native/unix/write.c
@@ -91,7 +91,7 @@ void write_char_8(F_PORT* port, F_FIXNUM ch)
 }
 
 /* Caller must ensure buffer is of the right size. */
-void write_string_raw(F_PORT* port, BYTE* str, CELL len)
+void write_string_raw(F_PORT* port, char* str, CELL len)
 {
 	/* Append string to buffer */
 	memcpy((void*)((CELL)untag_string(port->buffer) + sizeof(F_STRING)
diff --git a/native/write.h b/native/write.h
index 64cb51eb94..ef3b157c27 100644
--- a/native/write.h
+++ b/native/write.h
@@ -4,6 +4,6 @@ void primitive_can_write(void);
 void primitive_add_write_io_task(void);
 bool perform_write_io_task(F_PORT* port);
 void write_char_8(F_PORT* port, F_FIXNUM ch);
-void write_string_raw(F_PORT* port, BYTE* str, CELL len);
+void write_string_raw(F_PORT* port, char* str, CELL len);
 void write_string_8(F_PORT* port, F_STRING* str);
 void primitive_write_8(void);