shithub: martian9

ref: 284f87648016e19394d52aca2505ef24b50bdbca
dir: /m9.ml/

(*
  Martian Scheme
  Copyright 2020, McKay Marston

  This is a project for me to
    1) Get more familiar with OCaml.
    2) Try to provide a natively supported scheme for Plan9.

  It is heavily inspired by s9fes (http://www.t3x.org/s9fes), and the
  make a lisp project (https://github.com/kanaka/mal)
 *)

module T = Types.Types

module Env = Map.Make (String
(*(struct
  type t = Types.Symbol
  let compare (Types.Symbol a) (Types.Symbol b) = compare a b
  end)*))

(* replace me *)
let num_fun f =
  Types.proc (function
      | [ T.Number a; T.Number b ] -> T.Number (f a b)
      | _ -> raise (Invalid_argument "Expected numeric argument"))
;;

(* replace me *)
let repl_env =
  ref
    (List.fold_left
       (fun a b -> b a)
       Env.empty
       [ Env.add "+" (num_fun ( + ))
       ; Env.add "-" (num_fun ( - ))
       ; Env.add "*" (num_fun ( * ))
       ; Env.add "/" (num_fun ( / ))
       ])
;;

let rec eval_ast ast env =
  match ast with
  | T.Symbol { T.value = s } ->
    (try Env.find s !env with
    | Not_found -> raise (Invalid_argument ("Symbol '" ^ s ^ "' not found")))
  | T.List { T.value = xs; T.meta } ->
    T.List { T.value = List.map (fun x -> eval x env) xs; T.meta }
  | T.Vector { T.value = xs; T.meta } ->
    T.Vector { T.value = List.map (fun x -> eval x env) xs; T.meta }
  | _ -> ast

and eval ast env =
  let result = eval_ast ast env in
  match result with
  | T.List { T.value = T.Proc { T.value = f } :: args } -> f args
  | _ -> result
;;

let nameplate = "Martian9 Scheme v0.1"
let read str = Reader.read_str str
let print exp = Printer.print exp true
let rep str env = print (eval (read str) env)

let rec main =
  try
    print_endline nameplate;
    while true do
      print_string "m9> ";
      let line = read_line () in
      try print_endline (rep line repl_env) with
      | End_of_file -> ()
      | Invalid_argument x ->
        output_string stderr ("Invalid argument: " ^ x ^ "\n");
        flush stderr
    done
  with
  | End_of_file -> ()
;;