steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Changing lisp to reflect moving extra/lisp/conses to extra/lists

db4
James Cash 2008-06-03 03:46:29 -04:00
parent 887bc84d4b
commit 847077f770
3 changed files with 13 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
extra/lisp/lisp.factor
View File

@ -3,7 +3,7 @@
USING: kernel peg sequences arrays strings combinators.lib USING: kernel peg sequences arrays strings combinators.lib
namespaces combinators math locals locals.private accessors namespaces combinators math locals locals.private accessors
vectors syntax lisp.parser assocs parser sequences.lib words quotations vectors syntax lisp.parser assocs parser sequences.lib words quotations
fry lisp.conses ; fry lists ;
IN: lisp IN: lisp
DEFER: convert-form DEFER: convert-form
@ -11,20 +11,21 @@ DEFER: funcall
DEFER: lookup-var DEFER: lookup-var
DEFER: lisp-macro? DEFER: lisp-macro?
DEFER: lookup-macro DEFER: lookup-macro
DEFER: macro-call
! Functions to convert s-exps to quotations ! Functions to convert s-exps to quotations
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: convert-body ( cons -- quot ) : convert-body ( cons -- quot )
[ ] [ convert-form compose ] reduce ; inline [ ] [ convert-form compose ] reduce-cons ; inline
: convert-if ( cons -- quot ) : convert-if ( cons -- quot )
rest first3 [ convert-form ] tri@ '[ @ , , if ] ; cdr first3 [ convert-form ] tri@ '[ @ , , if ] ;
: convert-begin ( cons -- quot ) : convert-begin ( cons -- quot )
rest [ convert-form ] [ ] map-as '[ , [ funcall ] each ] ; cdr [ convert-form ] [ ] map-as '[ , [ funcall ] each ] ;
: convert-cond ( cons -- quot ) : convert-cond ( cons -- quot )
rest [ body>> first2 [ convert-form ] bi@ [ '[ @ funcall ] ] dip 2array ] cdr [ body>> first2 [ convert-form ] bi@ [ '[ @ funcall ] ] dip 2array ]
{ } map-as '[ , cond ] ; { } map-as '[ , cond ] ;
: convert-general-form ( cons -- quot ) : convert-general-form ( cons -- quot )
@ -34,12 +35,12 @@ DEFER: lookup-macro
<PRIVATE <PRIVATE
: localize-body ( assoc body -- assoc newbody ) : localize-body ( assoc body -- assoc newbody )
[ dup lisp-symbol? [ over dupd [ name>> ] dip at swap or ] [ dup lisp-symbol? [ over dupd [ name>> ] dip at swap or ]
[ dup cons? [ body>> localize-body <s-exp> ] when ] if [ dup cons? [ localize-body ] when ] if
] map ; ] map-cons ;
: localize-lambda ( body vars -- newbody newvars ) : localize-lambda ( body vars -- newbody newvars )
make-locals dup push-locals swap make-locals dup push-locals swap
[ swap localize-body <s-exp> convert-form swap pop-locals ] dip swap ; [ swap localize-body cons convert-form swap pop-locals ] dip swap ;
: split-lambda ( cons -- body vars ) : split-lambda ( cons -- body vars )
first3 -rot nip [ body>> ] bi@ [ name>> ] map ; inline first3 -rot nip [ body>> ] bi@ [ name>> ] map ; inline
@ -57,7 +58,7 @@ PRIVATE>
split-lambda "&rest" over member? [ rest-lambda ] [ normal-lambda ] if ; split-lambda "&rest" over member? [ rest-lambda ] [ normal-lambda ] if ;
: convert-quoted ( cons -- quot ) : convert-quoted ( cons -- quot )
cdr>> 1quotation ; cdr 1quotation ;
: form-dispatch ( lisp-symbol -- quot ) : form-dispatch ( lisp-symbol -- quot )
name>> name>>
@ -73,7 +74,7 @@ PRIVATE>
uncons lookup-macro macro-call convert-form ; uncons lookup-macro macro-call convert-form ;
: convert-list-form ( cons -- quot ) : convert-list-form ( cons -- quot )
dup car>> dup car
{ { [ dup lisp-macro? ] [ macro-expand ] } { { [ dup lisp-macro? ] [ macro-expand ] }
{ [ dup lisp-symbol? ] [ form-dispatch ] } { [ dup lisp-symbol? ] [ form-dispatch ] }
[ drop convert-general-form ] [ drop convert-general-form ]

2
extra/lisp/parser/parser-tests.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 James Cash ! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: lisp.parser tools.test peg peg.ebnf lisp.conses ; USING: lisp.parser tools.test peg peg.ebnf lists ;
IN: lisp.parser.tests IN: lisp.parser.tests

2
extra/lisp/parser/parser.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 James Cash ! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel peg peg.ebnf peg.expr math.parser sequences arrays strings USING: kernel peg peg.ebnf peg.expr math.parser sequences arrays strings
combinators.lib math fry accessors lisp.conses ; combinators.lib math fry accessors lists ;
IN: lisp.parser IN: lisp.parser