Merge branch 'master' of git://factorcode.org/git/jamesnvc

diff --git a/extra/advice/advice-docs.factor b/extra/advice/advice-docs.factor
new file mode 100644 (file)
index 0000000..2b33378
--- /dev/null
+++ b/extra/advice/advice-docs.factor
@@ -0,0 +1,22 @@
+IN: advice
+USING: help.markup help.syntax tools.annotations words ;
+
+HELP: make-advised
+{ $values { "word" "a word to annotate in preparation of advising" } }
+{ $description "Prepares a word for being advised.  This is done by: "
+    { $list
+        { "Annotating it to call the appropriate words before, around, and after the original body " }
+        { "Adding " { $snippet "before" } ", " { $snippet "around" } ", and " { $snippet "after" } " properties, which will contain the advice" }
+        { "Adding an " { $snippet "advised" } "property, which can later be used to determine if a given word is defined (see " { $link advised? } ")" }
+    }
+}
+{ $see-also advised? annotate } ;
+
+HELP: advised?
+{ $values { "word" "a word" } { "?" "t or f, indicating if " { $snippet word } " is advised" } }
+{ $description "Determines whether or not the given word has any advice on it." } ;
+
+ARTICLE: "advice" "Advice"
+"Advice is a simple way of adding additition functionality to words by adding 'hooks' to a word, which can act before, after, or around the calling of the word." ;
+
+ABOUT: "advice"
\ No newline at end of file

diff --git a/extra/advice/advice-tests.factor b/extra/advice/advice-tests.factor
new file mode 100644 (file)
index 0000000..17b60c8
--- /dev/null
+++ b/extra/advice/advice-tests.factor
@@ -0,0 +1,40 @@
+! Copyright (C) 2008 James Cash
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences math tools.test advice parser namespaces ;
+IN: advice.tests
+
+[
+: foo "foo" ; 
+\ foo make-advised
+ 
+  { "bar" "foo" } [
+     [ "bar" ] "barify" \ foo advise-before
+     foo ] unit-test
+ 
+  { "bar" "foo" "baz" } [
+      [ "baz" ] "bazify" \ foo advise-after
+      foo ] unit-test
+ 
+  { "foo" "baz" } [
+     "barify" \ foo before remove-advice
+     foo ] unit-test
+ 
+: bar ( a -- b ) 1+ ;
+\ bar make-advised
+
+  { 11 } [
+     [ 2 * ] "double" \ bar advise-before
+     5 bar
+  ] unit-test 
+
+  { 11/3 } [
+      [ 3 / ] "third" \ bar advise-after
+      5 bar
+  ] unit-test
+
+  { -2 } [
+      [ -1 * ad-do-it 3 + ] "frobnobicate" \ bar advise-around
+      5 bar
+  ] unit-test
+ 
+ ] with-scope
\ No newline at end of file

diff --git a/extra/advice/advice.factor b/extra/advice/advice.factor
new file mode 100644 (file)
index 0000000..6a7d46f
--- /dev/null
+++ b/extra/advice/advice.factor
@@ -0,0 +1,49 @@
+! Copyright (C) 2008 James Cash
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences symbols fry words assocs tools.annotations coroutines ;
+IN: advice
+
+SYMBOLS: before after around advised ;
+
+<PRIVATE
+: advise ( quot name word loc --  )
+    word-prop set-at ;
+PRIVATE>
+    
+: advise-before ( quot name word --  )
+    before advise ;
+    
+: advise-after ( quot name word --  )
+    after advise ;
+
+: advise-around ( quot name word --  )
+    [ \ coterminate suffix ] 2dip
+    around advise ;
+
+: get-advice ( word type -- seq )
+    word-prop values ;
+
+: call-before ( word --  )
+    before get-advice [ call ] each ;
+
+: call-after ( word --  )
+    after get-advice [ call ] each ;
+
+: call-around ( main word --  )
+    around get-advice [ cocreate ] map tuck 
+    [ [ coresume ] each ] [ call ] [ reverse [ coresume ] each ] tri* ;
+
+: remove-advice ( name word loc --  )
+    word-prop delete-at ;
+
+: ad-do-it ( input -- result )
+    coyield ;
+
+: advised? ( word -- ? )
+    advised word-prop ;
+    
+: make-advised ( word -- )
+    [ dup [ over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ]
+    [ { before after around } [ H{ } clone swap set-word-prop ] with each ] 
+    [ t advised set-word-prop ] tri ;
+    
\ No newline at end of file

diff --git a/extra/advice/authors.txt b/extra/advice/authors.txt
new file mode 100644 (file)
index 0000000..4b7af4a
--- /dev/null
+++ b/extra/advice/authors.txt
@@ -0,0 +1 @@
+James Cash

diff --git a/extra/advice/summary.txt b/extra/advice/summary.txt
new file mode 100644 (file)
index 0000000..a6f9c06
--- /dev/null
+++ b/extra/advice/summary.txt
@@ -0,0 +1 @@
+Implmentation of advice/aspects

diff --git a/extra/advice/tags.txt b/extra/advice/tags.txt
new file mode 100644 (file)
index 0000000..a87b65d
--- /dev/null
+++ b/extra/advice/tags.txt
@@ -0,0 +1,3 @@
+advice
+aspect
+annotations

diff --git a/extra/lisp/lisp-docs.factor b/extra/lisp/lisp-docs.factor
index 149f22864e2f9ea5a56ce83379f2bee59a7e038e..c970a1e0b7b943992c9abcab428cab6862b885aa 100644 (file)
--- a/extra/lisp/lisp-docs.factor
+++ b/extra/lisp/lisp-docs.factor
@@ -1,5 +1,12 @@
 IN: lisp
 USING: help.markup help.syntax ;
+HELP: <LISP
+{ $description "parsing word which converts the lisp code between <LISP and LISP> into factor quotations and calls it" }
+{ $see-also lisp-string>factor } ;
+
+HELP: lisp-string>factor
+{ $values { "str"  "a string of lisp code" } { "quot" "the quotation the lisp compiles into" } }
+{ $description "Turns a string of lisp into a factor quotation" } ;
 
 ARTICLE: "lisp" "Lisp in Factor"
 "This is a simple implementation of a Lisp dialect, which somewhat resembles Scheme." $nl

diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor
index 48f6419d3031c5f32958f7fc7bf1d68a5369b4a3..5f849c441689fbc2731840e860e3e7a5d93dbe1c 100644 (file)
--- a/extra/lisp/lisp-tests.factor
+++ b/extra/lisp/lisp-tests.factor
@@ -84,4 +84,11 @@ IN: lisp.test
         <LISP ((lambda (x y) (if x (+ 1 y) (+ 2 y))) #t 3) LISP>
     ] unit-test
     
+    { { 3 3 4 } } [
+        <LISP (defun foo (x y &rest z)
+                  (cons (+ x y) z))
+              (foo 1 2 3 4)
+        LISP> cons>seq
+    ] unit-test
+    
 ] with-interactive-vocabs

diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor
index e60529caab7511587c8ef3b6ac532255145dfc3d..4a933501e8705b0f075d3de13ef3cfe41c36d348 100644 (file)
--- a/extra/lisp/lisp.factor
+++ b/extra/lisp/lisp.factor
@@ -64,14 +64,9 @@ PRIVATE>
 : macro-expand ( cons -- quot )
     uncons [ list>seq >quotation ] [ lookup-macro ] bi* call call ;
 
-<PRIVATE
-: (expand-macros) ( cons -- cons )
-    [ dup list? [ (expand-macros) dup car lisp-macro? [ macro-expand ] when ] when ] lmap ;
-PRIVATE>
-
 : expand-macros ( cons -- cons )
-    dup list? [ (expand-macros) dup car lisp-macro? [ macro-expand ] when ] when ;
-
+    dup list? [ [ expand-macros ] lmap dup car lisp-macro? [ macro-expand expand-macros ] when ] when ;
+    
 : convert-begin ( cons -- quot )
     cdr [ convert-form ] [ ] lmap-as [ 1 tail* ] [ but-last ] bi
     [ '[ { } _ with-datastack drop ] ] map prepend '[ _ [ call ] each ] ;
@@ -169,15 +164,15 @@ M: no-such-var summary drop "No such variable" ;
 
    "set" "lisp" "define-lisp-var" define-primitive
     
-   "(lambda (&rest xs) xs)" lisp-string>factor first "list" lisp-define
-   "(defmacro setq (var val) (list (quote set) (list (quote quote) var) val))" lisp-eval
+   "(set 'list (lambda (&rest xs) xs))" lisp-eval
+   "(defmacro setq (var val) (list 'set (list 'quote var) val))" lisp-eval
     
    <" (defmacro defun (name vars &rest body)
-        (list (quote setq) name (list (quote lambda) vars body))) "> lisp-eval
+        (list 'setq name (cons 'lambda (cons vars body)))) "> lisp-eval
     
-   "(defmacro if (pred tr fl) (list (quote cond) (list pred tr) (list (quote #t) fl)))" lisp-eval
+   "(defmacro if (pred tr fl) (list 'cond (list pred tr) (list (quote #t) fl)))" lisp-eval
    ;
 
 : <LISP 
-    "LISP>" parse-multiline-string define-lisp-builtins
-    lisp-string>factor parsed \ call parsed ; parsing
+    "LISP>" parse-multiline-string "(begin " prepend ")" append define-lisp-builtins
+    lisp-string>factor parsed \ call parsed ; parsing
\ No newline at end of file

diff --git a/extra/lisp/parser/parser-tests.factor b/extra/lisp/parser/parser-tests.factor
index d722390f9a699c39c1c1ca1e89032d44a1a5aa6b..911a8d34401030fdcbe0b20ad93bdd2cac55a293 100644 (file)
--- a/extra/lisp/parser/parser-tests.factor
+++ b/extra/lisp/parser/parser-tests.factor
@@ -65,4 +65,16 @@ IN: lisp.parser.tests
    }
 } [
     "(1 (3 4) 2)" lisp-expr
+] unit-test
+    
+{ { T{ lisp-symbol { name "quote" } } { 1 2 3 } } } [
+    "'(1 2 3)" lisp-expr cons>seq
+] unit-test
+    
+{ { T{ lisp-symbol f "quote" } T{ lisp-symbol f "foo" } } } [
+    "'foo" lisp-expr cons>seq
+] unit-test
+    
+{ { 1 2 { T{ lisp-symbol { name "quote" } } { 3 4 } } 5 } } [
+    "(1 2 '(3 4) 5)" lisp-expr cons>seq
 ] unit-test
\ No newline at end of file

diff --git a/extra/lisp/parser/parser.factor b/extra/lisp/parser/parser.factor
index 72344fd0dc23e96d561793c3ff86a98e84ed3758..50f58692d5833ea2541544e882a1b52105b95826 100644 (file)
--- a/extra/lisp/parser/parser.factor
+++ b/extra/lisp/parser/parser.factor
@@ -35,5 +35,7 @@ atom         = number
               | identifier
               | string
 s-expression = LPAREN (list-item)* RPAREN                => [[ second seq>cons ]]
-list-item    = _ ( atom | s-expression ) _               => [[ second ]]
-;EBNF
+list-item    = _ ( atom | s-expression | quoted ) _      => [[ second ]]
+quoted       = squote list-item                          => [[ second nil cons "quote" <lisp-symbol> swap cons ]]
+expr         = list-item
+;EBNF
\ No newline at end of file

diff --git a/work/README.txt b/work/README.txt
deleted file mode 100644 (file)
index fd1af07..0000000
--- a/work/README.txt
+++ /dev/null
@@ -1 +0,0 @@
-The 'work' directory is for your own personal vocabularies.