UI deploy tool
Slava Pestov
parent
55fb33f6e1
commit
af2d0abb0e
|
|
@ -1,5 +1,5 @@
|
|||
USING: help.markup help.syntax words alien.c-types assocs
|
||||
kernel ;
|
||||
kernel math ;
|
||||
IN: tools.deploy.config
|
||||
|
||||
ARTICLE: "deploy-config" "Deployment configuration"
|
||||
|
|
@ -14,17 +14,13 @@ ARTICLE: "deploy-config" "Deployment configuration"
|
|||
ARTICLE: "deploy-flags" "Deployment flags"
|
||||
"There are two types of flags. The first set controls the major subsystems which are to be included in the deployment image:"
|
||||
{ $subsection deploy-math? }
|
||||
{ $subsection deploy-compiled? }
|
||||
{ $subsection deploy-io? }
|
||||
{ $subsection deploy-compiler? }
|
||||
{ $subsection deploy-ui? }
|
||||
"The second set of flags controls the level of stripping to be performed on the deployment image; there is a trade-off between image size, and retaining functionality which is required by the application:"
|
||||
{ $subsection strip-globals? }
|
||||
{ $subsection strip-word-props? }
|
||||
{ $subsection strip-word-names? }
|
||||
{ $subsection strip-dictionary? }
|
||||
{ $subsection strip-debugger? }
|
||||
{ $subsection strip-prettyprint? }
|
||||
{ $subsection strip-c-types? } ;
|
||||
{ $subsection deploy-io }
|
||||
{ $subsection deploy-reflection }
|
||||
{ $subsection deploy-word-props? }
|
||||
{ $subsection deploy-c-types? } ;
|
||||
|
||||
ARTICLE: "prepare-deploy" "Preparing to deploy an application"
|
||||
"In order to deploy an application as a stand-alone image, the application's vocabulary must first be given a " { $link POSTPONE: MAIN: } " hook. Then, a " { $emphasis "deployment configuration" } " must be created."
|
||||
|
|
@ -33,47 +29,22 @@ ARTICLE: "prepare-deploy" "Preparing to deploy an application"
|
|||
|
||||
ABOUT: "prepare-deploy"
|
||||
|
||||
HELP: strip-globals?
|
||||
{ $description "Deploy flag. If set, the deploy tool applies various heuristics to strip out un-needed variables from the global namespace."
|
||||
HELP: deploy-word-props?
|
||||
{ $description "Deploy flag. If set, the deploy tool retains all word properties. Otherwise, it applies various heuristics to strip out un-needed word properties from words in the dictionary."
|
||||
$nl
|
||||
"On by default. Disable this if the heuristics strip out required variables." } ;
|
||||
"Off by default. Enable this if the heuristics strip out required word properties." } ;
|
||||
|
||||
HELP: strip-word-props?
|
||||
{ $description "Deploy flag. If set, the deploy tool applies various heuristics to strip out un-needed word properties from words in the dictionary."
|
||||
HELP: deploy-c-types?
|
||||
{ $description "Deploy flag. If set, the deploy tool retains the " { $link c-types } " table."
|
||||
$nl
|
||||
"On by default. Disable this if the heuristics strip out required word properties." } ;
|
||||
|
||||
HELP: strip-word-names?
|
||||
{ $description "Deploy flag. If set, the deploy tool strips word names from words in the dictionary."
|
||||
$nl
|
||||
"On by default. Disable this if your program calls " { $link word-name } "." } ;
|
||||
|
||||
HELP: strip-dictionary?
|
||||
{ $description "Deploy flag. If set, the deploy tool strips unused words."
|
||||
$nl
|
||||
"On by default. Disable this if your program calls " { $link lookup } " to look up words by name, or needs to parse code at run-time." } ;
|
||||
|
||||
HELP: strip-debugger?
|
||||
{ $description "Deploy flag. If set, the deploy tool strips the verbose error reporting facility; any errors thrown by the program will start the low-level debugger in the VM."
|
||||
$nl
|
||||
"On by default. Disable this if you need to debug a problem which only occurs when your program is running deployed." } ;
|
||||
|
||||
HELP: strip-prettyprint?
|
||||
{ $description "Deploy flag. If set, the deploy tool strips variables used by the prettyprinter."
|
||||
$nl
|
||||
"On by default. Disable this if your program uses the prettyprinter." } ;
|
||||
|
||||
HELP: strip-c-types?
|
||||
{ $description "Deploy flag. If set, the deploy tool strips out the " { $link c-types } " table."
|
||||
$nl
|
||||
"On by default. Disable this if your program calls " { $link c-type } ", " { $link heap-size } ", " { $link <c-object> } ", " { $link <c-array> } ", " { $link malloc-object } ", or " { $link malloc-array } " with a C type name which is not a literal pushed directly at the call site. In this situation, the compiler is unable to fold away the C type lookup, and thus must use the global table at runtime." } ;
|
||||
"Off by default. Disable this if your program calls " { $link c-type } ", " { $link heap-size } ", " { $link <c-object> } ", " { $link <c-array> } ", " { $link malloc-object } ", or " { $link malloc-array } " with a C type name which is not a literal pushed directly at the call site. In this situation, the compiler is unable to fold away the C type lookup, and thus must use the global table at runtime." } ;
|
||||
|
||||
HELP: deploy-math?
|
||||
{ $description "Deploy flag. If set, the deployed image will contain the full number tower."
|
||||
{ $description "Deploy flag. If set, the deployed image will contain support for " { $link ratio } " and " { $link complex } " types."
|
||||
$nl
|
||||
"On by default. Most programs require the number tower, in particular, any program deployed with " { $link deploy-compiled? } " set." } ;
|
||||
"On by default. Often the programmer will use rationals without realizing it. A small amount of space can be saved by stripping these features out, but some code may require changes to work properly." } ;
|
||||
|
||||
HELP: deploy-compiled?
|
||||
HELP: deploy-compiler?
|
||||
{ $description "Deploy flag. If set, words in the deployed image will be compiled when possible."
|
||||
$nl
|
||||
"On by default. Most programs should be compiled, not only for performance but because features which depend on the C library interface only function after compilation." } ;
|
||||
|
|
@ -83,10 +54,11 @@ HELP: deploy-ui?
|
|||
$nl
|
||||
"Off by default. Programs wishing to use the UI must be deployed with this flag on." } ;
|
||||
|
||||
HELP: deploy-io?
|
||||
{ $description "Deploy flag. If set, support for non-blocking I/O and networking will be included in the deployed image."
|
||||
$nl
|
||||
"Off by default. Programs wishing to use non-blocking I/O or networking must be deployed with this flag on." } ;
|
||||
HELP: deploy-io
|
||||
{ $description "The level of I/O support required by the deployed image." } ;
|
||||
|
||||
HELP: deploy-reflection
|
||||
{ $description "The level of reflection support required by the deployed image." } ;
|
||||
|
||||
HELP: default-config
|
||||
{ $values { "assoc" assoc } }
|
||||
|
|
|
|||
|
|
@ -1,40 +1,58 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: vocabs.loader io.files io kernel sequences assocs
|
||||
splitting parser prettyprint ;
|
||||
splitting parser prettyprint namespaces math ;
|
||||
IN: tools.deploy.config
|
||||
|
||||
SYMBOL: strip-io?
|
||||
SYMBOL: strip-globals?
|
||||
SYMBOL: strip-word-props?
|
||||
SYMBOL: strip-word-names?
|
||||
SYMBOL: strip-dictionary?
|
||||
SYMBOL: strip-debugger?
|
||||
SYMBOL: strip-prettyprint?
|
||||
SYMBOL: strip-c-types?
|
||||
|
||||
SYMBOL: deploy-math?
|
||||
SYMBOL: deploy-compiled?
|
||||
SYMBOL: deploy-io?
|
||||
SYMBOL: deploy-ui?
|
||||
SYMBOL: deploy-compiler?
|
||||
SYMBOL: deploy-math?
|
||||
|
||||
SYMBOL: deploy-io
|
||||
|
||||
: deploy-io-options
|
||||
{
|
||||
{ 1 "Level 1 - No input/output" }
|
||||
{ 2 "Level 2 - Basic ANSI C streams" }
|
||||
{ 3 "Level 3 - Non-blocking streams and networking" }
|
||||
} ;
|
||||
|
||||
: strip-io? deploy-io get zero? ;
|
||||
|
||||
: native-io? deploy-io get 3 = ;
|
||||
|
||||
SYMBOL: deploy-reflection
|
||||
|
||||
: deploy-reflection-options
|
||||
{
|
||||
{ 1 "Level 1 - No reflection" }
|
||||
{ 2 "Level 2 - Retain word names" }
|
||||
{ 3 "Level 3 - Prettyprinter" }
|
||||
{ 4 "Level 4 - Debugger" }
|
||||
{ 5 "Level 5 - Parser" }
|
||||
{ 6 "Level 6 - Full environment" }
|
||||
} ;
|
||||
|
||||
: strip-word-names? deploy-reflection get 2 < ;
|
||||
: strip-prettyprint? deploy-reflection get 3 < ;
|
||||
: strip-debugger? deploy-reflection get 4 < ;
|
||||
: strip-dictionary? deploy-reflection get 5 < ;
|
||||
: strip-globals? deploy-reflection get 6 < ;
|
||||
|
||||
SYMBOL: deploy-word-props?
|
||||
SYMBOL: deploy-c-types?
|
||||
|
||||
SYMBOL: deploy-vm
|
||||
SYMBOL: deploy-image
|
||||
|
||||
: default-config ( -- assoc )
|
||||
V{
|
||||
{ strip-io? f }
|
||||
{ strip-prettyprint? t }
|
||||
{ strip-globals? t }
|
||||
{ strip-word-props? t }
|
||||
{ strip-word-names? t }
|
||||
{ strip-dictionary? t }
|
||||
{ strip-debugger? t }
|
||||
{ strip-c-types? t }
|
||||
{ deploy-io 2 }
|
||||
{ deploy-reflection 1 }
|
||||
{ deploy-compiler? t }
|
||||
{ deploy-math? t }
|
||||
{ deploy-compiled? t }
|
||||
{ deploy-io? f }
|
||||
{ deploy-ui? f }
|
||||
{ deploy-word-props? f }
|
||||
{ deploy-c-types? f }
|
||||
! default value for deploy.app
|
||||
{ "stop-after-last-window?" t }
|
||||
} clone ;
|
||||
|
|
|
|||
|
|
@ -30,13 +30,16 @@ IN: tools.deploy
|
|||
dup duplex-stream-out stream-close
|
||||
copy-lines ;
|
||||
|
||||
: ?append swap [ append ] [ drop ] if ;
|
||||
|
||||
: profile-string ( config -- string )
|
||||
{
|
||||
{ deploy-math? "math" }
|
||||
{ deploy-compiled? "compiler" }
|
||||
{ deploy-ui? "ui" }
|
||||
{ deploy-io? "io" }
|
||||
} swap [ nip at ] curry assoc-subset values " " join ;
|
||||
[
|
||||
""
|
||||
deploy-math? get " math" ?append
|
||||
deploy-compiler? get " compiler" ?append
|
||||
native-io? " io" ?append
|
||||
deploy-ui? get " ui" ?append
|
||||
] bind ;
|
||||
|
||||
: deploy-command-line ( vm image vocab config -- vm flags )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -16,10 +16,10 @@ IN: tools.deploy.shaker
|
|||
: strip-init-hooks ( -- )
|
||||
"Stripping startup hooks" show
|
||||
"command-line" init-hooks get delete-at
|
||||
strip-io? get [ "io.backend" init-hooks get delete-at ] when ;
|
||||
strip-io? [ "io.backend" init-hooks get delete-at ] when ;
|
||||
|
||||
: strip-debugger ( -- )
|
||||
strip-debugger? get [
|
||||
strip-debugger? [
|
||||
"Stripping debugger" show
|
||||
"resource:extra/tools/deploy/shaker/strip-debugger.factor"
|
||||
run-file
|
||||
|
|
@ -65,23 +65,13 @@ IN: tools.deploy.shaker
|
|||
|
||||
: strip-words ( props -- )
|
||||
[ word? ] instances
|
||||
strip-word-props? get [ tuck strip-word-props ] [ nip ] if
|
||||
strip-word-names? get [ dup strip-word-names ] when
|
||||
deploy-word-props? get [ nip ] [ tuck strip-word-props ] if
|
||||
strip-word-names? [ dup strip-word-names ] when
|
||||
strip-word-defs ;
|
||||
|
||||
USING: bit-arrays byte-arrays io.streams.nested ;
|
||||
|
||||
: strip-classes ( -- )
|
||||
"Stripping classes" show
|
||||
io-backend get [
|
||||
c-reader forget
|
||||
c-writer forget
|
||||
] when
|
||||
{ style-stream mirror enum } [ forget ] each ;
|
||||
|
||||
: strip-environment ( retain-globals -- )
|
||||
"Stripping environment" show
|
||||
strip-globals? get [
|
||||
strip-globals? [
|
||||
global strip-assoc 21 setenv
|
||||
] [ drop ] if ;
|
||||
|
||||
|
|
@ -103,16 +93,16 @@ SYMBOL: deploy-vocab
|
|||
\ boot ,
|
||||
init-hooks get values concat %
|
||||
,
|
||||
strip-io? get [ \ flush , ] unless
|
||||
strip-io? [ \ flush , ] unless
|
||||
] [ ] make "Boot quotation: " write dup . flush
|
||||
set-boot-quot ;
|
||||
|
||||
: retained-globals ( -- seq )
|
||||
[
|
||||
builtins ,
|
||||
strip-io? get [ io-backend , ] unless
|
||||
strip-io? [ io-backend , ] unless
|
||||
|
||||
strip-dictionary? get [
|
||||
strip-dictionary? [
|
||||
{
|
||||
builtins
|
||||
dictionary
|
||||
|
|
@ -129,14 +119,14 @@ SYMBOL: deploy-vocab
|
|||
} %
|
||||
] unless
|
||||
|
||||
strip-prettyprint? get [
|
||||
strip-prettyprint? [
|
||||
{
|
||||
tab-size
|
||||
margin
|
||||
} %
|
||||
] unless
|
||||
|
||||
strip-c-types? get not deploy-ui? get or [
|
||||
deploy-c-types? get deploy-ui? get or [
|
||||
"c-types" "alien.c-types" lookup ,
|
||||
] when
|
||||
|
||||
|
|
@ -150,18 +140,7 @@ SYMBOL: deploy-vocab
|
|||
] when
|
||||
] { } make dup . ;
|
||||
|
||||
: normalize-strip-flags
|
||||
strip-prettyprint? get [
|
||||
strip-word-names? off
|
||||
] unless
|
||||
strip-dictionary? get [
|
||||
strip-prettyprint? off
|
||||
strip-word-names? off
|
||||
strip-word-props? off
|
||||
] unless ;
|
||||
|
||||
: strip ( -- )
|
||||
normalize-strip-flags
|
||||
strip-cocoa
|
||||
strip-debugger
|
||||
strip-init-hooks
|
||||
|
|
|
|||
|
|
@ -0,0 +1,91 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: ui.gadgets colors kernel ui.render namespaces
|
||||
ui.gadgets.controls models sequences ui.gadgets.buttons
|
||||
ui.gadgets.packs ui.gadgets.labels tools.deploy.config
|
||||
namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
|
||||
ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
|
||||
tools.deploy.app vocabs ;
|
||||
IN: ui.tools.deploy
|
||||
|
||||
TUPLE: deploy-gadget vocab settings ;
|
||||
|
||||
: bundle-name ( -- )
|
||||
"bundle-name" get <field> "Bundle name:" label-on-left gadget, ;
|
||||
|
||||
: exit-when-windows-closed ( -- )
|
||||
"stop-after-last-window?" get
|
||||
"Exit when last UI window closed" <checkbox> gadget, ;
|
||||
|
||||
: io-settings ( -- )
|
||||
"Input/output support:" <label> gadget,
|
||||
deploy-io get deploy-io-options <radio-buttons> gadget, ;
|
||||
|
||||
: reflection-settings ( -- )
|
||||
"Reflection support:" <label> gadget,
|
||||
deploy-reflection get deploy-reflection-options <radio-buttons> gadget, ;
|
||||
|
||||
: advanced-settings ( -- )
|
||||
"Advanced:" <label> gadget,
|
||||
deploy-compiler? get "Use optimizing compiler" <checkbox> gadget,
|
||||
deploy-math? get "Rational and complex number support" <checkbox> gadget,
|
||||
deploy-word-props? get "Include word properties" <checkbox> gadget,
|
||||
deploy-c-types? get "Include C types" <checkbox> gadget, ;
|
||||
|
||||
: deploy-settings-theme
|
||||
{ 10 10 } over set-pack-gap
|
||||
1 swap set-pack-fill ;
|
||||
|
||||
: <deploy-settings> ( -- control )
|
||||
default-config [ <model> ] assoc-map [
|
||||
[
|
||||
bundle-name
|
||||
exit-when-windows-closed
|
||||
io-settings
|
||||
reflection-settings
|
||||
advanced-settings
|
||||
] make-pile dup deploy-settings-theme
|
||||
namespace <mapping> swap [ 2drop ] <control>
|
||||
] bind ;
|
||||
|
||||
: find-deploy-gadget
|
||||
[ deploy-gadget? ] find-parent ;
|
||||
|
||||
: find-deploy-vocab
|
||||
find-deploy-gadget deploy-gadget-vocab ;
|
||||
|
||||
: find-deploy-config
|
||||
find-deploy-vocab deploy-config ;
|
||||
|
||||
: find-deploy-settings
|
||||
find-deploy-gadget deploy-gadget-settings ;
|
||||
|
||||
: com-revert ( gadget -- )
|
||||
dup find-deploy-config
|
||||
swap find-deploy-settings set-control-value ;
|
||||
|
||||
: com-save ( gadget -- )
|
||||
dup find-deploy-settings control-value
|
||||
swap find-deploy-vocab set-deploy-config ;
|
||||
|
||||
: com-deploy ( gadget -- )
|
||||
dup com-save
|
||||
find-deploy-vocab [ deploy.app ] curry call-listener ;
|
||||
|
||||
deploy-gadget "toolbar" f {
|
||||
{ f com-revert }
|
||||
{ f com-save }
|
||||
{ T{ key-down f f "RETURN" } com-deploy }
|
||||
} define-command-map
|
||||
|
||||
: <deploy-gadget> ( vocab -- gadget )
|
||||
dup f deploy-gadget construct-boa [
|
||||
<deploy-settings>
|
||||
g-> set-deploy-gadget-settings
|
||||
10 <border> 1 track,
|
||||
toolbar,
|
||||
] { 0 1 } build-track dup com-revert ;
|
||||
|
||||
: deploy-tool ( vocab -- )
|
||||
vocab-name dup <deploy-gadget>
|
||||
"Deploying \"" rot "\"" 3append open-window ;
|
||||
|
|
@ -7,7 +7,8 @@ help.topics inference inspector io.files io.styles kernel
|
|||
namespaces parser prettyprint quotations tools.annotations
|
||||
editors tools.profiler tools.test tools.time tools.walker
|
||||
ui.commands ui.gadgets.editors ui.gestures ui.operations vocabs
|
||||
vocabs.loader words sequences tools.browser classes ;
|
||||
vocabs.loader words sequences tools.browser classes
|
||||
ui.tools.deploy ;
|
||||
IN: ui.tools.operations
|
||||
|
||||
V{ } clone operations set-global
|
||||
|
|
@ -155,6 +156,8 @@ M: word com-stack-effect word-def com-stack-effect ;
|
|||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
||||
[ vocab-spec? ] \ deploy-tool H{ } define-operation
|
||||
|
||||
! Quotations
|
||||
[ quotation? ] \ com-stack-effect H{
|
||||
{ +keyboard+ T{ key-down f { C+ } "i" } }
|
||||
|
|
|
|||
Loading…
Reference in New Issue