From 0fb92f60da58db424036b4ec9973d0c9f693cecb Mon Sep 17 00:00:00 2001
From: hellerve <veit@veitheller.de>
Date: Mon, 22 May 2017 18:52:00 -0400
Subject: [PATCH] all: added primitives

---
 src/BC/Eval.hs       |  5 +++++
 src/BC/Parse.hs      |  2 +-
 src/BC/Primitives.hs | 26 ++++++++++++++++++++++++++
 src/BC/State.hs      |  3 ++-
 src/BC/Types.hs      |  1 +
 5 files changed, 35 insertions(+), 2 deletions(-)
 create mode 100644 src/BC/Primitives.hs

diff --git a/src/BC/Eval.hs b/src/BC/Eval.hs
index 9d390c0..aab993b 100644
--- a/src/BC/Eval.hs
+++ b/src/BC/Eval.hs
@@ -51,6 +51,7 @@ eval state [BBraced vals] = eval state vals
 eval state [BCall (BSym name) args] =
     case M.lookup name state of
       Just val@BFun{} -> funCall state val args
+      Just val@BNative{} -> funCall state val args
       Nothing -> (BErr ("function " ++ name ++ " is undefined"), state)
       _ -> (BErr (name ++ " is not a function"), state)
 eval state [] = (BSym "", state)
@@ -134,3 +135,7 @@ funCall state (BFun name args body) provided =
         callWith state (a:args) (p:provided) =
           let (evald, nstate) = eval state p
           in callWith (M.insert a evald nstate) args provided
+-- TODO: fix state forgetfulness
+funCall state (BNative body) provided =
+    let args = map (fst . (eval state)) provided
+    in (body args, state)
diff --git a/src/BC/Parse.hs b/src/BC/Parse.hs
index 8ed077c..36e6d06 100644
--- a/src/BC/Parse.hs
+++ b/src/BC/Parse.hs
@@ -35,7 +35,7 @@ float = do
       Just "-" -> return $ construct ("-" ++ x ++ "." ++ y)
       _        -> return $ construct (x ++ "." ++ y)
         -- do a little dance
-  where construct str = BNum $ BFloat $ fromRational $ realToFrac $ (read str::Double)
+  where construct str = BNum $ BFloat $ fromRational $ realToFrac (read str::Double)
 
 
 integer :: P.Parser Value
diff --git a/src/BC/Primitives.hs b/src/BC/Primitives.hs
new file mode 100644
index 0000000..04810ad
--- /dev/null
+++ b/src/BC/Primitives.hs
@@ -0,0 +1,26 @@
+module BC.Primitives where
+
+import BC.Types
+
+primitives :: [(String, Value)]
+primitives = map valuize primitivesList
+  where valuize (x, y) = (x, BNative y)
+
+
+primitivesList :: [(String, [Value] -> Value)]
+primitivesList = [ ("cos", pcos)
+                 , ("sqrt", psqrt)
+                 ]
+
+
+psqrt :: [Value] -> Value
+psqrt [BNum (BInt x)] = BNum $ BFloat $ sqrt $ fromIntegral x
+psqrt [BNum (BFloat x)] = BNum $ BFloat $ sqrt x
+psqrt [x] = BErr $ "Expected argument to be a number, got " ++ show x
+
+
+pcos :: [Value] -> Value
+pcos [BNum (BInt x)] = BNum $ BFloat $ cos $ fromIntegral x
+pcos [BNum (BFloat x)] = BNum $ BFloat $ cos x
+pcos [x] = BErr $ "Expected argument to be a number, got " ++ show x
+
diff --git a/src/BC/State.hs b/src/BC/State.hs
index fadb0dd..a3e6764 100644
--- a/src/BC/State.hs
+++ b/src/BC/State.hs
@@ -2,9 +2,10 @@ module BC.State where
 
 import Data.HashMap
 
+import BC.Primitives
 import BC.Types
 
 type State = Map String Value
 
 newState :: State
-newState = empty
+newState = fromList primitives
diff --git a/src/BC/Types.hs b/src/BC/Types.hs
index d47ba17..8523635 100644
--- a/src/BC/Types.hs
+++ b/src/BC/Types.hs
@@ -35,6 +35,7 @@ instance Show Value where
   show (BSym  o) = o
   show (BNum n) = show n
   show (BErr e) = "error: " ++ e
+  show (BNative _) = "native"
 
 
 -- sorry, this is a little hacky