Permalink
Browse files

Added some useful standard foreign functions for IO

  • Loading branch information...
1 parent 13e17a4 commit 0433650a628eb170bdefcff0e37b08ccb01d757e Edwin Brady committed Sep 6, 2012
Showing with 59 additions and 8 deletions.
  1. +2 −1 idris.cabal
  2. +2 −2 rts/Makefile
  3. +30 −0 rts/idris_stdfgn.c
  4. +17 −0 rts/idris_stdfgn.h
  5. +5 −3 src/IRTS/CodegenC.hs
  6. +2 −1 src/IRTS/LParser.hs
  7. +1 −1 src/IRTS/Lang.hs
View
@@ -40,7 +40,8 @@ Description: Idris is a general purpose language with full dependent types.
Cabal-Version: >= 1.6
Build-type: Custom
-Data-files: rts/libidris_rts.a rts/idris_rts.h rts/idris_main.c
+Data-files: rts/libidris_rts.a rts/idris_rts.h rts/idris_gc.h
+ rts/idris_stdfgn.h rts/idris_main.c rts/idris_gmp.h
Extra-source-files: lib/Makefile lib/*.idr lib/prelude/*.idr lib/network/*.idr
lib/control/monad/*.idr lib/language/*.idr
tutorial/examples/*.idr
View
@@ -1,5 +1,5 @@
-OBJS = idris_rts.o idris_gc.o idris_gmp.o
-HDRS = idris_rts.h idris_gc.h idris_gmp.h
+OBJS = idris_rts.o idris_gc.o idris_gmp.o idris_stdfgn.o
+HDRS = idris_rts.h idris_gc.h idris_gmp.h idris_stdfgn.h
CFLAGS = -g
LIBTARGET = libidris_rts.a
View
@@ -0,0 +1,30 @@
+#include "idris_stdfgn.h"
+#include "idris_rts.h"
+
+void putStr(char* str) {
+ printf("%s", str);
+}
+
+void* fileOpen(char* name, char* mode) {
+ FILE* f = fopen(name, mode);
+ return (void*)f;
+}
+
+void fileClose(void* h) {
+ FILE* f = (FILE*)h;
+ fclose(f);
+}
+
+void fputStr(void* h, char* str) {
+ FILE* f = (FILE*)h;
+ fputs(str, f);
+}
+
+int isNull(void* ptr) {
+ return ptr==NULL;
+}
+
+void* idris_stdin() {
+ return (void*)stdin;
+}
+
View
@@ -0,0 +1,17 @@
+#ifndef _IDRISSTDFGN_H
+#define _IDRISSTDFGN_H
+
+// A collection of useful standard functions to be used by the prelude.
+
+void putStr(char* str);
+//char* readStr();
+
+void* fileOpen(char* f, char* mode);
+void fileClose(void* h);
+//char* freadStr(void* h);
+void fputStr(void*h, char* str);
+
+int isNull(void* ptr);
+void* idris_stdin();
+
+#endif
View
@@ -49,7 +49,7 @@ codegenC defs out exec incs libs dbg
when (exit /= ExitSuccess) $
putStrLn ("FAILURE: " ++ gcc)
-headers [] = "#include <idris_rts.h>\n\n"
+headers [] = "#include <idris_rts.h>\n#include <idris_stdfgn.h>\n"
headers (x : xs) = "#include <" ++ x ++ ">\n" ++ headers xs
debug TRACE = "#define IDRIS_TRACE\n\n"
@@ -137,13 +137,15 @@ bcc i (FOREIGNCALL l LANG_C rty fn args)
-- bcc i _ = indent i ++ "// not done yet\n"
c_irts FInt x = "MKINT((i_int)(" ++ x ++ ")"
+c_irts FChar x = "MKINT((i_int)(" ++ x ++ ")"
c_irts FString x = "MKSTR(" ++ x ++ ")"
c_irts FUnit x = "MKINT(42424242)"
-c_irts FPtr x = "MKPTR(" ++ x ++ ")"
+c_irts FPtr x = "MKPTR(vm, " ++ x ++ ")"
c_irts FDouble x = "MKFLOAT(vm, " ++ x ++ ")"
c_irts FAny x = x
irts_c FInt x = "GETINT(" ++ x ++ ")"
+irts_c FChar x = "GETINT(" ++ x ++ ")"
irts_c FString x = "GETSTR(" ++ x ++ ")"
irts_c FUnit x = x
irts_c FPtr x = "GETPTR(" ++ x ++ ")"
@@ -196,7 +198,7 @@ doOp LBigStr [x] = "idris_castBigStr(vm, " ++ creg x ++ ")"
doOp LFloatStr [x] = "idris_castFloatStr(vm, " ++ creg x ++ ")"
doOp LStrFloat [x] = "idris_castStrFloat(vm, " ++ creg x ++ ")"
-doOp LReadStr [] = "idris_readStr(vm, stdin)"
+doOp LReadStr [x] = "idris_readStr(vm, GETPTR(" ++ creg x ++ "))"
doOp LPrintNum [x] = creg x ++ "; printf(\"%ld\\n\", GETINT(" ++ creg x ++ "))"
doOp LPrintStr [x] = creg x ++ "; fputs(GETSTR(" ++ creg x ++ "), stdout)"
doOp _ _ = "FAIL"
View
@@ -204,7 +204,8 @@ pPrim = do reserved "StrEq"; lchar '(';
return (LOp LStrLt [e, e'])
<|> do reserved "StrLen"; lchar '('; e <- pLExp; lchar ')';
return (LOp LStrLen [e])
- <|> do reserved "ReadString"; return (LOp LReadStr [])
+ <|> do reserved "ReadString"; lchar '('; e <- pLExp; lchar ')';
+ return (LOp LReadStr [e])
<|> do reserved "WriteString"; lchar '(';
e <- pLExp; lchar ')'
return (LOp LPrintStr [e])
View
@@ -33,7 +33,7 @@ data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe
data FLang = LANG_C
deriving Show
-data FType = FInt | FString | FUnit | FPtr | FDouble | FAny
+data FType = FInt | FChar | FString | FUnit | FPtr | FDouble | FAny
deriving Show
data LAlt = LConCase Int Name [Name] LExp

0 comments on commit 0433650

Please sign in to comment.