1 /*
2 * Copyright Vladimir Prus 2003.
3 * Distributed under the Boost Software License, Version 1.0.
4 * (See accompanying file LICENSE_1_0.txt or copy at
5 * http://www.boost.org/LICENSE_1_0.txt)
6 */
7
8 #include "../native.h"
9 #include "../object.h"
10 #include "../lists.h"
11 #include "../compile.h"
12
13 #include <stdlib.h>
14
15
16 #ifndef max
17 # define max(a,b) ((a)>(b)?(a):(b))
18 #endif
19
20
sequence_select_highest_ranked(FRAME * frame,int flags)21 LIST * sequence_select_highest_ranked( FRAME * frame, int flags )
22 {
23 /* Returns all of 'elements' for which corresponding element in parallel */
24 /* list 'rank' is equal to the maximum value in 'rank'. */
25
26 LIST * const elements = lol_get( frame->args, 0 );
27 LIST * const rank = lol_get( frame->args, 1 );
28
29 LIST * result = L0;
30 int highest_rank = -1;
31
32 {
33 LISTITER iter = list_begin( rank );
34 LISTITER const end = list_end( rank );
35 for ( ; iter != end; iter = list_next( iter ) )
36 {
37 int const current = atoi( object_str( list_item( iter ) ) );
38 highest_rank = max( highest_rank, current );
39 }
40 }
41
42 {
43 LISTITER iter = list_begin( rank );
44 LISTITER const end = list_end( rank );
45 LISTITER elements_iter = list_begin( elements );
46 for ( ; iter != end; iter = list_next( iter ), elements_iter =
47 list_next( elements_iter ) )
48 if ( atoi( object_str( list_item( iter ) ) ) == highest_rank )
49 result = list_push_back( result, object_copy( list_item(
50 elements_iter ) ) );
51 }
52
53 return result;
54 }
55
sequence_transform(FRAME * frame,int flags)56 LIST * sequence_transform( FRAME * frame, int flags )
57 {
58 LIST * function = lol_get( frame->args, 0 );
59 LIST * sequence = lol_get( frame->args, 1 );
60 LIST * result = L0;
61 OBJECT * function_name = list_front( function );
62 LISTITER args_begin = list_next( list_begin( function ) ), args_end = list_end( function );
63 LISTITER iter = list_begin( sequence ), end = list_end( sequence );
64 RULE * rule = bindrule( function_name, frame->prev->module );
65
66 for ( ; iter != end; iter = list_next( iter ) )
67 {
68 FRAME inner[ 1 ];
69
70 frame_init( inner );
71 inner->prev = frame;
72 inner->prev_user = frame->prev_user;
73 inner->module = frame->prev->module;
74
75 lol_add( inner->args, list_push_back( list_copy_range( function, args_begin, args_end ), object_copy( list_item( iter ) ) ) );
76 result = list_append( result, evaluate_rule( rule, function_name, inner ) );
77
78 frame_free( inner );
79 }
80
81 return result;
82 }
83
init_sequence()84 void init_sequence()
85 {
86 {
87 char const * args[] = { "elements", "*", ":", "rank", "*", 0 };
88 declare_native_rule( "sequence", "select-highest-ranked", args,
89 sequence_select_highest_ranked, 1 );
90 }
91 {
92 char const * args[] = { "function", "+", ":", "sequence", "*", 0 };
93 declare_native_rule( "sequence", "transform", args,
94 sequence_transform, 1 );
95 }
96 }
97