shithub: martian9

ref: dc596842d658ab664a025d4e98c89b50cac465c4
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
  Types.symbol (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 <-> []";
     * print_endline ("      ph: " ^ ph);
     * print_endline ("      pt: " ^ String.concat "|" pt); *)
    if ph = "_" || ph = Printer.print sym true
    then is_matching_pattern sym pt [] matched && true
    else ph = "..." || List.hd pt = "..."
  | [], ah :: at ->
    (* print_endline "    [] <-> LIST"; *)
    false
  | _, _ -> matched
;;

let rec ellipsis pattern template args =
  let has_ellipsis =
    try
      ignore (Str.search_forward (Str.regexp "...") (Printer.stringify pattern true) 0);
      true
    with
    | Not_found -> false
  in
  let ellipsis_substitutions = ref [] in
  let missing = List.length args - List.length pattern + if has_ellipsis then 1 else 0 in
  print_endline ("missing: " ^ string_of_int missing);
  (* print_endline (" NEED TO ADD " ^ string_of_int missing ^ " PLACEHOLDERS"); *)
  match missing with
  | _ when missing = 0 || missing > 0 ->
    (* add arguments *)
    print_endline ("ADD " ^ string_of_int missing ^ " arguments");
    for i = 1 to missing do
      ellipsis_substitutions := !ellipsis_substitutions @ [ Printer.print (gen_sym "x") true ]
    done;
    let pattern_str =
      Str.global_replace
        (Str.regexp "\\.\\.\\.")
        (String.concat " " !ellipsis_substitutions)
        (Printer.stringify pattern true)
    in
    let template_str =
      Str.global_replace
        (Str.regexp "\\.\\.\\.")
        (String.concat " " !ellipsis_substitutions)
        (Printer.print template true)
    in
    (* let args_str = Printer.stringify args true in *)
    (* print_endline ("ellipsis: template: " ^ template_str ^ "  args: " ^ args_str); *)
    "(" ^ pattern_str ^ ") " ^ template_str ^ ")"
  | _ when missing < 0 ->
    (* remove ellipsis and arg *)
    print_endline "REMOVE arguments";
    (* let rgx = Str.regexp "[a-zA-Z0-9]+ \\.\\.\\." in *)
    let rgx = Str.regexp "[a-zA-Z0-9]+ \\.\\.\\." in
    let pattern_str = Str.global_replace rgx "" (Printer.stringify pattern true) in
    let template_str = Str.global_replace rgx "" (Printer.stringify pattern true) in
    print_endline ("  pattern:  " ^ Printer.dump pattern);
    print_endline ("    pattern_str:  " ^ pattern_str);
    print_endline ("  template: " ^ Printer.print template true);
    print_endline ("    template_str: " ^ template_str);
    print_endline ("(" ^ pattern_str ^ ") " ^ template_str ^ ")");
    "(" ^ pattern_str ^ ") " ^ template_str ^ ")"
  | _ -> "(" ^ Printer.dump pattern ^ ") " ^ Printer.print template true ^ ")"
;;

let rec parse ast macros =
  print_endline ("\n\nREADING MACRO: " ^ String.concat " " ast);
  match ast with
  | [] -> raise End_of_file
  | macro :: tokens -> print_endline ("   macro: " ^ macro)
;;

let generate_variants sym literals patterns =
  let symbol = Printer.print sym true in
  let variants = ref Types.M9map.empty in
  let rec register_variants clauses =
    let new_sym = gen_sym symbol in
    match clauses with
    | [ pattern ] ->
      variants := Types.M9map.add new_sym pattern !variants;
      !variants
    | pattern :: rest ->
      variants := Types.M9map.add new_sym pattern !variants;
      register_variants rest
    | _ -> raise (Utils.Syntax_error "macro pattern registration botch")
  in
  register_variants patterns
;;

let match_variant macro args =
  let vmatch = ref "" in
  (match macro with
  | T.Map { T.value = meta } ->
    (match Types.M9map.find Types.macro_variants meta with
    | T.Map { T.value = variant_list } ->
      Types.M9map.iter
        (fun k v ->
          print_endline (Printer.print k true ^ ": " ^ Printer.print v true);
          match v with
          | T.List { T.value = T.List { T.value = x } :: z } ->
            print_endline
              (" >>>> ["
              ^ string_of_int (List.length args)
              ^ "|"
              ^ string_of_int (List.length x)
              ^ "] "
              ^ Printer.dump x
              ^ " :: "
              ^ Printer.dump z);
            if List.length args = List.length x then vmatch := Printer.print (List.hd x) true
          | _ -> ())
        variant_list
    | _ -> ())
  | _ -> ());
  !vmatch
;;