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

View File

@ -7,7 +7,6 @@ vocabs.hierarchy vocabs.loader vocabs.metadata vocabs.parser words ;
IN: fuel IN: fuel
! Evaluation ! Evaluation
: fuel-eval-restartable ( -- ) : fuel-eval-restartable ( -- )
t eval-res-flag set-global ; inline t eval-res-flag set-global ; inline
@ -17,9 +16,6 @@ IN: fuel
: fuel-eval-in-context ( lines in usings -- ) : fuel-eval-in-context ( lines in usings -- )
eval-in-context ; eval-in-context ;
: fuel-eval-set-result ( obj -- )
clone eval-result set-global ; inline
: fuel-retort ( -- ) f f "" send-retort ; inline : fuel-retort ( -- ) f f "" send-retort ; inline
! Loading files ! Loading files
@ -44,21 +40,30 @@ SYMBOL: :uses-suggestions
restarts get [ is-suggested-restart? ] filter restarts get [ is-suggested-restart? ] filter
dup length 1 = [ first continue-restart ] [ drop ] if ; dup length 1 = [ first continue-restart ] [ drop ] if ;
SYMBOL: auto-uses
: set-use-hook ( -- ) : 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> 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 [ :uses-suggestions set ] dip
[ try-suggested-restarts rethrow ] recover ; inline [ try-suggested-restarts rethrow ] recover
auto-uses get-global ; inline
: fuel-run-file ( path -- ) : fuel-run-file ( path -- result )
'[ _ set-use-hook run-file ] with-scope ; inline 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 ) : 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 -- ) : fuel-get-uses ( name lines -- )
'[ '[
@ -71,108 +76,111 @@ PRIVATE>
] fuel-with-autouse ; ] fuel-with-autouse ;
! Edit locations ! Edit locations
: fuel-get-word-location ( word -- result )
word-location ;
: fuel-get-word-location ( word -- ) : fuel-get-vocab-location ( vocab -- result )
word-location fuel-eval-set-result ; vocab-location ;
: fuel-get-vocab-location ( vocab -- ) : fuel-get-doc-location ( word -- result )
vocab-location fuel-eval-set-result ; doc-location ;
: fuel-get-doc-location ( word -- ) : fuel-get-article-location ( name -- result )
doc-location fuel-eval-set-result ; article-location ;
: fuel-get-article-location ( name -- ) : fuel-get-vocabs ( -- reuslt )
article-location fuel-eval-set-result ; all-disk-vocab-names ;
: fuel-get-vocabs ( -- ) : fuel-get-vocabs/prefix ( prefix -- result )
all-disk-vocab-names fuel-eval-set-result ; get-vocabs/prefix ;
: fuel-get-vocabs/prefix ( prefix -- ) : fuel-get-words ( prefix names -- result )
get-vocabs/prefix fuel-eval-set-result ; get-vocabs-words/prefix ;
: fuel-get-words ( prefix names -- )
get-vocabs-words/prefix fuel-eval-set-result ;
! Cross-references ! 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 ! 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 -- ) : fuel-get-article-title ( name -- result )
articles get at [ article-title ] [ f ] if* fuel-eval-set-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-vocab-summary ( name -- summary )
fuel.help:vocab-summary fuel-eval-set-result ; 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 -- ) : fuel-get-vocabs/tag ( tag -- result )
get-vocabs/tag fuel-eval-set-result ; get-vocabs/tag ;
: fuel-get-vocabs/author ( author -- ) : fuel-get-vocabs/author ( author -- result )
get-vocabs/author fuel-eval-set-result ; get-vocabs/author ;
! Scaffold support ! Scaffold support
: scaffold-name ( devname -- ) : scaffold-name ( devname -- )
[ developer-name set ] when* ; [ 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 [ 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 [ 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 [ 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 [ 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 ] [ scaffold-tags ]
[ [
drop [ vocab-tags-path ] keep swap drop [ vocab-tags-path ] keep swap
vocab-append-path absolute-path fuel-eval-set-result vocab-append-path absolute-path
] 2bi ; ] 2bi ;
: fuel-scaffold-summary ( name summary -- ) : fuel-scaffold-summary ( name summary -- result )
[ scaffold-summary ] [ scaffold-summary ]
[ [
drop [ vocab-summary-path ] keep swap drop [ vocab-summary-path ] keep swap
vocab-append-path absolute-path fuel-eval-set-result vocab-append-path absolute-path
] 2bi ; ] 2bi ;
: fuel-scaffold-platforms ( name platforms -- ) : fuel-scaffold-platforms ( name platforms -- result )
[ scaffold-platforms ] [ scaffold-platforms ]
[ [
drop [ vocab-platforms-path ] keep swap drop [ vocab-platforms-path ] keep swap
vocab-append-path absolute-path fuel-eval-set-result vocab-append-path absolute-path
] 2bi ; ] 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) (:nrs 'fuel-eval-non-restartable)
(:in (or (factor-current-vocab) "fuel")) (:in (or (factor-current-vocab) "fuel"))
(:usings `(:array ,@(factor-usings))) (:usings `(:array ,@(factor-usings)))
(:get 'fuel-eval-set-result)
(:end '\;) (:end '\;)
(t `(:factor ,(symbol-name sexp)))))) (t `(:factor ,(symbol-name sexp))))))
((symbolp sexp) (symbol-name sexp)))) ((symbolp sexp) (symbol-name sexp))))

View File

@ -466,7 +466,7 @@ the 'words.' word emits."
(fuel-markup--insert-newline))) (fuel-markup--insert-newline)))
(defun fuel-markup--all-tags (e) (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)))) (tags (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(fuel-markup--list (fuel-markup--list
(cons '$list (mapcar (lambda (tag) (list '$link tag tag 'tag)) tags))))) (cons '$list (mapcar (lambda (tag) (list '$link tag tag 'tag)) tags)))))
@ -484,7 +484,7 @@ the 'words.' word emits."
(fuel-markup--insert-newline))) (fuel-markup--insert-newline)))
(defun fuel-markup--all-authors (e) (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)))) (authors (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(fuel-markup--list (fuel-markup--list
(cons '$list (mapcar (lambda (a) (list '$link a a 'author)) authors))))) (cons '$list (mapcar (lambda (a) (list '$link a a 'author)) authors)))))

View File

@ -50,11 +50,12 @@
(fuel-mode--code-file "tests")) (fuel-mode--code-file "tests"))
(defun fuel-scaffold--vocab-roots () (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)))) (nth 1 (fuel-eval--send/wait cmd))))
(defun fuel-scaffold--dev-name () (defun fuel-scaffold--dev-name ()
(or (let ((cmd '(:fuel* (developer-name get :get) (or (let ((cmd '(:fuel* (developer-name get)
"fuel" "fuel"
("namespaces" "tools.scaffold")))) ("namespaces" "tools.scaffold"))))
(fuel-eval--retort-result (fuel-eval--send/wait cmd))) (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) (defun fuel-stack--infer-effect (str)
(let ((cmd `(:fuel* (let ((cmd `(:fuel*
((:using stack-checker effects) ((: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)))) (fuel-eval--retort-result (fuel-eval--send/wait cmd 500))))
(defsubst fuel-stack--infer-effect/prop (str) (defsubst fuel-stack--infer-effect/prop (str)