Git's functional nature (with an encoding in OCaml)

type tree =
  | Blob of blob
  | Tree of string * tree list

let rec substitute old_tree new_tree tree =
  if tree = old_tree then new_tree
  else match tree with
  | Tree (s, tl) ->
      let tl' = List.map (substitute old_tree new_tree) tl in
      if List.for_all2 (==) tl tl' then tree else Tree (s, tl')
  | _ -> tree

(* Since it's just a demonstration of concepts,  we deliberately omit the
    system programming part such as file system interfaces and the
    monitoring/checking of files/directories changes since last commit.
    We only deal with a very small fraction of the basic operations of git,
    though a lot more is possible in this way.
*)

(* blob is the git's jargon for content of a file, it should be encoded with
     more information such as name and verification bits etc. Here we simplify
     it as just a string. The same for the tree definition below.
*)
type blob = string

(* tree is a directory structure with files and subdirs inside *)
type tree =
  | Blob of blob
  | Tree of string * tree list

type commit = { parents: commit list; self: tree; commit_log: string }

type tag = { tag_name: string; point_to: commit; tag_log: string }

type branch = { branch_name: string; mutable last_commit: commit }

type git_repo =
    { mutable head: string;
      mutable branches: branch list;
      mutable tags: tag list }

(* This is a global state, hence not functional. But in practice, git use
    implicitly a git repo located in current directory or its up layers , we
    simulate it here.
*)
let local_repo = { head= ""; branches = []; tags = [] }

(* The state of the current working copy. *)
let local_state = ref (Tree (".", []))

(* Since we omit the system programming part, We don't deal with git's
   "index" and "add" concepts either, otherwise we should have a "local_index"
   variable.
*)

(* Again, this is dangerous, since "master" branch is not yet committed, but
   it simulates git's behavior. *)
let init () = local_repo.head <- "master"

(* helper function *)
let current_branch() =
  List.find (fun r -> r.branch_name = local_repo.head) local_repo.branches

(* This is the key point, in substitute, the generated tree physically shares
    as much data as possible with the input tree.
*)
let rec substitute old_tree new_tree tree =
  if tree = old_tree then new_tree
  else match tree with
  | Tree (s, tl) ->
      let tl' = List.map (substitute old_tree new_tree) tl in
      if List.for_all2 (==) tl tl' then tree else Tree (s, tl')
  | _ -> tree

(* Due to the lack of system programming part, We'll simply say please
    change some [old_tree] part with the [new_tree] part on commit.
    The real arguments can be deduced by comparing the files/directories
    against last commit.
 
    For the sake of code clearness,  we only deal with the cases of changing
    one  sub-tree at a time. Changing multiple sub-trees can be implemented
    with a List.fold of the substitute function.
*)
let commit ?old_tree ?(log = "") new_tree =
  if local_repo.branches = [] then begin
    (* First commit, no branches, no tags yet *)
    assert (local_repo.head = "master");
    assert (local_repo.tags = []);
    let new_commit = { parents = []; self = new_tree; commit_log = log} in
    let new_branch = { branch_name = "master"; last_commit = new_commit } in
    local_repo.branches <- [new_branch]
  end else
    let cur_branch = current_branch() in
    let last = cur_branch.last_commit in
    let new_commit =
      { parents = [last] ;
        self = (match old_tree with
                | None -> new_tree
                | Some tree -> substitute tree new_tree last.self);
        commit_log = log } in
    cur_branch.last_commit <- new_commit

let tag ?(log="") name =
  assert (List.for_all (fun t -> t.tag_name <> name) local_repo.tags);
  let cur_branch = current_branch() in
  let last = cur_branch.last_commit in
  let new_tag = { tag_name = name; point_to = last; tag_log = log } in
  local_repo.tags <- new_tag :: local_repo.tags

let tag_del name =
  local_repo.tags <- List.filter (fun t -> t.tag_name <> name) local_repo.tags

(* Beware, git's actual semantics is a bit complex here. It says you're not on
    any branch when checking out a tag. Anyway, this is simplified.
*)
let tag_checkout name =
  let tag = List.find (fun t -> t.tag_name = name) local_repo.tags in
  local_state := tag.point_to.self;
  local_repo.head <- ""

let branch name =
  assert (List.for_all (fun b -> b.branch_name <> name) local_repo.branches);
  let cur_branch = current_branch() in
  let last = cur_branch.last_commit in
  let new_branch = { branch_name = name; last_commit = last } in
  local_repo.branches <- new_branch :: local_repo.branches

(* When a branch is deleted, the data that exclusively belongs to this branch
    (i.e. not reachable through/shared with other branches/tags) is going to be
    GCed by manually tigger git-gc, and here by OCaml's automatic GC.
*)
let branch_del name =
  assert (local_repo.head <> name);
  local_repo.branches <-
    List.filter (fun b -> b.branch_name <> name) local_repo.branches

let branch_checkout name =
  if local_repo.head <> name then
    let branch = List.find (fun b -> b.branch_name = name) local_repo.branches in
    local_state := branch.last_commit.self;
    local_repo.head <- branch.branch_name