shithub: martian9

ref: ad64b64a877a8ade76ab155b61931aa2f18a3ee5
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 and ellipses not handled, yet *)
  | ph :: pt, ah :: at ->
    print_endline "    LIST <-> LIST";
    if ph = "_" || (ph = Printer.print sym true && sym = ah)
    then is_matching_pattern sym pt at matched && true
    else (
      print_endline (" ------> " ^ ph ^ " vs " ^ Printer.print ah true);
      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 (List.hd pt = "...")
  | [], ah :: at ->
    print_endline "    [] <-> LIST";
    false
  | _, _ -> matched
;;

let lambdaize pattern template args =
  match pattern, args with
  | ph :: pt, ah :: at :: rest ->
    print_endline "lambdaize: list list";
    Reader.read
      ("((lambda ("
      ^ Printer.stringify pt false
      ^ ") ("
      ^ Printer.print template true
      ^ ")"
      ^ Printer.stringify args false
      ^ "))")
  | ph :: pt, ah :: at ->
     print_endline "lambdaize: list short";
     Reader.read ("((lambda (" ^ Printer.stringify pt true ^ ")"
                  ^ Printer.print template true ^ ")"
                  ^ Printer.stringify args true ^ ")")
  | ph :: pt, [] ->
    print_endline "lambdaize: list empty";
    Reader.read
      ("((lambda ("
      ^ Printer.stringify pt false
      ^ ") "
      ^ Printer.print template true
      ^ "))")
  | _ ->
    print_endline "lambdaize: empty";
    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);
              print_endline ("     - template: " ^ Printer.dump template);
              print_endline
               ("matched?: "
               ^
               if is_matching_pattern
                    sym
                    (List.map (fun x -> Printer.print x true) pattern)
                    (Core.seq ast)
                    true
               then "yes"
               else "no");
             if is_matching_pattern
                  sym
                  (List.map (fun x -> Printer.print x true) pattern)
                  (Core.seq ast)
                  true
             then lambdaize pattern (Types.list template) args
             else 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)
                    (Core.seq ast)
                    true
               then "yes"
               else "no");
             if is_matching_pattern
                  sym
                  (List.map (fun x -> Printer.print x true) pattern)
                  (Core.seq ast)
                  true
             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
;;