[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[原创] 由纯 VBScript 编写的 Lisp 语言解释器 - MAL.VBS

本帖最后由 老刘1号 于 2023-7-8 13:09 编辑
  1. ' mal.vbs
  2. ' A MAL (Lisp) Language Interpreter witten in VBScript
  3. ' Code by OldLiu (632171029@qq.com)
  4. ' https://github.com/kanaka/mal
  5. ' https://github.com/OldLiu001/mal/tree/master/impls/vbs
  6. Option Explicit
  7. CreateObject("System.Collections.ArrayList")
  8. Const strHost = "CSCRIPT.EXE" 'WSCRIPT
  9. If Not UCase(Right(WScript.FullName,11)) = UCase(strHost) Then
  10. Dim Args,Arg
  11. For Each Arg in Wscript.Arguments
  12. Args=Args&Chr(&H20)&Chr(&H22)&Arg&Chr(&H22)
  13. Next
  14. CreateObject("Wscript.Shell").Run _
  15. strHost&Chr(&H20)&Chr(&H22)&WScript.ScriptFullName&Chr(&H22)&Args
  16. WScript.Quit
  17. End If
  18. Dim TYPES
  19. Set TYPES = New MalTypes
  20. Class MalTypes
  21. Public LIST, VECTOR, HASHMAP, [BOOLEAN], NIL
  22. Public KEYWORD, [STRING], NUMBER, SYMBOL
  23. Public PROCEDURE, ATOM
  24. Public [TypeName]
  25. Private Sub Class_Initialize
  26. [TypeName] = Array( _
  27. "LIST", "VECTOR", "HASHMAP", "BOOLEAN", _
  28. "NIL", "KEYWORD", "STRING", "NUMBER", _
  29. "SYMBOL", "PROCEDURE", "ATOM")
  30. Dim i
  31. For i = 0 To UBound([TypeName])
  32. Execute "[" + [TypeName](i) + "] = " + CStr(i)
  33. Next
  34. End Sub
  35. End Class
  36. Class MalType
  37. Public [Type]
  38. Public Value
  39. Private varMeta
  40. Public Property Get MetaData()
  41. If IsEmpty(varMeta) Then
  42. Set MetaData = NewMalNil()
  43. Else
  44. Set MetaData = varMeta
  45. End If
  46. End Property
  47. Public Property Set MetaData(objMeta)
  48. Set varMeta = objMeta
  49. End Property
  50. Public Function Copy()
  51. Set Copy = NewMalType([Type], Value)
  52. End Function
  53. Public Function Init(lngType, varValue)
  54. [Type] = lngType
  55. Value = varValue
  56. End Function
  57. End Class
  58. Function NewMalType(lngType, varValue)
  59. Dim varResult
  60. Set varResult = New MalType
  61. varResult.Init lngType, varValue
  62. Set NewMalType = varResult
  63. End Function
  64. Function NewMalBool(varValue)
  65. Set NewMalBool = NewMalType(TYPES.BOOLEAN, varValue)
  66. End Function
  67. Function NewMalNil()
  68. Set NewMalNil = NewMalType(TYPES.NIL, Empty)
  69. End Function
  70. Function NewMalKwd(varValue)
  71. Set NewMalKwd = NewMalType(TYPES.KEYWORD, varValue)
  72. End Function
  73. Function NewMalStr(varValue)
  74. Set NewMalStr = NewMalType(TYPES.STRING, varValue)
  75. End Function
  76. Function NewMalNum(varValue)
  77. Set NewMalNum = NewMalType(TYPES.NUMBER, varValue)
  78. End Function
  79. Function NewMalSym(varValue)
  80. Set NewMalSym = NewMalType(TYPES.SYMBOL, varValue)
  81. End Function
  82. Class MalAtom
  83. Public [Type]
  84. Public Value
  85. Private varMeta
  86. Public Property Get MetaData()
  87. If IsEmpty(varMeta) Then
  88. Set MetaData = NewMalNil()
  89. Else
  90. Set MetaData = varMeta
  91. End If
  92. End Property
  93. Public Property Set MetaData(objMeta)
  94. Set varMeta = objMeta
  95. End Property
  96. Public Function Copy()
  97. Set Copy = NewMalAtom(Value)
  98. End Function
  99. Public Sub Reset(objMal)
  100. Set Value = objMal
  101. End Sub
  102. Private Sub Class_Initialize
  103. [Type] = TYPES.ATOM
  104. End Sub
  105. End Class
  106. Function NewMalAtom(varValue)
  107. Dim varRes
  108. Set varRes = New MalAtom
  109. varRes.Reset varValue
  110. Set NewMalAtom = varRes
  111. End Function
  112. Class MalList ' Extends MalType
  113. Public [Type]
  114. Public Value
  115. Private varMeta
  116. Public Property Get MetaData()
  117. If IsEmpty(varMeta) Then
  118. Set MetaData = NewMalNil()
  119. Else
  120. Set MetaData = varMeta
  121. End If
  122. End Property
  123. Public Property Set MetaData(objMeta)
  124. Set varMeta = objMeta
  125. End Property
  126. Public Function Copy()
  127. Set Copy = New MalList
  128. Set Copy.Value = Value
  129. End Function
  130. Private Sub Class_Initialize
  131. [Type] = TYPES.LIST
  132. Set Value = CreateObject("System.Collections.ArrayList")
  133. End Sub
  134. Public Function Init(arrValues)
  135. Dim i
  136. For i = 0 To UBound(arrValues)
  137. Add arrValues(i)
  138. Next
  139. End Function
  140. Public Function Add(objMalType)
  141. Value.Add objMalType
  142. End Function
  143. Public Property Get Item(i)
  144. Set Item = Value.Item(i)
  145. End Property
  146. Public Property Let Item(i, varValue)
  147. Value.Item(i) = varValue
  148. End Property
  149. Public Property Set Item(i, varValue)
  150. Set Value.Item(i) = varValue
  151. End Property
  152. Public Function Count()
  153. Count = Value.Count
  154. End Function
  155. End Class
  156. Function NewMalList(arrValues)
  157. Dim varResult
  158. Set varResult = New MalList
  159. varResult.Init arrValues
  160. Set NewMalList = varResult
  161. End Function
  162. Class MalVector ' Extends MalType
  163. Public [Type]
  164. Public Value
  165. Private varMeta
  166. Public Property Get MetaData()
  167. If IsEmpty(varMeta) Then
  168. Set MetaData = NewMalNil()
  169. Else
  170. Set MetaData = varMeta
  171. End If
  172. End Property
  173. Public Property Set MetaData(objMeta)
  174. Set varMeta = objMeta
  175. End Property
  176. Public Function Copy()
  177. Set Copy = New MalVector
  178. Set Copy.Value = Value
  179. End Function
  180. Private Sub Class_Initialize
  181. [Type] = TYPES.VECTOR
  182. Set Value = CreateObject("System.Collections.ArrayList")
  183. End Sub
  184. Public Function Init(arrValues)
  185. Dim i
  186. For i = 0 To UBound(arrValues)
  187. Add arrValues(i)
  188. Next
  189. End Function
  190. Public Function Add(objMalType)
  191. Value.Add objMalType
  192. End Function
  193. Public Property Get Item(i)
  194. Set Item = Value.Item(i)
  195. End Property
  196. Public Property Let Item(i, varValue)
  197. Value.Item(i) = varValue
  198. End Property
  199. Public Property Set Item(i, varValue)
  200. Set Value.Item(i) = varValue
  201. End Property
  202. Public Function Count()
  203. Count = Value.Count
  204. End Function
  205. End Class
  206. Function NewMalVec(arrValues)
  207. Dim varResult
  208. Set varResult = New MalVector
  209. varResult.Init arrValues
  210. Set NewMalVec = varResult
  211. End Function
  212. Class MalHashmap 'Extends MalType
  213. Public [Type]
  214. Public Value
  215. Private varMeta
  216. Public Property Get MetaData()
  217. If IsEmpty(varMeta) Then
  218. Set MetaData = NewMalNil()
  219. Else
  220. Set MetaData = varMeta
  221. End If
  222. End Property
  223. Public Property Set MetaData(objMeta)
  224. Set varMeta = objMeta
  225. End Property
  226. Public Function Copy()
  227. Set Copy = New MalHashmap
  228. Set Copy.Value = Value
  229. End Function
  230. Private Sub Class_Initialize
  231. [Type] = TYPES.HASHMAP
  232. Set Value = CreateObject("Scripting.Dictionary")
  233. End Sub
  234. Public Function Init(arrKeys, arrValues)
  235. Dim i
  236. For i = 0 To UBound(arrKeys)
  237. Add arrKeys(i), arrValues(i)
  238. Next
  239. End Function
  240. Private Function M2S(objKey)
  241. Dim varRes
  242. Select Case objKey.Type
  243. Case TYPES.STRING
  244. varRes = "S" + objKey.Value
  245. Case TYPES.KEYWORD
  246. varRes = "K" + objKey.Value
  247. Case Else
  248. Err.Raise vbObjectError, _
  249. "MalHashmap", "Unexpect key type."
  250. End Select
  251. M2S = varRes
  252. End Function
  253. Private Function S2M(strKey)
  254. Dim varRes
  255. Select Case Left(strKey, 1)
  256. Case "S"
  257. Set varRes = NewMalStr(Right(strKey, Len(strKey) - 1))
  258. Case "K"
  259. Set varRes = NewMalKwd(Right(strKey, Len(strKey) - 1))
  260. Case Else
  261. Err.Raise vbObjectError, _
  262. "MalHashmap", "Unexpect key type."
  263. End Select
  264. Set S2M = varRes
  265. End Function
  266. Public Function Add(varKey, varValue)
  267. If varKey.Type <> TYPES.STRING And _
  268. varKey.Type <> TYPES.KEYWORD Then
  269. Err.Raise vbObjectError, _
  270. "MalHashmap", "Unexpect key type."
  271. End If
  272. Set Value.Item(M2S(varKey)) = varValue
  273. 'Value.Add M2S(varKey), varValue
  274. End Function
  275. Public Property Get Keys()
  276. Dim aKeys
  277. aKeys = Value.Keys
  278. Dim aRes()
  279. ReDim aRes(UBound(aKeys))
  280. Dim i
  281. For i = 0 To UBound(aRes)
  282. Set aRes(i) = S2M(aKeys(i))
  283. Next
  284. Keys = aRes
  285. End Property
  286. Public Function Count()
  287. Count = Value.Count
  288. End Function
  289. Public Property Get Item(i)
  290. Set Item = Value.Item(M2S(i))
  291. End Property
  292. Public Function Exists(varKey)
  293. If varKey.Type <> TYPES.STRING And _
  294. varKey.Type <> TYPES.KEYWORD Then
  295. Err.Raise vbObjectError, _
  296. "MalHashmap", "Unexpect key type."
  297. End If
  298. Exists = Value.Exists(M2S(varKey))
  299. End Function
  300. Public Property Let Item(i, varValue)
  301. Value.Item(M2S(i)) = varValue
  302. End Property
  303. Public Property Set Item(i, varValue)
  304. Set Value.Item(M2S(i)) = varValue
  305. End Property
  306. End Class
  307. Function NewMalMap(arrKeys, arrValues)
  308. Dim varResult
  309. Set varResult = New MalHashmap
  310. varResult.Init arrKeys, arrValues
  311. Set NewMalMap = varResult
  312. End Function
  313. Class VbsProcedure 'Extends MalType
  314. Public [Type]
  315. Public Value
  316. Public IsMacro
  317. Public boolSpec
  318. Public MetaData
  319. Private Sub Class_Initialize
  320. [Type] = TYPES.PROCEDURE
  321. IsMacro = False
  322. Set MetaData = NewMalNil()
  323. End Sub
  324. Public Property Get IsSpecial()
  325. IsSpecial = boolSpec
  326. End Property
  327. Public Function Init(objFunction, boolIsSpec)
  328. Set Value = objFunction
  329. boolSpec = boolIsSpec
  330. End Function
  331. Public Function Apply(objArgs, objEnv)
  332. Dim varResult
  333. If boolSpec Then
  334. Set varResult = Value(objArgs, objEnv)
  335. Else
  336. Set varResult = Value(EvaluateRest(objArgs, objEnv), objEnv)
  337. End If
  338. Set Apply = varResult
  339. End Function
  340. Public Function ApplyWithoutEval(objArgs, objEnv)
  341. Dim varResult
  342. Set varResult = Value(objArgs, objEnv)
  343. Set ApplyWithoutEval = varResult
  344. End Function
  345. Public Function Copy()
  346. Dim varRes
  347. Set varRes = New VbsProcedure
  348. varRes.Type = [Type]
  349. Set varRes.Value = Value
  350. varRes.IsMacro = IsMacro
  351. varRes.boolSpec = boolSpec
  352. Set Copy = varRes
  353. End Function
  354. End Class
  355. Function NewVbsProc(strFnName, boolSpec)
  356. Dim varResult
  357. Set varResult = New VbsProcedure
  358. varResult.Init GetRef(strFnName), boolSpec
  359. Set NewVbsProc = varResult
  360. End Function
  361. Class MalProcedure 'Extends MalType
  362. Public [Type]
  363. Public Value
  364. Public IsMacro
  365. Public Property Get IsSpecial()
  366. IsSpecial = False
  367. End Property
  368. Public MetaData
  369. Private Sub Class_Initialize
  370. [Type] = TYPES.PROCEDURE
  371. IsMacro = False
  372. Set MetaData = NewMalNil()
  373. End Sub
  374. Public objParams, objCode, objSavedEnv
  375. Public Function Init(objP, objC, objE)
  376. Set objParams = objP
  377. Set objCode = objC
  378. Set objSavedEnv = objE
  379. End Function
  380. Public Function Apply(objArgs, objEnv)
  381. If IsMacro Then
  382. Err.Raise vbObjectError, _
  383. "MalProcedureApply", "Not a procedure."
  384. End If
  385. Dim varRet
  386. Dim objNewEnv
  387. Set objNewEnv = NewEnv(objSavedEnv)
  388. Dim i
  389. i = 0
  390. Dim objList
  391. While i < objParams.Count
  392. If objParams.Item(i).Value = "&" Then
  393. If objParams.Count - 1 = i + 1 Then
  394. Set objList = NewMalList(Array())
  395. objNewEnv.Add objParams.Item(i + 1), objList
  396. While i + 1 < objArgs.Count
  397. objList.Add Evaluate(objArgs.Item(i + 1), objEnv)
  398. i = i + 1
  399. Wend
  400. i = objParams.Count ' Break While
  401. Else
  402. Err.Raise vbObjectError, _
  403. "MalProcedureApply", "Invalid parameter(s)."
  404. End If
  405. Else
  406. If i + 1 >= objArgs.Count Then
  407. Err.Raise vbObjectError, _
  408. "MalProcedureApply", "Need more arguments."
  409. End If
  410. objNewEnv.Add objParams.Item(i), _
  411. Evaluate(objArgs.Item(i + 1), objEnv)
  412. i = i + 1
  413. End If
  414. Wend
  415. Set varRet = EvalLater(objCode, objNewEnv)
  416. Set Apply = varRet
  417. End Function
  418. Public Function MacroApply(objArgs, objEnv)
  419. If Not IsMacro Then
  420. Err.Raise vbObjectError, _
  421. "MalMacroApply", "Not a macro."
  422. End If
  423. Dim varRet
  424. Dim objNewEnv
  425. Set objNewEnv = NewEnv(objSavedEnv)
  426. Dim i
  427. i = 0
  428. Dim objList
  429. While i < objParams.Count
  430. If objParams.Item(i).Value = "&" Then
  431. If objParams.Count - 1 = i + 1 Then
  432. Set objList = NewMalList(Array())
  433. ' No evaluation
  434. objNewEnv.Add objParams.Item(i + 1), objList
  435. While i + 1 < objArgs.Count
  436. objList.Add objArgs.Item(i + 1)
  437. i = i + 1
  438. Wend
  439. i = objParams.Count ' Break While
  440. Else
  441. Err.Raise vbObjectError, _
  442. "MalMacroApply", "Invalid parameter(s)."
  443. End If
  444. Else
  445. If i + 1 >= objArgs.Count Then
  446. Err.Raise vbObjectError, _
  447. "MalMacroApply", "Need more arguments."
  448. End If
  449. ' No evaluation
  450. objNewEnv.Add objParams.Item(i), _
  451. objArgs.Item(i + 1)
  452. i = i + 1
  453. End If
  454. Wend
  455. ' EvalLater -> Evaluate
  456. Set varRet = Evaluate(objCode, objNewEnv)
  457. Set MacroApply = varRet
  458. End Function
  459. Public Function ApplyWithoutEval(objArgs, objEnv)
  460. Dim varRet
  461. Dim objNewEnv
  462. Set objNewEnv = NewEnv(objSavedEnv)
  463. Dim i
  464. i = 0
  465. Dim objList
  466. While i < objParams.Count
  467. If objParams.Item(i).Value = "&" Then
  468. If objParams.Count - 1 = i + 1 Then
  469. Set objList = NewMalList(Array())
  470. ' No evaluation
  471. objNewEnv.Add objParams.Item(i + 1), objList
  472. While i + 1 < objArgs.Count
  473. objList.Add objArgs.Item(i + 1)
  474. i = i + 1
  475. Wend
  476. i = objParams.Count ' Break While
  477. Else
  478. Err.Raise vbObjectError, _
  479. "MalMacroApply", "Invalid parameter(s)."
  480. End If
  481. Else
  482. If i + 1 >= objArgs.Count Then
  483. Err.Raise vbObjectError, _
  484. "MalMacroApply", "Need more arguments."
  485. End If
  486. ' No evaluation
  487. objNewEnv.Add objParams.Item(i), _
  488. objArgs.Item(i + 1)
  489. i = i + 1
  490. End If
  491. Wend
  492. ' EvalLater -> Evaluate
  493. Set varRet = Evaluate(objCode, objNewEnv)
  494. Set ApplyWithoutEval = varRet
  495. End Function
  496. Public Function Copy()
  497. Dim varRes
  498. Set varRes = New MalProcedure
  499. varRes.Type = [Type]
  500. varRes.Value = Value
  501. varRes.IsMacro = IsMacro
  502. Set varRes.objParams = objParams
  503. Set varRes.objCode = objCode
  504. Set varRes.objSavedEnv = objSavedEnv
  505. Set Copy = varRes
  506. End Function
  507. End Class
  508. Function NewMalProc(objParams, objCode, objEnv)
  509. Dim varRet
  510. Set varRet = New MalProcedure
  511. varRet.Init objParams, objCode, objEnv
  512. Set NewMalProc = varRet
  513. End Function
  514. Function NewMalMacro(objParams, objCode, objEnv)
  515. Dim varRet
  516. Set varRet = New MalProcedure
  517. varRet.Init objParams, objCode, objEnv
  518. varRet.IsMacro = True
  519. Set NewMalProc = varRet
  520. End Function
  521. Function SetMeta(objMal, objMeta)
  522. Dim varRes
  523. Set varRes = objMal.Copy
  524. Set varRes.MetaData = objMeta
  525. Set SetMeta = varRes
  526. End Function
  527. Function GetMeta(objMal)
  528. Set GetMeta = objMal.MetaData
  529. End Function
  530. Function ReadString(strCode)
  531. Dim objTokens
  532. Set objTokens = Tokenize(strCode)
  533. Set ReadString = ReadForm(objTokens)
  534. If Not objTokens.AtEnd() Then
  535. Err.Raise vbObjectError, _
  536. "ReadForm", "extra token '" + objTokens.Current() + "'."
  537. End If
  538. End Function
  539. Class Tokens
  540. Private objQueue
  541. Private objRE
  542. Private Sub Class_Initialize
  543. Set objRE = New RegExp
  544. With objRE
  545. .Pattern = "[\s,]*" + _
  546. "(" + _
  547. "~@" + "|" + _
  548. "[\[\]{}()'`~^@]" + "|" + _
  549. """(?:\\.|[^\\""])*""?" + "|" + _
  550. ";.*" + "|" + _
  551. "[^\s\[\]{}('""`,;)]*" + _
  552. ")"
  553. .IgnoreCase = True
  554. .Global = True
  555. End With
  556. Set objQueue = CreateObject("System.Collections.Queue")
  557. End Sub
  558. Public Function Init(strCode)
  559. Dim objMatches, objMatch
  560. Set objMatches = objRE.Execute(strCode)
  561. Dim strToken
  562. For Each objMatch In objMatches
  563. strToken = Trim(objMatch.SubMatches(0))
  564. If Not (Left(strToken, 1) = ";" Or strToken = "") Then
  565. objQueue.Enqueue strToken
  566. End If
  567. Next
  568. End Function
  569. Public Function Current()
  570. Current = objQueue.Peek()
  571. End Function
  572. Public Function MoveToNext()
  573. MoveToNext = objQueue.Dequeue()
  574. End Function
  575. Public Function AtEnd()
  576. AtEnd = (objQueue.Count = 0)
  577. End Function
  578. Public Function Count()
  579. Count = objQueue.Count
  580. End Function
  581. End Class
  582. Function Tokenize(strCode) ' Return objTokens
  583. Dim varResult
  584. Set varResult = New Tokens
  585. varResult.Init strCode
  586. Set Tokenize = varResult
  587. End Function
  588. Function ReadForm(objTokens) ' Return Nothing / MalType
  589. If objTokens.AtEnd() Then
  590. Set ReadForm = Nothing
  591. Exit Function
  592. End If
  593. Dim strToken
  594. strToken = objTokens.Current()
  595. Dim varResult
  596. If InStr("([{", strToken) Then
  597. Select Case strToken
  598. Case "("
  599. Set varResult = ReadList(objTokens)
  600. Case "["
  601. Set varResult = ReadVector(objTokens)
  602. Case "{"
  603. Set varResult = ReadHashmap(objTokens)
  604. End Select
  605. ElseIf InStr("'`~@", strToken) Then
  606. Set varResult = ReadSpecial(objTokens)
  607. ElseIf InStr(")]}", strToken) Then
  608. Err.Raise vbObjectError, _
  609. "ReadForm", "unbalanced parentheses."
  610. ElseIf strToken = "^" Then
  611. Set varResult = ReadMetadata(objTokens)
  612. Else
  613. Set varResult = ReadAtom(objTokens)
  614. End If
  615. Set ReadForm = varResult
  616. End Function
  617. Function ReadMetadata(objTokens)
  618. Dim varResult
  619. Call objTokens.MoveToNext()
  620. Dim objTemp
  621. Set objTemp = ReadForm(objTokens)
  622. Set varResult = NewMalList(Array( _
  623. NewMalSym("with-meta"), _
  624. ReadForm(objTokens), objTemp))
  625. Set ReadMetadata = varResult
  626. End Function
  627. Function ReadSpecial(objTokens)
  628. Dim varResult
  629. Dim strToken, strAlias
  630. strToken = objTokens.Current()
  631. Select Case strToken
  632. Case "'"
  633. strAlias = "quote"
  634. Case "`"
  635. strAlias = "quasiquote"
  636. Case "~"
  637. strAlias = "unquote"
  638. Case "~@"
  639. strAlias = "splice-unquote"
  640. Case "@"
  641. strAlias = "deref"
  642. Case Else
  643. Err.Raise vbObjectError, _
  644. "ReadSpecial", "unknown token '" & strAlias & "'."
  645. End Select
  646. Call objTokens.MoveToNext()
  647. Set varResult = NewMalList(Array( _
  648. NewMalSym(strAlias), _
  649. ReadForm(objTokens)))
  650. Set ReadSpecial = varResult
  651. End Function
  652. Function ReadList(objTokens)
  653. Dim varResult
  654. Call objTokens.MoveToNext()
  655. If objTokens.AtEnd() Then
  656. Err.Raise vbObjectError, _
  657. "ReadList", "unbalanced parentheses."
  658. End If
  659. Set varResult = NewMalList(Array())
  660. With varResult
  661. While objTokens.Count() > 1 And objTokens.Current() <> ")"
  662. .Add ReadForm(objTokens)
  663. Wend
  664. End With
  665. If objTokens.MoveToNext() <> ")" Then
  666. Err.Raise vbObjectError, _
  667. "ReadList", "unbalanced parentheses."
  668. End If
  669. Set ReadList = varResult
  670. End Function
  671. Function ReadVector(objTokens)
  672. Dim varResult
  673. Call objTokens.MoveToNext()
  674. If objTokens.AtEnd() Then
  675. Err.Raise vbObjectError, _
  676. "ReadVector", "unbalanced parentheses."
  677. End If
  678. Set varResult = NewMalVec(Array())
  679. With varResult
  680. While objTokens.Count() > 1 And objTokens.Current() <> "]"
  681. .Add ReadForm(objTokens)
  682. Wend
  683. End With
  684. If objTokens.MoveToNext() <> "]" Then
  685. Err.Raise vbObjectError, _
  686. "ReadVector", "unbalanced parentheses."
  687. End If
  688. Set ReadVector = varResult
  689. End Function
  690. Function ReadHashmap(objTokens)
  691. Dim varResult
  692. Call objTokens.MoveToNext()
  693. If objTokens.Count = 0 Then
  694. Err.Raise vbObjectError, _
  695. "ReadHashmap", "unbalanced parentheses."
  696. End If
  697. Set varResult = NewMalMap(Array(), Array())
  698. Dim objKey, objValue
  699. With varResult
  700. While objTokens.Count > 2 And objTokens.Current() <> "}"
  701. Set objKey = ReadForm(objTokens)
  702. Set objValue = ReadForm(objTokens)
  703. .Add objKey, objValue
  704. Wend
  705. End With
  706. If objTokens.MoveToNext() <> "}" Then
  707. Err.Raise vbObjectError, _
  708. "ReadHashmap", "unbalanced parentheses."
  709. End If
  710. Set ReadHashmap = varResult
  711. End Function
  712. Function ReadAtom(objTokens)
  713. Dim varResult
  714. Dim strAtom
  715. strAtom = objTokens.MoveToNext()
  716. Select Case strAtom
  717. Case "true"
  718. Set varResult = NewMalBool(True)
  719. Case "false"
  720. Set varResult = NewMalBool(False)
  721. Case "nil"
  722. Set varResult = NewMalNil()
  723. Case Else
  724. Select Case Left(strAtom, 1)
  725. Case ":"
  726. Set varResult = NewMalKwd(strAtom)
  727. Case """"
  728. Set varResult = NewMalStr(ParseString(strAtom))
  729. Case Else
  730. If IsNumeric(strAtom) Then
  731. Set varResult = NewMalNum(Eval(strAtom))
  732. Else
  733. Set varResult = NewMalSym(strAtom)
  734. End If
  735. End Select
  736. End Select
  737. Set ReadAtom = varResult
  738. End Function
  739. Function ParseString(strRaw)
  740. If Right(strRaw, 1) <> """" Or Len(strRaw) < 2 Then
  741. Err.Raise vbObjectError, _
  742. "ParseString", "unterminated string, got EOF."
  743. End If
  744. Dim strTemp
  745. strTemp = Mid(strRaw, 2, Len(strRaw) - 2)
  746. Dim i
  747. i = 1
  748. ParseString = ""
  749. While i <= Len(strTemp) - 1
  750. Select Case Mid(strTemp, i, 2)
  751. Case "\\"
  752. ParseString = ParseString & "\"
  753. Case "\n"
  754. ParseString = ParseString & vbCrLf
  755. Case "\"""
  756. ParseString = ParseString & """"
  757. Case Else
  758. ParseString = ParseString & Mid(strTemp, i, 1)
  759. i = i - 1
  760. End Select
  761. i = i + 2
  762. Wend
  763. If i <= Len(strTemp) Then
  764. ' Last char is not processed.
  765. If Right(strTemp, 1) <> "\" Then
  766. ParseString = ParseString & Right(strTemp, 1)
  767. Else
  768. Err.Raise vbObjectError, _
  769. "ParseString", "unterminated string, got EOF."
  770. End If
  771. End If
  772. End Function
  773. Function PrintMalType(objMal, boolReadable)
  774. Dim varResult
  775. varResult = ""
  776. If TypeName(objMal) = "Nothing" Then
  777. PrintMalType = ""
  778. Exit Function
  779. End If
  780. Dim i
  781. Select Case objMal.Type
  782. Case TYPES.LIST
  783. With objMal
  784. For i = 0 To .Count - 2
  785. varResult = varResult & _
  786. PrintMalType(.Item(i), boolReadable) & " "
  787. Next
  788. If .Count > 0 Then
  789. varResult = varResult & _
  790. PrintMalType(.Item(.Count - 1), boolReadable)
  791. End If
  792. End With
  793. varResult = "(" & varResult & ")"
  794. Case TYPES.VECTOR
  795. With objMal
  796. For i = 0 To .Count - 2
  797. varResult = varResult & _
  798. PrintMalType(.Item(i), boolReadable) & " "
  799. Next
  800. If .Count > 0 Then
  801. varResult = varResult & _
  802. PrintMalType(.Item(.Count - 1), boolReadable)
  803. End If
  804. End With
  805. varResult = "[" & varResult & "]"
  806. Case TYPES.HASHMAP
  807. With objMal
  808. Dim arrKeys
  809. arrKeys = .Keys
  810. For i = 0 To .Count - 2
  811. varResult = varResult & _
  812. PrintMalType(arrKeys(i), boolReadable) & " " & _
  813. PrintMalType(.Item(arrKeys(i)), boolReadable) & " "
  814. Next
  815. If .Count > 0 Then
  816. varResult = varResult & _
  817. PrintMalType(arrKeys(.Count - 1), boolReadable) & " " & _
  818. PrintMalType(.Item(arrKeys(.Count - 1)), boolReadable)
  819. End If
  820. End With
  821. varResult = "{" & varResult & "}"
  822. Case TYPES.STRING
  823. If boolReadable Then
  824. varResult = EscapeString(objMal.Value)
  825. Else
  826. varResult = objMal.Value
  827. End If
  828. Case TYPES.BOOLEAN
  829. If objMal.Value Then
  830. varResult = "true"
  831. Else
  832. varResult = "false"
  833. End If
  834. Case TYPES.NIL
  835. varResult = "nil"
  836. Case TYPES.NUMBER
  837. varResult = CStr(objMal.Value)
  838. Case TYPES.PROCEDURE
  839. varResult = "#<function>"
  840. Case TYPES.KEYWORD
  841. varResult = objMal.Value
  842. Case TYPES.SYMBOL
  843. varResult = objMal.Value
  844. Case TYPES.ATOM
  845. varResult = "(atom " + PrintMalType(objMal.Value, boolReadable) + ")"
  846. Case Else
  847. Err.Raise vbObjectError, _
  848. "PrintMalType", "Unknown type."
  849. End Select
  850. PrintMalType = varResult
  851. End Function
  852. Function EscapeString(strRaw)
  853. EscapeString = strRaw
  854. EscapeString = Replace(EscapeString, "\", "\\")
  855. EscapeString = Replace(EscapeString, vbCrLf, "\n")
  856. EscapeString = Replace(EscapeString, """", "\""")
  857. EscapeString = """" & EscapeString & """"
  858. End Function
  859. Function NewEnv(objOuter)
  860. Dim varRet
  861. Set varRet = New Environment
  862. Set varRet.Self = varRet
  863. Set varRet.Outer = objOuter
  864. Set NewEnv = varRet
  865. End Function
  866. Class Environment
  867. Private objOuter, objSelf
  868. Private objBinds
  869. Private Sub Class_Initialize()
  870. Set objBinds = CreateObject("Scripting.Dictionary")
  871. Set objOuter = Nothing
  872. Set objSelf = Nothing
  873. End Sub
  874. Public Property Set Outer(objEnv)
  875. Set objOuter = objEnv
  876. End Property
  877. Public Property Get Outer()
  878. Set Outer = objOuter
  879. End Property
  880. Public Property Set Self(objEnv)
  881. Set objSelf = objEnv
  882. End Property
  883. Public Sub Add(varKey, varValue)
  884. Set objBinds.Item(varKey.Value) = varValue
  885. End Sub
  886. Public Function Find(varKey)
  887. Dim varRet
  888. If objBinds.Exists(varKey.Value) Then
  889. Set varRet = objSelf
  890. Else
  891. If TypeName(objOuter) <> "Nothing" Then
  892. Set varRet = objOuter.Find(varKey)
  893. Else
  894. Err.Raise vbObjectError, _
  895. "Environment", "'" + varKey.Value + "' not found"
  896. End If
  897. End If
  898. Set Find = varRet
  899. End Function
  900. Public Function [Get](varKey)
  901. Dim objEnv, varRet
  902. Set objEnv = Find(varKey)
  903. If objEnv Is objSelf Then
  904. Set varRet = objBinds(varKey.Value)
  905. Else
  906. Set varRet = objEnv.Get(varKey)
  907. End If
  908. Set [Get] = varRet
  909. End Function
  910. End Class
  911. Sub CheckArgNum(objArgs, lngArgNum)
  912. If objArgs.Count - 1 <> lngArgNum Then
  913. Err.Raise vbObjectError, _
  914. "CheckArgNum", "Wrong number of arguments."
  915. End IF
  916. End Sub
  917. Sub CheckType(objMal, varType)
  918. If objMal.Type <> varType Then
  919. Err.Raise vbObjectError, _
  920. "CheckType", "Wrong argument type."
  921. End IF
  922. End Sub
  923. Function IsListOrVec(objMal)
  924. IsListOrVec = _
  925. objMal.Type = TYPES.LIST Or _
  926. objMal.Type = TYPES.VECTOR
  927. End Function
  928. Sub CheckListOrVec(objMal)
  929. If Not IsListOrVec(objMal) Then
  930. Err.Raise vbObjectError, _
  931. "CheckListOrVec", _
  932. "Wrong argument type, need a list or a vector."
  933. End If
  934. End Sub
  935. Dim objNS
  936. Set objNS = NewEnv(Nothing)
  937. Function MAdd(objArgs, objEnv)
  938. CheckArgNum objArgs, 2
  939. CheckType objArgs.Item(1), TYPES.NUMBER
  940. CheckType objArgs.Item(2), TYPES.NUMBER
  941. Set MAdd = NewMalNum( _
  942. objArgs.Item(1).Value + objArgs.Item(2).Value)
  943. End Function
  944. objNS.Add NewMalSym("+"), NewVbsProc("MAdd", False)
  945. Function MSub(objArgs, objEnv)
  946. CheckArgNum objArgs, 2
  947. CheckType objArgs.Item(1), TYPES.NUMBER
  948. CheckType objArgs.Item(2), TYPES.NUMBER
  949. Set MSub = NewMalNum( _
  950. objArgs.Item(1).Value - objArgs.Item(2).Value)
  951. End Function
  952. objNS.Add NewMalSym("-"), NewVbsProc("MSub", False)
  953. Function MMul(objArgs, objEnv)
  954. CheckArgNum objArgs, 2
  955. CheckType objArgs.Item(1), TYPES.NUMBER
  956. CheckType objArgs.Item(2), TYPES.NUMBER
  957. Set MMul = NewMalNum( _
  958. objArgs.Item(1).Value * objArgs.Item(2).Value)
  959. End Function
  960. objNS.Add NewMalSym("*"), NewVbsProc("MMul", False)
  961. Function MDiv(objArgs, objEnv)
  962. CheckArgNum objArgs, 2
  963. CheckType objArgs.Item(1), TYPES.NUMBER
  964. CheckType objArgs.Item(2), TYPES.NUMBER
  965. Set MDiv = NewMalNum( _
  966. objArgs.Item(1).Value \ objArgs.Item(2).Value)
  967. End Function
  968. objNS.Add NewMalSym("/"), NewVbsProc("MDiv", False)
  969. Function MList(objArgs, objEnv)
  970. Dim varRet
  971. Set varRet = NewMalList(Array())
  972. Dim i
  973. For i = 1 To objArgs.Count - 1
  974. varRet.Add objArgs.Item(i)
  975. Next
  976. Set MList = varRet
  977. End Function
  978. objNS.Add NewMalSym("list"), NewVbsProc("MList", False)
  979. Function MIsList(objArgs, objEnv)
  980. CheckArgNum objArgs, 1
  981. Set MIsList = NewMalBool(objArgs.Item(1).Type = TYPES.LIST)
  982. End Function
  983. objNS.Add NewMalSym("list?"), NewVbsProc("MIsList", False)
  984. Function MIsEmpty(objArgs, objEnv)
  985. CheckArgNum objArgs, 1
  986. CheckListOrVec objArgs.Item(1)
  987. Set MIsEmpty = NewMalBool(objArgs.Item(1).Count = 0)
  988. End Function
  989. objNS.Add NewMalSym("empty?"), NewVbsProc("MIsEmpty", False)
  990. Function MCount(objArgs, objEnv)
  991. CheckArgNum objArgs, 1
  992. If objArgs.Item(1).Type = TYPES.NIL Then
  993. Set MCount = NewMalNum(0)
  994. Else
  995. CheckListOrVec objArgs.Item(1)
  996. Set MCount = NewMalNum(objArgs.Item(1).Count)
  997. End If
  998. End Function
  999. objNS.Add NewMalSym("count"), NewVbsProc("MCount", False)
  1000. Function MEqual(objArgs, objEnv)
  1001. Dim varRet
  1002. CheckArgNum objArgs, 2
  1003. Dim boolResult, i
  1004. If IsListOrVec(objArgs.Item(1)) And _
  1005. IsListOrVec(objArgs.Item(2)) Then
  1006. If objArgs.Item(1).Count <> objArgs.Item(2).Count Then
  1007. Set varRet = NewMalBool(False)
  1008. Else
  1009. boolResult = True
  1010. For i = 0 To objArgs.Item(1).Count - 1
  1011. boolResult = boolResult And _
  1012. MEqual(NewMalList(Array(Nothing, _
  1013. objArgs.Item(1).Item(i), _
  1014. objArgs.Item(2).Item(i))), objEnv).Value
  1015. Next
  1016. Set varRet = NewMalBool(boolResult)
  1017. End If
  1018. Else
  1019. If objArgs.Item(1).Type <> objArgs.Item(2).Type Then
  1020. Set varRet = NewMalBool(False)
  1021. Else
  1022. Select Case objArgs.Item(1).Type
  1023. Case TYPES.HASHMAP
  1024. 'Err.Raise vbObjectError, _
  1025. ' "MEqual", "Not implement yet~"
  1026. If UBound(objArgs.Item(1).Keys) <> UBound(objArgs.Item(2).Keys) Then
  1027. Set varRet = NewMalBool(False)
  1028. Set MEqual = varRet
  1029. Exit Function
  1030. End If
  1031. boolResult = True
  1032. For Each i In objArgs.Item(1).Keys
  1033. If Not objArgs.Item(2).Exists(i) Then
  1034. Set varRet = NewMalBool(False)
  1035. Set MEqual = varRet
  1036. Exit Function
  1037. End If
  1038. boolResult = boolResult And _
  1039. MEqual(NewMalList(Array(Nothing, objArgs.Item(1).Item(i), objArgs.Item(2).Item(i))), objEnv).Value
  1040. Next
  1041. Set varRet = NewMalBool(boolResult)
  1042. Case Else
  1043. Set varRet = NewMalBool( _
  1044. objArgs.Item(1).Value = objArgs.Item(2).Value)
  1045. End Select
  1046. End If
  1047. End If
  1048. Set MEqual = varRet
  1049. End Function
  1050. objNS.Add NewMalSym("="), NewVbsProc("MEqual", False)
  1051. Function MGreater(objArgs, objEnv)
  1052. Dim varRet
  1053. CheckArgNum objArgs, 2
  1054. CheckType objArgs.Item(1), TYPES.NUMBER
  1055. CheckType objArgs.Item(2), TYPES.NUMBER
  1056. Set varRet = NewMalBool( _
  1057. objArgs.Item(1).Value > objArgs.Item(2).Value)
  1058. Set MGreater = varRet
  1059. End Function
  1060. objNS.Add NewMalSym(">"), NewVbsProc("MGreater", False)
  1061. Function MPrStr(objArgs, objEnv)
  1062. Dim varRet
  1063. Dim strRet
  1064. strRet = ""
  1065. Dim i
  1066. If objArgs.Count - 1 >= 1 Then
  1067. strRet = PrintMalType(objArgs.Item(1), True)
  1068. End If
  1069. For i = 2 To objArgs.Count - 1
  1070. strRet = strRet + " " + _
  1071. PrintMalType(objArgs.Item(i), True)
  1072. Next
  1073. Set varRet = NewMalStr(strRet)
  1074. Set MPrStr = varRet
  1075. End Function
  1076. objNS.Add NewMalSym("pr-str"), NewVbsProc("MPrStr", False)
  1077. Function MStr(objArgs, objEnv)
  1078. Dim varRet
  1079. Dim strRet
  1080. strRet = ""
  1081. Dim i
  1082. For i = 1 To objArgs.Count - 1
  1083. strRet = strRet + _
  1084. PrintMalType(objArgs.Item(i), False)
  1085. Next
  1086. Set varRet = NewMalStr(strRet)
  1087. Set MStr = varRet
  1088. End Function
  1089. objNS.Add NewMalSym("str"), NewVbsProc("MStr", False)
  1090. Function MPrn(objArgs, objEnv)
  1091. Dim varRet
  1092. Dim objStr
  1093. Set objStr = MPrStr(objArgs, objEnv)
  1094. WScript.StdOut.WriteLine objStr.Value
  1095. Set varRet = NewMalNil()
  1096. Set MPrn = varRet
  1097. End Function
  1098. objNS.Add NewMalSym("prn"), NewVbsProc("MPrn", False)
  1099. Function MPrintln(objArgs, objEnv)
  1100. Dim varRet
  1101. Dim strRes
  1102. strRes = ""
  1103. Dim i
  1104. If objArgs.Count - 1 >= 1 Then
  1105. strRes = PrintMalType(objArgs.Item(1), False)
  1106. End If
  1107. For i = 2 To objArgs.Count - 1
  1108. strRes = strRes + " " + _
  1109. PrintMalType(objArgs.Item(i), False)
  1110. Next
  1111. WScript.StdOut.WriteLine strRes
  1112. Set varRet = NewMalNil()
  1113. Set MPrintln = varRet
  1114. End Function
  1115. objNS.Add NewMalSym("println"), NewVbsProc("MPrintln", False)
  1116. Sub InitBuiltIn()
  1117. REP "(def! not (fn* [bool] (if bool false true)))"
  1118. REP "(def! <= (fn* [a b] (not (> a b))))"
  1119. REP "(def! < (fn* [a b] (> b a)))"
  1120. REP "(def! >= (fn* [a b] (not (> b a))))"
  1121. REP "(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) ""\nnil)"")))))"
  1122. REP "(def! cons (fn* [a b] (concat (list a) b)))"
  1123. REP "(def! nil? (fn* [x] (= x nil)))"
  1124. REP "(def! true? (fn* [x] (= x true)))"
  1125. REP "(def! false? (fn* [x] (= x false)))"
  1126. REP "(def! vector (fn* [& args] (vec args)))"
  1127. REP "(def! vals (fn* [hmap] (map (fn* [key] (get hmap key)) (keys hmap))))"
  1128. REP "(def! *host-language* ""VBScript"")"
  1129. End Sub
  1130. Function MReadStr(objArgs, objEnv)
  1131. Dim varRes
  1132. CheckArgNum objArgs, 1
  1133. CheckType objArgs.Item(1), TYPES.STRING
  1134. Set varRes = ReadString(objArgs.Item(1).Value)
  1135. If TypeName(varRes) = "Nothing" Then
  1136. Set varRes = NewMalNil()
  1137. End If
  1138. Set MReadStr = varRes
  1139. End Function
  1140. objNS.Add NewMalSym("read-string"), NewVbsProc("MReadStr", False)
  1141. Function MSlurp(objArgs, objEnv)
  1142. Dim varRes
  1143. CheckArgNum objArgs, 1
  1144. CheckType objArgs.Item(1), TYPES.STRING
  1145. Dim strRes
  1146. With CreateObject("Scripting.FileSystemObject")
  1147. strRes = .OpenTextFile( _
  1148. .GetParentFolderName( _
  1149. .GetFile(WScript.ScriptFullName)) & _
  1150. "\" & objArgs.Item(1).Value).ReadAll
  1151. End With
  1152. Set varRes = NewMalStr(strRes)
  1153. Set MSlurp = varRes
  1154. End Function
  1155. objNS.Add NewMalSym("slurp"), NewVbsProc("MSlurp", False)
  1156. Function MAtom(objArgs, objEnv)
  1157. Dim varRes
  1158. CheckArgNum objArgs, 1
  1159. Set varRes = NewMalAtom(objArgs.Item(1))
  1160. Set MAtom = varRes
  1161. End Function
  1162. objNS.Add NewMalSym("atom"), NewVbsProc("MAtom", False)
  1163. Function MIsAtom(objArgs, objEnv)
  1164. Dim varRes
  1165. CheckArgNum objArgs, 1
  1166. Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.ATOM)
  1167. Set MIsAtom = varRes
  1168. End Function
  1169. objNS.Add NewMalSym("atom?"), NewVbsProc("MIsAtom", False)
  1170. Function MDeref(objArgs, objEnv)
  1171. Dim varRes
  1172. CheckArgNum objArgs, 1
  1173. CheckType objArgs.Item(1), TYPES.ATOM
  1174. Set varRes = objArgs.Item(1).Value
  1175. Set MDeref = varRes
  1176. End Function
  1177. objNS.Add NewMalSym("deref"), NewVbsProc("MDeref", False)
  1178. Function MReset(objArgs, objEnv)
  1179. Dim varRes
  1180. CheckArgNum objArgs, 2
  1181. CheckType objArgs.Item(1), TYPES.ATOM
  1182. objArgs.Item(1).Reset objArgs.Item(2)
  1183. Set varRes = objArgs.Item(2)
  1184. Set MReset = varRes
  1185. End Function
  1186. objNS.Add NewMalSym("reset!"), NewVbsProc("MReset", False)
  1187. Function MSwap(objArgs, objEnv)
  1188. Dim varRes
  1189. If objArgs.Count - 1 < 2 Then
  1190. Err.Raise vbObjectError, _
  1191. "MSwap", "Need more arguments."
  1192. End If
  1193. Dim objAtom, objFn
  1194. Set objAtom = objArgs.Item(1)
  1195. CheckType objAtom, TYPES.ATOM
  1196. Set objFn = objArgs.Item(2)
  1197. CheckType objFn, TYPES.PROCEDURE
  1198. Dim objProg
  1199. Set objProg = NewMalList(Array(objFn))
  1200. objProg.Add objAtom.Value
  1201. Dim i
  1202. For i = 3 To objArgs.Count - 1
  1203. objProg.Add objArgs.Item(i)
  1204. Next
  1205. objAtom.Reset objFn.ApplyWithoutEval(objProg, objEnv)
  1206. Set varRes = objAtom.Value
  1207. Set MSwap = varRes
  1208. End Function
  1209. objNS.Add NewMalSym("swap!"), NewVbsProc("MSwap", False)
  1210. Function MConcat(objArgs, objEnv)
  1211. Dim varRes
  1212. Dim i, j
  1213. Set varRes = NewMalList(Array())
  1214. For i = 1 To objArgs.Count - 1
  1215. If Not IsListOrVec(objArgs.Item(i)) Then
  1216. Err.Raise vbObjectError, _
  1217. "MConcat", "Invaild argument(s)."
  1218. End If
  1219. For j = 0 To objArgs.Item(i).Count - 1
  1220. varRes.Add objArgs.Item(i).Item(j)
  1221. Next
  1222. Next
  1223. Set MConcat = varRes
  1224. End Function
  1225. objNS.Add NewMalSym("concat"), NewVbsProc("MConcat", False)
  1226. Function MVec(objArgs, objEnv)
  1227. Dim varRes
  1228. CheckArgNum objArgs, 1
  1229. CheckListOrVec objArgs.Item(1)
  1230. Set varRes = NewMalVec(Array())
  1231. Dim i
  1232. For i = 0 To objArgs.Item(1).Count - 1
  1233. varRes.Add objArgs.Item(1).Item(i)
  1234. Next
  1235. Set MVec = varRes
  1236. End Function
  1237. objNS.Add NewMalSym("vec"), NewVbsProc("MVec", False)
  1238. Function MNth(objArgs, objEnv)
  1239. Dim varRes
  1240. CheckArgNum objArgs, 2
  1241. CheckListOrVec objArgs.Item(1)
  1242. CheckType objArgs.Item(2), TYPES.NUMBER
  1243. If objArgs.Item(2).Value < objArgs.Item(1).Count Then
  1244. Set varRes = objArgs.Item(1).Item(objArgs.Item(2).Value)
  1245. Else
  1246. Err.Raise vbObjectError, _
  1247. "MNth", "Index out of bounds."
  1248. End If
  1249. Set MNth = varRes
  1250. End Function
  1251. objNS.Add NewMalSym("nth"), NewVbsProc("MNth", False)
  1252. Function MFirst(objArgs, objEnv)
  1253. Dim varRes
  1254. CheckArgNum objArgs, 1
  1255. If objArgs.Item(1).Type = TYPES.NIL Then
  1256. Set varRes = NewMalNil()
  1257. Set MFirst = varRes
  1258. Exit Function
  1259. End If
  1260. CheckListOrVec objArgs.Item(1)
  1261. If objArgs.Item(1).Count < 1 Then
  1262. Set varRes = NewMalNil()
  1263. Else
  1264. Set varRes = objArgs.Item(1).Item(0)
  1265. End If
  1266. Set MFirst = varRes
  1267. End Function
  1268. objNS.Add NewMalSym("first"), NewVbsProc("MFirst", False)
  1269. Function MRest(objArgs, objEnv)
  1270. Dim varRes
  1271. CheckArgNum objArgs, 1
  1272. If objArgs.Item(1).Type = TYPES.NIL Then
  1273. Set varRes = NewMalList(Array())
  1274. Set MRest = varRes
  1275. Exit Function
  1276. End If
  1277. Dim objList
  1278. Set objList = objArgs.Item(1)
  1279. CheckListOrVec objList
  1280. Set varRes = NewMalList(Array())
  1281. Dim i
  1282. For i = 1 To objList.Count - 1
  1283. varRes.Add objList.Item(i)
  1284. Next
  1285. Set MRest = varRes
  1286. End Function
  1287. objNS.Add NewMalSym("rest"), NewVbsProc("MRest", False)
  1288. Sub InitMacro()
  1289. REP "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw ""odd number of forms to cond"")) (cons'cond (rest (rest xs)))))))"
  1290. 'REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
  1291. REP "(def! *gensym-counter* (atom 0))"
  1292. REP "(def! gensym (fn* [] (symbol (str ""G__"" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))"
  1293. REP "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))"
  1294. End Sub
  1295. Class MalException
  1296. Private objDict
  1297. Private Sub Class_Initialize
  1298. Set objDict = CreateObject("Scripting.Dictionary")
  1299. End Sub
  1300. Public Sub Add(varKey, varValue)
  1301. objDict.Add varKey, varValue
  1302. End Sub
  1303. Public Function Item(varKey)
  1304. Set Item = objDict.Item(varKey)
  1305. End Function
  1306. Public Sub Remove(varKey)
  1307. objDict.Remove varKey
  1308. End Sub
  1309. End Class
  1310. Dim objExceptions
  1311. Set objExceptions = New MalException
  1312. Function MThrow(objArgs, objEnv)
  1313. CheckArgNum objArgs, 1
  1314. Dim strRnd
  1315. strRnd = CStr(Rnd())
  1316. objExceptions.Add strRnd, objArgs.Item(1)
  1317. Err.Raise vbObjectError, _
  1318. "MThrow", strRnd
  1319. End Function
  1320. objNS.Add NewMalSym("throw"), NewVbsProc("MThrow", False)
  1321. Function MApply(objArgs, objEnv)
  1322. Dim varRes
  1323. If objArgs.Count - 1 < 2 Then
  1324. Err.Raise vbObjectError, _
  1325. "MApply", "Need more arguments."
  1326. End If
  1327. Dim objFn
  1328. Set objFn = objArgs.Item(1)
  1329. CheckType objFn, TYPES.PROCEDURE
  1330. If objFn.IsSpecial Or objFn.IsMacro Then
  1331. Err.Raise vbObjectError, _
  1332. "MApply", "Need a function."
  1333. End If
  1334. Dim objAST
  1335. Set objAST = NewMalList(Array(objFn))
  1336. Dim i
  1337. For i = 2 To objArgs.Count - 2
  1338. objAST.Add objArgs.Item(i)
  1339. Next
  1340. Dim objSeq
  1341. Set objSeq = objArgs.Item(objArgs.Count - 1)
  1342. CheckListOrVec objSeq
  1343. For i = 0 To objSeq.Count - 1
  1344. objAST.Add objSeq.Item(i)
  1345. Next
  1346. Set varRes = objFn.ApplyWithoutEval(objAST, objEnv)
  1347. Set MApply = varRes
  1348. End Function
  1349. objNS.Add NewMalSym("apply"), NewVbsProc("MApply", False)
  1350. Function MMap(objArgs, objEnv)
  1351. Dim varRes
  1352. CheckArgNum objArgs, 2
  1353. Dim objFn, objSeq
  1354. Set objFn = objArgs.Item(1)
  1355. Set objSeq = objArgs.Item(2)
  1356. CheckType objFn, TYPES.PROCEDURE
  1357. CheckListOrVec objSeq
  1358. If objFn.IsSpecial Or objFn.IsMacro Then
  1359. Err.Raise vbObjectError, _
  1360. "MApply", "Need a function."
  1361. End If
  1362. Set varRes = NewMalList(Array())
  1363. Dim i
  1364. For i = 0 To objSeq.Count - 1
  1365. varRes.Add objFn.ApplyWithoutEval(NewMalList(Array( _
  1366. objFn, objSeq.Item(i))), objEnv)
  1367. Next
  1368. Set MMap = varRes
  1369. End Function
  1370. objNS.Add NewMalSym("map"), NewVbsProc("MMap", False)
  1371. Function MIsSymbol(objArgs, objEnv)
  1372. Dim varRes
  1373. CheckArgNum objArgs, 1
  1374. Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.SYMBOL)
  1375. Set MIsSymbol = varRes
  1376. End Function
  1377. objNS.Add NewMalSym("symbol?"), NewVbsProc("MIsSymbol", False)
  1378. Function MSymbol(objArgs, objEnv)
  1379. Dim varRes
  1380. CheckArgNum objArgs, 1
  1381. CheckType objArgs.Item(1), TYPES.STRING
  1382. Set varRes = NewMalSym(objArgs.Item(1).Value)
  1383. Set MSymbol = varRes
  1384. End Function
  1385. objNS.Add NewMalSym("symbol"), NewVbsProc("MSymbol", False)
  1386. Function MKeyword(objArgs, objEnv)
  1387. Dim varRes
  1388. CheckArgNum objArgs, 1
  1389. Select Case objArgs.Item(1).Type
  1390. Case TYPES.STRING
  1391. Set varRes = NewMalKwd(":" + objArgs.Item(1).Value)
  1392. Case TYPES.KEYWORD
  1393. Set varRes = objArgs.Item(1)
  1394. Case Else
  1395. Err.Raise vbObjectError, _
  1396. "MKeyword", "Unexpect argument(s)."
  1397. End Select
  1398. Set MKeyword = varRes
  1399. End Function
  1400. objNS.Add NewMalSym("keyword"), NewVbsProc("MKeyword", False)
  1401. Function MIsKeyword(objArgs, objEnv)
  1402. Dim varRes
  1403. CheckArgNum objArgs, 1
  1404. Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.KEYWORD)
  1405. Set MIsKeyword = varRes
  1406. End Function
  1407. objNS.Add NewMalSym("keyword?"), NewVbsProc("MIsKeyword", False)
  1408. Function MIsSeq(objArgs, objEnv)
  1409. Dim varRes
  1410. CheckArgNum objArgs, 1
  1411. Set varRes = NewMalBool( _
  1412. objArgs.Item(1).Type = TYPES.LIST Or _
  1413. objArgs.Item(1).Type = TYPES.VECTOR)
  1414. Set MIsSeq = varRes
  1415. End Function
  1416. objNS.Add NewMalSym("sequential?"), NewVbsProc("MIsSeq", False)
  1417. Function MIsVec(objArgs, objEnv)
  1418. Dim varRes
  1419. CheckArgNum objArgs, 1
  1420. Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.VECTOR)
  1421. Set MIsVec = varRes
  1422. End Function
  1423. objNS.Add NewMalSym("vector?"), NewVbsProc("MIsVec", False)
  1424. Function MIsMap(objArgs, objEnv)
  1425. Dim varRes
  1426. CheckArgNum objArgs, 1
  1427. Set varRes = NewMalBool(objArgs.Item(1).Type = TYPES.HASHMAP)
  1428. Set MIsMap = varRes
  1429. End Function
  1430. objNS.Add NewMalSym("map?"), NewVbsProc("MIsMap", False)
  1431. Function MHashMap(objArgs, objEnv)
  1432. Dim varRes
  1433. If objArgs.Count Mod 2 <> 1 Then
  1434. Err.Raise vbObjectError, _
  1435. "MHashMap", "Unexpect argument(s)."
  1436. End If
  1437. Set varRes = NewMalMap(Array(), Array())
  1438. Dim i
  1439. For i = 1 To objArgs.Count - 1 Step 2
  1440. varRes.Add objArgs.Item(i), objArgs.Item(i + 1)
  1441. Next
  1442. Set MHashMap = varRes
  1443. End Function
  1444. objNS.Add NewMalSym("hash-map"), NewVbsProc("MHashMap", False)
  1445. Function MAssoc(objArgs, objEnv)
  1446. Dim varRes
  1447. If objArgs.Count - 1 < 3 Or objArgs.Count Mod 2 <> 0 Then
  1448. Err.Raise vbObjectError, _
  1449. "MHashMap", "Unexpect argument(s)."
  1450. End If
  1451. Dim objMap
  1452. Set objMap = objArgs.Item(1)
  1453. CheckType objMap, TYPES.HASHMAP
  1454. Dim i
  1455. Set varRes = NewMalMap(Array(), Array())
  1456. For Each i In objMap.Keys
  1457. varRes.Add i, objMap.Item(i)
  1458. Next
  1459. For i = 2 To objArgs.Count - 1 Step 2
  1460. varRes.Add objArgs.Item(i), objArgs.Item(i + 1)
  1461. Next
  1462. Set MAssoc = varRes
  1463. End Function
  1464. objNS.Add NewMalSym("assoc"), NewVbsProc("MAssoc", False)
  1465. Function MGet(objArgs, objEnv)
  1466. Dim varRes
  1467. CheckArgNum objArgs, 2
  1468. If objArgs.Item(1).Type = TYPES.NIL Then
  1469. Set varRes = NewMalNil()
  1470. Else
  1471. CheckType objArgs.Item(1), TYPES.HASHMAP
  1472. If objArgs.Item(1).Exists(objArgs.Item(2)) Then
  1473. Set varRes = objArgs.Item(1).Item(objArgs.Item(2))
  1474. Else
  1475. Set varRes = NewMalNil()
  1476. End If
  1477. End If
  1478. Set MGet = varRes
  1479. End Function
  1480. objNS.Add NewMalSym("get"), NewVbsProc("MGet", False)
  1481. Function MDissoc(objArgs, objEnv)
  1482. Dim varRes
  1483. 'CheckArgNum objArgs, 2
  1484. CheckType objArgs.Item(1), TYPES.HASHMAP
  1485. If objArgs.Item(1).Exists(objArgs.Item(2)) Then
  1486. Set varRes = NewMalMap(Array(), Array())
  1487. Dim i
  1488. Dim j, boolFlag
  1489. For Each i In objArgs.Item(1).Keys
  1490. boolFlag = True
  1491. For j = 2 To objArgs.Count - 1
  1492. If i.Type = objArgs.Item(j).Type And _
  1493. i.Value = objArgs.Item(j).Value Then
  1494. boolFlag = False
  1495. End If
  1496. Next
  1497. If boolFlag Then
  1498. varRes.Add i, objArgs.Item(1).Item(i)
  1499. End If
  1500. Next
  1501. Else
  1502. Set varRes = objArgs.Item(1)
  1503. End If
  1504. Set MDissoc = varRes
  1505. End Function
  1506. objNS.Add NewMalSym("dissoc"), NewVbsProc("MDissoc", False)
  1507. Function MKeys(objArgs, objEnv)
  1508. CheckArgNum objArgs, 1
  1509. CheckType objArgs.Item(1), TYPES.HASHMAP
  1510. Set MKeys = NewMalList(objArgs.Item(1).Keys)
  1511. End Function
  1512. objNS.Add NewMalSym("keys"), NewVbsProc("MKeys", False)
  1513. Function MIsContains(objArgs, objEnv)
  1514. CheckArgNum objArgs, 2
  1515. CheckType objArgs.Item(1), TYPES.HASHMAP
  1516. Set MIsContains = NewMalBool(objArgs.Item(1).Exists(objArgs.Item(2)))
  1517. End Function
  1518. objNS.Add NewMalSym("contains?"), NewVbsProc("MIsContains", False)
  1519. Function MReadLine(objArgs, objEnv)
  1520. Dim varRes
  1521. CheckArgNum objArgs, 1
  1522. CheckType objArgs.Item(1), TYPES.STRING
  1523. Dim strInput
  1524. WScript.StdOut.Write objArgs.Item(1).Value
  1525. On Error Resume Next
  1526. strInput = WScript.StdIn.ReadLine()
  1527. If Err.Number <> 0 Then
  1528. Set varRes = NewMalNil()
  1529. Else
  1530. Set varRes = NewMalStr(strInput)
  1531. End If
  1532. On Error Goto 0
  1533. Set MReadLine = varRes
  1534. End Function
  1535. objNS.Add NewMalSym("readline"), NewVbsProc("MReadLine", False)
  1536. Function MTimeMs(objArgs, objEnv)
  1537. Set MTimeMs = NewMalNum(CLng(Timer * 1000))
  1538. End Function
  1539. objNS.Add NewMalSym("time-ms"), NewVbsProc("MTimeMs", False)
  1540. Function MIsStr(objArgs, objEnv)
  1541. CheckArgNum objArgs, 1
  1542. Set MIsStr = NewMalBool(objArgs.Item(1).Type = TYPES.STRING)
  1543. End Function
  1544. objNS.Add NewMalSym("string?"), NewVbsProc("MIsStr", False)
  1545. Function MIsNum(objArgs, objEnv)
  1546. CheckArgNum objArgs, 1
  1547. Set MIsNum = NewMalBool(objArgs.Item(1).Type = TYPES.NUMBER)
  1548. End Function
  1549. objNS.Add NewMalSym("number?"), NewVbsProc("MIsNum", False)
  1550. Function MIsFn(objArgs, objEnv)
  1551. CheckArgNum objArgs, 1
  1552. Dim varRes
  1553. varRes = objArgs.Item(1).Type = TYPES.PROCEDURE
  1554. If varRes Then
  1555. varRes = (Not objArgs.Item(1).IsMacro) And _
  1556. (Not objArgs.Item(1).IsSpecial)
  1557. End If
  1558. Set MIsFn = NewMalBool(varRes)
  1559. End Function
  1560. objNS.Add NewMalSym("fn?"), NewVbsProc("MIsFn", False)
  1561. Function MIsMacro(objArgs, objEnv)
  1562. CheckArgNum objArgs, 1
  1563. Dim varRes
  1564. varRes = objArgs.Item(1).Type = TYPES.PROCEDURE
  1565. If varRes Then
  1566. varRes = objArgs.Item(1).IsMacro And _
  1567. (Not objArgs.Item(1).IsSpecial)
  1568. End If
  1569. Set MIsMacro = NewMalBool(varRes)
  1570. End Function
  1571. objNS.Add NewMalSym("macro?"), NewVbsProc("MIsMacro", False)
  1572. Function MMeta(objArgs, objEnv)
  1573. CheckArgNum objArgs, 1
  1574. 'CheckType objArgs.Item(1), TYPES.PROCEDURE
  1575. Dim varRes
  1576. Set varRes = GetMeta(objArgs.Item(1))
  1577. Set MMeta = varRes
  1578. End Function
  1579. objNS.Add NewMalSym("meta"), NewVbsProc("MMeta", False)
  1580. Function MWithMeta(objArgs, objEnv)
  1581. CheckArgNum objArgs, 2
  1582. 'CheckType objArgs.Item(1), TYPES.PROCEDURE
  1583. Dim varRes
  1584. Set varRes = SetMeta(objArgs.Item(1), objArgs.Item(2))
  1585. Set MWithMeta = varRes
  1586. End Function
  1587. objNS.Add NewMalSym("with-meta"), NewVbsProc("MWithMeta", False)
  1588. Function MConj(objArgs, objEnv)
  1589. If objArgs.Count - 1 < 1 Then
  1590. Err.Raise vbObjectError, _
  1591. "MConj", "Need more arguments."
  1592. End If
  1593. Dim varRes
  1594. Dim objSeq
  1595. Set objSeq = objArgs.Item(1)
  1596. Dim i
  1597. Select Case objSeq.Type
  1598. Case TYPES.LIST
  1599. Set varRes = NewMalList(Array())
  1600. For i = objArgs.Count - 1 To 2 Step -1
  1601. varRes.Add objArgs.Item(i)
  1602. Next
  1603. For i = 0 To objSeq.Count - 1
  1604. varRes.Add objSeq.Item(i)
  1605. Next
  1606. Case TYPES.VECTOR
  1607. Set varRes = NewMalVec(Array())
  1608. For i = 0 To objSeq.Count - 1
  1609. varRes.Add objSeq.Item(i)
  1610. Next
  1611. For i = 2 To objArgs.Count - 1
  1612. varRes.Add objArgs.Item(i)
  1613. Next
  1614. Case Else
  1615. Err.Raise vbObjectError, _
  1616. "MConj", "Unexpect argument type."
  1617. End Select
  1618. Set MConj = varRes
  1619. End Function
  1620. objNS.Add NewMalSym("conj"), NewVbsProc("MConj", False)
  1621. Function MSeq(objArgs, objEnv)
  1622. CheckArgNum objArgs, 1
  1623. Dim objSeq
  1624. Set objSeq = objArgs.Item(1)
  1625. Dim varRes
  1626. Dim i
  1627. Select Case objSeq.Type
  1628. Case TYPES.STRING
  1629. If objSeq.Value = "" Then
  1630. Set varRes = NewMalNil()
  1631. Else
  1632. Set varRes = NewMalList(Array())
  1633. For i = 1 To Len(objSeq.Value)
  1634. varRes.Add NewMalStr(Mid(objSeq.Value, i, 1))
  1635. Next
  1636. End If
  1637. Case TYPES.LIST
  1638. If objSeq.Count = 0 Then
  1639. Set varRes = NewMalNil()
  1640. Else
  1641. Set varRes = objSeq
  1642. End If
  1643. Case TYPES.VECTOR
  1644. If objSeq.Count = 0 Then
  1645. Set varRes = NewMalNil()
  1646. Else
  1647. Set varRes = NewMalList(Array())
  1648. For i = 0 To objSeq.Count - 1
  1649. varRes.Add objSeq.Item(i)
  1650. Next
  1651. End If
  1652. Case TYPES.NIL
  1653. Set varRes = NewMalNil()
  1654. Case Else
  1655. Err.Raise vbObjectError, _
  1656. "MSeq", "Unexpect argument type."
  1657. End Select
  1658. Set MSeq = varRes
  1659. End Function
  1660. objNS.Add NewMalSym("seq"), NewVbsProc("MSeq", False)
  1661. Class TailCall
  1662. Public objMalType
  1663. Public objEnv
  1664. End Class
  1665. Function EvalLater(objMal, objEnv)
  1666. Dim varRes
  1667. Set varRes = New TailCall
  1668. Set varRes.objMalType = objMal
  1669. Set varRes.objEnv = objEnv
  1670. Set EvalLater = varRes
  1671. End Function
  1672. Function MDef(objArgs, objEnv)
  1673. Dim varRet
  1674. CheckArgNum objArgs, 2
  1675. CheckType objArgs.Item(1), TYPES.SYMBOL
  1676. Set varRet = Evaluate(objArgs.Item(2), objEnv)
  1677. objEnv.Add objArgs.Item(1), varRet
  1678. Set MDef = varRet
  1679. End Function
  1680. objNS.Add NewMalSym("def!"), NewVbsProc("MDef", True)
  1681. Function MLet(objArgs, objEnv)
  1682. Dim varRet
  1683. CheckArgNum objArgs, 2
  1684. Dim objBinds
  1685. Set objBinds = objArgs.Item(1)
  1686. CheckListOrVec objBinds
  1687. If objBinds.Count Mod 2 <> 0 Then
  1688. Err.Raise vbObjectError, _
  1689. "MLet", "Wrong argument count."
  1690. End If
  1691. Dim objNewEnv
  1692. Set objNewEnv = NewEnv(objEnv)
  1693. Dim i, objSym
  1694. For i = 0 To objBinds.Count - 1 Step 2
  1695. Set objSym = objBinds.Item(i)
  1696. CheckType objSym, TYPES.SYMBOL
  1697. objNewEnv.Add objSym, Evaluate(objBinds.Item(i + 1), objNewEnv)
  1698. Next
  1699. Set varRet = EvalLater(objArgs.Item(2), objNewEnv)
  1700. Set MLet = varRet
  1701. End Function
  1702. objNS.Add NewMalSym("let*"), NewVbsProc("MLet", True)
  1703. Function MDo(objArgs, objEnv)
  1704. Dim varRet, i
  1705. If objArgs.Count - 1 < 1 Then
  1706. Err.Raise vbObjectError, _
  1707. "MDo", "Need more arguments."
  1708. End If
  1709. For i = 1 To objArgs.Count - 2
  1710. Call Evaluate(objArgs.Item(i), objEnv)
  1711. Next
  1712. Set varRet = EvalLater( _
  1713. objArgs.Item(objArgs.Count - 1), _
  1714. objEnv)
  1715. Set MDo = varRet
  1716. End Function
  1717. objNS.Add NewMalSym("do"), NewVbsProc("MDo", True)
  1718. Function MIf(objArgs, objEnv)
  1719. Dim varRet
  1720. If objArgs.Count - 1 <> 3 And _
  1721. objArgs.Count - 1 <> 2 Then
  1722. Err.Raise vbObjectError, _
  1723. "MIf", "Wrong number of arguments."
  1724. End If
  1725. Dim objCond
  1726. Set objCond = Evaluate(objArgs.Item(1), objEnv)
  1727. Dim boolCond
  1728. If objCond.Type = TYPES.BOOLEAN Then
  1729. boolCond = objCond.Value
  1730. Else
  1731. boolCond = True
  1732. End If
  1733. boolCond = (boolCond And objCond.Type <> TYPES.NIL)
  1734. If boolCond Then
  1735. Set varRet = EvalLater(objArgs.Item(2), objEnv)
  1736. Else
  1737. If objArgs.Count - 1 = 3 Then
  1738. Set varRet = EvalLater(objArgs.Item(3), objEnv)
  1739. Else
  1740. Set varRet = NewMalNil()
  1741. End If
  1742. End If
  1743. Set MIf = varRet
  1744. End Function
  1745. objNS.Add NewMalSym("if"), NewVbsProc("MIf", True)
  1746. Function MFn(objArgs, objEnv)
  1747. Dim varRet
  1748. CheckArgNum objArgs, 2
  1749. Dim objParams, objCode
  1750. Set objParams = objArgs.Item(1)
  1751. CheckListOrVec objParams
  1752. Set objCode = objArgs.Item(2)
  1753. Dim i
  1754. For i = 0 To objParams.Count - 1
  1755. CheckType objParams.Item(i), TYPES.SYMBOL
  1756. Next
  1757. Set varRet = NewMalProc(objParams, objCode, objEnv)
  1758. Set MFn = varRet
  1759. End Function
  1760. objNS.Add NewMalSym("fn*"), NewVbsProc("MFn", True)
  1761. Function MEval(objArgs, objEnv)
  1762. Dim varRes
  1763. CheckArgNum objArgs, 1
  1764. Set varRes = Evaluate(objArgs.Item(1), objEnv)
  1765. Set varRes = EvalLater(varRes, objNS)
  1766. Set MEval = varRes
  1767. End Function
  1768. objNS.Add NewMalSym("eval"), NewVbsProc("MEval", True)
  1769. Function MQuote(objArgs, objEnv)
  1770. CheckArgNum objArgs, 1
  1771. Set MQuote = objArgs.Item(1)
  1772. End Function
  1773. objNS.Add NewMalSym("quote"), NewVbsProc("MQuote", True)
  1774. Function MQuasiQuote(objArgs, objEnv)
  1775. Dim varRes
  1776. CheckArgNum objArgs, 1
  1777. Set varRes = EvalLater( _
  1778. MQuasiQuoteExpand(objArgs, objEnv), objEnv)
  1779. Set MQuasiQuote = varRes
  1780. End Function
  1781. objNS.Add NewMalSym("quasiquote"), NewVbsProc("MQuasiQuote", True)
  1782. Function MQuasiQuoteExpand(objArgs, objEnv)
  1783. Dim varRes
  1784. CheckArgNum objArgs, 1
  1785. Set varRes = ExpandHelper(objArgs.Item(1))
  1786. If varRes.Splice Then
  1787. Err.Raise vbObjectError, _
  1788. "MQuasiQuoteExpand", "Wrong return value type."
  1789. End If
  1790. Set varRes = varRes.Value
  1791. Set MQuasiQuoteExpand = varRes
  1792. End Function
  1793. objNS.Add NewMalSym("quasiquoteexpand"), NewVbsProc("MQuasiQuoteExpand", True)
  1794. Class ExpandType
  1795. Public Splice
  1796. Public Value
  1797. End Class
  1798. Function NewExpandType(objValue, boolSplice)
  1799. Dim varRes
  1800. Set varRes = New ExpandType
  1801. Set varRes.Value = objValue
  1802. varRes.Splice = boolSplice
  1803. Set NewExpandType = varRes
  1804. End Function
  1805. Function ExpandHelper(objArg)
  1806. Dim varRes, boolSplice
  1807. Dim varBuilder, varEType, i
  1808. boolSplice = False
  1809. Select Case objArg.Type
  1810. Case TYPES.LIST
  1811. Dim boolNormal
  1812. boolNormal = False
  1813. ' Check for unquotes.
  1814. Select Case objArg.Count
  1815. Case 2
  1816. ' Maybe have a bug here
  1817. ' like (unquote a b c) should be throw a error
  1818. If objArg.Item(0).Type = TYPES.SYMBOL Then
  1819. Select Case objArg.Item(0).Value
  1820. Case "unquote"
  1821. Set varRes = objArg.Item(1)
  1822. Case "splice-unquote"
  1823. Set varRes = objArg.Item(1)
  1824. boolSplice = True
  1825. Case Else
  1826. boolNormal = True
  1827. End Select
  1828. Else
  1829. boolNormal = True
  1830. End If
  1831. Case Else
  1832. boolNormal = True
  1833. End Select
  1834. If boolNormal Then
  1835. Set varRes = NewMalList(Array())
  1836. Set varBuilder = varRes
  1837. For i = 0 To objArg.Count - 1
  1838. Set varEType = ExpandHelper(objArg.Item(i))
  1839. If varEType.Splice Then
  1840. varBuilder.Add NewMalSym("concat")
  1841. Else
  1842. varBuilder.Add NewMalSym("cons")
  1843. End If
  1844. varBuilder.Add varEType.Value
  1845. varBuilder.Add NewMalList(Array())
  1846. Set varBuilder = varBuilder.Item(2)
  1847. Next
  1848. End If
  1849. Case TYPES.VECTOR
  1850. Set varRes = NewMalList(Array( _
  1851. NewMalSym("vec"), NewMalList(Array())))
  1852. Set varBuilder = varRes.Item(1)
  1853. For i = 0 To objArg.Count - 1
  1854. Set varEType = ExpandHelper(objArg.Item(i))
  1855. If varEType.Splice Then
  1856. varBuilder.Add NewMalSym("concat")
  1857. Else
  1858. varBuilder.Add NewMalSym("cons")
  1859. End If
  1860. varBuilder.Add varEType.Value
  1861. varBuilder.Add NewMalList(Array())
  1862. Set varBuilder = varBuilder.Item(2)
  1863. Next
  1864. Case TYPES.HASHMAP
  1865. ' Maybe have a bug here.
  1866. ' e.g. {"key" ~value}
  1867. Set varRes = NewMalList(Array( _
  1868. NewMalSym("quote"), objArg))
  1869. Case TYPES.SYMBOL
  1870. Set varRes = NewMalList(Array( _
  1871. NewMalSym("quote"), objArg))
  1872. Case Else
  1873. ' Maybe have a bug here.
  1874. ' All unspecified type will return itself.
  1875. Set varRes = objArg
  1876. End Select
  1877. Set ExpandHelper = NewExpandType(varRes, boolSplice)
  1878. End Function
  1879. Function MDefMacro(objArgs, objEnv)
  1880. Dim varRet
  1881. CheckArgNum objArgs, 2
  1882. CheckType objArgs.Item(1), TYPES.SYMBOL
  1883. Set varRet = Evaluate(objArgs.Item(2), objEnv).Copy()
  1884. CheckType varRet, TYPES.PROCEDURE
  1885. varRet.IsMacro = True
  1886. objEnv.Add objArgs.Item(1), varRet
  1887. Set MDefMacro = varRet
  1888. End Function
  1889. objNS.Add NewMalSym("defmacro!"), NewVbsProc("MDefMacro", True)
  1890. Function IsMacroCall(objCode, objEnv)
  1891. Dim varRes
  1892. varRes = False
  1893. ' VBS has no short-circuit evaluation.
  1894. If objCode.Type = TYPES.LIST Then
  1895. If objCode.Count > 0 Then
  1896. If objCode.Item(0).Type = TYPES.SYMBOL Then
  1897. Dim varValue
  1898. Set varValue = objEnv.Get(objCode.Item(0))
  1899. If varValue.Type = TYPES.PROCEDURE Then
  1900. If varValue.IsMacro Then
  1901. varRes = True
  1902. End If
  1903. End If
  1904. End If
  1905. End If
  1906. End If
  1907. IsMacroCall = varRes
  1908. End Function
  1909. Function MacroExpand(ByVal objAST, ByVal objEnv)
  1910. Dim varRes
  1911. While IsMacroCall(objAST, objEnv)
  1912. Dim varMacro
  1913. Set varMacro = objEnv.Get(objAST.Item(0))
  1914. Set objAST = varMacro.MacroApply(objAST, objEnv)
  1915. Wend
  1916. Set varRes = objAST
  1917. Set MacroExpand = varRes
  1918. End Function
  1919. Function MMacroExpand(objArgs, objEnv)
  1920. Dim varRes
  1921. CheckArgNum objArgs, 1
  1922. Set varRes = MacroExpand(objArgs.Item(1), objEnv)
  1923. Set MMacroExpand = varRes
  1924. End Function
  1925. objNS.Add NewMalSym("macroexpand"), NewVbsProc("MMacroExpand", True)
  1926. Function MTry(objArgs, objEnv)
  1927. Dim varRes
  1928. If objArgs.Count - 1 < 1 Then
  1929. Err.Raise vbObjectError, _
  1930. "MTry", "Need more arguments."
  1931. End If
  1932. If objArgs.Count - 1 = 1 Then
  1933. Set varRes = EvalLater(objArgs.Item(1), objEnv)
  1934. Set MTry = varRes
  1935. Exit Function
  1936. End If
  1937. CheckArgNum objArgs, 2
  1938. CheckType objArgs.Item(2), TYPES.LIST
  1939. Dim objTry, objCatch
  1940. Set objTry = objArgs.Item(1)
  1941. Set objCatch = objArgs.Item(2)
  1942. CheckArgNum objCatch, 2
  1943. CheckType objCatch.Item(0), TYPES.SYMBOL
  1944. CheckType objCatch.Item(1), TYPES.SYMBOL
  1945. If objCatch.Item(0).Value <> "catch*" Then
  1946. Err.Raise vbObjectError, _
  1947. "MTry", "Unexpect argument(s)."
  1948. End If
  1949. On Error Resume Next
  1950. Set varRes = Evaluate(objTry, objEnv)
  1951. If Err.Number <> 0 Then
  1952. Dim objException
  1953. If Err.Source <> "MThrow" Then
  1954. Set objException = NewMalStr(Err.Description)
  1955. Else
  1956. Set objException = objExceptions.Item(Err.Description)
  1957. objExceptions.Remove Err.Description
  1958. End If
  1959. Call Err.Clear()
  1960. On Error Goto 0
  1961. ' The code below may cause error too.
  1962. ' So we should clear err info & throw out any errors.
  1963. ' Use 'quote' to avoid eval objExp again.
  1964. Set varRes = Evaluate(NewMalList(Array( _
  1965. NewMalSym("let*"), NewMalList(Array( _
  1966. objCatch.Item(1), NewMalList(Array( _
  1967. NewMalSym("quote"), objException)))), _
  1968. objCatch.Item(2))), objEnv)
  1969. Else
  1970. On Error Goto 0
  1971. End If
  1972. Set MTry = varRes
  1973. End Function
  1974. objNS.Add NewMalSym("try*"), NewVbsProc("MTry", True)
  1975. Call InitBuiltIn()
  1976. Call InitMacro()
  1977. Call InitArgs()
  1978. Sub InitArgs()
  1979. Dim objArgs
  1980. Set objArgs = NewMalList(Array())
  1981. Dim i
  1982. For i = 1 To WScript.Arguments.Count - 1
  1983. objArgs.Add NewMalStr(WScript.Arguments.Item(i))
  1984. Next
  1985. objNS.Add NewMalSym("*ARGV*"), objArgs
  1986. If WScript.Arguments.Count > 0 Then
  1987. REP "(load-file """ + WScript.Arguments.Item(0) + """)"
  1988. WScript.Quit 0
  1989. End If
  1990. End Sub
  1991. Randomize 1228
  1992. Call REPL()
  1993. Sub REPL()
  1994. Dim strCode, strResult
  1995. REP "(println (str ""Mal [""*host-language*""]""))"
  1996. While True
  1997. WScript.StdOut.Write "user> "
  1998. On Error Resume Next
  1999. strCode = WScript.StdIn.ReadLine()
  2000. If Err.Number <> 0 Then WScript.Quit 0
  2001. On Error Goto 0
  2002. Dim strRes
  2003. On Error Resume Next
  2004. strRes = REP(strCode)
  2005. If Err.Number <> 0 Then
  2006. If Err.Source = "MThrow" Then
  2007. 'WScript.StdErr.WriteLine Err.Source + ": " + _
  2008. WScript.StdErr.WriteLine "Exception: " + _
  2009. PrintMalType(objExceptions.Item(Err.Description), True)
  2010. objExceptions.Remove Err.Description
  2011. Else
  2012. 'WScript.StdErr.WriteLine Err.Source + ": " + Err.Description
  2013. WScript.StdErr.WriteLine "Exception: " + Err.Description
  2014. End If
  2015. Else
  2016. If strRes <> "" Then
  2017. WScript.Echo strRes
  2018. End If
  2019. End If
  2020. On Error Goto 0
  2021. Wend
  2022. End Sub
  2023. Function Read(strCode)
  2024. Set Read = ReadString(strCode)
  2025. End Function
  2026. Function Evaluate(ByVal objCode, ByVal objEnv)
  2027. While True
  2028. If TypeName(objCode) = "Nothing" Then
  2029. Set Evaluate = Nothing
  2030. Exit Function
  2031. End If
  2032. Set objCode = MacroExpand(objCode, objEnv)
  2033. Dim varRet, objFirst
  2034. If objCode.Type = TYPES.LIST Then
  2035. If objCode.Count = 0 Then ' ()
  2036. Set Evaluate = objCode
  2037. Exit Function
  2038. End If
  2039. Set objFirst = Evaluate(objCode.Item(0), objEnv)
  2040. Set varRet = objFirst.Apply(objCode, objEnv)
  2041. Else
  2042. Set varRet = EvaluateAST(objCode, objEnv)
  2043. End If
  2044. If TypeName(varRet) = "TailCall" Then
  2045. ' NOTICE: If not specify 'ByVal',
  2046. ' Change of arguments will influence
  2047. ' the caller's variable!
  2048. Set objCode = varRet.objMalType
  2049. Set objEnv = varRet.objEnv
  2050. Else
  2051. Set Evaluate = varRet
  2052. Exit Function
  2053. End If
  2054. Wend
  2055. End Function
  2056. Function EvaluateAST(objCode, objEnv)
  2057. Dim varRet, i
  2058. Select Case objCode.Type
  2059. Case TYPES.SYMBOL
  2060. Set varRet = objEnv.Get(objCode)
  2061. Case TYPES.LIST
  2062. Err.Raise vbObjectError, _
  2063. "EvaluateAST", "Unexpect type."
  2064. Case TYPES.VECTOR
  2065. Set varRet = NewMalVec(Array())
  2066. For i = 0 To objCode.Count() - 1
  2067. varRet.Add Evaluate(objCode.Item(i), objEnv)
  2068. Next
  2069. Case TYPES.HASHMAP
  2070. Set varRet = NewMalMap(Array(), Array())
  2071. For Each i In objCode.Keys()
  2072. varRet.Add i, Evaluate(objCode.Item(i), objEnv)
  2073. Next
  2074. Case Else
  2075. Set varRet = objCode
  2076. End Select
  2077. Set EvaluateAST = varRet
  2078. End Function
  2079. Function EvaluateRest(objCode, objEnv)
  2080. Dim varRet, i
  2081. Select Case objCode.Type
  2082. Case TYPES.LIST
  2083. Set varRet = NewMalList(Array(NewMalNil()))
  2084. For i = 1 To objCode.Count() - 1
  2085. varRet.Add Evaluate(objCode.Item(i), objEnv)
  2086. Next
  2087. Case Else
  2088. Err.Raise vbObjectError, _
  2089. "EvaluateRest", "Unexpected type."
  2090. End Select
  2091. Set EvaluateRest = varRet
  2092. End Function
  2093. Function Print(objCode)
  2094. Print = PrintMalType(objCode, True)
  2095. End Function
  2096. Function REP(strCode)
  2097. REP = Print(Evaluate(Read(strCode), objNS))
  2098. End Function
  2099. Sub Include(strFileName)
  2100. With CreateObject("Scripting.FileSystemObject")
  2101. ExecuteGlobal .OpenTextFile( _
  2102. .GetParentFolderName( _
  2103. .GetFile(WScript.ScriptFullName)) & _
  2104. "\" & strFileName).ReadAll
  2105. End With
  2106. End Sub
复制代码
3

评分人数

不明觉厉                                           .

QQ 20147578

TOP

几个测试用例(相等于语法教程了)
  1. ;; Testing evaluation of arithmetic operations
  2. (+ 1 2)
  3. ;=>3
  4. (+ 5 (* 2 3))
  5. ;=>11
  6. (- (+ 5 (* 2 3)) 3)
  7. ;=>8
  8. (/ (- (+ 5 (* 2 3)) 3) 4)
  9. ;=>2
  10. (/ (- (+ 515 (* 87 311)) 302) 27)
  11. ;=>1010
  12. (* -3 6)
  13. ;=>-18
  14. (/ (- (+ 515 (* -87 311)) 296) 27)
  15. ;=>-994
  16. ;;; This should throw an error with no return value
  17. (abc 1 2 3)
  18. ;/.+
  19. ;; Testing empty list
  20. ()
  21. ;=>()
  22. ;>>> deferrable=True
  23. ;;
  24. ;; -------- Deferrable Functionality --------
  25. ;; Testing evaluation within collection literals
  26. [1 2 (+ 1 2)]
  27. ;=>[1 2 3]
  28. {"a" (+ 7 8)}
  29. ;=>{"a" 15}
  30. {:a (+ 7 8)}
  31. ;=>{:a 15}
  32. ;; Check that evaluation hasn't broken empty collections
  33. []
  34. ;=>[]
  35. {}
  36. ;=>{}
复制代码
  1. ;; Testing REPL_ENV
  2. (+ 1 2)
  3. ;=>3
  4. (/ (- (+ 5 (* 2 3)) 3) 4)
  5. ;=>2
  6. ;; Testing def!
  7. (def! x 3)
  8. ;=>3
  9. x
  10. ;=>3
  11. (def! x 4)
  12. ;=>4
  13. x
  14. ;=>4
  15. (def! y (+ 1 7))
  16. ;=>8
  17. y
  18. ;=>8
  19. ;; Verifying symbols are case-sensitive
  20. (def! mynum 111)
  21. ;=>111
  22. (def! MYNUM 222)
  23. ;=>222
  24. mynum
  25. ;=>111
  26. MYNUM
  27. ;=>222
  28. ;; Check env lookup non-fatal error
  29. (abc 1 2 3)
  30. ;/.*\'?abc\'? not found.*
  31. ;; Check that error aborts def!
  32. (def! w 123)
  33. (def! w (abc))
  34. w
  35. ;=>123
  36. ;; Testing let*
  37. (let* (z 9) z)
  38. ;=>9
  39. (let* (x 9) x)
  40. ;=>9
  41. x
  42. ;=>4
  43. (let* (z (+ 2 3)) (+ 1 z))
  44. ;=>6
  45. (let* (p (+ 2 3) q (+ 2 p)) (+ p q))
  46. ;=>12
  47. (def! y (let* (z 7) z))
  48. y
  49. ;=>7
  50. ;; Testing outer environment
  51. (def! a 4)
  52. ;=>4
  53. (let* (q 9) q)
  54. ;=>9
  55. (let* (q 9) a)
  56. ;=>4
  57. (let* (z 2) (let* (q 9) a))
  58. ;=>4
  59. ;>>> deferrable=True
  60. ;;
  61. ;; -------- Deferrable Functionality --------
  62. ;; Testing let* with vector bindings
  63. (let* [z 9] z)
  64. ;=>9
  65. (let* [p (+ 2 3) q (+ 2 p)] (+ p q))
  66. ;=>12
  67. ;; Testing vector evaluation
  68. (let* (a 5 b 6) [3 4 a [b 7] 8])
  69. ;=>[3 4 5 [6 7] 8]
  70. ;>>> soft=True
  71. ;>>> optional=True
  72. ;;
  73. ;; -------- Optional Functionality --------
  74. ;; Check that last assignment takes priority
  75. (let* (x 2 x 3) x)
  76. ;=>3
复制代码
  1. ;; -----------------------------------------------------
  2. ;; Testing list functions
  3. (list)
  4. ;=>()
  5. (list? (list))
  6. ;=>true
  7. (empty? (list))
  8. ;=>true
  9. (empty? (list 1))
  10. ;=>false
  11. (list 1 2 3)
  12. ;=>(1 2 3)
  13. (count (list 1 2 3))
  14. ;=>3
  15. (count (list))
  16. ;=>0
  17. (count nil)
  18. ;=>0
  19. (if (> (count (list 1 2 3)) 3) 89 78)
  20. ;=>78
  21. (if (>= (count (list 1 2 3)) 3) 89 78)
  22. ;=>89
  23. ;; Testing if form
  24. (if true 7 8)
  25. ;=>7
  26. (if false 7 8)
  27. ;=>8
  28. (if false 7 false)
  29. ;=>false
  30. (if true (+ 1 7) (+ 1 8))
  31. ;=>8
  32. (if false (+ 1 7) (+ 1 8))
  33. ;=>9
  34. (if nil 7 8)
  35. ;=>8
  36. (if 0 7 8)
  37. ;=>7
  38. (if (list) 7 8)
  39. ;=>7
  40. (if (list 1 2 3) 7 8)
  41. ;=>7
  42. (= (list) nil)
  43. ;=>false
  44. ;; Testing 1-way if form
  45. (if false (+ 1 7))
  46. ;=>nil
  47. (if nil 8)
  48. ;=>nil
  49. (if nil 8 7)
  50. ;=>7
  51. (if true (+ 1 7))
  52. ;=>8
  53. ;; Testing basic conditionals
  54. (= 2 1)
  55. ;=>false
  56. (= 1 1)
  57. ;=>true
  58. (= 1 2)
  59. ;=>false
  60. (= 1 (+ 1 1))
  61. ;=>false
  62. (= 2 (+ 1 1))
  63. ;=>true
  64. (= nil 1)
  65. ;=>false
  66. (= nil nil)
  67. ;=>true
  68. (> 2 1)
  69. ;=>true
  70. (> 1 1)
  71. ;=>false
  72. (> 1 2)
  73. ;=>false
  74. (>= 2 1)
  75. ;=>true
  76. (>= 1 1)
  77. ;=>true
  78. (>= 1 2)
  79. ;=>false
  80. (< 2 1)
  81. ;=>false
  82. (< 1 1)
  83. ;=>false
  84. (< 1 2)
  85. ;=>true
  86. (<= 2 1)
  87. ;=>false
  88. (<= 1 1)
  89. ;=>true
  90. (<= 1 2)
  91. ;=>true
  92. ;; Testing equality
  93. (= 1 1)
  94. ;=>true
  95. (= 0 0)
  96. ;=>true
  97. (= 1 0)
  98. ;=>false
  99. (= true true)
  100. ;=>true
  101. (= false false)
  102. ;=>true
  103. (= nil nil)
  104. ;=>true
  105. (= (list) (list))
  106. ;=>true
  107. (= (list) ())
  108. ;=>true
  109. (= (list 1 2) (list 1 2))
  110. ;=>true
  111. (= (list 1) (list))
  112. ;=>false
  113. (= (list) (list 1))
  114. ;=>false
  115. (= 0 (list))
  116. ;=>false
  117. (= (list) 0)
  118. ;=>false
  119. (= (list nil) (list))
  120. ;=>false
  121. ;; Testing builtin and user defined functions
  122. (+ 1 2)
  123. ;=>3
  124. ( (fn* (a b) (+ b a)) 3 4)
  125. ;=>7
  126. ( (fn* () 4) )
  127. ;=>4
  128. ( (fn* (f x) (f x)) (fn* (a) (+ 1 a)) 7)
  129. ;=>8
  130. ;; Testing closures
  131. ( ( (fn* (a) (fn* (b) (+ a b))) 5) 7)
  132. ;=>12
  133. (def! gen-plus5 (fn* () (fn* (b) (+ 5 b))))
  134. (def! plus5 (gen-plus5))
  135. (plus5 7)
  136. ;=>12
  137. (def! gen-plusX (fn* (x) (fn* (b) (+ x b))))
  138. (def! plus7 (gen-plusX 7))
  139. (plus7 8)
  140. ;=>15
  141. ;; Testing do form
  142. (do (prn 101))
  143. ;/101
  144. ;=>nil
  145. (do (prn 102) 7)
  146. ;/102
  147. ;=>7
  148. (do (prn 101) (prn 102) (+ 1 2))
  149. ;/101
  150. ;/102
  151. ;=>3
  152. (do (def! a 6) 7 (+ a 8))
  153. ;=>14
  154. a
  155. ;=>6
  156. ;; Testing special form case-sensitivity
  157. (def! DO (fn* (a) 7))
  158. (DO 3)
  159. ;=>7
  160. ;; Testing recursive sumdown function
  161. (def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown  (- N 1))) 0)))
  162. (sumdown 1)
  163. ;=>1
  164. (sumdown 2)
  165. ;=>3
  166. (sumdown 6)
  167. ;=>21
  168. ;; Testing recursive fibonacci function
  169. (def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2)))))))
  170. (fib 1)
  171. ;=>1
  172. (fib 2)
  173. ;=>2
  174. (fib 4)
  175. ;=>5
  176. ;; Testing recursive function in environment.
  177. (let* (f (fn* () x) x 3) (f))
  178. ;=>3
  179. (let* (cst (fn* (n) (if (= n 0) nil (cst (- n 1))))) (cst 1))
  180. ;=>nil
  181. (let* (f (fn* (n) (if (= n 0) 0 (g (- n 1)))) g (fn* (n) (f n))) (f 2))
  182. ;=>0
  183. ;>>> deferrable=True
  184. ;;
  185. ;; -------- Deferrable Functionality --------
  186. ;; Testing if on strings
  187. (if "" 7 8)
  188. ;=>7
  189. ;; Testing string equality
  190. (= "" "")
  191. ;=>true
  192. (= "abc" "abc")
  193. ;=>true
  194. (= "abc" "")
  195. ;=>false
  196. (= "" "abc")
  197. ;=>false
  198. (= "abc" "def")
  199. ;=>false
  200. (= "abc" "ABC")
  201. ;=>false
  202. (= (list) "")
  203. ;=>false
  204. (= "" (list))
  205. ;=>false
  206. ;; Testing variable length arguments
  207. ( (fn* (& more) (count more)) 1 2 3)
  208. ;=>3
  209. ( (fn* (& more) (list? more)) 1 2 3)
  210. ;=>true
  211. ( (fn* (& more) (count more)) 1)
  212. ;=>1
  213. ( (fn* (& more) (count more)) )
  214. ;=>0
  215. ( (fn* (& more) (list? more)) )
  216. ;=>true
  217. ( (fn* (a & more) (count more)) 1 2 3)
  218. ;=>2
  219. ( (fn* (a & more) (count more)) 1)
  220. ;=>0
  221. ( (fn* (a & more) (list? more)) 1)
  222. ;=>true
  223. ;; Testing language defined not function
  224. (not false)
  225. ;=>true
  226. (not nil)
  227. ;=>true
  228. (not true)
  229. ;=>false
  230. (not "a")
  231. ;=>false
  232. (not 0)
  233. ;=>false
  234. ;; -----------------------------------------------------
  235. ;; Testing string quoting
  236. ""
  237. ;=>""
  238. "abc"
  239. ;=>"abc"
  240. "abc  def"
  241. ;=>"abc  def"
  242. "\""
  243. ;=>"\""
  244. "abc\ndef\nghi"
  245. ;=>"abc\ndef\nghi"
  246. "abc\\def\\ghi"
  247. ;=>"abc\\def\\ghi"
  248. "\\n"
  249. ;=>"\\n"
  250. ;; Testing pr-str
  251. (pr-str)
  252. ;=>""
  253. (pr-str "")
  254. ;=>"\"\""
  255. (pr-str "abc")
  256. ;=>"\"abc\""
  257. (pr-str "abc  def" "ghi jkl")
  258. ;=>"\"abc  def\" \"ghi jkl\""
  259. (pr-str "\"")
  260. ;=>"\"\\\"\""
  261. (pr-str (list 1 2 "abc" "\"") "def")
  262. ;=>"(1 2 \"abc\" \"\\\"\") \"def\""
  263. (pr-str "abc\ndef\nghi")
  264. ;=>"\"abc\\ndef\\nghi\""
  265. (pr-str "abc\\def\\ghi")
  266. ;=>"\"abc\\\\def\\\\ghi\""
  267. (pr-str (list))
  268. ;=>"()"
  269. ;; Testing str
  270. (str)
  271. ;=>""
  272. (str "")
  273. ;=>""
  274. (str "abc")
  275. ;=>"abc"
  276. (str "\"")
  277. ;=>"\""
  278. (str 1 "abc" 3)
  279. ;=>"1abc3"
  280. (str "abc  def" "ghi jkl")
  281. ;=>"abc  defghi jkl"
  282. (str "abc\ndef\nghi")
  283. ;=>"abc\ndef\nghi"
  284. (str "abc\\def\\ghi")
  285. ;=>"abc\\def\\ghi"
  286. (str (list 1 2 "abc" "\"") "def")
  287. ;=>"(1 2 abc \")def"
  288. (str (list))
  289. ;=>"()"
  290. ;; Testing prn
  291. (prn)
  292. ;/
  293. ;=>nil
  294. (prn "")
  295. ;/""
  296. ;=>nil
  297. (prn "abc")
  298. ;/"abc"
  299. ;=>nil
  300. (prn "abc  def" "ghi jkl")
  301. ;/"abc  def" "ghi jkl"
  302. (prn "\"")
  303. ;/"\\""
  304. ;=>nil
  305. (prn "abc\ndef\nghi")
  306. ;/"abc\\ndef\\nghi"
  307. ;=>nil
  308. (prn "abc\\def\\ghi")
  309. ;/"abc\\\\def\\\\ghi"
  310. nil
  311. (prn (list 1 2 "abc" "\"") "def")
  312. ;/\(1 2 "abc" "\\""\) "def"
  313. ;=>nil
  314. ;; Testing println
  315. (println)
  316. ;/
  317. ;=>nil
  318. (println "")
  319. ;/
  320. ;=>nil
  321. (println "abc")
  322. ;/abc
  323. ;=>nil
  324. (println "abc  def" "ghi jkl")
  325. ;/abc  def ghi jkl
  326. (println "\"")
  327. ;/"
  328. ;=>nil
  329. (println "abc\ndef\nghi")
  330. ;/abc
  331. ;/def
  332. ;/ghi
  333. ;=>nil
  334. (println "abc\\def\\ghi")
  335. ;/abc\\def\\ghi
  336. ;=>nil
  337. (println (list 1 2 "abc" "\"") "def")
  338. ;/\(1 2 abc "\) def
  339. ;=>nil
  340. ;; Testing keywords
  341. (= :abc :abc)
  342. ;=>true
  343. (= :abc :def)
  344. ;=>false
  345. (= :abc ":abc")
  346. ;=>false
  347. (= (list :abc) (list :abc))
  348. ;=>true
  349. ;; Testing vector truthiness
  350. (if [] 7 8)
  351. ;=>7
  352. ;; Testing vector printing
  353. (pr-str [1 2 "abc" "\""] "def")
  354. ;=>"[1 2 \"abc\" \"\\\"\"] \"def\""
  355. (pr-str [])
  356. ;=>"[]"
  357. (str [1 2 "abc" "\""] "def")
  358. ;=>"[1 2 abc \"]def"
  359. (str [])
  360. ;=>"[]"
  361. ;; Testing vector functions
  362. (count [1 2 3])
  363. ;=>3
  364. (empty? [1 2 3])
  365. ;=>false
  366. (empty? [])
  367. ;=>true
  368. (list? [4 5 6])
  369. ;=>false
  370. ;; Testing vector equality
  371. (= [] (list))
  372. ;=>true
  373. (= [7 8] [7 8])
  374. ;=>true
  375. (= [:abc] [:abc])
  376. ;=>true
  377. (= (list 1 2) [1 2])
  378. ;=>true
  379. (= (list 1) [])
  380. ;=>false
  381. (= [] [1])
  382. ;=>false
  383. (= 0 [])
  384. ;=>false
  385. (= [] 0)
  386. ;=>false
  387. (= [] "")
  388. ;=>false
  389. (= "" [])
  390. ;=>false
  391. ;; Testing vector parameter lists
  392. ( (fn* [] 4) )
  393. ;=>4
  394. ( (fn* [f x] (f x)) (fn* [a] (+ 1 a)) 7)
  395. ;=>8
  396. ;; Nested vector/list equality
  397. (= [(list)] (list []))
  398. ;=>true
  399. (= [1 2 (list 3 4 [5 6])] (list 1 2 [3 4 (list 5 6)]))
  400. ;=>true
复制代码
  1. ;; Testing cons function
  2. (cons 1 (list))
  3. ;=>(1)
  4. (cons 1 (list 2))
  5. ;=>(1 2)
  6. (cons 1 (list 2 3))
  7. ;=>(1 2 3)
  8. (cons (list 1) (list 2 3))
  9. ;=>((1) 2 3)
  10. (def! a (list 2 3))
  11. (cons 1 a)
  12. ;=>(1 2 3)
  13. a
  14. ;=>(2 3)
  15. ;; Testing concat function
  16. (concat)
  17. ;=>()
  18. (concat (list 1 2))
  19. ;=>(1 2)
  20. (concat (list 1 2) (list 3 4))
  21. ;=>(1 2 3 4)
  22. (concat (list 1 2) (list 3 4) (list 5 6))
  23. ;=>(1 2 3 4 5 6)
  24. (concat (concat))
  25. ;=>()
  26. (concat (list) (list))
  27. ;=>()
  28. (= () (concat))
  29. ;=>true
  30. (def! a (list 1 2))
  31. (def! b (list 3 4))
  32. (concat a b (list 5 6))
  33. ;=>(1 2 3 4 5 6)
  34. a
  35. ;=>(1 2)
  36. b
  37. ;=>(3 4)
  38. ;; Testing regular quote
  39. (quote 7)
  40. ;=>7
  41. (quote (1 2 3))
  42. ;=>(1 2 3)
  43. (quote (1 2 (3 4)))
  44. ;=>(1 2 (3 4))
  45. ;; Testing simple quasiquote
  46. (quasiquote nil)
  47. ;=>nil
  48. (quasiquote 7)
  49. ;=>7
  50. (quasiquote a)
  51. ;=>a
  52. (quasiquote {"a" b})
  53. ;=>{"a" b}
  54. ;; Testing quasiquote with lists
  55. (quasiquote ())
  56. ;=>()
  57. (quasiquote (1 2 3))
  58. ;=>(1 2 3)
  59. (quasiquote (a))
  60. ;=>(a)
  61. (quasiquote (1 2 (3 4)))
  62. ;=>(1 2 (3 4))
  63. (quasiquote (nil))
  64. ;=>(nil)
  65. (quasiquote (1 ()))
  66. ;=>(1 ())
  67. (quasiquote (() 1))
  68. ;=>(() 1)
  69. (quasiquote (1 () 2))
  70. ;=>(1 () 2)
  71. (quasiquote (()))
  72. ;=>(())
  73. ;; (quasiquote (f () g (h) i (j k) l))
  74. ;; =>(f () g (h) i (j k) l)
  75. ;; Testing unquote
  76. (quasiquote (unquote 7))
  77. ;=>7
  78. (def! a 8)
  79. ;=>8
  80. (quasiquote a)
  81. ;=>a
  82. (quasiquote (unquote a))
  83. ;=>8
  84. (quasiquote (1 a 3))
  85. ;=>(1 a 3)
  86. (quasiquote (1 (unquote a) 3))
  87. ;=>(1 8 3)
  88. (def! b (quote (1 "b" "d")))
  89. ;=>(1 "b" "d")
  90. (quasiquote (1 b 3))
  91. ;=>(1 b 3)
  92. (quasiquote (1 (unquote b) 3))
  93. ;=>(1 (1 "b" "d") 3)
  94. (quasiquote ((unquote 1) (unquote 2)))
  95. ;=>(1 2)
  96. ;; Quasiquote and environments
  97. (let* (x 0) (quasiquote (unquote x)))
  98. ;=>0
  99. ;; Testing splice-unquote
  100. (def! c (quote (1 "b" "d")))
  101. ;=>(1 "b" "d")
  102. (quasiquote (1 c 3))
  103. ;=>(1 c 3)
  104. (quasiquote (1 (splice-unquote c) 3))
  105. ;=>(1 1 "b" "d" 3)
  106. (quasiquote (1 (splice-unquote c)))
  107. ;=>(1 1 "b" "d")
  108. (quasiquote ((splice-unquote c) 2))
  109. ;=>(1 "b" "d" 2)
  110. (quasiquote ((splice-unquote c) (splice-unquote c)))
  111. ;=>(1 "b" "d" 1 "b" "d")
  112. ;; Testing symbol equality
  113. (= (quote abc) (quote abc))
  114. ;=>true
  115. (= (quote abc) (quote abcd))
  116. ;=>false
  117. (= (quote abc) "abc")
  118. ;=>false
  119. (= "abc" (quote abc))
  120. ;=>false
  121. (= "abc" (str (quote abc)))
  122. ;=>true
  123. (= (quote abc) nil)
  124. ;=>false
  125. (= nil (quote abc))
  126. ;=>false
  127. ;>>> deferrable=True
  128. ;;
  129. ;; -------- Deferrable Functionality --------
  130. ;; Testing ' (quote) reader macro
  131. '7
  132. ;=>7
  133. '(1 2 3)
  134. ;=>(1 2 3)
  135. '(1 2 (3 4))
  136. ;=>(1 2 (3 4))
  137. ;; Testing cons and concat with vectors
  138. (cons 1 [])
  139. ;=>(1)
  140. (cons [1] [2 3])
  141. ;=>([1] 2 3)
  142. (cons 1 [2 3])
  143. ;=>(1 2 3)
  144. (concat [1 2] (list 3 4) [5 6])
  145. ;=>(1 2 3 4 5 6)
  146. (concat [1 2])
  147. ;=>(1 2)
  148. ;>>> optional=True
  149. ;;
  150. ;; -------- Optional Functionality --------
  151. ;; Testing ` (quasiquote) reader macro
  152. `7
  153. ;=>7
  154. `(1 2 3)
  155. ;=>(1 2 3)
  156. `(1 2 (3 4))
  157. ;=>(1 2 (3 4))
  158. `(nil)
  159. ;=>(nil)
  160. ;; Testing ~ (unquote) reader macro
  161. `~7
  162. ;=>7
  163. (def! a 8)
  164. ;=>8
  165. `(1 ~a 3)
  166. ;=>(1 8 3)
  167. (def! b '(1 "b" "d"))
  168. ;=>(1 "b" "d")
  169. `(1 b 3)
  170. ;=>(1 b 3)
  171. `(1 ~b 3)
  172. ;=>(1 (1 "b" "d") 3)
  173. ;; Testing ~@ (splice-unquote) reader macro
  174. (def! c '(1 "b" "d"))
  175. ;=>(1 "b" "d")
  176. `(1 c 3)
  177. ;=>(1 c 3)
  178. `(1 ~@c 3)
  179. ;=>(1 1 "b" "d" 3)
  180. ;>>> soft=True
  181. ;; Testing vec function
  182. (vec (list))
  183. ;=>[]
  184. (vec (list 1))
  185. ;=>[1]
  186. (vec (list 1 2))
  187. ;=>[1 2]
  188. (vec [])
  189. ;=>[]
  190. (vec [1 2])
  191. ;=>[1 2]
  192. ;; Testing that vec does not mutate the original list
  193. (def! a (list 1 2))
  194. (vec a)
  195. ;=>[1 2]
  196. a
  197. ;=>(1 2)
  198. ;; Test quine
  199. ((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q)))))))
  200. ;=>((fn* (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (fn* (q) (quasiquote ((unquote q) (quote (unquote q)))))))
  201. ;; Testing quasiquote with vectors
  202. (quasiquote [])
  203. ;=>[]
  204. (quasiquote [[]])
  205. ;=>[[]]
  206. (quasiquote [()])
  207. ;=>[()]
  208. (quasiquote ([]))
  209. ;=>([])
  210. (def! a 8)
  211. ;=>8
  212. `[1 a 3]
  213. ;=>[1 a 3]
  214. (quasiquote [a [] b [c] d [e f] g])
  215. ;=>[a [] b [c] d [e f] g]
  216. ;; Testing unquote with vectors
  217. `[~a]
  218. ;=>[8]
  219. `[(~a)]
  220. ;=>[(8)]
  221. `([~a])
  222. ;=>([8])
  223. `[a ~a a]
  224. ;=>[a 8 a]
  225. `([a ~a a])
  226. ;=>([a 8 a])
  227. `[(a ~a a)]
  228. ;=>[(a 8 a)]
  229. ;; Testing splice-unquote with vectors
  230. (def! c '(1 "b" "d"))
  231. ;=>(1 "b" "d")
  232. `[~@c]
  233. ;=>[1 "b" "d"]
  234. `[(~@c)]
  235. ;=>[(1 "b" "d")]
  236. `([~@c])
  237. ;=>([1 "b" "d"])
  238. `[1 ~@c 3]
  239. ;=>[1 1 "b" "d" 3]
  240. `([1 ~@c 3])
  241. ;=>([1 1 "b" "d" 3])
  242. `[(1 ~@c 3)]
  243. ;=>[(1 1 "b" "d" 3)]
  244. ;; Misplaced unquote or splice-unquote
  245. `(0 unquote)
  246. ;=>(0 unquote)
  247. `(0 splice-unquote)
  248. ;=>(0 splice-unquote)
  249. `[unquote 0]
  250. ;=>[unquote 0]
  251. `[splice-unquote 0]
  252. ;=>[splice-unquote 0]
  253. ;; Debugging quasiquote
  254. (quasiquoteexpand nil)
  255. ;=>nil
  256. (quasiquoteexpand 7)
  257. ;=>7
  258. (quasiquoteexpand a)
  259. ;=>(quote a)
  260. (quasiquoteexpand {"a" b})
  261. ;=>(quote {"a" b})
  262. (quasiquoteexpand ())
  263. ;=>()
  264. (quasiquoteexpand (1 2 3))
  265. ;=>(cons 1 (cons 2 (cons 3 ())))
  266. (quasiquoteexpand (a))
  267. ;=>(cons (quote a) ())
  268. (quasiquoteexpand (1 2 (3 4)))
  269. ;=>(cons 1 (cons 2 (cons (cons 3 (cons 4 ())) ())))
  270. (quasiquoteexpand (nil))
  271. ;=>(cons nil ())
  272. (quasiquoteexpand (1 ()))
  273. ;=>(cons 1 (cons () ()))
  274. (quasiquoteexpand (() 1))
  275. ;=>(cons () (cons 1 ()))
  276. (quasiquoteexpand (1 () 2))
  277. ;=>(cons 1 (cons () (cons 2 ())))
  278. (quasiquoteexpand (()))
  279. ;=>(cons () ())
  280. (quasiquoteexpand (f () g (h) i (j k) l))
  281. ;=>(cons (quote f) (cons () (cons (quote g) (cons (cons (quote h) ()) (cons (quote i) (cons (cons (quote j) (cons (quote k) ())) (cons (quote l) ())))))))
  282. (quasiquoteexpand (unquote 7))
  283. ;=>7
  284. (quasiquoteexpand a)
  285. ;=>(quote a)
  286. (quasiquoteexpand (unquote a))
  287. ;=>a
  288. (quasiquoteexpand (1 a 3))
  289. ;=>(cons 1 (cons (quote a) (cons 3 ())))
  290. (quasiquoteexpand (1 (unquote a) 3))
  291. ;=>(cons 1 (cons a (cons 3 ())))
  292. (quasiquoteexpand (1 b 3))
  293. ;=>(cons 1 (cons (quote b) (cons 3 ())))
  294. (quasiquoteexpand (1 (unquote b) 3))
  295. ;=>(cons 1 (cons b (cons 3 ())))
  296. (quasiquoteexpand ((unquote 1) (unquote 2)))
  297. ;=>(cons 1 (cons 2 ()))
  298. (quasiquoteexpand (a (splice-unquote (b c)) d))
  299. ;=>(cons (quote a) (concat (b c) (cons (quote d) ())))
  300. (quasiquoteexpand (1 c 3))
  301. ;=>(cons 1 (cons (quote c) (cons 3 ())))
  302. (quasiquoteexpand (1 (splice-unquote c) 3))
  303. ;=>(cons 1 (concat c (cons 3 ())))
  304. (quasiquoteexpand (1 (splice-unquote c)))
  305. ;=>(cons 1 (concat c ()))
  306. (quasiquoteexpand ((splice-unquote c) 2))
  307. ;=>(concat c (cons 2 ()))
  308. (quasiquoteexpand ((splice-unquote c) (splice-unquote c)))
  309. ;=>(concat c (concat c ()))
  310. (quasiquoteexpand [])
  311. ;=>(vec ())
  312. (quasiquoteexpand [[]])
  313. ;=>(vec (cons (vec ()) ()))
  314. (quasiquoteexpand [()])
  315. ;=>(vec (cons () ()))
  316. (quasiquoteexpand ([]))
  317. ;=>(cons (vec ()) ())
  318. (quasiquoteexpand [1 a 3])
  319. ;=>(vec (cons 1 (cons (quote a) (cons 3 ()))))
  320. (quasiquoteexpand [a [] b [c] d [e f] g])
  321. ;=>(vec (cons (quote a) (cons (vec ()) (cons (quote b) (cons (vec (cons (quote c) ())) (cons (quote d) (cons (vec (cons (quote e) (cons (quote f) ()))) (cons (quote g) ()))))))))
复制代码
  1. ;;; TODO: really a step5 test
  2. ;;
  3. ;; Testing that (do (do)) not broken by TCO
  4. (do (do 1 2))
  5. ;=>2
  6. ;;
  7. ;; Testing read-string, eval and slurp
  8. (read-string "(1 2 (3 4) nil)")
  9. ;=>(1 2 (3 4) nil)
  10. (= nil (read-string "nil"))
  11. ;=>true
  12. (read-string "(+ 2 3)")
  13. ;=>(+ 2 3)
  14. (read-string "\"\n\"")
  15. ;=>"\n"
  16. (read-string "7 ;; comment")
  17. ;=>7
  18. ;;; Differing output, but make sure no fatal error
  19. (read-string ";; comment")
  20. (eval (read-string "(+ 2 3)"))
  21. ;=>5
  22. (slurp "../tests/test.txt")
  23. ;=>"A line of text\n"
  24. ;;; Load the same file twice.
  25. (slurp "../tests/test.txt")
  26. ;=>"A line of text\n"
  27. ;; Testing load-file
  28. (load-file "../tests/inc.mal")
  29. ;=>nil
  30. (inc1 7)
  31. ;=>8
  32. (inc2 7)
  33. ;=>9
  34. (inc3 9)
  35. ;=>12
  36. ;;
  37. ;; Testing atoms
  38. (def! inc3 (fn* (a) (+ 3 a)))
  39. (def! a (atom 2))
  40. ;=>(atom 2)
  41. (atom? a)
  42. ;=>true
  43. (atom? 1)
  44. ;=>false
  45. (deref a)
  46. ;=>2
  47. (reset! a 3)
  48. ;=>3
  49. (deref a)
  50. ;=>3
  51. (swap! a inc3)
  52. ;=>6
  53. (deref a)
  54. ;=>6
  55. (swap! a (fn* (a) a))
  56. ;=>6
  57. (swap! a (fn* (a) (* 2 a)))
  58. ;=>12
  59. (swap! a (fn* (a b) (* a b)) 10)
  60. ;=>120
  61. (swap! a + 3)
  62. ;=>123
  63. ;; Testing swap!/closure interaction
  64. (def! inc-it (fn* (a) (+ 1 a)))
  65. (def! atm (atom 7))
  66. (def! f (fn* () (swap! atm inc-it)))
  67. (f)
  68. ;=>8
  69. (f)
  70. ;=>9
  71. ;; Testing whether closures can retain atoms
  72. (def! g (let* (atm (atom 0)) (fn* () (deref atm))))
  73. (def! atm (atom 1))
  74. (g)
  75. ;=>0
  76. ;>>> deferrable=True
  77. ;;
  78. ;; -------- Deferrable Functionality --------
  79. ;; Testing reading of large files
  80. (load-file "../tests/computations.mal")
  81. ;=>nil
  82. (sumdown 2)
  83. ;=>3
  84. (fib 2)
  85. ;=>1
  86. ;; Testing `@` reader macro (short for `deref`)
  87. (def! atm (atom 9))
  88. @atm
  89. ;=>9
  90. ;;; TODO: really a step5 test
  91. ;; Testing that vector params not broken by TCO
  92. (def! g (fn* [] 78))
  93. (g)
  94. ;=>78
  95. (def! g (fn* [a] (+ a 78)))
  96. (g 3)
  97. ;=>81
  98. ;;
  99. ;; Testing that *ARGV* exists and is an empty list
  100. (list? *ARGV*)
  101. ;=>true
  102. *ARGV*
  103. ;=>()
  104. ;;
  105. ;; Testing that eval sets aa in root scope, and that it is found in nested scope
  106. (let* (b 12) (do (eval (read-string "(def! aa 7)")) aa ))
  107. ;=>7
  108. ;>>> soft=True
  109. ;>>> optional=True
  110. ;;
  111. ;; -------- Optional Functionality --------
  112. ;; Testing comments in a file
  113. (load-file "../tests/incB.mal")
  114. ;=>nil
  115. (inc4 7)
  116. ;=>11
  117. (inc5 7)
  118. ;=>12
  119. ;; Testing map literal across multiple lines in a file
  120. (load-file "../tests/incC.mal")
  121. ;=>nil
  122. mymap
  123. ;=>{"a" 1}
  124. ;; Checking that eval does not use local environments.
  125. (def! a 1)
  126. ;=>1
  127. (let* (a 2) (eval (read-string "a")))
  128. ;=>1
  129. ;; Non alphanumeric characters in comments in read-string
  130. (read-string "1;!")
  131. ;=>1
  132. (read-string "1;\"")
  133. ;=>1
  134. (read-string "1;#")
  135. ;=>1
  136. (read-string "1;$")
  137. ;=>1
  138. (read-string "1;%")
  139. ;=>1
  140. (read-string "1;'")
  141. ;=>1
  142. (read-string "1;\\")
  143. ;=>1
  144. (read-string "1;\\\\")
  145. ;=>1
  146. (read-string "1;\\\\\\")
  147. ;=>1
  148. (read-string "1;`")
  149. ;=>1
  150. ;;; Hopefully less problematic characters can be checked together
  151. (read-string "1; &()*+,-./:;<=>?@[]^_{|}~")
  152. ;=>1
复制代码
  1. ;; Testing trivial macros
  2. (defmacro! one (fn* () 1))
  3. (one)
  4. ;=>1
  5. (defmacro! two (fn* () 2))
  6. (two)
  7. ;=>2
  8. ;; Testing unless macros
  9. (defmacro! unless (fn* (pred a b) `(if ~pred ~b ~a)))
  10. (unless false 7 8)
  11. ;=>7
  12. (unless true 7 8)
  13. ;=>8
  14. (defmacro! unless2 (fn* (pred a b) (list 'if (list 'not pred) a b)))
  15. (unless2 false 7 8)
  16. ;=>7
  17. (unless2 true 7 8)
  18. ;=>8
  19. ;; Testing macroexpand
  20. (macroexpand (one))
  21. ;=>1
  22. (macroexpand (unless PRED A B))
  23. ;=>(if PRED B A)
  24. (macroexpand (unless2 PRED A B))
  25. ;=>(if (not PRED) A B)
  26. (macroexpand (unless2 2 3 4))
  27. ;=>(if (not 2) 3 4)
  28. ;; Testing evaluation of macro result
  29. (defmacro! identity (fn* (x) x))
  30. (let* (a 123) (macroexpand (identity a)))
  31. ;=>a
  32. (let* (a 123) (identity a))
  33. ;=>123
  34. ;; Test that macros do not break empty list
  35. ()
  36. ;=>()
  37. ;; Test that macros do not break quasiquote
  38. `(1)
  39. ;=>(1)
  40. ;>>> deferrable=True
  41. ;;
  42. ;; -------- Deferrable Functionality --------
  43. ;; Testing non-macro function
  44. (not (= 1 1))
  45. ;=>false
  46. ;;; This should fail if it is a macro
  47. (not (= 1 2))
  48. ;=>true
  49. ;; Testing nth, first and rest functions
  50. (nth (list 1) 0)
  51. ;=>1
  52. (nth (list 1 2) 1)
  53. ;=>2
  54. (nth (list 1 2 nil) 2)
  55. ;=>nil
  56. (def! x "x")
  57. (def! x (nth (list 1 2) 2))
  58. x
  59. ;=>"x"
  60. (first (list))
  61. ;=>nil
  62. (first (list 6))
  63. ;=>6
  64. (first (list 7 8 9))
  65. ;=>7
  66. (rest (list))
  67. ;=>()
  68. (rest (list 6))
  69. ;=>()
  70. (rest (list 7 8 9))
  71. ;=>(8 9)
  72. ;; Testing cond macro
  73. (macroexpand (cond))
  74. ;=>nil
  75. (cond)
  76. ;=>nil
  77. (macroexpand (cond X Y))
  78. ;=>(if X Y (cond))
  79. (cond true 7)
  80. ;=>7
  81. (cond false 7)
  82. ;=>nil
  83. (macroexpand (cond X Y Z T))
  84. ;=>(if X Y (cond Z T))
  85. (cond true 7 true 8)
  86. ;=>7
  87. (cond false 7 true 8)
  88. ;=>8
  89. (cond false 7 false 8 "else" 9)
  90. ;=>9
  91. (cond false 7 (= 2 2) 8 "else" 9)
  92. ;=>8
  93. (cond false 7 false 8 false 9)
  94. ;=>nil
  95. ;; Testing EVAL in let*
  96. (let* (x (cond false "no" true "yes")) x)
  97. ;=>"yes"
  98. ;; Testing nth, first, rest with vectors
  99. (nth [1] 0)
  100. ;=>1
  101. (nth [1 2] 1)
  102. ;=>2
  103. (nth [1 2 nil] 2)
  104. ;=>nil
  105. (def! x "x")
  106. (def! x (nth [1 2] 2))
  107. x
  108. ;=>"x"
  109. (first [])
  110. ;=>nil
  111. (first nil)
  112. ;=>nil
  113. (first [10])
  114. ;=>10
  115. (first [10 11 12])
  116. ;=>10
  117. (rest [])
  118. ;=>()
  119. (rest nil)
  120. ;=>()
  121. (rest [10])
  122. ;=>()
  123. (rest [10 11 12])
  124. ;=>(11 12)
  125. (rest (cons 10 [11 12]))
  126. ;=>(11 12)
  127. ;; Testing EVAL in vector let*
  128. (let* [x (cond false "no" true "yes")] x)
  129. ;=>"yes"
  130. ;>>> soft=True
  131. ;>>> optional=True
  132. ;;
  133. ;; ------- Optional Functionality --------------
  134. ;; ------- (Not needed for self-hosting) -------
  135. ;; Test that macros use closures
  136. (def! x 2)
  137. (defmacro! a (fn* [] x))
  138. (a)
  139. ;=>2
  140. (let* (x 3) (a))
  141. ;=>2
复制代码
  1. ;;
  2. ;; Testing throw
  3. (throw "err1")
  4. ;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*err1.*
  5. ;;
  6. ;; Testing try*/catch*
  7. (try* 123 (catch* e 456))
  8. ;=>123
  9. (try* abc (catch* exc (prn "exc is:" exc)))
  10. ;/"exc is:" "'abc' not found"
  11. ;=>nil
  12. (try* (abc 1 2) (catch* exc (prn "exc is:" exc)))
  13. ;/"exc is:" "'abc' not found"
  14. ;=>nil
  15. ;; Make sure error from core can be caught
  16. (try* (nth () 1) (catch* exc (prn "exc is:" exc)))
  17. ;/"exc is:".*(length|range|[Bb]ounds|beyond).*
  18. ;=>nil
  19. (try* (throw "my exception") (catch* exc (do (prn "exc:" exc) 7)))
  20. ;/"exc:" "my exception"
  21. ;=>7
  22. ;; Test that exception handlers get restored correctly
  23. (try* (do (try* "t1" (catch* e "c1")) (throw "e1")) (catch* e "c2"))
  24. ;=>"c2"
  25. (try* (try* (throw "e1") (catch* e (throw "e2"))) (catch* e "c2"))
  26. ;=>"c2"
  27. ;;; Test that throw is a function:
  28. (try* (map throw (list "my err")) (catch* exc exc))
  29. ;=>"my err"
  30. ;;
  31. ;; Testing builtin functions
  32. (symbol? 'abc)
  33. ;=>true
  34. (symbol? "abc")
  35. ;=>false
  36. (nil? nil)
  37. ;=>true
  38. (nil? true)
  39. ;=>false
  40. (true? true)
  41. ;=>true
  42. (true? false)
  43. ;=>false
  44. (true? true?)
  45. ;=>false
  46. (false? false)
  47. ;=>true
  48. (false? true)
  49. ;=>false
  50. ;; Testing apply function with core functions
  51. (apply + (list 2 3))
  52. ;=>5
  53. (apply + 4 (list 5))
  54. ;=>9
  55. (apply prn (list 1 2 "3" (list)))
  56. ;/1 2 "3" \(\)
  57. ;=>nil
  58. (apply prn 1 2 (list "3" (list)))
  59. ;/1 2 "3" \(\)
  60. ;=>nil
  61. (apply list (list))
  62. ;=>()
  63. (apply symbol? (list (quote two)))
  64. ;=>true
  65. ;; Testing apply function with user functions
  66. (apply (fn* (a b) (+ a b)) (list 2 3))
  67. ;=>5
  68. (apply (fn* (a b) (+ a b)) 4 (list 5))
  69. ;=>9
  70. ;; Testing map function
  71. (def! nums (list 1 2 3))
  72. (def! double (fn* (a) (* 2 a)))
  73. (double 3)
  74. ;=>6
  75. (map double nums)
  76. ;=>(2 4 6)
  77. (map (fn* (x) (symbol? x)) (list 1 (quote two) "three"))
  78. ;=>(false true false)
  79. (= () (map str ()))
  80. ;=>true
  81. ;>>> deferrable=True
  82. ;;
  83. ;; ------- Deferrable Functionality ----------
  84. ;; ------- (Needed for self-hosting) -------
  85. ;; Testing symbol and keyword functions
  86. (symbol? :abc)
  87. ;=>false
  88. (symbol? 'abc)
  89. ;=>true
  90. (symbol? "abc")
  91. ;=>false
  92. (symbol? (symbol "abc"))
  93. ;=>true
  94. (keyword? :abc)
  95. ;=>true
  96. (keyword? 'abc)
  97. ;=>false
  98. (keyword? "abc")
  99. ;=>false
  100. (keyword? "")
  101. ;=>false
  102. (keyword? (keyword "abc"))
  103. ;=>true
  104. (symbol "abc")
  105. ;=>abc
  106. (keyword "abc")
  107. ;=>:abc
  108. ;; Testing sequential? function
  109. (sequential? (list 1 2 3))
  110. ;=>true
  111. (sequential? [15])
  112. ;=>true
  113. (sequential? sequential?)
  114. ;=>false
  115. (sequential? nil)
  116. ;=>false
  117. (sequential? "abc")
  118. ;=>false
  119. ;; Testing apply function with core functions and arguments in vector
  120. (apply + 4 [5])
  121. ;=>9
  122. (apply prn 1 2 ["3" 4])
  123. ;/1 2 "3" 4
  124. ;=>nil
  125. (apply list [])
  126. ;=>()
  127. ;; Testing apply function with user functions and arguments in vector
  128. (apply (fn* (a b) (+ a b)) [2 3])
  129. ;=>5
  130. (apply (fn* (a b) (+ a b)) 4 [5])
  131. ;=>9
  132. ;; Testing map function with vectors
  133. (map (fn* (a) (* 2 a)) [1 2 3])
  134. ;=>(2 4 6)
  135. (map (fn* [& args] (list? args)) [1 2])
  136. ;=>(true true)
  137. ;; Testing vector functions
  138. (vector? [10 11])
  139. ;=>true
  140. (vector? '(12 13))
  141. ;=>false
  142. (vector 3 4 5)
  143. ;=>[3 4 5]
  144. (= [] (vector))
  145. ;=>true
  146. (map? {})
  147. ;=>true
  148. (map? '())
  149. ;=>false
  150. (map? [])
  151. ;=>false
  152. (map? 'abc)
  153. ;=>false
  154. (map? :abc)
  155. ;=>false
  156. ;;
  157. ;; Testing hash-maps
  158. (hash-map "a" 1)
  159. ;=>{"a" 1}
  160. {"a" 1}
  161. ;=>{"a" 1}
  162. (assoc {} "a" 1)
  163. ;=>{"a" 1}
  164. (get (assoc (assoc {"a" 1 } "b" 2) "c" 3) "a")
  165. ;=>1
  166. (def! hm1 (hash-map))
  167. ;=>{}
  168. (map? hm1)
  169. ;=>true
  170. (map? 1)
  171. ;=>false
  172. (map? "abc")
  173. ;=>false
  174. (get nil "a")
  175. ;=>nil
  176. (get hm1 "a")
  177. ;=>nil
  178. (contains? hm1 "a")
  179. ;=>false
  180. (def! hm2 (assoc hm1 "a" 1))
  181. ;=>{"a" 1}
  182. (get hm1 "a")
  183. ;=>nil
  184. (contains? hm1 "a")
  185. ;=>false
  186. (get hm2 "a")
  187. ;=>1
  188. (contains? hm2 "a")
  189. ;=>true
  190. ;;; TODO: fix. Clojure returns nil but this breaks mal impl
  191. (keys hm1)
  192. ;=>()
  193. (= () (keys hm1))
  194. ;=>true
  195. (keys hm2)
  196. ;=>("a")
  197. (keys {"1" 1})
  198. ;=>("1")
  199. ;;; TODO: fix. Clojure returns nil but this breaks mal impl
  200. (vals hm1)
  201. ;=>()
  202. (= () (vals hm1))
  203. ;=>true
  204. (vals hm2)
  205. ;=>(1)
  206. (count (keys (assoc hm2 "b" 2 "c" 3)))
  207. ;=>3
  208. ;; Testing keywords as hash-map keys
  209. (get {:abc 123} :abc)
  210. ;=>123
  211. (contains? {:abc 123} :abc)
  212. ;=>true
  213. (contains? {:abcd 123} :abc)
  214. ;=>false
  215. (assoc {} :bcd 234)
  216. ;=>{:bcd 234}
  217. (keyword? (nth (keys {:abc 123 :def 456}) 0))
  218. ;=>true
  219. (keyword? (nth (vals {"a" :abc "b" :def}) 0))
  220. ;=>true
  221. ;; Testing whether assoc updates properly
  222. (def! hm4 (assoc {:a 1 :b 2} :a 3 :c 1))
  223. (get hm4 :a)
  224. ;=>3
  225. (get hm4 :b)
  226. ;=>2
  227. (get hm4 :c)
  228. ;=>1
  229. ;; Testing nil as hash-map values
  230. (contains? {:abc nil} :abc)
  231. ;=>true
  232. (assoc {} :bcd nil)
  233. ;=>{:bcd nil}
  234. ;;
  235. ;; Additional str and pr-str tests
  236. (str "A" {:abc "val"} "Z")
  237. ;=>"A{:abc val}Z"
  238. (str true "." false "." nil "." :keyw "." 'symb)
  239. ;=>"true.false.nil.:keyw.symb"
  240. (pr-str "A" {:abc "val"} "Z")
  241. ;=>"\"A\" {:abc \"val\"} \"Z\""
  242. (pr-str true "." false "." nil "." :keyw "." 'symb)
  243. ;=>"true \".\" false \".\" nil \".\" :keyw \".\" symb"
  244. (def! s (str {:abc "val1" :def "val2"}))
  245. (cond (= s "{:abc val1 :def val2}") true (= s "{:def val2 :abc val1}") true)
  246. ;=>true
  247. (def! p (pr-str {:abc "val1" :def "val2"}))
  248. (cond (= p "{:abc \"val1\" :def \"val2\"}") true (= p "{:def \"val2\" :abc \"val1\"}") true)
  249. ;=>true
  250. ;;
  251. ;; Test extra function arguments as Mal List (bypassing TCO with apply)
  252. (apply (fn* (& more) (list? more)) [1 2 3])
  253. ;=>true
  254. (apply (fn* (& more) (list? more)) [])
  255. ;=>true
  256. (apply (fn* (a & more) (list? more)) [1])
  257. ;=>true
  258. ;>>> soft=True
  259. ;>>> optional=True
  260. ;;
  261. ;; ------- Optional Functionality --------------
  262. ;; ------- (Not needed for self-hosting) -------
  263. ;; Testing throwing a hash-map
  264. (throw {:msg "err2"})
  265. ;/.*([Ee][Rr][Rr][Oo][Rr]|[Ee]xception).*msg.*err2.*
  266. ;;;TODO: fix so long lines don't trigger ANSI escape codes ;;;(try*
  267. ;;;(try* (throw ["data" "foo"]) (catch* exc (do (prn "exc is:" exc) 7))) ;;;;
  268. ;;;; "exc is:" ["data" "foo"] ;;;;=>7
  269. ;;;;=>7
  270. ;;
  271. ;; Testing try* without catch*
  272. (try* xyz)
  273. ;/.*\'?xyz\'? not found.*
  274. ;;
  275. ;; Testing throwing non-strings
  276. (try* (throw (list 1 2 3)) (catch* exc (do (prn "err:" exc) 7)))
  277. ;/"err:" \(1 2 3\)
  278. ;=>7
  279. ;;
  280. ;; Testing dissoc
  281. (def! hm3 (assoc hm2 "b" 2))
  282. (count (keys hm3))
  283. ;=>2
  284. (count (vals hm3))
  285. ;=>2
  286. (dissoc hm3 "a")
  287. ;=>{"b" 2}
  288. (dissoc hm3 "a" "b")
  289. ;=>{}
  290. (dissoc hm3 "a" "b" "c")
  291. ;=>{}
  292. (count (keys hm3))
  293. ;=>2
  294. (dissoc {:cde 345 :fgh 456} :cde)
  295. ;=>{:fgh 456}
  296. (dissoc {:cde nil :fgh 456} :cde)
  297. ;=>{:fgh 456}
  298. ;;
  299. ;; Testing equality of hash-maps
  300. (= {} {})
  301. ;=>true
  302. (= {} (hash-map))
  303. ;=>true
  304. (= {:a 11 :b 22} (hash-map :b 22 :a 11))
  305. ;=>true
  306. (= {:a 11 :b [22 33]} (hash-map :b [22 33] :a 11))
  307. ;=>true
  308. (= {:a 11 :b {:c 33}} (hash-map :b {:c 33} :a 11))
  309. ;=>true
  310. (= {:a 11 :b 22} (hash-map :b 23 :a 11))
  311. ;=>false
  312. (= {:a 11 :b 22} (hash-map :a 11))
  313. ;=>false
  314. (= {:a [11 22]} {:a (list 11 22)})
  315. ;=>true
  316. (= {:a 11 :b 22} (list :a 11 :b 22))
  317. ;=>false
  318. (= {} [])
  319. ;=>false
  320. (= [] {})
  321. ;=>false
  322. (keyword :abc)
  323. ;=>:abc
  324. (keyword? (first (keys {":abc" 123 ":def" 456})))
  325. ;=>false
  326. ;; Testing that hashmaps don't alter function ast
  327. (def! bar (fn* [a] {:foo (get a :foo)}))
  328. (bar {:foo (fn* [x] x)})
  329. (bar {:foo 3})
  330. ;; shouldn't give an error
复制代码
  1. ;;;
  2. ;;; See IMPL/tests/stepA_mal.mal for implementation specific
  3. ;;; interop tests.
  4. ;;;
  5. ;;
  6. ;; Testing readline
  7. (readline "mal-user> ")
  8. "hello"
  9. ;=>"\"hello\""
  10. ;;
  11. ;; Testing *host-language*
  12. ;;; each impl is different, but this should return false
  13. ;;; rather than throwing an exception
  14. (= "something bogus" *host-language*)
  15. ;=>false
  16. ;>>> deferrable=True
  17. ;;
  18. ;; ------- Deferrable Functionality ----------
  19. ;; ------- (Needed for self-hosting) -------
  20. ;;
  21. ;;
  22. ;; Testing hash-map evaluation and atoms (i.e. an env)
  23. (def! e (atom {"+" +}))
  24. (swap! e assoc "-" -)
  25. ( (get @e "+") 7 8)
  26. ;=>15
  27. ( (get @e "-") 11 8)
  28. ;=>3
  29. (swap! e assoc "foo" (list))
  30. (get @e "foo")
  31. ;=>()
  32. (swap! e assoc "bar" '(1 2 3))
  33. (get @e "bar")
  34. ;=>(1 2 3)
  35. ;; Testing for presence of optional functions
  36. (do (list time-ms string? number? seq conj meta with-meta fn?) nil)
  37. ;=>nil
  38. (map symbol? '(nil false true))
  39. ;=>(false false false)
  40. ;; ------------------------------------------------------------------
  41. ;>>> soft=True
  42. ;>>> optional=True
  43. ;;
  44. ;; ------- Optional Functionality --------------
  45. ;; ------- (Not needed for self-hosting) -------
  46. ;; Testing metadata on functions
  47. ;;
  48. ;; Testing metadata on mal functions
  49. (meta (fn* (a) a))
  50. ;=>nil
  51. (meta (with-meta (fn* (a) a) {"b" 1}))
  52. ;=>{"b" 1}
  53. (meta (with-meta (fn* (a) a) "abc"))
  54. ;=>"abc"
  55. (def! l-wm (with-meta (fn* (a) a) {"b" 2}))
  56. (meta l-wm)
  57. ;=>{"b" 2}
  58. (meta (with-meta l-wm {"new_meta" 123}))
  59. ;=>{"new_meta" 123}
  60. (meta l-wm)
  61. ;=>{"b" 2}
  62. (def! f-wm (with-meta (fn* [a] (+ 1 a)) {"abc" 1}))
  63. (meta f-wm)
  64. ;=>{"abc" 1}
  65. (meta (with-meta f-wm {"new_meta" 123}))
  66. ;=>{"new_meta" 123}
  67. (meta f-wm)
  68. ;=>{"abc" 1}
  69. (def! f-wm2 ^{"abc" 1} (fn* [a] (+ 1 a)))
  70. (meta f-wm2)
  71. ;=>{"abc" 1}
  72. ;; Meta of native functions should return nil (not fail)
  73. (meta +)
  74. ;=>nil
  75. ;;
  76. ;; Make sure closures and metadata co-exist
  77. (def! gen-plusX (fn* (x) (with-meta (fn* (b) (+ x b)) {"meta" 1})))
  78. (def! plus7 (gen-plusX 7))
  79. (def! plus8 (gen-plusX 8))
  80. (plus7 8)
  81. ;=>15
  82. (meta plus7)
  83. ;=>{"meta" 1}
  84. (meta plus8)
  85. ;=>{"meta" 1}
  86. (meta (with-meta plus7 {"meta" 2}))
  87. ;=>{"meta" 2}
  88. (meta plus8)
  89. ;=>{"meta" 1}
  90. ;;
  91. ;; Testing string? function
  92. (string? "")
  93. ;=>true
  94. (string? 'abc)
  95. ;=>false
  96. (string? "abc")
  97. ;=>true
  98. (string? :abc)
  99. ;=>false
  100. (string? (keyword "abc"))
  101. ;=>false
  102. (string? 234)
  103. ;=>false
  104. (string? nil)
  105. ;=>false
  106. ;; Testing number? function
  107. (number? 123)
  108. ;=>true
  109. (number? -1)
  110. ;=>true
  111. (number? nil)
  112. ;=>false
  113. (number? false)
  114. ;=>false
  115. (number? "123")
  116. ;=>false
  117. (def! add1 (fn* (x) (+ x 1)))
  118. ;; Testing fn? function
  119. (fn? +)
  120. ;=>true
  121. (fn? add1)
  122. ;=>true
  123. (fn? cond)
  124. ;=>false
  125. (fn? "+")
  126. ;=>false
  127. (fn? :+)
  128. ;=>false
  129. (fn? ^{"ismacro" true} (fn* () 0))
  130. ;=>true
  131. ;; Testing macro? function
  132. (macro? cond)
  133. ;=>true
  134. (macro? +)
  135. ;=>false
  136. (macro? add1)
  137. ;=>false
  138. (macro? "+")
  139. ;=>false
  140. (macro? :+)
  141. ;=>false
  142. (macro? {})
  143. ;=>false
  144. ;;
  145. ;; Testing conj function
  146. (conj (list) 1)
  147. ;=>(1)
  148. (conj (list 1) 2)
  149. ;=>(2 1)
  150. (conj (list 2 3) 4)
  151. ;=>(4 2 3)
  152. (conj (list 2 3) 4 5 6)
  153. ;=>(6 5 4 2 3)
  154. (conj (list 1) (list 2 3))
  155. ;=>((2 3) 1)
  156. (conj [] 1)
  157. ;=>[1]
  158. (conj [1] 2)
  159. ;=>[1 2]
  160. (conj [2 3] 4)
  161. ;=>[2 3 4]
  162. (conj [2 3] 4 5 6)
  163. ;=>[2 3 4 5 6]
  164. (conj [1] [2 3])
  165. ;=>[1 [2 3]]
  166. ;;
  167. ;; Testing seq function
  168. (seq "abc")
  169. ;=>("a" "b" "c")
  170. (apply str (seq "this is a test"))
  171. ;=>"this is a test"
  172. (seq '(2 3 4))
  173. ;=>(2 3 4)
  174. (seq [2 3 4])
  175. ;=>(2 3 4)
  176. (seq "")
  177. ;=>nil
  178. (seq '())
  179. ;=>nil
  180. (seq [])
  181. ;=>nil
  182. (seq nil)
  183. ;=>nil
  184. ;;
  185. ;; Testing metadata on collections
  186. (meta [1 2 3])
  187. ;=>nil
  188. (with-meta [1 2 3] {"a" 1})
  189. ;=>[1 2 3]
  190. (meta (with-meta [1 2 3] {"a" 1}))
  191. ;=>{"a" 1}
  192. (vector? (with-meta [1 2 3] {"a" 1}))
  193. ;=>true
  194. (meta (with-meta [1 2 3] "abc"))
  195. ;=>"abc"
  196. (with-meta [] "abc")
  197. ;=>[]
  198. (meta (with-meta (list 1 2 3) {"a" 1}))
  199. ;=>{"a" 1}
  200. (list? (with-meta (list 1 2 3) {"a" 1}))
  201. ;=>true
  202. (with-meta (list) {"a" 1})
  203. ;=>()
  204. (empty? (with-meta (list) {"a" 1}))
  205. ;=>true
  206. (meta (with-meta {"abc" 123} {"a" 1}))
  207. ;=>{"a" 1}
  208. (map? (with-meta {"abc" 123} {"a" 1}))
  209. ;=>true
  210. (with-meta {} {"a" 1})
  211. ;=>{}
  212. (def! l-wm (with-meta [4 5 6] {"b" 2}))
  213. ;=>[4 5 6]
  214. (meta l-wm)
  215. ;=>{"b" 2}
  216. (meta (with-meta l-wm {"new_meta" 123}))
  217. ;=>{"new_meta" 123}
  218. (meta l-wm)
  219. ;=>{"b" 2}
  220. ;;
  221. ;; Testing metadata on builtin functions
  222. (meta +)
  223. ;=>nil
  224. (def! f-wm3 ^{"def" 2} +)
  225. (meta f-wm3)
  226. ;=>{"def" 2}
  227. (meta +)
  228. ;=>nil
  229. ;; Loading sumdown from computations.mal
  230. (load-file "../tests/computations.mal")
  231. ;=>nil
  232. ;;
  233. ;; Testing time-ms function
  234. (def! start-time (time-ms))
  235. (= start-time 0)
  236. ;=>false
  237. (sumdown 10) ; Waste some time
  238. ;=>55
  239. (> (time-ms) start-time)
  240. ;=>true
  241. ;;
  242. ;; Test that defining a macro does not mutate an existing function.
  243. (def! f (fn* [x] (number? x)))
  244. (defmacro! m f)
  245. (f (+ 1 1))
  246. ;=>true
  247. (m (+ 1 1))
  248. ;=>false
复制代码
2

评分人数

    • HOPE2021: 感谢分享!技术 + 1
    • CrLf: 大工程PB + 8 技术 + 1

TOP

牛逼

TOP

回复 4# CrLf


    其实准备再用bat写一遍(还没动手

TOP

回复 6# jyswjjgdwtdtj


    今天发现个陈年老BUG,刚才才给修了,自己挖自己的坟帖了属于是(

TOP

返回列表