diff --git a/extra/lisp/lisp-docs.factor b/extra/lisp/lisp-docs.factor new file mode 100644 index 0000000000..149f22864e --- /dev/null +++ b/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" \ No newline at end of file diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor index df37de2475..05ce63a69d 100644 --- a/extra/lisp/lisp-tests.factor +++ b/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 ] "+" funcall +] unit-test + +{ 8.3 } [ + [ 10.4 2.1 ] "-" 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 \ No newline at end of file diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index 3e4cdca41f..0f5e4b4d2e 100644 --- a/extra/lisp/lisp.factor +++ b/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 > ] dip at swap or ] @@ -34,8 +37,6 @@ DEFER: funcall : localize-lambda ( body vars -- newbody newvars ) make-locals dup push-locals swap [ swap localize-body 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 [ , 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 \ No newline at end of file + dup lisp-symbol? [ lookup-var ] when call ; inline + +: define-primitve ( name vocab word -- ) + swap lookup [ [ , ] compose call ] bake lisp-define ; \ No newline at end of file diff --git a/extra/lisp/parser/parser-docs.factor b/extra/lisp/parser/parser-docs.factor new file mode 100644 index 0000000000..fc16a0a310 --- /dev/null +++ b/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." ; \ No newline at end of file diff --git a/extra/lisp/parser/parser.factor b/extra/lisp/parser/parser.factor index 32886f9367..44c79fd962 100644 --- a/extra/lisp/parser/parser.factor +++ b/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 diff --git a/extra/lisp/summary.txt b/extra/lisp/summary.txt index 8c36217f1c..7277c2a5b5 100644 --- a/extra/lisp/summary.txt +++ b/extra/lisp/summary.txt @@ -1 +1 @@ -A Lisp interpreter in Factor +A Lisp interpreter/compiler in Factor