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

stack-checker.known-words: simpler infer-ndip and infer-builder.

locals-and-roots
John Benediktsson 2016-03-26 18:37:25 -07:00
parent ce2b971b3b
commit 292e95f867
1 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
basis/stack-checker/known-words/known-words.factor
View File

@ -125,13 +125,15 @@ M: declared-effect infer-call*
[ [ known>> infer-call* ] keep ] with-effect-here check-declared-effect ; [ [ known>> infer-call* ] keep ] with-effect-here check-declared-effect ;
M: input-parameter infer-call* \ call unknown-macro-input ; M: input-parameter infer-call* \ call unknown-macro-input ;
M: object infer-call* \ call bad-macro-input ; M: object infer-call* \ call bad-macro-input ;
: infer-ndip ( word n -- ) :: infer-ndip ( word n -- )
[ literals get ] 2dip literals get [
[ '[ _ def>> infer-quot-here ] ] word def>> infer-quot-here
[ '[ _ [ pop ] dip [ infer->r infer-quot-here ] [ infer-r> ] bi ] ] bi* ] [
if-empty ; pop n [ infer->r infer-quot-here ] [ infer-r> ] bi
] if-empty ;
: infer-dip ( -- ) \ dip 1 infer-ndip ; : infer-dip ( -- ) \ dip 1 infer-ndip ;
@ -145,12 +147,9 @@ M: object infer-call* \ call bad-macro-input ;
\ 3dip [ infer-3dip ] "special" set-word-prop \ 3dip [ infer-3dip ] "special" set-word-prop
: infer-builder ( quot word -- ) :: infer-builder ( quot word -- )
[ 2 consume-d dup first2 quot call make-known
[ 2 consume-d ] dip [ push-d ] [ 1array ] bi word #call, ; inline
[ dup first2 ] dip call make-known
[ push-d ] [ 1array ] bi
] dip #call, ; inline
: infer-curry ( -- ) [ <curried> ] \ curry infer-builder ; : infer-curry ( -- ) [ <curried> ] \ curry infer-builder ;