fsharp: stepA: Self host through step3. Need conj to pass step4.

diff --git a/fsharp/core.fs b/fsharp/core.fs
index 0abb11f..f2a6c1d 100644 (file)
--- a/fsharp/core.fs
+++ b/fsharp/core.fs
@@ -207,3 +207,28 @@ module Core
     let contains = mapOp1 containsKey
     let keys = mapKV (fun (k, v) -> k)
     let vals = mapKV (fun (k, v) -> v)
+
+    let atom nextValue = function
+        | [node] -> Atom((nextValue ()), ref node)
+        | _ -> raise <| Error.wrongArity ()
+
+    let deref = function
+        | [Atom(_, r)] -> !r
+        | [_] -> raise <| Error.argMismatch ()
+        | _ -> raise <| Error.wrongArity ()
+
+    let reset = function
+        | [Atom(_, r); node] ->
+            r := node
+            !r
+        | [_; _] -> raise <| Error.argMismatch ()
+        | _ -> raise <| Error.wrongArity ()
+
+    let swap = function
+        | Atom(_, r)
+            ::(BuiltInFunc(_, f) | Func(_, f, _, _, _))
+            ::rest ->
+                r := f (!r::rest)
+                !r
+        | [_; _] -> raise <| Error.argMismatch ()
+        | _ -> raise <| Error.wrongArity ()

diff --git a/fsharp/env.fs b/fsharp/env.fs
index 1310d81..3560544 100644 (file)
--- a/fsharp/env.fs
+++ b/fsharp/env.fs
@@ -87,7 +87,11 @@ module Env
               wrap "get" Core.get
               wrap "contains?" Core.contains
               wrap "keys" Core.keys
-              wrap "vals" Core.vals ]
+              wrap "vals" Core.vals
+              wrap "atom" (Core.atom getNextValue)
+              wrap "deref" Core.deref
+              wrap "reset!" Core.reset
+              wrap "swap!" Core.swap ]
             |> ofList
         [ env ]
 

diff --git a/fsharp/printer.fs b/fsharp/printer.fs
index e4f88cb..39291f7 100644 (file)
--- a/fsharp/printer.fs
+++ b/fsharp/printer.fs
@@ -26,6 +26,7 @@ module Printer
             | BuiltInFunc(tag, _) | Func(tag, _, _, _, _) ->
                 pr_func "func" tag
             | Macro(tag, _, _, _, _) -> pr_func "macro" tag
+            | Atom(tag, r) -> pr_atom tag !r
 
         and pr separator prefix node =
             appendStr prefix
@@ -49,7 +50,12 @@ module Printer
             appendStr "\""
 
         and pr_func ftype tag =
-           sprintf "#<%s %d>" ftype tag |> appendStr
+            sprintf "#<%s %d>" ftype tag |> appendStr
+
+        and pr_atom tag node =
+            appendStr "(atom "
+            pr_node node
+            appendStr ")"
 
         and pr_list nodes =
             appendStr "("

diff --git a/fsharp/types.fs b/fsharp/types.fs
index 06ad6f9..42a3f1e 100644 (file)
--- a/fsharp/types.fs
+++ b/fsharp/types.fs
@@ -14,6 +14,7 @@ module Types
         | BuiltInFunc of int * (Node list -> Node)
         | Func of int * (Node list -> Node) * Node * Node list * EnvChain
         | Macro of int * (Node list -> Node) * Node * Node list * EnvChain
+        | Atom of int * Node Ref
 
         static member private hashSeq (s : seq<Node>) =
             let iter st node = (st * 397) ^^^ node.GetHashCode()
@@ -61,6 +62,7 @@ module Types
             | BuiltInFunc(_, _)
             | Func(_, _, _, _, _)
             | Macro(_, _, _, _, _) -> 9
+            | Atom(_, _) -> 10
 
         static member private equals x y =
             match x, y with
@@ -78,6 +80,7 @@ module Types
             | (BuiltInFunc(a, _) | Func(a, _, _, _, _) | Macro(a, _, _, _, _)),
               (BuiltInFunc(b, _) | Func(b, _, _, _, _) | Macro(b, _, _, _, _)) ->
                 a = b
+            | Atom(a, _), Atom(b, _) -> a = b
             | _, _ -> false
 
         static member private compare x y =
@@ -96,6 +99,7 @@ module Types
             | (BuiltInFunc(a, _) | Func(a, _, _, _, _) | Macro(a, _, _, _, _)),
               (BuiltInFunc(b, _) | Func(b, _, _, _, _) | Macro(b, _, _, _, _)) ->
                 compare a b
+            | Atom(a, _), Atom(b, _) -> compare a b
             | a, b -> compare (Node.rank a) (Node.rank b)
 
         override x.Equals yobj =
@@ -116,6 +120,7 @@ module Types
             | Bool(b) -> hash b
             | BuiltInFunc(tag, _) | Func(tag, _, _, _, _) | Macro(tag, _, _, _, _) ->
                 hash tag
+            | Atom(tag, _) -> hash tag
 
         interface System.IComparable with
             member x.CompareTo yobj =