define-compound

factor/jedit/FactorSideKickParser.java

@@ -146,6 +146,7 @@ public class FactorSideKickParser extends SideKickParser
 			parsed = parsed.next();
 		}
 
+		if(last != null)
 			last.end = buffer.createPosition(buffer.getLength());
 	} //}}}
 

library/platform/jvm/words.factor

@@ -3,6 +3,7 @@
 ! $Id$
 !
 ! Copyright (C) 2003 Slava Pestov.
+! Copyright (C) 2004 Chris Double.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -101,3 +102,8 @@ USE: stack
 
 : compound>list ( worddef -- list )
     worddef>list dup [ skip-docs ] when ;
+
+: define-compound ( word def -- )
+    #! Define a compound word at runtime.
+    >r dup >r [ "vocabulary" get "name" get ] bind r> r>
+    <compound> define ;

library/platform/native/parse-syntax.factor

@@ -81,7 +81,7 @@ USE: unparser
     #! End a word definition.
     nreverse
     "cross-compiling" get
-    [ compound, ] [ define ] ifte ; parsing
+    [ compound, ] [ define-compound ] ifte ; parsing
 
 ! Vocabularies
 : DEFER: CREATE drop ; parsing

library/platform/native/words.factor

@@ -48,6 +48,12 @@ USE: stack
 : primitive? ( obj -- ? )
     dup word? [ word-primitive 1 = not ] [ drop f ] ifte ;
 
+: define-compound ( word def -- )
+    #! Define a compound word at runtime.
+    over set-word
+    over set-word-parameter
+    1 swap set-word-primitive ;
+
 ! Various features not supported by native Factor.
 : comment? drop f ;
 : worddef>list word-parameter ;
@@ -61,12 +67,3 @@ IN: kernel
 
 : set-word ( word -- )
     global [ "last-word" set ] bind ;
-
-IN: builtins
-
-: define ( word definition -- )
-    #! Unlike the Java interpreter primitive define, the
-    #! definition parameter is a list.
-    over set-word
-    over set-word-parameter
-    1 swap set-word-primitive ;

library/test/test.factor

@@ -78,6 +78,7 @@ USE: unparser
         "prettyprint"
         "inspector"
         "vectors"
+        "words"
         "unparser"
         "random"
         "math/bitops"

library/test/words.factor

@@ -0,0 +1,9 @@
+IN: scratchpad
+USE: arithmetic
+USE: test
+USE: words
+
+[ 4 ] [
+    "poo" "scratchpad" create [ 2 2 + ] define-compound
+    "poo" [ "scratchpad" ] search execute
+] unit-test