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, 2013 Henrik Tidefelt
21 #include "Shapes_Helpers_decls.h"
23 #include "shapescore.h"
24 #include "continuations.h"
26 #include "texlabelmanager.h"
27 #include "shapesexceptions.h"
29 using namespace Shapes
;
37 class ForceConsCont
: public Kernel::Continuation
39 Kernel::ValueRef carVal_
;
40 Kernel::ContRef cont_
;
42 ForceConsCont( const Kernel::ValueRef
& carVal
, const Kernel::ContRef
& cont
, const Ast::SourceLocation
& traceLoc
);
43 virtual ~ForceConsCont( );
44 virtual void takeValue( const RefCountPtr
< const Lang::Value
> & val
, Kernel::EvalState
* evalState
, bool dummy
) const;
45 virtual Kernel::ContRef
up( ) const;
46 virtual RefCountPtr
< const char > description( ) const;
47 virtual void gcMark( Kernel::GCMarkedSet
& marked
);
55 class Core_TeX
: public Lang::CoreFunction
58 Core_TeX( const RefCountPtr
< const Ast::NamespacePath
> & ns
, const char * name
)
59 : CoreFunction( ns
, name
)
62 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
64 const size_t ARITY
= 1;
65 CHECK_ARITY( args
, ARITY
, id_
);
67 typedef const Lang::String ArgType
;
68 RefCountPtr
< ArgType
> arg
= Helpers::down_cast_CoreArgument
< ArgType
>( id_
, args
, 0, callLoc
);
70 Kernel::ContRef cont
= evalState
->cont_
;
71 cont
->takeValue( Kernel::theTeXLabelManager
.request( std::string( arg
->val_
.getPtr( ) ), args
.getLoc( 0 ), evalState
->dyn_
),
76 class Core_coords2D
: public Lang::CoreFunction
79 Core_coords2D( const RefCountPtr
< const Ast::NamespacePath
> & ns
, const char * name
)
80 : CoreFunction( ns
, name
)
83 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
85 const size_t ARITY
= 2;
86 CHECK_ARITY( args
, ARITY
, id_
);
88 RefCountPtr
< const Lang::Value
> xUntyped
= args
.getValue( 0 );
89 RefCountPtr
< const Lang::Value
> yUntyped
= args
.getValue( 1 );
92 typedef const Lang::Float ArgType
;
93 ArgType
* xVal
= dynamic_cast< ArgType
* >( xUntyped
.getPtr( ) );
96 ArgType
* yVal
= dynamic_cast< ArgType
* >( yUntyped
.getPtr( ) );
101 /* This is a special case, where 0 is interpreted as a length.
103 typedef const Lang::Length ArgTypeY
;
104 ArgTypeY
* yVal
= dynamic_cast< ArgTypeY
* >( yUntyped
.getPtr( ) );
107 Kernel::ContRef cont
= evalState
->cont_
;
108 cont
->takeValue( Kernel::ValueRef( new Lang::Coords2D( Lang::Length( 0 ), *yVal
) ),
113 throw Exceptions::CoreTypeMismatch( callLoc
, new Interaction::CharPtrLocation( "( <>, y )" ), args
, 1, ArgType::staticTypeName( ) );
116 Kernel::ContRef cont
= evalState
->cont_
;
117 cont
->takeValue( Kernel::ValueRef( new Lang::FloatPair( xVal
->val_
, yVal
->val_
) ),
124 typedef const Lang::Length ArgType
;
125 ArgType
* xVal
= dynamic_cast< ArgType
* >( xUntyped
.getPtr( ) );
128 ArgType
* yVal
= dynamic_cast< ArgType
* >( yUntyped
.getPtr( ) );
131 /* A Float with value 0 is still allowed
133 typedef const Lang::Float ArgTypeY
;
134 ArgTypeY
* yVal
= dynamic_cast< ArgTypeY
* >( yUntyped
.getPtr( ) );
137 if( yVal
->val_
== 0 )
139 Kernel::ContRef cont
= evalState
->cont_
;
140 cont
->takeValue( Kernel::ValueRef( new Lang::Coords2D( *xVal
, Lang::Length( 0 ) ) ),
145 throw Exceptions::CoreTypeMismatch( callLoc
, new Interaction::CharPtrLocation( "( <>, y )" ), args
, 1, ArgType::staticTypeName( ) );
148 Kernel::ContRef cont
= evalState
->cont_
;
149 cont
->takeValue( Kernel::ValueRef( new Lang::Coords2D( *xVal
, *yVal
) ),
155 throw Exceptions::CoreTypeMismatch( callLoc
, new Interaction::CharPtrLocation( "( x, <> )" ), args
, 0, Helpers::typeSetString( Lang::Float::staticTypeName( ), Lang::Length::staticTypeName( ) ) );
159 class Core_cornercoords2D
: public Lang::CoreFunction
162 Core_cornercoords2D( const RefCountPtr
< const Ast::NamespacePath
> & ns
, const char * name
)
163 : CoreFunction( ns
, name
)
166 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
169 * We don't check for presence of named arguments here since this function is generally called internally, and
170 * we don't want the extra overhead of an unnecessary check.
173 Kernel::ContRef cont
= evalState
->cont_
;
174 switch( args
.size( ) )
177 cont
->takeValue( Kernel::ValueRef( new Lang::CornerCoords2D( * Helpers::down_cast_SyntaxArgument
< const Lang::Length
>( "( x, <> ^ )", args
, 0, callLoc
),
178 * Helpers::down_cast_SyntaxArgument
< const Lang::Length
>( "( <>, y ^ )", args
, 1, callLoc
),
179 std::numeric_limits
< double >::signaling_NaN( ) ) ),
183 cont
->takeValue( Kernel::ValueRef( new Lang::CornerCoords2D( * Helpers::down_cast_SyntaxArgument
< const Lang::Length
>( "( x, <> ^ <> )", args
, 0, callLoc
),
184 * Helpers::down_cast_SyntaxArgument
< const Lang::Length
>( "( <>, y ^ <> )", args
, 1, callLoc
),
185 Helpers::down_cast_SyntaxArgument
< const Lang::Float
>( "( <>, <> ^ a )", args
, 2, callLoc
)->val_
) ),
189 throw Exceptions::CoreArityMismatch( id_
, 2, 3, args
.size( ) );
195 class Core_coords3D
: public Lang::CoreFunction
198 Core_coords3D( const RefCountPtr
< const Ast::NamespacePath
> & ns
, const char * name
)
199 : CoreFunction( ns
, name
)
202 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
204 const size_t ARITY
= 3;
205 CHECK_ARITY( args
, ARITY
, id_
);
207 RefCountPtr
< const Lang::Value
> xUntyped
= args
.getValue( 0 );
208 RefCountPtr
< const Lang::Value
> yUntyped
= args
.getValue( 1 );
209 RefCountPtr
< const Lang::Value
> zUntyped
= args
.getValue( 2 );
212 typedef const Lang::Float ArgType
;
213 ArgType
* xVal
= dynamic_cast< ArgType
* >( xUntyped
.getPtr( ) );
216 Kernel::ContRef cont
= evalState
->cont_
;
217 cont
->takeValue( Kernel::ValueRef( new Lang::FloatTriple( xVal
->val_
,
218 Helpers::down_cast_SyntaxArgument
< ArgType
>( "( <>, y, <> )", args
, 1, callLoc
)->val_
,
219 Helpers::down_cast_SyntaxArgument
< ArgType
>( "( <>, <>, z )", args
, 2, callLoc
)->val_
) ),
226 typedef const Lang::Length ArgType
;
227 ArgType
* xVal
= dynamic_cast< ArgType
* >( xUntyped
.getPtr( ) );
230 Kernel::ContRef cont
= evalState
->cont_
;
231 cont
->takeValue( Kernel::ValueRef( new Lang::Coords3D( *xVal
,
232 * Helpers::down_cast_SyntaxArgument
< ArgType
>( "( <>, y, <> )", args
, 1, callLoc
),
233 * Helpers::down_cast_SyntaxArgument
< ArgType
>( "( <>, <>, z )", args
, 2, callLoc
) ) ),
239 throw Exceptions::CoreTypeMismatch( callLoc
, new Interaction::CharPtrLocation( "( x, <>, <> )" ), args
, 0, Helpers::typeSetString( Lang::Float::staticTypeName( ), Lang::Length::staticTypeName( ) ) );
243 class Core_polarHandle2DFree_r
: public Lang::CoreFunction
246 Core_polarHandle2DFree_r( const RefCountPtr
< const Ast::NamespacePath
> & ns
, const char * name
)
247 : CoreFunction( ns
, name
)
250 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
252 const size_t ARITY
= 1;
253 CHECK_ARITY( args
, ARITY
, id_
);
255 Kernel::ContRef cont
= evalState
->cont_
;
256 cont
->takeValue( Kernel::ValueRef( new Lang::PolarHandle2DFree_r( evalState
->dyn_
->getDefaultUnit( ),
257 Helpers::down_cast_SyntaxArgument
< const Lang::Float
>( "(^ a )", args
, 0, callLoc
)->val_
) ),
262 class Core_polarHandle2DFree_ra
: public Lang::CoreFunction
265 Core_polarHandle2DFree_ra( const RefCountPtr
< const Ast::NamespacePath
> & ns
, const char * name
)
266 : CoreFunction( ns
, name
)
269 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
271 const size_t ARITY
= 0;
272 CHECK_ARITY( args
, ARITY
, id_
);
274 Kernel::ContRef cont
= evalState
->cont_
;
275 cont
->takeValue( Kernel::ValueRef( new Lang::PolarHandle2DFree_ra( evalState
->dyn_
->getDefaultUnit( ) ) ),
281 class Core_fcons
: public Lang::CoreFunction
284 Core_fcons( const RefCountPtr
< const Ast::NamespacePath
> & ns
, const char * title
)
285 : CoreFunction( ns
, title
, new Kernel::EvaluatedFormals( Ast::FileID::build_internal( title
), true ) )
287 formals_
->appendEvaluatedCoreFormal( "car", Kernel::THE_SLOT_VARIABLE
);
288 formals_
->appendEvaluatedCoreFormal( "cdr", Kernel::THE_SLOT_VARIABLE
);
291 call( Kernel::EvalState
* evalState
, Kernel::Arguments
& args
, const Ast::SourceLocation
& callLoc
) const
293 const size_t ARITY
= 2;
294 CHECK_ARITY( args
, ARITY
, id_
);
296 RefCountPtr
< const Lang::Value
> carVal
= args
.getValue( 0 );
301 typedef const Lang::SingleList ArgType2
;
302 RefCountPtr
< ArgType2
> cdrValTyped
= Helpers::try_cast_CoreArgument
< ArgType2
>( args
.getValue( i
) );
303 Kernel::ContRef cont
= evalState
->cont_
;
304 cont
->takeValue( Helpers::SingleList_cons( carVal
, cdrValTyped
),
308 catch( const NonLocalExit::NotThisType
& ball
)
310 /* Never mind, see below. */
315 typedef const Lang::ConsPair ArgType2
;
316 RefCountPtr
< ArgType2
> cdrValTyped
= Helpers::try_cast_CoreArgument
< ArgType2
>( args
.getValue( i
) );
317 evalState
->cont_
= Kernel::ContRef( new Kernel::ForcingListContinuation( Kernel::ContRef( new Kernel::ForceConsCont( carVal
, evalState
->cont_
, args
.getLoc( i
) ) ), args
.getLoc( i
) ) );
318 Kernel::ContRef cont
= evalState
->cont_
;
319 cont
->takeValue( cdrValTyped
,
323 catch( const NonLocalExit::NotThisType
& ball
)
325 /* Never mind, see below. */
328 throw Exceptions::CoreTypeMismatch( callLoc
, id_
, args
, i
, Helpers::typeSetString( Lang::SingleList::staticTypeName( ), Lang::ConsPair::staticTypeName( ) ) );
335 Kernel::ForceConsCont::ForceConsCont( const Kernel::ValueRef
& carVal
, const Kernel::ContRef
& cont
, const Ast::SourceLocation
& traceLoc
)
336 : Kernel::Continuation( traceLoc
), carVal_( carVal
), cont_( cont
)
339 Kernel::ForceConsCont::~ForceConsCont( )
343 Kernel::ForceConsCont::takeValue( const RefCountPtr
< const Lang::Value
> & val
, Kernel::EvalState
* evalState
, bool dummy
) const
345 typedef const Lang::SingleList CdrType
;
346 RefCountPtr
< CdrType
> cdrTyped
= Helpers::down_cast_ContinuationArgument
< CdrType
>( val
, this );
347 cont_
->takeValue( Helpers::SingleList_cons( carVal_
, cdrTyped
), evalState
);
351 Kernel::ForceConsCont::up( ) const
356 RefCountPtr
< const char >
357 Kernel::ForceConsCont::description( ) const
359 return strrefdup( "fcons' second" );
363 Kernel::ForceConsCont::gcMark( Kernel::GCMarkedSet
& marked
)
365 const_cast< Lang::Value
* >( carVal_
.getPtr( ) )->gcMark( marked
);
366 cont_
->gcMark( marked
);
371 RefCountPtr
< const Lang::CoreFunction
> Ast::THE_FUNCTION_coords2D( new Lang::Core_coords2D( Lang::THE_NAMESPACE_Shapes_Geometry
, "coords" ) );
372 RefCountPtr
< const Lang::CoreFunction
> Ast::THE_FUNCTION_cornercoords2D( new Lang::Core_cornercoords2D( Lang::THE_NAMESPACE_Shapes_Geometry
, "cornercoords" ) );
373 RefCountPtr
< const Lang::CoreFunction
> Ast::THE_FUNCTION_coords3D( new Lang::Core_coords3D( Lang::THE_NAMESPACE_Shapes_Geometry3D
, "coords" ) );
374 RefCountPtr
< const Lang::CoreFunction
> Ast::THE_FUNCTION_polarHandle2DFree_r( new Lang::Core_polarHandle2DFree_r( Lang::THE_NAMESPACE_Shapes_Geometry
, "polarHandleFree_r" ) );
375 RefCountPtr
< const Lang::CoreFunction
> Ast::THE_FUNCTION_polarHandle2DFree_ra( new Lang::Core_polarHandle2DFree_ra( Lang::THE_NAMESPACE_Shapes_Geometry
, "polarHandleFree_ra" ) );
376 /* This belongs in consts.cc but we must make sure it is initialized before we use it below. Note that the identifier will actually be destroyed
377 * before Ast::THE_FUNCTION_TeX is destroyed, but that should not cause a failure...
379 const char Lang::TEX_SYNTAX_ID
[] = "TeX";
380 RefCountPtr
< const Lang::CoreFunction
> Ast::THE_FUNCTION_TeX( new Lang::Core_TeX( Lang::THE_NAMESPACE_Shapes_Graphics
, Lang::TEX_SYNTAX_ID
) );
381 RefCountPtr
< const Lang::CoreFunction
> Ast::THE_FUNCTION_fcons( new Lang::Core_fcons( Lang::THE_NAMESPACE_Shapes_Data
, "fcons" ) );