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.
|
||||
! 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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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))))
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue