factor: trim using lists

[factor.git] / extra / icfp / 2006 / 2006.factor

diff --git a/extra/icfp/2006/2006.factor b/extra/icfp/2006/2006.factor
old mode 100755 (executable)
new mode 100644 (file)
index e88301c..2617691
--- a/extra/icfp/2006/2006.factor
+++ b/extra/icfp/2006/2006.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2007 Gavin Harrison
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences kernel.private namespaces arrays io
-io.files splitting io.binary math.functions vectors quotations
-combinators io.encodings.binary ;
+USING: arrays combinators endian grouping io io.encodings.binary
+io.files kernel math math.functions namespaces sequences vectors ;
 IN: icfp.2006
 
 SYMBOL: regs
@@ -21,44 +20,44 @@ SYMBOL: open-arrays
     arrays get nth set-nth ;
 
 : get-op ( num -- op )
-    -28 shift BIN: 1111 bitand ;
+    -28 shift 0b1111 bitand ;
 
 : get-value ( platter -- register )
-    HEX: 1ffffff bitand ;
+    0x1ffffff bitand ;
 
-: >32bit ( m -- n ) HEX: ffffffff bitand ; inline
+: >32bit ( m -- n ) 0xffffffff bitand ; inline
 
 : get-a ( platter -- register )
-    -6 shift BIN: 111 bitand ; inline
+    -6 shift 0b111 bitand ; inline
 
 : get-b ( platter -- register )
-    -3 shift BIN: 111 bitand ; inline
+    -3 shift 0b111 bitand ; inline
 
 : get-c ( platter -- register )
-    BIN: 111 bitand ; inline
+    0b111 bitand ; inline
 
 : get-cb ( platter -- b c ) [ get-c ] keep get-b ;
 : get-cba ( platter -- c b a ) [ get-cb ] keep get-a ;
 : get-special ( platter -- register )
-    -25 shift BIN: 111 bitand ; inline
+    -25 shift 0b111 bitand ; inline
 
 : op0 ( opcode -- ? )
     get-cba rot reg-val zero? [
         2drop
     ] [
-        >r reg-val r> set-reg
+        [ reg-val ] dip set-reg
     ] if f ;
 
 : binary-op ( quot -- ? )
-    >r get-cba r>
-    swap >r >r [ reg-val ] bi@ swap r> call r>
+    [ get-cba ] dip
+    swap [ [ [ reg-val ] bi@ swap ] dip call ] dip
     set-reg f ; inline
 
 : op1 ( opcode -- ? )
     [ swap arr-val ] binary-op ;
 
 : op2 ( opcode -- ? )
-    get-cba >r [ reg-val ] bi@ r> reg-val set-arr f ;
+    get-cba [ [ reg-val ] bi@ ] dip reg-val set-arr f ;
 
 : op3 ( opcode -- ? )
     [ + >32bit ] binary-op ;
@@ -70,21 +69,21 @@ SYMBOL: open-arrays
     [ /i ] binary-op ;
 
 : op6 ( opcode -- ? )
-    [ bitand HEX: ffffffff swap - ] binary-op ;
+    [ bitand 0xffffffff swap - ] binary-op ;
 
 : new-array ( size location -- )
-    >r 0 <array> r> arrays get set-nth ;
+    [ 0 <array> ] dip arrays get set-nth ;
 
 : ?grow-storage ( -- )
     open-arrays get dup empty? [
-        >r arrays get length r> push
+        [ arrays get length ] dip push
     ] [
         drop
     ] if ;
 
 : op8 ( opcode -- ? )
     ?grow-storage
-    get-cb >r reg-val open-arrays get pop [ new-array ] keep r>
+    get-cb [ reg-val open-arrays get pop [ new-array ] keep ] dip
     set-reg f ;
 
 : op9 ( opcode -- ? )
@@ -148,4 +147,4 @@ SYMBOL: open-arrays
     init f exec-loop ;
 
 : run-sand ( -- )
-    "extra/icfp/2006/sandmark.umz" resource-path run-prog ;
+    "resource:extra/icfp/2006/sandmark.umz" run-prog ;