Interpret ns

src/ludus/interpreter.clj

@@ -33,14 +33,14 @@
     (= 0 (:length pattern) (dec (count value))) {:success true :ctx {}}
 
     :else (let [members (:members pattern)]
-            (loop [i (:length pattern)
-                   ctx {}]
-              (if (= 0 i)
-                {:success true :ctx ctx}
-                (let [match? (match (nth members (dec i)) (nth value i) ctx-atom)]
-                  (if (:success match?)
-                    (recur (dec i) (merge ctx (:ctx match?)))
-                    {:success false :reason (str "Could not match " pattern " with " value)})))))))
+      (loop [i (:length pattern)
+       ctx {}]
+       (if (= 0 i)
+        {:success true :ctx ctx}
+        (let [match? (match (nth members (dec i)) (nth value i) ctx-atom)]
+          (if (:success match?)
+            (recur (dec i) (merge ctx (:ctx match?)))
+            {:success false :reason (str "Could not match " pattern " with " value)})))))))
 
 (defn- match [pattern value ctx-atom]
   (let [ctx @ctx-atom]
@@ -71,10 +71,10 @@
 ;; TODO: get typed exceptions to distinguish panics
 (defn- interpret-let [ast ctx]
   (let [pattern (:pattern ast)
-        expr (:expr ast)
-        value (interpret-ast expr ctx)
-        match (match pattern value ctx)
-        success (:success match)]
+    expr (:expr ast)
+    value (interpret-ast expr ctx)
+    match (match pattern value ctx)
+    success (:success match)]
     (if success
       (swap! ctx update-ctx (:ctx match))
       (throw (ex-info (:reason match) {})))
@@ -82,32 +82,32 @@
 
 (defn- interpret-if [ast ctx]
   (let [if-expr (:if ast)
-        then-expr (:then ast)
-        else-expr (:else ast)
-        if-value (interpret-ast if-expr ctx)]
+    then-expr (:then ast)
+    else-expr (:else ast)
+    if-value (interpret-ast if-expr ctx)]
     (if if-value
       (interpret-ast then-expr ctx)
       (interpret-ast else-expr ctx))))
 
 (defn- interpret-match [ast ctx]
   (let [match-expr (:expr ast)
-        expr (interpret-ast match-expr ctx)
-        clauses (:clauses ast)]
+    expr (interpret-ast match-expr ctx)
+    clauses (:clauses ast)]
     (loop [clause (first clauses)
-           clauses (rest clauses)]
-      (if clause
-        (let [pattern (:pattern clause)
-              body (:body clause)
-              new-ctx (atom {::parent ctx})
-              match? (match pattern expr new-ctx)
-              success (:success match?)
-              clause-ctx (:ctx match?)]
-          (if success
-            (do
-              (swap! new-ctx #(merge % clause-ctx))
-              (interpret-ast body new-ctx))
-            (recur (first clauses) (rest clauses))))
-        (throw (ex-info "Match Error: No match found" {}))))))
+     clauses (rest clauses)]
+     (if clause
+      (let [pattern (:pattern clause)
+        body (:body clause)
+        new-ctx (atom {::parent ctx})
+        match? (match pattern expr new-ctx)
+        success (:success match?)
+        clause-ctx (:ctx match?)]
+        (if success
+          (do
+            (swap! new-ctx #(merge % clause-ctx))
+            (interpret-ast body new-ctx))
+          (recur (first clauses) (rest clauses))))
+      (throw (ex-info "Match Error: No match found" {}))))))
 
 (defn- interpret-cond [ast ctx]
   (let [clauses (:clauses ast)]
@@ -131,7 +131,7 @@
   (if (not (= 1 (:length tuple)))
     (throw (ex-info "Called keywords must be unary" {}))
     (let [kw (interpret-ast kw ctx)
-          map (second (interpret-ast tuple ctx))]
+      map (second (interpret-ast tuple ctx))]
       (if (::data/struct map)
         (if (contains? map kw)
           (kw map)
@@ -143,45 +143,45 @@
   (cond
     (= ::data/partial (first tuple))
     {::data/type ::data/clj
-       :name (str (:name lfn) "{partial}")
-       :body (fn [arg] 
-        (call-fn 
-          lfn 
-          (concat [::data/tuple] (replace {::data/placeholder arg} (rest tuple))) 
-          ctx))}
+     :name (str (:name lfn) "{partial}")
+     :body (fn [arg] 
+      (call-fn 
+        lfn 
+        (concat [::data/tuple] (replace {::data/placeholder arg} (rest tuple))) 
+        ctx))}
 
-    (= (::data/type lfn) ::data/clj) (apply (:body lfn) (next tuple))
+     (= (::data/type lfn) ::data/clj) (apply (:body lfn) (next tuple))
 
-    (= (::data/type lfn) ::data/fn)
-        (let [clauses (:clauses lfn)]
+     (= (::data/type lfn) ::data/fn)
+     (let [clauses (:clauses lfn)]
       (loop [clause (first clauses)
-             clauses (rest clauses)]
-        (if clause
-          (let [pattern (:pattern clause)
-                body (:body clause)
-                new-ctx (atom {::parent ctx})
-                match? (match pattern tuple new-ctx)
-                success (:success match?)
-                clause-ctx (:ctx match?)]
-            (if success
-              (do
-                (swap! new-ctx #(merge % clause-ctx))
-                (interpret-ast body new-ctx))
-              (recur (first clauses) (rest clauses))))
+       clauses (rest clauses)]
+       (if clause
+        (let [pattern (:pattern clause)
+          body (:body clause)
+          new-ctx (atom {::parent ctx})
+          match? (match pattern tuple new-ctx)
+          success (:success match?)
+          clause-ctx (:ctx match?)]
+          (if success
+            (do
+              (swap! new-ctx #(merge % clause-ctx))
+              (interpret-ast body new-ctx))
+            (recur (first clauses) (rest clauses))))
 
-          (throw (ex-info "Match Error: No match found" {:fn-name (:name lfn)})))))
+        (throw (ex-info "Match Error: No match found" {:fn-name (:name lfn)})))))
 
-    (= clojure.lang.Keyword (type lfn))
-    (if (= 2 (count tuple))
-        (let [target (second tuple) kw lfn]
-          (if (::data/struct target)
-            (if (contains? target kw)
-              (kw target)
-              (throw (ex-info (str "Struct error: no member at " kw) {})))
-            (kw target)))
-        (throw (ex-info "Called keywords take a single argument" {})))
+     (= clojure.lang.Keyword (type lfn))
+     (if (= 2 (count tuple))
+      (let [target (second tuple) kw lfn]
+        (if (::data/struct target)
+          (if (contains? target kw)
+            (kw target)
+            (throw (ex-info (str "Struct error: no member at " kw) {})))
+          (kw target)))
+      (throw (ex-info "Called keywords take a single argument" {})))
 
-    :else (throw (ex-info "I don't know how to call that" {:fn lfn}))))
+     :else (throw (ex-info "I don't know how to call that" {:fn lfn}))))
 
 ;; TODO: add placeholder partial application
 (defn- interpret-synthetic-term [prev-value curr ctx]
@@ -196,25 +196,25 @@
 
 (defn- interpret-synthetic [ast ctx]
   (let [terms (:terms ast)
-        first (first terms)
-        second (second terms)
-        rest (rest (rest terms))
-        first-term-type (::ast/type first)
-        first-val (if (= first-term-type ::ast/atom)
-                    (interpret-called-kw first second ctx)
-                    (interpret-synthetic-term (interpret-ast first ctx) second ctx))]
+    first (first terms)
+    second (second terms)
+    rest (rest (rest terms))
+    first-term-type (::ast/type first)
+    first-val (if (= first-term-type ::ast/atom)
+      (interpret-called-kw first second ctx)
+      (interpret-synthetic-term (interpret-ast first ctx) second ctx))]
     (reduce #(interpret-synthetic-term %1 %2 ctx) first-val rest)))
 
 (defn- interpret-fn [ast ctx]
   (let [name (:name ast)
-        clauses (:clauses ast)]
+    clauses (:clauses ast)]
     (if (= name ::ast/anon)
       {::data/type ::data/fn
        :name name
        :clauses clauses}
-      (let [fn {::data/type ::data/fn
-                :name name
-                :clauses clauses}]
+       (let [fn {::data/type ::data/fn
+        :name name
+        :clauses clauses}]
         (if (contains? @ctx name)
           (throw (ex-info (str "Name " name " is already bound") {}))
           (do
@@ -223,21 +223,34 @@
 
 (defn- interpret-do [ast ctx]
   (let [exprs (:exprs ast)
-        origin (interpret-ast (first exprs) ctx)
-        fns (rest exprs)]
+    origin (interpret-ast (first exprs) ctx)
+    fns (rest exprs)]
     (reduce #(call-fn (interpret-ast %2 ctx) [::data/tuple %1] ctx) origin fns)))
 
 (defn- map-values [f]
   (map (fn [kv]
-         (let [[k v] kv]
-           [k (f v)]))))
+   (let [[k v] kv]
+     [k (f v)]))))
+
+(defn- interpret-ns [ast ctx]
+  (let [members (:members ast) 
+        name (:name ast)]
+    (if (contains? @ctx name)
+      (throw (ex-info (str "ns name " name "is already bound") {}))
+      (let [ns (into
+        {::data/struct true ::data/type ::data/ns ::data/name name}
+        (map-values #(interpret-ast % ctx))
+        members)]
+      (do
+        (swap! ctx update-ctx {name ns})
+        ns)))))
 
 (defn interpret-ast [ast ctx]
   (case (::ast/type ast)
 
     ::ast/atom (:value ast)
 
-    ::ast/word (resolve-word(:word ast) ctx)
+    ::ast/word (resolve-word (:word ast) ctx)
 
     ::ast/let (interpret-let ast ctx)
 
@@ -255,19 +268,21 @@
 
     ::ast/placeholder ::data/placeholder
 
+    ::ast/ns (interpret-ns ast ctx)
+
     ::ast/block
     (let [exprs (:exprs ast)
-          inner (pop exprs)
-          last (peek exprs)
-          ctx (atom {::parent ctx})]
+      inner (pop exprs)
+      last (peek exprs)
+      ctx (atom {::parent ctx})]
       (run! #(interpret-ast % ctx) inner)
       (interpret-ast last ctx))
 
     ::ast/script
     (let [exprs (:exprs ast)
-          inner (pop exprs)
-          last (peek exprs)
-          ctx (atom prelude/prelude)]
+      inner (pop exprs)
+      last (peek exprs)
+      ctx (atom prelude/prelude)]
       (run! #(interpret-ast % ctx) inner)
       (interpret-ast last ctx))
 
@@ -313,7 +328,13 @@
       else -> :oops
     }
 
-	")
+    ns bar {
+      foo
+    }
+
+    bar :foo
+
+    ")
 
   (println "")
   (println "****************************************")
@@ -335,7 +356,7 @@
   * refactor calling keywords
   * refactor accessing structs vs. hashes
 
-")
+  ")