@@ -1275,13 +1275,12 @@ JL_DLLEXPORT jl_value_t *jl_macroexpand1(jl_value_t *expr, jl_module_t *inmodule
12751275 return expr ;
12761276}
12771277
1278- // Main entry point to flisp lowering. Most arguments are optional; see `jl_lower_expr_mod`.
12791278// warn: Print any lowering warnings returned; otherwise ignore
12801279JL_DLLEXPORT jl_value_t * jl_fl_lower (jl_value_t * expr , jl_module_t * inmodule ,
1281- const char * file , int line , size_t world , bool_t warn )
1280+ const char * filename , int line , size_t world , bool_t warn )
12821281{
12831282 JL_TIMING (LOWERING , LOWERING );
1284- jl_timing_show_location (file , line , inmodule , JL_TIMING_DEFAULT_BLOCK );
1283+ jl_timing_show_location (filename , line , inmodule , JL_TIMING_DEFAULT_BLOCK );
12851284 jl_array_t * kwargs = NULL ;
12861285 JL_GC_PUSH3 (& expr , & kwargs , & inmodule );
12871286 expr = jl_copy_ast (expr );
@@ -1290,7 +1289,7 @@ JL_DLLEXPORT jl_value_t *jl_fl_lower(jl_value_t *expr, jl_module_t *inmodule,
12901289 fl_context_t * fl_ctx = & ctx -> fl ;
12911290 value_t arg = julia_to_scm (fl_ctx , expr );
12921291 value_t e = fl_applyn (fl_ctx , 3 , symbol_value (symbol (fl_ctx , "jl-lower-to-thunk" )), arg ,
1293- symbol (fl_ctx , file ), fixnum (line ));
1292+ symbol (fl_ctx , filename ), fixnum (line ));
12941293 value_t lwr = car_ (e );
12951294 value_t warnings = car_ (cdr_ (e ));
12961295 expr = scm_to_julia (fl_ctx , lwr , inmodule );
@@ -1320,15 +1319,41 @@ JL_DLLEXPORT jl_value_t *jl_fl_lower(jl_value_t *expr, jl_module_t *inmodule,
13201319 jl_log (jl_unbox_long (level ), NULL , group , id , file , line , (jl_value_t * )kwargs , msg );
13211320 }
13221321 JL_GC_POP ();
1323- return expr ;
1322+ return ( jl_value_t * ) jl_svec1 ( expr ) ;
13241323}
13251324
1326- // Lower an expression tree into Julia's intermediate-representation.
1325+ // Main C entry point to lowering. Calls jl_fl_lower during bootstrap, and
1326+ // Core._lower otherwise (this is also jl_fl_lower unless we have JuliaLowering)
13271327JL_DLLEXPORT jl_value_t * jl_lower (jl_value_t * expr , jl_module_t * inmodule ,
1328- const char * file , int line , size_t world , bool_t warn )
1328+ const char * filename , int line , size_t world , bool_t warn )
13291329{
1330- // TODO: Allow change of lowerer
1331- return jl_fl_lower (expr , inmodule , file , line , world , warn );
1330+ jl_value_t * core_lower = NULL ;
1331+ if (jl_core_module ) {
1332+ core_lower = jl_get_global (jl_core_module , jl_symbol ("_lower" ));
1333+ }
1334+ if (!core_lower || core_lower == jl_nothing ) {
1335+ return jl_fl_lower (expr , inmodule , filename , line , world , warn );
1336+ }
1337+ jl_value_t * * args ;
1338+ JL_GC_PUSHARGS (args , 7 );
1339+ args [0 ] = core_lower ;
1340+ args [1 ] = expr ;
1341+ args [2 ] = (jl_value_t * )inmodule ;
1342+ args [3 ] = jl_cstr_to_string (filename );
1343+ args [4 ] = jl_box_ulong (line );
1344+ args [5 ] = jl_box_ulong (world );
1345+ args [6 ] = warn ? jl_true : jl_false ;
1346+ jl_task_t * ct = jl_current_task ;
1347+ size_t last_age = ct -> world_age ;
1348+ ct -> world_age = jl_atomic_load_acquire (& jl_world_counter );
1349+ jl_value_t * result = jl_apply (args , 7 );
1350+ ct -> world_age = last_age ;
1351+ args [0 ] = result ; // root during error check below
1352+ JL_TYPECHK (parse , simplevector , result );
1353+ if (jl_svec_len (result ) < 1 )
1354+ jl_error ("Result from lowering should be `svec(a::Any, x::Any...)`" );
1355+ JL_GC_POP ();
1356+ return result ;
13321357}
13331358
13341359JL_DLLEXPORT jl_value_t * jl_lower_expr_mod (jl_value_t * expr , jl_module_t * inmodule )
0 commit comments