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
parent
9d19fb939a
commit
5d27f004a1
|
@ -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 ;
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
|
@ -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)))))
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue