e99339c · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Merge branch 'master' of github.com:edwinb/Idris-dev

Conflicts: src/IRTS/CodegenC.hs

commite99339cb9c0930fdaaf068b557bfb372f275b9d9 authorEdwin Brady <eb@cs.st-andrews.ac.uk> dateThu 6 Sep 2012, 18:50 (14 years ago) parentc926923 53de817

6 files changed+80−5

compare with master

unifiedsplit

rts/idris_rts.c+39−5 rts/idris_rts.h+6 src/IRTS/CodegenC.hs+18 src/IRTS/LParser.hs+12 src/IRTS/Lang.hs+5 tutorial/idris-tutorial.pdf

rts/idris_rts.c+39−5

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

166166 char *ls = GETSTR(l);

167167 char *rs = GETSTR(r);

168168 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.

174169 cl -> ty = STRING;

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

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

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

234229 return str;

235230}

236231

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+

237271

238272void stackOverflow() {

239273 fprintf(stderr, "Stack overflow");

rts/idris_rts.h+6

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

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

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

134134

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+

135141// Handle stack overflow.

136142// Just reports an error and exits.

137143

src/IRTS/CodegenC.hs+18

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

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

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

204204doOp _ 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 ++ ")"

205223doOp _ _ _ = "FAIL"

206224

207225tempfile :: IO (FilePath, Handle)

src/IRTS/LParser.hs+12

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

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

216216 e <- pLExp; lchar ')';

217217 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])

218230

219231pAlt :: LParser LAlt

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

src/IRTS/Lang.hs+5

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

2727 | LIntBig | LBigInt | LStrBig | LBigStr

2828 | LPrintNum | LPrintStr | LReadStr

29+

31+ | LFSqrt | LFFloor | LFCeil

32+

2934 deriving Show

3035

3136-- Supported target languages for foreign calls

tutorial/idris-tutorial.pdf

Binary file not shown.