Show.fs 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328
  1. module Qsp.Show
  2. open FsharpMyExtension
  3. open FsharpMyExtension.ShowList
  4. open Qsp.Ast
  5. type FormatConfig =
  6. {
  7. IsSplitStringPl: bool
  8. TrimWhitespaceWhenSplit: bool
  9. }
  10. static member Default =
  11. {
  12. IsSplitStringPl = false
  13. TrimWhitespaceWhenSplit = false
  14. }
  15. let showVarType = function
  16. | StringType -> showChar '$'
  17. | ImplicitNumericType -> empty
  18. | ExplicitNumericType -> showChar '#'
  19. let showVar (typ:VarType, varName:string) =
  20. showVarType typ << showString varName
  21. let rec showStringLines showExpr showStmtsInline (lines:list<Line>) =
  22. lines
  23. |> List.map (
  24. List.collect (
  25. function
  26. | StringKind x ->
  27. showString (x.Replace("'", "''"))
  28. |> List.singleton
  29. | ExprKind x ->
  30. showExpr x
  31. |> show
  32. |> fun x -> x.Replace("'", "''") // TODO: стоит ли говорить, что все эти былины с `.Replace("'", "''")` нужно превратить в нормальный код?
  33. |> showString
  34. |> bet "<<" ">>"
  35. |> List.singleton
  36. | HyperLinkKind(x, body) ->
  37. let attValue =
  38. match x with
  39. | Raw x ->
  40. x.Replace("'", "''")
  41. |> showString
  42. | StaticStmts(x) ->
  43. showStmtsInline x
  44. |> show
  45. |> fun x -> x.Replace("'", "''")
  46. |> showString
  47. let header =
  48. showString "<a href=\"exec: "
  49. << attValue
  50. << showString "\">"
  51. match showStringLines showExpr showStmtsInline body with
  52. | [] ->
  53. header
  54. << showString "</a>"
  55. |> List.singleton
  56. | [x] ->
  57. header
  58. << x
  59. << showString "</a>"
  60. |> List.singleton
  61. | xs ->
  62. xs
  63. |> List.mapStartMidEnd
  64. (fun x -> header << x)
  65. id
  66. (fun x -> x << showString "</a>")
  67. |> fun x -> x // TODO: и все строки позже соединятся воедино, даже пробелов не удостоятся, ага.
  68. ) >> joinsEmpty empty
  69. )
  70. let showValue showExpr showStmtsInline = function
  71. | Int x -> shows x
  72. | String lines ->
  73. showStringLines showExpr showStmtsInline lines
  74. |> joinsEmpty (showString "\n")
  75. |> bet "'" "'"
  76. let ops = Op.toString >> showString
  77. let unar = function No -> "no" | Obj -> "obj" | Neg -> "-" | Loc -> "loc"
  78. let rec simpleShowExpr showStmtsInline expr : ShowS =
  79. let rec f = function
  80. | Val v -> showValue (simpleShowExpr showStmtsInline) showStmtsInline v
  81. | Var v -> showVar v
  82. | Func(name, args) ->
  83. let args =
  84. if List.isEmpty args then
  85. empty
  86. else
  87. showParen true (List.map f args |> join ", ")
  88. showString name << args
  89. | UnarExpr(op, e) ->
  90. let space = function Obj | No | Loc -> showSpace | Neg -> id
  91. let x =
  92. match e with
  93. | Expr(_, _, _) ->
  94. showParen true (f e)
  95. | Arr(_, _) // `-(arr[idx])` лучше выглядит, чем `-arr[idx]`?
  96. | Func(_, _) // `-(func(idx))` лучше выглядит, чем `-(arr(idx))`?
  97. | UnarExpr _
  98. | Val _
  99. | Var _ ->
  100. space op << f e
  101. showString (unar op) << x
  102. | Expr(op, e1, e2) ->
  103. let f body =
  104. match body with
  105. | Val(_)
  106. | Var _ -> f body
  107. | UnarExpr(_, _)
  108. | Expr(_, _, _) ->
  109. showParen true (f body)
  110. | Func(_, _)
  111. | Arr(_, _) ->
  112. f body
  113. f e1 << showSpace
  114. << ops op << showSpace
  115. << f e2
  116. | Arr(var, es) ->
  117. showVar var << bet "[" "]" (List.map f es |> join ", ")
  118. f expr
  119. let rec showExpr showStmtsInline = function
  120. | Val v -> showValue (showExpr showStmtsInline) showStmtsInline v
  121. | Var v -> showVar v
  122. | Func(name, args) ->
  123. let args =
  124. if List.isEmpty args then
  125. empty
  126. else
  127. showParen true
  128. (List.map (showExpr showStmtsInline) args |> join ", ")
  129. showString name << args
  130. | UnarExpr(op, e) ->
  131. let space = function Obj | No | Loc -> showSpace | Neg -> id
  132. showString (unar op) << space op << showExpr showStmtsInline e
  133. | Expr(op, e1, e2) ->
  134. let prec = Precedences.OpB >> Precedences.prec
  135. let f = function
  136. | Expr(op', _, _) -> showParen (prec op > prec op')
  137. | UnarExpr _ -> showParen true | _ -> id
  138. let f x = f x (showExpr showStmtsInline x)
  139. f e1 << showSpace << ops op << showSpace << f e2
  140. | Arr(var, es) -> showVar var << bet "[" "]" (List.map (showExpr showStmtsInline) es |> join ", ")
  141. let showAssign showStmtsInline = function
  142. | AssignWhat.AssignArr(var, key) -> showVar var << bet "[" "]" (showExpr showStmtsInline key)
  143. | AssignWhat.AssignVar var -> showVar var
  144. | AssignWhat.AssignArrAppend var -> showVar var << showString "[]"
  145. let (|OneStmt|_|) = function
  146. | [x] ->
  147. match x with
  148. // | StarPl(Val (String _)) -> None
  149. | StarPl _ -> None // Как правило, строки очень длинные, потому пусть лучше будет так
  150. | Assign _ | CallSt _ | Comment _ -> Some x
  151. | AssignCode _ -> None // спорно
  152. | Act _ | If _ -> None
  153. | Label _ -> None // эту нечисть нужно как можно более нагляднее подчеркнуть. Да странно будет, если она окажется одна в списке инструкций.
  154. | Exit -> None // ¯\_(ツ)_/¯
  155. | For _ -> None
  156. | _ -> None
  157. let (|AssingName|) = function AssignArr(x, _) -> x | AssignVar x -> x | AssignArrAppend x -> x
  158. type IndentsOption =
  159. | UsingSpaces of int
  160. | UsingTabs
  161. let spaceBetween (s:ShowS) : ShowS =
  162. showSpace << s << showSpace
  163. let showStmt indentsOption (formatConfig:FormatConfig) =
  164. let tabs =
  165. match indentsOption with
  166. | UsingTabs ->
  167. showChar '\t'
  168. | UsingSpaces spacesCount ->
  169. replicate spacesCount ' '
  170. let rec f' stmt =
  171. let showStmtsInline xs : ShowS =
  172. List.collect f' xs // TODO
  173. |> join "&"
  174. let showAssign = showAssign showStmtsInline
  175. let showExpr = showExpr showStmtsInline
  176. let showStringLines = showStringLines showExpr showStmtsInline
  177. match stmt with
  178. | Assign(AssingName name' as ass, Expr((Plus|Minus) as op, Var name, e)) when name' = name ->
  179. [showAssign ass << spaceBetween (ops op << showChar '=') << showExpr e]
  180. | Assign(AssingName name' as ass, Expr((Plus|Minus) as op, e, Var name)) when name' = name ->
  181. [showAssign ass << spaceBetween (showChar '=' << ops op) << showExpr e]
  182. | Assign(ass, e) ->
  183. [showAssign ass << spaceBetween (showChar '=') << showExpr e]
  184. | CallSt(name, es) ->
  185. let args =
  186. if List.isEmpty es then
  187. empty
  188. else
  189. showSpace << (List.map showExpr es |> join ", ")
  190. [ showString name << args ]
  191. | StarPl e ->
  192. if formatConfig.IsSplitStringPl then
  193. match e with
  194. | Val(String str) ->
  195. let str =
  196. if formatConfig.TrimWhitespaceWhenSplit then
  197. str
  198. |> List.map (
  199. List.map (function
  200. | StringKind x -> StringKind (x.Trim())
  201. | x -> x)
  202. )
  203. else
  204. str
  205. showStringLines str
  206. |> List.map (bet "'" "'")
  207. | _ ->
  208. [ showExpr e ]
  209. else
  210. [ showExpr e ]
  211. | Label s -> [showChar ':' << showString s]
  212. | If(e, thenBody, elseBody) ->
  213. let ifHeader e = showString "if" << showSpace << showExpr e << showChar ':'
  214. [
  215. match thenBody, elseBody with
  216. | OneStmt x, OneStmt y ->
  217. yield ifHeader e
  218. << showSpace << showStmtsInline [x]
  219. << spaceBetween (showString "else")
  220. << showStmtsInline [y]
  221. | OneStmt x, [] ->
  222. yield ifHeader e
  223. << showSpace << showStmtsInline [x]
  224. | _ ->
  225. let rec body : _ -> ShowS list = function
  226. | [If(e, thenBody, elseBody)] ->
  227. [
  228. yield showString "elseif" << showSpace << showExpr e << showChar ':'
  229. yield! thenBody
  230. |> List.collect
  231. (f' >> List.map ((<<) tabs))
  232. yield! body elseBody
  233. ]
  234. | [] -> []
  235. | xs ->
  236. [
  237. yield showString "else"
  238. yield!
  239. xs
  240. |> List.collect
  241. (f' >> List.map ((<<) tabs))
  242. ]
  243. yield ifHeader e
  244. yield! thenBody
  245. |> List.collect
  246. (f' >> List.map ((<<) tabs))
  247. yield! body elseBody
  248. yield showString "end"
  249. ]
  250. | Act(es, body) ->
  251. let header = showString "act" << showSpace << join ", " (List.map showExpr es) << showChar ':'
  252. [
  253. match body with
  254. | OneStmt x ->
  255. yield header << showSpace << showStmtsInline [x]
  256. | _ ->
  257. yield header
  258. yield!
  259. body
  260. |> List.collect
  261. (f' >> List.map ((<<) tabs))
  262. yield showString "end"
  263. ]
  264. | For(var, fromExpr, toExpr, stepExpr, body) ->
  265. let header =
  266. showString "for"
  267. << showSpace << showVar var
  268. << showSpace << showChar '='
  269. << showSpace << showExpr fromExpr
  270. << showSpace << showString "to"
  271. << showSpace << showExpr toExpr
  272. << (stepExpr
  273. |> Option.map (fun expr ->
  274. showSpace << showString "step"
  275. << showSpace << showExpr expr
  276. ) |> Option.defaultValue empty)
  277. << showChar ':'
  278. [
  279. match body with
  280. | OneStmt x ->
  281. yield header << showSpace << showStmtsInline [x]
  282. | _ ->
  283. yield header
  284. yield!
  285. body
  286. |> List.collect
  287. (f' >> List.map ((<<) tabs))
  288. yield showString "end"
  289. ]
  290. | Comment s -> [showChar '!' << showString s]
  291. | AssignCode(ass, stmts) ->
  292. let header = showAssign ass << spaceBetween (showChar '=') << showChar '{'
  293. [
  294. if List.isEmpty stmts then
  295. yield header << showChar '}'
  296. else
  297. yield header
  298. yield!
  299. stmts
  300. |> List.collect
  301. (f' >> List.map ((<<) tabs))
  302. yield showChar '}'
  303. ]
  304. | Exit -> [showString "exit"]
  305. f'
  306. let showLoc indentsOption isSplitStringPl (Location(name, statements)) : ShowS list =
  307. [
  308. yield showString "# " << showString name
  309. yield! List.collect (showStmt indentsOption isSplitStringPl) statements
  310. yield showString (sprintf "--- %s ----------" name)
  311. ]
  312. let printLocs indentsOption isSplitStringPl xs =
  313. List.map (lines << showLoc indentsOption isSplitStringPl) xs
  314. |> joinEmpty "\n\n"
  315. |> show