@@ -153,7 +153,7 @@ struct macroctx_stack {
153
153
};
154
154
155
155
static jl_value_t * scm_to_julia (fl_context_t * fl_ctx , value_t e , jl_module_t * mod );
156
- static value_t julia_to_scm (fl_context_t * fl_ctx , jl_value_t * v );
156
+ static value_t julia_to_scm (jl_ast_context_t * ctx , jl_value_t * v );
157
157
static jl_value_t * jl_expand_macros (jl_value_t * expr , jl_module_t * inmodule , struct macroctx_stack * macroctx , int onelevel , size_t world , int throw_load_error );
158
158
159
159
static jl_sym_t * scmsym_to_julia (fl_context_t * fl_ctx , value_t s )
@@ -680,37 +680,40 @@ static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *m
680
680
jl_error ("malformed tree" );
681
681
}
682
682
683
- static value_t julia_to_scm_ (fl_context_t * fl_ctx , jl_value_t * v , int check_valid );
683
+ static value_t julia_to_scm_ (jl_ast_context_t * ctx , jl_value_t * v , int check_valid );
684
684
685
- static value_t julia_to_scm (fl_context_t * fl_ctx , jl_value_t * v )
685
+ static value_t julia_to_scm (jl_ast_context_t * ctx , jl_value_t * v )
686
686
{
687
687
value_t temp ;
688
688
// need try/catch to reset GC handle stack in case of error
689
+ fl_context_t * fl_ctx = & ctx -> fl ;
689
690
FL_TRY_EXTERN (fl_ctx ) {
690
- temp = julia_to_scm_ (fl_ctx , v , 1 );
691
+ temp = julia_to_scm_ (ctx , v , 1 );
691
692
}
692
693
FL_CATCH_EXTERN (fl_ctx ) {
693
694
temp = fl_ctx -> lasterror ;
694
695
}
695
696
return temp ;
696
697
}
697
698
698
- static void array_to_list (fl_context_t * fl_ctx , jl_array_t * a , value_t * pv , int check_valid )
699
+ static void array_to_list (jl_ast_context_t * ctx , jl_array_t * a , value_t * pv , int check_valid )
699
700
{
700
701
value_t temp ;
702
+ fl_context_t * fl_ctx = & ctx -> fl ;
701
703
for (long i = jl_array_nrows (a ) - 1 ; i >= 0 ; i -- ) {
702
704
* pv = fl_cons (fl_ctx , fl_ctx -> NIL , * pv );
703
- temp = julia_to_scm_ (fl_ctx , jl_array_ptr_ref (a , i ), check_valid );
705
+ temp = julia_to_scm_ (ctx , jl_array_ptr_ref (a , i ), check_valid );
704
706
// note: must be separate statement
705
707
car_ (* pv ) = temp ;
706
708
}
707
709
}
708
710
709
- static value_t julia_to_list2 (fl_context_t * fl_ctx , jl_value_t * a , jl_value_t * b , int check_valid )
711
+ static value_t julia_to_list2 (jl_ast_context_t * ctx , jl_value_t * a , jl_value_t * b , int check_valid )
710
712
{
711
- value_t sa = julia_to_scm_ (fl_ctx , a , check_valid );
713
+ fl_context_t * fl_ctx = & ctx -> fl ;
714
+ value_t sa = julia_to_scm_ (ctx , a , check_valid );
712
715
fl_gc_handle (fl_ctx , & sa );
713
- value_t sb = julia_to_scm_ (fl_ctx , b , check_valid );
716
+ value_t sb = julia_to_scm_ (ctx , b , check_valid );
714
717
value_t l = fl_list2 (fl_ctx , sa , sb );
715
718
fl_free_gc_handles (fl_ctx , 1 );
716
719
return l ;
@@ -784,12 +787,13 @@ static value_t julia_to_list2_noalloc(fl_context_t *fl_ctx, jl_value_t *a, jl_va
784
787
return l ;
785
788
}
786
789
787
- static value_t julia_to_scm_ (fl_context_t * fl_ctx , jl_value_t * v , int check_valid )
790
+ static value_t julia_to_scm_ (jl_ast_context_t * ctx , jl_value_t * v , int check_valid )
788
791
{
789
792
// The following code will take internal pointers to v's fields. We need to make sure
790
793
// that v will not be moved by GC.
791
794
OBJ_PIN (v );
792
795
value_t retval ;
796
+ fl_context_t * fl_ctx = & ctx -> fl ;
793
797
if (julia_to_scm_noalloc1 (fl_ctx , v , & retval ))
794
798
return retval ;
795
799
if (jl_is_expr (v )) {
@@ -798,12 +802,12 @@ static value_t julia_to_scm_(fl_context_t *fl_ctx, jl_value_t *v, int check_vali
798
802
fl_gc_handle (fl_ctx , & args );
799
803
if (jl_expr_nargs (ex ) > 520000 && ex -> head != jl_block_sym )
800
804
lerror (fl_ctx , symbol (fl_ctx , "error" ), "expression too large" );
801
- array_to_list (fl_ctx , ex -> args , & args , check_valid );
802
- value_t hd = julia_to_scm_ (fl_ctx , (jl_value_t * )ex -> head , check_valid );
805
+ array_to_list (ctx , ex -> args , & args , check_valid );
806
+ value_t hd = julia_to_scm_ (ctx , (jl_value_t * )ex -> head , check_valid );
803
807
if (ex -> head == jl_lambda_sym && jl_expr_nargs (ex )> 0 && jl_is_array (jl_exprarg (ex ,0 ))) {
804
808
value_t llist = fl_ctx -> NIL ;
805
809
fl_gc_handle (fl_ctx , & llist );
806
- array_to_list (fl_ctx , (jl_array_t * )jl_exprarg (ex ,0 ), & llist , check_valid );
810
+ array_to_list (ctx , (jl_array_t * )jl_exprarg (ex ,0 ), & llist , check_valid );
807
811
car_ (args ) = llist ;
808
812
fl_free_gc_handles (fl_ctx , 1 );
809
813
}
@@ -819,26 +823,26 @@ static value_t julia_to_scm_(fl_context_t *fl_ctx, jl_value_t *v, int check_vali
819
823
jl_value_t * line = jl_fieldref (v ,0 );
820
824
value_t args = julia_to_list2_noalloc (fl_ctx , line , file , check_valid );
821
825
fl_gc_handle (fl_ctx , & args );
822
- value_t hd = julia_to_scm_ (fl_ctx , (jl_value_t * )jl_line_sym , check_valid );
826
+ value_t hd = julia_to_scm_ (ctx , (jl_value_t * )jl_line_sym , check_valid );
823
827
value_t scmv = fl_cons (fl_ctx , hd , args );
824
828
fl_free_gc_handles (fl_ctx , 1 );
825
829
return scmv ;
826
830
}
827
831
if (jl_typetagis (v , jl_gotonode_type ))
828
832
return julia_to_list2_noalloc (fl_ctx , (jl_value_t * )jl_goto_sym , jl_fieldref (v ,0 ), check_valid );
829
833
if (jl_typetagis (v , jl_quotenode_type ))
830
- return julia_to_list2 (fl_ctx , (jl_value_t * )jl_inert_sym , jl_fieldref_noalloc (v ,0 ), 0 );
834
+ return julia_to_list2 (ctx , (jl_value_t * )jl_inert_sym , jl_fieldref_noalloc (v ,0 ), 0 );
831
835
if (jl_typetagis (v , jl_newvarnode_type ))
832
836
return julia_to_list2_noalloc (fl_ctx , (jl_value_t * )jl_newvar_sym , jl_fieldref (v ,0 ), check_valid );
833
837
if (jl_typetagis (v , jl_globalref_type )) {
834
838
jl_module_t * m = jl_globalref_mod (v );
835
839
jl_sym_t * sym = jl_globalref_name (v );
836
840
if (m == jl_core_module )
837
- return julia_to_list2 (fl_ctx , (jl_value_t * )jl_core_sym ,
841
+ return julia_to_list2 (ctx , (jl_value_t * )jl_core_sym ,
838
842
(jl_value_t * )sym , check_valid );
839
- value_t args = julia_to_list2 (fl_ctx , (jl_value_t * )m , (jl_value_t * )sym , check_valid );
843
+ value_t args = julia_to_list2 (ctx , (jl_value_t * )m , (jl_value_t * )sym , check_valid );
840
844
fl_gc_handle (fl_ctx , & args );
841
- value_t hd = julia_to_scm_ (fl_ctx , (jl_value_t * )jl_globalref_sym , check_valid );
845
+ value_t hd = julia_to_scm_ (ctx , (jl_value_t * )jl_globalref_sym , check_valid );
842
846
value_t scmv = fl_cons (fl_ctx , hd , args );
843
847
fl_free_gc_handles (fl_ctx , 1 );
844
848
return scmv ;
@@ -906,8 +910,8 @@ JL_DLLEXPORT jl_value_t *jl_fl_parse(const char *text, size_t text_len,
906
910
static jl_value_t * jl_call_scm_on_ast (const char * funcname , jl_value_t * expr , jl_module_t * inmodule )
907
911
{
908
912
jl_ast_context_t * ctx = jl_ast_ctx_enter (inmodule );
913
+ value_t arg = julia_to_scm (ctx , expr );
909
914
fl_context_t * fl_ctx = & ctx -> fl ;
910
- value_t arg = julia_to_scm (fl_ctx , expr );
911
915
value_t e = fl_applyn (fl_ctx , 1 , symbol_value (symbol (fl_ctx , funcname )), arg );
912
916
jl_value_t * result = scm_to_julia (fl_ctx , e , inmodule );
913
917
JL_GC_PUSH1 (& result );
@@ -920,8 +924,8 @@ jl_value_t *jl_call_scm_on_ast_and_loc(const char *funcname, jl_value_t *expr,
920
924
jl_module_t * inmodule , const char * file , int line )
921
925
{
922
926
jl_ast_context_t * ctx = jl_ast_ctx_enter (inmodule );
927
+ value_t arg = julia_to_scm (ctx , expr );
923
928
fl_context_t * fl_ctx = & ctx -> fl ;
924
- value_t arg = julia_to_scm (fl_ctx , expr );
925
929
value_t e = fl_applyn (fl_ctx , 3 , symbol_value (symbol (fl_ctx , funcname )), arg ,
926
930
symbol (fl_ctx , file ), fixnum (line ));
927
931
jl_value_t * result = scm_to_julia (fl_ctx , e , inmodule );
@@ -1322,8 +1326,8 @@ JL_DLLEXPORT jl_value_t *jl_expand_with_loc_warn(jl_value_t *expr, jl_module_t *
1322
1326
expr = jl_copy_ast (expr );
1323
1327
expr = jl_expand_macros (expr , inmodule , NULL , 0 , ~(size_t )0 , 1 );
1324
1328
jl_ast_context_t * ctx = jl_ast_ctx_enter (inmodule );
1329
+ value_t arg = julia_to_scm (ctx , expr );
1325
1330
fl_context_t * fl_ctx = & ctx -> fl ;
1326
- value_t arg = julia_to_scm (fl_ctx , expr );
1327
1331
value_t e = fl_applyn (fl_ctx , 4 , symbol_value (symbol (fl_ctx , "jl-expand-to-thunk-warn" )), arg ,
1328
1332
symbol (fl_ctx , file ), fixnum (line ), fl_ctx -> F );
1329
1333
expr = scm_to_julia (fl_ctx , e , inmodule );
0 commit comments