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

fry: improve syntax for _ and @ to throw when not used in a fry quotation.

clean-macosx-x86-64
John Benediktsson 2019-10-04 18:15:59 -07:00
parent e17b911929
commit fcfe24f98b
1 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
basis/fry/fry.factor
View File

@ -1,11 +1,16 @@
! Copyright (C) 2009 Slava Pestov, Eduardo Cavazos, Joe Groff. ! Copyright (C) 2009 Slava Pestov, Eduardo Cavazos, Joe Groff.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators kernel locals.backend math parser USING: accessors combinators kernel locals.backend math
quotations sequences sets splitting words ; namespaces parser quotations sequences sets splitting words ;
IN: fry IN: fry
: _ ( -- * ) "Only valid inside a fry" throw ; ERROR: not-in-a-fry ;
: @ ( -- * ) "Only valid inside a fry" throw ;
SYMBOL: in-fry?
SYNTAX: _ in-fry? get [ \ _ suffix! ] [ not-in-a-fry ] if ;
SYNTAX: @ in-fry? get [ \ @ suffix! ] [ not-in-a-fry ] if ;
ERROR: >r/r>-in-fry-error ; ERROR: >r/r>-in-fry-error ;
@ -17,7 +22,7 @@ GENERIC: fry ( quot -- quot' )
dup { load-local load-locals get-local drop-locals } intersect dup { load-local load-locals get-local drop-locals } intersect
[ >r/r>-in-fry-error ] unless-empty ; [ >r/r>-in-fry-error ] unless-empty ;
PREDICATE: fry-specifier < word { _ @ } member-eq? ; PREDICATE: fry-specifier < word { POSTPONE: _ POSTPONE: @ } member-eq? ;
GENERIC: count-inputs ( quot -- n ) GENERIC: count-inputs ( quot -- n )
@ -89,11 +94,11 @@ INSTANCE: fried-callable fried
[ >quotation 1quotation prefix ] if-empty ; [ >quotation 1quotation prefix ] if-empty ;
: mark-composes ( quot -- quot' ) : mark-composes ( quot -- quot' )
[ dup \ @ = [ drop [ _ @ ] ] [ 1quotation ] if ] map concat ; inline [ dup \ @ = [ drop [ POSTPONE: _ POSTPONE: @ ] ] [ 1quotation ] if ] map concat ; inline
: shallow-fry ( quot -- quot' ) : shallow-fry ( quot -- quot' )
check-fry mark-composes check-fry mark-composes
{ _ } split convert-curries { POSTPONE: _ } split convert-curries
[ [ [ ] ] [ [ ] (make-curry) but-last ] if-zero ] [ [ [ ] ] [ [ ] (make-curry) but-last ] if-zero ]
[ shallow-spread>quot swap [ [ ] (make-curry) compose ] unless-zero ] if-empty ; [ shallow-spread>quot swap [ [ ] (make-curry) compose ] unless-zero ] if-empty ;
@ -145,4 +150,4 @@ M: callable fry ( quot -- quot' )
] bi ] bi
] if-empty ; ] if-empty ;
SYNTAX: '[ parse-quotation fry append! ; SYNTAX: '[ t in-fry? [ parse-quotation ] with-variable fry append! ;