Merge branch 'master' of git://factorcode.org/git/factor
						commit
						062f2ceb17
					
				| 
						 | 
					@ -1,7 +1,7 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
USING: kernel parser namespaces sequences quotations arrays vectors splitting
 | 
					USING: kernel parser namespaces sequences quotations arrays vectors splitting
 | 
				
			||||||
       words math
 | 
					       strings words math generalizations
 | 
				
			||||||
       macros generalizations combinators.lib combinators.conditional newfx ;
 | 
					       macros combinators.lib combinators.conditional newfx ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
IN: bake
 | 
					IN: bake
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -20,7 +20,9 @@ DEFER: [bake]
 | 
				
			||||||
: broil-element ( obj -- quot )
 | 
					: broil-element ( obj -- quot )
 | 
				
			||||||
    {
 | 
					    {
 | 
				
			||||||
      { [ comma?    ] [ drop [ >r ]          ] }
 | 
					      { [ comma?    ] [ drop [ >r ]          ] }
 | 
				
			||||||
 | 
					      { [ f =       ] [ [ >r ] prefix-on     ] }
 | 
				
			||||||
      { [ integer?  ] [ [ >r ] prefix-on     ] }
 | 
					      { [ integer?  ] [ [ >r ] prefix-on     ] }
 | 
				
			||||||
 | 
					      { [ string?   ] [ [ >r ] prefix-on     ] }
 | 
				
			||||||
      { [ sequence? ] [ [bake] [ >r ] append ] }
 | 
					      { [ sequence? ] [ [bake] [ >r ] append ] }
 | 
				
			||||||
      { [ word?     ] [ literalize [ >r ] prefix-on ] }
 | 
					      { [ word?     ] [ literalize [ >r ] prefix-on ] }
 | 
				
			||||||
      { [ drop t    ] [ [ >r ] prefix-on     ] }
 | 
					      { [ drop t    ] [ [ >r ] prefix-on     ] }
 | 
				
			||||||
| 
						 | 
					@ -92,3 +94,4 @@ MACRO: bake ( seq -- quot ) [bake] ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
:  `{ \ } [ >array     ] parse-literal \ bake parsed ; parsing
 | 
					:  `{ \ } [ >array     ] parse-literal \ bake parsed ; parsing
 | 
				
			||||||
: `V{ \ } [ >vector    ] parse-literal \ bake parsed ; parsing
 | 
					: `V{ \ } [ >vector    ] parse-literal \ bake parsed ; parsing
 | 
				
			||||||
 | 
					:  `[ \ } [ >quotation ] parse-literal \ bake parsed ; parsing
 | 
				
			||||||
| 
						 | 
					@ -13,74 +13,74 @@ IN: bake.fry.tests
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | 
					! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ [ 3 + ] ] [ 3 `[ , + ] ] unit-test
 | 
					[ [ 3 + ] ] [ 3 '[ , + ] ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ [ 1 3 + ] ] [ 1 3 `[ , , + ] ] unit-test
 | 
					[ [ 1 3 + ] ] [ 1 3 '[ , , + ] ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ [ 1 + ] ] [ 1 [ + ] `[ , @ ] ] unit-test
 | 
					[ [ 1 + ] ] [ 1 [ + ] '[ , @ ] ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ [ 1 + . ] ] [ 1 [ + ] `[ , @ . ] ] unit-test
 | 
					[ [ 1 + . ] ] [ 1 [ + ] '[ , @ . ] ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ [ + - ] ] [ [ + ] [ - ] `[ @ @ ] ] unit-test
 | 
					[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ [ "a" write "b" print ] ]
 | 
					[ [ "a" write "b" print ] ]
 | 
				
			||||||
[ "a" "b" `[ , write , print ] ] unit-test
 | 
					[ "a" "b" '[ , write , print ] ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ [ 1 2 + 3 4 - ] ]
 | 
					[ [ 1 2 + 3 4 - ] ]
 | 
				
			||||||
[ [ + ] [ - ] `[ 1 2 @ 3 4 @ ] ] unit-test
 | 
					[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ 1/2 ] [
 | 
					[ 1/2 ] [
 | 
				
			||||||
    1 `[ , _ / ] 2 swap call
 | 
					    1 '[ , _ / ] 2 swap call
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
 | 
					[ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
 | 
				
			||||||
    1 `[ , _ _ 3array ]
 | 
					    1 '[ , _ _ 3array ]
 | 
				
			||||||
    { "a" "b" "c" } { "A" "B" "C" } rot 2map
 | 
					    { "a" "b" "c" } { "A" "B" "C" } rot 2map
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
 | 
					[ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
 | 
				
			||||||
    `[ 1 _ 2array ]
 | 
					    '[ 1 _ 2array ]
 | 
				
			||||||
    { "a" "b" "c" } swap map
 | 
					    { "a" "b" "c" } swap map
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ 1 2 ] [
 | 
					[ 1 2 ] [
 | 
				
			||||||
    1 2 `[ _ , ] call
 | 
					    1 2 '[ _ , ] call
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
 | 
					[ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
 | 
				
			||||||
    1 2 `[ , _ , 3array ]
 | 
					    1 2 '[ , _ , 3array ]
 | 
				
			||||||
    { "a" "b" "c" } swap map
 | 
					    { "a" "b" "c" } swap map
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: funny-dip `[ @ _ ] call ; inline
 | 
					: funny-dip '[ @ _ ] call ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
 | 
					[ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ { 1 2 3 } ] [
 | 
					[ { 1 2 3 } ] [
 | 
				
			||||||
    3 1 `[ , [ , + ] map ] call
 | 
					    3 1 '[ , [ , + ] map ] call
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ { 1 { 2 { 3 } } } ] [
 | 
					[ { 1 { 2 { 3 } } } ] [
 | 
				
			||||||
    1 2 3 `[ , [ , [ , 1array ] call 2array ] call 2array ] call
 | 
					    1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{ 1 1 } [ `[ [ [ , ] ] ] ] must-infer-as
 | 
					{ 1 1 } [ '[ [ [ , ] ] ] ] must-infer-as
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ { { { 3 } } } ] [
 | 
					[ { { { 3 } } } ] [
 | 
				
			||||||
    3 `[ [ [ , 1array ] call 1array ] call 1array ] call
 | 
					    3 '[ [ [ , 1array ] call 1array ] call 1array ] call
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ { { { 3 } } } ] [
 | 
					[ { { { 3 } } } ] [
 | 
				
			||||||
    3 `[ [ [ , 1array ] call 1array ] call 1array ] call
 | 
					    3 '[ [ [ , 1array ] call 1array ] call 1array ] call
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! [ 10 20 30 40 `[ , V{ , { , } } , ] ] [ [ 10 V{ 20 { 30 } } 40 ] ] unit-test*
 | 
					! [ 10 20 30 40 '[ , V{ , { , } } , ] ] [ [ 10 V{ 20 { 30 } } 40 ] ] unit-test*
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ 10 20 30 40 `[ , V{ , { , } } , ] ]
 | 
					[ 10 20 30 40 '[ , V{ , { , } } , ] ]
 | 
				
			||||||
[ [ 10 20 30 >r r> 1 narray >r >r r> r> 2 narray >vector 40 ] ]
 | 
					[ [ 10 20 30 >r r> 1 narray >r >r r> r> 2 narray >vector 40 ] ]
 | 
				
			||||||
unit-test*
 | 
					unit-test*
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ { 1 2 3 } { 4 5 6 } { 7 8 9 } `[ , { V{ @ } { , } } ] call ]
 | 
					[ { 1 2 3 } { 4 5 6 } { 7 8 9 } '[ , { V{ @ } { , } } ] call ]
 | 
				
			||||||
[
 | 
					[
 | 
				
			||||||
  { 1 2 3 }
 | 
					  { 1 2 3 }
 | 
				
			||||||
  { V{ 4 5 6 } { { 7 8 9 } } }
 | 
					  { V{ 4 5 6 } { { 7 8 9 } } }
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -77,4 +77,4 @@ DEFER: shallow-fry
 | 
				
			||||||
 | 
					
 | 
				
			||||||
MACRO: fry ( seq -- quot ) [fry] ;
 | 
					MACRO: fry ( seq -- quot ) [fry] ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: `[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing
 | 
					: '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing
 | 
				
			||||||
| 
						 | 
					@ -15,11 +15,11 @@ IN: documents
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: lines-equal? ( loc1 loc2 -- ? ) [ first ] bi@ number= ;
 | 
					: lines-equal? ( loc1 loc2 -- ? ) [ first ] bi@ number= ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
TUPLE: document locs ;
 | 
					TUPLE: document < model locs ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: <document> ( -- document )
 | 
					: <document> ( -- document )
 | 
				
			||||||
    V{ "" } clone <model> V{ } clone
 | 
					    V{ "" } clone document new-model
 | 
				
			||||||
    { set-delegate set-document-locs } document construct ;
 | 
					    V{ } clone >>locs ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: add-loc ( loc document -- ) locs>> push ;
 | 
					: add-loc ( loc document -- ) locs>> push ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue