fsharp/core.fs

   1 module Core
   2
   3     open Types
   4
   5     let errArity () = EvalError("arity: wrong number of arguments")
   6     let errArgMismatch () = EvalError("argument mismatch")
   7
   8     let inline toBool b = if b then Node.TRUE else Node.FALSE
   9
  10     let inline twoNumberOp (f : int64 -> int64 -> Node) = function
  11         | [Number(a); Number(b)] -> f a b
  12         | [_; _] -> raise <| errArgMismatch ()
  13         | _ -> raise <| errArity ()
  14
  15     let inline twoNodeOp (f : Node -> Node -> Node) = function
  16         | [a; b] -> f a b
  17         | _ -> raise <| errArity ()
  18
  19     let add = twoNumberOp (fun a b -> a + b |> Number)
  20     let subtract = twoNumberOp (fun a b -> a - b |> Number)
  21     let multiply = twoNumberOp (fun a b -> a * b |> Number)
  22     let divide = twoNumberOp (fun a b -> a / b |> Number)
  23     let lt = twoNodeOp (fun a b -> a < b |> toBool)
  24     let le = twoNodeOp (fun a b -> a <= b |> toBool)
  25     let ge = twoNodeOp (fun a b -> a >= b |> toBool)
  26     let gt = twoNodeOp (fun a b -> a > b |> toBool)
  27     let eq = twoNodeOp (fun a b -> a = b |> toBool)
  28
  29     let list nodes = List(nodes)
  30     let isList = function
  31         | [List(_)] -> Node.TRUE
  32         | [_] -> Node.FALSE
  33         | _ -> raise <| errArity ()
  34
  35     let isEmpty = function
  36         | [List([])] -> Node.TRUE
  37         | [Vector(seg)] when seg.Count <= 0 -> Node.TRUE
  38         | _ -> Node.FALSE
  39
  40     let count = function
  41         | [List(lst)] -> lst |> List.length |> int64 |> Number
  42         | [Vector(seg)] -> seg.Count |> int64 |> Number
  43         | [Nil] -> Node.ZERO
  44         | [_] -> raise <| errArgMismatch ()
  45         | _ -> raise <| errArity ()
  46
  47     let pr_str nodes = nodes |> Printer.pr_str |> String
  48     let str nodes = nodes |> Printer.str |> String
  49     let prn nodes = nodes |> Printer.prn |> printfn "%s"; Nil
  50     let println nodes = nodes |> Printer.println |> printfn "%s"; Nil
  51
  52     let read_str = function
  53         | [String(s)] ->
  54             match Reader.read_str s with
  55             | [node] -> node
  56             | nodes -> List(Symbol("do")::nodes)
  57         | [_] -> raise <| errArgMismatch ()
  58         | _ -> raise <| errArity ()
  59
  60     let slurp = function
  61         | [String(s)] -> System.IO.File.ReadAllText s |> String
  62         | [_] -> raise <| errArgMismatch ()
  63         | _ -> raise <| errArity ()
  64
  65     let cons = function
  66         | [node; List(lst)] -> List(node::lst)
  67         | [node; Vector(seg)] -> List(node::(List.ofSeq seg))
  68         | [_; _] -> raise <| errArgMismatch ()
  69         | _ -> raise <| errArity ()
  70
  71     let concat nodes =
  72         let cons st node = node::st
  73         let accumNode acc = function
  74             | List(lst) -> lst |> List.fold cons acc
  75             | Vector(seg) -> seg |> Seq.fold cons acc
  76             | _ -> raise <| errArgMismatch ()
  77
  78         nodes
  79         |> List.fold accumNode []
  80         |> List.rev
  81         |> List