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 2014 Henrik Tidefelt
21 #include "shapescore.h"
23 #include "shapesexceptions.h"
25 #include "continuations.h"
29 using namespace Shapes
;
37 class Core_leiographicSort_cont_values
: public Kernel::Continuation
39 RefCountPtr
< const Lang::SingleList
> keys_
;
40 const Ast::SourceLocation
& keysLoc_
;
41 Kernel::ContRef cont_
;
43 Core_leiographicSort_cont_values( RefCountPtr
< const Lang::SingleList
> keys
, const Ast::SourceLocation
& keysLoc
, const Kernel::ContRef
& cont
, const Ast::SourceLocation
& valuesLoc
)
44 : Kernel::Continuation( valuesLoc
), keys_( keys
), keysLoc_( keysLoc
), cont_( cont
)
46 virtual ~Core_leiographicSort_cont_values( ) { }
47 virtual void takeValue( const RefCountPtr
< const Lang::Value
> & keysUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const;
48 virtual Kernel::ContRef
up( ) const
52 virtual RefCountPtr
< const char > description( ) const
54 return strrefdup( "force list of values associated with keys to be sorted" );
56 virtual void gcMark( Kernel::GCMarkedSet
& marked
)
58 const_cast< Lang::SingleList
* >( keys_
.getPtr( ) )->gcMark( marked
);
59 cont_
->gcMark( marked
);
63 class Core_leiographicSort_cont_keys
: public Kernel::Continuation
65 RefCountPtr
< const Lang::Value
> values_
;
66 const Ast::SourceLocation
& valuesLoc_
;
67 Kernel::ContRef cont_
;
69 Core_leiographicSort_cont_keys( RefCountPtr
< const Lang::Value
> values
, const Ast::SourceLocation
& valuesLoc
, const Kernel::ContRef
& cont
, const Ast::SourceLocation
& keysLoc
)
70 : Kernel::Continuation( keysLoc
), values_( values
), valuesLoc_( valuesLoc
), cont_( cont
)
72 virtual ~Core_leiographicSort_cont_keys( ) { }
73 virtual void takeValue( const RefCountPtr
< const Lang::Value
> & keysUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const;
74 virtual Kernel::ContRef
up( ) const
78 virtual RefCountPtr
< const char > description( ) const
80 return strrefdup( "force list of keys to be sorted" );
82 virtual void gcMark( Kernel::GCMarkedSet
& marked
)
84 const_cast< Lang::Value
* >( values_
.getPtr( ) )->gcMark( marked
);
85 cont_
->gcMark( marked
);
89 class Core_mergeSort_cont_sort
: public Kernel::Continuation
92 RefCountPtr
< const Lang::Function
> precedes_
;
93 const Ast::SourceLocation
& precedesLoc_
;
94 Kernel::PassedDyn dyn_
;
95 Kernel::ContRef cont_
;
97 Core_mergeSort_cont_sort( bool reversed
, RefCountPtr
< const Lang::Function
> precedes
, const Ast::SourceLocation
& precedesLoc
, const Kernel::PassedDyn
& dyn
, const Kernel::ContRef
& cont
, const Ast::SourceLocation
& callLoc
)
98 : Kernel::Continuation( callLoc
), reversed_( reversed
), precedes_( precedes
), precedesLoc_( precedesLoc
), dyn_( dyn
), cont_( cont
)
100 virtual ~Core_mergeSort_cont_sort( ) { }
101 virtual void takeValue( const RefCountPtr
< const Lang::Value
> & valuesUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const;
102 virtual Kernel::ContRef
up( ) const
106 virtual RefCountPtr
< const char > description( ) const
108 return strrefdup( "mergesort split in two, and sort first part" );
110 virtual void gcMark( Kernel::GCMarkedSet
& marked
)
112 const_cast< Lang::Function
* >( precedes_
.getPtr( ) )->gcMark( marked
);
113 dyn_
->gcMark( marked
);
114 cont_
->gcMark( marked
);
118 class Core_mergeSort_cont_sortSecond
: public Kernel::Continuation
121 RefCountPtr
< const Lang::Function
> precedes_
;
122 const Ast::SourceLocation
& precedesLoc_
;
123 RefCountPtr
< const Lang::SingleListPair
> secondUnsorted_
;
124 Kernel::PassedDyn dyn_
;
125 Kernel::ContRef cont_
;
127 Core_mergeSort_cont_sortSecond( bool reversed
, RefCountPtr
< const Lang::Function
> precedes
, const Ast::SourceLocation
& precedesLoc
, const RefCountPtr
< const Lang::SingleListPair
> & secondUnsorted
, const Kernel::PassedDyn
& dyn
, const Kernel::ContRef
& cont
, const Ast::SourceLocation
& callLoc
)
128 : Kernel::Continuation( callLoc
), reversed_( reversed
), precedes_( precedes
), precedesLoc_( precedesLoc
), secondUnsorted_( secondUnsorted
), dyn_( dyn
), cont_( cont
)
130 virtual ~Core_mergeSort_cont_sortSecond( ) { }
131 virtual void takeValue( const RefCountPtr
< const Lang::Value
> & valUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const;
132 virtual Kernel::ContRef
up( ) const
136 virtual RefCountPtr
< const char > description( ) const
138 return strrefdup( "mergesort sort second part" );
140 virtual void gcMark( Kernel::GCMarkedSet
& marked
)
142 const_cast< Lang::Function
* >( precedes_
.getPtr( ) )->gcMark( marked
);
143 const_cast< Lang::SingleListPair
* >( secondUnsorted_
.getPtr( ) )->gcMark( marked
);
144 dyn_
->gcMark( marked
);
145 cont_
->gcMark( marked
);
149 class Core_mergeSort_cont_merge
: public Kernel::Continuation
152 RefCountPtr
< const Lang::Function
> precedes_
;
153 const Ast::SourceLocation
& precedesLoc_
;
154 RefCountPtr
< const Lang::SingleListPair
> firstSorted_
;
155 Kernel::PassedDyn dyn_
;
156 Kernel::ContRef cont_
;
158 Core_mergeSort_cont_merge( bool reversed
, RefCountPtr
< const Lang::Function
> precedes
, const Ast::SourceLocation
& precedesLoc
, const RefCountPtr
< const Lang::SingleListPair
> & firstSorted
, const Kernel::PassedDyn
& dyn
, const Kernel::ContRef
& cont
, const Ast::SourceLocation
& callLoc
)
159 : Kernel::Continuation( callLoc
), reversed_( reversed
), precedes_( precedes
), precedesLoc_( precedesLoc
), firstSorted_( firstSorted
), dyn_( dyn
), cont_( cont
)
161 virtual ~Core_mergeSort_cont_merge( ) { }
162 virtual void takeValue( const RefCountPtr
< const Lang::Value
> & valUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const;
163 virtual Kernel::ContRef
up( ) const
167 virtual RefCountPtr
< const char > description( ) const
169 return strrefdup( "mergesort merge" );
171 virtual void gcMark( Kernel::GCMarkedSet
& marked
)
173 const_cast< Lang::Function
* >( precedes_
.getPtr( ) )->gcMark( marked
);
174 const_cast< Lang::SingleListPair
* >( firstSorted_
.getPtr( ) )->gcMark( marked
);
175 dyn_
->gcMark( marked
);
176 cont_
->gcMark( marked
);
180 class Core_mergeSort_cont_mergeShortcut
: public Kernel::Continuation
183 RefCountPtr
< const Lang::Function
> precedes_
;
184 const Ast::SourceLocation
& precedesLoc_
;
185 RefCountPtr
< const Lang::SingleListPair
> firstSorted_
;
186 RefCountPtr
< const Lang::SingleListPair
> secondSorted_
;
187 Kernel::PassedDyn dyn_
;
188 Kernel::ContRef cont_
;
189 const Ast::SourceLocation
& callLoc_
;
191 Core_mergeSort_cont_mergeShortcut( bool reversed
, RefCountPtr
< const Lang::Function
> precedes
, const Ast::SourceLocation
& precedesLoc
, const RefCountPtr
< const Lang::SingleListPair
> & firstSorted
, const RefCountPtr
< const Lang::SingleListPair
> & secondSorted
, const Kernel::PassedDyn
& dyn
, const Kernel::ContRef
& cont
, const Ast::SourceLocation
& callbackLoc
, const Ast::SourceLocation
& callLoc
)
192 : Kernel::Continuation( callbackLoc
), reversed_( reversed
), precedes_( precedes
), precedesLoc_( precedesLoc
), firstSorted_( firstSorted
), secondSorted_( secondSorted
), dyn_( dyn
), cont_( cont
), callLoc_( callLoc
)
194 virtual ~Core_mergeSort_cont_mergeShortcut( ) { }
195 virtual void takeValue( const RefCountPtr
< const Lang::Value
> & secondSortedUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const;
196 virtual Kernel::ContRef
up( ) const
200 virtual RefCountPtr
< const char > description( ) const
202 return strrefdup( "mergesort merge possibly shortcut" );
204 virtual void gcMark( Kernel::GCMarkedSet
& marked
)
206 const_cast< Lang::Function
* >( precedes_
.getPtr( ) )->gcMark( marked
);
207 const_cast< Lang::SingleListPair
* >( firstSorted_
.getPtr( ) )->gcMark( marked
);
208 const_cast< Lang::SingleListPair
* >( secondSorted_
.getPtr( ) )->gcMark( marked
);
209 dyn_
->gcMark( marked
);
210 cont_
->gcMark( marked
);
214 class Core_mergeSort_cont_mergeStep
: public Kernel::Continuation
218 RefCountPtr
< const Lang::Function
> precedes_
;
219 const Ast::SourceLocation
& precedesLoc_
;
220 RefCountPtr
< const Lang::SingleListPair
> first_
;
221 RefCountPtr
< const Lang::SingleListPair
> second_
;
222 RefCountPtr
< const Lang::SingleList
> reverseResult_
;
223 Kernel::VariableHandle lastInResult_
;
224 Kernel::PassedDyn dyn_
;
225 Kernel::ContRef cont_
;
226 const Ast::SourceLocation
& callLoc_
;
228 Core_mergeSort_cont_mergeStep( bool reversed
, RefCountPtr
< const Lang::Function
> precedes
, const Ast::SourceLocation
& precedesLoc
, const RefCountPtr
< const Lang::SingleListPair
> & first
, const RefCountPtr
< const Lang::SingleListPair
> & second
, bool firstAtStart
, const RefCountPtr
< const Lang::SingleList
> & reverseResult
, const Kernel::VariableHandle
& lastInResult
, const Kernel::PassedDyn
& dyn
, const Kernel::ContRef
& cont
, const Ast::SourceLocation
& callbackLoc
, const Ast::SourceLocation
& callLoc
)
229 : Kernel::Continuation( callbackLoc
), reversed_( reversed
), firstAtStart_( firstAtStart
), precedes_( precedes
), precedesLoc_( precedesLoc
), first_( first
), second_( second
), reverseResult_( reverseResult
), lastInResult_( lastInResult
), dyn_( dyn
), cont_( cont
), callLoc_( callLoc
)
231 virtual ~Core_mergeSort_cont_mergeStep( ) { }
232 virtual void takeValue( const RefCountPtr
< const Lang::Value
> & precedesResUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const;
233 virtual Kernel::ContRef
up( ) const
237 virtual RefCountPtr
< const char > description( ) const
239 return strrefdup( "mergesort merge step" );
241 virtual void gcMark( Kernel::GCMarkedSet
& marked
)
243 const_cast< Lang::Function
* >( precedes_
.getPtr( ) )->gcMark( marked
);
244 const_cast< Lang::SingleListPair
* >( first_
.getPtr( ) )->gcMark( marked
);
245 const_cast< Lang::SingleListPair
* >( second_
.getPtr( ) )->gcMark( marked
);
246 const_cast< Lang::SingleList
* >( reverseResult_
.getPtr( ) )->gcMark( marked
);
247 dyn_
->gcMark( marked
);
248 cont_
->gcMark( marked
);
250 static void callback( bool reversed
, RefCountPtr
< const Lang::Function
> precedes
, const Ast::SourceLocation
& precedesLoc
, const RefCountPtr
< const Lang::SingleListPair
> & first
, const RefCountPtr
< const Lang::SingleListPair
> & second
, bool firstAtStart
, RefCountPtr
< const Lang::SingleList
> reverseResult
, const Kernel::VariableHandle
& lastInResult
, const Kernel::PassedDyn
& dyn
, const Kernel::ContRef
& cont
, const Ast::SourceLocation
& callLoc
, Kernel::EvalState
* evalState
);
253 class Core_mergeSort_cont_finish
: public Kernel::Continuation
255 Kernel::ContRef cont_
;
257 Core_mergeSort_cont_finish( const Kernel::ContRef
& cont
, const Ast::SourceLocation
& callLoc
)
258 : Kernel::Continuation( callLoc
), cont_( cont
)
260 virtual ~Core_mergeSort_cont_finish( ) { }
261 virtual void takeValue( const RefCountPtr
< const Lang::Value
> & valuesSortedUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const;
262 virtual Kernel::ContRef
up( ) const
266 virtual RefCountPtr
< const char > description( ) const
268 return strrefdup( "mergesort finish" );
270 virtual void gcMark( Kernel::GCMarkedSet
& marked
)
272 cont_
->gcMark( marked
);
281 class Core_lexiographicSort
: public Lang::CoreFunction
284 Core_lexiographicSort( const char * title
)
285 : CoreFunction( title
, new Kernel::EvaluatedFormals( Ast::FileID::build_internal( title
), true ) )
287 formals_
->appendEvaluatedCoreFormal( "keys", Kernel::THE_SLOT_VARIABLE
);
288 formals_
->appendEvaluatedCoreFormal( "values", Kernel::THE_VOID_VARIABLE
);
292 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
294 args
.applyDefaults( callLoc
);
297 size_t keysi
= argsi
;
298 RefCountPtr
< const Lang::Value
> keys
= args
.getValue( keysi
);
301 size_t valuesi
= argsi
;
302 RefCountPtr
< const Lang::Value
> values
= args
.getValue( valuesi
);
304 Kernel::ContRef cont
= Kernel::ContRef
305 ( new Kernel::ForcingListContinuation
306 ( Kernel::ContRef( new Kernel::Core_leiographicSort_cont_keys
307 ( values
, args
.getLoc( valuesi
), evalState
->cont_
, args
.getLoc( keysi
) ) ),
308 args
.getLoc( keysi
),
309 false /* don't force structures */,
310 true /* consify */) );
311 evalState
->cont_
= cont
;
312 cont
->takeValue( keys
, evalState
);
316 static RefCountPtr
< const Lang::SingleList
> sortTyped( const RefCountPtr
< const Lang::SingleList
> & keys
, const Ast::SourceLocation
& keysLoc
, const RefCountPtr
< const Lang::SingleList
> & values
, const Ast::SourceLocation
& valuesLoc
);
317 static RefCountPtr
< const Lang::SingleList
> sort( const RefCountPtr
< const Lang::SingleList
> & keys
, const Ast::SourceLocation
& keysLoc
, const RefCountPtr
< const Lang::SingleList
> & values
, const Ast::SourceLocation
& valuesLoc
);
320 class Core_mergeSort
: public Lang::CoreFunction
323 Core_mergeSort( const char * title
)
324 : CoreFunction( title
, new Kernel::EvaluatedFormals( Ast::FileID::build_internal( title
), true ) )
326 formals_
->appendEvaluatedCoreFormal( "values", Kernel::THE_SLOT_VARIABLE
);
327 formals_
->appendEvaluatedCoreFormal( "precedes?", Kernel::THE_SLOT_VARIABLE
);
331 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
333 args
.applyDefaults( callLoc
);
336 size_t valuesi
= argsi
;
337 RefCountPtr
< const Lang::Value
> values
= args
.getValue( valuesi
);
340 size_t precedesi
= argsi
;
341 typedef const Lang::Function PredType
;
342 RefCountPtr
< PredType
> precedes
= Helpers::down_cast_CoreArgument
< PredType
>( title_
, args
, argsi
, callLoc
);
344 Kernel::ContRef finishCont
= Kernel::ContRef( new Kernel::Core_mergeSort_cont_finish( evalState
->cont_
, callLoc
) );
346 Kernel::ContRef cont
= Kernel::ContRef
347 ( new Kernel::ForcingListContinuation
348 ( Kernel::ContRef( new Kernel::Core_mergeSort_cont_sort( true, precedes
, args
.getLoc( precedesi
), evalState
->dyn_
, finishCont
, callLoc
) ),
349 args
.getLoc( valuesi
),
350 false /* don't sort structures */,
351 true /* consify */ ) );
352 evalState
->cont_
= cont
;
353 cont
->takeValue( values
, evalState
);
362 Kernel::Core_leiographicSort_cont_values::takeValue( const RefCountPtr
< const Lang::Value
> & keysUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const
364 typedef const Lang::SingleList ArgType
;
365 RefCountPtr
< ArgType
> values
= Helpers::down_cast
< ArgType
>( keysUntyped
, "< Internal error situation in Core_leiographicSort_cont_values >" );
367 RefCountPtr
< const Lang::SingleList
> res
= Lang::Core_lexiographicSort::sort( keys_
, keysLoc_
, values
, traceLoc_
);
368 evalState
->cont_
= cont_
;
369 cont_
->takeValue( res
, evalState
);
373 Kernel::Core_leiographicSort_cont_keys::takeValue( const RefCountPtr
< const Lang::Value
> & keysUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const
375 typedef const Lang::SingleList ArgType
;
376 RefCountPtr
< ArgType
> keys
= Helpers::down_cast
< ArgType
>( keysUntyped
, "< Internal error situation in Core_leiographicSort_cont_keys >" );
378 if( values_
== Lang::THE_VOID
){
380 RefCountPtr
< const Lang::SingleList
> res
= Lang::Core_lexiographicSort::sort( keys
, traceLoc_
, keys
, traceLoc_
);
381 evalState
->cont_
= cont_
;
382 cont_
->takeValue( res
, evalState
);
387 Kernel::ContRef cont
= Kernel::ContRef
388 ( new Kernel::ForcingListContinuation
389 ( Kernel::ContRef( new Kernel::Core_leiographicSort_cont_values( keys
, traceLoc_
, cont_
, valuesLoc_
) ),
391 false /* don't force structures */,
392 true /* consify */ ) );
393 evalState
->cont_
= cont
;
394 cont
->takeValue( values_
, evalState
);
405 struct ElementarySortItem
407 std::vector
< T
> key_
;
408 RefCountPtr
< const Lang::Value
> val_
;
410 ElementarySortItem( const RefCountPtr
< const Lang::Value
> & val
, size_t keySize
)
413 key_
.reserve( keySize
);
418 class ElementarySortItemLess
421 bool operator () ( const ElementarySortItem
< T
> * x
, const ElementarySortItem
< T
> * y
) const
423 typedef typeof x
->key_ VecType
;
424 typename
VecType::const_iterator i
= x
->key_
.begin( );
425 typename
VecType::const_iterator xEnd
= x
->key_
.end( );
426 typename
VecType::const_iterator j
= y
->key_
.begin( );
427 typename
VecType::const_iterator yEnd
= y
->key_
.end( );
428 for( ; i
!= xEnd
&& j
!= yEnd
; ++i
, ++j
){
439 RefCountPtr
< const Lang::SingleList
>
440 Lang::Core_lexiographicSort::sortTyped( const RefCountPtr
< const Lang::SingleList
> & keys
, const Ast::SourceLocation
& keysLoc
, const RefCountPtr
< const Lang::SingleList
> & values
, const Ast::SourceLocation
& valuesLoc
)
442 typedef T KeySymbolType
;
443 typedef ElementarySortItem
< typename
KeySymbolType::ValueType
> SortItem
;
445 /* Initialize items to be sorted.
447 PtrOwner_back_Access
< std::list
< ElementarySortItem
< typename
KeySymbolType::ValueType
> * > > itemsMem
;
449 RefCountPtr
< const Lang::SingleListPair
> k
= keys
.down_cast
< const Lang::SingleListPair
>( );
450 RefCountPtr
< const Lang::SingleListPair
> v
= values
.down_cast
< const Lang::SingleListPair
>( );
451 while( k
!= NullPtr
< const Lang::SingleListPair
>( ) ){
452 if( v
== NullPtr
< const Lang::SingleListPair
>( ) ){
453 throw Exceptions::MiscellaneousRequirement( valuesLoc
, "Values cannot be associated with keys since the number of elements differ." );
455 RefCountPtr
< const Lang::VectorFunction
> kvec
= k
->car_
->getVal
< const Lang::VectorFunction
>( "Element in list of keys to be sorted." );
456 RefCountPtr
< const Lang::VectorFunction::vector_type
> kmem
= kvec
->mem( );
457 SortItem
* item
= new SortItem( v
->car_
->getUntyped( ), kmem
->size( ) );
458 itemsMem
.push_back( item
);
459 typedef typeof *kmem VecType
;
460 for( typename
VecType::const_iterator i
= kmem
->begin( ); i
!= kmem
->end( ); ++i
){
461 const KeySymbolType
* sym
= dynamic_cast< const KeySymbolType
* >( i
->getPtr( ) );
463 throw Exceptions::TypeMismatch( keysLoc
, "(element of key to be sorted, expected all to be of same type)", (*i
)->getTypeName( ), KeySymbolType::staticTypeName( ) );
465 item
->key_
.push_back( sym
->val_
);
467 k
= k
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
468 v
= v
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
470 if( v
!= NullPtr
< const Lang::SingleListPair
>( ) ){
471 throw Exceptions::MiscellaneousRequirement( valuesLoc
, "Values cannot be associated with keys since the number of elements differ." );
474 /* Place items in vector and sort.
476 std::vector
< SortItem
* > items
;
477 items
.reserve( itemsMem
.size( ) );
479 typedef typeof itemsMem ListType
;
480 for( typename
ListType::const_iterator i
= itemsMem
.begin( ); i
!= itemsMem
.end( ); ++i
){
481 items
.push_back( *i
);
484 std::stable_sort( items
.begin( ), items
.end( ), ElementarySortItemLess
< typename
KeySymbolType::ValueType
>( ) );
488 RefCountPtr
< const Lang::SingleList
> result
= Lang::THE_CONS_NULL
;
490 typedef typeof items VecType
;
491 for( typename
VecType::const_reverse_iterator i
= items
.rbegin( ); i
!= items
.rend( ); ++i
){
492 result
= Helpers::SingleList_cons( (*i
)->val_
, result
);
503 RefCountPtr
< const Lang::SingleList
>
504 Lang::Core_lexiographicSort::sort( const RefCountPtr
< const Lang::SingleList
> & keys
, const Ast::SourceLocation
& keysLoc
, const RefCountPtr
< const Lang::SingleList
> & values
, const Ast::SourceLocation
& valuesLoc
)
506 /* Currently, all keys must be of type Lang::VectorFunction, and we just need to find one
507 * non-empty key in order to find the vector element type.
509 RefCountPtr
< const Lang::Value
> firstSymbol
= RefCountPtr
< const Lang::Value
>( NullPtr
< const Lang::Value
>( ) );
513 RefCountPtr
< const Lang::SingleListPair
> k
= keys
.down_cast
< const Lang::SingleListPair
>( );
514 while( k
!= NullPtr
< const Lang::SingleListPair
>( ) ){
516 RefCountPtr
< const Lang::VectorFunction
> kvec
= k
->car_
->getVal
< const Lang::VectorFunction
>( "Element in list of keys to be sorted." );
517 RefCountPtr
< const Lang::VectorFunction::vector_type
> kmem
= kvec
->mem( );
518 if( kmem
->empty( ) ){
519 k
= k
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
522 firstSymbol
= kmem
->front( );
526 if( k
== NullPtr
< const Lang::SingleListPair
>( ) ){
527 /* All keys were empty, hence already in order. We just need to check that the number of values match the number of keys. */
528 RefCountPtr
< const Lang::SingleListPair
> v
= values
.down_cast
< const Lang::SingleListPair
>( );
529 while( v
!= NullPtr
< const Lang::SingleListPair
>( ) ){
531 throw Exceptions::MiscellaneousRequirement( valuesLoc
, "Values cannot be associated with keys since the number of elements differ." );
534 v
= v
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
537 throw Exceptions::MiscellaneousRequirement( valuesLoc
, "Values cannot be associated with keys since the number of elements differ." );
543 /* Dispatch based on the type of vector elements. */
545 typedef Lang::Integer KeySymbolType
;
546 if( dynamic_cast< const KeySymbolType
* >( firstSymbol
.getPtr( ) ) != NULL
)
547 return sortTyped
< KeySymbolType
>( keys
, keysLoc
, values
, valuesLoc
);
550 typedef Lang::Float KeySymbolType
;
551 if( dynamic_cast< const KeySymbolType
* >( firstSymbol
.getPtr( ) ) != NULL
)
552 return sortTyped
< KeySymbolType
>( keys
, keysLoc
, values
, valuesLoc
);
555 throw Exceptions::TypeMismatch( keysLoc
, "(element of key to be sorted)", firstSymbol
->getTypeName( ), Helpers::typeSetString( Lang::Integer::staticTypeName( ), Lang::Float::staticTypeName( ) ) );
560 Kernel::Core_mergeSort_cont_sort::takeValue( const RefCountPtr
< const Lang::Value
> & valuesUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const
562 typedef const Lang::SingleList ArgType
;
563 RefCountPtr
< ArgType
> valuesMaybeNil
= Helpers::down_cast
< ArgType
>( valuesUntyped
, "< Internal error situation in Core_mergeSort_cont_sort >" );
565 RefCountPtr
< const Lang::SingleListPair
> values
= valuesMaybeNil
.down_cast
< const Lang::SingleListPair
>( );
566 if( values
== NullPtr
< const Lang::SingleListPair
>( ) ){
567 /* Special case of empty input, never happens during recursion.
569 evalState
->cont_
= cont_
;
570 /* The Kernel::THE_VOID_VARIABLE is just a dummy below. It will just be discared by the receiving continuation. */
571 cont_
->takeValue( RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( Kernel::THE_VOID_VARIABLE
, Lang::THE_CONS_NULL
) ),
576 /* Split in half, with each part reversed. */
577 RefCountPtr
< const Lang::SingleListPair
> p
= values
.down_cast
< const Lang::SingleListPair
>( );
578 RefCountPtr
< const Lang::SingleListPair
> q
= p
;
579 std::stack
< Kernel::VariableHandle
> leftReversed
;
580 while( q
!= NullPtr
< const Lang::SingleListPair
>( ) ){
581 leftReversed
.push( p
->car_
);
582 p
= p
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
583 q
= q
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
584 if( q
== NullPtr
< const Lang::SingleListPair
>( ) )
586 q
= q
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
588 if( p
== NullPtr
< const Lang::SingleListPair
>( ) ){
589 /* There was just a single element.
590 * First and only element is at the same time the last element of the sorted sequence.
592 evalState
->cont_
= cont_
;
593 cont_
->takeValue( RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( values
->car_
, values
) ),
598 /* There's at least one element in each part.
600 RefCountPtr
< const Lang::SingleListPair
> left
=
601 RefCountPtr
< const Lang::SingleListPair
>( new Lang::SingleListPair( leftReversed
.top( ), Lang::THE_CONS_NULL
) );
603 while( ! leftReversed
.empty( ) ){
604 left
= RefCountPtr
< const Lang::SingleListPair
>( new Lang::SingleListPair( leftReversed
.top( ), left
) );
607 RefCountPtr
< const Lang::SingleListPair
> right
= p
.down_cast
< const Lang::SingleListPair
>( );
609 /* Now is the time to decide in which order to sort the left and right parts. The goal is to be able to
610 * shortcut the merge if values are sorted from the beginning.
611 * The part sorted first will have only one end value available, while the part sorted second, just before
612 * the merge begins, will have both first and last values available. The order will depend on whether the merge
613 * proceeds with values in increasing order or decreasing order.
615 * Decreasing order (reversed_):
616 * Consider the input { 1 2 3 4 5 6 }. It will be split and after sorting we will have the left part sorted as ( 3 ; 2 ; 1 )
617 * and the right part sorted as ( 6 ; 5 ; 4 ). The values that need to be compared are 3 and 4 (4 < 3 would mean that the merge
618 * cannot be shortcut). Since 4 is at the and of the sorted right part, this must be the second part to be sorted.
619 * First: left, ( 3 ; 2 ; 1 ). Second: right, ( 6 ; 5 ; 4 ).
621 * Increasing order (not reversed_):
622 * Consider the input { 1 2 3 4 5 6 }. It will be split and after sorting we will have the left part sorted as ( 1 ; 2 ; 3 )
623 * and the right part sorted as ( 4 ; 5 ; 6 ). The values that need to be compared are 3 and 4 (4 < 3 would mean that the merge
624 * cannot be shortcut). Since 3 is at the and of the sorted left part, this must be the second part to be sorted.
625 * First: right, ( 4 ; 5 ; 6 ). Second: left, ( 1 ; 2 ; 3 ).
628 RefCountPtr
< const Lang::SingleListPair
> tmp
= right
;
633 /* Initiate sorting of first part.
635 Kernel::ContRef cont
= Kernel::ContRef
636 ( new Kernel::Core_mergeSort_cont_sort
637 ( ! reversed_
, precedes_
, precedesLoc_
, dyn_
,
638 Kernel::ContRef( new Kernel::Core_mergeSort_cont_sortSecond( reversed_
, precedes_
, precedesLoc_
, left
, dyn_
, cont_
, traceLoc_
) ),
640 evalState
->cont_
= cont
;
641 cont
->takeValue( right
, evalState
);
645 Kernel::Core_mergeSort_cont_sortSecond::takeValue( const RefCountPtr
< const Lang::Value
> & valUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const
647 /* The value received by this continuation shall be a SingleListPair where
648 * cdr_ is the sorted first part, reversed
649 * car_ is the last element in the cdr_ sequence
651 typedef const Lang::SingleListPair ArgType
;
652 RefCountPtr
< ArgType
> val
= Helpers::down_cast
< ArgType
>( valUntyped
, "< Internal error situation in Core_mergeSort_cont_sortSecond::takeValue >" );
654 RefCountPtr
< ArgType
> firstSorted
= Helpers::down_cast
< ArgType
>( val
->cdr_
, "< Internal error situation in Core_mergeSort_cont_sortSecond::takeValue >" );
656 /* Initiate sorting of second part.
658 Kernel::ContRef cont
= Kernel::ContRef
659 ( new Kernel::Core_mergeSort_cont_sort
660 ( ! reversed_
, precedes_
, precedesLoc_
, dyn_
,
661 Kernel::ContRef( new Kernel::Core_mergeSort_cont_merge
662 ( reversed_
, precedes_
, precedesLoc_
, firstSorted
, dyn_
, cont_
, traceLoc_
) ),
664 evalState
->cont_
= cont
;
665 cont
->takeValue( secondUnsorted_
, evalState
);
669 Kernel::Core_mergeSort_cont_merge::takeValue( const RefCountPtr
< const Lang::Value
> & valUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const
671 /* The value received by this continuation shall be a SingleListPair where
672 * cdr_ is the sorted second part, reversed
673 * car_ is the last element in the cdr_ sequence
675 typedef const Lang::SingleListPair ArgType
;
676 RefCountPtr
< ArgType
> val
= Helpers::down_cast
< ArgType
>( valUntyped
, "< Internal error situation in Core_mergeSort_cont_merge::takeValue >" );
678 RefCountPtr
< ArgType
> secondSorted
= Helpers::down_cast
< ArgType
>( val
->cdr_
, "< Internal error situation in Core_mergeSort_cont_merge::takeValue >" );
679 Kernel::VariableHandle lastInSecond
= val
->car_
;
681 static Ast::SourceLocation
callbackLoc( Ast::FileID::build_internal( "< mergesort callback >" ) );
683 evalState
->cont_
= Kernel::ContRef( new Kernel::Core_mergeSort_cont_mergeShortcut( reversed_
, precedes_
, precedesLoc_
, firstSorted_
, secondSorted
, dyn_
, cont_
, callbackLoc
, traceLoc_
) );
684 evalState
->dyn_
= dyn_
;
686 if( dynamic_cast< const Lang::UserFunction
* >( precedes_
.getPtr( ) ) == NULL
){
687 /* Compare the use of RelaxContinuation in Core_mergeSort_cont_mergeStep::callback.
689 evalState
->cont_
= Kernel::ContRef( new Kernel::RelaxContinuation( evalState
->cont_
) );
693 precedes_
->call( precedes_
, evalState
, lastInSecond
, firstSorted_
->car_
, callbackLoc
);
695 precedes_
->call( precedes_
, evalState
, firstSorted_
->car_
, lastInSecond
, callbackLoc
);
699 Kernel::Core_mergeSort_cont_mergeShortcut::takeValue( const RefCountPtr
< const Lang::Value
> & precUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const
701 bool prec
= Helpers::down_cast_ContinuationArgument
< const Lang::Boolean
>( precUntyped
, this )->val_
;
705 /* First element in _second_ list precedes last element in _first_ list, cannot shortcut.
706 * However, if both lists have only one element, we know how they shall be ordered.
708 if( dynamic_cast< const Lang::SingleListNull
* >( firstSorted_
->cdr_
.getPtr( ) ) != NULL
709 && dynamic_cast< const Lang::SingleListNull
* >( secondSorted_
->cdr_
.getPtr( ) ) != NULL
){
710 RefCountPtr
< const Lang::SingleList
> result
= Lang::THE_CONS_NULL
;
711 result
= RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( firstSorted_
->car_
, result
) );
712 result
= RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( secondSorted_
->car_
, result
) );
713 evalState
->cont_
= cont_
;
714 cont_
->takeValue( RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( firstSorted_
->car_
, result
) ),
718 Core_mergeSort_cont_mergeStep::callback( reversed_
, precedes_
, precedesLoc_
, firstSorted_
, secondSorted_
, true,
719 Lang::THE_CONS_NULL
, Kernel::THE_SLOT_VARIABLE
, dyn_
, cont_
, callLoc_
,
726 /* Otherwise, shortcut by just appending sequences in reverse and return. */
727 RefCountPtr
< const Lang::SingleListPair
> p
= secondSorted_
;
728 RefCountPtr
< const Lang::SingleList
> result
= Lang::THE_CONS_NULL
;
729 Kernel::VariableHandle lastInResult
= p
->car_
;
730 while( p
!= NullPtr
< const Lang::SingleListPair
>( ) ){
731 result
= RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( p
->car_
, result
) );
732 p
= p
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
735 while( p
!= NullPtr
< const Lang::SingleListPair
>( ) ){
736 result
= RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( p
->car_
, result
) );
737 p
= p
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
739 evalState
->cont_
= cont_
;
740 cont_
->takeValue( RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( lastInResult
, result
) ),
748 Kernel::Core_mergeSort_cont_mergeStep::callback( bool reversed
, RefCountPtr
< const Lang::Function
> precedes
, const Ast::SourceLocation
& precedesLoc
, const RefCountPtr
< const Lang::SingleListPair
> & first
, const RefCountPtr
< const Lang::SingleListPair
> & second
, bool firstAtStart
, RefCountPtr
< const Lang::SingleList
> reverseResult
, const Kernel::VariableHandle
& lastInResult
, const Kernel::PassedDyn
& dyn
, const Kernel::ContRef
& cont
, const Ast::SourceLocation
& callLoc
, Kernel::EvalState
* evalState
)
750 static Ast::SourceLocation
callbackLoc( Ast::FileID::build_internal( "< mergesort callback >" ) );
752 if( firstAtStart
&& dynamic_cast< const Lang::SingleListNull
* >( second
->cdr_
.getPtr( ) ) != NULL
){
753 /* We would not get here if it would have been possible to shortcut the merge.
754 * This means that the first element in the first list is next in turn.
756 reverseResult
= RefCountPtr
< const Lang::SingleListPair
>( new Lang::SingleListPair( first
->car_
, reverseResult
) );
757 RefCountPtr
< const Lang::SingleListPair
> rest
= first
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
759 if( rest
== NullPtr
< const Lang::SingleListPair
>( ) ){
760 /* Only one value in second remains. */
762 reverseResult
= RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( second
->car_
, reverseResult
) );
763 evalState
->cont_
= cont
;
764 cont
->takeValue( RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( lastInResult
, reverseResult
) ),
770 /* Continue merge. */
771 Core_mergeSort_cont_mergeStep::callback( reversed
, precedes
, precedesLoc
, rest
, second
, false, reverseResult
, lastInResult
, dyn
, cont
, callLoc
,
779 evalState
->cont_
= Kernel::ContRef( new Kernel::Core_mergeSort_cont_mergeStep( reversed
, precedes
, precedesLoc
, first
, second
, firstAtStart
, reverseResult
, lastInResult
, dyn
, cont
, callbackLoc
, callLoc
) );
780 evalState
->dyn_
= dyn
;
782 if( dynamic_cast< const Lang::UserFunction
* >( precedes
.getPtr( ) ) == NULL
){
783 /* We are not sure that calling precedes will allow the evaluation call chain to unwind.
784 * Relax after precedes has produced a result.
785 * (We could do more elaborate testing here to determine more exactly when we need to relax
786 * the evaluation, what we have now is just a rough approximation that is expected to catch
787 * the most important cases. We just have to be sure that we don't fail to relax the evaluation
788 * when needed -- better safe than sorry.)
790 evalState
->cont_
= Kernel::ContRef( new Kernel::RelaxContinuation( evalState
->cont_
) );
793 /* Recall that the merge is constructing a reversed result. That is, when in reversed mode, the resulting list is
794 * actually increasing. This means that we shall take the element from the right (!) part in case of a tie.
795 * When not inreversed mode, it is the opposite since we are constructing a reversed result.
797 * Decreasing order (reversed):
798 * First: left, ( 3 ; 2 ; 1 ). Second: right, ( 6 ; 5 ; 4 ).
799 * Thus, pick element from first only if 3 > 6, that is 6 < 3.
801 * Increasing order (not reversed):
802 * First: right, ( 4 ; 5 ; 6 ). Second: left, ( 1 ; 2 ; 3 ).
803 * This, pick element from first only if 4 < 1.
805 * In both cases, the comparison is the same.
808 precedes
->call( precedes
, evalState
, second
->car_
, first
->car_
, callbackLoc
);
810 precedes
->call( precedes
, evalState
, first
->car_
, second
->car_
, callbackLoc
);
815 Kernel::Core_mergeSort_cont_mergeStep::takeValue( const RefCountPtr
< const Lang::Value
> & precUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const
817 bool prec
= Helpers::down_cast_ContinuationArgument
< const Lang::Boolean
>( precUntyped
, this )->val_
;
821 /* Pick value from first.
823 RefCountPtr
< const Lang::SingleListPair
> reverseResult
= RefCountPtr
< const Lang::SingleListPair
>( new Lang::SingleListPair( first_
->car_
, reverseResult_
) );
824 RefCountPtr
< const Lang::SingleListPair
> rest
= first_
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
826 Kernel::VariableHandle lastInResult
= (lastInResult_
== Kernel::THE_SLOT_VARIABLE
) ? first_
->car_
: lastInResult_
;
828 if( rest
== NullPtr
< const Lang::SingleListPair
>( ) ){
829 /* Only values in second remain. */
831 RefCountPtr
< const Lang::SingleListPair
> p
= second_
;
832 while( p
!= NullPtr
< const Lang::SingleListPair
>( ) ){
833 reverseResult
= RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( p
->car_
, reverseResult
) );
834 p
= p
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
836 evalState
->cont_
= cont_
;
837 cont_
->takeValue( RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( lastInResult
, reverseResult
) ),
843 /* Continue merge. */
844 Core_mergeSort_cont_mergeStep::callback( reversed_
, precedes_
, precedesLoc_
, rest
, second_
, firstAtStart_
, reverseResult
, lastInResult
, dyn_
, cont_
, callLoc_
,
852 /* Pick value from second.
854 RefCountPtr
< const Lang::SingleListPair
> reverseResult
= RefCountPtr
< const Lang::SingleListPair
>( new Lang::SingleListPair( second_
->car_
, reverseResult_
) );
855 RefCountPtr
< const Lang::SingleListPair
> rest
= second_
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
857 Kernel::VariableHandle lastInResult
= (lastInResult_
== Kernel::THE_SLOT_VARIABLE
) ? second_
->car_
: lastInResult_
;
859 if( rest
== NullPtr
< const Lang::SingleListPair
>( ) ){
860 /* Only values in first remain. */
862 RefCountPtr
< const Lang::SingleListPair
> p
= first_
;
863 while( p
!= NullPtr
< const Lang::SingleListPair
>( ) ){
864 reverseResult
= RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( p
->car_
, reverseResult
) );
865 p
= p
->cdr_
.down_cast
< const Lang::SingleListPair
>( );
867 evalState
->cont_
= cont_
;
868 cont_
->takeValue( RefCountPtr
< const Lang::SingleList
>( new Lang::SingleListPair( lastInResult
, reverseResult
) ),
874 /* Continue merge. */
875 Core_mergeSort_cont_mergeStep::callback( reversed_
, precedes_
, precedesLoc_
, first_
, rest
, false, reverseResult
, lastInResult
, dyn_
, cont_
, callLoc_
,
885 Kernel::Core_mergeSort_cont_finish::takeValue( const RefCountPtr
< const Lang::Value
> & valUntyped
, Kernel::EvalState
* evalState
, bool dummy
) const
887 /* The value received by this continuation shall be a SingleListPair where
888 * cdr_ is the sorted sequence, reversed
889 * car_ is the last element in the cdr_ sequence
891 typedef const Lang::SingleListPair ArgType
;
892 RefCountPtr
< ArgType
> val
= Helpers::down_cast
< ArgType
>( valUntyped
, "< Internal error situation in Core_mergeSort_cont_finish::takeValue >" );
894 evalState
->cont_
= cont_
;
895 cont_
->takeValue( val
->cdr_
, evalState
);
900 Kernel::registerCore_sort( Kernel::Environment
* env
)
902 env
->initDefineCoreFunction( new Lang::Core_lexiographicSort( "lexiographicSort" ) );
903 env
->initDefineCoreFunction( new Lang::Core_mergeSort( "sort" ) );