From b494a18b9e377eb3326eb99e7b2ee9a5f93bae31 Mon Sep 17 00:00:00 2001 From: James Cash Date: Thu, 5 Jun 2008 16:28:24 -0400 Subject: [PATCH 1/5] Adding tests for macros now --- extra/lisp/lisp-tests.factor | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor index 2603a75cb0..a6016f2697 100644 --- a/extra/lisp/lisp-tests.factor +++ b/extra/lisp/lisp-tests.factor @@ -31,6 +31,10 @@ IN: lisp.test "((lambda (x y z) (+ x (- y z))) 40 3 1)" lisp-eval ] unit-test + { T{ lisp-symbol f "if" } } [ + "(defmacro if (pred tr fl) (quasiquote (cond ((unquote pred) (unquote tr)) (#t (unquote fl)))))" lisp-eval + ] unit-test + { 1 } [ "(if #t 1 2)" lisp-eval ] unit-test From 35e2bb8711bdacf3dedac1cb0410fa33f7bf9836 Mon Sep 17 00:00:00 2001 From: James Cash Date: Thu, 5 Jun 2008 18:14:43 -0400 Subject: [PATCH 2/5] More macro tests --- extra/lisp/lisp-tests.factor | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor index a6016f2697..c4090e1098 100644 --- a/extra/lisp/lisp-tests.factor +++ b/extra/lisp/lisp-tests.factor @@ -7,8 +7,8 @@ IN: lisp.test [ init-env - "#f" [ f ] lisp-define - "#t" [ t ] lisp-define + [ f ] "#f" lisp-define + [ t ] "#t" lisp-define "+" "math" "+" define-primitive "-" "math" "-" define-primitive @@ -35,6 +35,10 @@ IN: lisp.test "(defmacro if (pred tr fl) (quasiquote (cond ((unquote pred) (unquote tr)) (#t (unquote fl)))))" lisp-eval ] unit-test + { t } [ + T{ lisp-symbol f "if" } lisp-macro? + ] unit-test + { 1 } [ "(if #t 1 2)" lisp-eval ] unit-test From 60db47acf4f1f8e72ffc528f3d69d71fef042e64 Mon Sep 17 00:00:00 2001 From: James Cash Date: Thu, 5 Jun 2008 18:15:05 -0400 Subject: [PATCH 3/5] Macros almost working --- extra/lisp/lisp.factor | 56 ++++++++++++++++++++++++------------------ 1 file changed, 32 insertions(+), 24 deletions(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index 6193c3b33e..b64957b2c5 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel peg sequences arrays strings combinators.lib namespaces combinators math locals locals.private accessors -vectors syntax lisp.parser assocs parser sequences.lib words quotations -fry lists inspector ; +vectors syntax lisp.parser assocs parser sequences.lib words +quotations fry lists inspector ; IN: lisp DEFER: convert-form @@ -11,15 +11,13 @@ DEFER: funcall DEFER: lookup-var DEFER: lisp-macro? DEFER: lookup-macro -DEFER: macro-call - +DEFER: macro-expand +DEFER: define-lisp-macro + ! Functions to convert s-exps to quotations ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : convert-body ( cons -- quot ) [ ] [ convert-form compose ] foldl ; inline - -: convert-if ( cons -- quot ) - cdr 3car [ convert-form ] tri@ '[ @ , , if ] ; : convert-begin ( cons -- quot ) cdr [ convert-form ] [ ] lmap-as '[ , [ funcall ] each ] ; @@ -34,13 +32,11 @@ DEFER: macro-call ! words for convert-lambda > swap at swap or ] - [ dup cons? [ localize-body ] when nip ] if - ] with lmap>array ; - + [ lisp-symbol? ] pick '[ [ name>> , at ] [ ] bi or ] traverse ; + : localize-lambda ( body vars -- newbody newvars ) make-locals dup push-locals swap - [ swap localize-body seq>cons convert-form swap pop-locals ] dip swap ; + [ swap localize-body convert-form swap pop-locals ] dip swap ; : split-lambda ( cons -- body-cons vars-seq ) 3car -rot nip [ name>> ] lmap>array ; inline @@ -67,24 +63,24 @@ PRIVATE> [ { [ dup list? ] [ car dup lisp-symbol? ] [ name>> "unquote" equal? dup ] } && nip ] [ cadr ] traverse ; -: form-dispatch ( lisp-symbol -- quot ) +: convert-defmacro ( cons -- quot ) + cdr [ car ] keep [ convert-lambda ] [ car name>> ] bi define-lisp-macro 1quotation ; + +: form-dispatch ( cons lisp-symbol -- quot ) name>> { { "lambda" [ convert-lambda ] } + { "defmacro" [ convert-defmacro ] } { "quote" [ convert-quoted ] } { "unquote" [ convert-unquoted ] } { "quasiquote" [ convert-quasiquoted ] } - { "if" [ convert-if ] } { "begin" [ convert-begin ] } { "cond" [ convert-cond ] } [ drop convert-general-form ] } case ; -: macro-expand ( cons -- quot ) - uncons lookup-macro macro-call convert-form ; - : convert-list-form ( cons -- quot ) dup car - { { [ dup lisp-macro? ] [ macro-expand ] } + { { [ dup lisp-macro? ] [ drop macro-expand ] } { [ dup lisp-symbol? ] [ form-dispatch ] } [ drop convert-general-form ] } cond ; @@ -96,8 +92,17 @@ PRIVATE> [ 1quotation ] } cond ; +: compile-form ( lisp-ast -- quot ) + convert-form lambda-rewrite call ; inline + +: macro-call ( lambda -- cons ) + call ; + +: macro-expand ( cons -- quot ) + uncons lookup-macro macro-call compile-form ; + : lisp-string>factor ( str -- quot ) - lisp-expr parse-result-ast convert-form lambda-rewrite call ; + lisp-expr parse-result-ast compile-form ; : lisp-eval ( str -- * ) lisp-string>factor call ; @@ -105,7 +110,7 @@ PRIVATE> ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SYMBOL: lisp-env -ERROR: no-such-var var ; +ERROR: no-such-var variable-name ; SYMBOL: macro-env @@ -115,8 +120,8 @@ M: no-such-var summary drop "No such variable" ; H{ } clone lisp-env set H{ } clone macro-env set ; -: lisp-define ( name quot -- ) - swap lisp-env get set-at ; +: lisp-define ( quot name -- ) + lisp-env get set-at ; : lisp-get ( name -- word ) dup lisp-env get at [ ] [ no-such-var ] ?if ; @@ -128,10 +133,13 @@ M: no-such-var summary drop "No such variable" ; dup lisp-symbol? [ lookup-var ] when call ; inline : define-primitive ( name vocab word -- ) - swap lookup 1quotation '[ , compose call ] lisp-define ; + swap lookup 1quotation '[ , compose call ] swap lisp-define ; -: lookup-macro ( lisp-symbol -- macro ) +: lookup-macro ( lisp-symbol -- lambda ) name>> macro-env get at ; +: define-lisp-macro ( quot name -- ) + macro-env get set-at ; + : lisp-macro? ( car -- ? ) dup lisp-symbol? [ name>> macro-env get key? ] [ drop f ] if ; From 90905c2519f6e9bd929e23ec142d5134eaef1a3c Mon Sep 17 00:00:00 2001 From: James Cash Date: Thu, 5 Jun 2008 18:53:44 -0400 Subject: [PATCH 4/5] Fixing remaining lazy-lists, to lists.lazy --- extra/lists/lazy/examples/examples.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/lists/lazy/examples/examples.factor b/extra/lists/lazy/examples/examples.factor index 9e8fb77439..f85344651d 100644 --- a/extra/lists/lazy/examples/examples.factor +++ b/extra/lists/lazy/examples/examples.factor @@ -2,8 +2,8 @@ ! Copyright (C) 2004 Chris Double. ! See http://factorcode.org/license.txt for BSD license. -USING: lazy-lists math kernel sequences quotations ; -IN: lazy-lists.examples +USING: lists.lazy math kernel sequences quotations ; +IN: lists.lazy.examples : naturals 0 lfrom ; : positives 1 lfrom ; From 50b76dbe269d050e6c3f60fbc185b1010865bf8a Mon Sep 17 00:00:00 2001 From: James Cash Date: Thu, 5 Jun 2008 18:53:58 -0400 Subject: [PATCH 5/5] Fixing docs for lists --- extra/lists/lazy/lazy-docs.factor | 1 - extra/lists/lists-docs.factor | 8 ++++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/extra/lists/lazy/lazy-docs.factor b/extra/lists/lazy/lazy-docs.factor index 8d457ba2e1..95e925b089 100644 --- a/extra/lists/lazy/lazy-docs.factor +++ b/extra/lists/lazy/lazy-docs.factor @@ -127,4 +127,3 @@ HELP: llines { $values { "stream" "a stream" } { "result" "a list" } } { $description "Returns a lazy list of all lines in the file. " { $link car } " returns the next lines in the file, " { $link cdr } " returns the remaining lines as a lazy list. " { $link nil? } " indicates end of file." } { $see-also lcontents } ; - diff --git a/extra/lists/lists-docs.factor b/extra/lists/lists-docs.factor index a5299ba6a0..15faf8d002 100644 --- a/extra/lists/lists-docs.factor +++ b/extra/lists/lists-docs.factor @@ -19,8 +19,8 @@ HELP: cdr { $description "Returns the tail of the list." } ; HELP: nil -{ $values { "cons" "An empty cons" } } -{ $description "Returns a representation of an empty list" } ; +{ $values { "symbol" "The empty cons (+nil+)" } } +{ $description "Returns a symbol representing the empty list" } ; HELP: nil? { $values { "cons" "a cons object" } { "?" "a boolean" } } @@ -85,7 +85,7 @@ HELP: list>seq { $description "Turns the given cons object into an array, maintaing order." } ; HELP: seq>list -{ $values { "array" "an array object" } { "list" "a cons object" } } +{ $values { "seq" "a sequence" } { "list" "a cons object" } } { $description "Turns the given array into a cons object, maintaing order." } ; HELP: cons>seq @@ -97,7 +97,7 @@ HELP: seq>cons { $description "Recursively turns the given sequence into a cons object, maintaing order and also converting nested lists." } ; HELP: traverse -{ $values { " list" "a cons object" } { "pred" } { "a quotation with stack effect ( list/elt -- ? )" } +{ $values { "list" "a cons object" } { "pred" "a quotation with stack effect ( list/elt -- ? )" } { "quot" "a quotation with stack effect ( list/elt -- result)" } { "result" "a new cons object" } } { $description "Recursively traverses the list object, replacing any elements (which can themselves be sublists) that pred" " returns true for with the result of applying quot to." } ;