From b77d6601415033ec95a2b01330ed7fab8126635f Mon Sep 17 00:00:00 2001 From: James Cash Date: Thu, 17 Apr 2008 02:37:03 -0400 Subject: [PATCH 01/22] Initial import of Lisp-in-Factor --- extra/lisp/authors.txt | 1 + extra/lisp/lisp.factor | 4 ++++ extra/lisp/summary.txt | 1 + extra/lisp/tags.txt | 1 + 4 files changed, 7 insertions(+) create mode 100644 extra/lisp/authors.txt create mode 100644 extra/lisp/lisp.factor create mode 100644 extra/lisp/summary.txt create mode 100644 extra/lisp/tags.txt diff --git a/extra/lisp/authors.txt b/extra/lisp/authors.txt new file mode 100644 index 0000000000..4b7af4aac0 --- /dev/null +++ b/extra/lisp/authors.txt @@ -0,0 +1 @@ +James Cash diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor new file mode 100644 index 0000000000..c604a35b1b --- /dev/null +++ b/extra/lisp/lisp.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2008 James Cash +! See http://factorcode.org/license.txt for BSD license. + +IN: lisp \ No newline at end of file diff --git a/extra/lisp/summary.txt b/extra/lisp/summary.txt new file mode 100644 index 0000000000..8c36217f1c --- /dev/null +++ b/extra/lisp/summary.txt @@ -0,0 +1 @@ +A Lisp interpreter in Factor diff --git a/extra/lisp/tags.txt b/extra/lisp/tags.txt new file mode 100644 index 0000000000..0ca0d1aa8c --- /dev/null +++ b/extra/lisp/tags.txt @@ -0,0 +1 @@ +Lisp languages From a033091b44b60774af70541bbd23fa22bb84e5ca Mon Sep 17 00:00:00 2001 From: James Cash Date: Thu, 17 Apr 2008 12:37:31 -0400 Subject: [PATCH 02/22] Starting work on EBNF for lisp --- extra/lisp/lisp.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index c604a35b1b..e051241a32 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -1,4 +1,8 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. +USING: kernel peg.ebnf peg.expr ; +IN: lisp -IN: lisp \ No newline at end of file +EBNF: expr +list = "(" ( atom | list )* ")" => [[ second 1array ]] +;EBNF \ No newline at end of file From 025da7d2cd7d19bf47e28a9be0809aebc0660fd6 Mon Sep 17 00:00:00 2001 From: James Cash Date: Sun, 20 Apr 2008 01:41:16 -0400 Subject: [PATCH 03/22] More work on extra/lisp --- extra/lisp/lisp.factor | 14 +++++++++++--- extra/lisp/tags.txt | 2 +- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index e051241a32..3dba8cfb1d 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -1,8 +1,16 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. -USING: kernel peg.ebnf peg.expr ; +USING: kernel peg.ebnf peg.expr math.parser sequences arrays ; IN: lisp -EBNF: expr -list = "(" ( atom | list )* ")" => [[ second 1array ]] +EBNF: lisp-expr +digit = [0-9] => [[ digit> ]] +integer = (digit)+ => [[ 10 digits>integer ]] +float = (digit)+ "." (digit)* => [[ 3 head 3append string>number ]] +number = integer + | float +identifier = [a-zA-Z] ([a-zA-Z0-9])* +atom = number + | identifier +list = "(" (atom|list)* ")" => [[ second 1array ]] ;EBNF \ No newline at end of file diff --git a/extra/lisp/tags.txt b/extra/lisp/tags.txt index 0ca0d1aa8c..eee3fba9aa 100644 --- a/extra/lisp/tags.txt +++ b/extra/lisp/tags.txt @@ -1 +1 @@ -Lisp languages +lisp From 8db59121c6ece9e1eb1b12f21b0b11544e91a62d Mon Sep 17 00:00:00 2001 From: James Cash Date: Mon, 21 Apr 2008 20:25:29 -0400 Subject: [PATCH 04/22] Adding some tags --- extra/lisp/tags.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/extra/lisp/tags.txt b/extra/lisp/tags.txt index eee3fba9aa..c369ccae57 100644 --- a/extra/lisp/tags.txt +++ b/extra/lisp/tags.txt @@ -1 +1,2 @@ lisp +languages From b1bd228cb5c73be4988f4b1f261a2e9719074b32 Mon Sep 17 00:00:00 2001 From: James Cash Date: Mon, 21 Apr 2008 20:25:55 -0400 Subject: [PATCH 05/22] if-conversion working --- extra/lisp/lisp.factor | 51 +++++++++++++++++++++++++++++++++--------- 1 file changed, 41 insertions(+), 10 deletions(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index 3dba8cfb1d..b2cb975f47 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -1,16 +1,47 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. -USING: kernel peg.ebnf peg.expr math.parser sequences arrays ; +USING: kernel peg.ebnf peg.expr math.parser sequences arrays strings combinators.lib +namespaces combinators math ; IN: lisp +TUPLE: lisp-symbol name ; + +C: lisp-symbol + EBNF: lisp-expr -digit = [0-9] => [[ digit> ]] -integer = (digit)+ => [[ 10 digits>integer ]] -float = (digit)+ "." (digit)* => [[ 3 head 3append string>number ]] -number = integer - | float -identifier = [a-zA-Z] ([a-zA-Z0-9])* +_ = (" " | "\t" | "\n")* +LPAREN = "(" +RPAREN = ")" +digit = [0-9] +integer = (digit)+ => [[ string>number ]] +float = (digit)+ "." (digit)* => [[ first3 >string [ >string ] 2 ndip 3append string>number ]] +number = float + | integer +identifier = [a-zA-Z] ([^(){} ])* => [[ [ 1 head ] [ second ] bi append >string ]] atom = number - | identifier -list = "(" (atom|list)* ")" => [[ second 1array ]] -;EBNF \ No newline at end of file + | identifier +list-item = _ (atom|list) _ => [[ second ]] +list = LPAREN (list-item)* RPAREN => [[ second ]] +;EBNF + +DEFER: convert-form + +: convert-body ( lisp-form -- quot ) + [ convert-form ] map [ ] [ compose ] reduce ; inline + +: convert-if ( lisp-form -- quot ) + 1 tail [ convert-form ] map reverse first3 [ % , , \ if , ] [ ] make ; + +: convert-general-form ( lisp-form -- quot ) + unclip swap convert-body [ % , ] [ ] make ; + +: convert-list-form ( lisp-form -- quot ) +dup first + { { [ dup "if" equal? ] [ convert-if ] } + [ drop convert-general-form ] + } cond ; + +: convert-form ( lisp-form -- quot ) + { { [ dup [ sequence? ] [ number? not ] bi and ] [ convert-list-form ] } + [ [ , ] [ ] make ] + } cond ; \ No newline at end of file From 761e3bb8f5f6863078cb6671a008596520cd4c77 Mon Sep 17 00:00:00 2001 From: James Cash Date: Wed, 23 Apr 2008 09:01:33 -0400 Subject: [PATCH 06/22] Using bake instead of make --- extra/lisp/lisp.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index b2cb975f47..d2de6fe278 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -1,7 +1,7 @@ ! 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 -namespaces combinators math ; +namespaces combinators math bake ; IN: lisp TUPLE: lisp-symbol name ; @@ -30,14 +30,14 @@ DEFER: convert-form [ convert-form ] map [ ] [ compose ] reduce ; inline : convert-if ( lisp-form -- quot ) - 1 tail [ convert-form ] map reverse first3 [ % , , \ if , ] [ ] make ; + 1 tail [ convert-form ] map reverse first3 [ % , , if ] bake ; : convert-general-form ( lisp-form -- quot ) - unclip swap convert-body [ % , ] [ ] make ; + unclip swap convert-body [ % , ] bake ; : convert-list-form ( lisp-form -- quot ) dup first - { { [ dup "if" equal? ] [ convert-if ] } + { { [ dup "if" equal? ] [ drop convert-if ] } [ drop convert-general-form ] } cond ; From 1069db6d053095278c7c9cf1b855b4784c3c788d Mon Sep 17 00:00:00 2001 From: James Cash Date: Wed, 23 Apr 2008 09:01:54 -0400 Subject: [PATCH 07/22] Adding unit tests --- extra/lisp/lisp-tests.factor | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 extra/lisp/lisp-tests.factor diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor new file mode 100644 index 0000000000..a3db32c915 --- /dev/null +++ b/extra/lisp/lisp-tests.factor @@ -0,0 +1,4 @@ +[ [ T{ lisp-symbol f "foo" } [ 2 T{ lisp-symbol f "bar" } ] [ 3 4 T{ lisp-symbol f "baz" } ] if ] ] + [ "(if foo (bar 2) (baz 3 4))" lisp-expr parse-result-ast convert-if ] unit-test + + \ No newline at end of file From ec79b7823f822d36930c6c1c77e1c1ff6b857324 Mon Sep 17 00:00:00 2001 From: James Cash Date: Thu, 24 Apr 2008 16:35:42 -0400 Subject: [PATCH 08/22] Adding lambda conversion and strings --- extra/lisp/lisp.factor | 64 ++++++++++++++++++++++++++++++------------ 1 file changed, 46 insertions(+), 18 deletions(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index d2de6fe278..be43d50a18 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -1,29 +1,38 @@ ! 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 -namespaces combinators math bake ; +namespaces combinators math bake locals.private accessors vectors syntax ; IN: lisp TUPLE: lisp-symbol name ; -C: lisp-symbol +C: lisp-symbol EBNF: lisp-expr -_ = (" " | "\t" | "\n")* -LPAREN = "(" -RPAREN = ")" -digit = [0-9] -integer = (digit)+ => [[ string>number ]] -float = (digit)+ "." (digit)* => [[ first3 >string [ >string ] 2 ndip 3append string>number ]] -number = float - | integer -identifier = [a-zA-Z] ([^(){} ])* => [[ [ 1 head ] [ second ] bi append >string ]] -atom = number - | identifier -list-item = _ (atom|list) _ => [[ second ]] -list = LPAREN (list-item)* RPAREN => [[ second ]] +_ = (" " | "\t" | "\n")* +LPAREN = "(" +RPAREN = ")" +dquote = '"' +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 ]] +string = dquote ("\" . | !(dquote) . )* dquote => [[ second >string ]] +atom = number + | identifier + | string +list-item = _ (atom|list) _ => [[ second ]] +list = LPAREN (list-item)* RPAREN => [[ second ]] ;EBNF - + DEFER: convert-form : convert-body ( lisp-form -- quot ) @@ -32,12 +41,31 @@ DEFER: convert-form : convert-if ( lisp-form -- quot ) 1 tail [ convert-form ] map reverse first3 [ % , , if ] bake ; +: convert-begin ( lisp-form -- quot ) + 1 tail convert-body ; + +: convert-cond ( lisp-form -- quot ) + 1 tail [ [ convert-body map ] map ] [ % cond ] bake ; + : convert-general-form ( lisp-form -- quot ) unclip swap convert-body [ % , ] bake ; - + +> swap member? [ name>> make-local ] [ ] if ] + [ dup vector? [ localize-body ] [ nip ] if ] if ] with map ; inline +PRIVATE> + +: convert-lambda ( lisp-form -- quot ) + 1 tail unclip reverse [ name>> ] map dup make-locals dup push-locals + [ swap localize-body convert-body ] dipd pop-locals swap ; + : convert-list-form ( lisp-form -- quot ) dup first - { { [ dup "if" equal? ] [ drop convert-if ] } + { { [ dup "if" equal? ] [ drop convert-if ] } + { [ dup "begin" equal? ] [ drop convert-begin ] } + { [ dup "cond" equal? ] [ drop convert-cond ] } + { [ dup "lambda" equal? ] [ drop convert-lambda ] } [ drop convert-general-form ] } cond ; From df4023b6a76f695e91d6c50dcc7fefff1c6c9b38 Mon Sep 17 00:00:00 2001 From: James Cash Date: Thu, 24 Apr 2008 22:50:23 -0400 Subject: [PATCH 09/22] Fixed bug in convert-list-form --- extra/lisp/lisp.factor | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index be43d50a18..624f190fb1 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -61,15 +61,15 @@ PRIVATE> [ swap localize-body convert-body ] dipd pop-locals swap ; : convert-list-form ( lisp-form -- quot ) -dup first - { { [ dup "if" equal? ] [ drop convert-if ] } - { [ dup "begin" equal? ] [ drop convert-begin ] } - { [ dup "cond" equal? ] [ drop convert-cond ] } - { [ dup "lambda" equal? ] [ drop convert-lambda ] } +dup first dup lisp-symbol? [ name>> + { { "lambda" [ convert-lambda ] } + { "if" [ convert-if ] } + { "begin" [ convert-begin ] } + { "cond" [ convert-cond ] } [ drop convert-general-form ] - } cond ; + } case ] [ drop convert-general-form ] if ; : convert-form ( lisp-form -- quot ) - { { [ dup [ sequence? ] [ number? not ] bi and ] [ convert-list-form ] } + { { [ dup vector? ] [ convert-list-form ] } [ [ , ] [ ] make ] } cond ; \ No newline at end of file From 228430512c0ed31a055d25326bb021cc6ad7c441 Mon Sep 17 00:00:00 2001 From: James Cash Date: Sat, 26 Apr 2008 15:55:39 -0400 Subject: [PATCH 10/22] Splitting EBNF parser to seperate vocab --- extra/lisp/parser/parser.factor | 36 +++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 extra/lisp/parser/parser.factor diff --git a/extra/lisp/parser/parser.factor b/extra/lisp/parser/parser.factor new file mode 100644 index 0000000000..0fac78ae75 --- /dev/null +++ b/extra/lisp/parser/parser.factor @@ -0,0 +1,36 @@ +USING: kernel peg.ebnf peg.expr math.parser sequences arrays strings +combinators.lib ; + +IN: lisp.parser + +TUPLE: lisp-symbol name ; +C: lisp-symbol + +TUPLE: s-exp body ; +C: 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 ]] +string = dquote ("\" . | !(dquote) . )* dquote => [[ second >string ]] +atom = number + | identifier + | string +list-item = _ (atom|s-expression) _ => [[ second ]] +s-expression = LPAREN (list-item)* RPAREN => [[ second ]] +;EBNF From 1ad1f5ceba4b828c6fdf8d1e49a5a85ac2a4019d Mon Sep 17 00:00:00 2001 From: James Cash Date: Sat, 26 Apr 2008 17:17:34 -0400 Subject: [PATCH 11/22] Switching back from tuple to vectors --- extra/lisp/parser/parser.factor | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/extra/lisp/parser/parser.factor b/extra/lisp/parser/parser.factor index 0fac78ae75..2375313a10 100644 --- a/extra/lisp/parser/parser.factor +++ b/extra/lisp/parser/parser.factor @@ -6,9 +6,6 @@ IN: lisp.parser TUPLE: lisp-symbol name ; C: lisp-symbol -TUPLE: s-exp body ; -C: s-exp - EBNF: lisp-expr _ = (" " | "\t" | "\n")* LPAREN = "(" @@ -32,5 +29,5 @@ atom = number | identifier | string list-item = _ (atom|s-expression) _ => [[ second ]] -s-expression = LPAREN (list-item)* RPAREN => [[ second ]] +s-expression = LPAREN (list-item)* RPAREN => [[ second ]] ;EBNF From 0c10c13e4d315f70ca72cce99ca7d3ff8e0b6b22 Mon Sep 17 00:00:00 2001 From: James Cash Date: Sat, 26 Apr 2008 17:20:12 -0400 Subject: [PATCH 12/22] Bug fixes --- extra/lisp/lisp.factor | 66 +++++++++++++----------------------------- 1 file changed, 20 insertions(+), 46 deletions(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index 624f190fb1..729c136a95 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -1,53 +1,24 @@ ! 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 -namespaces combinators math bake locals.private accessors vectors syntax ; +USING: kernel peg sequences arrays strings combinators.lib +namespaces combinators math bake locals.private accessors vectors syntax lisp.parser ; IN: lisp -TUPLE: lisp-symbol name ; - -C: lisp-symbol - -EBNF: lisp-expr -_ = (" " | "\t" | "\n")* -LPAREN = "(" -RPAREN = ")" -dquote = '"' -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 ]] -string = dquote ("\" . | !(dquote) . )* dquote => [[ second >string ]] -atom = number - | identifier - | string -list-item = _ (atom|list) _ => [[ second ]] -list = LPAREN (list-item)* RPAREN => [[ second ]] -;EBNF - DEFER: convert-form -: convert-body ( lisp-form -- quot ) +: convert-body ( s-exp -- quot ) [ convert-form ] map [ ] [ compose ] reduce ; inline -: convert-if ( lisp-form -- quot ) +: convert-if ( s-exp -- quot ) 1 tail [ convert-form ] map reverse first3 [ % , , if ] bake ; -: convert-begin ( lisp-form -- quot ) +: convert-begin ( s-exp -- quot ) 1 tail convert-body ; -: convert-cond ( lisp-form -- quot ) +: convert-cond ( s-exp -- quot ) 1 tail [ [ convert-body map ] map ] [ % cond ] bake ; -: convert-general-form ( lisp-form -- quot ) +: convert-general-form ( s-exp -- quot ) unclip swap convert-body [ % , ] bake ; -: convert-lambda ( lisp-form -- quot ) +: convert-lambda ( s-exp -- quot ) 1 tail unclip reverse [ name>> ] map dup make-locals dup push-locals [ swap localize-body convert-body ] dipd pop-locals swap ; -: convert-list-form ( lisp-form -- quot ) -dup first dup lisp-symbol? [ name>> - { { "lambda" [ convert-lambda ] } - { "if" [ convert-if ] } - { "begin" [ convert-begin ] } - { "cond" [ convert-cond ] } - [ drop convert-general-form ] - } case ] [ drop convert-general-form ] if ; +: convert-list-form ( s-exp -- quot ) + dup first dup lisp-symbol? [ name>> + { { "lambda" [ convert-lambda ] } + { "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 vector? ] [ convert-list-form ] } [ [ , ] [ ] make ] - } cond ; \ No newline at end of file + } cond ; + +: lisp-string>factor ( str -- quot ) + lisp-expr parse-result-ast convert-form ; \ No newline at end of file From a6f25c55fc5e480bf82efef2d25bf4364b3ee076 Mon Sep 17 00:00:00 2001 From: James Cash Date: Sun, 27 Apr 2008 03:03:49 -0400 Subject: [PATCH 13/22] Changing back to use a tuple for the parsed s-expression --- extra/lisp/lisp.factor | 10 +++++----- extra/lisp/parser/parser.factor | 7 +++++-- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index 729c136a95..e254c51b7b 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -7,7 +7,7 @@ IN: lisp DEFER: convert-form : convert-body ( s-exp -- quot ) - [ convert-form ] map [ ] [ compose ] reduce ; inline + [ convert-form ] map reverse [ ] [ compose ] reduce ; inline : convert-if ( s-exp -- quot ) 1 tail [ convert-form ] map reverse first3 [ % , , if ] bake ; @@ -18,17 +18,17 @@ DEFER: convert-form : convert-cond ( s-exp -- quot ) 1 tail [ [ convert-body map ] map ] [ % cond ] bake ; -: convert-general-form ( s-exp -- quot ) +: convert-general-form ( s-exp -- quot ) unclip swap convert-body [ % , ] bake ; > swap member? [ name>> make-local ] [ ] if ] - [ dup vector? [ localize-body ] [ nip ] if ] if ] with map ; inline + [ dup s-exp? [ body>> localize-body ] [ nip ] if ] if ] with map ; PRIVATE> : convert-lambda ( s-exp -- quot ) - 1 tail unclip reverse [ name>> ] map dup make-locals dup push-locals + first3 -rot nip [ body>> ] bi@ reverse [ name>> ] map dup make-locals dup push-locals [ swap localize-body convert-body ] dipd pop-locals swap ; : convert-list-form ( s-exp -- quot ) @@ -41,7 +41,7 @@ PRIVATE> } case ] [ drop convert-general-form ] if ; : convert-form ( lisp-form -- quot ) - { { [ dup vector? ] [ convert-list-form ] } + { { [ dup s-exp? ] [ body>> convert-list-form ] } [ [ , ] [ ] make ] } cond ; diff --git a/extra/lisp/parser/parser.factor b/extra/lisp/parser/parser.factor index 2375313a10..ec079265bc 100644 --- a/extra/lisp/parser/parser.factor +++ b/extra/lisp/parser/parser.factor @@ -6,6 +6,9 @@ IN: lisp.parser TUPLE: lisp-symbol name ; C: lisp-symbol +TUPLE: s-exp body ; +C: s-exp + EBNF: lisp-expr _ = (" " | "\t" | "\n")* LPAREN = "(" @@ -29,5 +32,5 @@ atom = number | identifier | string list-item = _ (atom|s-expression) _ => [[ second ]] -s-expression = LPAREN (list-item)* RPAREN => [[ second ]] -;EBNF +s-expression = LPAREN (list-item)* RPAREN => [[ second ]] +;EBNF \ No newline at end of file From 5d689e732d7201a601df060a5e8fb3a902d4ea4e Mon Sep 17 00:00:00 2001 From: James Cash Date: Sun, 27 Apr 2008 23:12:18 -0400 Subject: [PATCH 14/22] Adding requisite files to lisp.parser --- extra/lisp/parser/authors.txt | 1 + extra/lisp/parser/parser-tests.factor | 34 +++++++++++++++++++++++++++ extra/lisp/parser/summary.txt | 1 + extra/lisp/parser/tags.txt | 2 ++ 4 files changed, 38 insertions(+) create mode 100644 extra/lisp/parser/authors.txt create mode 100644 extra/lisp/parser/parser-tests.factor create mode 100644 extra/lisp/parser/summary.txt create mode 100644 extra/lisp/parser/tags.txt diff --git a/extra/lisp/parser/authors.txt b/extra/lisp/parser/authors.txt new file mode 100644 index 0000000000..4b7af4aac0 --- /dev/null +++ b/extra/lisp/parser/authors.txt @@ -0,0 +1 @@ +James Cash diff --git a/extra/lisp/parser/parser-tests.factor b/extra/lisp/parser/parser-tests.factor new file mode 100644 index 0000000000..025b45e60d --- /dev/null +++ b/extra/lisp/parser/parser-tests.factor @@ -0,0 +1,34 @@ +! Copyright (C) 2008 James Cash +! See http://factorcode.org/license.txt for BSD license. +USING: lisp.parser tools.test ; + +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 + +{ "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\")" +] unit-test \ No newline at end of file diff --git a/extra/lisp/parser/summary.txt b/extra/lisp/parser/summary.txt new file mode 100644 index 0000000000..aa407b3dfb --- /dev/null +++ b/extra/lisp/parser/summary.txt @@ -0,0 +1 @@ +EBNF grammar for parsing Lisp diff --git a/extra/lisp/parser/tags.txt b/extra/lisp/parser/tags.txt new file mode 100644 index 0000000000..d1f6fa1ef3 --- /dev/null +++ b/extra/lisp/parser/tags.txt @@ -0,0 +1,2 @@ +lisp +parsing From f02ca2284cf3046dd3037a42a171e7d06ac97c7b Mon Sep 17 00:00:00 2001 From: James Cash Date: Sun, 27 Apr 2008 23:12:52 -0400 Subject: [PATCH 15/22] Starting tests for lisp --- extra/lisp/lisp-tests.factor | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor index a3db32c915..6266693571 100644 --- a/extra/lisp/lisp-tests.factor +++ b/extra/lisp/lisp-tests.factor @@ -1,4 +1,5 @@ -[ [ T{ lisp-symbol f "foo" } [ 2 T{ lisp-symbol f "bar" } ] [ 3 4 T{ lisp-symbol f "baz" } ] if ] ] - [ "(if foo (bar 2) (baz 3 4))" lisp-expr parse-result-ast convert-if ] unit-test - - \ No newline at end of file +! Copyright (C) 2008 James Cash +! See http://factorcode.org/license.txt for BSD license. +USING: lisp tools.test ; + +IN: lisp.tests \ No newline at end of file From 062facb8097b5427481e701018fadc1824194a8b Mon Sep 17 00:00:00 2001 From: James Cash Date: Sun, 27 Apr 2008 23:13:42 -0400 Subject: [PATCH 16/22] Adding copyright notice to lisp.parser --- extra/lisp/parser/parser.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/extra/lisp/parser/parser.factor b/extra/lisp/parser/parser.factor index ec079265bc..7f03846044 100644 --- a/extra/lisp/parser/parser.factor +++ b/extra/lisp/parser/parser.factor @@ -1,3 +1,5 @@ +! 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 ; From ec95cef85ecaa3192eada818bed1724a21c46a0a Mon Sep 17 00:00:00 2001 From: James Cash Date: Tue, 29 Apr 2008 23:10:47 -0400 Subject: [PATCH 17/22] Adding more tests --- extra/lisp/lisp-tests.factor | 8 ++++++-- extra/lisp/parser/parser-tests.factor | 8 ++++++-- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor index 6266693571..3e3e05b2ea 100644 --- a/extra/lisp/lisp-tests.factor +++ b/extra/lisp/lisp-tests.factor @@ -1,5 +1,9 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. -USING: lisp tools.test ; +USING: lisp lisp.parser tools.test ; -IN: lisp.tests \ No newline at end of file +IN: lisp.test + +{ [ "aoeu" 2 1 T{ lisp-symbol f "foo" } ] } [ + "(foo 1 2 \"aoeu\")" lisp-string>factor +] unit-test \ No newline at end of file diff --git a/extra/lisp/parser/parser-tests.factor b/extra/lisp/parser/parser-tests.factor index 025b45e60d..9e6b54ab0c 100644 --- a/extra/lisp/parser/parser-tests.factor +++ b/extra/lisp/parser/parser-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. -USING: lisp.parser tools.test ; +USING: lisp.parser tools.test peg peg.ebnf ; IN: lisp.parser.tests @@ -12,6 +12,10 @@ IN: lisp.parser.tests "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 @@ -30,5 +34,5 @@ IN: lisp.parser.tests { T{ s-exp f V{ T{ lisp-symbol f "foo" } 1 2 "aoeu" } } } [ - "(foo 1 2 \"aoeu\")" + "(foo 1 2 \"aoeu\")" lisp-expr parse-result-ast ] unit-test \ No newline at end of file From 598bb166de83b74a91477afc22e48d0f37a4baad Mon Sep 17 00:00:00 2001 From: James Cash Date: Wed, 30 Apr 2008 16:59:50 -0400 Subject: [PATCH 18/22] Minor formatting changes --- extra/lisp/lisp.factor | 39 +++++++++++++++++++++++++++++++-------- 1 file changed, 31 insertions(+), 8 deletions(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index e254c51b7b..82eddbb2ac 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -5,21 +5,24 @@ namespaces combinators math bake locals.private accessors vectors syntax lisp.pa IN: lisp DEFER: convert-form +DEFER: funcall +! Functions to convert s-exps to quotations +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : convert-body ( s-exp -- quot ) [ convert-form ] map reverse [ ] [ compose ] reduce ; inline : convert-if ( s-exp -- quot ) - 1 tail [ convert-form ] map reverse first3 [ % , , if ] bake ; + rest [ convert-form ] map reverse first3 [ % , , if ] bake ; : convert-begin ( s-exp -- quot ) - 1 tail convert-body ; + rest convert-body ; : convert-cond ( s-exp -- quot ) - 1 tail [ [ convert-body map ] map ] [ % cond ] bake ; + rest [ [ convert-body map ] map ] [ % cond ] bake ; : convert-general-form ( s-exp -- quot ) - unclip swap convert-body [ % , ] bake ; + unclip swap convert-body [ % , funcall ] bake ; first3 -rot nip [ body>> ] bi@ reverse [ name>> ] map dup make-locals dup push-locals [ swap localize-body convert-body ] dipd pop-locals swap ; +: convert-quoted ( s-exp -- quot ) + second [ , ] bake ; + : convert-list-form ( s-exp -- quot ) - dup first dup lisp-symbol? [ name>> + 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 ; + } 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 ; \ No newline at end of file +: lisp-string>factor ( str -- quot ) + lisp-expr parse-result-ast convert-form ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: lisp-env + +H{ } clone lisp-env set + +: define-lisp-word ( name body -- ) + lisp-env get set-at ; + +: get-lisp-word ( name -- word ) + lisp-env get at ; + +: funcall ( quot sym -- * ) + name>> get-lisp-word call ; \ No newline at end of file From dcab546b97f8d7e7b2b55f9f18ae339456a59dd2 Mon Sep 17 00:00:00 2001 From: James Cash Date: Wed, 30 Apr 2008 17:00:20 -0400 Subject: [PATCH 19/22] Adding negative numbers to the parser, other minor changes --- extra/lisp/parser/parser.factor | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/extra/lisp/parser/parser.factor b/extra/lisp/parser/parser.factor index 7f03846044..83f0278129 100644 --- a/extra/lisp/parser/parser.factor +++ b/extra/lisp/parser/parser.factor @@ -18,21 +18,22 @@ RPAREN = ")" dquote = '"' squote = "'" digit = [0-9] -integer = (digit)+ => [[ string>number ]] -float = (digit)+ "." (digit)* => [[ first3 >string [ >string ] dipd 3append string>number ]] +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 ]] +letters = [a-zA-Z] => [[ 1array >string ]] initials = letters | id-specials -numbers = [0-9] => [[ 1array >string ]] +numbers = [0-9] => [[ 1array >string ]] subsequents = initials | numbers -identifier = initials (subsequents)* => [[ first2 concat append ]] -string = dquote ("\" . | !(dquote) . )* dquote => [[ second >string ]] +identifier = initials (subsequents)* => [[ first2 concat append ]] +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 ]] +list-item = _ (atom|s-expression) _ => [[ second ]] +s-expression = LPAREN (list-item)* RPAREN => [[ second ]] ;EBNF \ No newline at end of file From 3e8e976beec14b728570a08623a3bf7097ce0efc Mon Sep 17 00:00:00 2001 From: James Cash Date: Fri, 2 May 2008 03:11:10 -0400 Subject: [PATCH 20/22] Negative numbers not working now, will fix later --- extra/lisp/parser/parser.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/lisp/parser/parser.factor b/extra/lisp/parser/parser.factor index 83f0278129..65ad01aa6f 100644 --- a/extra/lisp/parser/parser.factor +++ b/extra/lisp/parser/parser.factor @@ -18,8 +18,8 @@ RPAREN = ")" dquote = '"' squote = "'" digit = [0-9] -integer = ("-")? (digit)+ => [[ string>number ]] -float = ("-")? (digit)+ "." (digit)* => [[ first3 >string [ >string ] dipd 3append string>number ]] +integer = (digit)+ => [[ string>number ]] +float = (digit)+ "." (digit)* => [[ first3 >string [ >string ] dipd 3append string>number ]] number = float | integer id-specials = "!" | "$" | "%" | "&" | "*" | "/" | ":" | "<" From 82cdbdeb0ecf47e6ab5081dc3d1bf75299d42b62 Mon Sep 17 00:00:00 2001 From: James Cash Date: Mon, 5 May 2008 12:48:58 -0400 Subject: [PATCH 21/22] Adding more unit tests for lisp --- extra/lisp/lisp-tests.factor | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/extra/lisp/lisp-tests.factor b/extra/lisp/lisp-tests.factor index 3e3e05b2ea..101af3fa5b 100644 --- a/extra/lisp/lisp-tests.factor +++ b/extra/lisp/lisp-tests.factor @@ -6,4 +6,16 @@ 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 \ No newline at end of file From 42154c96096cad1125973e08dea67bf061b90144 Mon Sep 17 00:00:00 2001 From: James Cash Date: Mon, 5 May 2008 12:49:16 -0400 Subject: [PATCH 22/22] Trying to get var-args to work --- extra/lisp/lisp.factor | 48 ++++++++++++++++++++++++++++-------------- 1 file changed, 32 insertions(+), 16 deletions(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index 82eddbb2ac..7630889570 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -1,7 +1,8 @@ ! 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.private accessors vectors syntax lisp.parser ; +namespaces combinators math bake locals locals.private accessors +vectors syntax lisp.parser assocs parser sequences.lib ; IN: lisp DEFER: convert-form @@ -10,29 +11,42 @@ DEFER: funcall ! Functions to convert s-exps to quotations ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : convert-body ( s-exp -- quot ) - [ convert-form ] map reverse [ ] [ compose ] reduce ; inline + [ 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-body ; + rest convert-form ; : convert-cond ( s-exp -- quot ) - rest [ [ convert-body map ] map ] [ % cond ] bake ; + rest [ [ convert-form map ] map ] [ % cond ] bake ; : convert-general-form ( s-exp -- quot ) - unclip swap convert-body [ % , funcall ] bake ; + unclip convert-form swap convert-body [ , % funcall ] bake ; > swap member? [ name>> make-local ] [ ] if ] - [ dup s-exp? [ body>> localize-body ] [ nip ] if ] if ] with map ; -PRIVATE> + [ dup s-exp? [ body>> localize-body ] [ nip ] if ] if + ] with map ; + +: localize-lambda ( body vars -- newbody newvars ) + dup make-locals dup push-locals [ swap localize-body 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 ) - first3 -rot nip [ body>> ] bi@ reverse [ name>> ] map dup make-locals dup push-locals - [ swap localize-body convert-body ] dipd pop-locals swap ; + split-lambda dup "&rest" swap member? [ rest-lambda-vars ] [ dup length ] if + [ localize-lambda ] dip + [ , cut [ dup length firstn ] dip dup empty? [ drop ] when , with-locals ] bake ; : convert-quoted ( s-exp -- quot ) second [ , ] bake ; @@ -56,17 +70,19 @@ PRIVATE> : lisp-string>factor ( str -- quot ) lisp-expr parse-result-ast convert-form ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -SYMBOL: lisp-env +SYMBOL: lisp-env -H{ } clone lisp-env set +: init-env ( -- ) + H{ } clone lisp-env set ; -: define-lisp-word ( name body -- ) - lisp-env get set-at ; +: lisp-define ( name quot -- ) + swap lisp-env get set-at ; -: get-lisp-word ( name -- word ) +: lisp-get ( name -- word ) lisp-env get at ; -: funcall ( quot sym -- * ) - name>> get-lisp-word call ; \ No newline at end of file +: funcall ( quot sym -- * ) + dup lisp-symbol? [ name>> lisp-get ] when call ; inline \ No newline at end of file