9ed63a9 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

fix basic008

9ed63a9be5invis9 years ago

src/IRTS/JavaScript/AST.hs+2−2

compare with master

unifiedsplit

@@ -31,6 +31,7 @@ import Numeric

32data JsStmt

33 = JsEmpty

34+ | JsComment Text

34 | JsExprStmt JsExpr

35 | JsExprStmt JsExpr

35 | JsFun Text

36 | JsFun Text

36 [Text]

37 [Text]

@@ -94,7 +95,6 @@ data JsExpr

94 | JsForeign Text

95 | JsForeign Text

95 [JsExpr]

96 [JsExpr]

96 | JsB2I JsExpr

97 | JsB2I JsExpr

97− | JsComment Text

98 | JsForce JsExpr

99 deriving (Show, Eq, Data, Typeable)

100

@@ -152,6 +152,7 @@ jsSetVar n x = JsSet (JsVar n) x

152

153jsStmt2Text :: JsStmt -> Text

154jsStmt2Text JsEmpty = ""

155+jsStmt2Text (JsComment c) = T.unlines $ map ("// " `T.append`) $ T.lines c

155jsStmt2Text (JsExprStmt e) = T.concat [jsAst2Text e, ";"]

156jsStmt2Text (JsExprStmt e) = T.concat [jsAst2Text e, ";"]

156jsStmt2Text (JsReturn x) = T.concat ["return ", jsAst2Text x, ";"]

157jsStmt2Text (JsReturn x) = T.concat ["return ", jsAst2Text x, ";"]

157jsStmt2Text (JsDecVar name exp) =

158jsStmt2Text (JsDecVar name exp) =

@@ -283,7 +284,6 @@ jsAst2Text (JsForeign code args) =

283 args_repl (T.replace ("%" `T.append` T.pack (show i)) (T.concat ["(", t, ")"]) c) (i + 1) r

284 args_repl (T.replace ("%" `T.append` T.pack (show i)) (T.concat ["(", t, ")"]) c) (i + 1) r

284 in T.concat ["(", args_repl code 0 (map jsAst2Text args), ")"]

285 in T.concat ["(", args_repl code 0 (map jsAst2Text args), ")"]

285jsAst2Text (JsB2I x) = jsAst2Text $ JsBinOp "+" x (JsInt 0)

286jsAst2Text (JsB2I x) = jsAst2Text $ JsBinOp "+" x (JsInt 0)

286−jsAst2Text (JsComment c) = T.concat ["/*", c, "*/"]

287jsAst2Text (JsForce e) = T.concat ["js_idris_force(", jsAst2Text e, ")"]

288

289jsLazy :: JsExpr -> JsExpr

src/IRTS/JavaScript/Codegen.hs+2−9

@@ -164,7 +164,7 @@ doCodegen conf defs decls =

164doCodegenDecl :: CGConf -> Map Name LDecl -> LDecl -> (Text, CGStats)

165doCodegenDecl conf defs (LFun _ n args def) =

166 let (ast, stats) = cgFun conf defs n args def

167− in (jsStmt2Text $ ast, stats)

167+ in (T.concat [jsStmt2Text (JsComment $ T.pack $ show n), "\n", jsStmt2Text ast], stats)

168doCodegenDecl conf defs (LConstructor n i sz) = ("", emptyStats)

169

170seqJs :: [JsStmt] -> JsStmt

@@ -347,14 +347,7 @@ cgBody' rt (LV (Glob n)) =

347 do

348 argsFn <- getArgList n

349 case argsFn of

350− Just [] -> do

350+ Just a -> cgBody' rt (LApp False (LV (Glob n)) [])

351− n' <- cgName n

352− pure $ ([], addRT rt n')

353− Just a ->

354− do

355− let part = Partial n 0 (length a)

356− addPartial part

357− pure ([], addRT rt $ jsAppN (jsNamePartial part) [])

358 Nothing -> do

351 Nothing -> do

359 n' <- cgName n

352 n' <- cgName n

360 pure $ ([], addRT rt n')

353 pure $ ([], addRT rt n')

src/IRTS/JavaScript/Name.hs+2−40

@@ -35,47 +35,9 @@ jsEscape = concatMap jschar

35 | x == '.' = "__"

36 | otherwise = "_" ++ show (fromEnum x) ++ "_"

38−showCGJS :: Name -> String

39−showCGJS (UN n) = "u$" ++ jsEscape (T.unpack n)

40−showCGJS (NS n s) = "q_" ++ show (length s) ++ "$" ++ showSep "$" (map (jsEscape . T.unpack) (reverse s))

41− ++ "$" ++ showCGJS n

42−showCGJS (MN _ u) | u == txt "underscore" = "_"

43−showCGJS (MN i s) = "t$" ++ jsEscape (T.unpack s) ++ "$" ++ show i

44−showCGJS (SN s) = showCGJS' s

45− where

46− showCGJS' (WhereN i p c) =

47− "where$" ++ showCGJS p ++ "$" ++ showCGJS c ++ "$" ++ show i

48− showCGJS' (WithN i n) = "with$" ++ showCGJS n ++ "$" ++ show i

49− showCGJS' (ImplementationN cl impl) =

50− "impl_" ++ show (length impl) ++ "$" ++ showCGJS cl ++ "$"

51− ++ showSep "$" (map (jsEscape . T.unpack) impl)

52− showCGJS' (MethodN m) = "meth$" ++ showCGJS m

53− showCGJS' (ParentN p c) = "parent$" ++ showCGJS p ++ "$" ++ show c

54− showCGJS' (CaseN fc c) = "case$" ++ showCGJS c ++ "$" ++ showFC' fc

55− showCGJS' (ElimN sn) = "elim$" ++ showCGJS sn

56− showCGJS' (ImplementationCtorN n) = "ictor$" ++ showCGJS n

57− showCGJS' (MetaN parent meta) =

58− "meta$" ++ showCGJS parent ++ "$" ++ showCGJS meta

59− showFC' (FC' NoFC) = ""

60− showFC' (FC' (FileFC f)) = "_" ++ cgFN f

61− showFC' (FC' (FC f s e))

62− | s == e = "_" ++ cgFN f ++ "_" ++ show (fst s) ++ "_" ++ show (snd s)

63− | otherwise =

64− "_" ++

65− cgFN f ++

66− "_" ++

67− show (fst s) ++

68− "_" ++ show (snd s) ++ "_" ++ show (fst e) ++ "_" ++ show (snd e)

69− cgFN =

70− concatMap

71− (\c ->

72− if not (isDigit c || isLetter c)

73− then "__"

74− else [c])

75−showCGJS (SymRef i) = error "can't do codegen for a symbol reference"

76−

77jsName :: Name -> Text

38jsName :: Name -> Text

78−jsName n = T.pack $ showCGJS n

39+jsName (MN i u) = T.concat ["$_", T.pack (show i), "_", T.pack $ jsEscape $ T.unpack u]

40+jsName n = T.pack $ jsEscape $ showCG n

80jsNameGenerated :: Int -> Text

42jsNameGenerated :: Int -> Text

81jsNameGenerated v = T.pack $ "$cg$" ++ show v

43jsNameGenerated v = T.pack $ "$cg$" ++ show v