e99339c · Idris-dev · git.iko.soy

rts/idris_rts.c+39−5

compare with master

unifiedsplit

@@ -166,11 +166,6 @@ VAL idris_concat(VM* vm, VAL l, VAL r) {

166 char *ls = GETSTR(l);

167 char *rs = GETSTR(r);

168 Closure* cl = allocate(vm, sizeof(Closure) + strlen(ls) + strlen(rs) + 1);

169− // Oops! problem if the second allocate triggers a gc because cl has

170− // to be a root. Fix by allocating all in one go.

171−

172− // Also note that l/r may be in from space, so don't delete after collection,

173− // rather, delete just before the next collection.

174 cl -> ty = STRING;

169 cl -> ty = STRING;

175 cl -> info.str = (char*)cl + sizeof(Closure);

170 cl -> info.str = (char*)cl + sizeof(Closure);

176 strcpy(cl -> info.str, ls);

171 strcpy(cl -> info.str, ls);

@@ -234,6 +229,45 @@ VAL idris_readStr(VM* vm, FILE* h) {

234 return str;

229 return str;

235}

230}

236

231

232+VAL idris_strHead(VM* vm, VAL str) {

233+ return MKINT(GETSTR(str)[0]);

234+}

235+

236+VAL idris_strTail(VM* vm, VAL str) {

237+ return MKSTR(vm, GETSTR(str)+1);

238+}

239+

240+VAL idris_strCons(VM* vm, VAL x, VAL xs) {

241+ char *xstr = GETSTR(xs);

242+ Closure* cl = allocate(vm, sizeof(ClosureType) + sizeof(char*) +

243+ strlen(xstr) + 2);

244+ cl -> ty = STRING;

245+ cl -> info.str = (char*)cl + sizeof(ClosureType) + sizeof(char*);

246+ cl -> info.str[0] = (char)(GETINT(x));

247+ strcpy(cl -> info.str+1, xstr);

248+ return cl;

249+}

250+

251+VAL idris_strIndex(VM* vm, VAL str, VAL i) {

252+ return MKINT(GETSTR(str)[GETINT(i)]);

253+}

254+

255+VAL idris_strRev(VM* vm, VAL str) {

256+ char *xstr = GETSTR(str);

257+ Closure* cl = allocate(vm, sizeof(ClosureType) + sizeof(char*) +

258+ strlen(xstr) + 1);

259+ cl -> ty = STRING;

260+ cl -> info.str = (char*)cl + sizeof(ClosureType) + sizeof(char*);

261+ int y = 0;

262+ int x = strlen(xstr);

263+

264+ cl-> info.str[x+1] = '\0';

265+ while(x>0) {

266+ cl -> info.str[y++] = xstr[--x];

267+ }

268+ return cl;

269+}

270+

237

271

238void stackOverflow() {

272void stackOverflow() {

239 fprintf(stderr, "Stack overflow");

273 fprintf(stderr, "Stack overflow");

rts/idris_rts.h+6

@@ -132,6 +132,12 @@ VAL idris_streq(VM* vm, VAL l, VAL r);

132VAL idris_strlen(VM* vm, VAL l);

133VAL idris_readStr(VM* vm, FILE* h);

134

135+VAL idris_strHead(VM* vm, VAL str);

136+VAL idris_strTail(VM* vm, VAL str);

137+VAL idris_strCons(VM* vm, VAL x, VAL xs);

138+VAL idris_strIndex(VM* vm, VAL str, VAL i);

139+VAL idris_strRev(VM* vm, VAL str);

140+

135// Handle stack overflow.

141// Handle stack overflow.

136// Just reports an error and exits.

142// Just reports an error and exits.

137

143

src/IRTS/CodegenC.hs+18

@@ -202,6 +202,24 @@ doOp v LStrFloat [x] = v ++ "idris_castStrFloat(vm, " ++ creg x ++ ")"

202doOp v LReadStr [x] = v ++ "idris_readStr(vm, GETPTR(" ++ creg x ++ "))"

203doOp _ LPrintNum [x] = "printf(\"%ld\\n\", GETINT(" ++ creg x ++ "))"

204doOp _ LPrintStr [x] = "fputs(GETSTR(" ++ creg x ++ "), stdout)"

205+

206+doOp v LFExp [x] = v ++ "MKFLOAT(exp(GETFLOAT(" ++ creg x ++ ")))"

207+doOp v LFLog [x] = v ++ "MKFLOAT(log(GETFLOAT(" ++ creg x ++ ")))"

208+doOp v LFSin [x] = v ++ "MKFLOAT(sin(GETFLOAT(" ++ creg x ++ ")))"

209+doOp v LFCos [x] = v ++ "MKFLOAT(cos(GETFLOAT(" ++ creg x ++ ")))"

210+doOp v LFTan [x] = v ++ "MKFLOAT(tan(GETFLOAT(" ++ creg x ++ ")))"

211+doOp v LFASin [x] = v ++ "MKFLOAT(asin(GETFLOAT(" ++ creg x ++ ")))"

212+doOp v LFACos [x] = v ++ "MKFLOAT(acos(GETFLOAT(" ++ creg x ++ ")))"

213+doOp v LFATan [x] = v ++ "MKFLOAT(atan(GETFLOAT(" ++ creg x ++ ")))"

214+doOp v LFSqrt [x] = v ++ "MKFLOAT(floor(GETFLOAT(" ++ creg x ++ ")))"

215+doOp v LFFloor [x] = v ++ "MKFLOAT(ceil(GETFLOAT(" ++ creg x ++ ")))"

216+doOp v LFCeil [x] = v ++ "MKFLOAT(sqrt(GETFLOAT(" ++ creg x ++ ")))"

217+

218+doOp v LStrHead [x] = v ++ "idris_strHead(vm, " ++ creg x ++ ")"

219+doOp v LStrTail [x] = v ++ "idris_strTail(vm, " ++ creg x ++ ")"

220+doOp v LStrCons [x, y] = v ++ "idris_strCons(vm, " ++ creg x ++ "," ++ creg y ++ ")"

221+doOp v LStrIndex [x, y] = v ++ "idris_strIndex(vm, " ++ creg x ++ "," ++ creg y ++ ")"

222+doOp v LStrRev [x] = v ++ "idris_strRev(vm, " ++ creg x ++ ")"

205doOp _ _ _ = "FAIL"

223doOp _ _ _ = "FAIL"

206

224

207tempfile :: IO (FilePath, Handle)

225tempfile :: IO (FilePath, Handle)

src/IRTS/LParser.hs+12

@@ -215,6 +215,18 @@ pPrim = do reserved "StrEq"; lchar '(';

215 <|> do reserved "lazy"; lchar '(';

216 e <- pLExp; lchar ')';

217 return (LLazyExp e)

218+ <|> do reserved "StrHead"; lchar '('; e <- pLExp; lchar ')';

219+ return (LOp LStrHead [e])

220+ <|> do reserved "StrTail"; lchar '('; e <- pLExp; lchar ')';

221+ return (LOp LStrTail [e])

222+ <|> do reserved "StrRev"; lchar '('; e <- pLExp; lchar ')';

223+ return (LOp LStrRev [e])

224+ <|> do reserved "StrCons"; lchar '('; x <- pLExp; lchar ',';

225+ xs <- pLExp; lchar ')';

226+ return (LOp LStrCons [x, xs])

227+ <|> do reserved "StrIndex"; lchar '('; x <- pLExp; lchar ',';

228+ i <- pLExp; lchar ')';

229+ return (LOp LStrIndex [x, i])

218

230

219pAlt :: LParser LAlt

231pAlt :: LParser LAlt

220pAlt = try (do x <- iName []

232pAlt = try (do x <- iName []

src/IRTS/Lang.hs+5

@@ -26,6 +26,11 @@ data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe

27 | LIntBig | LBigInt | LStrBig | LBigStr

28 | LPrintNum | LPrintStr | LReadStr

29+

31+ | LFSqrt | LFFloor | LFCeil

32+

29 deriving Show

34 deriving Show

30

35

31-- Supported target languages for foreign calls

36-- Supported target languages for foreign calls

tutorial/idris-tutorial.pdf

Binary file not shown.