Merge git://factorcode.org/git/jamesnvc

extra/lisp/authors.txt

@@ -0,0 +1 @@
+James Cash

extra/lisp/lisp-tests.factor

@@ -0,0 +1,21 @@
+! Copyright (C) 2008 James Cash
+! See http://factorcode.org/license.txt for BSD license.
+USING: lisp lisp.parser tools.test ;
+
+IN: lisp.test
+
+{ [ "aoeu" 2 1 T{ lisp-symbol f "foo" } ] } [
+  "(foo 1 2 \"aoeu\")" lisp-string>factor
+] unit-test
+
+init-env
+
+"+" [ first2 + ] lisp-define
+
+{ [ first2 + ] } [
+  "+" lisp-get
+] unit-test
+
+{ 3 } [
+  "((lambda (x y) (+ x y)) 1 2)" lisp-string>factor call
+] unit-test

extra/lisp/lisp.factor

@@ -0,0 +1,88 @@
+! Copyright (C) 2008 James Cash
+! 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 ;
+IN: lisp
+
+DEFER: convert-form
+DEFER: funcall
+
+! Functions to convert s-exps to quotations
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+: convert-body ( s-exp -- quot )
+  [ convert-form ] map [ ] [ compose ] reduce ; inline
+  
+: convert-if ( s-exp -- quot )
+  rest [ convert-form ] map reverse first3  [ % , , if ] bake ;
+  
+: convert-begin ( s-exp -- quot )  
+  rest convert-form ;
+  
+: convert-cond ( s-exp -- quot )  
+  rest [ [ convert-form map ] map ] [ % cond ] bake ;
+  
+: convert-general-form ( s-exp -- quot )
+  unclip convert-form swap convert-body [ , % funcall ] bake ;
+  
+<PRIVATE  
+: localize-body ( vars body -- newbody )  
+  [ dup lisp-symbol? [ tuck name>> swap member? [ name>> make-local ] [ ] if ]
+                     [ dup s-exp? [ body>> localize-body <s-exp> ] [ nip ] if ] if
+                   ] with map ;
+  
+: localize-lambda ( body vars -- newbody newvars )
+  dup make-locals dup push-locals [ swap localize-body <s-exp> convert-form ] dipd
+  pop-locals swap ;
+  
+PRIVATE>
+                   
+: split-lambda ( s-exp -- body vars )                   
+  first3 -rot nip [ body>> ] bi@ [ name>> ] map ; inline                 
+  
+: rest-lambda-vars ( seq -- n newseq )  
+  "&rest" swap [ remove ] [ index ] 2bi ;
+  
+: convert-lambda ( s-exp -- quot )  
+  split-lambda dup "&rest"  swap member? [ rest-lambda-vars ] [ dup length ] if
+  [ localize-lambda <lambda> ] dip
+  [ , cut [ dup length firstn ] dip dup empty? [ drop ] when  , with-locals ] bake ;
+  
+: convert-quoted ( s-exp -- quot )  
+  second [ , ] bake ;
+  
+: convert-list-form ( s-exp -- quot )  
+  dup first dup lisp-symbol?
+    [ name>>
+      { { "lambda" [ convert-lambda ] }
+        { "quote" [ convert-quoted ] }
+        { "if" [ convert-if ] }
+        { "begin" [ convert-begin ] }
+        { "cond" [ convert-cond ] }
+       [ drop convert-general-form ]
+      } case ]
+    [ drop convert-general-form ] if ;
+  
+: convert-form ( lisp-form -- quot )
+  { { [ dup s-exp? ] [ body>> convert-list-form ] }
+   [ [ , ] [ ] make ]
+  } cond ;
+  
+: lisp-string>factor ( str -- quot )
+  lisp-expr parse-result-ast convert-form ;
+  
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: lisp-env
+
+: init-env ( -- )
+  H{ } clone lisp-env set ;
+
+: lisp-define ( name quot -- )
+  swap lisp-env get set-at ;
+  
+: lisp-get ( name -- word )
+  lisp-env get at ;
+  
+: funcall ( quot sym -- * )
+  dup lisp-symbol?  [ name>> lisp-get ] when call ; inline

extra/lisp/parser/authors.txt

@@ -0,0 +1 @@
+James Cash

extra/lisp/parser/parser-tests.factor

@@ -0,0 +1,38 @@
+! Copyright (C) 2008 James Cash
+! See http://factorcode.org/license.txt for BSD license.
+USING: lisp.parser tools.test peg peg.ebnf ;
+
+IN: lisp.parser.tests
+
+{ 1234  }  [
+  "1234" "atom" \ lisp-expr rule parse parse-result-ast
+] unit-test
+
+{ 123.98 } [
+  "123.98" "atom" \ lisp-expr rule parse parse-result-ast
+] unit-test
+
+{ "" } [
+  "\"\"" "atom" \ lisp-expr rule parse parse-result-ast
+] unit-test
+
+{ "aoeu" } [
+  "\"aoeu\"" "atom" \ lisp-expr rule parse parse-result-ast
+] unit-test
+
+{ "aoeu\"de" } [
+  "\"aoeu\\\"de\"" "atom" \ lisp-expr rule parse parse-result-ast
+] unit-test
+
+{ T{ lisp-symbol f "foobar" } } [
+  "foobar" "atom" \ lisp-expr rule parse parse-result-ast
+] unit-test
+
+{ T{ lisp-symbol f "+" } } [
+  "+" "atom" \ lisp-expr rule parse parse-result-ast
+] unit-test
+
+{ T{ s-exp f
+     V{ T{ lisp-symbol f "foo" } 1 2 "aoeu" } } } [
+  "(foo 1 2 \"aoeu\")" lisp-expr parse-result-ast
+] unit-test

extra/lisp/parser/parser.factor

@@ -0,0 +1,39 @@
+! Copyright (C) 2008 James Cash
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel peg.ebnf peg.expr math.parser sequences arrays strings
+combinators.lib ;
+
+IN: lisp.parser
+
+TUPLE: lisp-symbol name ;
+C: <lisp-symbol> lisp-symbol
+
+TUPLE: s-exp body ;
+C: <s-exp> s-exp
+
+EBNF: lisp-expr
+_            = (" " | "\t" | "\n")*
+LPAREN       = "("
+RPAREN       = ")"
+dquote       = '"'
+squote       = "'"
+digit        = [0-9]
+integer      = (digit)+                            => [[ string>number ]]
+float        = (digit)+ "." (digit)*               => [[ first3 >string [ >string ] dipd 3append string>number ]]
+number       = float
+              | integer
+id-specials  = "!" | "$" | "%" | "&" | "*" | "/" | ":" | "<"
+              | " =" | ">" | "?" | "^" | "_" | "~" | "+" | "-" | "." | "@"
+letters      = [a-zA-Z]                                  => [[ 1array >string ]]
+initials     = letters | id-specials
+numbers      = [0-9]                                     => [[ 1array >string ]]
+subsequents  = initials | numbers
+identifier   = initials (subsequents)*                   => [[ first2 concat append <lisp-symbol> ]]
+escaped      = "\" .                                     => [[ second ]]
+string       = dquote ( escaped | !(dquote) . )*  dquote => [[ second >string ]]
+atom         = number
+              | identifier
+              | string
+list-item    = _ (atom|s-expression) _                   => [[ second ]]
+s-expression = LPAREN (list-item)* RPAREN                => [[ second <s-exp> ]]
+;EBNF

extra/lisp/parser/summary.txt

@@ -0,0 +1 @@
+EBNF grammar for parsing Lisp

extra/lisp/parser/tags.txt

@@ -0,0 +1,2 @@
+lisp
+parsing

extra/lisp/summary.txt

@@ -0,0 +1 @@
+A Lisp interpreter in Factor 

extra/lisp/tags.txt

@@ -0,0 +1,2 @@
+lisp
+languages