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

new version of make

cvs
Daniel Ehrenberg 2005-09-01 20:07:22 +00:00
parent bdbd011470
commit e6a24eb355
1 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
contrib/algebra/parse-k.factor
View File

@ -188,13 +188,13 @@ M: comp-literal compile-ast ! literal numbers
compile-ast % compile-ast %
dup % dup %
] each-with ] each-with
] make-list nip ; ] [ ] make nip ;
M: vector compile-ast ! literal vectors M: vector compile-ast ! literal vectors
dup [ number? ] all? [ dup [ number? ] all? [
replace-with nip replace-with nip
] [ ] [
[ , ] accumulator [ make-vector nip ] cons [ , ] accumulator [ { } make nip ] cons
] ifte ; ] ifte ;
: infix-relation : infix-relation
@ -314,12 +314,13 @@ M: apply compile-ast ! function application
[ 1 - ] keep [ [ 1 - ] keep [
2dup - [ swap set-array-nth ] cons , \ keep , 2dup - [ swap set-array-nth ] cons , \ keep ,
] repeat drop ] repeat drop
] make-list ; ] [ ] make ;
: ast>quot ( args ast -- quot ) : ast>quot ( args ast -- quot )
over prologue -rot compile-ast append ; over prologue -rot compile-ast append ;
: define-math ( string -- ) : define-math ( seq -- )
" " join
dup parse-full apply-args uncons car swap dup parse-full apply-args uncons car swap
>apply< >r create-in r> >apply< >r create-in r>
[ "math-args" set-word-prop ] 2keep [ "math-args" set-word-prop ] 2keep
@ -331,7 +332,7 @@ M: apply compile-ast ! function application
"in-definition" on "in-definition" on
string-mode on string-mode on
[ [
" " join string-mode off define-math string-mode off define-math
] f ; parsing ] f ; parsing
: TEST-MATH: : TEST-MATH: