1 /* This file is part of Shapes.
3 * Shapes is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
8 * Shapes is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with Shapes. If not, see <http://www.gnu.org/licenses/>.
16 * Copyright 2008, 2009 Henrik Tidefelt
23 using namespace Shapes
;
28 Kernel::Continuation::takeHandle( Kernel::VariableHandle val
, Kernel::EvalState
* evalState
, bool callingMyself
) const
32 val
->force( val
, evalState
);
34 else if( callingMyself
)
36 throw Exceptions::InternalError( strrefdup( "Continuation is just calling itself..." ) );
40 this->takeValue( val
->getUntyped( ), evalState
, true );
45 Kernel::Continuation::takeValue( const RefCountPtr
< const Lang::Value
> & val
, Kernel::EvalState
* evalState
, bool callingMyself
) const
49 throw Exceptions::InternalError( strrefdup( "Continuation is just calling itself..." ) );
51 this->takeHandle( Kernel::VariableHandle( new Kernel::Variable( val
) ), evalState
, true );
54 const Ast::SourceLocation
&
55 Kernel::Continuation::traceLoc( ) const
61 Kernel::Continuation::backTrace( std::ostream
& os
) const
63 typedef std::list
< std::pair
< const Kernel::Continuation
*, RefCountPtr
< const char > > > ListType
;
66 const Kernel::Continuation
* tmp
= this;
69 trace
.push_front( ListType::value_type( tmp
, tmp
->description( ) ) );
70 tmp
= tmp
->up( ).getPtr( );
73 ListType::const_iterator i
= trace
.begin( );
74 ListType::const_iterator next
= i
;
76 for( ; i
!= trace
.end( ); ++i
, ++next
)
78 if( next
== trace
.end( ) ||
79 not i
->first
->traceLoc( ).contains( next
->first
->traceLoc( ) ) )
81 os
<< " " << i
->first
->traceLoc( ) << "\t" << i
->second
<< std::endl
;
91 class ForcedStructureContinuationHelper
: public Kernel::Continuation
93 const ForcedStructureContinuation
* cont_
; // This does not have proper memory management...
94 Kernel::ContRef contMem_
; // and this is not properly down-casted.
95 RefCountPtr
< const Lang::Structure
> structure_
;
96 RefCountPtr
< const Lang::SingleList
> lst_
;
98 ForcedStructureContinuationHelper( const ForcedStructureContinuation
* cont
, Kernel::ContRef contMem
, const RefCountPtr
< const Lang::Structure
> & structure
, const RefCountPtr
< const Lang::SingleList
> & lst
, const Ast::SourceLocation
& traceLoc
)
99 : Kernel::Continuation( traceLoc
), cont_( cont
), contMem_( contMem
), structure_( structure
), lst_( lst
)
101 virtual ~ForcedStructureContinuationHelper( )
103 virtual void takeValue( const RefCountPtr
< const Lang::Value
> & val
, Kernel::EvalState
* evalState
, bool dummy
) const
105 // Getting here means that some value that _we_ don't care about has been forced.
107 RefCountPtr
< const Lang::SingleList
> firstUnforced
= Kernel::ForcedStructureContinuation::findUnforced( lst_
);
108 if( firstUnforced
->isNull( ) )
110 cont_
->takeStructure( structure_
, evalState
);
114 typedef const Lang::SingleListPair ArgType
;
115 RefCountPtr
< ArgType
> p
= Helpers::down_cast
< ArgType
>( firstUnforced
, "< internal error: SingleListPair contradicting isNull( )" );
116 evalState
->cont_
= Kernel::ContRef( new Kernel::ForcedStructureContinuationHelper( cont_
, contMem_
, structure_
, p
->cdr_
, traceLoc_
) );
117 p
->car_
->force( const_cast< Kernel::VariableHandle
& >( p
->car_
), evalState
);
121 virtual Kernel::ContRef
up( ) const
125 virtual RefCountPtr
< const char > description( ) const
127 return strrefdup( "< Forcing union >" );
129 virtual void gcMark( Kernel::GCMarkedSet
& marked
)
131 const_cast< Lang::Structure
* >( structure_
.getPtr( ) )->gcMark( marked
);
132 const_cast< Lang::SingleList
* >( lst_
.getPtr( ) )->gcMark( marked
);
133 contMem_
->gcMark( marked
);
141 Kernel::ForcedStructureContinuation::ForcedStructureContinuation( const char * continuationName
, const Ast::SourceLocation
& traceLoc
)
142 : Kernel::Continuation( traceLoc
), continuationName_( continuationName
)
145 Kernel::ForcedStructureContinuation::~ForcedStructureContinuation( )
149 Kernel::ForcedStructureContinuation::takeValue( const RefCountPtr
< const Lang::Value
> & val
, Kernel::EvalState
* evalState
, bool dummy
) const
151 typedef const Lang::Structure ArgType
;
152 RefCountPtr
< ArgType
> structure
= Helpers::down_cast
< ArgType
>( val
, continuationName_
);
154 RefCountPtr
< const Lang::SingleList
> firstUnforced
= findUnforced( structure
->values_
);
155 if( firstUnforced
->isNull( ) )
157 this->takeStructure( structure
, evalState
);
161 typedef const Lang::SingleListPair ArgType
;
162 RefCountPtr
< ArgType
> p
= Helpers::down_cast
< ArgType
>( structure
->values_
, "< internal error: SingleListPair contradicting isNull( )" );
163 evalState
->cont_
= Kernel::ContRef( new Kernel::ForcedStructureContinuationHelper( this, evalState
->cont_
, structure
, p
->cdr_
, traceLoc_
) );
164 p
->car_
->force( const_cast< Kernel::VariableHandle
& >( p
->car_
), evalState
);
168 RefCountPtr
< const Lang::SingleList
>
169 Kernel::ForcedStructureContinuation::findUnforced( RefCountPtr
< const Lang::SingleList
> lst
)
175 typedef const Lang::SingleListPair ArgType
;
176 RefCountPtr
< ArgType
> p
= Helpers::try_cast_CoreArgument
< ArgType
>( lst
);
177 if( p
->car_
->isThunk( ) )
184 catch( const NonLocalExit::NotThisType
& ball
)
186 // This means we reached the end of the list.
192 Ast::Node::Node( const Ast::SourceLocation
& loc
)
193 : parent_( 0 ), analysisEnv_( 0 ), loc_( loc
)
200 Ast::Node::analyze( Ast::Node
* parent
, Ast::AnalysisEnvironment
* env
, Ast::StateIDSet
* freeStatesDst
)
202 CHECK( if( parent_
!= 0 && parent
!= parent_
)
204 throw Exceptions::InternalError( "Ast::Node::analyze: parent_ has already been set." );
207 CHECK( if( analysisEnv_
!= 0 && env
!= analysisEnv_
)
209 throw Exceptions::InternalError( "Ast::Node::analyze: analysisEnv_ has already been set." );
214 parent
->children_
.push_back( this );
215 if( parent
->loc_
.file_
!= loc_
.file_
&&
216 loc_
.file_
->hasPosition( ) )
218 loc_
.file_
->nodes( ).push_back( this );
221 this->analyze_impl( parent
, env
, freeStatesDst
);
230 Ast::Node::ChildrenType
&
231 Ast::Node::children( )
236 Ast::AnalysisEnvironment
*
243 Ast::Node::findExpressionSameFile( const Ast::SourceLocation
& loc
)
245 if( loc_
.file_
!= loc
.file_
)
249 if( ! loc_
.contains( loc
) )
253 /* If we get here, we have a match, but we should try to find the deepest match...
255 typedef typeof children_ ListType
;
256 for( ListType::iterator i
= children_
.begin( ); i
!= children_
.end( ); ++i
)
258 Ast::Expression
* tmp
= (*i
)->findExpressionSameFile( loc
);
264 /* None of our children was a match, so then this is the deepest match.
265 * If we're not an Expression, some of our parents should be the sought expression.
266 * Returning 0 in that case will be the correct thing to do!
268 return dynamic_cast< Ast::Expression
* >( this );
272 Ast::Expression::Expression( const Ast::SourceLocation
& loc
)
273 : Ast::Node( loc
), immediate_( false ), breakpoint_( 0 )
276 Ast::Expression::~Expression( )
280 const Ast::SourceLocation
&
281 Ast::Node::loc( ) const
287 Ast::BindNode::BindNode( const Ast::SourceLocation
& loc
, const Ast::SourceLocation
& idLoc
, const char * id
)
288 : Ast::Node( loc
), idLoc_( idLoc
), id_( id
)
291 Ast::BindNode::~BindNode( )
300 Ast::BindNode::id( ) const
305 const Ast::SourceLocation
&
306 Ast::BindNode::idLoc( ) const
312 Ast::Assertion::Assertion( const Ast::SourceLocation
& loc
)
313 : Ast::Expression( loc
)
318 Ast::Assertion::~Assertion( )
322 Ast::ErrorExpression::ErrorExpression( const Ast::SourceLocation
& loc
)
323 : Ast::Expression( loc
)
326 Ast::ErrorExpression::~ErrorExpression( )
330 Ast::ErrorExpression::analyze_impl( Ast::Node
* parent
, Ast::AnalysisEnvironment
* env
, Ast::StateIDSet
* freeStatesDst
)
333 That this is an error should have generated the appropriate messages elsewhere.
338 Ast::ErrorExpression::eval( Kernel::EvalState
* evalState
) const
340 throw Exceptions::InternalError( loc_
, "An ErrorExpression was evaluated" );