Last active
May 9, 2026 06:20
-
-
Save jake-87/f04327194d0a4f0243b321d2a09a4965 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| type t = | |
| | Int of int | |
| | Name of string | |
| | Let of string * t * t | |
| | Add of t * t | |
| | Ref of t option ref | |
| (* iffy *) | |
| let rec pp i x = | |
| print_string (String.make i ' '); | |
| match x with | |
| | Ref r -> begin match !r with | |
| | None -> print_string "ref None" | |
| | Some ml -> pp i ml | |
| end | |
| | Int i -> print_int i | |
| | Name s -> print_string s | |
| | Let(s,a,b) -> | |
| print_string ("let " ^ s ^ " = \n"); | |
| pp (i + 1) a; | |
| print_string " in\n"; | |
| pp i b | |
| | Add(a,b) -> pp i a; | |
| print_string " + "; | |
| pp i b | |
| let rec eval ctx = function | |
| | Ref r -> begin match !r with | |
| | None -> failwith "empty ref" | |
| | Some ml -> eval ctx ml | |
| end | |
| | Int i -> i | |
| | Name n -> List.assoc n ctx | |
| | Let (n, a, b) -> | |
| let k = eval ctx a in | |
| eval ((n,k) :: ctx) b | |
| | Add (a,b) -> | |
| (eval ctx a) + (eval ctx b) | |
| let nm = | |
| let x = ref 0 in | |
| fun () -> | |
| incr x; | |
| "nm" ^ string_of_int !x | |
| (* lots of room for optimization here but this does work *) | |
| let rec go (t : t) : (t * string * t option ref) = | |
| match t with | |
| | Int i -> | |
| let r = ref None in | |
| let nm = nm () in | |
| let ml = Let (nm, Int i, Ref r) in | |
| (ml, nm, r) | |
| | Name n -> | |
| let r = ref None in | |
| let nm = nm () in | |
| let ml = Let (nm, Name n, Ref r) in | |
| (ml, nm, r) | |
| | Let (s, a, b) -> | |
| let (a', anm, ar) = go a in | |
| let (b', bnm, br) = go b in | |
| let ml = Let (s, Name anm, b') in | |
| ar := Some ml; | |
| (a', bnm, br) | |
| | Add (a, b) -> | |
| let (a', anm, ar) = go a in | |
| let (b', bnm, br) = go b in | |
| let r = ref None in | |
| let nm = nm () in | |
| let ml = Let(nm, Add (Name anm, Name bnm), Ref r) in | |
| ar := Some b'; | |
| br := Some ml; | |
| (a', nm, r) | |
| | Ref r -> begin match !r with | |
| | None -> failwith "go none" | |
| | Some s -> | |
| print_endline "go some?"; | |
| go s | |
| end | |
| let example = | |
| Let("x", | |
| Let("y", Int 1, Add (Name "y", Let("z",Int 5,Name "z"))), | |
| Add(Name "x", Int 2) | |
| ) | |
| let () = | |
| pp 0 example; | |
| print_endline "\n\n\n"; | |
| let (conv, nm, r) = go example in | |
| pp 0 conv | |
Author
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Removing unneeded names gives:
which as noted also preserves evaluation order!