Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

We’re showing branches in this repository, but you can also compare across forks.

base fork: ljos/sigmatism
base: 6ad5da3a27
...
head fork: ljos/sigmatism
compare: f0af83c389
  • 2 commits
  • 2 files changed
  • 0 commit comments
  • 1 contributor
Showing with 71 additions and 1 deletion.
  1. +1 −1  src/sigmatism/clj/sigmatism.clj
  2. +70 −0 src/sigmatism/hs/sigmatism.hs
2  src/sigmatism/clj/sigmatism.clj 100644 → 100755
View
@@ -1,4 +1,4 @@
-(ns sigmatism.clj.core
+(ns sigmatism.clj.sigmatism
(:refer-clojure :exclude [eval atom assoc not]))
(defn eq [x y]
70 src/sigmatism/hs/sigmatism.hs
View
@@ -0,0 +1,70 @@
+module Sigmatism
+( eval
+ , read
+) where
+
+data Expr = Symbol String
+ | Cons {car :: Expr, cdr :: Expr}
+ | Nil
+ | T
+ deriving(Show, Eq)
+
+eq :: Expr -> Expr -> Expr
+eq Nil Nil = T
+eq (Symbol a) (Symbol b) = if (a == b) then T else Nil
+eq _ _ = Nil
+
+assoc :: Expr -> Expr -> Expr
+assoc a (Cons f s) =
+ if T == eq a (car f) then
+ cdr f
+ else
+ assoc a s
+
+atom (Symbol _) = T
+atom Nil = T
+atom _ = Nil
+
+evcon :: Expr -> Expr -> Expr
+evcon (Cons f s) a =
+ if T == eval (car f) a then
+ eval ((car.cdr) f) a
+ else
+ evcon s a
+
+pair :: Expr -> Expr -> Expr
+pair Nil Nil = Nil
+pair (Cons f r) (Cons h t) =
+ Cons (Cons f (Cons h Nil)) (pair r t)
+
+evlis :: Expr -> Expr -> Expr
+evlis Nil _ = Nil
+evlis (Cons f r) a = Cons (eval f a) (evlis r a)
+
+append :: Expr -> Expr -> Expr
+append Nil y = y
+append (Cons f r) y = Cons f (append r y)
+
+eval :: Expr -> Expr -> Expr
+eval (Symbol s) ns = assoc (Symbol s) ns
+eval (Cons (Symbol s) snd) a
+ | s == "quote" = car snd
+ | s == "atom" = atom $ eval (car snd) a
+ | s == "eq" = eq (eval (car snd) a) (eval ((car.cdr) snd) a)
+ | s == "car" = car $ eval (car snd) a
+ | s == "cdr" = cdr $ eval (car snd) a
+ | s == "cons" = (Cons (eval (car snd) a) (eval ((car.cdr) snd) a))
+ | s == "cond" = evcon snd a
+ | otherwise = eval (Cons (assoc (Symbol s) a) snd) a
+eval (Cons (Cons (Symbol "label") rest) snd) a =
+ let label = (Cons (car rest) (Cons (Cons (Symbol "label") rest) Nil))
+ ns = (Cons label a)
+ expr = ((car.cdr) rest)
+ in
+ eval expr ns
+eval (Cons (Cons (Symbol "lambda") rest) snd) a =
+ let expr = ((car.cdr) rest)
+ pairs = pair (car rest) $ evlis snd a
+ ns = append pairs a
+ in
+ eval expr ns

No commit comments for this range

Something went wrong with that request. Please try again.