• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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