on master help sign in
More primitives
commitd1de0f47d77c36d927e7fc412959f2898ff26005 authorDavid Christiansen <david@davidchristiansen.dk> dateThu 2 May 2013, 23:13 (13 years ago) parent93fa7ce
1 file changed+32
src/Core/Execute.hs+32
src/Core/Execute.hs+32
@@ -19,6 +19,7 @@ import Control.Monad.Trans.State.Strict
1919import Control.Monad.Trans.Error
2020import Control.Monad
2121import Data.Maybe
22+import Data.Bits
2223import qualified Data.Map as M
2324
2425import Foreign.LibFFI
@@ -175,6 +176,7 @@ doExec env ctxt p@(P Ref n ty) =
175176 [CaseOp _ _ _ _ _ [] (STerm tm) _ _] -> -- nullary fun
176177 doExec env ctxt tm
177178 [CaseOp _ _ _ _ _ ns sc _ _] -> return (EP Ref n EErased)
179+ [] -> execFail $ "Could not find " ++ show n ++ " in definitions."
178180 thing -> trace (take 200 $ "got to " ++ show thing ++ " lookup up " ++ show n) $ undefined
179181doExec env ctxt p@(P Bound n ty) =
180182 case lookup n env of
@@ -289,36 +291,64 @@ execApp' env ctxt f@(EP _ n _) args =
289291 where getOp :: Name -> [ExecVal] -> Maybe (Exec ExecVal)
290292 getOp (UN "prim__addInt") [EConstant (I i1), EConstant (I i2)] =
291293 primRes I (i1 + i2)
294+ getOp (UN "prim__andInt") [EConstant (I i1), EConstant (I i2)] =
295+ primRes I (i1 .&. i2)
292296 getOp (UN "prim__charToInt") [EConstant (Ch c)] =
293297 primRes I (fromEnum c)
298+ getOp (UN "prim__complInt") [EConstant (I i)] =
299+ primRes I (complement i)
294300 getOp (UN "prim__concat") [EConstant (Str s1), EConstant (Str s2)] =
295301 primRes Str (s1 ++ s2)
302+ getOp (UN "prim__divInt") [EConstant (I i1), EConstant (I i2)] =
303+ primRes I (i1 `div` i2)
296304 getOp (UN "prim__eqChar") [EConstant (Ch c1), EConstant (Ch c2)] =
297305 primResBool (c1 == c2)
298306 getOp (UN "prim__eqInt") [EConstant (I i1), EConstant (I i2)] =
299307 primResBool (i1 == i2)
300308 getOp (UN "prim__eqString") [EConstant (Str s1), EConstant (Str s2)] =
301309 primResBool (s1 == s2)
310+ getOp (UN "prim__gtChar") [EConstant (Ch i1), EConstant (Ch i2)] =
311+ primResBool (i1 > i2)
312+ getOp (UN "prim__gteChar") [EConstant (Ch i1), EConstant (Ch i2)] =
313+ primResBool (i1 >= i2)
314+ getOp (UN "prim__gtInt") [EConstant (I i1), EConstant (I i2)] =
315+ primResBool (i1 > i2)
316+ getOp (UN "prim__gteInt") [EConstant (I i1), EConstant (I i2)] =
317+ primResBool (i1 >= i2)
302318 getOp (UN "prim__intToFloat") [EConstant (I i)] =
303319 primRes Fl (fromRational (toRational i))
304320 getOp (UN "prim__intToStr") [EConstant (I i)] =
305321 primRes Str (show i)
306322 getOp (UN "prim_lenString") [EConstant (Str s)] =
307323 primRes I (length s)
324+ getOp (UN "prim__ltChar") [EConstant (Ch i1), EConstant (Ch i2)] =
325+ primResBool (i1 < i2)
326+ getOp (UN "prim__lteChar") [EConstant (Ch i1), EConstant (Ch i2)] =
327+ primResBool (i1 <= i2)
328+ getOp (UN "prim__lteInt") [EConstant (I i1), EConstant (I i2)] =
329+ primResBool (i1 <= i2)
308330 getOp (UN "prim__ltInt") [EConstant (I i1), EConstant (I i2)] =
309331 primResBool (i1 < i2)
332+ getOp (UN "prim__modInt") [EConstant (I i1), EConstant (I i2)] =
333+ primRes I (i1 `mod` i2)
310334 getOp (UN "prim__mulBigInt") [EConstant (BI i1), EConstant (BI i2)] =
311335 primRes BI (i1 * i2)
312336 getOp (UN "prim__mulFloat") [EConstant (Fl i1), EConstant (Fl i2)] =
313337 primRes Fl (i1 * i2)
314338 getOp (UN "prim__mulInt") [EConstant (I i1), EConstant (I i2)] =
315339 primRes I (i1 * i2)
340+ getOp (UN "prim__orInt") [EConstant (I i1), EConstant (I i2)] =
341+ primRes I (i1 .|. i2)
316342 getOp (UN "prim__readString") [EP _ (UN "prim__stdin") _] =
317343 Just $ do line <- execIO getLine
318344 return (EConstant (Str line))
319345 getOp (UN "prim__readString") [EHandle h] =
320346 Just $ do contents <- execIO $ hGetLine h
321347 return (EConstant (Str contents))
348+ getOp (UN "prim__shLInt") [EConstant (I i1), EConstant (I i2)] =
349+ primRes I (shiftL i1 i2)
350+ getOp (UN "prim__shRInt") [EConstant (I i1), EConstant (I i2)] =
351+ primRes I (shiftR i1 i2)
322352 getOp (UN "prim__strCons") [EConstant (Ch c), EConstant (Str s)] =
323353 primRes Str (c:s)
324354 getOp (UN "prim__strHead") [EConstant (Str (c:s))] =
@@ -331,6 +361,8 @@ execApp' env ctxt f@(EP _ n _) args =
331361 primRes Fl (i1 - i2)
332362 getOp (UN "prim__subInt") [EConstant (I i1), EConstant (I i2)] =
333363 primRes I (i1 - i2)
364+ getOp (UN "prim__xorInt") [EConstant (I i1), EConstant (I i2)] =
365+ primRes I (i1 `xor` i2)
334366 getOp n args = trace ("No prim " ++ show n ++ " for " ++ take 1000 (show args)) Nothing
335367
336368 primRes :: (a -> Const) -> a -> Maybe (Exec ExecVal)