implemented the primitive \include

Author: gfngfn

Makefile

@@ -1,3 +1,3 @@
-bin/macrodown.exe : types.ml mcdlexer.mli mcdlexer.ml stacklist.mli stacklist.ml mcdparser.mli mcdparser.ml mcdabs.mli mcdabs.ml assoclist.mli assoclist.ml mcdout.mli mcdout.ml mcdsemantics.mli mcdsemantics.ml mcdmain.ml
-	ocamlc.opt -o bin/macrodown.exe types.ml mcdlexer.mli mcdlexer.ml stacklist.mli stacklist.ml mcdparser.mli mcdparser.ml mcdabs.mli mcdabs.ml assoclist.mli assoclist.ml mcdout.mli mcdout.ml mcdsemantics.mli mcdsemantics.ml mcdmain.ml
+bin/macrodown.exe : types.ml files.ml mcdlexer.mli mcdlexer.ml stacklist.mli stacklist.ml mcdparser.mli mcdparser.ml mcdabs.mli mcdabs.ml assoclist.mli assoclist.ml mcdout.mli mcdout.ml mcdsemantics.mli mcdsemantics.ml mcdmain.ml
+	ocamlc -o bin/macrodown.exe types.ml files.ml mcdlexer.mli mcdlexer.ml stacklist.mli stacklist.ml mcdparser.mli mcdparser.ml mcdabs.mli mcdabs.ml assoclist.mli assoclist.ml mcdout.mli mcdout.ml mcdsemantics.mli mcdsemantics.ml mcdmain.ml
 

files.ml

@@ -0,0 +1,28 @@
+open Types
+
+(* string -> string *)
+let string_of_file_in file_name_in =
+  let str_in = ref "" in
+  let chnl_in = open_in file_name_in in
+  let cat_sub () =
+    while true do
+      str_in := !str_in ^ (String.make 1 (input_char chnl_in))
+    done
+  in
+    try
+      ( cat_sub () ; "" )
+    with
+      End_of_file -> ( close_in chnl_in ; !str_in )
+
+let rec string_of_file_in_list file_name_in_list =
+  match file_name_in_list with
+    [] -> ""
+  | head :: tail ->
+      let str_in = string_of_file_in head in
+        str_in ^ (string_of_file_in_list tail)
+
+(* string -> string -> unit *)
+let file_out_of_string file_name_out content_out =
+  let chnl_out = open_out file_name_out in
+    output_string chnl_out content_out ;
+    close_out chnl_out

mcdmain.ml

@@ -3,39 +3,18 @@ open Types
 let report_error errmsg =
   print_string ("[ERROR IN MAIN] " ^ errmsg) ; print_newline ()
 
-(* string -> string *)
-let string_of_file_in file_name_in =
-  let str_in = ref "" in
-  let chnl_in = open_in file_name_in in
-  let cat_sub () =
-    while true do
-      str_in := !str_in ^ (String.make 1 (input_char chnl_in))
-    done
-  in
-    try
-      ( cat_sub () ; "" )
-    with
-      End_of_file -> ( close_in chnl_in ; !str_in )
-
-let rec string_of_file_in_list file_name_in_list =
-	match file_name_in_list with
-	  [] -> ""
-	| head :: tail ->
-      let str_in =
-        try string_of_file_in head with
-          Sys_error(s) -> report_error ("System error: " ^ s)
-      in
-        str_in ^ (string_of_file_in_list tail)
-
-(* string -> string -> unit *)
-let file_out_of_string file_name_out content_out =
-  let chnl_out = open_out file_name_out in
-    output_string chnl_out content_out ;
-    close_out chnl_out
+let report_detail dtlmsg =
+  print_string dtlmsg ; print_newline ()
 
 let main file_name_in_list file_name_out =
 
-  let content_in = (string_of_file_in_list file_name_in_list) in
+  let content_in = (
+      try Files.string_of_file_in_list file_name_in_list with
+        Sys_error(s) -> (
+            report_error ("System error - " ^ s) ;
+            ""
+          )
+  ) in
   let lexed = Mcdlexer.mcdlex content_in in
   let parsed = Mcdparser.mcdparser lexed in
   let absed = Mcdabs.concrete_to_abstract parsed in
@@ -45,12 +24,12 @@ let main file_name_in_list file_name_out =
       IllegalOut -> ""
   in
     match content_out with
-      "" -> ( print_string "No output." ; print_newline () )
+      "" -> report_detail "No output."
     | _ -> (
           try
-            file_out_of_string file_name_out content_out
+            Files.file_out_of_string file_name_out content_out
           with
-            Sys_error(s) -> report_error ("System error: " ^ s)
+            Sys_error(s) -> report_error ("System error - " ^ s)
         )
 
 let rec concat_list lsta lstb =
@@ -59,14 +38,17 @@ let rec concat_list lsta lstb =
   | head :: tail -> head :: (concat_list tail lstb)
 
 let rec see_argv num file_name_in_list file_name_out =
-    if num == Array.length Sys.argv then
+    if num == Array.length Sys.argv then (
+      report_detail ("[output] " ^ file_name_out) ;
       main file_name_in_list file_name_out
-    else (
-      if (compare Sys.argv.(num) "-o") == 0 then (
-        print_string ("[output] " ^ Sys.argv.(num + 1)) ; print_newline () ;
-        see_argv (num + 2) file_name_in_list (Sys.argv.(num + 1))
-      ) else (
-        print_string ("[input] " ^ Sys.argv.(num)) ; print_newline () ;
+    ) else (
+      if (compare Sys.argv.(num) "-o") == 0 then
+          try (
+            see_argv (num + 2) file_name_in_list (Sys.argv.(num + 1))
+          ) with
+            Invalid_argument(s) -> report_error "missing file name after '-o' option"
+      else (
+        report_detail ("[input] " ^ Sys.argv.(num)) ;
         see_argv (num + 1) (concat_list file_name_in_list [Sys.argv.(num)]) file_name_out
       )
     )

mcdsemantics.ml

@@ -36,6 +36,7 @@
     let loc_replace : macro_location = ref DummyFunc in
     let loc_prefix : macro_location = ref DummyFunc in
     let loc_postfix : macro_location = ref DummyFunc in
+    let loc_include : macro_location = ref DummyFunc in
     let menv_main : macro_environment ref = ref Assoclist.empty in
     let venv_main : var_environment ref = ref Assoclist.empty in
       venv_main := (Assoclist.add "~indent" loc_indent !venv_main) ;
@@ -46,6 +47,7 @@
       menv_main := (Assoclist.add "\\replace" loc_replace !menv_main) ;
       menv_main := (Assoclist.add "\\prefix" loc_prefix !menv_main) ;
       menv_main := (Assoclist.add "\\postfix" loc_postfix !menv_main) ;
+      menv_main := (Assoclist.add "\\include" loc_include !menv_main) ;
       loc_deepen := Func([], DeepenIndent, EmptyAbsBlock, !menv_main, !venv_main) ;
       loc_shallow := Func([], ShallowIndent, EmptyAbsBlock, !menv_main, !venv_main) ;
       loc_ifempty := Func(["~subj"; "~tru"; "~fls"],
@@ -68,6 +70,10 @@
                        PrimitivePostfix(ContentOf("~name"), ContentOf("~postfix")),
                        EmptyAbsBlock, !menv_main, !venv_main
                      ) ;
+      loc_include := Func(["~filename"],
+                       PrimitiveInclude(ContentOf("~filename")),
+                       EmptyAbsBlock, !menv_main, !venv_main
+                     ) ;
       interpret menv_main venv_main abstr
 
   (* (macro_environment ref) -> (var_environment ref) -> abstract_tree -> abstract_tree *)
@@ -144,6 +150,25 @@
             EmptyAbsBlock
         )
 
+    | PrimitiveInclude(abstr_file_name) -> (
+          print_process "$PrimitiveInclude" ;
+          let str_file_name = (
+            try Mcdout.mcdout (interpret menv venv abstr_file_name) with
+              IllegalOut -> ( report_error "illegal argument of \\include" ; "" )
+          ) in
+          let str_content = (
+            try Files.string_of_file_in str_file_name with
+              Sys_error(s) -> (
+                  report_error ("System error at \\include - " ^ s) ;
+                  ""
+                )
+          ) in
+          let lexed_content = Mcdlexer.mcdlex str_content in
+          let parsed_content = Mcdparser.mcdparser lexed_content in
+          let absed_content = Mcdabs.concrete_to_abstract parsed_content in
+            interpret menv venv absed_content
+        )
+
     | DeepenIndent -> (
           print_process "$DeepenIndent" ;
           (
@@ -258,7 +283,7 @@
                       ref (Assoclist.add_list var_list loc_list cont_venv_f)
                     with
                       IncorrespondenceOfLength -> (
-                          report_error "wrong number of arguments" ;
+                          report_error ("wrong number of arguments for '" ^ f ^ "'") ;
                           ref cont_venv_f
                         )
                   in
@@ -291,7 +316,7 @@
                       ref (Assoclist.add "@id" loc_id (Assoclist.add_list var_list loc_list cont_venv_f))
                     with
                       IncorrespondenceOfLength -> (
-                          report_error "wrong number of argument" ;
+                          report_error ("wrong number of arguments for '" ^ f ^ "'") ;
                           ref cont_venv_f
                         )
                   in

types.ml

@@ -43,6 +43,7 @@ type abstract_tree = EmptyAbsBlock
                    | PrimitiveReplace of abstract_tree * abstract_tree * abstract_tree
                    | PrimitivePrefix of abstract_tree * abstract_tree
                    | PrimitivePostfix of abstract_tree * abstract_tree
+                   | PrimitiveInclude of abstract_tree
                    | LiteralBlock of literal_name * abstract_tree
                    | OutputOfLiteral of letter