72524a0 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Proper tail calls and ArithTy ITChar support

commit72524a0a0a333964d7c9e5cfda0d3be6f3e6821a authorJan Bessai <Jan.Bessai@tu-dortmund.de> dateMon 8 Jul 2013, 19:07 (13 years ago) parenta1e13db

5 files changed+27−54

compare with master

unifiedsplit

java/src/main/java/org/idris/rts/Closure.java+10−9 java/src/main/java/org/idris/rts/TailCallClosure.java−26 src/IRTS/CodegenJava.hs+11−15 src/IRTS/Java/ASTBuilding.hs+3−3 src/IRTS/Java/JTypes.hs+3−1

java/src/main/java/org/idris/rts/Closure.java+10−9

@@ -3,19 +3,20 @@ package org.idris.rts;

33import java.util.concurrent.Callable;

55public abstract class Closure implements Callable<Object>, Runnable {

6− protected final Object [] context;

7−

8− protected Closure(final Object ... context) {

9− this.context = context;

6+ @Override

7+ public abstract Object call();

9+ public static Object unwrapTailCall(Object o) {

10+ while (o instanceof Closure) {

11+ o = ((Closure)o).call();

12+ }

13+ return o;

1014 }

11−

15+

1216 @Override

1317 public void run() {

14− call();

18+ unwrapTailCall(call());

1519 }

16−

17− @Override

18− public abstract Object call();

1920

2021 public Thread fork() {

2122 Thread childProcess = new Thread(this);

java/src/main/java/org/idris/rts/TailCallClosure.javadeleted−26

@@ -1,26 +0,0 @@

1−package org.idris.rts;

2−

3−public class TailCallClosure extends Closure {

4− private final Closure function;

5−

6− public TailCallClosure(Closure function) {

7− super();

8− this.function = function;

9− }

10−

11− public final Object call() {

12− Closure function = this.function;

13− Object result = null;

14− while (function != null) {

15− result = function.call();

16− function = null;

17− if (result instanceof TailCallClosure) {

18− function = ((TailCallClosure)result).function;

19− } else {

20− return result;

21− }

22− }

23− return result;

24− }

25−}

26−

src/IRTS/CodegenJava.hs+11−15

@@ -1,7 +1,7 @@

11{-# LANGUAGE PatternGuards #-}

22module IRTS.CodegenJava (codegenJava) where

4−import Core.TT

4+import Core.TT hiding (mkApp)

55import IRTS.BCImp

66import IRTS.CodegenCommon

77import IRTS.Java.ASTBuilding

@@ -313,12 +313,7 @@ mkExp :: SExp -> BlockResultTransformation -> CodeGeneration [BlockStmt]

313313mkExp (SV var) cont = Nothing <>@! var >>= cont []

314314

315315-- Applications

316−mkExp (SApp True name args) cont =

317− ((\ name args -> call name args) <$> mangleFull name <*> mapM (Nothing <>@!) args) >>= cont []

318− --mkTailCallClosure name args >>= cont []

319−mkExp (SApp False name args) cont =

320− ((\ name args -> call name args) <$> mangleFull name <*> mapM (Nothing <>@!) args) >>= cont []

321− --((\ closure -> (closure ~> "call") []) <$> mkTailCallClosure name args) >>= cont []

316+mkExp (SApp pushTail name args) cont = mkApp pushTail name args >>= cont []

322317

323318-- Bindings

324319mkExp (SLet var newExp inExp) cont = mkLet var newExp inExp cont

@@ -373,16 +368,18 @@ varPos (Glob name) = do

373368-----------------------------------------------------------------------

374369-- Application (wrap method calls in tail call closures)

375370

376−mkTailCallClosure :: Name -> [LVar] -> CodeGeneration Exp

377−mkTailCallClosure name args =

378− (\ methClosure ->

379− InstanceCreation [] (toClassType idrisTailCallClosureType) [methClosure] Nothing

371+mkApp :: Bool -> Name -> [LVar] -> CodeGeneration Exp

372+mkApp False name args =

373+ (\ methodName params ->

374+ (idrisClosureType ~> "unwrapTailCall") [call methodName params]

380375 )

381− <$> mkMethodCallClosure name args

376+ <$> mangleFull name

377+ <*> mapM (Nothing <>@!) args

378+mkApp True name args = mkMethodCallClosure name args

382379

383380mkMethodCallClosure :: Name -> [LVar] -> CodeGeneration Exp

384381mkMethodCallClosure name args =

385− (\ name args -> closure [localContext] (call name args))

382+ (\ name args -> closure (call name args))

386383 <$> mangleFull name

387384 <*> mapM (Nothing <>@!) args

388385

@@ -531,7 +528,6 @@ mkConstant c@(B16V x) = mkConstantArray (constType c) B16 x

531528mkConstant c@(B32V x) = mkConstantArray (constType c) B32 x

532529mkConstant c@(B64V x) = mkConstantArray (constType c) B64 x

533530mkConstant c@(AType x) = ClassLit (Just $ box (constType c))

534−mkConstant c@(ChType ) = ClassLit (Just $ box integerType)

535531mkConstant c@(StrType ) = ClassLit (Just $ stringType)

536532mkConstant c@(PtrType ) = ClassLit (Just $ objectType)

537533mkConstant c@(VoidType ) = ClassLit (Just $ voidType)

@@ -596,7 +592,7 @@ mkPrimitiveFunction op args =

596592

597593mkThread :: LVar -> CodeGeneration Exp

598594mkThread arg =

599− (\ closure -> (closure ~> "fork") []) <$> mkTailCallClosure (MN 0 "EVAL") [arg]

595+ (\ closure -> (closure ~> "fork") []) <$> mkMethodCallClosure (MN 0 "EVAL") [arg]

600596

601597-----------------------------------------------------------------------

602598-- Exceptions

src/IRTS/Java/ASTBuilding.hs+3−3

@@ -113,12 +113,12 @@ extendWithNull :: [Exp] -> Int -> [Exp]

113113extendWithNull exps additionalZeros =

114114 exps ++ (replicate additionalZeros (Lit $ Null))

115115

116−closure :: [Exp] -> Exp -> Exp

117−closure params body =

116+closure :: Exp -> Exp

117+closure body =

118118 InstanceCreation

119119 []

120120 (toClassType idrisClosureType)

121− params

121+ []

122122 (Just $ ClassBody

123123 [ simpleMethod

124124 [Public, Final] (Just objectType) "call" []

src/IRTS/Java/JTypes.hs+3−1

@@ -142,6 +142,7 @@ intTyToJType :: IntTy -> J.Type

142142intTyToJType (ITFixed nt) = nativeTyToJType nt

143143intTyToJType (ITNative) = integerType

144144intTyToJType (ITBig) = bigIntegerType

145+intTyToJType (ITChar) = charType

145146intTyToJType (ITVec nt _) = array $ nativeTyToJType nt

146147

147148arithTyToJType :: ArithTy -> J.Type

@@ -183,7 +184,7 @@ constType :: Const -> J.Type

183184constType (I _) = arithTyToJType (ATInt ITNative)

184185constType (BI _) = arithTyToJType (ATInt ITBig )

185186constType (Fl _) = arithTyToJType (ATFloat )

186−constType (Ch _) = charType

187+constType (Ch _) = arithTyToJType (ATInt ITChar )

187188constType (Str _) = stringType

188189constType (B8 _) = arithTyToJType (ATInt $ ITFixed IT8 )

189190constType (B16 _) = arithTyToJType (ATInt $ ITFixed IT16)

@@ -223,6 +224,7 @@ opName x

223224 suffixFor (ITFixed nt) = show nt

224225 suffixFor (ITNative) = show IT32

225226 suffixFor (ITBig) = show ITBig

227+ suffixFor (ITChar) = show ITChar

226228 suffixFor (ITVec nt _) = "ITVec" ++ (show $ nativeTyWidth nt)

227229

228230sourceTypes :: PrimFn -> [J.Type]