From 88576aefe45d74dbc6f24a792e3f6a514e5f79b7 Mon Sep 17 00:00:00 2001
From: James Cash <james.nvc@gmail.com>
Date: Thu, 15 May 2008 22:14:53 -0400
Subject: [PATCH] Adding define-primitive word

---
 extra/lisp/lisp-tests.factor | 10 ++++------
 extra/lisp/lisp.factor       | 17 ++++++++++-------
 2 files changed, 14 insertions(+), 13 deletions(-)

diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor
index df37de2475..06c2260d72 100644
--- a/extra/lisp/lisp-tests.factor
+++ b/extra/lisp/lisp-tests.factor
@@ -6,14 +6,12 @@ IN: lisp.test
 
 init-env
 
-"+" [ first2 + ] lisp-define
+"+" "math" "+" define-primitve
 
-{ [ first2 + ] } [
-  "+" lisp-get
+{ 5 } [
+  [ 2 3 ] "+" <lisp-symbol> funcall
 ] unit-test
 
 { 3 } [
-  [
-    "((lambda (x y) (+ x y)) 1 2)" lisp-string>factor call
-  ] with-interactive-vocabs
+  "((lambda (x y) (+ x y)) 1 2)" lisp-string>factor call
 ] unit-test
\ No newline at end of file
diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor
index 3e4cdca41f..32df8c5102 100644
--- a/extra/lisp/lisp.factor
+++ b/extra/lisp/lisp.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel peg sequences arrays strings combinators.lib
 namespaces combinators math bake locals locals.private accessors
-vectors syntax lisp.parser assocs parser sequences.lib ;
+vectors syntax lisp.parser assocs parser sequences.lib words ;
 IN: lisp
 
 DEFER: convert-form
@@ -24,7 +24,8 @@ DEFER: funcall
   
 : convert-general-form ( s-exp -- quot )
   unclip convert-form swap convert-body [ , % funcall ] bake ;
-  
+
+! words for convert-lambda  
 <PRIVATE  
 : localize-body ( assoc body -- assoc newbody )  
   [ dup lisp-symbol? [ over dupd [ name>> ] dip at swap or ]
@@ -34,8 +35,6 @@ DEFER: funcall
 : localize-lambda ( body vars -- newbody newvars )
   make-locals dup push-locals swap
   [ swap localize-body <s-exp> convert-form swap pop-locals ] dip swap ;
-  
-PRIVATE>
                    
 : split-lambda ( s-exp -- body vars )                   
   first3 -rot nip [ body>> ] bi@ [ name>> ] map ; inline
@@ -47,6 +46,7 @@ PRIVATE>
   
 : normal-lambda ( body vars -- quot )
   localize-lambda <lambda> [ , compose ] bake ;
+PRIVATE>
   
 : convert-lambda ( s-exp -- quot )  
   split-lambda dup "&rest"  swap member? [ rest-lambda ] [ normal-lambda ] if ;
@@ -68,7 +68,7 @@ PRIVATE>
   
 : convert-form ( lisp-form -- quot )
   dup s-exp?  [ body>> convert-list-form ]
-              [ [ , ] [ ] make ] if ;
+              [ [ , ] bake ] if ;
                 
 : lisp-string>factor ( str -- quot )
   lisp-expr parse-result-ast convert-form lambda-rewrite call ;
@@ -85,7 +85,10 @@ ERROR: no-such-var var ;
   swap lisp-env get set-at ;
   
 : lisp-get ( name -- word )
-  dup lisp-env get at [ ] [ no-such-var ] ?if ;
+  dup lisp-env get at [ ] [ no-such-var throw ] ?if ;
   
 : funcall ( quot sym -- * )
-  dup lisp-symbol?  [ name>> lisp-get ] when call ; inline
\ No newline at end of file
+  dup lisp-symbol?  [ name>> lisp-get ] when call ; inline
+
+: define-primitve ( name vocab word -- )  
+  swap lookup [ [ , ] compose call ] bake lisp-define ;
\ No newline at end of file