Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
  • 2 commits
  • 2 files changed
  • 0 comments
  • 1 contributor
2  src/sigmatism/clj/sigmatism.clj 100644 → 100755
... ... @@ -1,4 +1,4 @@
1   -(ns sigmatism.clj.core
  1 +(ns sigmatism.clj.sigmatism
2 2 (:refer-clojure :exclude [eval atom assoc not]))
3 3
4 4 (defn eq [x y]
70 src/sigmatism/hs/sigmatism.hs
... ... @@ -0,0 +1,70 @@
  1 +module Sigmatism
  2 +( eval
  3 + , read
  4 +) where
  5 +
  6 +data Expr = Symbol String
  7 + | Cons {car :: Expr, cdr :: Expr}
  8 + | Nil
  9 + | T
  10 + deriving(Show, Eq)
  11 +
  12 +eq :: Expr -> Expr -> Expr
  13 +eq Nil Nil = T
  14 +eq (Symbol a) (Symbol b) = if (a == b) then T else Nil
  15 +eq _ _ = Nil
  16 +
  17 +assoc :: Expr -> Expr -> Expr
  18 +assoc a (Cons f s) =
  19 + if T == eq a (car f) then
  20 + cdr f
  21 + else
  22 + assoc a s
  23 +
  24 +atom (Symbol _) = T
  25 +atom Nil = T
  26 +atom _ = Nil
  27 +
  28 +evcon :: Expr -> Expr -> Expr
  29 +evcon (Cons f s) a =
  30 + if T == eval (car f) a then
  31 + eval ((car.cdr) f) a
  32 + else
  33 + evcon s a
  34 +
  35 +pair :: Expr -> Expr -> Expr
  36 +pair Nil Nil = Nil
  37 +pair (Cons f r) (Cons h t) =
  38 + Cons (Cons f (Cons h Nil)) (pair r t)
  39 +
  40 +evlis :: Expr -> Expr -> Expr
  41 +evlis Nil _ = Nil
  42 +evlis (Cons f r) a = Cons (eval f a) (evlis r a)
  43 +
  44 +append :: Expr -> Expr -> Expr
  45 +append Nil y = y
  46 +append (Cons f r) y = Cons f (append r y)
  47 +
  48 +eval :: Expr -> Expr -> Expr
  49 +eval (Symbol s) ns = assoc (Symbol s) ns
  50 +eval (Cons (Symbol s) snd) a
  51 + | s == "quote" = car snd
  52 + | s == "atom" = atom $ eval (car snd) a
  53 + | s == "eq" = eq (eval (car snd) a) (eval ((car.cdr) snd) a)
  54 + | s == "car" = car $ eval (car snd) a
  55 + | s == "cdr" = cdr $ eval (car snd) a
  56 + | s == "cons" = (Cons (eval (car snd) a) (eval ((car.cdr) snd) a))
  57 + | s == "cond" = evcon snd a
  58 + | otherwise = eval (Cons (assoc (Symbol s) a) snd) a
  59 +eval (Cons (Cons (Symbol "label") rest) snd) a =
  60 + let label = (Cons (car rest) (Cons (Cons (Symbol "label") rest) Nil))
  61 + ns = (Cons label a)
  62 + expr = ((car.cdr) rest)
  63 + in
  64 + eval expr ns
  65 +eval (Cons (Cons (Symbol "lambda") rest) snd) a =
  66 + let expr = ((car.cdr) rest)
  67 + pairs = pair (car rest) $ evlis snd a
  68 + ns = append pairs a
  69 + in
  70 + eval expr ns

No commit comments for this range

Something went wrong with that request. Please try again.