From 06624f3183f4d773cf1023cabe2e370ebba5dee1 Mon Sep 17 00:00:00 2001 From: Rose Hogenson Date: Fri, 16 May 2025 08:24:59 -0700 Subject: Use code generation for printing the AST --- generate-show-syntax.sml | 66 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 generate-show-syntax.sml (limited to 'generate-show-syntax.sml') diff --git a/generate-show-syntax.sml b/generate-show-syntax.sml new file mode 100644 index 0000000..7e7e38a --- /dev/null +++ b/generate-show-syntax.sml @@ -0,0 +1,66 @@ +use "Result.sml"; +use "Map.sml"; +use "Syntax.sml"; +use "Parser.sml"; +use "Opts.sml"; + +val header = + "fun intToStringI (_ : string) (i : int) : string = Int.toString i\n" + ^ "\n" + ^ "fun varToStringI (_ : string) (v : Syntax.var) : string = \"Var \" ^ Int.toString v\n" + ^ "\n" + ^ "fun stringToStringI (_ : string) (s : string) : string = \"\\\"\" ^ String.toString s ^ \"\\\"\"\n" + ^ "\n" + ^ "fun optionToString (_ : string -> 'a -> string) (_ : string) NONE : string = \"NONE\"\n" + ^ " | optionToString show indent (SOME x) = \"SOME (\" ^ show indent x ^ \")\"\n" + ^ "\n" + ^ "fun listToString (_ : string -> 'a -> string) (_ : string) ([] : 'a list) : string = \"[]\"\n" + ^ " | listToString show indent [x] = \"[\" ^ show indent x ^ \"]\"\n" + ^ " | listToString show indent xs =\n" + ^ " let val indent' = indent ^ \" \" in\n" + ^ " \"[\\n\" ^ indent' ^ String.concatWith (\",\\n\" ^ indent') (map (show indent') xs) ^ \"\\n\" ^ indent ^ \"]\"\n" + ^ " end\n" + +fun showTy (Syntax.Tyvar var) : string = var ^ "ToStringI" + | showTy (Syntax.Tycon ([ty], con)) = con ^ "ToString (" ^ showTy ty ^ ")" + | showTy (Syntax.TyTuple tys) = + let val vars = List.tabulate (length tys, fn i => "x" ^ Int.toString i) + in + "(fn indent => fn (" ^ String.concatWith ", " vars ^ ") => let val indent' = indent ^ \" \" in \"(\\n\" ^ indent' ^ " ^ String.concatWith " ^ \",\\n\" ^ indent' ^ " (map (fn (var, ty) => showTy ty ^ " indent' " ^ var) (ListPair.zip (vars, tys))) ^ " ^ \"\\n\" ^ indent ^ \")\" end)" + end + | showTy _ = "(fn _ => fn _ => \"UNHANDLED\")" + +val opts = { o = ref "/dev/stdout" } +val flags = + [ ("o", Opts.StringOpt (fn arg => #o opts := arg)) ] +val filename = + case Opts.getOpt flags (CommandLine.arguments ()) of + [arg] => arg + | _ => raise Fail "usage: showsyntax " +val ast = + case Parser.parse filename of + Result.Left e => raise Fail e + | Result.Right x => x +val (structName, decls) = + case ast of + Syntax.ELet (Syntax.DStruct str :: _, _) => str + | _ => raise Fail "ast has unexpected format (I can't print it sorry)" +val out = TextIO.openOut (!(#o opts)) +val _ = TextIO.output (out, "(*\n This file was generated by generate-show-syntax.sml. Do not edit manually.\n To regenerate, use\n\n sml generate-show-syntax.sml -o " ^ !(#o opts) ^ " " ^ filename ^ "\n*)\n\n") +val _ = TextIO.output (out, "structure Show" ^ structName ^ " = struct\n") +val _ = TextIO.output (out, header) +val _ = map + (fn (i, Syntax.DDatatype (typeName, cases)) => ( + TextIO.output (out, + "\n" ^ (if i = 0 then "fun" else "and") ^ " " + ^ String.concatWith "\n | " (map + (fn (caseName, NONE) => typeName ^ "ToStringI (indent : string) (" ^ structName ^ "." ^ caseName ^ " : " ^ structName ^ "." ^ typeName ^ ") : string =\n \"" ^ caseName ^ "\"" + | (caseName, SOME ty) => typeName ^ "ToStringI (indent : string) (" ^ structName ^ "." ^ caseName ^ " x : " ^ structName ^ "." ^ typeName ^ ") : string =\n \"" ^ caseName ^ " \" ^ " ^ showTy ty ^ " indent x") + cases) + ^ "\n"); + TextIO.output (out, "and " ^ typeName ^ "ToString (x : " ^ structName ^ "." ^ typeName ^ ") : string = " ^ typeName ^ "ToStringI \"\" x\n") + ) + | _ => ()) + (ListPair.zip (List.tabulate (length decls, fn i => i), decls)) +val _ = TextIO.output(out, "end\n") +val _ = OS.Process.exit OS.Process.success -- cgit v1.3.1