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

extra/lisp/lisp-docs.factor

@@ -0,0 +1,15 @@
+IN: lisp
+USING: help.markup help.syntax ;
+
+ARTICLE: "lisp" "Lisp in Factor"
+"This is a simple implementation of a Lisp dialect, which somewhat resembles Scheme." $nl
+"It works in two main stages: "
+{ $list
+  { "Parse (via "  { $vocab-link "lisp.parser" } " the Lisp code into a "
+    { $snippet "s-exp"  } " tuple." }
+  { "Transform the " { $snippet "s-exp" } " into a Factor quotation, via " { $link convert-form } }
+}
+
+{ $subsection "lisp.parser" } ;
+
+ABOUT: "lisp"

extra/lisp/lisp-tests.factor

@@ -6,14 +6,40 @@ IN: lisp.test
 
 init-env
 
-"+" [ first2 + ] lisp-define
+"#f" [ f ] lisp-define 
+"#t" [ t ] lisp-define
 
-{ [ first2 + ] } [
-  "+" lisp-get
+"+" "math" "+" define-primitve
+"-" "math" "-" define-primitve
+
+{ 5 } [
+  [ 2 3 ] "+" <lisp-symbol> funcall
+] unit-test
+
+{ 8.3 } [
+ [ 10.4 2.1 ] "-" <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
+
+{ 42 } [
+  "((lambda (x y z) (+ x (- y z))) 40 3 1)" lisp-string>factor call
+] unit-test
+
+{ 1 } [
+  "(if #t 1 2)" lisp-string>factor call
+] unit-test
+
+{ "b" } [
+  "(cond (#f \"a\") (#t \"b\"))" lisp-string>factor call
+] unit-test
+
+{ 5 } [
+  "(begin (+ 1 4))" lisp-string>factor call
+] unit-test
+
+{ 3 } [
+   "((lambda (x) (if x (begin (+ 1 2)) (- 3 5))) #t)" lisp-string>factor call
 ] unit-test

extra/lisp/lisp.factor

@@ -2,11 +2,12 @@
 ! 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 quotations ;
 IN: lisp
 
 DEFER: convert-form
 DEFER: funcall
+DEFER: lookup-var
 
 ! Functions to convert s-exps to quotations
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -17,14 +18,16 @@ DEFER: funcall
   rest [ convert-form ] map reverse first3  [ % , , if ] bake ;
   
 : convert-begin ( s-exp -- quot )  
-  rest convert-form ;
+  rest [ convert-form ] map >quotation [ , [ funcall ] each ] bake ;
   
 : convert-cond ( s-exp -- quot )  
-  rest [ [ convert-form map ] map ] [ % cond ] bake ;
+  rest [ body>> >array [ convert-form ] map first2 swap `{ [ % funcall ] , } bake ]
+  map >array [ , cond ] bake ;
   
 : 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 ]
@@ -35,8 +38,6 @@ DEFER: funcall
   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 +48,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 ;
@@ -67,8 +69,10 @@ PRIVATE>
     [ drop convert-general-form ] if ;
   
 : convert-form ( lisp-form -- quot )
-  dup s-exp?  [ body>> convert-list-form ]
-              [ [ , ] [ ] make ] if ;
+  { { [ dup s-exp? ] [ body>> convert-list-form ] }
+    { [ dup lisp-symbol? ] [ [ , lookup-var ] bake ] }
+    [ [ , ] bake ]
+  } cond ;
                 
 : lisp-string>factor ( str -- quot )
   lisp-expr parse-result-ast convert-form lambda-rewrite call ;
@@ -85,7 +89,13 @@ 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 ;
+  
+: lookup-var ( lisp-symbol -- quot )
+  name>> lisp-get ;
   
 : funcall ( quot sym -- * )
-  dup lisp-symbol?  [ name>> lisp-get ] when call ; inline
+  dup lisp-symbol?  [ lookup-var ] when call ; inline
+  
+: define-primitve ( name vocab word -- )  
+  swap lookup [ [ , ] compose call ] bake lisp-define ;

extra/lisp/parser/parser-docs.factor

@@ -0,0 +1,6 @@
+IN: lisp.parser
+USING: help.markup help.syntax ;
+
+ARTICLE: "lisp.parser" "Parsing strings of Lisp"
+"This vocab uses " { $vocab-link "peg.ebnf" } " to turn strings of Lisp into " { $snippet "s-exp" } "s, which are then used by"
+{ $vocab-link "lisp" } " to produce Factor quotations." ;

extra/lisp/parser/parser.factor

@@ -24,7 +24,7 @@ rational     = integer "/" (digit)+                      => [[ first3 nip string
 number       = float
               | rational
               | integer
-id-specials  = "!" | "$" | "%" | "&" | "*" | "/" | ":" | "<"
+id-specials  = "!" | "$" | "%" | "&" | "*" | "/" | ":" | "<" | "#"
               | " =" | ">" | "?" | "^" | "_" | "~" | "+" | "-" | "." | "@"
 letters      = [a-zA-Z]                                  => [[ 1array >string ]]
 initials     = letters | id-specials

extra/lisp/summary.txt

@@ -1 +1 @@
-A Lisp interpreter in Factor 
+A Lisp interpreter/compiler in Factor