shithub: martian9

ref: 64583452c2d9c394432b2490c67ea17875ea65aa
dir: /macro.ml/

module T = Types.Types

(* let gen_sym root =
 *   let gen() = match Random.int(26+26+10) with
 *       n when n < 26 -> int_of_char 'a' + n
 *     | n when n < 26 + 26 -> int_of_char 'A' + n - 26
 *     | n -> int_of_char '0' + n - 26 - 26 in
 *   let gen _ = String.make 1 (char_of_int(gen())) in
 *   root ^ (String.concat "" (Array.to_list (Array.init 5 gen))) *)

let rec is_matching_pattern sym pattern args matched =
  match pattern, args with
  (* literals not handled, yet *)
  | ph :: pt, ah :: at -> print_endline "    LIST <-> LIST";
                          if (ph = "_" || (ph = (Printer.print sym true) && ph = (Printer.print ah true))) then is_matching_pattern sym pt at matched && true else (print_endline " ------> foo"; is_matching_pattern sym pt at matched)
   | ph :: pt, [] -> print_endline "    LIST <-> []";
                     if (ph = "_" || ph = (Printer.print sym true)) then is_matching_pattern sym pt [] matched && true else false
   | [], ah :: at -> print_endline "    [] <-> LIST"; false
   | _, _ -> matched

let lambdaize pattern template args =
  match pattern, args with
  | ph :: pt, ah :: at ->
     Reader.read ("(lambda (" ^ (Printer.stringify pt false) ^ ") (" ^ (Printer.print template true) ^ ")" ^ (Printer.stringify args false) ^ ")")
  | ph :: pt, [] ->
     Reader.read ("((lambda (" ^ (Printer.stringify pt false) ^ ") " ^ (Printer.print template true) ^ "))")
  | _ -> Reader.read ("((lambda () " ^ (Printer.print template true) ^ "))")

let rec expand ast env args sym meta =
  print_endline ("\n\nTHIS IS A MACRO: " ^ Printer.print sym true);
  print_endline ("   META: " ^ Printer.print meta true);
  print_endline ("   ARGS: " ^ Printer.dump args);
  print_endline ("  AST:   " ^ Printer.print ast true);

  match meta with
  | T.Map { T.value = m } ->
    (try
       let literals = Types.M9map.find Types.macro_literals m in
       let transformers = Types.M9map.find Types.macro_transformers m in
       print_endline
         ("  -- EVAL_MACRO: literals: "
         ^ Printer.print literals true
         ^ "     transformers: "
         ^ Printer.print transformers true);
       print_endline ("    args: " ^ Printer.dump args);
       let rec match_transform transforms =
         match transforms with
         | hd :: tl ->
           print_endline ("      transform: " ^ Printer.print hd true);
           (match hd with
           | T.List
               { T.value = [ T.List { T.value = pattern }; T.List { T.value = template } ] }
             ->
             print_endline ("     _ multi pattern: " ^ Printer.dump pattern); match_transform tl
           | T.List { T.value = [ T.List { T.value = pattern }; atom ] } ->
              print_endline ("     _ single pattern: " ^ Printer.dump pattern);
              print_endline ("matched?: " ^ (if is_matching_pattern sym (List.map (fun x -> Printer.print x true) pattern) args true then "yes" else "no"));
              if is_matching_pattern sym (List.map (fun x -> Printer.print x true) pattern) args true
              then atom else match_transform tl
              (* then lambdaize pattern atom args else match_transform tl *)
           | _ -> T.Nil) (* errors? *)
         | [] -> T.Nil
       in
       match_transform (Core.seq transformers)
     with
    | Not_found -> T.Nil)
  | _ -> T.Nil