@@ -32,6 +32,10 @@ import Foreign.Ptr
3232
3333import System.IO
3434
35+readMay :: (Read a) => String -> Maybe a
36+readMay s = case reads s of
37+ [(x, "")] -> Just x
38+ _ -> Nothing
3539
3640data Lazy = Delayed ExecEnv Context Term | Forced ExecVal deriving Show
3741
@@ -304,89 +308,6 @@ execApp' env ctxt f@(EP _ n _) args =
304308 do res <- execCase env ctxt ns sc args
305309 return $ fromMaybe (mkEApp f args) res
306310 thing -> return $ mkEApp f args
307− where getOp :: Name -> [ExecVal] -> Maybe (Exec ExecVal)
308− getOp (UN "prim__addInt") [EConstant (I i1), EConstant (I i2)] =
309− primRes I (i1 + i2)
310− getOp (UN "prim__andInt") [EConstant (I i1), EConstant (I i2)] =
311− primRes I (i1 .&. i2)
312− getOp (UN "prim__charToInt") [EConstant (Ch c)] =
313− primRes I (fromEnum c)
314− getOp (UN "prim__complInt") [EConstant (I i)] =
315− primRes I (complement i)
316− getOp (UN "prim__concat") [EConstant (Str s1), EConstant (Str s2)] =
317− primRes Str (s1 ++ s2)
318− getOp (UN "prim__divInt") [EConstant (I i1), EConstant (I i2)] =
319− primRes I (i1 `div` i2)
320− getOp (UN "prim__eqChar") [EConstant (Ch c1), EConstant (Ch c2)] =
321− primResBool (c1 == c2)
322− getOp (UN "prim__eqInt") [EConstant (I i1), EConstant (I i2)] =
323− primResBool (i1 == i2)
324− getOp (UN "prim__eqString") [EConstant (Str s1), EConstant (Str s2)] =
325− primResBool (s1 == s2)
326− getOp (UN "prim__gtChar") [EConstant (Ch i1), EConstant (Ch i2)] =
327− primResBool (i1 > i2)
328− getOp (UN "prim__gteChar") [EConstant (Ch i1), EConstant (Ch i2)] =
329− primResBool (i1 >= i2)
330− getOp (UN "prim__gtInt") [EConstant (I i1), EConstant (I i2)] =
331− primResBool (i1 > i2)
332− getOp (UN "prim__gteInt") [EConstant (I i1), EConstant (I i2)] =
333− primResBool (i1 >= i2)
334− getOp (UN "prim__intToFloat") [EConstant (I i)] =
335− primRes Fl (fromRational (toRational i))
336− getOp (UN "prim__intToStr") [EConstant (I i)] =
337− primRes Str (show i)
338− getOp (UN "prim_lenString") [EConstant (Str s)] =
339− primRes I (length s)
340− getOp (UN "prim__ltChar") [EConstant (Ch i1), EConstant (Ch i2)] =
341− primResBool (i1 < i2)
342− getOp (UN "prim__lteChar") [EConstant (Ch i1), EConstant (Ch i2)] =
343− primResBool (i1 <= i2)
344− getOp (UN "prim__lteInt") [EConstant (I i1), EConstant (I i2)] =
345− primResBool (i1 <= i2)
346− getOp (UN "prim__ltInt") [EConstant (I i1), EConstant (I i2)] =
347− primResBool (i1 < i2)
348− getOp (UN "prim__modInt") [EConstant (I i1), EConstant (I i2)] =
349− primRes I (i1 `mod` i2)
350− getOp (UN "prim__mulBigInt") [EConstant (BI i1), EConstant (BI i2)] =
351− primRes BI (i1 * i2)
352− getOp (UN "prim__mulFloat") [EConstant (Fl i1), EConstant (Fl i2)] =
353− primRes Fl (i1 * i2)
354− getOp (UN "prim__mulInt") [EConstant (I i1), EConstant (I i2)] =
355− primRes I (i1 * i2)
356− getOp (UN "prim__orInt") [EConstant (I i1), EConstant (I i2)] =
357− primRes I (i1 .|. i2)
358− getOp (UN "prim__readString") [EP _ (UN "prim__stdin") _] =
359− Just $ do line <- execIO getLine
360− return (EConstant (Str line))
361− getOp (UN "prim__readString") [EHandle h] =
362− Just $ do contents <- execIO $ hGetLine h
363− return (EConstant (Str (contents ++ "\n")))
364− getOp (UN "prim__shLInt") [EConstant (I i1), EConstant (I i2)] =
365− primRes I (shiftL i1 i2)
366− getOp (UN "prim__shRInt") [EConstant (I i1), EConstant (I i2)] =
367− primRes I (shiftR i1 i2)
368− getOp (UN "prim__strCons") [EConstant (Ch c), EConstant (Str s)] =
369− primRes Str (c:s)
370− getOp (UN "prim__strHead") [EConstant (Str (c:s))] =
371− primRes Ch c
372− getOp (UN "prim__strRev") [EConstant (Str s)] =
373− primRes Str (reverse s)
374− getOp (UN "prim__strTail") [EConstant (Str (c:s))] =
375− primRes Str s
376− getOp (UN "prim__subFloat") [EConstant (Fl i1), EConstant (Fl i2)] =
377− primRes Fl (i1 - i2)
378− getOp (UN "prim__subInt") [EConstant (I i1), EConstant (I i2)] =
379− primRes I (i1 - i2)
380− getOp (UN "prim__xorInt") [EConstant (I i1), EConstant (I i2)] =
381− primRes I (i1 `xor` i2)
382− getOp n args = trace ("No prim " ++ show n ++ " for " ++ take 1000 (show args)) Nothing
383−
384− primRes :: (a -> Const) -> a -> Maybe (Exec ExecVal)
385− primRes constr = Just . return . EConstant . constr
386−
387− primResBool :: Bool -> Maybe (Exec ExecVal)
388− primResBool b = primRes I (if b then 1 else 0)
389−
390311execApp' env ctxt bnd@(EBind n b body) (arg:args) = do ret <- body arg
391312 let (f', as) = unApplyV ret
392313 execApp' env ctxt f' (as ++ args)
@@ -396,6 +317,490 @@ execApp' env ctxt app@(EApp _ _) args2 | (f, args1) <- unApplyV app = execApp' e
396317execApp' env ctxt f args = return (mkEApp f args)
397318
398319
320+getOp :: Name -> [ExecVal] -> Maybe (Exec ExecVal)
321+getOp (UN "prim__addB16") [EConstant (B16 i1), EConstant (B16 i2)] =
322+ primRes B16 (i1 + i2)
323+getOp (UN "prim__addB32") [EConstant (B32 i1), EConstant (B32 i2)] =
324+ primRes B32 (i1 + i2)
325+getOp (UN "prim__addB64") [EConstant (B64 i1), EConstant (B64 i2)] =
326+ primRes B64 (i1 + i2)
327+getOp (UN "prim__addB8") [EConstant (B8 i1), EConstant (B8 i2)] =
328+ primRes B8 (i1 + i2)
329+getOp (UN "prim__addBigInt") [EConstant (BI i1), EConstant (BI i2)] =
330+ primRes BI (i1 + i2)
331+getOp (UN "prim__addFloat") [EConstant (Fl f1), EConstant (Fl f2)] =
332+ primRes Fl (f1 + f2)
333+getOp (UN "prim__addInt") [EConstant (I i1), EConstant (I i2)] =
334+ primRes I (i1 + i2)
335+getOp (UN "prim__andB16") [EConstant (B16 i1), EConstant (B16 i2)] =
336+ primRes B16 (i1 .&. i2)
337+getOp (UN "prim__andB32") [EConstant (B32 i1), EConstant (B32 i2)] =
338+ primRes B32 (i1 .&. i2)
339+getOp (UN "prim__andB64") [EConstant (B64 i1), EConstant (B64 i2)] =
340+ primRes B64 (i1 .&. i2)
341+getOp (UN "prim__andB8") [EConstant (B8 i1), EConstant (B8 i2)] =
342+ primRes B8 (i1 .&. i2)
343+getOp (UN "prim__andBigInt") [EConstant (BI i1), EConstant (BI i2)] =
344+ primRes BI (i1 .&. i2)
345+getOp (UN "prim__andInt") [EConstant (I i1), EConstant (I i2)] =
346+ primRes I (i1 .&. i2)
347+getOp (UN "prim__ashrB16") [EConstant (B16 i1), EConstant (B16 i2)] =
348+ primRes B16 (shiftR i1 (fromIntegral i2))
349+getOp (UN "prim__ashrB32") [EConstant (B32 i1), EConstant (B32 i2)] =
350+ primRes B32 (shiftR i1 (fromIntegral i2))
351+getOp (UN "prim__ashrB64") [EConstant (B64 i1), EConstant (B64 i2)] =
352+ primRes B64 (shiftR i1 (fromIntegral i2))
353+getOp (UN "prim__ashrB8") [EConstant (B8 i1), EConstant (B8 i2)] =
354+ primRes B8 (shiftR i1 (fromIntegral i2))
355+getOp (UN "prim__ashrBigInt") [EConstant (BI i1), EConstant (BI i2)] =
356+ primRes BI (shiftR i1 (fromIntegral i2))
357+getOp (UN "prim__ashrInt") [EConstant (I i1), EConstant (I i2)] =
358+ primRes I (shiftR i1 i2)
359+getOp (UN "prim__believe_me") [_, _, arg] = Just (return arg)
360+getOp (UN "prim__charToInt") [EConstant (Ch c)] =
361+ primRes I (fromEnum c)
362+getOp (UN "prim__complB16") [EConstant (B16 i)] =
363+ primRes B16 (complement i)
364+getOp (UN "prim__complB32") [EConstant (B32 i)] =
365+ primRes B32 (complement i)
366+getOp (UN "prim__complB64") [EConstant (B64 i)] =
367+ primRes B64 (complement i)
368+getOp (UN "prim__complB8") [EConstant (B8 i)] =
369+ primRes B8 (complement i)
370+getOp (UN "prim__complBigInt") [EConstant (BI i)] =
371+ primRes BI (complement i)
372+getOp (UN "prim__complInt") [EConstant (I i)] =
373+ primRes I (complement i)
374+getOp (UN "prim__concat") [EConstant (Str s1), EConstant (Str s2)] =
375+ primRes Str (s1 ++ s2)
376+getOp (UN "prim__divFloat") [EConstant (Fl f1), EConstant (Fl f2)] =
377+ primRes Fl (f1 / f2)
378+getOp (UN "prim__divInt") [EConstant (I i1), EConstant (I i2)] =
379+ primRes I (i1 `div` i2)
380+getOp (UN "prim__eqB16") [EConstant (B16 i1), EConstant (B16 i2)] =
381+ primResBool (i1 == i2)
382+getOp (UN "prim__eqB32") [EConstant (B32 i1), EConstant (B32 i2)] =
383+ primResBool (i1 == i2)
384+getOp (UN "prim__eqB64") [EConstant (B64 i1), EConstant (B64 i2)] =
385+ primResBool (i1 == i2)
386+getOp (UN "prim__eqB8") [EConstant (B8 i1), EConstant (B8 i2)] =
387+ primResBool (i1 == i2)
388+getOp (UN "prim__eqBigInt") [EConstant (BI i1), EConstant (BI i2)] =
389+ primResBool (i1 == i2)
390+getOp (UN "prim__eqChar") [EConstant (Ch c1), EConstant (Ch c2)] =
391+ primResBool (c1 == c2)
392+getOp (UN "prim__eqFloat") [EConstant (Fl i1), EConstant (Fl i2)] =
393+ primResBool (i1 == i2)
394+getOp (UN "prim__eqInt") [EConstant (I i1), EConstant (I i2)] =
395+ primResBool (i1 == i2)
396+getOp (UN "prim__eqString") [EConstant (Str s1), EConstant (Str s2)] =
397+ primResBool (s1 == s2)
398+getOp (UN "prim__floatACos") [EConstant (Fl f)] =
399+ primRes Fl (acos f)
400+getOp (UN "prim__floatASin") [EConstant (Fl f)] =
401+ primRes Fl (asin f)
402+getOp (UN "prim__floatATan") [EConstant (Fl f)] =
403+ primRes Fl (atan f)
404+getOp (UN "prim__floatCeil") [EConstant (Fl f)] =
405+ primRes Fl (fromIntegral (ceiling f))
406+getOp (UN "prim__floatCos") [EConstant (Fl f)] =
407+ primRes Fl (cos f)
408+getOp (UN "prim__floatExp") [EConstant (Fl f)] =
409+ primRes Fl (exp f)
410+getOp (UN "prim__floatFloor") [EConstant (Fl f)] =
411+ primRes Fl (fromIntegral (floor f))
412+getOp (UN "prim__floatLog") [EConstant (Fl f)] =
413+ primRes Fl (log f)
414+getOp (UN "prim__floatSin") [EConstant (Fl f)] =
415+ primRes Fl (sin f)
416+getOp (UN "prim__floatSqrt") [EConstant (Fl f)] =
417+ primRes Fl (sqrt f)
418+getOp (UN "prim__floatTan") [EConstant (Fl f)] =
419+ primRes Fl (tan f)
420+getOp (UN "prim__floatToStr") [EConstant (Fl f)] =
421+ primRes Str (show f)
422+getOp (UN "prim__fromFloatB16") [EConstant (Fl f)] =
423+ primRes B16 (fromIntegral (fromEnum f))
424+getOp (UN "prim__fromFloatB32") [EConstant (Fl f)] =
425+ primRes B32 (fromIntegral (fromEnum f))
426+getOp (UN "prim__fromFloatB64") [EConstant (Fl f)] =
427+ primRes B64 (fromIntegral (fromEnum f))
428+getOp (UN "prim__fromFloatB8") [EConstant (Fl f)] =
429+ primRes B8 (fromIntegral (fromEnum f))
430+getOp (UN "prim__fromFloatBigInt") [EConstant (Fl f)] =
431+ primRes BI (fromIntegral (fromEnum f))
432+getOp (UN "prim__fromFloatInt") [EConstant (Fl f)] =
433+ primRes I (fromEnum f)
434+getOp (UN "prim__fromStrB16") [EConstant (Str s)] =
435+ primRes B16 (fromMaybe 0 $ readMay s)
436+getOp (UN "prim__fromStrB32") [EConstant (Str s)] =
437+ primRes B32 (fromMaybe 0 $ readMay s)
438+getOp (UN "prim__fromStrB64") [EConstant (Str s)] =
439+ primRes B64 (fromMaybe 0 $ readMay s)
440+getOp (UN "prim__fromStrB8") [EConstant (Str s)] =
441+ primRes B8 (fromMaybe 0 $ readMay s)
442+getOp (UN "prim__fromStrBigInt") [EConstant (Str s)] =
443+ primRes BI (fromMaybe 0 $ readMay s)
444+getOp (UN "prim__fromStrInt") [EConstant (Str s)] =
445+ primRes I (fromMaybe 0 $ readMay s)
446+getOp (UN "prim__gtB16") [EConstant (B16 x), EConstant (B16 y)] =
447+ primResBool (x > y)
448+getOp (UN "prim__gtB32") [EConstant (B32 x), EConstant (B32 y)] =
449+ primResBool (x > y)
450+getOp (UN "prim__gtB64") [EConstant (B64 x), EConstant (B64 y)] =
451+ primResBool (x > y)
452+getOp (UN "prim__gtB8") [EConstant (B8 x), EConstant (B8 y)] =
453+ primResBool (x > y)
454+getOp (UN "prim__gtBigInt") [EConstant (BI x), EConstant (BI y)] =
455+ primResBool (x > y)
456+getOp (UN "prim__gtChar") [EConstant (Ch x), EConstant (Ch y)] =
457+ primResBool (x > y)
458+getOp (UN "prim__gtFloat") [EConstant (Fl x), EConstant (Fl y)] =
459+ primResBool (x > y)
460+getOp (UN "prim__gtInt") [EConstant (I x), EConstant (I y)] =
461+ primResBool (x > y)
462+getOp (UN "prim__gteB16") [EConstant (B16 x), EConstant (B16 y)] =
463+ primResBool (x >= y)
464+getOp (UN "prim__gteB32") [EConstant (B32 x), EConstant (B32 y)] =
465+ primResBool (x >= y)
466+getOp (UN "prim__gteB64") [EConstant (B64 x), EConstant (B64 y)] =
467+ primResBool (x >= y)
468+getOp (UN "prim__gteB8") [EConstant (B8 x), EConstant (B8 y)] =
469+ primResBool (x >= y)
470+getOp (UN "prim__gteBigInt") [EConstant (BI x), EConstant (BI y)] =
471+ primResBool (x >= y)
472+getOp (UN "prim__gteChar") [EConstant (Ch x), EConstant (Ch y)] =
473+ primResBool (x >= y)
474+getOp (UN "prim__gteFloat") [EConstant (Fl x), EConstant (Fl y)] =
475+ primResBool (x >= y)
476+getOp (UN "prim__gteInt") [EConstant (I x), EConstant (I y)] =
477+ primResBool (x >= y)
478+getOp (UN "prim__intToChar") [EConstant (I i)] =
479+ primRes Ch (toEnum i)
480+getOp (UN "prim__intToFloat") [EConstant (I i)] =
481+ primRes Fl (fromRational (toRational i))
482+getOp (UN "prim__intToStr") [EConstant (I i)] =
483+ primRes Str (show i)
484+getOp (UN "prim_lenString") [EConstant (Str s)] =
485+ primRes I (length s)
486+getOp (UN "prim__lshrB16") [EConstant (B16 i1), EConstant (B16 i2)] =
487+ primRes B16 (shiftR i1 (fromIntegral i2))
488+getOp (UN "prim__lshrB32") [EConstant (B32 i1), EConstant (B32 i2)] =
489+ primRes B32 (shiftR i1 (fromIntegral i2))
490+getOp (UN "prim__lshrB64") [EConstant (B64 i1), EConstant (B64 i2)] =
491+ primRes B64 (shiftR i1 (fromIntegral i2))
492+getOp (UN "prim__lshrB8") [EConstant (B8 i1), EConstant (B8 i2)] =
493+ primRes B8 (shiftR i1 (fromIntegral i2))
494+getOp (UN "prim__lshrBigInt") [EConstant (BI i1), EConstant (BI i2)] =
495+ primRes BI (shiftR i1 (fromIntegral i2))
496+getOp (UN "prim__lshrInt") [EConstant (I i1), EConstant (I i2)] =
497+ primRes I (shiftR i1 i2)
498+getOp (UN "prim__ltB16") [EConstant (B16 x), EConstant (B16 y)] =
499+ primResBool (x < y)
500+getOp (UN "prim__ltB32") [EConstant (B32 x), EConstant (B32 y)] =
501+ primResBool (x < y)
502+getOp (UN "prim__ltB64") [EConstant (B64 x), EConstant (B64 y)] =
503+ primResBool (x < y)
504+getOp (UN "prim__ltB8") [EConstant (B8 x), EConstant (B8 y)] =
505+ primResBool (x < y)
506+getOp (UN "prim__ltBigInt") [EConstant (BI x), EConstant (BI y)] =
507+ primResBool (x < y)
508+getOp (UN "prim__ltChar") [EConstant (Ch x), EConstant (Ch y)] =
509+ primResBool (x < y)
510+getOp (UN "prim__ltFloat") [EConstant (Fl x), EConstant (Fl y)] =
511+ primResBool (x < y)
512+getOp (UN "prim__ltInt") [EConstant (I x), EConstant (I y)] =
513+ primResBool (x < y)
514+getOp (UN "prim__lteB16") [EConstant (B16 x), EConstant (B16 y)] =
515+ primResBool (x <= y)
516+getOp (UN "prim__lteB32") [EConstant (B32 x), EConstant (B32 y)] =
517+ primResBool (x <= y)
518+getOp (UN "prim__lteB64") [EConstant (B64 x), EConstant (B64 y)] =
519+ primResBool (x <= y)
520+getOp (UN "prim__lteB8") [EConstant (B8 x), EConstant (B8 y)] =
521+ primResBool (x <= y)
522+getOp (UN "prim__lteBigInt") [EConstant (BI x), EConstant (BI y)] =
523+ primResBool (x <= y)
524+getOp (UN "prim__lteChar") [EConstant (Ch x), EConstant (Ch y)] =
525+ primResBool (x <= y)
526+getOp (UN "prim__lteFloat") [EConstant (Fl x), EConstant (Fl y)] =
527+ primResBool (x <= y)
528+getOp (UN "prim__lteInt") [EConstant (I x), EConstant (I y)] =
529+ primResBool (x <= y)
530+getOp (UN "prim__modInt") [EConstant (I i1), EConstant (I i2)] =
531+ primRes I (i1 `mod` i2)
532+getOp (UN "prim__mulB16") [EConstant (B16 i1), EConstant (B16 i2)] =
533+ primRes B16 (i1 * i2)
534+getOp (UN "prim__mulB32") [EConstant (B32 i1), EConstant (B32 i2)] =
535+ primRes B32 (i1 * i2)
536+getOp (UN "prim__mulB64") [EConstant (B64 i1), EConstant (B64 i2)] =
537+ primRes B64 (i1 * i2)
538+getOp (UN "prim__mulB8") [EConstant (B8 i1), EConstant (B8 i2)] =
539+ primRes B8 (i1 * i2)
540+getOp (UN "prim__mulBigInt") [EConstant (BI i1), EConstant (BI i2)] =
541+ primRes BI (i1 * i2)
542+getOp (UN "prim__mulFloat") [EConstant (Fl i1), EConstant (Fl i2)] =
543+ primRes Fl (i1 * i2)
544+getOp (UN "prim__mulInt") [EConstant (I i1), EConstant (I i2)] =
545+ primRes I (i1 * i2)
546+getOp (UN "prim__orB16") [EConstant (B16 i1), EConstant (B16 i2)] =
547+ primRes B16 (i1 .|. i2)
548+getOp (UN "prim__orB32") [EConstant (B32 i1), EConstant (B32 i2)] =
549+ primRes B32 (i1 .|. i2)
550+getOp (UN "prim__orB64") [EConstant (B64 i1), EConstant (B64 i2)] =
551+ primRes B64 (i1 .|. i2)
552+getOp (UN "prim__orB8") [EConstant (B8 i1), EConstant (B8 i2)] =
553+ primRes B8 (i1 .|. i2)
554+getOp (UN "prim__orBigInt") [EConstant (BI i1), EConstant (BI i2)] =
555+ primRes BI (i1 .|. i2)
556+getOp (UN "prim__orInt") [EConstant (I i1), EConstant (I i2)] =
557+ primRes I (i1 .|. i2)
558+getOp (UN "prim__readString") [EP _ (UN "prim__stdin") _] =
559+ Just $ do line <- execIO getLine
560+ return (EConstant (Str line))
561+getOp (UN "prim__readString") [EHandle h] =
562+ Just $ do contents <- execIO $ hGetLine h
563+ return (EConstant (Str (contents ++ "\n")))
564+getOp (UN "prim__sdivB16") [EConstant (B16 i1), EConstant (B16 i2)] =
565+ primRes B16 (i1 `div` i2)
566+getOp (UN "prim__sdivB32") [EConstant (B32 i1), EConstant (B32 i2)] =
567+ primRes B32 (i1 `div` i2)
568+getOp (UN "prim__sdivB64") [EConstant (B64 i1), EConstant (B64 i2)] =
569+ primRes B64 (i1 `div` i2)
570+getOp (UN "prim__sdivB8") [EConstant (B8 i1), EConstant (B8 i2)] =
571+ primRes B8 (i1 `div` i2)
572+getOp (UN "prim__sdivBigInt") [EConstant (BI i1), EConstant (BI i2)] =
573+ primRes BI (i1 `div` i2)
574+getOp (UN "prim__sdivInt") [EConstant (I i1), EConstant (I i2)] =
575+ primRes I (i1 `div` i2)
576+getOp (UN "prim__sextB16_B32") [EConstant (B16 i)] =
577+ primRes B32 (fromIntegral i)
578+getOp (UN "prim__sextB16_B64") [EConstant (B16 i)] =
579+ primRes B64 (fromIntegral i)
580+getOp (UN "prim__sextB16_BigInt") [EConstant (B16 i)] =
581+ primRes BI (fromIntegral i)
582+getOp (UN "prim__sextB16_Int") [EConstant (B16 i)] =
583+ primRes I (fromIntegral i)
584+getOp (UN "prim__sextB32_B64") [EConstant (B32 i)] =
585+ primRes B64 (fromIntegral i)
586+getOp (UN "prim__sextB32_BigInt") [EConstant (B32 i)] =
587+ primRes BI (fromIntegral i)
588+getOp (UN "prim__sextB32_Int") [EConstant (B32 i)] =
589+ primRes I (fromIntegral i)
590+getOp (UN "prim__sextB64_BigInt") [EConstant (B64 i)] =
591+ primRes BI (fromIntegral i)
592+getOp (UN "prim__sextB8_B16") [EConstant (B8 i)] =
593+ primRes B16 (fromIntegral i)
594+getOp (UN "prim__sextB8_B32") [EConstant (B8 i)] =
595+ primRes B32 (fromIntegral i)
596+getOp (UN "prim__sextB8_B64") [EConstant (B8 i)] =
597+ primRes B64 (fromIntegral i)
598+getOp (UN "prim__sextB8_BigInt") [EConstant (B8 i)] =
599+ primRes BI (fromIntegral i)
600+getOp (UN "prim__sextB8_Int") [EConstant (B8 i)] =
601+ primRes I (fromIntegral i)
602+getOp (UN "prim__sextInt_B16") [EConstant (I i)] =
603+ primRes B16 (fromIntegral i)
604+getOp (UN "prim__sextInt_B32") [EConstant (I i)] =
605+ primRes B32 (fromIntegral i)
606+getOp (UN "prim__sextInt_B64") [EConstant (I i)] =
607+ primRes B64 (fromIntegral i)
608+getOp (UN "prim__sextInt_BigInt") [EConstant (I i)] =
609+ primRes BI (fromIntegral i)
610+getOp (UN "prim__shlB16") [EConstant (B16 i1), EConstant (B16 i2)] =
611+ primRes B16 (shiftL i1 (fromIntegral i2))
612+getOp (UN "prim__shlB32") [EConstant (B32 i1), EConstant (B32 i2)] =
613+ primRes B32 (shiftL i1 (fromIntegral i2))
614+getOp (UN "prim__shlB64") [EConstant (B64 i1), EConstant (B64 i2)] =
615+ primRes B64 (shiftL i1 (fromIntegral i2))
616+getOp (UN "prim__shlB8") [EConstant (B8 i1), EConstant (B8 i2)] =
617+ primRes B8 (shiftL i1 (fromIntegral i2))
618+getOp (UN "prim__shlBigInt") [EConstant (BI i1), EConstant (BI i2)] =
619+ primRes BI (shiftL i1 (fromIntegral i2))
620+getOp (UN "prim__shlInt") [EConstant (I i1), EConstant (I i2)] =
621+ primRes I (shiftL i1 i2)
622+getOp (UN "prim__sremB16") [EConstant (B16 i1), EConstant (B16 i2)] =
623+ primRes B16 (rem i1 i2)
624+getOp (UN "prim__sremB32") [EConstant (B32 i1), EConstant (B32 i2)] =
625+ primRes B32 (rem i1 i2)
626+getOp (UN "prim__sremB64") [EConstant (B64 i1), EConstant (B64 i2)] =
627+ primRes B64 (rem i1 i2)
628+getOp (UN "prim__sremB8") [EConstant (B8 i1), EConstant (B8 i2)] =
629+ primRes B8 (rem i1 i2)
630+getOp (UN "prim__sremBigInt") [EConstant (BI i1), EConstant (BI i2)] =
631+ primRes BI (rem i1 i2)
632+getOp (UN "prim__sremInt") [EConstant (I i1), EConstant (I i2)] =
633+ primRes I (rem i1 i2)
634+-- No definition for prim__stdin because the IO operations special-case it instead
635+getOp (UN "prim__strCons") [EConstant (Ch c), EConstant (Str s)] =
636+ primRes Str (c:s)
637+getOp (UN "prim__strHead") [EConstant (Str (c:s))] =
638+ primRes Ch c
639+getOp (UN "prim__strIndex") [EConstant (Str s), EConstant (I i)]
640+ | i >= 0 && i < length s = primRes Ch (s !! i)
641+getOp (UN "prim__strRev") [EConstant (Str s)] =
642+ primRes Str (reverse s)
643+getOp (UN "prim__strTail") [EConstant (Str (c:s))] =
644+ primRes Str s
645+getOp (UN "prim__strToFloat") [EConstant (Str s)] =
646+ primRes Fl (fromMaybe 0.0 $ readMay s)
647+getOp (UN "prim__subB16") [EConstant (B16 i1), EConstant (B16 i2)] =
648+ primRes B16 (i1 - i2)
649+getOp (UN "prim__subB32") [EConstant (B32 i1), EConstant (B32 i2)] =
650+ primRes B32 (i1 - i2)
651+getOp (UN "prim__subB64") [EConstant (B64 i1), EConstant (B64 i2)] =
652+ primRes B64 (i1 - i2)
653+getOp (UN "prim__subB8") [EConstant (B8 i1), EConstant (B8 i2)] =
654+ primRes B8 (i1 - i2)
655+getOp (UN "prim__subBigInt") [EConstant (BI i1), EConstant (BI i2)] =
656+ primRes BI (i1 - i2)
657+getOp (UN "prim__subFloat") [EConstant (Fl i1), EConstant (Fl i2)] =
658+ primRes Fl (i1 - i2)
659+getOp (UN "prim__subInt") [EConstant (I i1), EConstant (I i2)] =
660+ primRes I (i1 - i2)
661+getOp (UN "prim__toFloatB16") [EConstant (B16 i)] =
662+ primRes Fl (fromIntegral i)
663+getOp (UN "prim__toFloatB32") [EConstant (B32 i)] =
664+ primRes Fl (fromIntegral i)
665+getOp (UN "prim__toFloatB64") [EConstant (B64 i)] =
666+ primRes Fl (fromIntegral i)
667+getOp (UN "prim__toFloatB8") [EConstant (B8 i)] =
668+ primRes Fl (fromIntegral i)
669+getOp (UN "prim__toFloatBigInt") [EConstant (BI i)] =
670+ primRes Fl (fromIntegral i)
671+getOp (UN "prim__toFloatInt") [EConstant (I i)] =
672+ primRes Fl (fromIntegral i)
673+getOp (UN "prim__toStrB16") [EConstant (B16 i)] =
674+ primRes Str (show i)
675+getOp (UN "prim__toStrB32") [EConstant (B32 i)] =
676+ primRes Str (show i)
677+getOp (UN "prim__toStrB64") [EConstant (B64 i)] =
678+ primRes Str (show i)
679+getOp (UN "prim__toStrB8") [EConstant (B8 i)] =
680+ primRes Str (show i)
681+getOp (UN "prim__toStrBigInt") [EConstant (BI i)] =
682+ primRes Str (show i)
683+getOp (UN "prim__toStrInt") [EConstant (I i)] =
684+ primRes Str (show i)
685+getOp (UN "prim__truncB16_B8") [EConstant (B16 i)] =
686+ primRes B8 (fromIntegral i)
687+getOp (UN "prim__truncB16_Int") [EConstant (B16 i)] =
688+ primRes I (fromIntegral i)
689+getOp (UN "prim__truncB32_B16") [EConstant (B32 i)] =
690+ primRes B16 (fromIntegral i)
691+getOp (UN "prim__truncB32_B8") [EConstant (B32 i)] =
692+ primRes B8 (fromIntegral i)
693+getOp (UN "prim__truncB32_Int") [EConstant (B32 i)] =
694+ primRes I (fromIntegral i)
695+getOp (UN "prim__truncB64_B16") [EConstant (B64 i)] =
696+ primRes B16 (fromIntegral i)
697+getOp (UN "prim__truncB64_B32") [EConstant (B64 i)] =
698+ primRes B32 (fromIntegral i)
699+getOp (UN "prim__truncB64_B8") [EConstant (B64 i)] =
700+ primRes B8 (fromIntegral i)
701+getOp (UN "prim__truncB64_Int") [EConstant (B64 i)] =
702+ primRes I (fromIntegral i)
703+getOp (UN "prim__truncBigInt_B16") [EConstant (BI i)] =
704+ primRes B16 (fromIntegral i)
705+getOp (UN "prim__truncBigInt_B32") [EConstant (BI i)] =
706+ primRes B32 (fromIntegral i)
707+getOp (UN "prim__truncBigInt_B64") [EConstant (BI i)] =
708+ primRes B64 (fromIntegral i)
709+getOp (UN "prim__truncBigInt_B8") [EConstant (BI i)] =
710+ primRes B8 (fromIntegral i)
711+getOp (UN "prim__truncBigInt_Int") [EConstant (BI i)] =
712+ primRes I (fromIntegral i)
713+getOp (UN "prim__truncInt_B16") [EConstant (I i)] =
714+ primRes B16 (fromIntegral i)
715+getOp (UN "prim__truncInt_B32") [EConstant (I i)] =
716+ primRes B32 (fromIntegral i)
717+getOp (UN "prim__truncInt_B64") [EConstant (I i)] =
718+ primRes B64 (fromIntegral i)
719+getOp (UN "prim__truncInt_B8") [EConstant (I i)] =
720+ primRes B8 (fromIntegral i)
721+getOp (UN "prim__udivB16") [EConstant (B16 i1), EConstant (B16 i2)] =
722+ primRes B16 (i1 `div` i2)
723+getOp (UN "prim__udivB32") [EConstant (B32 i1), EConstant (B32 i2)] =
724+ primRes B32 (i1 `div` i2)
725+getOp (UN "prim__udivB64") [EConstant (B64 i1), EConstant (B64 i2)] =
726+ primRes B64 (i1 `div` i2)
727+getOp (UN "prim__udivB8") [EConstant (B8 i1), EConstant (B8 i2)] =
728+ primRes B8 (i1 `div` i2)
729+getOp (UN "prim__udivBigInt") [EConstant (BI i1), EConstant (BI i2)] =
730+ primRes BI (i1 `div` i2)
731+getOp (UN "prim__udivInt") [EConstant (I i1), EConstant (I i2)] =
732+ primRes I (i1 `div` i2)
733+getOp (UN "prim__uremB16") [EConstant (B16 i1), EConstant (B16 i2)] =
734+ primRes B16 (rem i1 i2)
735+getOp (UN "prim__uremB32") [EConstant (B32 i1), EConstant (B32 i2)] =
736+ primRes B32 (rem i1 i2)
737+getOp (UN "prim__uremB64") [EConstant (B64 i1), EConstant (B64 i2)] =
738+ primRes B64 (rem i1 i2)
739+getOp (UN "prim__uremB8") [EConstant (B8 i1), EConstant (B8 i2)] =
740+ primRes B8 (rem i1 i2)
741+getOp (UN "prim__uremBigInt") [EConstant (BI i1), EConstant (BI i2)] =
742+ primRes BI (rem i1 i2)
743+getOp (UN "prim__uremInt") [EConstant (I i1), EConstant (I i2)] =
744+ primRes I (rem i1 i2)
745+-- No implementation for prim__vm because the VM isn't available in interpreted code
746+getOp (UN "prim__xorB16") [EConstant (B16 i1), EConstant (B16 i2)] =
747+ primRes B16 (i1 `xor` i2)
748+getOp (UN "prim__xorB32") [EConstant (B32 i1), EConstant (B32 i2)] =
749+ primRes B32 (i1 `xor` i2)
750+getOp (UN "prim__xorB64") [EConstant (B64 i1), EConstant (B64 i2)] =
751+ primRes B64 (i1 `xor` i2)
752+getOp (UN "prim__xorB8") [EConstant (B8 i1), EConstant (B8 i2)] =
753+ primRes B8 (i1 `xor` i2)
754+getOp (UN "prim__xorBigInt") [EConstant (BI i1), EConstant (BI i2)] =
755+ primRes BI (i1 `xor` i2)
756+getOp (UN "prim__xorInt") [EConstant (I i1), EConstant (I i2)] =
757+ primRes I (i1 `xor` i2)
758+getOp (UN "prim__zextB16_B32") [EConstant (B16 i)] =
759+ primRes B32 (fromIntegral i)
760+getOp (UN "prim__zextB16_B64") [EConstant (B16 i)] =
761+ primRes B64 (fromIntegral i)
762+getOp (UN "prim__zextB16_BigInt") [EConstant (B16 i)] =
763+ primRes BI (fromIntegral i)
764+getOp (UN "prim__zextB16_Int") [EConstant (B16 i)] =
765+ primRes I (fromIntegral i)
766+getOp (UN "prim__zextB32_B64") [EConstant (B32 i)] =
767+ primRes B64 (fromIntegral i)
768+getOp (UN "prim__zextB32_BigInt") [EConstant (B32 i)] =
769+ primRes BI (fromIntegral i)
770+getOp (UN "prim__zextB32_Int") [EConstant (B32 i)] =
771+ primRes I (fromIntegral i)
772+getOp (UN "prim__zextB64_BigInt") [EConstant (B64 i)] =
773+ primRes BI (fromIntegral i)
774+getOp (UN "prim__zextB8_B16") [EConstant (B8 i)] =
775+ primRes B16 (fromIntegral i)
776+getOp (UN "prim__zextB8_B32") [EConstant (B8 i)] =
777+ primRes B32 (fromIntegral i)
778+getOp (UN "prim__zextB8_B64") [EConstant (B8 i)] =
779+ primRes B64 (fromIntegral i)
780+getOp (UN "prim__zextB8_BigInt") [EConstant (B8 i)] =
781+ primRes BI (fromIntegral i)
782+getOp (UN "prim__zextB8_Int") [EConstant (B8 i)] =
783+ primRes I (fromIntegral i)
784+getOp (UN "prim__zextInt_B16") [EConstant (I i)] =
785+ primRes B16 (fromIntegral i)
786+getOp (UN "prim__zextInt_B32") [EConstant (I i)] =
787+ primRes B32 (fromIntegral i)
788+getOp (UN "prim__zextInt_B64") [EConstant (I i)] =
789+ primRes B64 (fromIntegral i)
790+getOp (UN "prim__zextInt_BigInt") [EConstant (I i)] =
791+ primRes BI (fromIntegral i)
792+getOp n args = trace ("No prim " ++ show n ++ " for " ++ take 1000 (show args)) Nothing
793+
794+-- | Helper function to construct a result of a primitive
795+primRes :: (a -> Const) -> a -> Maybe (Exec ExecVal)
796+primRes constr = Just . return . EConstant . constr
797+
798+-- | Helper function with boolean conversion for primitive results
799+primResBool :: Bool -> Maybe (Exec ExecVal)
800+primResBool b = primRes I (if b then 1 else 0)
801+
802+
803+
399804
400805
401806