9a444c5 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Add 'mod' and variants

commit9a444c5b882c1c4aef2b26f93b7fee605922344a authorEdwin Brady <ecb10@st-andrews.ac.uk> dateSun 25 Nov 2012, 21:12 (14 years ago) parent1b3f4ed

8 files changed+39−6

compare with master

unifiedsplit

lib/Builtins.idr+4 rts/idris_gmp.c+19 rts/idris_gmp.h+1 src/IRTS/CodegenC.hs+2 src/IRTS/Lang.hs+6−3 src/Idris/ElabDecls.hs+2−2 src/Idris/Primitives.hs+4 tutorial/typesfuns.tex+1−1

lib/Builtins.idr+4

@@ -249,6 +249,10 @@ partial

249249div : Int -> Int -> Int

250250div = prim__divInt

251251

252+partial

253+mod : Int -> Int -> Int

254+mod = prim__modInt

255+

252256

253257(/) : Float -> Float -> Float

254258(/) = prim__divFloat

rts/idris_gmp.c+19

@@ -116,6 +116,17 @@ VAL bigDiv(VM* vm, VAL x, VAL y) {

116116 return cl;

117117}

118118

119+VAL bigMod(VM* vm, VAL x, VAL y) {

120+ mpz_t* bigint;

121+ VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*) +

122+ sizeof(mpz_t), 0);

123+ bigint = (mpz_t*)(((char*)cl) + sizeof(ClosureType) + sizeof(void*));

124+ mpz_mod(*bigint, GETMPZ(x), GETMPZ(y));

125+ SETTY(cl, BIGINT);

126+ cl -> info.ptr = (void*)bigint;

127+ return cl;

128+}

129+

119130VAL idris_bigPlus(VM* vm, VAL x, VAL y) {

120131 if (ISINT(x) && ISINT(y)) {

121132 i_int vx = GETINT(x);

@@ -181,6 +192,14 @@ VAL idris_bigDivide(VM* vm, VAL x, VAL y) {

181192 }

182193}

183194

195+VAL idris_bigMod(VM* vm, VAL x, VAL y) {

196+ if (ISINT(x) && ISINT(y)) {

197+ return INTOP(%, x, y);

198+ } else {

199+ return bigMod(vm, GETBIG(vm, x), GETBIG(vm, y));

200+ }

201+}

202+

184203int bigEqConst(VAL x, int c) {

185204 if (ISINT(x)) { return (GETINT(x) == c); }

186205 else { return mpz_cmp_si(GETMPZ(x), c); }

rts/idris_gmp.h+1

@@ -10,6 +10,7 @@ VAL idris_bigPlus(VM*, VAL x, VAL y);

1010VAL idris_bigMinus(VM*, VAL x, VAL y);

1111VAL idris_bigTimes(VM*, VAL x, VAL y);

1212VAL idris_bigDivide(VM*, VAL x, VAL y);

13+VAL idris_bigMod(VM*, VAL x, VAL y);

1314

1415int bigEqConst(VAL x, int c);

1516

src/IRTS/CodegenC.hs+2

@@ -207,6 +207,7 @@ doOp v LPlus [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"

207207doOp v LMinus [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"

208208doOp v LTimes [l, r] = v ++ "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"

209209doOp v LDiv [l, r] = v ++ "INTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"

210+doOp v LMod [l, r] = v ++ "INTOP(%," ++ creg l ++ ", " ++ creg r ++ ")"

210211doOp v LEq [l, r] = v ++ "INTOP(==," ++ creg l ++ ", " ++ creg r ++ ")"

211212doOp v LLt [l, r] = v ++ "INTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"

212213doOp v LLe [l, r] = v ++ "INTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"

@@ -227,6 +228,7 @@ doOp v LBPlus [l, r] = v ++ "idris_bigPlus(vm, " ++ creg l ++ ", " ++ creg r ++

227228doOp v LBMinus [l, r] = v ++ "idris_bigMinus(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

228229doOp v LBTimes [l, r] = v ++ "idris_bigTimes(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

229230doOp v LBDiv [l, r] = v ++ "idris_bigDivide(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

231+doOp v LBMod [l, r] = v ++ "idris_bigMod(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

230232doOp v LBEq [l, r] = v ++ "idris_bigEq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

231233doOp v LBLt [l, r] = v ++ "idris_bigLt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

232234doOp v LBLe [l, r] = v ++ "idris_bigLe(vm, " ++ creg l ++ ", " ++ creg r ++ ")"

src/IRTS/Lang.hs+6−3

@@ -28,9 +28,12 @@ data LExp = LV LVar

2828-- Primitive operators. Backends are not *required* to implement all

2929-- of these, but should report an error if they are unable

3030

31−data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe

31+data PrimFn = LPlus | LMinus | LTimes | LDiv | LMod

32+ | LEq | LLt | LLe | LGt | LGe

33+ | LFPlus | LFMinus | LFTimes | LFDiv

3437 | LStrConcat | LStrLt | LStrEq | LStrLen

3639 | LIntBig | LBigInt | LStrBig | LBigStr

src/Idris/ElabDecls.hs+2−2

@@ -330,7 +330,7 @@ elabClauses info fc opts n_in cs = let n = liftname info n_in in

330330 then do missing <- genClauses fc n (map getLHS pdef) cs

331331 -- missing <- genMissing n scargs sc

332332 missing' <- filterM (checkPossible info fc True n) missing

333− logLvl 3 $ "Must be unreachable:\n" ++

333+ logLvl 2 $ "Must be unreachable:\n" ++

334334 showSep "\n" (map (showImp True) missing') ++

335335 "\nAgainst: " ++

336336 showSep "\n" (map (\t -> showImp True (delab ist t)) (map getLHS pdef))

@@ -400,7 +400,7 @@ elabClauses info fc opts n_in cs = let n = liftname info n_in in

400400

401401 getLHS (_, l, _) = l

402402

403− simpl rt ctxt (Right (x, y)) = Right (normalise ctxt [] x,

403+ simpl rt ctxt (Right (x, y)) = Right (normalise ctxt [] x,

404404 simplify ctxt rt [] y)

405405 simpl rt ctxt t = t

406406

src/Idris/Primitives.hs+4

@@ -39,6 +39,8 @@ primitives =

3939 (2, LTimes) total,

4040 Prim (UN "prim__divInt") (ty [IType, IType] IType) 2 (iBin (div))

4141 (2, LDiv) partial,

42+ Prim (UN "prim__modInt") (ty [IType, IType] IType) 2 (iBin (mod))

43+ (2, LMod) partial,

4244 Prim (UN "prim__eqInt") (ty [IType, IType] IType) 2 (biBin (==))

4345 (2, LEq) total,

4446 Prim (UN "prim__ltInt") (ty [IType, IType] IType) 2 (biBin (<))

@@ -68,6 +70,8 @@ primitives =

6870 (2, LBTimes) total,

6971 Prim (UN "prim__divBigInt") (ty [BIType, BIType] BIType) 2 (bBin (div))

7072 (2, LBDiv) partial,

73+ Prim (UN "prim__modBigInt") (ty [BIType, BIType] BIType) 2 (bBin (mod))

74+ (2, LBMod) partial,

7175 Prim (UN "prim__eqBigInt") (ty [BIType, BIType] IType) 2 (bbBin (==))

7276 (2, LBEq) total,

7377 Prim (UN "prim__ltBigInt") (ty [BIType, BIType] IType) 2 (bbBin (<))

tutorial/typesfuns.tex+1−1

@@ -908,7 +908,7 @@ inBounds : Int -> Int -> Bool

908908inBounds x y = x >= 0 && x < 640 && y >= 0 && y < 480

909909

910910drawPoint : (x : Int) -> (y : Int) -> so (inBounds x y) -> IO ()

911−drawPoint x y oh = unsafeDrawPoint x y

911+drawPoint x y p = unsafeDrawPoint x y

912912

913913\end{SaveVerbatim}

914914\useverb{soexample}