4358581 · Idris-dev · git.iko.soy

11import Control.Applicative

12import Control.Arrow

13import Control.Monad

14+import qualified Control.Monad.Trans as T

15+import Control.Monad.Trans.State

14import Data.Char

16import Data.Char

15import Data.Maybe (fromJust)

17import Data.Maybe (fromJust)

16import Language.Java.Parser

18import Language.Java.Parser

23import System.IO

25import System.IO

24import System.Process

26import System.Process

25

27

28+data CodeGenerationEnv = CodeGenerationEnv { globalVariablePositions :: [(Name, Integer)] }

29+

30+type CodeGeneration = StateT (CodeGenerationEnv) (Either String)

31+

26−codegenJava :: [(Name, SDecl)] ->

32+codegenJava :: [(Name, SExp)] -> -- initialization of globals

33+ [(Name, SDecl)] ->

27 FilePath -> -- output file name

34 FilePath -> -- output file name

28 OutputType ->

35 OutputType ->

29 IO ()

36 IO ()

30−codegenJava defs out exec =

37+codegenJava globalInit defs out exec =

31 either (error)

38 either (error)

32 (writeFile out . flatIndent . prettyPrint)

39 (writeFile out . flatIndent . prettyPrint)

33− (mkCompilationUnit defs out)

40+ ( evalStateT (mkCompilationUnit globalInit defs out) (mkCodeGenEnv globalInit) )

34

41

42+mkCodeGenEnv :: [(Name, SExp)] -> CodeGenerationEnv

43+mkCodeGenEnv globalInit =

44+ CodeGenerationEnv $ zipWith (\ (name, _) pos -> (name, pos)) globalInit [0..]

45+

35−mkCompilationUnit :: [(Name, SDecl)] ->

46+mkCompilationUnit :: [(Name, SExp)] -> [(Name, SDecl)] -> FilePath -> CodeGeneration CompilationUnit

36− FilePath ->

37− Either String CompilationUnit

38−mkCompilationUnit defs out =

47+mkCompilationUnit globalInit defs out =

39 CompilationUnit Nothing [ ImportDecl False idrisRts True

48 CompilationUnit Nothing [ ImportDecl False idrisRts True

40 , ImportDecl True idrisForeign True

49 , ImportDecl True idrisForeign True

41 , ImportDecl False bigInteger False

50 , ImportDecl False bigInteger False

44 , ImportDecl False scanner False

53 , ImportDecl False scanner False

45 , ImportDecl False arrays False

54 , ImportDecl False arrays False

46 ] <$>

55 ] <$>

47− mkTypeDecl defs out

56+ mkTypeDecl globalInit defs out

48 where

57 where

49 idrisRts = J.Name $ map Ident ["org", "idris", "rts"]

58 idrisRts = J.Name $ map Ident ["org", "idris", "rts"]

50 idrisForeign = J.Name $ map Ident ["org", "idris", "rts", "ForeignPrimitives"]

59 idrisForeign = J.Name $ map Ident ["org", "idris", "rts", "ForeignPrimitives"]

75prefixCallNamespacesDecl :: Ident -> SDecl -> SDecl

84prefixCallNamespacesDecl :: Ident -> SDecl -> SDecl

76prefixCallNamespacesDecl name (SFun fname args i e) = SFun fname args i (prefixCallNamespaces name e)

85prefixCallNamespacesDecl name (SFun fname args i e) = SFun fname args i (prefixCallNamespaces name e)

77

86

78−mkTypeDecl :: [(Name, SDecl)] ->

87+mkTypeDecl :: [(Name, SExp)] -> [(Name, SDecl)] -> FilePath -> CodeGeneration [TypeDecl]

79− FilePath ->

80− Either String [TypeDecl]

81−mkTypeDecl defs out =

88+mkTypeDecl globalInit defs out =

82 (\ name body -> [ClassTypeDecl $ ClassDecl [ Public

89 (\ name body -> [ClassTypeDecl $ ClassDecl [ Public

83 , Annotation $ SingleElementAnnotation

90 , Annotation $ SingleElementAnnotation

84 (J.Name [Ident "SuppressWarnings"])

91 (J.Name [Ident "SuppressWarnings"])

91 body])

98 body])

92 <$> mkClassName out

99 <$> mkClassName out

93 <*> ( mkClassName out

100 <*> ( mkClassName out

94− >>= (\ ident -> mkClassBody (map (second (prefixCallNamespacesDecl ident)) defs))

101+ >>= (\ ident -> mkClassBody globalInit (map (second (prefixCallNamespacesDecl ident)) defs))

95 )

102 )

96

103

97−mkClassName :: FilePath -> Either String Ident

104+mkClassName :: FilePath -> CodeGeneration Ident

98mkClassName path =

105mkClassName path =

99− left (\ err -> "Parser error in \"" ++ path ++ "\": " ++ (show err))

106+ T.lift $ left (\ err -> "Parser error in \"" ++ path ++ "\": " ++ (show err))

100− (parser ident . takeBaseName $ takeFileName path)

107+ (parser ident . takeBaseName $ takeFileName path)

108+

109+mkClassBody :: [(Name, SExp)] -> [(Name, SDecl)] -> CodeGeneration ClassBody

110+mkClassBody globalInit defs =

111+ (\ globals defs -> ClassBody . (globals++) . addMainMethod . mergeInnerClasses $ defs)

112+ <$> mkGlobalContext globalInit

113+ <*> mapM mkDecl defs

114+

115+mkGlobalContext :: [(Name, SExp)] -> CodeGeneration [Decl]

116+mkGlobalContext [] = return []

117+mkGlobalContext initExps =

118+ (\ exps -> [ MemberDecl $ FieldDecl [Private, Static, Final]

119+ objectArrayType

120+ [VarDecl (VarId $ Ident "globalContext")

121+ (Just . InitArray $ ArrayInit exps)

122+ ]

123+ ]

124+ )

125+ <$> mapM (\ (_, exp) -> InitExp <$> mkExp exp) initExps

101

126

102−mkClassBody :: [(Name, SDecl)] ->

127+

103− Either String ClassBody

104−mkClassBody defs = (ClassBody . addMainMethod . mergeInnerClasses)

105− <$> mapM mkDecl defs

106

128

107addMainMethod :: [Decl] -> [Decl]

129addMainMethod :: [Decl] -> [Decl]

108addMainMethod decls

130addMainMethod decls

160 mergeInner [] decl' = [decl']

182 mergeInner [] decl' = [decl']

161

183

162

184

163−mkIdentifier :: Name -> Either String Ident

185+mkIdentifier :: Name -> CodeGeneration Ident

164mkIdentifier (NS name _) = mkIdentifier name

186mkIdentifier (NS name _) = mkIdentifier name

165mkIdentifier (MN i name) = (\ (Ident x) -> Ident $ x ++ ('_' : show i))

187mkIdentifier (MN i name) = (\ (Ident x) -> Ident $ x ++ ('_' : show i))

166 <$> mkIdentifier (UN name)

188 <$> mkIdentifier (UN name)

167mkIdentifier (UN name) =

189mkIdentifier (UN name) =

168− left (\ err -> "Parser error in \"" ++ name ++ "\": " ++ (show err))

190+ T.lift $ left (\ err -> "Parser error in \"" ++ name ++ "\": " ++ (show err))

169− ( parser ident

191+ ( parser ident

170− . cleanReserved

192+ . cleanReserved

171− . cleanNonLetter

193+ . cleanNonLetter

172− . cleanStart

194+ . cleanStart

173− $ cleanWs False name)

195+ $ cleanWs False name)

174 where

196 where

175 cleanStart (x:xs)

197 cleanStart (x:xs)

176 | isNumber x = '_' : (x:xs)

198 | isNumber x = '_' : (x:xs)

207

229

208

230

209 cleanReserved "param" = "_param"

231 cleanReserved "param" = "_param"

232+ cleanReserved "globalContext" = "_globalContext"

210 cleanReserved "context" = "_context"

233 cleanReserved "context" = "_context"

211 cleanReserved "newcontext" = "_newcontext"

234 cleanReserved "newcontext" = "_newcontext"

212

235

306

329

307 cleanReserved x = x

330 cleanReserved x = x

308

331

309−mkName :: Name -> Either String J.Name

332+mkName :: Name -> CodeGeneration J.Name

310mkName (NS name nss) = (\ n ns -> J.Name (n:ns))

333mkName (NS name nss) = (\ n ns -> J.Name (n:ns))

311 <$> mkIdentifier name

334 <$> mkIdentifier name

312 <*> mapM (mkIdentifier . UN) nss

335 <*> mapM (mkIdentifier . UN) nss

333idrisObjectType :: ClassType

356idrisObjectType :: ClassType

334idrisObjectType = ClassType [(Ident "IdrisObject", [])]

357idrisObjectType = ClassType [(Ident "IdrisObject", [])]

335

358

336−contextArray :: Exp

359+contextArray :: LVar -> Exp

337−contextArray = ExpName $ J.Name [Ident "context"]

360+contextArray (Loc _) = ExpName $ J.Name [Ident "context"]

361+contextArray (Glob _) = ExpName $ J.Name [Ident "globalContext"]

338

362

339charType :: ClassType

363charType :: ClassType

340charType = ClassType [(Ident "Character", [])]

364charType = ClassType [(Ident "Character", [])]

372comparableType :: ClassType

396comparableType :: ClassType

373comparableType = ClassType [(Ident "Comparable", [])]

397comparableType = ClassType [(Ident "Comparable", [])]

374

398

375−mkDecl :: (Name, SDecl) ->

399+mkDecl :: (Name, SDecl) -> CodeGeneration Decl

376− Either String Decl

377mkDecl ((NS n (ns:nss)), decl) =

400mkDecl ((NS n (ns:nss)), decl) =

378 (\ name body -> MemberDecl $ MemberClassDecl $ ClassDecl [Public, Static] name [] Nothing [] body)

401 (\ name body -> MemberDecl $ MemberClassDecl $ ClassDecl [Public, Static] name [] Nothing [] body)

379 <$> mkIdentifier (UN ns)

402 <$> mkIdentifier (UN ns)

380− <*> mkClassBody [(NS n nss, decl)]

403+ <*> mkClassBody [] [(NS n nss, decl)]

381mkDecl (_, SFun name params stackSize body) =

404mkDecl (_, SFun name params stackSize body) =

382 (\ name params paramNames methodBody ->

405 (\ name params paramNames methodBody ->

383 MemberDecl $ MethodDecl [Public, Static]

406 MemberDecl $ MethodDecl [Public, Static]

404 <*> mkExp body

427 <*> mkExp body

405

428

406

429

407−mkClosure :: [Name] -> Int -> SExp -> Either String Exp

430+mkClosure :: [Name] -> Int -> SExp -> CodeGeneration Exp

408mkClosure params stackSize body =

431mkClosure params stackSize body =

409 (\ paramArray body ->

432 (\ paramArray body ->

410 InstanceCreation []

433 InstanceCreation []

415 <$> mkStackInit params stackSize

438 <$> mkStackInit params stackSize

416 <*> mkClosureCall body

439 <*> mkClosureCall body

417

440

418−mkFormalParam :: Name -> Either String FormalParam

441+mkFormalParam :: Name -> CodeGeneration FormalParam

419mkFormalParam name =

442mkFormalParam name =

420 (\ name -> FormalParam [Final] (RefType . ClassRefType $ objectType) False (VarId name))

443 (\ name -> FormalParam [Final] (RefType . ClassRefType $ objectType) False (VarId name))

421 <$> mkIdentifier name

444 <$> mkIdentifier name

422

445

423−mkClosureCall :: SExp -> Either String Decl

446+mkClosureCall :: SExp -> CodeGeneration Decl

424mkClosureCall body =

447mkClosureCall body =

425 (\ body -> MemberDecl $ MethodDecl [Public] [] (Just . RefType $ ClassRefType objectType) (Ident "call") [] [] body)

448 (\ body -> MemberDecl $ MethodDecl [Public] [] (Just . RefType $ ClassRefType objectType) (Ident "call") [] [] body)

426 <$> mkMethodBody body

449 <$> mkMethodBody body

427

450

428−mkMethodBody :: SExp -> Either String MethodBody

451+mkMethodBody :: SExp -> CodeGeneration MethodBody

429mkMethodBody exp =

452mkMethodBody exp =

430 (\ exp -> MethodBody . Just . Block $ [BlockStmt . Return . Just $ exp])

453 (\ exp -> MethodBody . Just . Block $ [BlockStmt . Return . Just $ exp])

431 <$> mkExp exp

454 <$> mkExp exp

432

455

433−mkStackInit :: [Name] -> Int -> Either String Exp

456+mkStackInit :: [Name] -> Int -> CodeGeneration Exp

434mkStackInit params stackSize =

457mkStackInit params stackSize =

435 (\ localVars -> ArrayCreateInit objectArrayType 0 . ArrayInit $

458 (\ localVars -> ArrayCreateInit objectArrayType 0 . ArrayInit $

436 (map (InitExp . ExpName) localVars)

459 (map (InitExp . ExpName) localVars)

445mkFlipK drop result =

468mkFlipK drop result =

446 MethodInv $ MethodCall (J.Name [Ident "idris_flipK"]) [ drop, result ]

469 MethodInv $ MethodCall (J.Name [Ident "idris_flipK"]) [ drop, result ]

447

470

448−mkLet :: LVar -> SExp -> SExp -> Either String Exp

471+mkLet :: LVar -> SExp -> SExp -> CodeGeneration Exp

449mkLet (Loc pos) oldExp newExp =

472mkLet (Loc pos) oldExp newExp =

450 (\ oldExp newExp ->

473 (\ oldExp newExp ->

451 mkFlipK ( Assign ( ArrayLhs $ ArrayIndex (ExpName $ J.Name [Ident "context"])

474 mkFlipK ( Assign ( ArrayLhs $ ArrayIndex (ExpName $ J.Name [Ident "context"])

457 )

480 )

458 <$> mkExp oldExp

481 <$> mkExp oldExp

459 <*> mkExp newExp

482 <*> mkExp newExp

460−

483+mkLet (Glob _) _ _ = T.lift $ Left "Cannot let bind to global variable"

461

484

462reverseNameSpace :: J.Name -> J.Name

485reverseNameSpace :: J.Name -> J.Name

463reverseNameSpace (J.Name ids) =

486reverseNameSpace (J.Name ids) =

464 J.Name ((tail ids) ++ [head ids])

487 J.Name ((tail ids) ++ [head ids])

465

488

466−mkCase :: Bool -> LVar -> [SAlt] -> Either String Exp

489+mkCase :: Bool -> LVar -> [SAlt] -> CodeGeneration Exp

467mkCase checked var ((SConCase parentStackPos consIndex _ params branchExpression):cases) =

490mkCase checked var ((SConCase parentStackPos consIndex _ params branchExpression):cases) =

468 mkConsCase checked

491 mkConsCase checked

469 var

492 var

473 branchExpression

496 branchExpression

474 (SCase var cases)

497 (SCase var cases)

475mkCase checked var (c@(SConstCase constant branchExpression):cases) =

498mkCase checked var (c@(SConstCase constant branchExpression):cases) =

476− (\ constant branchExpression alternative ->

499+ (\ constant branchExpression alternative var->

477 Cond ( MethodInv $ PrimaryMethodCall (constant)

500 Cond ( MethodInv $ PrimaryMethodCall (constant)

478 []

501 []

479 (Ident "equals")

502 (Ident "equals")

480− [mkVarAccess Nothing var]

503+ [var]

481 )

504 )

482 branchExpression

505 branchExpression

483 alternative

506 alternative

485 <$> mkExp (SConst constant)

508 <$> mkExp (SConst constant)

486 <*> mkExp branchExpression

509 <*> mkExp branchExpression

487 <*> mkCase checked var cases

510 <*> mkCase checked var cases

511+ <*> mkVarAccess Nothing var

488mkCase checked var (SDefaultCase exp:cases) = mkExp exp

512mkCase checked var (SDefaultCase exp:cases) = mkExp exp

489mkCase checked _ [] = mkExp (SError "Non-exhaustive pattern")

513mkCase checked _ [] = mkExp (SError "Non-exhaustive pattern")

490

514

491−mkConsCase :: Bool -> LVar -> Int -> Int -> [Name] -> SExp -> SExp -> Either String Exp

515+mkConsCase :: Bool -> LVar -> Int -> Int -> [Name] -> SExp -> SExp -> CodeGeneration Exp

492mkConsCase checked

516mkConsCase checked

493 toDeconstruct

517 toDeconstruct

494 parentStackStart

518 parentStackStart

496 params

520 params

497 branchExpression

521 branchExpression

498 alternative =

522 alternative =

499− (\ caseBinding alternative->

523+ (\ caseBinding alternative var varCasted->

500− Cond (BinOp (InstanceOf (mkVarAccess Nothing toDeconstruct)

524+ Cond (BinOp (InstanceOf (var)

501 (ClassRefType idrisObjectType)

525 (ClassRefType idrisObjectType)

502 )

526 )

503 CAnd

527 CAnd

504 ( BinOp

528 ( BinOp

505− ( MethodInv $ PrimaryMethodCall (mkVarAccess (Just idrisObjectType) toDeconstruct)

529+ ( MethodInv $ PrimaryMethodCall (varCasted)

506 []

530 []

507 (Ident "getConstructorId")

531 (Ident "getConstructorId")

508 []

532 []

516 )

540 )

517 <$> mkCaseBinding checked toDeconstruct parentStackStart params branchExpression

541 <$> mkCaseBinding checked toDeconstruct parentStackStart params branchExpression

518 <*> mkExp alternative

542 <*> mkExp alternative

543+ <*> mkVarAccess (Nothing) toDeconstruct

544+ <*> mkVarAccess (Just idrisObjectType) toDeconstruct

519

545

520

546

521−mkCaseBinding :: Bool -> LVar -> Int -> [Name] -> SExp -> Either String Exp

547+mkCaseBinding :: Bool -> LVar -> Int -> [Name] -> SExp -> CodeGeneration Exp

522mkCaseBinding True var parentStackStart params branchExpression =

548mkCaseBinding True var parentStackStart params branchExpression =

549+ (\ branchExpression deconstruction ->

523− (\ branchExpression -> mkFlipK (MethodInv $ MethodCall (J.Name [Ident "idris_assignStack"])

550+ mkFlipK (MethodInv $ MethodCall (J.Name [Ident "idris_assignStack"])

524− ( (ExpName $ J.Name [Ident "context"])

551+ ( (ExpName $ J.Name [Ident "context"])

525− : (Lit $ Int (toInteger parentStackStart))

552+ : (Lit $ Int (toInteger parentStackStart))

526− : (mkCaseBindingDeconstruction var params)

553+ : deconstruction

527− ))

554+ ))

528− (branchExpression)

555+ (branchExpression)

529 )

556 )

530 <$> mkExp branchExpression

557 <$> mkExp branchExpression

558+ <*> mkCaseBindingDeconstruction var params

531mkCaseBinding False var parentStackStart params branchExpression =

559mkCaseBinding False var parentStackStart params branchExpression =

532− (\ bindingMethod ->

560+ (\ bindingMethod deconstruction ->

533 MethodInv $ PrimaryMethodCall

561 MethodInv $ PrimaryMethodCall

534 ( MethodInv $ PrimaryMethodCall (InstanceCreation []

562 ( MethodInv $ PrimaryMethodCall (InstanceCreation []

535 (ClassType [(Ident "Object", [])])

563 (ClassType [(Ident "Object", [])])

538 )

566 )

539 []

567 []

540 (Ident "apply")

568 (Ident "apply")

541− ( contextArray

569+ ( contextArray (Loc undefined) : deconstruction )

542− : (mkCaseBindingDeconstruction var params)

543− )

544 )

570 )

545 []

571 []

546 (Ident "call")

572 (Ident "call")

547 []

573 []

548 )

574 )

549 <$> mkCaseBindingMethod parentStackStart params branchExpression

575 <$> mkCaseBindingMethod parentStackStart params branchExpression

576+ <*> mkCaseBindingDeconstruction var params

550

577

551−mkCaseBindingDeconstruction :: LVar -> [Name] -> [Exp]

578+mkCaseBindingDeconstruction :: LVar -> [Name] -> CodeGeneration [Exp]

552mkCaseBindingDeconstruction var members =

579mkCaseBindingDeconstruction var members =

553− map (mkProjection var) ([0..(length members - 1)])

580+ mapM (mkProjection var) ([0..(length members - 1)])

554

581

555−mkCaseBindingMethod :: Int -> [Name] -> SExp -> Either String MemberDecl

582+mkCaseBindingMethod :: Int -> [Name] -> SExp -> CodeGeneration MemberDecl

556mkCaseBindingMethod parentStackStart params branchExpression =

583mkCaseBindingMethod parentStackStart params branchExpression =

557 (\ formalParams caseBindingStack branchExpression ->

584 (\ formalParams caseBindingStack branchExpression ->

558 MethodDecl [Final, Public]

585 MethodDecl [Final, Public]

572mkContextParam =

599mkContextParam =

573 FormalParam [Final] (objectArrayType) False (VarId (Ident "context"))

600 FormalParam [Final] (objectArrayType) False (VarId (Ident "context"))

574

601

575−mkBindingClosure :: SExp -> Either String Exp

602+mkBindingClosure :: SExp -> CodeGeneration Exp

576mkBindingClosure oldExp =

603mkBindingClosure oldExp =

577 (\ oldCall ->

604 (\ oldCall ->

578 InstanceCreation []

605 InstanceCreation []

583 <$> mkClosureCall oldExp

610 <$> mkClosureCall oldExp

584

611

585

612

586−mkBindingStack :: Bool -> Int -> [Name] -> Either String [BlockStmt]

613+mkBindingStack :: Bool -> Int -> [Name] -> CodeGeneration [BlockStmt]

587mkBindingStack checked parentStackStart params =

614mkBindingStack checked parentStackStart params =

588 (\ paramNames ->

615 (\ paramNames ->

589 ( LocalVars [Final]

616 ( LocalVars [Final]

622 ]

649 ]

623 ]

650 ]

624

651

625−mkProjection :: LVar -> Int -> Exp

652+mkProjection :: LVar -> Int -> CodeGeneration Exp

626mkProjection var memberNr =

653mkProjection var memberNr =

627− ArrayAccess $ ArrayIndex ( MethodInv $ PrimaryMethodCall

654+ (\ var -> ArrayAccess $ ArrayIndex ( MethodInv $ PrimaryMethodCall

628− (mkVarAccess (Just idrisObjectType) var)

655+ (var)

629− []

656+ []

630− (Ident "getData")

657+ (Ident "getData")

631− []

658+ []

632− )

659+ )

633− (Lit $ Int (toInteger memberNr))

660+ (Lit $ Int (toInteger memberNr))

661+ )

662+ <$> mkVarAccess (Just idrisObjectType) var

634

663

635type ClassName = String

664type ClassName = String

636

665

645mkClass classType =

674mkClass classType =

646 ClassLit . Just . RefType .ClassRefType $ classType

675 ClassLit . Just . RefType .ClassRefType $ classType

647

676

648−mkBinOpExp :: ClassType -> Op -> [LVar] -> Exp

677+mkBinOpExp :: ClassType -> Op -> [LVar] -> CodeGeneration Exp

649−mkBinOpExp castTo op (var:vars) =

678+mkBinOpExp castTo op (var:vars) = do

679+ start <- mkVarAccess (Just castTo) var

680+ foldM (\ exp var -> BinOp exp op <$> mkVarAccess (Just castTo) var) start vars

681+

682+mkBinOpExpTrans :: (Exp -> Exp) -> (Exp -> Exp) -> ClassType -> Op -> [LVar] -> CodeGeneration Exp

683+mkBinOpExpTrans opTransformation resultTransformation castTo op (var:vars) = do

684+ start <- (mkVarAccess (Just castTo) var)

685+ foldM (\ exp var -> resultTransformation

686+ . BinOp (opTransformation exp) op

687+ . opTransformation

650− foldl (\ exp -> BinOp exp op . mkVarAccess (Just castTo))

688+ <$> mkVarAccess (Just castTo) var)

651− (mkVarAccess (Just castTo) var)

689+ start

652 vars

690 vars

653

691

654−mkBinOpExpTrans :: (Exp -> Exp) -> (Exp -> Exp) -> ClassType -> Op -> [LVar] -> Exp

655−mkBinOpExpTrans opTransformation resultTransformation castTo op (var:vars) =

656− foldl (\ exp -> resultTransformation

657− . BinOp (opTransformation exp) op

658− . opTransformation

659− . mkVarAccess (Just castTo))

660− (mkVarAccess (Just castTo) var)

661− vars

662−

663−mkBinOpExpConv :: String -> PrimType -> ClassType -> Op -> [LVar] -> Exp

692+mkBinOpExpConv :: String -> PrimType -> ClassType -> Op -> [LVar] -> CodeGeneration Exp

664mkBinOpExpConv fromMethodName toType fromType@(ClassType [(cls@(Ident _), [])]) op args =

693mkBinOpExpConv fromMethodName toType fromType@(ClassType [(cls@(Ident _), [])]) op args =

665 mkBinOpExpTrans (\ exp -> MethodInv $ TypeMethodCall (J.Name [cls])

694 mkBinOpExpTrans (\ exp -> MethodInv $ TypeMethodCall (J.Name [cls])

666 []

695 []

676 op

705 op

677 args

706 args

678

707

679−mkLogicalBinOpExp :: ClassType -> Op -> [LVar] -> Exp

708+mkLogicalBinOpExp :: ClassType -> Op -> [LVar] -> CodeGeneration Exp

680−mkLogicalBinOpExp castTo op (var:vars) =

709+mkLogicalBinOpExp castTo op (var:vars) = do

710+ start <- mkVarAccess (Just castTo) var

681− foldl (\ exp -> mkBoolToNumber castTo . BinOp exp op . mkVarAccess (Just castTo))

711+ foldM (\ exp var -> mkBoolToNumber castTo . BinOp exp op <$> mkVarAccess (Just castTo) var)

682− (mkVarAccess (Just castTo) var)

712+ start

683 vars

713 vars

684

714

685−mkMethodOpChain1 :: (Exp -> Exp) -> ClassType -> String -> [LVar] -> Exp

715+mkMethodOpChain1 :: (Exp -> Exp) -> ClassType -> String -> [LVar] -> CodeGeneration Exp

686mkMethodOpChain1 = mkMethodOpChain id

716mkMethodOpChain1 = mkMethodOpChain id

687

717

688−mkMethodOpChain :: (Exp -> Exp) -> (Exp -> Exp) -> ClassType -> String -> [LVar] -> Exp

718+mkMethodOpChain :: (Exp -> Exp) -> (Exp -> Exp) -> ClassType -> String -> [LVar] -> CodeGeneration Exp

689−mkMethodOpChain initialTransformation resultTransformation castTo method (arg:args) =

719+mkMethodOpChain initialTransformation resultTransformation castTo method (arg:args) = do

720+ start <- initialTransformation <$> mkVarAccess (Just $ castTo) arg

690− foldl (\ exp arg' ->

721+ foldM (\ exp arg' ->

691− resultTransformation . MethodInv $ PrimaryMethodCall exp

722+ resultTransformation

692− []

723+ . MethodInv

693− (Ident method)

724+ . PrimaryMethodCall exp [] (Ident method)

725+ . (:[])

694− [mkVarAccess (Just $ castTo) arg']

726+ <$> mkVarAccess (Just $ castTo) arg'

695 )

727 )

696− (initialTransformation (mkVarAccess (Just $ castTo) arg))

728+ start

697 args

729 args

698

730

699mkBoolToNumber :: ClassType -> Exp -> Exp

731mkBoolToNumber :: ClassType -> Exp -> Exp

700mkBoolToNumber (ClassType [(Ident name, [])]) boolExp =

732mkBoolToNumber (ClassType [(Ident name, [])]) boolExp =

701 Cond boolExp (mkPrimitive name (Int 1)) (mkPrimitive name (Int 0))

733 Cond boolExp (mkPrimitive name (Int 1)) (mkPrimitive name (Int 0))

702

734

703−mkZeroExt :: String -> Int -> ClassType -> ClassType -> LVar -> Exp

735+mkZeroExt :: String -> Int -> ClassType -> ClassType -> LVar -> CodeGeneration Exp

704−mkZeroExt toMethod bits fromType toType@(ClassType [(toTypeName, [])]) var =

736+mkZeroExt toMethod bits fromType toType@(ClassType [(toTypeName, [])]) var = do

737+ (\ var sext ->

705− MethodInv $ TypeMethodCall (J.Name [toTypeName])

738+ MethodInv $ TypeMethodCall (J.Name [toTypeName])

706− []

739+ []

707− (Ident "valueOf")

740+ (Ident "valueOf")

708− [ Cond ( BinOp (mkVarAccess (Just $ fromType) var)

741+ [ Cond ( BinOp (var)

709− LThan

742+ LThan

710− (Lit $ Int 0)

743+ (Lit $ Int 0)

711− )

744+ )

712− ( BinOp (Lit $ Int (2^bits))

745+ ( BinOp (Lit $ Int (2^bits))

713− Add

746+ Add

714− (mkSignedExt' toMethod fromType var)

747+ (sext)

715− )

748+ )

749+ sext

750+ ]

751+ )

752+ <$> mkVarAccess (Just $ fromType) var

716− (mkSignedExt' toMethod fromType var)

753+ <*> mkSignedExt' toMethod fromType var

717− ]

718

754

719−mkSignedExt :: String -> ClassType -> ClassType -> LVar -> Exp

755+mkSignedExt :: String -> ClassType -> ClassType -> LVar -> CodeGeneration Exp

720mkSignedExt toMethod fromType (ClassType [(toTypeName, [])]) var =

756mkSignedExt toMethod fromType (ClassType [(toTypeName, [])]) var =

721− MethodInv $ TypeMethodCall (J.Name [toTypeName])

757+ (\ sext -> MethodInv $ TypeMethodCall (J.Name [toTypeName])

722− []

758+ []

723− (Ident "valueOf")

759+ (Ident "valueOf")

760+ [ sext ]

761+ )

724− [ mkSignedExt' toMethod fromType var ]

762+ <$> mkSignedExt' toMethod fromType var

725

763

726−mkSignedExt' :: String -> ClassType -> LVar -> Exp

764+mkSignedExt' :: String -> ClassType -> LVar -> CodeGeneration Exp

727mkSignedExt' toMethod fromType var =

765mkSignedExt' toMethod fromType var =

766+ (\ var -> MethodInv $ PrimaryMethodCall (var)

767+ []

768+ (Ident toMethod)

769+ []

770+ )

728− MethodInv $ PrimaryMethodCall (mkVarAccess (Just $ fromType) var)

771+ <$> mkVarAccess (Just $ fromType) var

729− []

730− (Ident toMethod)

731− []

732

772

733data SPartialOrder

773data SPartialOrder

734 = SLt

774 = SLt

750 (BinOp (Lit $ Int 0) Equal x)

790 (BinOp (Lit $ Int 0) Equal x)

751mkPartialOrder SGt x = (BinOp (Lit $ Int 1) Equal x)

791mkPartialOrder SGt x = (BinOp (Lit $ Int 1) Equal x)

752

792

793+varPos :: LVar -> CodeGeneration Integer

794+varPos (Loc i) = return (toInteger i)

795+varPos (Glob name) = do

796+ positions <- globalVariablePositions <$> get

797+ case lookup name positions of

798+ (Just pos) -> return pos

799+ Nothing -> T.lift . Left $ "Invalid global variable id: " ++ show name

800+

753−mkVarAccess :: Maybe ClassType -> LVar -> Exp

801+mkVarAccess :: Maybe ClassType -> LVar -> CodeGeneration Exp

754−mkVarAccess Nothing (Loc i) =

802+mkVarAccess Nothing var =

755− ArrayAccess $ ArrayIndex contextArray (Lit $ Int (toInteger i))

803+ (\ pos -> ArrayAccess $ ArrayIndex (contextArray var) (Lit $ Int pos))

804+ <$> varPos var

756mkVarAccess (Just castTo) var =

805mkVarAccess (Just castTo) var =

757− Cast (RefType . ClassRefType $ castTo) (mkVarAccess Nothing var)

806+ Cast (RefType . ClassRefType $ castTo) <$> (mkVarAccess Nothing var)

758

807

759−mkPrimitiveCast :: ClassType -> ClassType -> LVar -> Exp

808+mkPrimitiveCast :: ClassType -> ClassType -> LVar -> CodeGeneration Exp

760mkPrimitiveCast fromType (ClassType [(toType, [])]) var =

809mkPrimitiveCast fromType (ClassType [(toType, [])]) var =

810+ (\ var ->

761− MethodInv $ TypeMethodCall (J.Name [toType])

811+ MethodInv $ TypeMethodCall (J.Name [toType])

762− []

763− (Ident "valueOf")

764− [mkVarAccess (Just fromType) var]

765−

766−mkToString :: ClassType -> LVar -> Exp

767−mkToString castTo var =

768− MethodInv $ PrimaryMethodCall (mkVarAccess (Just castTo) var)

769− []

770− (Ident "toString")

771 []

812 []

813+ (Ident "valueOf")

814+ [var]

815+ )

816+ <$> mkVarAccess (Just fromType) var

772

817

818+mkToString :: ClassType -> LVar -> CodeGeneration Exp

819+mkToString castTo var =

820+ (\ var -> MethodInv $ PrimaryMethodCall (var)

821+ []

822+ (Ident "toString")

823+ []

824+ )

825+ <$> mkVarAccess (Just castTo) var

773data Std = In | Out | Err

826data Std = In | Out | Err

774

827

775instance Show Std where

828instance Show Std where

787 (Ident "print")

840 (Ident "print")

788 [value]

841 [value]

789

842

790−mkMathFun :: String -> LVar -> Exp

843+mkMathFun :: String -> LVar -> CodeGeneration Exp

791mkMathFun funName var =

844mkMathFun funName var =

792− MethodInv $ TypeMethodCall (J.Name [Ident "Double"])

845+ (\ var -> MethodInv $ TypeMethodCall (J.Name [Ident "Double"])

793− []

846+ []

794− (Ident "valueOf")

847+ (Ident "valueOf")

795− [ MethodInv $ TypeMethodCall (J.Name [Ident "Math"])

848+ [ MethodInv $ TypeMethodCall (J.Name [Ident "Math"])

796− []

849+ []

797− (Ident funName)

850+ (Ident funName)

851+ [var]

852+ ]

853+ )

798− [mkVarAccess (Just doubleType) var]

854+ <$> mkVarAccess (Just doubleType) var

799− ]

800

855

801−mkStringAtIndex :: LVar -> Exp -> Exp

856+mkStringAtIndex :: LVar -> Exp -> CodeGeneration Exp

802mkStringAtIndex var indexExp =

857mkStringAtIndex var indexExp =

803− MethodInv $ TypeMethodCall (J.Name [Ident "Integer"])

858+ (\ var -> MethodInv $ TypeMethodCall (J.Name [Ident "Integer"])

804− []

859+ []

805− (Ident "valueOf")

860+ (Ident "valueOf")

861+ [ MethodInv $ PrimaryMethodCall (var)

862+ []

863+ (Ident "charAt")

864+ [indexExp]

865+ ]

866+ )

806− [ MethodInv $ PrimaryMethodCall (mkVarAccess (Just stringType) var)

867+ <$> mkVarAccess (Just stringType) var

807− []

808− (Ident "charAt")

809− [indexExp]

810− ]

811

868

812mkForeignType :: FType -> Maybe ClassType

869mkForeignType :: FType -> Maybe ClassType

813−mkForeignType FInt = return $ integerType

870+mkForeignType FInt = return integerType

814−mkForeignType FChar = return $ integerType

871+mkForeignType FChar = return integerType

815−mkForeignType FString = return $ stringType

872+mkForeignType FString = return stringType

816−mkForeignType FPtr = return $ objectType

873+mkForeignType FPtr = return objectType

817−mkForeignType FDouble = return $ doubleType

874+mkForeignType FDouble = return doubleType

818−mkForeignType FAny = return $ objectType

875+mkForeignType FAny = return objectType

819mkForeignType FUnit = Nothing

876mkForeignType FUnit = Nothing

820

877

821−mkForeignVarAccess :: FType -> LVar -> Exp

878+mkForeignVarAccess :: FType -> LVar -> CodeGeneration Exp

822mkForeignVarAccess FInt var =

879mkForeignVarAccess FInt var =

880+ (\ var -> MethodInv $ PrimaryMethodCall (var)

881+ []

882+ (Ident "intValue")

883+ []

884+ )

823− MethodInv $ PrimaryMethodCall (mkVarAccess (Just integerType) var)

885+ <$> mkVarAccess (Just integerType) var

824− []

825− (Ident "intValue")

826− []

827−mkForeignVarAccess FChar var = Cast (PrimType CharT) (mkForeignVarAccess FInt var)

886+mkForeignVarAccess FChar var = Cast (PrimType CharT) <$> mkForeignVarAccess FInt var

828mkForeignVarAccess FDouble var =

887mkForeignVarAccess FDouble var =

888+ (\ var -> MethodInv $ PrimaryMethodCall (var)

889+ []

890+ (Ident "doubleValue")

891+ []

892+ )

829− MethodInv $ PrimaryMethodCall (mkVarAccess (Just doubleType) var)

893+ <$> mkVarAccess (Just doubleType) var

830− []

831− (Ident "doubleValue")

832− []

833mkForeignVarAccess otherType var = mkVarAccess (mkForeignType otherType) var

894mkForeignVarAccess otherType var = mkVarAccess (mkForeignType otherType) var

834

895

835mkFromForeignType :: FType -> Exp -> Exp

896mkFromForeignType :: FType -> Exp -> Exp

846 [from]

907 [from]

847mkFromForeignType _ from = from

908mkFromForeignType _ from = from

848

909

849−mkForeignInvoke :: FType -> String -> [(FType, LVar)] -> Either String Exp

910+mkForeignInvoke :: FType -> String -> [(FType, LVar)] -> CodeGeneration Exp

850mkForeignInvoke fType method args =

911mkForeignInvoke fType method args =

851 (\ foreignInvokeMeth ->

912 (\ foreignInvokeMeth ->

852 MethodInv $ PrimaryMethodCall (InstanceCreation []

913 MethodInv $ PrimaryMethodCall (InstanceCreation []

861 <$> mkForeignInvokeMethod fType method args

922 <$> mkForeignInvokeMethod fType method args

862

923

863

924

864−mkForeignInvokeMethod :: FType -> String -> [(FType, LVar)] -> Either String MemberDecl

925+mkForeignInvokeMethod :: FType -> String -> [(FType, LVar)] -> CodeGeneration MemberDecl

865mkForeignInvokeMethod fType method args =

926mkForeignInvokeMethod fType method args =

866 (\ tryBlock ->

927 (\ tryBlock ->

867 MethodDecl [Public, Final]

928 MethodDecl [Public, Final]

870 (Ident "foreignInvoke")

931 (Ident "foreignInvoke")

871 []

932 []

872 []

933 []

873− (MethodBody . Just $ Block [ BlockStmt $

934+ (MethodBody . Just $ Block

935+ [ BlockStmt

874− Try tryBlock

936+ $ Try tryBlock

875− [ Catch (FormalParam []

937+ [ Catch (FormalParam []

876− (RefType $ ClassRefType exceptionType)

938+ (RefType $ ClassRefType exceptionType)

877− False

939+ False

878− (VarId $ Ident "ex")

940+ (VarId $ Ident "ex")

879− )

941+ )

880− (Block [ BlockStmt . Throw $

942+ (Block [ BlockStmt

943+ . Throw

881− InstanceCreation []

944+ $ InstanceCreation []

882− runtimeExceptionType

945+ runtimeExceptionType

883− [ExpName $ J.Name [Ident "ex"]]

946+ [ExpName $ J.Name [Ident "ex"]]

884− Nothing

947+ Nothing

885− ]

948+ ]

886− )

949+ )

887− ]

950+ ]

888− Nothing

951+ Nothing

889− ]

952+ ]

890 )

953 )

891− )

954+ )

892 <$> mkForeignInvokeTryBlock fType method args

955 <$> mkForeignInvokeTryBlock fType method args

893

956

894

957

895−mkForeignInvokeTryBlock :: FType -> String -> [(FType, LVar)] -> Either String Block

958+mkForeignInvokeTryBlock :: FType -> String -> [(FType, LVar)] -> CodeGeneration Block

896mkForeignInvokeTryBlock FUnit method args =

959mkForeignInvokeTryBlock FUnit method args =

897− (\ method -> Block [ BlockStmt . ExpStmt . MethodInv $

960+ (\ method args -> Block [ BlockStmt . ExpStmt . MethodInv $ MethodCall method args

898− MethodCall method

899− (map (uncurry mkForeignVarAccess) args)

900− , BlockStmt $ Return (Just $ Lit Null)

961+ , BlockStmt $ Return (Just $ Lit Null)

901− ]

962+ ]

902 )

963 )

903− <$> ( left (\ err -> "Error parsing name \"" ++ method ++ "\" :" ++ (show err))

964+ <$> ( T.lift $ left (\ err -> "Error parsing name \"" ++ method ++ "\" :" ++ (show err))

904− (parser name method)

965+ (parser name method)

905 )

966 )

967+ <*> mapM (uncurry mkForeignVarAccess) args

906mkForeignInvokeTryBlock fType method args =

968mkForeignInvokeTryBlock fType method args =

907− (\ method -> Block [ BlockStmt . Return

969+ (\ method args -> Block [ BlockStmt . Return

908 . Just

970 . Just

909 . mkFromForeignType fType

971 . mkFromForeignType fType

910− . MethodInv $

972+ . MethodInv

911− MethodCall method

973+ $ MethodCall method args

912− (map (uncurry mkForeignVarAccess) args)

913− ]

974+ ]

914 )

975 )

915− <$> ( left (\ err -> "Error parsing name \"" ++ method ++ "\" :" ++ (show err))

976+ <$> ( T.lift $ left (\ err -> "Error parsing name \"" ++ method ++ "\" :" ++ (show err))

916− (parser name method)

977+ (parser name method)

917 )

978 )

979+ <*> mapM (uncurry mkForeignVarAccess) args

918

980

919−mkMethodClosure :: Name -> [LVar] -> Either String Exp

981+mkMethodClosure :: Name -> [LVar] -> CodeGeneration Exp

920mkMethodClosure name args =

982mkMethodClosure name args =

921 (\ name args ->

983 (\ name args ->

922 InstanceCreation []

984 InstanceCreation []

923 idrisClosureType

985 idrisClosureType

924 [ (ExpName $ J.Name [Ident "context"]) ]

986 [ (ExpName $ J.Name [Ident "context"]) ]

987+ ( Just

925− ( Just $ ClassBody

988+ $ ClassBody

926− [ MemberDecl $

989+ [ MemberDecl

927− MethodDecl [Public, Final]

990+ $ MethodDecl [Public, Final]

928− []

991+ []

929− (Just . RefType $ ClassRefType objectType)

992+ (Just . RefType $ ClassRefType objectType)

930− (Ident "call")

993+ (Ident "call")

931− []

994+ []

932− []

995+ []

933− ( MethodBody . Just $

996+ ( MethodBody

997+ . Just

934− Block [ BlockStmt . Return . Just . MethodInv $

998+ $ Block [ BlockStmt

999+ . Return

1000+ . Just

1001+ . MethodInv

935− MethodCall (reverseNameSpace name)

1002+ $ MethodCall (reverseNameSpace name)

936− args

1003+ args

937− ]

1004+ ]

938− )

1005+ )

939− ]

1006+ ]

940− )

1007+ )

941 )

1008 )

942 <$> mkName name

1009 <$> mkName name

943 <*> mapM (mkExp . SV) args

1010 <*> mapM (mkExp . SV) args

944

1011

945−mkThread :: LVar -> Either String Exp

1012+mkThread :: LVar -> CodeGeneration Exp

946mkThread arg =

1013mkThread arg =

1014+ (\ eval ->

947− (\ eval -> MethodInv $

1015+ MethodInv

948− PrimaryMethodCall (InstanceCreation []

1016+ $ PrimaryMethodCall (InstanceCreation []

949− (ClassType [(Ident "Thread", [])])

1017+ (ClassType [(Ident "Thread", [])])

950− [ eval ]

1018+ [ eval ]

1019+ ( Just

951− ( Just $ ClassBody

1020+ $ ClassBody [ MemberDecl

952− [ MemberDecl $ MethodDecl

953− [Public, Final]

1021+ $ MethodDecl [Public, Final]

954− []

1022+ []

955− (Just . RefType $ ClassRefType objectType)

1023+ (Just . RefType $ ClassRefType objectType)

956− (Ident "_start")

1024+ (Ident "_start")

957− []

1025+ []

958− []

1026+ []

959− ( MethodBody . Just $ Block

1027+ ( MethodBody

1028+ . Just

1029+ $ Block [ BlockStmt

1030+ . ExpStmt

960− [ BlockStmt . ExpStmt . MethodInv $ MethodCall

1031+ . MethodInv

961− (J.Name [Ident "start"])

1032+ $ MethodCall (J.Name [Ident "start"])

962− []

1033+ []

963− , BlockStmt . Return . Just $ This

1034+ , BlockStmt

1035+ . Return

1036+ . Just

1037+ $ This

964 ]

1038 ]

965− )

1039+ )

966− ]

1040+ ]

967− )

1041+ )

968− )

1042+ )

969− []

1043+ []

970− (Ident "_start")

1044+ (Ident "_start")

971− []

1045+ []

972 )

1046 )

973 <$> mkThreadBinding arg

1047 <$> mkThreadBinding arg

974

1048

975−mkThreadBinding :: LVar -> Either String Exp

1049+mkThreadBinding :: LVar -> CodeGeneration Exp

976mkThreadBinding var =

1050mkThreadBinding var =

977− (\ bindingMethod ->

1051+ (\ bindingMethod var ->

978 MethodInv $ PrimaryMethodCall ( InstanceCreation []

1052 MethodInv $ PrimaryMethodCall ( InstanceCreation []

979 objectType

1053 objectType

980 []

1054 []

982 )

1056 )

983 []

1057 []

984 (Ident "apply")

1058 (Ident "apply")

985− [ mkVarAccess Nothing var ]

1059+ [ var ]

986− )

1060+ )

987 <$> mkThreadBindingMethod

1061 <$> mkThreadBindingMethod

1062+ <*> mkVarAccess Nothing var

988

1063

989

1064

990−mkThreadBindingMethod :: Either String MemberDecl

1065+mkThreadBindingMethod :: CodeGeneration MemberDecl

991mkThreadBindingMethod =

1066mkThreadBindingMethod =

992 (\ compute ->

1067 (\ compute ->

993 MethodDecl [Final, Public]

1068 MethodDecl [Final, Public]

1014 ]

1089 ]

1015

1090

1016

1091

1017−mkExp :: SExp -> Either String Exp

1092+mkExp :: SExp -> CodeGeneration Exp

1018−mkExp (SV var) =

1019− return $ mkVarAccess Nothing var

1093+mkExp (SV var) = mkVarAccess Nothing var

1020mkExp (SApp False name args) =

1094mkExp (SApp False name args) =

1021 (\ methClosure ->

1095 (\ methClosure ->

1022 MethodInv $ PrimaryMethodCall ( InstanceCreation []

1096 MethodInv $ PrimaryMethodCall ( InstanceCreation []

1040 <$> mkMethodClosure name args

1114 <$> mkMethodClosure name args

1041mkExp (SLet var new old) =

1115mkExp (SLet var new old) =

1042 mkLet var old new

1116 mkLet var old new

1043−mkExp (SUpdate (Loc i) exp) =

1117+mkExp (SUpdate var exp) =

1044− (\ rhs -> Assign (ArrayLhs $ ArrayIndex (contextArray) (Lit $ Int (toInteger i)))

1118+ (\ rhs varPos -> Assign (ArrayLhs $ ArrayIndex (contextArray var) (Lit $ Int varPos))

1045− EqualA

1119+ EqualA

1046− rhs)

1120+ rhs

1121+ )

1047 <$> mkExp exp

1122 <$> mkExp exp

1123+ <*> varPos var

1048mkExp (SCon conId name args) =

1124mkExp (SCon conId name args) =

1049 (\ args -> InstanceCreation []

1125 (\ args -> InstanceCreation []

1050 idrisObjectType

1126 idrisObjectType

1053 <$> mapM (mkExp .SV) args

1129 <$> mapM (mkExp .SV) args

1054mkExp (SCase var alts) = mkCase False var alts

1130mkExp (SCase var alts) = mkCase False var alts

1055mkExp (SChkCase var alts) = mkCase True var alts

1131mkExp (SChkCase var alts) = mkCase True var alts

1056−mkExp (SProj var i) = return $ mkProjection var i

1132+mkExp (SProj var i) = mkProjection var i

1057mkExp (SConst (I x)) = return $ mkPrimitive "Integer" (Int (toInteger x))

1133mkExp (SConst (I x)) = return $ mkPrimitive "Integer" (Int (toInteger x))

1058mkExp (SConst (BI x)) =

1134mkExp (SConst (BI x)) =

1059 return $ InstanceCreation []

1135 return $ InstanceCreation []

1080mkExp (SConst (VoidType)) = return $ mkClass voidType

1156mkExp (SConst (VoidType)) = return $ mkClass voidType

1081mkExp (SConst (Forgot)) = return $ mkClass objectType

1157mkExp (SConst (Forgot)) = return $ mkClass objectType

1082mkExp (SForeign _ fType meth args) = mkForeignInvoke fType meth args

1158mkExp (SForeign _ fType meth args) = mkForeignInvoke fType meth args

1083−mkExp (SOp LPlus args) = return $ mkBinOpExp integerType Add args

1159+mkExp (SOp LPlus args) = mkBinOpExp integerType Add args

1084−mkExp (SOp LMinus args) = return $ mkBinOpExp integerType Sub args

1160+mkExp (SOp LMinus args) = mkBinOpExp integerType Sub args

1085−mkExp (SOp LTimes args) = return $ mkBinOpExp integerType Mult args

1161+mkExp (SOp LTimes args) = mkBinOpExp integerType Mult args

1086−mkExp (SOp LDiv args) = return $ mkBinOpExp integerType Div args

1162+mkExp (SOp LDiv args) = mkBinOpExp integerType Div args

1087−mkExp (SOp LMod args) = return $ mkBinOpExp integerType Rem args

1163+mkExp (SOp LMod args) = mkBinOpExp integerType Rem args

1088−mkExp (SOp LAnd args) = return $ mkBinOpExp integerType And args

1164+mkExp (SOp LAnd args) = mkBinOpExp integerType And args

1089−mkExp (SOp LOr args) = return $ mkBinOpExp integerType Or args

1165+mkExp (SOp LOr args) = mkBinOpExp integerType Or args

1090−mkExp (SOp LXOr args) = return $ mkBinOpExp integerType Xor args

1166+mkExp (SOp LXOr args) = mkBinOpExp integerType Xor args

1091mkExp (SOp LCompl [var]) =

1167mkExp (SOp LCompl [var]) =

1092− return $ PreBitCompl (mkVarAccess (Just $ integerType) var)

1168+ PreBitCompl <$> mkVarAccess (Just $ integerType) var

1093−mkExp (SOp LSHL args) = return $ mkBinOpExp integerType LShift args

1169+mkExp (SOp LSHL args) = mkBinOpExp integerType LShift args

1094−mkExp (SOp LSHR args) = return $ mkBinOpExp integerType RShift args

1170+mkExp (SOp LSHR args) = mkBinOpExp integerType RShift args

1095mkExp (SOp LEq args) =

1171mkExp (SOp LEq args) =

1096− return $ mkMethodOpChain1 (mkBoolToNumber integerType) objectType "equals" args

1172+ mkMethodOpChain1 (mkBoolToNumber integerType) objectType "equals" args

1097−mkExp (SOp LLt args) = return $ mkLogicalBinOpExp integerType LThan args

1173+mkExp (SOp LLt args) = mkLogicalBinOpExp integerType LThan args

1098−mkExp (SOp LLe args) = return $ mkLogicalBinOpExp integerType LThanE args

1174+mkExp (SOp LLe args) = mkLogicalBinOpExp integerType LThanE args

1099−mkExp (SOp LGt args) = return $ mkLogicalBinOpExp integerType GThan args

1175+mkExp (SOp LGt args) = mkLogicalBinOpExp integerType GThan args

1100−mkExp (SOp LGe args) = return $ mkLogicalBinOpExp integerType GThanE args

1176+mkExp (SOp LGe args) = mkLogicalBinOpExp integerType GThanE args

1101−mkExp (SOp LFPlus args) = return $ mkBinOpExp doubleType Add args

1177+mkExp (SOp LFPlus args) = mkBinOpExp doubleType Add args

1102−mkExp (SOp LFMinus args) = return $ mkBinOpExp doubleType Sub args

1178+mkExp (SOp LFMinus args) = mkBinOpExp doubleType Sub args

1103−mkExp (SOp LFTimes args) = return $ mkBinOpExp doubleType Mult args

1179+mkExp (SOp LFTimes args) = mkBinOpExp doubleType Mult args

1104−mkExp (SOp LFDiv args) = return $ mkBinOpExp doubleType Div args

1180+mkExp (SOp LFDiv args) = mkBinOpExp doubleType Div args

1105mkExp (SOp LFEq args) =

1181mkExp (SOp LFEq args) =

1106− return $ mkMethodOpChain1 (mkBoolToNumber doubleType) doubleType "equals" args

1182+ mkMethodOpChain1 (mkBoolToNumber doubleType) doubleType "equals" args

1107−mkExp (SOp LFLt args) = return $ mkLogicalBinOpExp integerType LThan args

1183+mkExp (SOp LFLt args) = mkLogicalBinOpExp integerType LThan args

1108−mkExp (SOp LFLe args) = return $ mkLogicalBinOpExp integerType LThanE args

1184+mkExp (SOp LFLe args) = mkLogicalBinOpExp integerType LThanE args

1109−mkExp (SOp LFGt args) = return $ mkLogicalBinOpExp integerType GThan args

1185+mkExp (SOp LFGt args) = mkLogicalBinOpExp integerType GThan args

1110−mkExp (SOp LFGe args) = return $ mkLogicalBinOpExp integerType GThanE args

1186+mkExp (SOp LFGe args) = mkLogicalBinOpExp integerType GThanE args

1111−mkExp (SOp LBPlus args) = return $ mkMethodOpChain1 id bigIntegerType "add" args

1187+mkExp (SOp LBPlus args) = mkMethodOpChain1 id bigIntegerType "add" args

1112−mkExp (SOp LBMinus args) = return $ mkMethodOpChain1 id bigIntegerType "subtract" args

1188+mkExp (SOp LBMinus args) = mkMethodOpChain1 id bigIntegerType "subtract" args

1113−mkExp (SOp LBTimes args) = return $ mkMethodOpChain1 id bigIntegerType "multiply" args

1189+mkExp (SOp LBTimes args) = mkMethodOpChain1 id bigIntegerType "multiply" args

1114−mkExp (SOp LBDiv args) = return $ mkMethodOpChain1 id bigIntegerType "divide" args

1190+mkExp (SOp LBDiv args) = mkMethodOpChain1 id bigIntegerType "divide" args

1115−mkExp (SOp LBMod args) = return $ mkMethodOpChain1 id bigIntegerType "mod" args

1191+mkExp (SOp LBMod args) = mkMethodOpChain1 id bigIntegerType "mod" args

1116mkExp (SOp LBEq args) =

1192mkExp (SOp LBEq args) =

1117− return $ mkMethodOpChain1 (mkBoolToNumber bigIntegerType) bigIntegerType "equals" args

1193+ mkMethodOpChain1 (mkBoolToNumber bigIntegerType) bigIntegerType "equals" args

1118mkExp (SOp LBLt args) =

1194mkExp (SOp LBLt args) =

1119− return $ mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1195+ mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1120− . mkPartialOrder SLt

1196+ . mkPartialOrder SLt

1121− )

1197+ )

1122− bigIntegerType

1198+ bigIntegerType

1123− "compare"

1199+ "compare"

1124− args

1200+ args

1125mkExp (SOp LBLe args) =

1201mkExp (SOp LBLe args) =

1126− return $ mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1202+ mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1127− . mkPartialOrder SLe

1203+ . mkPartialOrder SLe

1128− )

1204+ )

1129− bigIntegerType

1205+ bigIntegerType

1130− "compare"

1206+ "compare"

1131− args

1207+ args

1132mkExp (SOp LBGt args) =

1208mkExp (SOp LBGt args) =

1133− return $ mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1209+ mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1134− . mkPartialOrder SGt

1210+ . mkPartialOrder SGt

1135− )

1211+ )

1136− bigIntegerType

1212+ bigIntegerType

1137− "compare"

1213+ "compare"

1138− args

1214+ args

1139mkExp (SOp LBGe args) =

1215mkExp (SOp LBGe args) =

1140− return $ mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1216+ mkMethodOpChain1 ( mkBoolToNumber bigIntegerType

1141− . mkPartialOrder SGe

1217+ . mkPartialOrder SGe

1142− )

1218+ )

1143− bigIntegerType

1219+ bigIntegerType

1144− "compare"

1220+ "compare"

1145− args

1221+ args

1146mkExp (SOp LStrConcat args) =

1222mkExp (SOp LStrConcat args) =

1147− return $ mkMethodOpChain (\ exp ->

1148− InstanceCreation []

1223+ mkMethodOpChain (\ exp -> InstanceCreation []

1149− (ClassType [(Ident "StringBuilder", [])])

1224+ (ClassType [(Ident "StringBuilder", [])])

1150− [exp]

1225+ [exp]

1151− Nothing

1226+ Nothing

1152− )

1227+ )

1153− (\ exp -> MethodInv $ PrimaryMethodCall exp [] (Ident "toString") [])

1228+ (\ exp -> MethodInv $ PrimaryMethodCall exp [] (Ident "toString") [])

1154− stringType

1229+ stringType

1155− "append"

1230+ "append"

1156− args

1231+ args

1157mkExp (SOp LStrLt args@[_, _]) =

1232mkExp (SOp LStrLt args@[_, _]) =

1158− return $ mkMethodOpChain1 ( mkBoolToNumber integerType

1233+ mkMethodOpChain1 ( mkBoolToNumber integerType

1159− . mkPartialOrder SLt

1234+ . mkPartialOrder SLt

1160− )

1235+ )

1161− stringType

1236+ stringType

1162− "compare"

1237+ "compare"

1163− args

1238+ args

1164mkExp (SOp LStrEq args@[_, _]) =

1239mkExp (SOp LStrEq args@[_, _]) =

1165− return $ mkMethodOpChain1 ( mkBoolToNumber integerType)

1240+ mkMethodOpChain1 ( mkBoolToNumber integerType)

1166− stringType

1241+ stringType

1167− "equals"

1242+ "equals"

1168− args

1243+ args

1169mkExp (SOp LStrLen [arg]) =

1244mkExp (SOp LStrLen [arg]) =

1245+ (\ var -> MethodInv $ PrimaryMethodCall var [] (Ident "length") [])

1170− return . MethodInv $ PrimaryMethodCall (mkVarAccess (Just stringType) arg) [] (Ident "length") []

1246+ <$> mkVarAccess (Just stringType) arg

1171mkExp (SOp LIntFloat [arg]) =

1247mkExp (SOp LIntFloat [arg]) =

1172− return $ mkPrimitiveCast integerType doubleType arg

1248+ mkPrimitiveCast integerType doubleType arg

1173mkExp (SOp LFloatInt [arg]) =

1249mkExp (SOp LFloatInt [arg]) =

1174− return $ mkPrimitiveCast doubleType integerType arg

1250+ mkPrimitiveCast doubleType integerType arg

1175mkExp (SOp LIntStr [arg]) =

1251mkExp (SOp LIntStr [arg]) =

1176− return $ mkToString integerType arg

1252+ mkToString integerType arg

1177mkExp (SOp LStrInt [arg]) =

1253mkExp (SOp LStrInt [arg]) =

1178− return $ mkPrimitiveCast stringType integerType arg

1254+ mkPrimitiveCast stringType integerType arg

1179mkExp (SOp LFloatStr [arg]) =

1255mkExp (SOp LFloatStr [arg]) =

1180− return $ mkToString doubleType arg

1256+ mkToString doubleType arg

1181mkExp (SOp LStrFloat [arg]) =

1257mkExp (SOp LStrFloat [arg]) =

1182− return $ mkPrimitiveCast doubleType stringType arg

1258+ mkPrimitiveCast doubleType stringType arg

1183mkExp (SOp LIntBig [arg]) =

1259mkExp (SOp LIntBig [arg]) =

1184− return $ mkPrimitiveCast integerType bigIntegerType arg

1260+ mkPrimitiveCast integerType bigIntegerType arg

1185mkExp (SOp LBigInt [arg]) =

1261mkExp (SOp LBigInt [arg]) =

1186− return $ mkPrimitiveCast bigIntegerType integerType arg

1262+ mkPrimitiveCast bigIntegerType integerType arg

1187mkExp (SOp LStrBig [arg]) =

1263mkExp (SOp LStrBig [arg]) =

1264+ (\ var -> InstanceCreation [] bigIntegerType [var] Nothing)

1188− return $ InstanceCreation [] bigIntegerType [mkVarAccess (Just stringType) arg] Nothing

1265+ <$> mkVarAccess (Just stringType) arg

1189mkExp (SOp LBigStr [arg]) =

1266mkExp (SOp LBigStr [arg]) =

1190− return $ mkToString bigIntegerType arg

1267+ mkToString bigIntegerType arg

1191mkExp (SOp LChInt [arg]) =

1268mkExp (SOp LChInt [arg]) =

1192− return $ mkVarAccess (Just integerType) arg

1269+ mkVarAccess (Just integerType) arg

1193mkExp (SOp LIntCh [arg]) =

1270mkExp (SOp LIntCh [arg]) =

1194− return $ mkVarAccess (Just integerType) arg

1271+ mkVarAccess (Just integerType) arg

1195mkExp (SOp LPrintNum [arg]) =

1272mkExp (SOp LPrintNum [arg]) =

1196− return $ mkSystemOutPrint (mkVarAccess Nothing arg)

1273+ mkSystemOutPrint <$> (mkVarAccess Nothing arg)

1197mkExp (SOp LPrintStr [arg]) =

1274mkExp (SOp LPrintStr [arg]) =

1198− return $ mkSystemOutPrint (mkVarAccess (Just stringType) arg)

1275+ mkSystemOutPrint <$> (mkVarAccess (Just stringType) arg)

1199mkExp (SOp LReadStr [arg]) = mkExp (SForeign LANG_C FString "idris_readStr" [(FPtr, arg)])

1276mkExp (SOp LReadStr [arg]) = mkExp (SForeign LANG_C FString "idris_readStr" [(FPtr, arg)])

1200−mkExp (SOp LB8Lt args) = return $ mkLogicalBinOpExp byteType LThan args

1277+mkExp (SOp LB8Lt args) = mkLogicalBinOpExp byteType LThan args

1201−mkExp (SOp LB8Lte args) = return $ mkLogicalBinOpExp byteType LThanE args

1278+mkExp (SOp LB8Lte args) = mkLogicalBinOpExp byteType LThanE args

1202mkExp (SOp LB8Eq args) =

1279mkExp (SOp LB8Eq args) =

1203− return $ mkMethodOpChain1 (mkBoolToNumber byteType) byteType "equals" args

1280+ mkMethodOpChain1 (mkBoolToNumber byteType) byteType "equals" args

1204−mkExp (SOp LB8Gt args) = return $ mkLogicalBinOpExp byteType GThan args

1281+mkExp (SOp LB8Gt args) = mkLogicalBinOpExp byteType GThan args

1205−mkExp (SOp LB8Gte args) = return $ mkLogicalBinOpExp byteType GThanE args

1282+mkExp (SOp LB8Gte args) = mkLogicalBinOpExp byteType GThanE args

1206−mkExp (SOp LB8Plus args) = return $ mkBinOpExp byteType Add args

1283+mkExp (SOp LB8Plus args) = mkBinOpExp byteType Add args

1207−mkExp (SOp LB8Minus args) = return $ mkBinOpExp byteType Sub args

1284+mkExp (SOp LB8Minus args) = mkBinOpExp byteType Sub args

1208−mkExp (SOp LB8Times args) = return $ mkBinOpExp byteType Mult args

1285+mkExp (SOp LB8Times args) = mkBinOpExp byteType Mult args

1209−mkExp (SOp LB8UDiv args) = return $ mkBinOpExpConv "shortValue" ShortT byteType Div args

1286+mkExp (SOp LB8UDiv args) = mkBinOpExpConv "shortValue" ShortT byteType Div args

1210−mkExp (SOp LB8SDiv args) = return $ mkBinOpExp byteType Div args

1287+mkExp (SOp LB8SDiv args) = mkBinOpExp byteType Div args

1211−mkExp (SOp LB8URem args) = return $ mkBinOpExpConv "shortValue" ShortT byteType Rem args

1288+mkExp (SOp LB8URem args) = mkBinOpExpConv "shortValue" ShortT byteType Rem args

1212−mkExp (SOp LB8SRem args) = return $ mkBinOpExp byteType Rem args

1289+mkExp (SOp LB8SRem args) = mkBinOpExp byteType Rem args

1213−mkExp (SOp LB8Shl args) = return $ mkBinOpExp byteType LShift args

1290+mkExp (SOp LB8Shl args) = mkBinOpExp byteType LShift args

1214−mkExp (SOp LB8LShr args) = return $ mkBinOpExp byteType RRShift args

1291+mkExp (SOp LB8LShr args) = mkBinOpExp byteType RRShift args

1215−mkExp (SOp LB8AShr args) = return $ mkBinOpExp byteType RShift args

1292+mkExp (SOp LB8AShr args) = mkBinOpExp byteType RShift args

1216−mkExp (SOp LB8And args) = return $ mkBinOpExp byteType And args

1293+mkExp (SOp LB8And args) = mkBinOpExp byteType And args

1217−mkExp (SOp LB8Or args) = return $ mkBinOpExp byteType Or args

1294+mkExp (SOp LB8Or args) = mkBinOpExp byteType Or args

1218−mkExp (SOp LB8Xor args) = return $ mkBinOpExp byteType Xor args

1295+mkExp (SOp LB8Xor args) = mkBinOpExp byteType Xor args

1219mkExp (SOp LB8Compl [var]) =

1296mkExp (SOp LB8Compl [var]) =

1220− return $ PreBitCompl (mkVarAccess (Just $ byteType) var)

1297+ PreBitCompl <$> mkVarAccess (Just $ byteType) var

1221−mkExp (SOp LB8Z16 [var]) = return $ mkZeroExt "shortValue" 8 byteType shortType var

1298+mkExp (SOp LB8Z16 [var]) = mkZeroExt "shortValue" 8 byteType shortType var

1222−mkExp (SOp LB8Z32 [var]) = return $ mkZeroExt "intValue" 8 byteType integerType var

1299+mkExp (SOp LB8Z32 [var]) = mkZeroExt "intValue" 8 byteType integerType var

1223−mkExp (SOp LB8Z64 [var]) = return $ mkZeroExt "longValue" 8 byteType longType var

1300+mkExp (SOp LB8Z64 [var]) = mkZeroExt "longValue" 8 byteType longType var

1224−mkExp (SOp LB8S16 [var]) = return $ mkSignedExt "shortValue" byteType shortType var

1301+mkExp (SOp LB8S16 [var]) = mkSignedExt "shortValue" byteType shortType var

1225−mkExp (SOp LB8S32 [var]) = return $ mkSignedExt "intValue" byteType integerType var

1302+mkExp (SOp LB8S32 [var]) = mkSignedExt "intValue" byteType integerType var

1226−mkExp (SOp LB8S64 [var]) = return $ mkSignedExt "longValue" byteType longType var

1303+mkExp (SOp LB8S64 [var]) = mkSignedExt "longValue" byteType longType var

1227−mkExp (SOp LB16Lt args) = return $ mkLogicalBinOpExp shortType LThan args

1304+mkExp (SOp LB16Lt args) = mkLogicalBinOpExp shortType LThan args

1228−mkExp (SOp LB16Lte args) = return $ mkLogicalBinOpExp shortType LThanE args

1305+mkExp (SOp LB16Lte args) = mkLogicalBinOpExp shortType LThanE args

1229mkExp (SOp LB16Eq args) =

1306mkExp (SOp LB16Eq args) =

1230− return $ mkMethodOpChain1 (mkBoolToNumber shortType) shortType "equals" args

1307+ mkMethodOpChain1 (mkBoolToNumber shortType) shortType "equals" args

1231−mkExp (SOp LB16Gt args) = return $ mkLogicalBinOpExp shortType GThan args

1308+mkExp (SOp LB16Gt args) = mkLogicalBinOpExp shortType GThan args

1232−mkExp (SOp LB16Gte args) = return $ mkLogicalBinOpExp shortType GThanE args

1309+mkExp (SOp LB16Gte args) = mkLogicalBinOpExp shortType GThanE args

1233−mkExp (SOp LB16Plus args) = return $ mkBinOpExp shortType Add args

1310+mkExp (SOp LB16Plus args) = mkBinOpExp shortType Add args

1234−mkExp (SOp LB16Minus args) = return $ mkBinOpExp shortType Sub args

1311+mkExp (SOp LB16Minus args) = mkBinOpExp shortType Sub args

1235−mkExp (SOp LB16Times args) = return $ mkBinOpExp shortType Mult args

1312+mkExp (SOp LB16Times args) = mkBinOpExp shortType Mult args

1236−mkExp (SOp LB16UDiv args) = return $ mkBinOpExpConv "intValue" IntT shortType Div args

1313+mkExp (SOp LB16UDiv args) = mkBinOpExpConv "intValue" IntT shortType Div args

1237−mkExp (SOp LB16SDiv args) = return $ mkBinOpExp shortType Div args

1314+mkExp (SOp LB16SDiv args) = mkBinOpExp shortType Div args

1238−mkExp (SOp LB16URem args) = return $ mkBinOpExpConv "intValue" IntT shortType Rem args

1315+mkExp (SOp LB16URem args) = mkBinOpExpConv "intValue" IntT shortType Rem args

1239−mkExp (SOp LB16SRem args) = return $ mkBinOpExp shortType Rem args

1316+mkExp (SOp LB16SRem args) = mkBinOpExp shortType Rem args

1240−mkExp (SOp LB16Shl args) = return $ mkBinOpExp shortType LShift args

1317+mkExp (SOp LB16Shl args) = mkBinOpExp shortType LShift args

1241−mkExp (SOp LB16LShr args) = return $ mkBinOpExp shortType RRShift args

1318+mkExp (SOp LB16LShr args) = mkBinOpExp shortType RRShift args

1242−mkExp (SOp LB16AShr args) = return $ mkBinOpExp shortType RShift args

1319+mkExp (SOp LB16AShr args) = mkBinOpExp shortType RShift args

1243−mkExp (SOp LB16And args) = return $ mkBinOpExp shortType And args

1320+mkExp (SOp LB16And args) = mkBinOpExp shortType And args

1244−mkExp (SOp LB16Or args) = return $ mkBinOpExp shortType Or args

1321+mkExp (SOp LB16Or args) = mkBinOpExp shortType Or args

1245−mkExp (SOp LB16Xor args) = return $ mkBinOpExp shortType Xor args

1322+mkExp (SOp LB16Xor args) = mkBinOpExp shortType Xor args

1246mkExp (SOp LB16Compl [var]) =

1323mkExp (SOp LB16Compl [var]) =

1247− return $ PreBitCompl (mkVarAccess (Just $ shortType) var)

1324+ PreBitCompl <$> mkVarAccess (Just $ shortType) var

1248−mkExp (SOp LB16Z32 [var]) = return $ mkZeroExt "intValue" 16 shortType integerType var

1325+mkExp (SOp LB16Z32 [var]) = mkZeroExt "intValue" 16 shortType integerType var

1249−mkExp (SOp LB16Z64 [var]) = return $ mkZeroExt "longValue" 16 shortType longType var

1326+mkExp (SOp LB16Z64 [var]) = mkZeroExt "longValue" 16 shortType longType var

1250−mkExp (SOp LB16S32 [var]) = return $ mkSignedExt "intValue" shortType integerType var

1327+mkExp (SOp LB16S32 [var]) = mkSignedExt "intValue" shortType integerType var

1251−mkExp (SOp LB16S64 [var]) = return $ mkSignedExt "longValue" shortType longType var

1328+mkExp (SOp LB16S64 [var]) = mkSignedExt "longValue" shortType longType var

1252mkExp (SOp LB16T8 [var]) =

1329mkExp (SOp LB16T8 [var]) =

1253− return . MethodInv $

1330+ (\ var -> MethodInv $

1254− TypeMethodCall (J.Name [Ident "Byte"])

1331+ TypeMethodCall (J.Name [Ident "Byte"])

1255− []

1332+ []

1256− (Ident "valueOf")

1333+ (Ident "valueOf")

1334+ [ MethodInv

1335+ $ PrimaryMethodCall var [] (Ident "byteValue") [] ]

1336+ )

1257− [ MethodInv $ PrimaryMethodCall (mkVarAccess (Just $ shortType) var) [] (Ident "byteValue") [] ]

1337+ <$> mkVarAccess (Just $ shortType) var

1258−mkExp (SOp LB32Lt args) = return $ mkLogicalBinOpExp integerType LThan args

1338+mkExp (SOp LB32Lt args) = mkLogicalBinOpExp integerType LThan args

1259−mkExp (SOp LB32Lte args) = return $ mkLogicalBinOpExp integerType LThanE args

1339+mkExp (SOp LB32Lte args) = mkLogicalBinOpExp integerType LThanE args

1260mkExp (SOp LB32Eq args) =

1340mkExp (SOp LB32Eq args) =

1261− return $ mkMethodOpChain1 (mkBoolToNumber integerType) integerType "equals" args

1341+ mkMethodOpChain1 (mkBoolToNumber integerType) integerType "equals" args

1262−mkExp (SOp LB32Gt args) = return $ mkLogicalBinOpExp integerType GThan args

1342+mkExp (SOp LB32Gt args) = mkLogicalBinOpExp integerType GThan args

1263−mkExp (SOp LB32Gte args) = return $ mkLogicalBinOpExp integerType GThanE args

1343+mkExp (SOp LB32Gte args) = mkLogicalBinOpExp integerType GThanE args

1264−mkExp (SOp LB32Plus args) = return $ mkBinOpExp integerType Add args

1344+mkExp (SOp LB32Plus args) = mkBinOpExp integerType Add args

1265−mkExp (SOp LB32Minus args) = return $ mkBinOpExp integerType Sub args

1345+mkExp (SOp LB32Minus args) = mkBinOpExp integerType Sub args

1266−mkExp (SOp LB32Times args) = return $ mkBinOpExp integerType Mult args

1346+mkExp (SOp LB32Times args) = mkBinOpExp integerType Mult args

1267−mkExp (SOp LB32UDiv args) = return $ mkBinOpExpConv "longValue" LongT integerType Div args

1347+mkExp (SOp LB32UDiv args) = mkBinOpExpConv "longValue" LongT integerType Div args

1268−mkExp (SOp LB32SDiv args) = return $ mkBinOpExp integerType Div args

1348+mkExp (SOp LB32SDiv args) = mkBinOpExp integerType Div args

1269−mkExp (SOp LB32URem args) = return $ mkBinOpExpConv "longValue" LongT integerType Rem args

1349+mkExp (SOp LB32URem args) = mkBinOpExpConv "longValue" LongT integerType Rem args

1270−mkExp (SOp LB32SRem args) = return $ mkBinOpExp integerType Rem args

1350+mkExp (SOp LB32SRem args) = mkBinOpExp integerType Rem args

1271−mkExp (SOp LB32Shl args) = return $ mkBinOpExp integerType LShift args

1351+mkExp (SOp LB32Shl args) = mkBinOpExp integerType LShift args

1272−mkExp (SOp LB32LShr args) = return $ mkBinOpExp integerType RRShift args

1352+mkExp (SOp LB32LShr args) = mkBinOpExp integerType RRShift args

1273−mkExp (SOp LB32AShr args) = return $ mkBinOpExp integerType RShift args

1353+mkExp (SOp LB32AShr args) = mkBinOpExp integerType RShift args

1274−mkExp (SOp LB32And args) = return $ mkBinOpExp integerType And args

1354+mkExp (SOp LB32And args) = mkBinOpExp integerType And args

1275−mkExp (SOp LB32Or args) = return $ mkBinOpExp integerType Or args

1355+mkExp (SOp LB32Or args) = mkBinOpExp integerType Or args

1276−mkExp (SOp LB32Xor args) = return $ mkBinOpExp integerType Xor args

1356+mkExp (SOp LB32Xor args) = mkBinOpExp integerType Xor args

1277mkExp (SOp LB32Compl [var]) =

1357mkExp (SOp LB32Compl [var]) =

1278− return $ PreBitCompl (mkVarAccess (Just $ integerType) var)

1358+ PreBitCompl <$> mkVarAccess (Just $ integerType) var

1279−mkExp (SOp LB32Z64 [var]) = return $ mkZeroExt "longValue" 32 integerType longType var

1359+mkExp (SOp LB32Z64 [var]) = mkZeroExt "longValue" 32 integerType longType var

1280−mkExp (SOp LB32S64 [var]) = return $ mkSignedExt "longValue" integerType longType var

1360+mkExp (SOp LB32S64 [var]) = mkSignedExt "longValue" integerType longType var

1281mkExp (SOp LB32T8 [var]) =

1361mkExp (SOp LB32T8 [var]) =

1282− return . MethodInv $

1362+ (\ var -> MethodInv

1283− TypeMethodCall (J.Name [Ident "Byte"])

1363+ $ TypeMethodCall (J.Name [Ident "Byte"])

1284− []

1364+ []

1285− (Ident "valueOf")

1365+ (Ident "valueOf")

1366+ [ MethodInv $ PrimaryMethodCall var [] (Ident "byteValue") [] ]

1367+ )

1286− [ MethodInv $ PrimaryMethodCall (mkVarAccess (Just $ integerType) var) [] (Ident "byteValue") [] ]

1368+ <$> mkVarAccess (Just $ integerType) var

1287mkExp (SOp LB32T16 [var]) =

1369mkExp (SOp LB32T16 [var]) =

1288− return . MethodInv $

1370+ (\ var -> MethodInv

1289− TypeMethodCall (J.Name [Ident "Short"])

1371+ $ TypeMethodCall (J.Name [Ident "Short"])

1290− []

1372+ []

1291− (Ident "valueOf")

1373+ (Ident "valueOf")

1374+ [ MethodInv $ PrimaryMethodCall var [] (Ident "shortValue") [] ]

1375+ )

1292− [ MethodInv $ PrimaryMethodCall (mkVarAccess (Just $ integerType) var) [] (Ident "shortValue") [] ]

1376+ <$> mkVarAccess (Just $ integerType) var

1293−mkExp (SOp LB64Lt args) = return $ mkLogicalBinOpExp longType LThan args

1377+mkExp (SOp LB64Lt args) = mkLogicalBinOpExp longType LThan args

1294−mkExp (SOp LB64Lte args) = return $ mkLogicalBinOpExp longType LThanE args

1378+mkExp (SOp LB64Lte args) = mkLogicalBinOpExp longType LThanE args

1295mkExp (SOp LB64Eq args) =

1379mkExp (SOp LB64Eq args) =

1296− return $ mkMethodOpChain1 (mkBoolToNumber longType) longType "equals" args

1380+ mkMethodOpChain1 (mkBoolToNumber longType) longType "equals" args

1297−mkExp (SOp LB64Gt args) = return $ mkLogicalBinOpExp longType GThan args

1381+mkExp (SOp LB64Gt args) = mkLogicalBinOpExp longType GThan args

1298−mkExp (SOp LB64Gte args) = return $ mkLogicalBinOpExp longType GThanE args

1382+mkExp (SOp LB64Gte args) = mkLogicalBinOpExp longType GThanE args

1299−mkExp (SOp LB64Plus args) = return $ mkBinOpExp longType Add args

1383+mkExp (SOp LB64Plus args) = mkBinOpExp longType Add args

1300−mkExp (SOp LB64Minus args) = return $ mkBinOpExp longType Sub args

1384+mkExp (SOp LB64Minus args) = mkBinOpExp longType Sub args

1301−mkExp (SOp LB64Times args) = return $ mkBinOpExp longType Mult args

1385+mkExp (SOp LB64Times args) = mkBinOpExp longType Mult args

1302−mkExp (SOp LB64UDiv (arg:args)) =

1386+mkExp (SOp LB64UDiv (arg:args)) = do

1387+ (arg:args) <- mapM (mkVarAccess (Just longType)) (arg:args)

1303 return $ foldl (\ exp arg ->

1388 return $ foldl (\ exp arg ->

1304 MethodInv $ PrimaryMethodCall

1389 MethodInv $ PrimaryMethodCall

1305 ( MethodInv $ PrimaryMethodCall

1390 ( MethodInv $ PrimaryMethodCall

1313 [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1398 [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1314 []

1399 []

1315 (Ident "valueOf")

1400 (Ident "valueOf")

1316− [ (mkVarAccess (Just longType) arg) ]

1401+ [ arg ]

1317 ]

1402 ]

1318 )

1403 )

1319 []

1404 []

1320 (Ident "longValue")

1405 (Ident "longValue")

1321 []

1406 []

1322 )

1407 )

1323− (mkVarAccess (Just longType) arg)

1408+ arg

1324 args

1409 args

1325−mkExp (SOp LB64SDiv args) = return $ mkBinOpExp longType Div args

1410+mkExp (SOp LB64SDiv args) = mkBinOpExp longType Div args

1326−mkExp (SOp LB64URem (arg:args)) =

1411+mkExp (SOp LB64URem (arg:args)) = do

1412+ (arg:args) <- mapM (mkVarAccess (Just longType)) (arg:args)

1327 return $ foldl (\ exp arg ->

1413 return $ foldl (\ exp arg ->

1328 MethodInv $ PrimaryMethodCall

1414 MethodInv $ PrimaryMethodCall

1329 ( MethodInv $ PrimaryMethodCall

1415 ( MethodInv $ PrimaryMethodCall

1337 [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1423 [ MethodInv $ TypeMethodCall (J.Name [Ident "BigInteger"])

1338 []

1424 []

1339 (Ident "valueOf")

1425 (Ident "valueOf")

1340− [ (mkVarAccess (Just longType) arg) ]

1426+ [ arg ]

1341 ]

1427 ]

1342 )

1428 )

1343 []

1429 []

1344 (Ident "longValue")

1430 (Ident "longValue")

1345 []

1431 []

1346 )

1432 )

1347− (mkVarAccess (Just longType) arg)

1433+ arg

1348 args

1434 args

1349−mkExp (SOp LB64SRem args) = return $ mkBinOpExp longType Rem args

1435+mkExp (SOp LB64SRem args) = mkBinOpExp longType Rem args

1350−mkExp (SOp LB64Shl args) = return $ mkBinOpExp longType LShift args

1436+mkExp (SOp LB64Shl args) = mkBinOpExp longType LShift args

1351−mkExp (SOp LB64LShr args) = return $ mkBinOpExp longType RRShift args

1437+mkExp (SOp LB64LShr args) = mkBinOpExp longType RRShift args

1352−mkExp (SOp LB64AShr args) = return $ mkBinOpExp longType RShift args

1438+mkExp (SOp LB64AShr args) = mkBinOpExp longType RShift args

1353−mkExp (SOp LB64And args) = return $ mkBinOpExp longType And args

1439+mkExp (SOp LB64And args) = mkBinOpExp longType And args

1354−mkExp (SOp LB64Or args) = return $ mkBinOpExp longType Or args

1440+mkExp (SOp LB64Or args) = mkBinOpExp longType Or args

1355−mkExp (SOp LB64Xor args) = return $ mkBinOpExp longType Xor args

1441+mkExp (SOp LB64Xor args) = mkBinOpExp longType Xor args

1356mkExp (SOp LB64Compl [var]) =

1442mkExp (SOp LB64Compl [var]) =

1357− return $ PreBitCompl (mkVarAccess (Just $ longType) var)

1443+ PreBitCompl <$> mkVarAccess (Just $ longType) var

1358mkExp (SOp LB64T8 [var]) =

1444mkExp (SOp LB64T8 [var]) =

1359− return . MethodInv $

1445+ (\ var -> MethodInv

1360− TypeMethodCall (J.Name [Ident "Byte"])

1446+ $ TypeMethodCall (J.Name [Ident "Byte"])

1361− []

1447+ []

1362− (Ident "valueOf")

1448+ (Ident "valueOf")

1449+ [ MethodInv

1450+ $ PrimaryMethodCall var [] (Ident "byteValue") []

1451+ ]

1452+ )

1363− [ MethodInv $ PrimaryMethodCall (mkVarAccess (Just $ longType) var) [] (Ident "byteValue") [] ]

1453+ <$> mkVarAccess (Just $ longType) var

1364mkExp (SOp LB64T16 [var]) =

1454mkExp (SOp LB64T16 [var]) =

1365− return . MethodInv $

1455+ (\ var -> MethodInv

1366− TypeMethodCall (J.Name [Ident "Short"])

1456+ $ TypeMethodCall (J.Name [Ident "Short"])

1367− []

1457+ []

1368− (Ident "valueOf")

1458+ (Ident "valueOf")

1459+ [ MethodInv $ PrimaryMethodCall var [] (Ident "shortValue") [] ]

1460+ )

1369− [ MethodInv $ PrimaryMethodCall (mkVarAccess (Just $ longType) var) [] (Ident "shortValue") [] ]

1461+ <$> mkVarAccess (Just $ longType) var

1370mkExp (SOp LB64T32 [var]) =

1462mkExp (SOp LB64T32 [var]) =

1371− return . MethodInv $

1463+ (\ var -> MethodInv

1372− TypeMethodCall (J.Name [Ident "Integer"])

1464+ $ TypeMethodCall (J.Name [Ident "Integer"])

1373− []

1465+ []

1374− (Ident "valueOf")

1466+ (Ident "valueOf")

1467+ [ MethodInv $ PrimaryMethodCall var [] (Ident "intValue") [] ]

1468+ )

1375− [ MethodInv $ PrimaryMethodCall (mkVarAccess (Just $ longType) var) [] (Ident "intValue") [] ]

1469+ <$> mkVarAccess (Just $ longType) var

1376mkExp (SOp LIntB8 [arg]) = mkExp (SOp LB32T8 [arg])

1470mkExp (SOp LIntB8 [arg]) = mkExp (SOp LB32T8 [arg])

1377mkExp (SOp LIntB16 [arg]) = mkExp (SOp LB32T16 [arg])

1471mkExp (SOp LIntB16 [arg]) = mkExp (SOp LB32T16 [arg])

1378mkExp (SOp LIntB32 [arg]) = mkExp (SV arg)

1472mkExp (SOp LIntB32 [arg]) = mkExp (SV arg)

1379mkExp (SOp LIntB64 [arg]) = mkExp (SOp LB32S64 [arg])

1473mkExp (SOp LIntB64 [arg]) = mkExp (SOp LB32S64 [arg])

1380mkExp (SOp LB32Int [arg]) = mkExp (SV arg)

1474mkExp (SOp LB32Int [arg]) = mkExp (SV arg)

1381−mkExp (SOp LFExp [arg]) = return $ mkMathFun "exp" arg

1475+mkExp (SOp LFExp [arg]) = mkMathFun "exp" arg

1382−mkExp (SOp LFLog [arg]) = return $ mkMathFun "log" arg

1476+mkExp (SOp LFLog [arg]) = mkMathFun "log" arg

1383−mkExp (SOp LFSin [arg]) = return $ mkMathFun "sin" arg

1477+mkExp (SOp LFSin [arg]) = mkMathFun "sin" arg

1384−mkExp (SOp LFCos [arg]) = return $ mkMathFun "cos" arg

1478+mkExp (SOp LFCos [arg]) = mkMathFun "cos" arg

1385−mkExp (SOp LFTan [arg]) = return $ mkMathFun "tan" arg

1479+mkExp (SOp LFTan [arg]) = mkMathFun "tan" arg

1386−mkExp (SOp LFASin [arg]) = return $ mkMathFun "asin" arg

1480+mkExp (SOp LFASin [arg]) = mkMathFun "asin" arg

1387−mkExp (SOp LFACos [arg]) = return $ mkMathFun "acos" arg

1481+mkExp (SOp LFACos [arg]) = mkMathFun "acos" arg

1388−mkExp (SOp LFATan [arg]) = return $ mkMathFun "atan" arg

1482+mkExp (SOp LFATan [arg]) = mkMathFun "atan" arg

1389−mkExp (SOp LFSqrt [arg]) = return $ mkMathFun "sqrt" arg

1483+mkExp (SOp LFSqrt [arg]) = mkMathFun "sqrt" arg

1390−mkExp (SOp LFFloor [arg]) = return $ mkMathFun "floor" arg

1484+mkExp (SOp LFFloor [arg]) = mkMathFun "floor" arg

1391−mkExp (SOp LFCeil [arg]) = return $ mkMathFun "ceil" arg

1485+mkExp (SOp LFCeil [arg]) = mkMathFun "ceil" arg

1392−mkExp (SOp LStrHead [arg]) = return $ mkStringAtIndex arg (Lit $ Int 0)

1486+mkExp (SOp LStrHead [arg]) = mkStringAtIndex arg (Lit $ Int 0)

1393mkExp (SOp LStrTail [arg]) =

1487mkExp (SOp LStrTail [arg]) =

1394− return . MethodInv $ PrimaryMethodCall (mkVarAccess (Just stringType) arg)

1488+ (\ var -> MethodInv $ PrimaryMethodCall (var)

1395 []

1489 []

1396 (Ident "substring")

1490 (Ident "substring")

1397 [Lit $ Int 1]

1491 [Lit $ Int 1]

1492+ )

1493+ <$> mkVarAccess (Just stringType) arg

1398mkExp (SOp LStrCons [c, cs]) =

1494mkExp (SOp LStrCons [c, cs]) =

1399− return . MethodInv $

1495+ (\ cVar csVar -> MethodInv $

1400 PrimaryMethodCall ( MethodInv $ PrimaryMethodCall (InstanceCreation []

1496 PrimaryMethodCall ( MethodInv $ PrimaryMethodCall (InstanceCreation []

1401 (ClassType [(Ident "StringBuilder", [])])

1497 (ClassType [(Ident "StringBuilder", [])])

1402− [mkVarAccess (Just stringType) cs]

1498+ [csVar]

1403 Nothing

1499 Nothing

1404 )

1500 )

1405 []

1501 []

1407 [ Lit $ Int 0,

1503 [ Lit $ Int 0,

1408 Cast (PrimType CharT)

1504 Cast (PrimType CharT)

1409 (MethodInv $ PrimaryMethodCall

1505 (MethodInv $ PrimaryMethodCall

1410− (mkVarAccess (Just integerType) c)

1506+ (cVar)

1411 []

1507 []

1412 (Ident "intValue")

1508 (Ident "intValue")

1413 []

1509 []

1417 []

1513 []

1418 (Ident "toString")

1514 (Ident "toString")

1419 []

1515 []

1516+ )

1517+ <$> mkVarAccess (Just integerType) c

1518+ <*> mkVarAccess (Just stringType) cs

1420−mkExp (SOp LStrIndex [str, i]) = return $ mkStringAtIndex str (mkVarAccess (Just integerType) i)

1519+mkExp (SOp LStrIndex [str, i]) = mkVarAccess (Just integerType) i >>= mkStringAtIndex str

1421mkExp (SOp LStrRev [str]) =

1520mkExp (SOp LStrRev [str]) =

1422− return . MethodInv $

1521+ (\ var -> MethodInv $

1423 PrimaryMethodCall ( MethodInv $ PrimaryMethodCall (InstanceCreation []

1522 PrimaryMethodCall ( MethodInv $ PrimaryMethodCall (InstanceCreation []

1424 (ClassType [(Ident "StringBuffer", [])])

1523 (ClassType [(Ident "StringBuffer", [])])

1425− [mkVarAccess (Just stringType) str]

1524+ [var]

1426 Nothing

1525 Nothing

1427 )

1526 )

1428 []

1527 []

1432 []

1531 []

1433 (Ident "toString")

1532 (Ident "toString")

1434 []

1533 []

1534+ )

1535+ <$> mkVarAccess (Just stringType) str

1435mkExp (SOp LStdIn []) = return $ mkSystemStd In

1536mkExp (SOp LStdIn []) = return $ mkSystemStd In

1436mkExp (SOp LStdOut []) = return $ mkSystemStd Out

1537mkExp (SOp LStdOut []) = return $ mkSystemStd Out

1437mkExp (SOp LStdErr []) = return $ mkSystemStd Err

1538mkExp (SOp LStdErr []) = return $ mkSystemStd Err

1438mkExp (SOp LFork [arg]) = mkThread arg

1539mkExp (SOp LFork [arg]) = mkThread arg

1439mkExp (SOp LPar [arg]) = mkExp (SV arg)

1540mkExp (SOp LPar [arg]) = mkExp (SV arg)

1440mkExp (SOp LVMPtr []) =

1541mkExp (SOp LVMPtr []) =

1441− return . MethodInv $ TypeMethodCall (J.Name [Ident "Thread"]) [] (Ident "currentThread") []

1542+ return $ MethodInv $ TypeMethodCall (J.Name [Ident "Thread"]) [] (Ident "currentThread") []

1442mkExp (SOp LNoOp args) = mkExp . SV $ last args

1543mkExp (SOp LNoOp args) = mkExp . SV $ last args

1443mkExp (SNothing) = return $ Lit Null

1544mkExp (SNothing) = return $ Lit Null

1444mkExp (SError err) =

1545mkExp (SError err) =