shithub: martian9

--- a/core.ml

+++ b/core.ml

@@ -8,12 +8,18 @@

     | _ -> raise (Invalid_argument "not a number") )

 let simple_compare t f =

-  Types.proc (function [T.Number a; T.Number b] -> t (f a b) | _ -> raise (Invalid_argument "incomparable"))

+  Types.proc (function

+    | [T.Number a; T.Number b] -> t (f a b)

+    | _ -> raise (Invalid_argument "incomparable") )

 let mk_num x = Types.number x

 let mk_bool x = T.Bool x

-let seq = function T.List {T.value= xs; meta= _} -> xs | T.Vector {T.value= xs; meta= _} -> xs | _ -> []

+let seq = function

+  | T.List {T.value= xs; meta= _} -> xs

+  | T.Vector {T.value= xs; meta= _} -> xs

+  | _ -> []

 (* 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)

@@ -22,7 +28,10 @@

   | _ -> T.Nil

 let init env =

-  Env.set env (Types.symbol "raise") (Types.proc (function [ast] -> raise (Types.M9exn ast) | _ -> T.Nil)) ;

+  Env.set env (Types.symbol "raise")

+    (Types.proc (function

+      | [ast] -> raise (Types.M9exn ast)

+      | _ -> T.Nil ) ) ;

   Env.set env (Types.symbol "*arguments*")

     (Types.list

        ( if Array.length Sys.argv > 1 then List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv)))

@@ -46,11 +55,20 @@

    *              && Types.to_bool (Types.M9map.find kw_macro meta)))

    *       | [ T.Proc _ ] -> T.Bool true

    *       | _ -> T.Bool false)); *)

-  Env.set env (Types.symbol "number?") (Types.proc (function [T.Number _] -> T.Bool true | _ -> T.Bool false)) ;

+  Env.set env (Types.symbol "number?")

+    (Types.proc (function

+      | [T.Number _] -> T.Bool true

+      | _ -> T.Bool false ) ) ;

   Env.set env (Types.symbol "list") (Types.proc (function xs -> Types.list xs)) ;

-  Env.set env (Types.symbol "list?") (Types.proc (function [T.List _] -> T.Bool true | _ -> T.Bool false)) ;

+  Env.set env (Types.symbol "list?")

+    (Types.proc (function

+      | [T.List _] -> T.Bool true

+      | _ -> T.Bool false ) ) ;

   Env.set env (Types.symbol "vector") (Types.proc (function xs -> Types.vector xs)) ;

-  Env.set env (Types.symbol "vector?") (Types.proc (function [T.Vector _] -> T.Bool true | _ -> T.Bool false)) ;

+  Env.set env (Types.symbol "vector?")

+    (Types.proc (function

+      | [T.Vector _] -> T.Bool true

+      | _ -> T.Bool false ) ) ;

   Env.set env (Types.symbol "empty?")

     (Types.proc (function

       | [T.List {T.value= []; meta= _}] -> T.Bool true

@@ -58,7 +76,8 @@

       | _ -> T.Bool false ) ) ;

   Env.set env (Types.symbol "count")

     (Types.proc (function

-      | [T.List {T.value= xs; meta= _}] | [T.Vector {T.value= xs; meta= _}] ->

+      | [T.List {T.value= xs; meta= _}]

+       |[T.Vector {T.value= xs; meta= _}] ->

           Types.number (float_of_int (List.length xs))

       | _ -> Types.number 0. ) ) ;

   Env.set env (Types.symbol "display")

@@ -67,9 +86,18 @@

          T.Unspecified ) ) ;

   Env.set env (Types.symbol "string")

     (Types.proc (function xs -> T.String (String.concat "" (List.map (fun s -> Printer.print s false) xs)))) ;

-  Env.set env (Types.symbol "read-string") (Types.proc (function [T.String x] -> Reader.read x | _ -> T.Nil)) ;

-  Env.set env (Types.symbol "slurp") (Types.proc (function [T.String x] -> T.String (Reader.slurp x) | _ -> T.Nil)) ;

-  Env.set env (Types.symbol "cons") (Types.proc (function [x; xs] -> Types.list [x; xs] | _ -> T.Nil)) ;

+  Env.set env (Types.symbol "read-string")

+    (Types.proc (function

+      | [T.String x] -> Reader.read x

+      | _ -> T.Nil ) ) ;

+  Env.set env (Types.symbol "slurp")

+    (Types.proc (function

+      | [T.String x] -> T.String (Reader.slurp x)

+      | _ -> T.Nil ) ) ;

+  Env.set env (Types.symbol "cons")

+    (Types.proc (function

+      | [x; xs] -> Types.list [x; xs]

+      | _ -> T.Nil ) ) ;

   Env.set env (Types.symbol "concat")

     (Types.proc

        (let rec concat = function

--- a/env.ml

+++ b/env.ml

@@ -16,7 +16,11 @@

 let rec find env sym =

   match sym with

   | T.Symbol {T.value= key; T.meta= _} -> (

-      if Data.mem key !(env.data) then Some env else match env.outer with Some outer -> find outer sym | None -> None )

+      if Data.mem key !(env.data) then Some env

+      else

+        match env.outer with

+        | Some outer -> find outer sym

+        | None -> None )

   | _ -> raise (Invalid_argument "find: not a symbol")

 let get env sym =

--- a/eval.ml

+++ b/eval.ml

@@ -8,7 +8,8 @@

    |T.Vector

       {T.value= T.List {T.value= [T.Symbol {T.value= "unquote-splicing"; meta= _}; head]; meta= _} :: tail; meta= _} ->

       Types.list [Types.symbol "concat"; head; quasiquote (Types.list tail)]

-  | T.List {T.value= head :: tail; meta= _} | T.Vector {T.value= head :: tail; meta= _} ->

+  | T.List {T.value= head :: tail; meta= _}

+   |T.Vector {T.value= head :: tail; meta= _} ->

       Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail)]

   | ast -> Types.list [Types.symbol "quote"; ast]

--- a/m9.ml

+++ b/m9.ml

@@ -22,7 +22,10 @@

   print_endline nameplate ;

try

     Core.init Core.base ;

-    Env.set repl_env (Types.symbol "eval") (Types.proc (function [ast] -> Eval.eval ast repl_env | _ -> T.Nil)) ;

+    Env.set repl_env (Types.symbol "eval")

+      (Types.proc (function

+        | [ast] -> Eval.eval ast repl_env

+        | _ -> T.Nil ) ) ;

     ignore (rep "(define load-file (lambda (f) (eval (read-string (string \"(begin \" (slurp f) \")\"))))" repl_env) ;

     if Array.length Sys.argv > 1 then print_endline (rep ("(load-file \"" ^ Sys.argv.(1) ^ "\")") repl_env)

     else (

--- a/macro.ml

+++ b/macro.ml

@@ -96,7 +96,9 @@

 let parse ast _ =

   print_endline ("\n\nREADING MACRO: " ^ String.concat " " ast) ;

-  match ast with [] -> raise End_of_file | macro :: _ -> print_endline ("   macro: " ^ macro)

+  match ast with

+  | [] -> raise End_of_file

+  | macro :: _ -> print_endline ("   macro: " ^ macro)

 let hack_ellipsis _ clause =

   let clauses = ref [] in

@@ -158,13 +160,16 @@

   register_variants clauses

 let rec collect_args tokens args =

-  match tokens with [t] -> args @ [t] | t :: ts -> if t = ")" then args else collect_args ts args @ [t] | _ -> []

+  match tokens with

+  | [t] -> args @ [t]

+  | t :: ts -> if t = ")" then args else collect_args ts args @ [t]

+  | _ -> []

 let match_variant original_sym macro args =

   let args = if List.hd args = original_sym then List.tl args else args in

   let vmatch = ref "" in

   (* print_endline (" >>>> match_variant: " ^ Printer.to_string macro) ; *)

-  print_endline (" >>>> match_variant with args: " ^ String.concat " " args);

+  print_endline (" >>>> match_variant with args: " ^ String.concat " " args) ;

   ( match macro with

   | T.Map {T.value= meta; meta= _} -> (

     match Types.M9map.find Types.macro_variants meta with

@@ -174,7 +179,7 @@

             print_endline ("  >>>  " ^ Printer.to_string k ^ ": " ^ Printer.to_string v) ;

             let wrong = Utils.tokenize (Printer.to_string v) in

             ( match wrong with

-            | "(" :: "define" :: sym :: "(" :: "lambda" :: rest ->

+            | "(" :: "define" :: sym :: "(" :: "lambda" :: rest -> (

                 print_endline ("    SYM: " ^ sym ^ "  REST: " ^ String.concat " " rest) ;

                 let new_args = collect_args (List.tl rest) [] in

                 print_endline

@@ -183,12 +188,13 @@

                   ^ "]  args: " ^ String.concat " " args ^ " ["

                   ^ string_of_int (List.length args)

                   ^ "]" ) ;

-                (match (List.length new_args, List.length args) with

-                 | 0, 0

-                   | 1, 1 -> vmatch := sym

-                   | x, y when x = y -> vmatch := sym

-                 | _, _ -> ())

-                (* if List.length new_args = List.length args - 1 then vmatch := sym *)

+                match (List.length new_args, List.length args) with

+                | 0, 0

+                 |1, 1 ->

+                    vmatch := sym

+                | x, y when x = y -> vmatch := sym

+                | _, _ -> ()

+                (* if List.length new_args = List.length args - 1 then vmatch := sym *) )

             | _ -> print_endline "no rest" ) ;

             print_endline ("     >>>> sym: " ^ Printer.to_string k) ;

             print_endline ("     >>>> args: " ^ String.concat " " args) ;

--- a/printer.ml

+++ b/printer.ml

@@ -28,7 +28,14 @@

   | T.Number n -> if Types.is_float n.value then string_of_float n.value else string_of_int (int_of_float n.value)

   | T.Port _ -> "<port unsupported>"

   | T.String s ->

-      if r then "\"" ^ Utils.gsub (Str.regexp "\\([\"\\\n]\\)") (function "\n" -> "\\n" | x -> "\\" ^ x) s ^ "\""

+      if r then

+        "\""

+        ^ Utils.gsub (Str.regexp "\\([\"\\\n]\\)")

+            (function

+              | "\n" -> "\\n"

+              | x -> "\\" ^ x )

+            s

+        ^ "\""

       else s

   | T.List {T.value= xs; T.meta= _} -> "(" ^ stringify xs r ^ ")"

   | T.Vector {T.value= v; T.meta= _} -> "#(" ^ stringify v r ^ ")"

@@ -36,7 +43,14 @@

 and stringify obj human =

   String.concat " "

-    (List.filter (function T.Unspecified | T.Eof_object -> human | _ -> true) obj |> List.map (fun s -> print s human))

+    ( List.filter

+        (function

+          | T.Unspecified

+           |T.Eof_object ->

+              human

+          | _ -> true )

+        obj

+    |> List.map (fun s -> print s human) )

 let dump obj = String.concat " " (List.map (fun s -> print s true) obj)

 let to_string obj = print obj true

--- a/reader.ml

+++ b/reader.ml

@@ -9,7 +9,11 @@

 let unescape_string token =

   if Str.string_match string_re token 0 then

     let without_quotes = String.sub token 1 (String.length token - 2) in

-    Utils.gsub (Str.regexp "\\\\.") (function "\\n" -> "\n" | x -> String.sub x 1 1) without_quotes

+    Utils.gsub (Str.regexp "\\\\.")

+      (function

+        | "\\n" -> "\n"

+        | x -> String.sub x 1 1 )

+      without_quotes

   else raise (Utils.Syntax_error "unterminated string")

 let trim_end list = List.rev (List.tl (List.rev list))

@@ -44,19 +48,29 @@

 let read_atom token =

   match token with

   | "null" -> T.Nil

-  | "#t" | "#true" -> T.Bool true

-  | "#f" | "#false" -> T.Bool false

+  | "#t"

+   |"#true" ->

+      T.Bool true

+  | "#f"

+   |"#false" ->

+      T.Bool false

   | _ -> (

     match token.[0] with

     | '0' .. '9' -> Types.number (float_of_string token)

     | '#' -> (

       match (token.[1], token.[2]) with

-      | '\\', '0' .. '9' | '\\', 'a' .. 'z' | '\\', 'A' .. 'Z' -> T.Char token.[2]

+      | '\\', '0' .. '9'

+       |'\\', 'a' .. 'z'

+       |'\\', 'A' .. 'Z' ->

+          T.Char token.[2]

       | _ -> Types.symbol token )

     | '-' -> (

       match String.length token with

       | 1 -> Types.symbol token

-      | _ -> ( match token.[1] with '0' .. '9' -> Types.number (float_of_string token) | _ -> Types.symbol token ) )

+      | _ -> (

+        match token.[1] with

+        | '0' .. '9' -> Types.number (float_of_string token)

+        | _ -> Types.symbol token ) )

     | '"' -> T.String (unescape_string token)

     | _ -> Types.symbol token )

@@ -164,7 +178,10 @@

     | "(" ->

         let list_reader = read_list ")" {list_form= []; tokens} in

         {form= Types.list list_reader.list_form; tokens= list_reader.tokens}

-    | "" | "\t" | "\n" -> read_form tokens

+    | ""

+     |"\t"

+     |"\n" ->

+        read_form tokens

     | "define-syntax" -> read_form (read_macro tokens)

     | _ ->

         if token.[0] = ';' then (

--- a/types.ml

+++ b/types.ml

@@ -47,7 +47,12 @@

 exception M9exn of Types.t

-let to_bool x = match x with Types.Nil | Types.Bool false -> false | _ -> true

+let to_bool x =

+  match x with

+  | Types.Nil

+   |Types.Bool false ->

+      false

+  | _ -> true

 let is_float v =

   let c = classify_float (fst (Float.modf v)) in

--- a/utils.ml

+++ b/utils.ml

@@ -5,9 +5,20 @@

 (* copied verbatim - must needs grok *)

 let gsub re f str =

-  String.concat "" (List.map (function Str.Delim x -> f x | Str.Text x -> x) (Str.full_split re str))

+  String.concat ""

+    (List.map

+       (function

+         | Str.Delim x -> f x

+         | Str.Text x -> x )

+       (Str.full_split re str) )

 let tokenize str =

   List.map

-    (function Str.Delim x -> String.trim x (* move trim to regex for speed? *) | Str.Text _ -> "tokenize botch")

-    (List.filter (function Str.Delim _ -> true | Str.Text _ -> false) (Str.full_split token_re str))

+    (function

+      | Str.Delim x -> String.trim x (* move trim to regex for speed? *)

+      | Str.Text _ -> "tokenize botch" )

+    (List.filter

+       (function

+         | Str.Delim _ -> true

+         | Str.Text _ -> false )

+       (Str.full_split token_re str) )