FUEL: refactoring to eliminate the eval-result variable

This makes the FUEL <-> Elisp ipc much simpler. All code called from
Elisp should put one result item on the stack. The fuel-pprint word
serializes it.
factor-shell
Björn Lindqvist 2018-02-07 18:38:28 +01:00
parent 9d19fb939a
commit 5d27f004a1
6 changed files with 82 additions and 77 deletions

View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays continuations debugger fuel.pprint io
USING: accessors arrays continuations debugger fry fuel.pprint io
io.streams.string kernel listener namespaces parser.notes
prettyprint.config sequences sets vocabs.parser ;
IN: fuel.eval
@ -8,9 +8,6 @@ IN: fuel.eval
SYMBOL: restarts-stack
V{ } clone restarts-stack set-global
SYMBOL: eval-result
f eval-result set-global
SYMBOL: eval-res-flag
t eval-res-flag set-global
@ -31,14 +28,14 @@ t eval-res-flag set-global
"<~FUEL~>" write nl flush ;
: begin-eval ( -- )
f eval-result set-global push-status ;
push-status ;
: end-eval ( error/f output -- )
eval-result get-global swap send-retort pop-status ;
: end-eval ( result error/f output -- )
swapd send-retort pop-status ;
: eval ( lines -- error/f )
[ parse-lines-interactive call( -- ) f ] curry
[ dup print-error ] recover ;
: eval ( lines -- result error/f )
'[ _ parse-lines-interactive call( -- x ) f ]
[ dup print-error f swap ] recover ;
: eval-usings ( usings -- )
[ [ use-vocab ] curry ignore-errors ] each ;

View File

@ -7,7 +7,6 @@ vocabs.hierarchy vocabs.loader vocabs.metadata vocabs.parser words ;
IN: fuel
! Evaluation
: fuel-eval-restartable ( -- )
t eval-res-flag set-global ; inline
@ -17,9 +16,6 @@ IN: fuel
: fuel-eval-in-context ( lines in usings -- )
eval-in-context ;
: fuel-eval-set-result ( obj -- )
clone eval-result set-global ; inline
: fuel-retort ( -- ) f f "" send-retort ; inline
! Loading files
@ -44,21 +40,30 @@ SYMBOL: :uses-suggestions
restarts get [ is-suggested-restart? ] filter
dup length 1 = [ first continue-restart ] [ drop ] if ;
SYMBOL: auto-uses
: set-use-hook ( -- )
[ manifest get auto-used>> clone :uses prefix fuel-eval-set-result ]
print-use-hook set ;
[
manifest get auto-used>> clone :uses prefix
clone auto-uses set-global
] print-use-hook set ;
PRIVATE>
: fuel-use-suggested-vocabs ( ..a suggestions quot: ( ..a -- ..b ) -- ..b )
: fuel-use-suggested-vocabs ( ..a suggestions quot: ( ..a -- ..b )
-- ..b result )
f auto-uses set-global
[ :uses-suggestions set ] dip
[ try-suggested-restarts rethrow ] recover ; inline
[ try-suggested-restarts rethrow ] recover
auto-uses get-global ; inline
: fuel-run-file ( path -- )
'[ _ set-use-hook run-file ] with-scope ; inline
: fuel-run-file ( path -- result )
f auto-uses set-global
'[ set-use-hook _ run-file ] with-scope
auto-uses get-global ; inline
: fuel-with-autouse ( ..a quot: ( ..a -- ..b ) -- ..b )
'[ _ set-use-hook call ] with-scope ; inline
'[ set-use-hook _ call ] with-scope ; inline
: fuel-get-uses ( name lines -- )
'[
@ -71,108 +76,111 @@ PRIVATE>
] fuel-with-autouse ;
! Edit locations
: fuel-get-word-location ( word -- result )
word-location ;
: fuel-get-word-location ( word -- )
word-location fuel-eval-set-result ;
: fuel-get-vocab-location ( vocab -- result )
vocab-location ;
: fuel-get-vocab-location ( vocab -- )
vocab-location fuel-eval-set-result ;
: fuel-get-doc-location ( word -- result )
doc-location ;
: fuel-get-doc-location ( word -- )
doc-location fuel-eval-set-result ;
: fuel-get-article-location ( name -- result )
article-location ;
: fuel-get-article-location ( name -- )
article-location fuel-eval-set-result ;
: fuel-get-vocabs ( -- reuslt )
all-disk-vocab-names ;
: fuel-get-vocabs ( -- )
all-disk-vocab-names fuel-eval-set-result ;
: fuel-get-vocabs/prefix ( prefix -- result )
get-vocabs/prefix ;
: fuel-get-vocabs/prefix ( prefix -- )
get-vocabs/prefix fuel-eval-set-result ;
: fuel-get-words ( prefix names -- )
get-vocabs-words/prefix fuel-eval-set-result ;
: fuel-get-words ( prefix names -- result )
get-vocabs-words/prefix ;
! Cross-references
: fuel-callers-xref ( word -- ) callers-xref fuel-eval-set-result ;
: fuel-callers-xref ( word -- result ) callers-xref ;
: fuel-callees-xref ( word -- ) callees-xref fuel-eval-set-result ;
: fuel-callees-xref ( word -- result ) callees-xref ;
: fuel-apropos-xref ( str -- ) apropos-xref fuel-eval-set-result ;
: fuel-apropos-xref ( str -- result ) apropos-xref ;
: fuel-vocab-xref ( vocab -- ) vocab-xref fuel-eval-set-result ;
: fuel-vocab-xref ( vocab -- result ) vocab-xref ;
: fuel-vocab-uses-xref ( vocab -- ) vocab-uses-xref fuel-eval-set-result ;
: fuel-vocab-uses-xref ( vocab -- result ) vocab-uses-xref ;
: fuel-vocab-usage-xref ( vocab -- ) vocab-usage-xref fuel-eval-set-result ;
: fuel-vocab-usage-xref ( vocab -- result ) vocab-usage-xref ;
! Help support
: fuel-get-article ( name -- ) fuel.help:get-article fuel-eval-set-result ;
: fuel-get-article ( name -- result )
fuel.help:get-article ;
: fuel-get-article-title ( name -- )
articles get at [ article-title ] [ f ] if* fuel-eval-set-result ;
: fuel-get-article-title ( name -- result )
articles get at [ article-title ] [ f ] if* ;
: fuel-word-help ( name -- ) word-help fuel-eval-set-result ;
: fuel-word-help ( name -- result ) word-help ;
: fuel-word-def ( name -- ) word-def fuel-eval-set-result ;
: fuel-word-def ( name -- result ) word-def ;
: fuel-vocab-help ( name -- ) fuel.help:vocab-help fuel-eval-set-result ;
: fuel-vocab-help ( name -- result ) fuel.help:vocab-help ;
: fuel-word-synopsis ( word -- ) word-synopsis fuel-eval-set-result ;
: fuel-word-synopsis ( word -- synopsis )
word-synopsis ;
: fuel-vocab-summary ( name -- )
fuel.help:vocab-summary fuel-eval-set-result ;
: fuel-vocab-summary ( name -- summary )
fuel.help:vocab-summary ;
: fuel-index ( quot -- ) call( -- seq ) format-index fuel-eval-set-result ;
: fuel-index ( quot -- result )
call( -- seq ) format-index ;
: fuel-get-vocabs/tag ( tag -- )
get-vocabs/tag fuel-eval-set-result ;
: fuel-get-vocabs/tag ( tag -- result )
get-vocabs/tag ;
: fuel-get-vocabs/author ( author -- )
get-vocabs/author fuel-eval-set-result ;
: fuel-get-vocabs/author ( author -- result )
get-vocabs/author ;
! Scaffold support
: scaffold-name ( devname -- )
[ developer-name set ] when* ;
: fuel-scaffold-vocab ( root name devname -- )
: fuel-scaffold-vocab ( root name devname -- result )
[ scaffold-name dup [ scaffold-vocab ] dip ] with-scope
dup require vocab-source-path absolute-path fuel-eval-set-result ;
dup require vocab-source-path absolute-path ;
: fuel-scaffold-help ( name devname -- )
: fuel-scaffold-help ( name devname -- result )
[ scaffold-name dup require dup scaffold-docs ] with-scope
vocab-docs-path absolute-path fuel-eval-set-result ;
vocab-docs-path absolute-path ;
: fuel-scaffold-tests ( name devname -- )
: fuel-scaffold-tests ( name devname -- result )
[ scaffold-name dup require dup scaffold-tests ] with-scope
vocab-tests-file absolute-path fuel-eval-set-result ;
vocab-tests-file absolute-path ;
: fuel-scaffold-authors ( name devname -- )
: fuel-scaffold-authors ( name devname -- result )
[ scaffold-name dup require dup scaffold-authors ] with-scope
[ vocab-authors-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ;
[ vocab-authors-path ] keep swap vocab-append-path absolute-path ;
: fuel-scaffold-tags ( name tags -- )
: fuel-scaffold-tags ( name tags -- result )
[ scaffold-tags ]
[
drop [ vocab-tags-path ] keep swap
vocab-append-path absolute-path fuel-eval-set-result
vocab-append-path absolute-path
] 2bi ;
: fuel-scaffold-summary ( name summary -- )
: fuel-scaffold-summary ( name summary -- result )
[ scaffold-summary ]
[
drop [ vocab-summary-path ] keep swap
vocab-append-path absolute-path fuel-eval-set-result
vocab-append-path absolute-path
] 2bi ;
: fuel-scaffold-platforms ( name platforms -- )
: fuel-scaffold-platforms ( name platforms -- result )
[ scaffold-platforms ]
[
drop [ vocab-platforms-path ] keep swap
vocab-append-path absolute-path fuel-eval-set-result
vocab-append-path absolute-path
] 2bi ;
: fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
: fuel-scaffold-get-root ( name -- result )
find-vocab-root ;

View File

@ -46,7 +46,6 @@
(:nrs 'fuel-eval-non-restartable)
(:in (or (factor-current-vocab) "fuel"))
(:usings `(:array ,@(factor-usings)))
(:get 'fuel-eval-set-result)
(:end '\;)
(t `(:factor ,(symbol-name sexp))))))
((symbolp sexp) (symbol-name sexp))))

View File

@ -466,7 +466,7 @@ the 'words.' word emits."
(fuel-markup--insert-newline)))
(defun fuel-markup--all-tags (e)
(let* ((cmd `(:fuel* (all-tags :get) "fuel" t))
(let* ((cmd `(:fuel* (all-tags) "fuel" t))
(tags (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(fuel-markup--list
(cons '$list (mapcar (lambda (tag) (list '$link tag tag 'tag)) tags)))))
@ -484,7 +484,7 @@ the 'words.' word emits."
(fuel-markup--insert-newline)))
(defun fuel-markup--all-authors (e)
(let* ((cmd `(:fuel* (all-authors :get) "fuel" t))
(let* ((cmd `(:fuel* (all-authors) "fuel" t))
(authors (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(fuel-markup--list
(cons '$list (mapcar (lambda (a) (list '$link a a 'author)) authors)))))

View File

@ -50,11 +50,12 @@
(fuel-mode--code-file "tests"))
(defun fuel-scaffold--vocab-roots ()
(let ((cmd '(:fuel* (vocab-roots get :get) "fuel" ("namespaces" "vocabs.loader"))))
(let ((cmd '(:fuel* (vocab-roots get)
"fuel" ("namespaces" "vocabs.loader"))))
(nth 1 (fuel-eval--send/wait cmd))))
(defun fuel-scaffold--dev-name ()
(or (let ((cmd '(:fuel* (developer-name get :get)
(or (let ((cmd '(:fuel* (developer-name get)
"fuel"
("namespaces" "tools.scaffold"))))
(fuel-eval--retort-result (fuel-eval--send/wait cmd)))

View File

@ -52,7 +52,7 @@ Set it to 0 to disable highlighting."
(defun fuel-stack--infer-effect (str)
(let ((cmd `(:fuel*
((:using stack-checker effects)
([ (:factor ,str) ] infer effect>string :get)))))
([ (:factor ,str) ] infer effect>string)))))
(fuel-eval--retort-result (fuel-eval--send/wait cmd 500))))
(defsubst fuel-stack--infer-effect/prop (str)