121 lines
		
	
	
		
			3.2 KiB
		
	
	
	
		
			Factor
		
	
	
		
		
			
		
	
	
			121 lines
		
	
	
		
			3.2 KiB
		
	
	
	
		
			Factor
		
	
	
| 
								 | 
							
								! Copyright (C) 2006, 2008 Slava Pestov.
							 | 
						||
| 
								 | 
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						||
| 
								 | 
							
								USING: kernel generic sequences prettyprint io words arrays
							 | 
						||
| 
								 | 
							
								summary effects debugger assocs accessors namespaces
							 | 
						||
| 
								 | 
							
								compiler.errors ;
							 | 
						||
| 
								 | 
							
								IN: stack-checker.errors
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								SYMBOL: recursive-state
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: inference-error error type rstate ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: inference-error compiler-error-type type>> ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: inference-error error-help error>> error-help ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: (inference-error) ( ... class type -- * )
							 | 
						||
| 
								 | 
							
								    >r boa r>
							 | 
						||
| 
								 | 
							
								    recursive-state get
							 | 
						||
| 
								 | 
							
								    \ inference-error boa throw ; inline
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: inference-error ( ... class -- * )
							 | 
						||
| 
								 | 
							
								    +error+ (inference-error) ; inline
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: inference-warning ( ... class -- * )
							 | 
						||
| 
								 | 
							
								    +warning+ (inference-error) ; inline
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: inference-error error.
							 | 
						||
| 
								 | 
							
								    [
							 | 
						||
| 
								 | 
							
								        rstate>> dup empty?
							 | 
						||
| 
								 | 
							
								        [ drop ] [ "Nesting:" print stack. ] if
							 | 
						||
| 
								 | 
							
								    ] [ error>> error. ] bi ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: literal-expected ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: literal-expected summary
							 | 
						||
| 
								 | 
							
								    drop "Literal value expected" ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: unbalanced-branches-error branches quots ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: unbalanced-branches-error ( branches quots -- * )
							 | 
						||
| 
								 | 
							
								    \ unbalanced-branches-error inference-error ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: unbalanced-branches-error error.
							 | 
						||
| 
								 | 
							
								    "Unbalanced branches:" print
							 | 
						||
| 
								 | 
							
								    [ quots>> ] [ branches>> [ length <effect> ] { } assoc>map ] bi zip
							 | 
						||
| 
								 | 
							
								    [ [ first pprint-short bl ] [ second effect>string print ] bi ] each ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: too-many->r ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: too-many->r summary
							 | 
						||
| 
								 | 
							
								    drop
							 | 
						||
| 
								 | 
							
								    "Quotation pushes elements on retain stack without popping them" ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: too-many-r> ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: too-many-r> summary
							 | 
						||
| 
								 | 
							
								    drop
							 | 
						||
| 
								 | 
							
								    "Quotation pops retain stack elements which it did not push" ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: cannot-infer-effect word ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: cannot-infer-effect ( word -- * )
							 | 
						||
| 
								 | 
							
								    \ cannot-infer-effect inference-warning ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: cannot-infer-effect error.
							 | 
						||
| 
								 | 
							
								    "Unable to infer stack effect of " write word>> . ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: missing-effect word ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: missing-effect error.
							 | 
						||
| 
								 | 
							
								    "The word " write
							 | 
						||
| 
								 | 
							
								    word>> pprint
							 | 
						||
| 
								 | 
							
								    " must declare a stack effect" print ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: effect-error word inferred declared ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								: effect-error ( word inferred declared -- * )
							 | 
						||
| 
								 | 
							
								    \ effect-error inference-error ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: effect-error error.
							 | 
						||
| 
								 | 
							
								    "Stack effects of the word " write
							 | 
						||
| 
								 | 
							
								    [ word>> pprint " do not match." print ]
							 | 
						||
| 
								 | 
							
								    [ "Inferred: " write inferred>> effect>string . ]
							 | 
						||
| 
								 | 
							
								    [ "Declared: " write declared>> effect>string . ] tri ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: recursive-quotation-error quot ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: recursive-quotation-error error.
							 | 
						||
| 
								 | 
							
								    "The quotation " write
							 | 
						||
| 
								 | 
							
								    quot>> pprint
							 | 
						||
| 
								 | 
							
								    " calls itself." print
							 | 
						||
| 
								 | 
							
								    "Stack effect inference is undecidable when quotation-level recursion is permitted." print ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: undeclared-recursion-error word ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: undeclared-recursion-error error.
							 | 
						||
| 
								 | 
							
								    "The inline recursive word " write
							 | 
						||
| 
								 | 
							
								    word>> pprint
							 | 
						||
| 
								 | 
							
								    " must be declared recursive" print ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: diverging-recursion-error word ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: diverging-recursion-error error.
							 | 
						||
| 
								 | 
							
								    "The recursive word " write
							 | 
						||
| 
								 | 
							
								    word>> pprint
							 | 
						||
| 
								 | 
							
								    " digs arbitrarily deep into the stack" print ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: unbalanced-recursion-error word height ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: unbalanced-recursion-error error.
							 | 
						||
| 
								 | 
							
								    "The recursive word " write
							 | 
						||
| 
								 | 
							
								    word>> pprint
							 | 
						||
| 
								 | 
							
								    " leaves with the stack having the wrong height" print ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								TUPLE: inconsistent-recursive-call-error word ;
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								M: inconsistent-recursive-call-error error.
							 | 
						||
| 
								 | 
							
								    "The recursive word " write
							 | 
						||
| 
								 | 
							
								    word>> pprint
							 | 
						||
| 
								 | 
							
								    " calls itself with a different set of quotation parameters than were input" print ;
							 |