d1de0f4 · Idris-dev · git.iko.soy

19import Control.Monad.Trans.Error

20import Control.Monad

21import Data.Maybe

22+import Data.Bits

22import qualified Data.Map as M

23import qualified Data.Map as M

23

24

24import Foreign.LibFFI

25import Foreign.LibFFI

175 [CaseOp _ _ _ _ _ [] (STerm tm) _ _] -> -- nullary fun

176 [CaseOp _ _ _ _ _ [] (STerm tm) _ _] -> -- nullary fun

176 doExec env ctxt tm

177 doExec env ctxt tm

177 [CaseOp _ _ _ _ _ ns sc _ _] -> return (EP Ref n EErased)

178 [CaseOp _ _ _ _ _ ns sc _ _] -> return (EP Ref n EErased)

179+ [] -> execFail $ "Could not find " ++ show n ++ " in definitions."

178 thing -> trace (take 200 $ "got to " ++ show thing ++ " lookup up " ++ show n) $ undefined

180 thing -> trace (take 200 $ "got to " ++ show thing ++ " lookup up " ++ show n) $ undefined

179doExec env ctxt p@(P Bound n ty) =

181doExec env ctxt p@(P Bound n ty) =

180 case lookup n env of

182 case lookup n env of

289 where getOp :: Name -> [ExecVal] -> Maybe (Exec ExecVal)

291 where getOp :: Name -> [ExecVal] -> Maybe (Exec ExecVal)

290 getOp (UN "prim__addInt") [EConstant (I i1), EConstant (I i2)] =

292 getOp (UN "prim__addInt") [EConstant (I i1), EConstant (I i2)] =

291 primRes I (i1 + i2)

293 primRes I (i1 + i2)

294+ getOp (UN "prim__andInt") [EConstant (I i1), EConstant (I i2)] =

295+ primRes I (i1 .&. i2)

292 getOp (UN "prim__charToInt") [EConstant (Ch c)] =

296 getOp (UN "prim__charToInt") [EConstant (Ch c)] =

293 primRes I (fromEnum c)

297 primRes I (fromEnum c)

298+ getOp (UN "prim__complInt") [EConstant (I i)] =

299+ primRes I (complement i)

294 getOp (UN "prim__concat") [EConstant (Str s1), EConstant (Str s2)] =

300 getOp (UN "prim__concat") [EConstant (Str s1), EConstant (Str s2)] =

295 primRes Str (s1 ++ s2)

301 primRes Str (s1 ++ s2)

302+ getOp (UN "prim__divInt") [EConstant (I i1), EConstant (I i2)] =

303+ primRes I (i1 `div` i2)

296 getOp (UN "prim__eqChar") [EConstant (Ch c1), EConstant (Ch c2)] =

304 getOp (UN "prim__eqChar") [EConstant (Ch c1), EConstant (Ch c2)] =

297 primResBool (c1 == c2)

305 primResBool (c1 == c2)

298 getOp (UN "prim__eqInt") [EConstant (I i1), EConstant (I i2)] =

306 getOp (UN "prim__eqInt") [EConstant (I i1), EConstant (I i2)] =

299 primResBool (i1 == i2)

307 primResBool (i1 == i2)

300 getOp (UN "prim__eqString") [EConstant (Str s1), EConstant (Str s2)] =

308 getOp (UN "prim__eqString") [EConstant (Str s1), EConstant (Str s2)] =

301 primResBool (s1 == s2)

309 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)

302 getOp (UN "prim__intToFloat") [EConstant (I i)] =

318 getOp (UN "prim__intToFloat") [EConstant (I i)] =

303 primRes Fl (fromRational (toRational i))

319 primRes Fl (fromRational (toRational i))

304 getOp (UN "prim__intToStr") [EConstant (I i)] =

320 getOp (UN "prim__intToStr") [EConstant (I i)] =

305 primRes Str (show i)

321 primRes Str (show i)

306 getOp (UN "prim_lenString") [EConstant (Str s)] =

322 getOp (UN "prim_lenString") [EConstant (Str s)] =

307 primRes I (length s)

323 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)

308 getOp (UN "prim__ltInt") [EConstant (I i1), EConstant (I i2)] =

330 getOp (UN "prim__ltInt") [EConstant (I i1), EConstant (I i2)] =

309 primResBool (i1 < i2)

331 primResBool (i1 < i2)

332+ getOp (UN "prim__modInt") [EConstant (I i1), EConstant (I i2)] =

333+ primRes I (i1 `mod` i2)

310 getOp (UN "prim__mulBigInt") [EConstant (BI i1), EConstant (BI i2)] =

334 getOp (UN "prim__mulBigInt") [EConstant (BI i1), EConstant (BI i2)] =

311 primRes BI (i1 * i2)

335 primRes BI (i1 * i2)

312 getOp (UN "prim__mulFloat") [EConstant (Fl i1), EConstant (Fl i2)] =

336 getOp (UN "prim__mulFloat") [EConstant (Fl i1), EConstant (Fl i2)] =

313 primRes Fl (i1 * i2)

337 primRes Fl (i1 * i2)

314 getOp (UN "prim__mulInt") [EConstant (I i1), EConstant (I i2)] =

338 getOp (UN "prim__mulInt") [EConstant (I i1), EConstant (I i2)] =

315 primRes I (i1 * i2)

339 primRes I (i1 * i2)

340+ getOp (UN "prim__orInt") [EConstant (I i1), EConstant (I i2)] =

341+ primRes I (i1 .|. i2)

316 getOp (UN "prim__readString") [EP _ (UN "prim__stdin") _] =

342 getOp (UN "prim__readString") [EP _ (UN "prim__stdin") _] =

317 Just $ do line <- execIO getLine

343 Just $ do line <- execIO getLine

318 return (EConstant (Str line))

344 return (EConstant (Str line))

319 getOp (UN "prim__readString") [EHandle h] =

345 getOp (UN "prim__readString") [EHandle h] =

320 Just $ do contents <- execIO $ hGetLine h

346 Just $ do contents <- execIO $ hGetLine h

321 return (EConstant (Str contents))

347 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)

322 getOp (UN "prim__strCons") [EConstant (Ch c), EConstant (Str s)] =

352 getOp (UN "prim__strCons") [EConstant (Ch c), EConstant (Str s)] =

323 primRes Str (c:s)

353 primRes Str (c:s)

324 getOp (UN "prim__strHead") [EConstant (Str (c:s))] =

354 getOp (UN "prim__strHead") [EConstant (Str (c:s))] =

331 primRes Fl (i1 - i2)

361 primRes Fl (i1 - i2)

332 getOp (UN "prim__subInt") [EConstant (I i1), EConstant (I i2)] =

362 getOp (UN "prim__subInt") [EConstant (I i1), EConstant (I i2)] =

333 primRes I (i1 - i2)

363 primRes I (i1 - i2)

364+ getOp (UN "prim__xorInt") [EConstant (I i1), EConstant (I i2)] =

365+ primRes I (i1 `xor` i2)

334 getOp n args = trace ("No prim " ++ show n ++ " for " ++ take 1000 (show args)) Nothing

366 getOp n args = trace ("No prim " ++ show n ++ " for " ++ take 1000 (show args)) Nothing

335

367

336 primRes :: (a -> Const) -> a -> Maybe (Exec ExecVal)

368 primRes :: (a -> Const) -> a -> Maybe (Exec ExecVal)