shithub: martian9

Info  •  Files  •  Log  •  Branches

initial macro work, added (define (x y z)) syntax

--- a/core.ml

+++ b/core.ml

@@ -24,6 +24,15 @@

   | _ -> []

 ;;

+(* this is 'assoc' from mal, but it's not what assoc is in scheme *)

+let rec link = function

+  | c :: k :: v :: (_ :: _ as xs) -> link (link [ c; k; v ] :: xs)

+  | [ T.Nil; k; v ] -> Types.map (Types.M9map.add k v Types.M9map.empty)

+  | [ T.Map { T.value = m; T.meta }; k; v ] ->

+    T.Map { T.value = Types.M9map.add k v m; T.meta }

+  | _ -> T.Nil

+;;

+

 let init env =

   Env.set

     env

--- a/m9.ml

+++ b/m9.ml

@@ -4,10 +4,11 @@

   This is a project for me to

     1) Get more familiar with OCaml.

-    2) Try to provide a natively supported scheme for Plan9.

+    2) Try to provide a natively supported r7rs-small 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)

+  make a lisp project (https://github.com/kanaka/mal - thanks

+  https://github.com/chouser for the fantastic implementation!)

  *)

 module T = Types.Types

@@ -72,26 +73,25 @@

 and eval ast env =

   match ast with

   | T.List { T.value = [] } -> ast

+  | T.List { T.value = [ T.Symbol { T.value = "define" }; T.List { T.value = arg_list }; body ] } ->

+     let sym = List.hd arg_list in

+     let rest = List.tl arg_list in

+     let func = eval (Reader.read ("(lambda (" ^ String.concat " " (List.map (fun x -> Printer.print x false) rest) ^ ") " ^ Printer.print body true ^ ")")) env in

+     Env.set env sym func; func

   | T.List { T.value = [ T.Symbol { T.value = "define" }; key; expr ] } ->

     let value = eval expr env in

     Env.set env key value;

     value

-  | T.List

-      { T.value = [ T.Symbol { T.value = "let" }; T.Vector { T.value = bindings }; body ]

-      }

-  | T.List

-      { T.value = [ T.Symbol { T.value = "let" }; T.List { T.value = bindings }; body ] }

+  | T.List { T.value = [ T.Symbol { T.value = "define-syntax" }; keyword; transformer ] }

     ->

-    let sub_env = Env.make (Some env) in

-    let rec bind_pairs = function

-      | T.List { T.value = [ T.Symbol { T.value = sym }; expr ] } :: more ->

-        let value = eval expr env in

-        Env.set env (Types.symbol sym) value;

-        bind_pairs more

-      | _ -> ()

-    in

-    bind_pairs bindings;

-    eval body sub_env

+    (match eval transformer env with

+    | T.Proc { T.value = p; T.meta } ->

+      let proc =

+        T.Proc { T.value = p; meta = Core.link [ meta; Core.kw_macro; T.Bool true ] }

+      in

+      Env.set env keyword proc;

+      proc

+    | _ -> raise (Reader.Syntax_error "transformer value must be syntax-rules"))

   | T.List

       { T.value =

           [ T.Symbol { T.value = "lambda" }; T.Vector { T.value = arg_names }; expr ]

@@ -104,7 +104,7 @@

         let sub_env = Env.make (Some env) in

         let rec bind_args a b =

           match a, b with

-          | [ T.Symbol { T.value = "&" }; name ], args ->

+          | [ T.Symbol { T.value = "." }; name ], args ->

             Env.set sub_env name (Types.list args)

           | name :: names, arg :: args ->

             Env.set sub_env name arg;

@@ -114,6 +114,22 @@

         in

         bind_args arg_names args;

         eval expr sub_env)

+  | T.List

+      { T.value = [ T.Symbol { T.value = "let" }; T.Vector { T.value = bindings }; body ]

+      }

+  | T.List

+      { T.value = [ T.Symbol { T.value = "let" }; T.List { T.value = bindings }; body ] }

+    ->

+    let sub_env = Env.make (Some env) in

+    let rec bind_pairs = function

+      | T.List { T.value = [ T.Symbol { T.value = sym }; expr ] } :: more ->

+        let value = eval expr env in

+        Env.set env (Types.symbol sym) value;

+        bind_pairs more

+      | _ -> ()

+    in

+    bind_pairs bindings;

+    eval body sub_env

   | T.List { T.value = T.Symbol { T.value = "begin" } :: body } ->

     List.fold_left (fun x expr -> eval expr env) T.Nil body

   | T.List { T.value = [ T.Symbol { T.value = "if" }; cond; then_expr; else_expr ] } ->