@@ -38,16 +38,16 @@ initCompileInfo bc =
38 lookupBigInt = any (needsBigInt . snd)
38 lookupBigInt = any (needsBigInt . snd)
40 needsBigInt :: [BC] -> Bool
40 needsBigInt :: [BC] -> Bool
41− needsBigInt bc = any id $ map testBCForBigInt bc
41+ needsBigInt bc = or $ map testBCForBigInt bc
43 testBCForBigInt :: BC -> Bool
43 testBCForBigInt :: BC -> Bool
44 testBCForBigInt (ASSIGNCONST _ c) =
44 testBCForBigInt (ASSIGNCONST _ c) =
45 testConstForBigInt c
45 testConstForBigInt c
47 testBCForBigInt (CONSTCASE _ c d) =
47 testBCForBigInt (CONSTCASE _ c d) =
48− (maybe False needsBigInt d)
48+ maybe False needsBigInt d
49− || (any id $ map (needsBigInt . snd) c)
49+ || (or $ map (needsBigInt . snd) c)
50− || (any id $ map (testConstForBigInt . fst) c)
50+ || (or $ map (testConstForBigInt . fst) c)
52 testBCForBigInt _ = False
52 testBCForBigInt _ = False
@@ -165,7 +165,7 @@ ffi code args = let parsed = ffiParse code in
165 | isDigit s =
165 | isDigit s =
166 FFIArg (read $ s : takeWhile isDigit ss) : ffiParse (dropWhile isDigit ss)
166 FFIArg (read $ s : takeWhile isDigit ss) : ffiParse (dropWhile isDigit ss)
167 | otherwise =
167 | otherwise =
168− [FFIError $ "FFI - Invalid positional argument"]
168+ [FFIError "FFI - Invalid positional argument"]
169 ffiParse (s:ss) = FFICode s : ffiParse ss
169 ffiParse (s:ss) = FFICode s : ffiParse ss
@@ -177,8 +177,8 @@ ffi code args = let parsed = ffiParse code in
178 renderFFI :: [FFI] -> [String] -> String
178 renderFFI :: [FFI] -> [String] -> String
179 renderFFI [] _ = ""
179 renderFFI [] _ = ""
180− renderFFI ((FFICode c) : fs) args = c : renderFFI fs args
180+ renderFFI (FFICode c : fs) args = c : renderFFI fs args
181− renderFFI ((FFIArg i) : fs) args
181+ renderFFI (FFIArg i : fs) args
182 | i < length args && i >= 0 = args !! i ++ renderFFI fs args
182 | i < length args && i >= 0 = args !! i ++ renderFFI fs args
183 | otherwise = error "FFI - Argument index out of bounds"
183 | otherwise = error "FFI - Argument index out of bounds"
@@ -219,7 +219,7 @@ compileJS' indent (JSType ty)
219compileJS' indent (JSSeq seq) =
219compileJS' indent (JSSeq seq) =
220 intercalate ";\n" (
220 intercalate ";\n" (
222− ((replicate indent ' ') ++) . (compileJS' indent)
222+ (replicate indent ' ' ++) . (compileJS' indent)
223 ) $ filter (/= JSNoop) seq
223 ) $ filter (/= JSNoop) seq
@@ -321,7 +321,7 @@ compileJS' indent (JSSwitch val branches def) =
321 "switch(" ++ compileJS' indent val ++ "){\n"
321 "switch(" ++ compileJS' indent val ++ "){\n"
322 ++ concatMap mkBranch branches
322 ++ concatMap mkBranch branches
323 ++ mkDefault def
323 ++ mkDefault def
324− ++ (replicate indent ' ') ++ "}"
324+ ++ replicate indent ' ' ++ "}"
326 mkBranch :: (JS, JS) -> String
326 mkBranch :: (JS, JS) -> String
327 mkBranch (tag, code) =
327 mkBranch (tag, code) =
@@ -400,9 +400,9 @@ codegenJS_all target definitions includes libs filename outputType = do
401 writeFile filename $ runtime ++ concat code ++ main ++ invokeMain
401 writeFile filename $ runtime ++ concat code ++ main ++ invokeMain
402 setPermissions filename (emptyPermissions { readable = True
402 setPermissions filename (emptyPermissions { readable = True
403− , executable = target == Node
403+ , executable = target == Node
404− , writable = True
404+ , writable = True
407 includeLibs :: [String] -> String
407 includeLibs :: [String] -> String
408 includeLibs =
408 includeLibs =
@@ -490,15 +490,15 @@ splitFunction (JSAlloc name (Just (JSFunction args body@(JSSeq _)))) = do
491 processBranches :: [(JS,JS)] -> RWS () [(Int,JS)] Int [(JS,JS)]
491 processBranches :: [(JS,JS)] -> RWS () [(Int,JS)] Int [(JS,JS)]
492 processBranches =
492 processBranches =
493− traverse (runKleisli (arr id *** (Kleisli splitSequence)))
493+ traverse (runKleisli (arr id *** Kleisli splitSequence))
495 splitSequence :: JS -> RWS () [(Int, JS)] Int JS
495 splitSequence :: JS -> RWS () [(Int, JS)] Int JS
496− splitSequence js@(JSSeq seq) = do
496+ splitSequence js@(JSSeq seq) =
497 let (pre,post) = break isCall seq in
497 let (pre,post) = break isCall seq in
498 case post of
498 case post of
499 [] -> JSSeq <$> traverse splitCondition seq
499 [] -> JSSeq <$> traverse splitCondition seq
500 [js@(JSCond _)] -> splitCondition js
500 [js@(JSCond _)] -> splitCondition js
501− [js@(JSSwitch _ _ _)] -> splitCondition js
501+ [js@(JSSwitch {})] -> splitCondition js
502 [_] -> return js
502 [_] -> return js
503 (call:rest) -> do
503 (call:rest) -> do
504 depth <- get
504 depth <- get
@@ -568,7 +568,7 @@ translateDecl info (name@(MN 0 fun), bc)
569 isCase :: BC -> Bool
569 isCase :: BC -> Bool
570 isCase bc
570 isCase bc
571− | CASE _ _ _ _ <- bc = True
571+ | CASE {} <- bc = True
572 | otherwise = False
572 | otherwise = False
574 defaultCase :: [BC] -> [BC]
574 defaultCase :: [BC] -> [BC]
@@ -647,7 +647,7 @@ translateChar ch
647 | '\\' <- ch = "\\\\"
647 | '\\' <- ch = "\\\\"
648 | '\"' <- ch = "\\\""
648 | '\"' <- ch = "\\\""
649 | '\'' <- ch = "\\\'"
649 | '\'' <- ch = "\\\'"
650− | ch `elem` asciiTab = "\\u00" ++ fill (showIntAtBase 16 intToDigit (ord ch) "")
650+ | ch `elem` asciiTab = "\\u00" ++ fill (showHex (ord ch) "")
651 | otherwise = [ch]
651 | otherwise = [ch]
653 fill :: String -> String
653 fill :: String -> String
@@ -663,8 +663,8 @@ translateChar ch
664translateName :: Name -> String
664translateName :: Name -> String
665translateName n = "_idris_" ++ concatMap cchar (showCG n)
665translateName n = "_idris_" ++ concatMap cchar (showCG n)
666− where cchar x | isAlpha x || isDigit x = [x]
666+ where cchar x | isAlphaNum x = [x]
667− | otherwise = "_" ++ show (fromEnum x) ++ "_"
667+ | otherwise = "_" ++ show (fromEnum x) ++ "_"
669jsASSIGN :: CompileInfo -> Reg -> Reg -> JS
669jsASSIGN :: CompileInfo -> Reg -> Reg -> JS
670jsASSIGN _ r1 r2 = JSAssign (translateReg r1) (translateReg r2)
670jsASSIGN _ r1 r2 = JSAssign (translateReg r1) (translateReg r2)