From 192dd6c5a6f085d6cab18a433816a21ac685293f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 19 Aug 2004 23:36:28 +0000
Subject: [PATCH] define-compound

---
 factor/jedit/FactorSideKickParser.java      |  3 ++-
 library/platform/jvm/words.factor           |  6 ++++++
 library/platform/native/parse-syntax.factor |  2 +-
 library/platform/native/words.factor        | 15 ++++++---------
 library/test/test.factor                    |  1 +
 library/test/words.factor                   |  9 +++++++++
 6 files changed, 25 insertions(+), 11 deletions(-)
 create mode 100644 library/test/words.factor

diff --git a/factor/jedit/FactorSideKickParser.java b/factor/jedit/FactorSideKickParser.java
index 03e3343e22..6988cf0b1a 100644
--- a/factor/jedit/FactorSideKickParser.java
+++ b/factor/jedit/FactorSideKickParser.java
@@ -146,7 +146,8 @@ public class FactorSideKickParser extends SideKickParser
 			parsed = parsed.next();
 		}
 
-		last.end = buffer.createPosition(buffer.getLength());
+		if(last != null)
+			last.end = buffer.createPosition(buffer.getLength());
 	} //}}}
 
 	//{{{ supportsCompletion() method
diff --git a/library/platform/jvm/words.factor b/library/platform/jvm/words.factor
index ee95e04962..d0a63d3e18 100644
--- a/library/platform/jvm/words.factor
+++ b/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 ;
diff --git a/library/platform/native/parse-syntax.factor b/library/platform/native/parse-syntax.factor
index 13486ea25f..9f1c0baa20 100644
--- a/library/platform/native/parse-syntax.factor
+++ b/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
diff --git a/library/platform/native/words.factor b/library/platform/native/words.factor
index 0891716cbd..e0aa3641a1 100644
--- a/library/platform/native/words.factor
+++ b/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 ;
diff --git a/library/test/test.factor b/library/test/test.factor
index e0a3cb6299..733f6cd2e7 100644
--- a/library/test/test.factor
+++ b/library/test/test.factor
@@ -78,6 +78,7 @@ USE: unparser
         "prettyprint"
         "inspector"
         "vectors"
+        "words"
         "unparser"
         "random"
         "math/bitops"
diff --git a/library/test/words.factor b/library/test/words.factor
new file mode 100644
index 0000000000..48e62cebbc
--- /dev/null
+++ b/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