Merge git://factorcode.org/git/factor
Eduardo Cavazos
commit
5f971a0349
|
|
@ -13,3 +13,7 @@ namespaces alien.c-types kernel system combinators ;
|
|||
} cond
|
||||
|
||||
T{ ppc-backend } compiler-backend set-global
|
||||
|
||||
macosx? [
|
||||
4 "double" c-type set-c-type-align
|
||||
] when
|
||||
|
|
|
|||
|
|
@ -261,9 +261,9 @@ windows? [
|
|||
cell "ulonglong" c-type set-c-type-align
|
||||
] unless
|
||||
|
||||
macosx? [
|
||||
cell "double" c-type set-c-type-align
|
||||
] when
|
||||
windows? [
|
||||
4 "double" c-type set-c-type-align
|
||||
] unless
|
||||
|
||||
T{ x86-backend f 4 } compiler-backend set-global
|
||||
|
||||
|
|
|
|||
|
|
@ -182,9 +182,20 @@ M: tuple pprint-narrow? drop t ;
|
|||
>pprint-sequence pprint-elements
|
||||
block> r> pprint-word block>
|
||||
] check-recursion ;
|
||||
|
||||
|
||||
M: object pprint* pprint-object ;
|
||||
|
||||
M: curry pprint*
|
||||
dup curry-quot callable? [ pprint-object ] [
|
||||
"( invalid curry )" swap present-text
|
||||
] if ;
|
||||
|
||||
M: compose pprint*
|
||||
dup compose-first over compose-second [ callable? ] both?
|
||||
[ pprint-object ] [
|
||||
"( invalid compose )" swap present-text
|
||||
] if ;
|
||||
|
||||
M: wrapper pprint*
|
||||
dup wrapped word? [
|
||||
<block \ \ pprint-word wrapped pprint-word block>
|
||||
|
|
|
|||
|
|
@ -321,3 +321,7 @@ unit-test
|
|||
[ [ 2 . ] ] [
|
||||
[ 2 \ break (step-into) . ] (remove-breakpoints)
|
||||
] unit-test
|
||||
|
||||
[ ] [ 1 \ + curry unparse drop ] unit-test
|
||||
|
||||
[ ] [ 1 \ + compose unparse drop ] unit-test
|
||||
|
|
|
|||
|
|
@ -155,20 +155,21 @@ SYMBOL: load-help?
|
|||
dup first vocab-heading.
|
||||
dup second print-error
|
||||
drop ;
|
||||
! third "Traceback" swap write-object ;
|
||||
|
||||
: load-failures. ( failures -- )
|
||||
[ load-error. nl ] each ;
|
||||
|
||||
SYMBOL: blacklist
|
||||
|
||||
: require-all ( vocabs -- failures )
|
||||
[
|
||||
V{ } clone blacklist set
|
||||
[
|
||||
[
|
||||
[ require ]
|
||||
[ error-continuation get 3array , ]
|
||||
recover
|
||||
] each
|
||||
] { } make
|
||||
[ require ]
|
||||
[ >r vocab-name r> 2array blacklist get push ]
|
||||
recover
|
||||
] each
|
||||
blacklist get
|
||||
] with-compiler-errors ;
|
||||
|
||||
: do-refresh ( modified-sources modified-docs -- )
|
||||
|
|
@ -182,7 +183,7 @@ SYMBOL: load-help?
|
|||
: refresh-all ( -- ) "" refresh ;
|
||||
|
||||
GENERIC: (load-vocab) ( name -- vocab )
|
||||
|
||||
!
|
||||
M: vocab (load-vocab)
|
||||
dup vocab-root [
|
||||
dup vocab-source-loaded? [ dup load-source ] unless
|
||||
|
|
@ -195,8 +196,25 @@ M: string (load-vocab)
|
|||
M: vocab-link (load-vocab)
|
||||
vocab-name (load-vocab) ;
|
||||
|
||||
[ [ dup vocab [ ] [ ] ?if (load-vocab) ] with-compiler-errors ]
|
||||
load-vocab-hook set-global
|
||||
TUPLE: blacklisted-vocab name ;
|
||||
|
||||
: blacklisted-vocab ( name -- * )
|
||||
\ blacklisted-vocab construct-boa throw ;
|
||||
|
||||
M: blacklisted-vocab error.
|
||||
"This vocabulary depends on the " write
|
||||
blacklisted-vocab-name write
|
||||
" vocabulary which failed to load" print ;
|
||||
|
||||
[
|
||||
dup vocab-name blacklist get key? [
|
||||
vocab-name blacklisted-vocab
|
||||
] [
|
||||
[
|
||||
dup vocab [ ] [ ] ?if (load-vocab)
|
||||
] with-compiler-errors
|
||||
] if
|
||||
] load-vocab-hook set-global
|
||||
|
||||
: vocab-where ( vocab -- loc )
|
||||
vocab-source-path dup [ 1 2array ] when ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,43 @@
|
|||
USING: io.sockets io.server io kernel math threads debugger
|
||||
concurrency tools.time prettyprint ;
|
||||
IN: benchmark.sockets
|
||||
|
||||
: simple-server ( -- )
|
||||
7777 local-server "benchmark.sockets" [
|
||||
read1 CHAR: x = [
|
||||
stop-server
|
||||
] [
|
||||
20 [ read1 write1 flush ] times
|
||||
] if
|
||||
] with-server ;
|
||||
|
||||
: simple-client ( -- )
|
||||
"localhost" 7777 <inet> <client> [
|
||||
CHAR: b write1 flush
|
||||
20 [ CHAR: a dup write1 flush read1 assert= ] times
|
||||
] with-stream ;
|
||||
|
||||
: stop-server ( -- )
|
||||
"localhost" 7777 <inet> <client> [
|
||||
CHAR: x write1
|
||||
] with-stream ;
|
||||
|
||||
: socket-benchmark ( n -- )
|
||||
dup pprint " clients: " write
|
||||
[
|
||||
[ simple-server ] in-thread
|
||||
100 sleep
|
||||
[ drop simple-client ] parallel-each
|
||||
stop-server
|
||||
yield yield
|
||||
] time ;
|
||||
|
||||
: socket-benchmarks
|
||||
10 socket-benchmark
|
||||
20 socket-benchmark
|
||||
40 socket-benchmark
|
||||
80 socket-benchmark
|
||||
160 socket-benchmark
|
||||
320 socket-benchmark ;
|
||||
|
||||
MAIN: socket-benchmarks
|
||||
|
|
@ -1,5 +1,6 @@
|
|||
USING: assocs html.parser kernel math sequences strings unicode.categories
|
||||
unicode.case ;
|
||||
USING: assocs html.parser kernel math sequences strings ascii
|
||||
arrays shuffle unicode.case namespaces splitting
|
||||
http.server.responders ;
|
||||
IN: html.parser.analyzer
|
||||
|
||||
: remove-blank-text ( vector -- vector' )
|
||||
|
|
@ -65,28 +66,30 @@ IN: html.parser.analyzer
|
|||
[ tag-attributes "href" swap at ] map
|
||||
[ ] subset ;
|
||||
|
||||
: (find-all) ( n seq quot -- )
|
||||
2dup >r >r find* [
|
||||
dupd 2array , 1+ r> r> (find-all)
|
||||
] [
|
||||
r> r> 3drop
|
||||
] if* ;
|
||||
|
||||
: find-all ( seq quot -- alist )
|
||||
[ 0 -rot (find-all) ] { } make ;
|
||||
|
||||
! : find-last-tag ( name vector -- index tag )
|
||||
! [
|
||||
! dup tag-matched? [ 2drop f ] [ tag-name = ] if
|
||||
! ] with find-last ;
|
||||
: find-opening-tags-by-name ( name seq -- seq )
|
||||
[ [ tag-name = ] keep tag-closing? not and ] with find-all ;
|
||||
|
||||
! : find-last-tag* ( name n vector -- tag )
|
||||
! 0 -rot <slice> find-last-tag ;
|
||||
: href-contains? ( str tag -- ? )
|
||||
tag-attributes "href" swap at* [ subseq? ] [ 2drop f ] if ;
|
||||
|
||||
! : find-matching-tag ( tag -- tag )
|
||||
! dup tag-closing? [
|
||||
! find-last-tag
|
||||
! ] [
|
||||
! ] if ;
|
||||
: query>hash* ( str -- hash )
|
||||
"?" split1 nip query>hash ;
|
||||
|
||||
|
||||
! clear "/Users/erg/web/fark.html" file-contents parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map
|
||||
! clear "http://fark.com" http-get parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map
|
||||
|
||||
! clear "/Users/erg/web/hostels.html" file-contents parse-html "Currency" "name" pick find-first-attribute-key-value
|
||||
|
||||
! clear "/Users/erg/web/hostels.html" file-contents parse-html
|
||||
! "Currency" "name" pick find-first-attribute-key-value
|
||||
! pick find-between remove-blank-text
|
||||
! clear "http://www.sailwx.info/shiptrack/cruiseships.phtml" http-get parse-html remove-blank-text
|
||||
! "a" over find-opening-tags-by-name
|
||||
! [ nip "shipposition.phtml?call=GBTT" swap href-contains? ] assoc-subset
|
||||
! first first 8 + over nth
|
||||
! tag-attributes "href" swap at query>hash*
|
||||
! "lat" over at "lon" rot at
|
||||
|
|
|
|||
|
|
@ -26,8 +26,10 @@ LOG: accepted-connection NOTICE
|
|||
: server-loop ( server quot -- )
|
||||
[ accept-loop ] curry with-disposal ; inline
|
||||
|
||||
SYMBOL: servers
|
||||
|
||||
: spawn-server ( addrspec quot -- )
|
||||
>r <server> r> server-loop ; inline
|
||||
>r <server> dup servers get push r> server-loop ; inline
|
||||
|
||||
\ spawn-server NOTICE add-error-logging
|
||||
|
||||
|
|
@ -39,9 +41,13 @@ LOG: accepted-connection NOTICE
|
|||
|
||||
: with-server ( seq service quot -- )
|
||||
[
|
||||
V{ } clone servers set
|
||||
[ spawn-server ] curry concurrency:parallel-each
|
||||
] curry with-logging ; inline
|
||||
|
||||
: stop-server ( -- )
|
||||
servers get [ dispose ] each ;
|
||||
|
||||
: received-datagram ( addrspec -- ) drop ;
|
||||
|
||||
\ received-datagram NOTICE add-input-logging
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
Doug Coleman
|
||||
Slava Pestov
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
USING: money parser tools.test ;
|
||||
IN: temporary
|
||||
|
||||
[ -1/10 ] [ DECIMAL: -.1 ] unit-test
|
||||
[ -1/10 ] [ DECIMAL: -0.1 ] unit-test
|
||||
[ -1/10 ] [ DECIMAL: -00.10 ] unit-test
|
||||
|
||||
[ 0 ] [ DECIMAL: .0 ] unit-test
|
||||
[ 0 ] [ DECIMAL: 0.0 ] unit-test
|
||||
[ 0 ] [ DECIMAL: 0. ] unit-test
|
||||
[ 0 ] [ DECIMAL: 0 ] unit-test
|
||||
[ 1/10 ] [ DECIMAL: .1 ] unit-test
|
||||
[ 1/10 ] [ DECIMAL: 0.1 ] unit-test
|
||||
[ 1/10 ] [ DECIMAL: 00.10 ] unit-test
|
||||
|
||||
|
||||
|
||||
[ "DECIMAL: ." eval ] must-fail
|
||||
[ "DECIMAL: f" eval ] must-fail
|
||||
[ "DECIMAL: 0.f" eval ] must-fail
|
||||
[ "DECIMAL: f.0" eval ] must-fail
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
USING: io kernel math math.functions math.parser parser
|
||||
namespaces sequences splitting combinators continuations
|
||||
sequences.lib ;
|
||||
IN: money
|
||||
|
||||
: dollars/cents ( dollars -- dollars cents )
|
||||
100 * 100 /mod round ;
|
||||
|
||||
: money. ( object -- )
|
||||
dollars/cents
|
||||
[
|
||||
"$" %
|
||||
swap number>string
|
||||
<reversed> 3 group "," join <reversed> %
|
||||
"." % number>string 2 CHAR: 0 pad-left %
|
||||
] "" make print ;
|
||||
|
||||
TUPLE: not-a-decimal ;
|
||||
|
||||
: not-a-decimal ( -- * )
|
||||
T{ not-a-decimal } throw ;
|
||||
|
||||
: parse-decimal ( str -- ratio )
|
||||
"." split1
|
||||
>r dup "-" head? [ drop t "0" ] [ f swap ] if r>
|
||||
[ dup empty? [ drop "0" ] when ] 2apply
|
||||
dup length
|
||||
>r [ string>number dup [ not-a-decimal ] unless ] 2apply r>
|
||||
10 swap ^ / + swap [ neg ] when ;
|
||||
|
||||
: DECIMAL:
|
||||
scan parse-decimal parsed ; parsing
|
||||
|
|
@ -0,0 +1 @@
|
|||
Utility for calculating money with rationals
|
||||
|
|
@ -178,6 +178,10 @@ PRIVATE>
|
|||
: ?third ( seq -- third/f ) 2 swap ?nth ; inline
|
||||
: ?fourth ( seq -- fourth/f ) 3 swap ?nth ; inline
|
||||
|
||||
: ?first2 ( seq -- 1st/f 2nd/f ) dup ?first swap ?second ; inline
|
||||
: ?first3 ( seq -- 1st/f 2nd/f 3rd/f ) dup ?first2 rot ?third ; inline
|
||||
: ?first4 ( seq -- 1st/f 2nd/f 3rd/f 4th/f ) dup ?first3 roll ?fourth ; inline
|
||||
|
||||
: accumulator ( quot -- quot vec )
|
||||
V{ } clone [ [ push ] curry compose ] keep ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1 @@
|
|||
Calculate federal and state tax withholdings
|
||||
|
|
@ -0,0 +1,98 @@
|
|||
USING: kernel money taxes tools.test ;
|
||||
IN: temporary
|
||||
|
||||
[
|
||||
426 23
|
||||
] [
|
||||
12000 2008 3 f <w4> <federal> net biweekly
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
[
|
||||
426 23
|
||||
] [
|
||||
12000 2008 3 t <w4> <federal> net biweekly
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
[
|
||||
684 4
|
||||
] [
|
||||
20000 2008 3 f <w4> <federal> net biweekly
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
|
||||
|
||||
[
|
||||
804 58
|
||||
] [
|
||||
24000 2008 3 f <w4> <federal> net biweekly
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
[
|
||||
831 31
|
||||
] [
|
||||
24000 2008 3 t <w4> <federal> net biweekly
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
|
||||
[
|
||||
780 81
|
||||
] [
|
||||
24000 2008 3 f <w4> <minnesota> net biweekly
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
[
|
||||
818 76
|
||||
] [
|
||||
24000 2008 3 t <w4> <minnesota> net biweekly
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
|
||||
[
|
||||
2124 39
|
||||
] [
|
||||
78250 2008 3 f <w4> <minnesota> net biweekly
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
[
|
||||
2321 76
|
||||
] [
|
||||
78250 2008 3 t <w4> <minnesota> net biweekly
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
|
||||
[
|
||||
2612 63
|
||||
] [
|
||||
100000 2008 3 f <w4> <minnesota> net biweekly
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
[
|
||||
22244 52
|
||||
] [
|
||||
1000000 2008 3 f <w4> <minnesota> net biweekly
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
[
|
||||
578357 40
|
||||
] [
|
||||
1000000 2008 3 f <w4> <minnesota> net
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
||||
[
|
||||
588325 41
|
||||
] [
|
||||
1000000 2008 3 t <w4> <minnesota> net
|
||||
dollars/cents
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,147 @@
|
|||
USING: arrays assocs kernel math math.intervals namespaces
|
||||
sequences combinators.lib money ;
|
||||
IN: taxes
|
||||
|
||||
: monthly ( x -- y ) 12 / ;
|
||||
: semimonthly ( x -- y ) 24 / ;
|
||||
: biweekly ( x -- y ) 26 / ;
|
||||
: weekly ( x -- y ) 52 / ;
|
||||
: daily ( x -- y ) 360 / ;
|
||||
|
||||
! Each employee fills out a w4
|
||||
TUPLE: w4 year allowances married? ;
|
||||
C: <w4> w4
|
||||
|
||||
: allowance ( -- x ) 3500 ; inline
|
||||
|
||||
: calculate-w4-allowances ( w4 -- x )
|
||||
w4-allowances allowance * ;
|
||||
|
||||
! Withhold: FICA, Medicare, Federal (FICA is social security)
|
||||
: fica-tax-rate ( -- x ) DECIMAL: .062 ; inline
|
||||
|
||||
! Base rate -- income over this rate is not taxed
|
||||
TUPLE: fica-base-unknown ;
|
||||
: fica-base-rate ( year -- x )
|
||||
H{
|
||||
{ 2008 102000 }
|
||||
{ 2007 97500 }
|
||||
} at* [ T{ fica-base-unknown } throw ] unless ;
|
||||
|
||||
: fica-tax ( salary w4 -- x )
|
||||
w4-year fica-base-rate min fica-tax-rate * ;
|
||||
|
||||
! Employer tax only, not withheld
|
||||
: futa-tax-rate ( -- x ) DECIMAL: .062 ; inline
|
||||
|
||||
! No base rate for medicare; all wages subject
|
||||
: medicare-tax-rate ( -- x ) DECIMAL: .0145 ; inline
|
||||
: medicare-tax ( salary w4 -- x ) drop medicare-tax-rate * ;
|
||||
|
||||
MIXIN: collector
|
||||
GENERIC: adjust-allowances ( salary w4 collector -- newsalary )
|
||||
GENERIC: withholding ( salary w4 collector -- x )
|
||||
GENERIC: net ( salary w4 collector -- x )
|
||||
|
||||
TUPLE: tax-table single married ;
|
||||
|
||||
: <tax-table> ( single married class -- obj )
|
||||
>r tax-table construct-boa r> construct-delegate ;
|
||||
|
||||
: tax-bracket-range dup second swap first - ;
|
||||
|
||||
: tax-bracket ( tax salary triples -- tax salary )
|
||||
[ [ tax-bracket-range min ] keep third * + ] 2keep
|
||||
tax-bracket-range [-] ;
|
||||
|
||||
: tax ( salary triples -- x )
|
||||
0 -rot [ tax-bracket ] each drop ;
|
||||
|
||||
: marriage-table ( w4 tax-table -- triples )
|
||||
swap w4-married?
|
||||
[ tax-table-married ] [ tax-table-single ] if ;
|
||||
|
||||
: federal-tax ( salary w4 tax-table -- n )
|
||||
[ adjust-allowances ] 2keep marriage-table tax ;
|
||||
|
||||
! http://www.irs.gov/pub/irs-pdf/p15.pdf
|
||||
! Table 7 ANNUAL Payroll Period
|
||||
|
||||
: federal-single ( -- triples )
|
||||
{
|
||||
{ 0 2650 DECIMAL: 0 }
|
||||
{ 2650 10300 DECIMAL: .10 }
|
||||
{ 10300 33960 DECIMAL: .15 }
|
||||
{ 33960 79725 DECIMAL: .25 }
|
||||
{ 79725 166500 DECIMAL: .28 }
|
||||
{ 166500 359650 DECIMAL: .33 }
|
||||
{ 359650 1/0. DECIMAL: .35 }
|
||||
} ;
|
||||
|
||||
: federal-married ( -- triples )
|
||||
{
|
||||
{ 0 8000 DECIMAL: 0 }
|
||||
{ 8000 23550 DECIMAL: .10 }
|
||||
{ 23550 72150 DECIMAL: .15 }
|
||||
{ 72150 137850 DECIMAL: .25 }
|
||||
{ 137850 207700 DECIMAL: .28 }
|
||||
{ 207700 365100 DECIMAL: .33 }
|
||||
{ 365100 1/0. DECIMAL: .35 }
|
||||
} ;
|
||||
|
||||
TUPLE: federal ;
|
||||
INSTANCE: federal collector
|
||||
: <federal> ( -- obj )
|
||||
federal-single federal-married federal <tax-table> ;
|
||||
|
||||
M: federal adjust-allowances ( salary w4 collector -- newsalary )
|
||||
drop calculate-w4-allowances - ;
|
||||
|
||||
M: federal withholding ( salary w4 tax-table -- x )
|
||||
[ federal-tax ] 3keep drop
|
||||
[ fica-tax ] 2keep
|
||||
medicare-tax + + ;
|
||||
|
||||
M: federal net ( salary w4 collector -- x )
|
||||
>r dupd r> withholding - ;
|
||||
|
||||
|
||||
! Minnesota
|
||||
: minnesota-single ( -- triples )
|
||||
{
|
||||
{ 0 1950 DECIMAL: 0 }
|
||||
{ 1950 23750 DECIMAL: .0535 }
|
||||
{ 23750 73540 DECIMAL: .0705 }
|
||||
{ 73540 1/0. DECIMAL: .0785 }
|
||||
} ;
|
||||
|
||||
: minnesota-married ( -- triples )
|
||||
{
|
||||
{ 0 7400 DECIMAL: 0 }
|
||||
{ 7400 39260 DECIMAL: .0535 }
|
||||
{ 39260 133980 DECIMAL: .0705 }
|
||||
{ 133980 1/0. DECIMAL: .0785 }
|
||||
} ;
|
||||
|
||||
TUPLE: minnesota ;
|
||||
INSTANCE: minnesota collector
|
||||
: <minnesota> ( -- obj )
|
||||
minnesota-single minnesota-married minnesota <tax-table> ;
|
||||
|
||||
M: minnesota adjust-allowances ( salary w4 collector -- newsalary )
|
||||
drop calculate-w4-allowances - ;
|
||||
|
||||
M: minnesota withholding ( salary w4 collector -- x )
|
||||
[ adjust-allowances ] 2keep marriage-table tax ;
|
||||
|
||||
TUPLE: total ;
|
||||
INSTANCE: total collector
|
||||
|
||||
! Totals
|
||||
M: total net ( salary w4 collector -- x )
|
||||
>r dupd r>
|
||||
[ withholding ] 3keep
|
||||
drop <federal> withholding + - ;
|
||||
|
||||
M: total withholding ( salary w4 collector -- x )
|
||||
>r >r dup r> r> net - ;
|
||||
|
|
@ -1,27 +0,0 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
puts factor_eval(STDIN.read)</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>line</string>
|
||||
<key>input</key>
|
||||
<string>selection</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>^E</string>
|
||||
<key>name</key>
|
||||
<string>Eval Selection/Line</string>
|
||||
<key>output</key>
|
||||
<string>replaceSelectedText</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>8E01DDAF-959B-4237-ADB9-C133A4ACCE90</string>
|
||||
</dict>
|
||||
</plist>
|
||||
|
|
@ -1,27 +0,0 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
factor_run(STDIN.read)</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>line</string>
|
||||
<key>input</key>
|
||||
<string>selection</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>^~e</string>
|
||||
<key>name</key>
|
||||
<string>Run Selection/Line in Listener</string>
|
||||
<key>output</key>
|
||||
<string>discard</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>15A984BD-BC65-43E8-878A-267788C8DA70</string>
|
||||
</dict>
|
||||
</plist>
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
#!/bin/bash -e
|
||||
#!/usr/bin/env bash
|
||||
|
||||
# Programs returning != 0 will not cause script to exit
|
||||
set +e
|
||||
|
|
@ -11,6 +11,9 @@ OS=
|
|||
ARCH=
|
||||
WORD=
|
||||
NO_UI=
|
||||
GIT_PROTOCOL=${GIT_PROTOCOL:="git"}
|
||||
GIT_URL=${GIT_URL:=$GIT_PROTOCOL"://factorcode.org/git/factor.git"}
|
||||
|
||||
|
||||
ensure_program_installed() {
|
||||
echo -n "Checking for $1..."
|
||||
|
|
@ -51,6 +54,9 @@ check_installed_programs() {
|
|||
ensure_program_installed wget
|
||||
ensure_program_installed gcc
|
||||
ensure_program_installed make
|
||||
case $OS in
|
||||
netbsd) ensure_program_installed gmake;;
|
||||
esac
|
||||
check_gcc_version
|
||||
}
|
||||
|
||||
|
|
@ -106,6 +112,7 @@ find_os() {
|
|||
*Darwin*) OS=macosx;;
|
||||
*linux*) OS=linux;;
|
||||
*Linux*) OS=linux;;
|
||||
*NetBSD*) OS=netbsd;;
|
||||
esac
|
||||
}
|
||||
|
||||
|
|
@ -153,6 +160,8 @@ echo_build_info() {
|
|||
echo MAKE_TARGET=$MAKE_TARGET
|
||||
echo BOOT_IMAGE=$BOOT_IMAGE
|
||||
echo MAKE_IMAGE_TARGET=$MAKE_IMAGE_TARGET
|
||||
echo GIT_PROTOCOL=$GIT_PROTOCOL
|
||||
echo GIT_URL=$GIT_URL
|
||||
}
|
||||
|
||||
set_build_info() {
|
||||
|
|
@ -188,22 +197,19 @@ find_build_info() {
|
|||
echo_build_info
|
||||
}
|
||||
|
||||
invoke_git() {
|
||||
git $*
|
||||
check_ret git
|
||||
}
|
||||
|
||||
git_clone() {
|
||||
echo "Downloading the git repository from factorcode.org..."
|
||||
git clone git://factorcode.org/git/factor.git
|
||||
check_ret git
|
||||
invoke_git clone $GIT_URL
|
||||
}
|
||||
|
||||
git_pull_factorcode() {
|
||||
echo "Updating the git repository from factorcode.org..."
|
||||
git pull git://factorcode.org/git/factor.git master
|
||||
check_ret git
|
||||
}
|
||||
|
||||
http_git_pull_factorcode() {
|
||||
echo "Updating the git repository from factorcode.org..."
|
||||
git pull http://factorcode.org/git/factor.git master
|
||||
check_ret git
|
||||
invoke_git pull $GIT_URL master
|
||||
}
|
||||
|
||||
cd_factor() {
|
||||
|
|
@ -211,21 +217,28 @@ cd_factor() {
|
|||
check_ret cd
|
||||
}
|
||||
|
||||
invoke_make() {
|
||||
case $OS in
|
||||
netbsd) make='gmake';;
|
||||
*) make='make';;
|
||||
esac
|
||||
$make $*
|
||||
check_ret $make
|
||||
}
|
||||
|
||||
make_clean() {
|
||||
make clean
|
||||
check_ret make
|
||||
invoke_make clean
|
||||
}
|
||||
|
||||
make_factor() {
|
||||
make NO_UI=$NO_UI $MAKE_TARGET -j5
|
||||
check_ret make
|
||||
invoke_make NO_UI=$NO_UI $MAKE_TARGET -j5
|
||||
}
|
||||
|
||||
delete_boot_images() {
|
||||
echo "Deleting old images..."
|
||||
rm $BOOT_IMAGE > /dev/null 2>&1
|
||||
rm $BOOT_IMAGE.* > /dev/null 2>&1
|
||||
rm staging.*.image > /dev/null 2>&1
|
||||
rm staging.*.image > /dev/null 2>&1
|
||||
}
|
||||
|
||||
get_boot_image() {
|
||||
|
|
@ -257,8 +270,8 @@ maybe_download_dlls() {
|
|||
}
|
||||
|
||||
get_config_info() {
|
||||
check_installed_programs
|
||||
find_build_info
|
||||
check_installed_programs
|
||||
check_libraries
|
||||
}
|
||||
|
||||
|
|
@ -285,13 +298,6 @@ update() {
|
|||
make_factor
|
||||
}
|
||||
|
||||
http_update() {
|
||||
get_config_info
|
||||
http_git_pull_factorcode
|
||||
make_clean
|
||||
make_factor
|
||||
}
|
||||
|
||||
update_bootstrap() {
|
||||
delete_boot_images
|
||||
get_boot_image
|
||||
|
|
@ -299,7 +305,7 @@ update_bootstrap() {
|
|||
}
|
||||
|
||||
refresh_image() {
|
||||
./$FACTOR_BINARY -script -e="refresh-all save 0 USE: system exit"
|
||||
./$FACTOR_BINARY -script -e="USE: vocabs.loader refresh-all USE: memory save 0 USE: system exit"
|
||||
check_ret factor
|
||||
}
|
||||
|
||||
|
|
@ -316,6 +322,8 @@ install_libraries() {
|
|||
|
||||
usage() {
|
||||
echo "usage: $0 install|install-x11|self-update|quick-update|update|bootstrap|wget-bootstrap"
|
||||
echo "If you are behind a firewall, invoke as:"
|
||||
echo "env GIT_PROTOCOL=http $0 <command>"
|
||||
}
|
||||
|
||||
case "$1" in
|
||||
|
|
@ -324,7 +332,6 @@ case "$1" in
|
|||
self-update) update; make_boot_image; bootstrap;;
|
||||
quick-update) update; refresh_image ;;
|
||||
update) update; update_bootstrap ;;
|
||||
http-update) http_update; update_bootstrap ;;
|
||||
bootstrap) get_config_info; bootstrap ;;
|
||||
wget-bootstrap) get_config_info; delete_boot_images; get_boot_image; bootstrap ;;
|
||||
*) usage ;;
|
||||
|
|
|
|||
Loading…
Reference in New Issue