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 Henrik Tidefelt
21 #include "shapescore.h"
23 #include "shapesexceptions.h"
25 #include "simplepdfi.h"
27 #include "continuations.h"
28 #include "multipage.h"
38 using namespace Shapes
;
45 class NullFunction
: public Lang::CoreFunction
48 NullFunction( const char * title
) : CoreFunction( title
) { }
49 virtual void call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
51 Kernel::ContRef cont
= evalState
->cont_
;
52 cont
->takeValue( Lang::THE_VOID
,
57 class Core_identity
: public Lang::CoreFunction
60 Core_identity( const char * title
) : CoreFunction( title
) { }
61 virtual void call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
63 const size_t ARITY
= 1;
64 CHECK_ARITY( args
, ARITY
, title_
);
66 Kernel::ContRef cont
= evalState
->cont_
;
67 cont
->takeHandle( args
.getHandle( 0 ),
72 class Core_typeof
: public Lang::CoreFunction
75 Core_typeof( const char * title
) : CoreFunction( title
) { }
76 virtual void call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
78 const size_t ARITY
= 1;
79 CHECK_ARITY( args
, ARITY
, title_
);
81 Kernel::ContRef cont
= evalState
->cont_
;
82 cont
->takeValue( args
.getValue( 0 )->getClass( ),
87 class Core_error
: public Lang::CoreFunction
90 Core_error( const char * title
)
91 : CoreFunction( title
, new Kernel::EvaluatedFormals( Ast::FileID::build_internal( title
), true ) )
93 formals_
->appendEvaluatedCoreFormal( "kind", Kernel::THE_SLOT_VARIABLE
);
94 formals_
->appendEvaluatedCoreFormal( "source", Kernel::THE_SLOT_VARIABLE
);
95 formals_
->appendEvaluatedCoreFormal( "message", Kernel::THE_SLOT_VARIABLE
);
96 formals_
->appendEvaluatedCoreFormal( "details", Kernel::THE_VOID_VARIABLE
);
97 formals_
->appendEvaluatedCoreFormal( "cause", Kernel::THE_VOID_VARIABLE
);
99 virtual void call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
101 args
.applyDefaults( );
103 static Lang::Symbol
OUT_OF_RANGE( "out_of_range" );
104 static Lang::Symbol
TYPE_MISMATCH( "type_mismatch" );
105 static Lang::Symbol
MISC( "misc" );
106 static Lang::Symbol
EXTERNAL( "external" );
107 static Lang::Symbol
PDF_VERSION( "PDF_version" );
108 static Lang::Symbol
DTMIN( "dtmin" );
109 static Lang::Symbol
NUMERIC( "numeric" );
112 typedef const Lang::Symbol KindType
;
113 RefCountPtr
< KindType
> kind
= Helpers::down_cast_CoreArgument
< KindType
>( title_
, args
, argsi
, callLoc
);
116 typedef const Lang::String SourceType
;
117 RefCountPtr
< SourceType
> source
= Helpers::down_cast_CoreArgument
< SourceType
>( title_
, args
, argsi
, callLoc
);
120 typedef const Lang::String MessageType
;
121 RefCountPtr
< MessageType
> message
= Helpers::down_cast_CoreArgument
< MessageType
>( title_
, args
, argsi
, callLoc
);
124 size_t details_argsi
= argsi
;
127 size_t cause_argsi
= argsi
;
129 Kernel::VariableHandle cause
= args
.getHandle( argsi
);
130 if( *kind
!= TYPE_MISMATCH
&&
131 cause
!= Kernel::THE_VOID_VARIABLE
)
133 throw Exceptions::CoreRequirement( "The argument <cause> must not be provided for the given value of <kind>.", title_
, callLoc
);
137 if( *kind
== OUT_OF_RANGE
)
139 typedef const Lang::Integer DetailsType
;
140 RefCountPtr
< DetailsType
> details
= Helpers::down_cast_CoreArgument
< DetailsType
>( title_
, args
, details_argsi
, callLoc
);
141 throw Exceptions::UserOutOfRange( kind
, source
, details
, message
->val_
);
143 else if( *kind
== TYPE_MISMATCH
)
145 typedef const Lang::Integer DetailsType
;
146 RefCountPtr
< DetailsType
> details
= Helpers::down_cast_CoreArgument
< DetailsType
>( title_
, args
, details_argsi
, callLoc
);
148 throw Exceptions::UserTypeMismatch( kind
, source
, details
, message
->val_
, args
.getValue( cause_argsi
)->getTypeName( ) );
150 else if( *kind
== MISC
||
152 *kind
== PDF_VERSION
||
155 Kernel::VariableHandle details
= args
.getHandle( details_argsi
);
156 if( details
!= Kernel::THE_VOID_VARIABLE
)
158 throw Exceptions::CoreRequirement( "The argument <details> must not be provided for the given value of <kind>.", title_
, callLoc
);
161 throw Exceptions::UserError( kind
, source
, args
.getValue( details_argsi
), message
->val_
);
163 else if( *kind
== DTMIN
)
165 typedef const Lang::Float DetailsType
;
166 RefCountPtr
< DetailsType
> details
= Helpers::down_cast_CoreArgument
< DetailsType
>( title_
, args
, details_argsi
, callLoc
);
168 throw Exceptions::UserError( kind
, source
, details
, message
->val_
);
172 throw Exceptions::UserError( kind
, source
, args
.getValue( details_argsi
), message
->val_
);
178 class Core_show
: public Lang::CoreFunction
181 Core_show( const char * title
) : CoreFunction( title
) { }
183 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
185 std::ostringstream oss
;
186 for( size_t i
= 0; i
!= args
.size( ); ++i
)
188 args
.getValue( i
)->show( oss
);
190 Kernel::ContRef cont
= evalState
->cont_
;
191 cont
->takeValue( RefCountPtr
< const Lang::Value
>( new Lang::String( strrefdup( oss
) ) ),
196 class Core_typename
: public Lang::CoreFunction
199 Core_typename( const char * title
) : CoreFunction( title
) { }
201 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
203 const size_t ARITY
= 1;
204 CHECK_ARITY( args
, ARITY
, title_
);
206 Kernel::ContRef cont
= evalState
->cont_
;
207 cont
->takeValue( RefCountPtr
< const Lang::Value
>( new Lang::String( args
.getValue( 0 )->getTypeName( ) ) ),
212 class Core_debuglog_before
: public Lang::CoreFunction
215 Core_debuglog_before( const char * title
)
216 : CoreFunction( title
, new Kernel::EvaluatedFormals( Ast::FileID::build_internal( title
) ) )
218 formals_
->appendEvaluatedCoreFormal( "msg", Kernel::THE_SLOT_VARIABLE
, true );
219 formals_
->appendEvaluatedCoreFormal( "result", Kernel::THE_SLOT_VARIABLE
, false );
222 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
224 args
.applyDefaults( );
226 args
.getValue( 0 )->show( Kernel::theDebugLog
.os( ) );
227 Kernel::theDebugLog
.os( ) << std::flush
;
229 Kernel::ContRef cont
= evalState
->cont_
;
230 cont
->takeHandle( args
.getHandle( 1 ),
235 class Core_debuglog_after
: public Lang::CoreFunction
238 Core_debuglog_after( const char * title
)
239 : CoreFunction( title
, new Kernel::EvaluatedFormals( Ast::FileID::build_internal( title
) ) )
241 formals_
->appendEvaluatedCoreFormal( "msg", Kernel::THE_SLOT_VARIABLE
, true );
242 formals_
->appendEvaluatedCoreFormal( "result", Kernel::THE_SLOT_VARIABLE
, true );
245 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
247 args
.applyDefaults( );
249 args
.getValue( 0 )->show( Kernel::theDebugLog
.os( ) );
250 Kernel::theDebugLog
.os( ) << std::flush
;
252 Kernel::ContRef cont
= evalState
->cont_
;
253 cont
->takeValue( args
.getValue( 1 ),
258 class Core_if
: public Lang::CoreFunction
261 Core_if( const char * title
)
262 : CoreFunction( title
, new Kernel::EvaluatedFormals( Ast::FileID::build_internal( title
) ) )
264 formals_
->appendEvaluatedCoreFormal( "predicate", Kernel::THE_SLOT_VARIABLE
, true );
265 formals_
->appendEvaluatedCoreFormal( "consequence", Kernel::THE_SLOT_VARIABLE
, false );
266 formals_
->appendEvaluatedCoreFormal( "alternative", Kernel::VariableHandle( new Kernel::Variable( Lang::THE_VOID
) ), false );
270 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
272 args
.applyDefaults( );
274 evalState
->cont_
= Kernel::ContRef( new Kernel::IfContinuation( args
.getHandle( 1 ), args
.getHandle( 2 ), evalState
->cont_
, callLoc
) );
276 Kernel::ContRef cont
= evalState
->cont_
;
277 cont
->takeHandle( args
.getHandle( 0 ), evalState
);
281 class Core_memoryinfo
: public Lang::CoreFunction
284 Core_memoryinfo( const char * title
) : CoreFunction( title
) { }
286 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
288 const size_t ARITY
= 0;
289 CHECK_ARITY( args
, ARITY
, title_
);
290 std::cerr
<< "Environments: alive: " << Kernel::Environment::liveCount
<< " of total: " << Kernel::Environment::createdCount
291 << " (" << 100 * static_cast< double >( Kernel::Environment::liveCount
) / static_cast< double >( Kernel::Environment::createdCount
) << "%)" << std::endl
;
292 Kernel::ContRef cont
= evalState
->cont_
;
293 cont
->takeHandle( Kernel::THE_VOID_VARIABLE
,
298 class Core_rectangle
: public Lang::CoreFunction
301 Core_rectangle( const char * title
) : CoreFunction( title
) { }
303 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
305 const size_t ARITY
= 2;
306 CHECK_ARITY( args
, ARITY
, title_
);
308 typedef typeof args ListType
;
310 typedef const Lang::Coords2D ArgType
;
312 RefCountPtr
< ArgType
> arg1
= Helpers::down_cast_CoreArgument
< ArgType
>( title_
, args
, 0, callLoc
);
313 RefCountPtr
< ArgType
> arg2
= Helpers::down_cast_CoreArgument
< ArgType
>( title_
, args
, 1, callLoc
);
315 Lang::ElementaryPath2D
* res
= new Lang::ElementaryPath2D
;
317 res
->push_back( new Concrete::PathPoint2D( arg1
->x_
.get( ), arg1
->y_
.get( ) ) );
318 res
->push_back( new Concrete::PathPoint2D( arg2
->x_
.get( ), arg1
->y_
.get( ) ) );
319 res
->push_back( new Concrete::PathPoint2D( arg2
->x_
.get( ), arg2
->y_
.get( ) ) );
320 res
->push_back( new Concrete::PathPoint2D( arg1
->x_
.get( ), arg2
->y_
.get( ) ) );
323 Kernel::ContRef cont
= evalState
->cont_
;
324 cont
->takeValue( Kernel::ValueRef( res
),
329 class Core_hot
: public Lang::CoreFunction
332 Core_hot( const char * title
)
333 : CoreFunction( title
, new Kernel::EvaluatedFormals( Ast::FileID::build_internal( title
), true ) )
335 formals_
->appendEvaluatedCoreFormal( "init", Kernel::THE_SLOT_VARIABLE
);
336 formals_
->appendEvaluatedCoreFormal( "tackon", Kernel::THE_SLOT_VARIABLE
);
337 formals_
->appendEvaluatedCoreFormal( "freeze", Kernel::VariableHandle( new Kernel::Variable( Lang::THE_IDENTITY
) ) );
341 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
343 args
.applyDefaults( );
345 Kernel::ContRef cont
= evalState
->cont_
;
346 cont
->takeValue( Kernel::ValueRef( new Lang::HotTriple
347 ( args
.getValue( 0 ),
348 Helpers::down_cast_CoreArgument
< const Lang::Function
>( title_
, args
, 1, callLoc
),
349 Helpers::down_cast_CoreArgument
< const Lang::Function
>( title_
, args
, 2, callLoc
) ) ),
354 class Core_ampersand_dynamic
: public Lang::CoreFunction
357 Core_ampersand_dynamic( const char * title
)
358 : CoreFunction( title
, new Kernel::EvaluatedFormals( Ast::FileID::build_internal( title
), true ) )
363 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
365 // args.applyDefaults( );
367 * Here, we should check that there are no named arguments, and that there are no states being passed...
370 RefCountPtr
< const Lang::DynamicBindings
> res
= RefCountPtr
< const Lang::DynamicBindings
>( new Lang::DynamicBindingsNull( ) );
372 for( size_t i
= 0; i
!= args
.size( ); ++i
)
374 res
= RefCountPtr
< const Lang::DynamicBindings
>
375 ( new Lang::DynamicBindingsPair( Helpers::down_cast_CoreArgument
< const Lang::DynamicBindings
>( title_
, args
, args
.size( ) - 1 - i
, callLoc
, true ),
379 Kernel::ContRef cont
= evalState
->cont_
;
380 cont
->takeValue( res
,
385 class Core_locate
: public Lang::CoreFunction
388 Core_locate( const char * title
) : CoreFunction( title
) { }
389 virtual void call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
391 const size_t ARITY
= 1;
392 CHECK_ARITY( args
, ARITY
, title_
);
394 RefCountPtr
< const Lang::Value
> res
= args
.getValue( 0 );
395 res
->set_node( args
.getNode( 0 ) );
397 Kernel::ContRef cont
= evalState
->cont_
;
398 cont
->takeValue( res
,
403 class Core_sourceof
: public Lang::CoreFunction
406 Core_sourceof( const char * title
) : CoreFunction( title
) { }
407 virtual void call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
409 const size_t ARITY
= 1;
410 CHECK_ARITY( args
, ARITY
, title_
);
412 const Ast::Node
* node
= args
.getValue( 0 )->node( );
415 throw Exceptions::CoreOutOfRange( title_
, args
, 0, "The value has not been located." );
418 std::ostringstream oss
;
421 node
->loc( ).copy( & oss
);
423 catch( const std::string
& ball
)
425 std::ostringstream msg
;
426 msg
<< "Source of located value could not be copied. Reason: " << ball
;
427 throw Exceptions::CoreOutOfRange( title_
, args
, 0, strrefdup( msg
) );
430 Kernel::ContRef cont
= evalState
->cont_
;
431 cont
->takeValue( RefCountPtr
< const Lang::Value
>( new Lang::String( strrefdup( oss
.str( ) ) ) ),
440 RefCountPtr
< const Lang::CoreFunction
> Lang::THE_IDENTITY( new Lang::Core_identity( "identity" ) );
443 Kernel::registerCore_misc( Kernel::Environment
* env
)
445 env
->initDefineCoreFunction( new Lang::Core_typeof( "typeof" ) );
446 env
->initDefineCoreFunction( new Lang::Core_error( "error" ) );
447 env
->initDefineCoreFunction( new Lang::Core_show( "show" ) );
448 env
->initDefineCoreFunction( new Lang::Core_typename( "typename" ) );
449 env
->initDefineCoreFunction( new Lang::Core_debuglog_before( "debuglog_before" ) );
450 env
->initDefineCoreFunction( new Lang::Core_debuglog_after( "debuglog_after" ) );
451 env
->initDefineCoreFunction( new Lang::Core_if( "if" ) );
452 env
->initDefineCoreFunction( new Lang::NullFunction( "ignore" ) );
453 env
->initDefineCoreFunction( new Lang::Core_rectangle( "rectangle" ) );
454 env
->initDefineCoreFunction( new Lang::Core_memoryinfo( "memoryinfo" ) );
455 env
->initDefineCoreFunction( new Lang::Core_hot( "hot" ) );
456 env
->initDefineCoreFunction( new Lang::Core_ampersand_dynamic( "bindings" ) );
458 env
->initDefineCoreFunction( new Lang::Core_locate( "locate" ) );
459 env
->initDefineCoreFunction( new Lang::Core_sourceof( "sourceof" ) );