@@ -15,12 +15,12 @@ use crate::compiler::compiler::run_optimizer;
1515use crate :: compiler:: comptypes:: {
1616 cons_of_string_map, foldM, join_vecs_to_string, list_to_cons, mapM, with_heading, Binding ,
1717 BodyForm , Callable , CompileErr , CompileForm , CompiledCode , CompilerOpts , DefunCall , HelperForm ,
18- InlineFunction , PrimaryCodegen ,
18+ InlineFunction , LetFormKind , PrimaryCodegen ,
1919} ;
2020use crate :: compiler:: debug:: { build_swap_table_mut, relabel} ;
2121use crate :: compiler:: frontend:: compile_bodyform;
2222use crate :: compiler:: gensym:: gensym;
23- use crate :: compiler:: inline:: replace_in_inline;
23+ use crate :: compiler:: inline:: { replace_in_inline, synthesize_args } ;
2424use crate :: compiler:: optimize:: optimize_expr;
2525use crate :: compiler:: prims:: { primapply, primcons, primquote, prims} ;
2626use crate :: compiler:: runtypes:: RunFailure ;
@@ -52,6 +52,38 @@ use crate::util::{number_from_u8, u8_from_number};
5252 * )
5353 */
5454
55+ fn cons_bodyform ( loc : Srcloc , left : Rc < BodyForm > , right : Rc < BodyForm > ) -> BodyForm {
56+ BodyForm :: Call (
57+ loc. clone ( ) ,
58+ vec ! [
59+ Rc :: new( BodyForm :: Value ( SExp :: Atom (
60+ loc. clone( ) ,
61+ "c" . as_bytes( ) . to_vec( ) ,
62+ ) ) ) , // Cons
63+ left. clone( ) ,
64+ right. clone( ) ,
65+ ] ,
66+ )
67+ }
68+
69+ /*
70+ * Produce a structure that mimics the expected environment if the current inline
71+ * context had been a function.
72+ */
73+ fn create_let_env_expression ( args : Rc < SExp > ) -> BodyForm {
74+ match args. borrow ( ) {
75+ SExp :: Cons ( l, a, b) => cons_bodyform (
76+ l. clone ( ) ,
77+ Rc :: new ( create_let_env_expression ( a. clone ( ) ) ) ,
78+ Rc :: new ( create_let_env_expression ( b. clone ( ) ) ) ,
79+ ) ,
80+ _ => {
81+ let cloned: & SExp = args. borrow ( ) ;
82+ BodyForm :: Value ( cloned. clone ( ) )
83+ }
84+ }
85+ }
86+
5587fn helper_atom ( h : & HelperForm ) -> SExp {
5688 SExp :: Atom ( h. loc ( ) , h. name ( ) )
5789}
@@ -300,7 +332,7 @@ pub fn get_callable(
300332 }
301333}
302334
303- fn process_macro_call (
335+ pub fn process_macro_call (
304336 allocator : & mut Allocator ,
305337 runner : Rc < dyn TRunProgram > ,
306338 opts : Rc < dyn CompilerOpts > ,
@@ -314,6 +346,13 @@ fn process_macro_call(
314346 let args_to_macro = list_to_cons ( l. clone ( ) , & converted_args) ;
315347 build_swap_table_mut ( & mut swap_table, & args_to_macro) ;
316348
349+ let arg_strs: Vec < String > = args. iter ( ) . map ( |x| x. to_sexp ( ) . to_string ( ) ) . collect ( ) ;
350+ println ! (
351+ "process macro args {:?} code {}" ,
352+ arg_strs,
353+ code. to_string( )
354+ ) ;
355+
317356 run (
318357 allocator,
319358 runner. clone ( ) ,
@@ -337,6 +376,7 @@ fn process_macro_call(
337376 } )
338377 . and_then ( |v| {
339378 let relabeled_expr = relabel ( & mut swap_table, & v) ;
379+ println ! ( "macro outcome {}" , relabeled_expr. to_string( ) ) ;
340380 compile_bodyform ( Rc :: new ( relabeled_expr) )
341381 } )
342382 . and_then ( |body| generate_expr_code ( allocator, runner, opts, compiler, Rc :: new ( body) ) )
@@ -394,7 +434,7 @@ fn process_defun_call(
394434 ) )
395435}
396436
397- fn get_call_name ( l : Srcloc , body : BodyForm ) -> Result < Rc < SExp > , CompileErr > {
437+ pub fn get_call_name ( l : Srcloc , body : BodyForm ) -> Result < Rc < SExp > , CompileErr > {
398438 match & body {
399439 BodyForm :: Value ( SExp :: Atom ( l, name) ) => {
400440 return Ok ( Rc :: new ( SExp :: Atom ( l. clone ( ) , name. clone ( ) ) ) ) ;
@@ -453,13 +493,12 @@ fn compile_call(
453493
454494 Callable :: CallInline ( l, inline) => replace_in_inline (
455495 allocator,
456- runner,
496+ runner. clone ( ) ,
457497 opts. clone ( ) ,
458498 compiler,
459499 l. clone ( ) ,
460- an. clone ( ) ,
461500 & inline,
462- Some ( & tl) ,
501+ & tl,
463502 ) ,
464503
465504 Callable :: CallDefun ( l, lookup) => {
@@ -553,7 +592,7 @@ pub fn generate_expr_code(
553592 expr : Rc < BodyForm > ,
554593) -> Result < CompiledCode , CompileErr > {
555594 match expr. borrow ( ) {
556- BodyForm :: Let ( l, bindings, expr) => {
595+ BodyForm :: Let ( l, LetFormKind :: Parallel , bindings, expr) => {
557596 /* Depends on a defun having been desugared from this let and the let
558597 expressing rewritten. */
559598 generate_expr_code ( allocator, runner, opts, compiler, expr. clone ( ) )
@@ -704,6 +743,7 @@ fn codegen_(
704743 Ok ( compiler. add_inline (
705744 name,
706745 & InlineFunction {
746+ name : name. clone ( ) ,
707747 args : args. clone ( ) ,
708748 body : body. clone ( ) ,
709749 } ,
@@ -826,11 +866,12 @@ fn generate_let_args(l: Srcloc, blist: Vec<Rc<Binding>>) -> Vec<Rc<BodyForm>> {
826866
827867fn hoist_body_let_binding (
828868 compiler : & PrimaryCodegen ,
869+ outer_context : Option < Rc < SExp > > ,
829870 args : Rc < SExp > ,
830871 body : Rc < BodyForm > ,
831872) -> ( Vec < HelperForm > , Rc < BodyForm > ) {
832873 match body. borrow ( ) {
833- BodyForm :: Let ( l, bindings, body) => {
874+ BodyForm :: Let ( l, LetFormKind :: Parallel , bindings, body) => {
834875 let defun_name = gensym ( "letbinding" . as_bytes ( ) . to_vec ( ) ) ;
835876 let generated_defun = generate_let_defun (
836877 compiler,
@@ -841,19 +882,23 @@ fn hoist_body_let_binding(
841882 body. clone ( ) ,
842883 ) ;
843884 let mut let_args = generate_let_args ( l. clone ( ) , bindings. to_vec ( ) ) ;
844- let pass_env = BodyForm :: Call (
845- l . clone ( ) ,
846- vec ! [
847- Rc :: new ( BodyForm :: Value ( SExp :: Atom (
885+ let pass_env = outer_context
886+ . map ( |x| create_let_env_expression ( x ) )
887+ . unwrap_or_else ( || {
888+ BodyForm :: Call (
848889 l. clone ( ) ,
849- "r" . as_bytes( ) . to_vec( ) ,
850- ) ) ) ,
851- Rc :: new( BodyForm :: Value ( SExp :: Atom (
852- l. clone( ) ,
853- "@" . as_bytes( ) . to_vec( ) ,
854- ) ) ) ,
855- ] ,
856- ) ;
890+ vec ! [
891+ Rc :: new( BodyForm :: Value ( SExp :: Atom (
892+ l. clone( ) ,
893+ "r" . as_bytes( ) . to_vec( ) ,
894+ ) ) ) ,
895+ Rc :: new( BodyForm :: Value ( SExp :: Atom (
896+ l. clone( ) ,
897+ "@" . as_bytes( ) . to_vec( ) ,
898+ ) ) ) ,
899+ ] ,
900+ )
901+ } ) ;
857902
858903 let mut call_args = Vec :: new ( ) ;
859904 call_args. push ( Rc :: new ( BodyForm :: Value ( SExp :: Atom ( l. clone ( ) , defun_name) ) ) ) ;
@@ -878,7 +923,9 @@ fn process_helper_let_bindings(
878923 while i < result. len ( ) {
879924 match result[ i] . clone ( ) {
880925 HelperForm :: Defun ( l, name, inline, args, body) => {
881- let helper_result = hoist_body_let_binding ( compiler, args. clone ( ) , body. clone ( ) ) ;
926+ let context = if ( inline) { Some ( args. clone ( ) ) } else { None } ;
927+ let helper_result =
928+ hoist_body_let_binding ( compiler, context, args. clone ( ) , body. clone ( ) ) ;
882929 let hoisted_helpers = helper_result. 0 ;
883930 let hoisted_body = helper_result. 1 . clone ( ) ;
884931
@@ -909,7 +956,7 @@ fn start_codegen(opts: Rc<dyn CompilerOpts>, comp: CompileForm) -> PrimaryCodege
909956 Some ( c) => c,
910957 } ;
911958
912- let hoisted_bindings = hoist_body_let_binding ( & use_compiler, comp. args . clone ( ) , comp. exp ) ;
959+ let hoisted_bindings = hoist_body_let_binding ( & use_compiler, None , comp. args . clone ( ) , comp. exp ) ;
913960 let mut new_helpers = hoisted_bindings. 0 ;
914961 let expr = hoisted_bindings. 1 ;
915962 new_helpers. append ( & mut comp. helpers . clone ( ) ) ;
@@ -969,14 +1016,11 @@ fn finalize_env_(
9691016 c : & PrimaryCodegen ,
9701017 l : Srcloc ,
9711018 env : Rc < SExp > ,
972- ) -> Result < SExp , CompileErr > {
1019+ ) -> Result < Rc < SExp > , CompileErr > {
9731020 match env. borrow ( ) {
9741021 SExp :: Atom ( l, v) => {
9751022 match c. defuns . get ( v) {
976- Some ( res) => {
977- let res_code_copy: & SExp = res. code . borrow ( ) ;
978- Ok ( res_code_copy. clone ( ) )
979- }
1023+ Some ( res) => Ok ( res. code . clone ( ) ) ,
9801024 None => {
9811025 match c. inlines . get ( v) {
9821026 Some ( res) => replace_in_inline (
@@ -985,18 +1029,14 @@ fn finalize_env_(
9851029 opts. clone ( ) ,
9861030 c,
9871031 l. clone ( ) ,
988- "*main*" . as_bytes ( ) . to_vec ( ) ,
9891032 res,
990- None ,
1033+ & synthesize_args ( res . args . clone ( ) ) ,
9911034 )
992- . map ( |x| {
993- let borrowed_sexp: & SExp = x. 1 . borrow ( ) ;
994- borrowed_sexp. clone ( )
995- } ) ,
1035+ . map ( |x| x. 1 . clone ( ) ) ,
9961036 None => {
9971037 /* Parentfns are functions in progress in the parent */
9981038 if !c. parentfns . get ( v) . is_none ( ) {
999- Ok ( SExp :: Nil ( l. clone ( ) ) )
1039+ Ok ( Rc :: new ( SExp :: Nil ( l. clone ( ) ) ) )
10001040 } else {
10011041 Err ( CompileErr (
10021042 l. clone ( ) ,
@@ -1029,13 +1069,10 @@ fn finalize_env_(
10291069 l. clone ( ) ,
10301070 r. clone ( ) ,
10311071 )
1032- . map ( |r| SExp :: Cons ( l. clone ( ) , Rc :: new ( h. clone ( ) ) , Rc :: new ( r. clone ( ) ) ) )
1072+ . map ( |r| Rc :: new ( SExp :: Cons ( l. clone ( ) , h. clone ( ) , r. clone ( ) ) ) )
10331073 } ) ,
10341074
1035- _ => {
1036- let env_copy: & SExp = env. borrow ( ) ;
1037- Ok ( env_copy. clone ( ) )
1038- }
1075+ _ => Ok ( env. clone ( ) ) ,
10391076 }
10401077}
10411078
@@ -1044,7 +1081,7 @@ fn finalize_env(
10441081 runner : Rc < dyn TRunProgram > ,
10451082 opts : Rc < dyn CompilerOpts > ,
10461083 c : & PrimaryCodegen ,
1047- ) -> Result < SExp , CompileErr > {
1084+ ) -> Result < Rc < SExp > , CompileErr > {
10481085 match c. env . borrow ( ) {
10491086 SExp :: Cons ( l, h, _) => finalize_env_ (
10501087 allocator,
@@ -1054,10 +1091,7 @@ fn finalize_env(
10541091 l. clone ( ) ,
10551092 h. clone ( ) ,
10561093 ) ,
1057- _ => {
1058- let env_copy: & SExp = c. env . borrow ( ) ;
1059- Ok ( env_copy. clone ( ) )
1060- }
1094+ _ => Ok ( c. env . clone ( ) ) ,
10611095 }
10621096}
10631097
@@ -1072,6 +1106,7 @@ fn dummy_functions(compiler: &PrimaryCodegen) -> Result<PrimaryCodegen, CompileE
10721106 HelperForm :: Defun ( _, name, true , args, body) => Ok ( compiler. add_inline (
10731107 name,
10741108 & InlineFunction {
1109+ name : name. clone ( ) ,
10751110 args : args. clone ( ) ,
10761111 body : body. clone ( ) ,
10771112 } ,
@@ -1118,7 +1153,7 @@ pub fn codegen(
11181153 Rc :: new ( primquote ( code. 0 . clone ( ) , code. 1 ) ) ,
11191154 Rc :: new ( primcons (
11201155 code. 0 . clone ( ) ,
1121- Rc :: new ( primquote ( code. 0 . clone ( ) , Rc :: new ( final_env) ) ) ,
1156+ Rc :: new ( primquote ( code. 0 . clone ( ) , final_env) ) ,
11221157 Rc :: new ( SExp :: Integer ( code. 0 . clone ( ) , bi_one ( ) ) ) ,
11231158 ) ) ,
11241159 ) ;
0 commit comments