e4fc71a · Idris-dev · git.iko.soy

js/Runtime-common.js+8−1

compare with master

unifiedsplit

@@ -10,12 +10,19 @@ __IDRRT__.Char = new __IDRRT__.Type('Char');

10__IDRRT__.String = new __IDRRT__.Type('String');

11__IDRRT__.Integer = new __IDRRT__.Type('Integer');

12__IDRRT__.Float = new __IDRRT__.Type('Float');

13−__IDRRT__.Ptr = new __IDRRT__.Type('Pointer')

13+__IDRRT__.Ptr = new __IDRRT__.Type('Pointer');

14__IDRRT__.Forgot = new __IDRRT__.Type('Forgot');

15

16

17/** @constructor */

18__IDRRT__.Tailcall = function(f) { this.f = f };

19+__IDRRT__.ffiWrap = function(fid) {

20+ return function(arg) {

21+ return __IDRRT__.tailcall(function(){

22+ return __IDR__.APPLY0(fid, arg);

23+ });

24+ };

25+};

19

26

20/** @constructor */

27/** @constructor */

21__IDRRT__.Con = function(i,vars) {

28__IDRRT__.Con = function(i,vars) {

lib/IO.idr+18−10

@@ -22,7 +22,13 @@ run__IO : IO () -> IO ()

22run__IO v = io_bind v (\v' => io_return v')

23

24data IntTy = ITNative | IT8 | IT16 | IT32 | IT64

25+data FTy = FIntT IntTy

26+ | FFunction FTy FTy

27+ | FFloat

28+ | FString

29+ | FPtr

30+ | FAny Type

31+ | FUnit

26

32

27FInt : FTy

33FInt : FTy

28FInt = FIntT ITNative

34FInt = FIntT ITNative

@@ -38,15 +44,17 @@ FLong = FIntT IT64

38

44

39interpFTy : FTy -> Type

45interpFTy : FTy -> Type

40interpFTy (FIntT ITNative) = Int

46interpFTy (FIntT ITNative) = Int

41−interpFTy (FIntT IT8) = Bits8

47+interpFTy (FIntT IT8) = Bits8

42−interpFTy (FIntT IT16) = Bits16

48+interpFTy (FIntT IT16) = Bits16

43−interpFTy (FIntT IT32) = Bits32

49+interpFTy (FIntT IT32) = Bits32

44−interpFTy (FIntT IT64) = Bits64

50+interpFTy (FIntT IT64) = Bits64

51+interpFTy (FAny t) = t

45−interpFTy FFloat = Float

52+interpFTy FFloat = Float

46−interpFTy FString = String

53+interpFTy FString = String

47−interpFTy FPtr = Ptr

54+interpFTy FPtr = Ptr

48−interpFTy (FAny t) = t

55+interpFTy FUnit = ()

49−interpFTy FUnit = ()

56+

57+interpFTy (FFunction a b) = interpFTy a -> interpFTy b

50

58

51ForeignTy : (xs:List FTy) -> (t:FTy) -> Type

59ForeignTy : (xs:List FTy) -> (t:FTy) -> Type

52ForeignTy Nil rt = IO (interpFTy rt)

60ForeignTy Nil rt = IO (interpFTy rt)

src/IRTS/CodegenJavaScript.hs+24−9

@@ -200,7 +200,7 @@ translateExpression (SApp True name vars) =

200 "new __IDRRT__.Tailcall("

201 ++ "function(){\n"

202 ++ "return " ++ translateFunctionCall name vars

203− ++ ";\n});"

203+ ++ ";\n})"

204

205translateExpression (SOp op vars)

206 | (LPlus _) <- op

@@ -356,19 +356,27 @@ translateExpression (SOp op vars)

356 ++ translateVariableName rhs

357

358translateExpression (SError msg) =

359− "(function(){throw \'" ++ msg ++ "\';})();"

359+ "(function(){throw \'" ++ msg ++ "\';})()"

360

361translateExpression (SForeign _ _ "putStr" [(FString, var)]) =

362− "__IDRRT__.print(" ++ translateVariableName var ++ ");"

362+ "__IDRRT__.print(" ++ translateVariableName var ++ ")"

363

364translateExpression (SForeign _ _ fun args)

365− | "." `isPrefixOf` fun, "[]=" `isSuffixOf` fun

365+ | "[]=" `isSuffixOf` fun

366 , (obj:idx:val:[]) <- args =

367− concat [object obj, field, index idx, assign val]

367+ concat [object obj, index idx, assign val]

368

369− | "." `isPrefixOf` fun, "[]" `isSuffixOf` fun

369+ | "[]" `isSuffixOf` fun

370 , (obj:idx:[]) <- args =

371− concat [object obj, field, index idx]

371+ object obj ++ index idx

372+

373+ | "[" `isPrefixOf` fun && "]=" `isSuffixOf` fun

374+ , (obj:val:[]) <- args =

375+ concat [object obj, '[' : name ++ "]", assign val]

376+

377+ | "[" `isPrefixOf` fun && "]" `isSuffixOf` fun

378+ , (obj:[]) <- args =

379+ object obj ++ '[' : name ++ "]"

372

380

373 | "." `isPrefixOf` fun, "=" `isSuffixOf` fun

381 | "." `isPrefixOf` fun, "=" `isSuffixOf` fun

374 , (obj:val:[]) <- args =

382 , (obj:val:[]) <- args =

@@ -402,9 +410,16 @@ translateExpression (SForeign _ _ fun args)

402 array = name

410 array = name

403 object o = translateVariableName (snd o)

411 object o = translateVariableName (snd o)

404 index i = "[" ++ translateVariableName (snd i) ++ "]"

412 index i = "[" ++ translateVariableName (snd i) ++ "]"

405− assign v = '=' : translateVariableName (snd v)

413+ assign v = '=' : generateWrapper v

406 arguments as =

414 arguments as =

407− '(' : intercalate "," (map (translateVariableName . snd) as) ++ ")"

415+ '(' : intercalate "," (map generateWrapper as) ++ ")"

416+

417+ generateWrapper (ffunc, name)

418+ | FFunction <- ffunc = "__IDRRT__.ffiWrap(" ++ translateVariableName name ++ ")"

419+ | FFunctionIO <- ffunc = "__IDRRT__.ffiWrap(" ++ translateVariableName name ++ ")"

420+

421+ generateWrapper (_, name) =

422+ translateVariableName name

408

423

409translateExpression (SChkCase var cases) =

424translateExpression (SChkCase var cases) =

410 "(function(e){\n"

425 "(function(e){\n"

src/IRTS/Compiler.hs+9−5

@@ -287,13 +287,17 @@ getFTypes tm = case unApply tm of

287

288mkIty' (P _ (UN ty) _) = mkIty ty

289mkIty' (App (P _ (UN "FIntT") _) (P _ (UN intTy) _)) = mkIntIty intTy

290+mkIty' (App (App (P _ (UN "FFunction") _) _) (App (P _ (UN "FAny") _) (App (P _ (UN "IO") _) _))) = FFunctionIO

291+mkIty' (App (App (P _ (UN "FFunction") _) _) _) = FFunction

290mkIty' _ = FAny

292mkIty' _ = FAny

291

293

292−mkIty "FFloat" = FDouble

294+mkIty "FFloat" = FDouble

293−mkIty "FChar" = FChar

295+mkIty "FChar" = FChar

294−mkIty "FString" = FString

296+mkIty "FString" = FString

295−mkIty "FPtr" = FPtr

297+mkIty "FPtr" = FPtr

296−mkIty "FUnit" = FUnit

298+mkIty "FUnit" = FUnit

299+mkIty "FFunction" = FFunction

300+mkIty "FFunctionIO" = FFunctionIO

297

301

298mkIntIty "ITNative" = FInt ITNative

302mkIntIty "ITNative" = FInt ITNative

299mkIntIty "IT8" = FInt IT8

303mkIntIty "IT8" = FInt IT8

src/IRTS/Lang.hs+9−1

@@ -79,7 +79,15 @@ data PrimFn = LPlus IntTy | LMinus IntTy | LTimes IntTy

79data FLang = LANG_C

80 deriving (Show, Eq)

81

82+data FType = FInt IntTy

83+ | FFunction

84+ | FFunctionIO

85+ | FChar

86+ | FString

87+ | FUnit

88+ | FPtr

89+ | FDouble

90+ | FAny

83 deriving (Show, Eq)

91 deriving (Show, Eq)

84

92

85data LAlt = LConCase Int Name [Name] LExp

93data LAlt = LConCase Int Name [Name] LExp