PageRenderTime 51ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 0ms

/demos/mk-mk-c.html

http://github.com/yinwang0/ydiff
HTML | 969 lines | 824 code | 145 blank | 0 comment | 0 complexity | 4e6381d0095b93c34756ca7e3bf65390 MD5 | raw file
Possible License(s): GPL-3.0
  1. <html>
  2. <head>
  3. <META http-equiv="Content-Type" content="text/html; charset=utf-8">
  4. <LINK href="diff-s.css" rel="stylesheet" type="text/css">
  5. <script type="text/javascript" src="nav-div.js"></script>
  6. </head>
  7. <body>
  8. <div id="left" class="src">
  9. <pre>
  10. <a id='leftstart' tid='rightstart'></a>
  11. <a id='841' tid='842' class='u'>;;; This file was generated by writeminikanren.pl
  12. </a><a id='843' tid='844' class='u'>;;; Generated at 2007-10-25 15:24:42
  13. </a>
  14. (<a id='387' tid='388' class='u'>define-syntax</a> <a id='389' tid='390' class='u'>lambdag@</a>
  15. <span class='d'>(syntax-rules ()
  16. ((_ (p) e) (lambda (p) e)))</span>)
  17. (<a id='383' tid='384' class='u'>define-syntax</a> <a id='385' tid='386' class='u'>lambdaf@</a>
  18. <span class='d'>(syntax-rules ()
  19. ((_ () e) (lambda () e)))</span>)
  20. (<a id='545' tid='546' class='u'>define-syntax</a> <a id='547' tid='548' class='u'>run*</a>
  21. (<a id='549' tid='550' class='u'>syntax-rules</a> ()
  22. ((<a id='551' tid='552' class='u'>_</a> (<a id='553' tid='554' class='u'>x</a>) <a id='555' tid='556' class='u'>g</a> <a id='557' tid='558' class='u'>...</a>) (<a id='559' tid='560' class='u'>run</a> <a id='561' tid='562' class='u'>#f</a> (<a id='563' tid='564' class='u'>x</a>) <a id='565' tid='566' class='u'>g</a> <a id='567' tid='568' class='u'>...</a>))))
  23. (<a id='527' tid='528' class='u'>define-syntax</a> <a id='529' tid='530' class='u'>rhs</a>
  24. (<a id='531' tid='532' class='u'>syntax-rules</a> ()
  25. ((<a id='533' tid='534' class='u'>_</a> <a id='535' tid='536' class='u'>x</a>) (<a id='537' tid='538' class='u'>cdr</a> <a id='539' tid='540' class='u'>x</a>))))
  26. (<a id='391' tid='392' class='u'>define-syntax</a> <a id='393' tid='394' class='u'>lhs</a>
  27. (<a id='395' tid='396' class='u'>syntax-rules</a> ()
  28. ((<a id='397' tid='398' class='u'>_</a> <a id='399' tid='400' class='u'>x</a>) (<a id='401' tid='402' class='u'>car</a> <a id='403' tid='404' class='u'>x</a>))))
  29. (<a id='569' tid='570' class='u'>define-syntax</a> <a id='571' tid='572' class='u'>size-s</a>
  30. (<a id='573' tid='574' class='u'>syntax-rules</a> ()
  31. ((<a id='575' tid='576' class='u'>_</a> <a id='577' tid='578' class='u'>x</a>) (<a id='579' tid='580' class='u'>length</a> <a id='581' tid='582' class='u'>x</a>))))
  32. (<a id='713' tid='714' class='u'>define-syntax</a> <a id='715' tid='716' class='u'>var</a>
  33. (<a id='717' tid='718' class='u'>syntax-rules</a> ()
  34. ((<a id='719' tid='720' class='u'>_</a> <a id='721' tid='722' class='u'>x</a>) (<a id='723' tid='724' class='u'>vector</a> <a id='725' tid='726' class='u'>x</a>))))
  35. (<a id='727' tid='728' class='u'>define-syntax</a> <a id='729' tid='730' class='u'>var?</a>
  36. (<a id='731' tid='732' class='u'>syntax-rules</a> ()
  37. ((<a id='733' tid='734' class='u'>_</a> <a id='735' tid='736' class='u'>x</a>) (<a id='737' tid='738' class='u'>vector?</a> <a id='739' tid='740' class='u'>x</a>))))
  38. (<a id='285' tid='286' class='u'>define</a> <a id='287' tid='288' class='u'>empty-s</a> <a id='289' tid='290' class='u'>&#39;</a>())
  39. (<a id='741' tid='742' class='u'>define</a> <a id='743' tid='744' class='u'>walk</a>
  40. (<a id='745' tid='746' class='u'>lambda</a> (<a id='747' tid='748' class='u'>v</a> <a id='749' tid='750' class='u'>s</a>)
  41. (<a id='751' tid='752' class='u'>cond</a>
  42. ((<a id='753' tid='754' class='u'>var?</a> <a id='755' tid='756' class='u'>v</a>)
  43. (<a id='757' tid='758' class='u'>let</a> ((<a id='759' tid='760' class='u'>a</a> (<a id='761' tid='762' class='u'>assq</a> <a id='763' tid='764' class='u'>v</a> <a id='765' tid='766' class='u'>s</a>)))
  44. (<a id='767' tid='768' class='u'>cond</a>
  45. (<a id='769' tid='770' class='u'>a</a> (<a id='771' tid='772' class='u'>walk</a> (<a id='773' tid='774' class='u'>rhs</a> <a id='775' tid='776' class='u'>a</a>) <a id='777' tid='778' class='u'>s</a>))
  46. (<a id='779' tid='780' class='u'>else</a> <a id='781' tid='782' class='u'>v</a>))))
  47. (<a id='783' tid='784' class='u'>else</a> <a id='785' tid='786' class='u'>v</a>))))
  48. (<a id='295' tid='296' class='u'>define</a> <a id='297' tid='298' class='u'>ext-s</a>
  49. (<a id='299' tid='300' class='u'>lambda</a> (<a id='301' tid='302' class='u'>x</a> <a id='303' tid='304' class='u'>v</a> <a id='305' tid='306' class='u'>s</a>)
  50. (<a id='307' tid='308' class='u'>cons</a> <a id='309' tid='310' class='u'>`</a>(<a id='311' tid='312' class='u'>,</a><a id='313' tid='314' class='u'>x</a> <a id='315' tid='316' class='u'>.</a> <a id='317' tid='318' class='u'>,</a><a id='319' tid='320' class='u'>v</a>) <a id='321' tid='322' class='u'>s</a>)))
  51. (<a id='591' tid='592' class='u'>define</a> <a id='593' tid='594' class='u'>unify</a>
  52. <span class='d'>(lambda (v w s)
  53. (let ((v (walk v s))
  54. (w (walk w s)))
  55. (cond
  56. ((eq? v w) s)
  57. ((var? v) (ext-s v w s))
  58. ((var? w) (ext-s w v s))
  59. ((and (pair? v) (pair? w))
  60. (let ((s (unify (car v) (car w) s)))
  61. (and s (unify (cdr v) (cdr w) s))))
  62. ((equal? v w) s)
  63. (else #f))))</span>)
  64. (<a id='595' tid='596' class='u'>define</a> <a id='597' tid='598' class='u'>unify-check</a>
  65. (<a id='599' tid='600' class='u'>lambda</a> (<a id='601' tid='602' class='u'>u</a> <a id='603' tid='604' class='u'>v</a> <a id='605' tid='606' class='u'>s</a>)
  66. (<a id='607' tid='608' class='u'>let</a> ((<a id='609' tid='610' class='u'>u</a> (<a id='611' tid='612' class='u'>walk</a> <a id='613' tid='614' class='u'>u</a> <a id='615' tid='616' class='u'>s</a>))
  67. (<a id='617' tid='618' class='u'>v</a> (<a id='619' tid='620' class='u'>walk</a> <a id='621' tid='622' class='u'>v</a> <a id='623' tid='624' class='u'>s</a>)))
  68. (<a id='625' tid='626' class='u'>cond</a>
  69. ((<a id='627' tid='628' class='u'>eq?</a> <a id='629' tid='630' class='u'>u</a> <a id='631' tid='632' class='u'>v</a>) <a id='633' tid='634' class='u'>s</a>)
  70. ((<a id='635' tid='636' class='u'>var?</a> <a id='637' tid='638' class='u'>u</a>) (<a id='639' tid='640' class='u'>ext-s-check</a> <a id='641' tid='642' class='u'>u</a> <a id='643' tid='644' class='u'>v</a> <a id='645' tid='646' class='u'>s</a>))
  71. ((<a id='647' tid='648' class='u'>var?</a> <a id='649' tid='650' class='u'>v</a>) (<a id='651' tid='652' class='u'>ext-s-check</a> <a id='653' tid='654' class='u'>v</a> <a id='655' tid='656' class='u'>u</a> <a id='657' tid='658' class='u'>s</a>))
  72. ((<a id='659' tid='660' class='u'>and</a> (<a id='661' tid='662' class='u'>pair?</a> <a id='663' tid='664' class='u'>u</a>) (<a id='665' tid='666' class='u'>pair?</a> <a id='667' tid='668' class='u'>v</a>))
  73. (<a id='669' tid='670' class='u'>let</a> ((<a id='671' tid='672' class='u'>s</a> (<a id='673' tid='674' class='u'>unify-check</a>
  74. (<a id='675' tid='676' class='u'>car</a> <a id='677' tid='678' class='u'>u</a>) (<a id='679' tid='680' class='u'>car</a> <a id='681' tid='682' class='u'>v</a>) <a id='683' tid='684' class='u'>s</a>)))
  75. (<a id='685' tid='686' class='u'>and</a> <a id='687' tid='688' class='u'>s</a> (<a id='689' tid='690' class='u'>unify-check</a>
  76. (<a id='691' tid='692' class='u'>cdr</a> <a id='693' tid='694' class='u'>u</a>) (<a id='695' tid='696' class='u'>cdr</a> <a id='697' tid='698' class='u'>v</a>) <a id='699' tid='700' class='u'>s</a>))))
  77. ((<a id='701' tid='702' class='u'>equal?</a> <a id='703' tid='704' class='u'>u</a> <a id='705' tid='706' class='u'>v</a>) <a id='707' tid='708' class='u'>s</a>)
  78. (<a id='709' tid='710' class='u'>else</a> <a id='711' tid='712' class='u'>#f</a>)))))
  79. (<a id='323' tid='324' class='u'>define</a> <a id='325' tid='326' class='u'>ext-s-check</a>
  80. (<a id='327' tid='328' class='u'>lambda</a> (<a id='329' tid='330' class='u'>x</a> <a id='331' tid='332' class='u'>v</a> <a id='333' tid='334' class='u'>s</a>)
  81. (<a id='335' tid='336' class='u'>cond</a>
  82. ((<a id='337' tid='338' class='u'>occurs-check</a> <a id='339' tid='340' class='u'>x</a> <a id='341' tid='342' class='u'>v</a> <a id='343' tid='344' class='u'>s</a>) <a id='345' tid='346' class='u'>#f</a>)
  83. (<a id='347' tid='348' class='u'>else</a> (<a id='349' tid='350' class='u'>ext-s</a> <a id='351' tid='352' class='u'>x</a> <a id='353' tid='354' class='u'>v</a> <a id='355' tid='356' class='u'>s</a>)))))
  84. (<a id='405' tid='406' class='u'>define</a> <a id='407' tid='408' class='u'>occurs-check</a>
  85. (<a id='409' tid='410' class='u'>lambda</a> (<a id='411' tid='412' class='u'>x</a> <a id='413' tid='414' class='u'>v</a> <a id='415' tid='416' class='u'>s</a>)
  86. (<a id='417' tid='418' class='u'>let</a> ((<a id='419' tid='420' class='u'>v</a> (<a id='421' tid='422' class='u'>walk</a> <a id='423' tid='424' class='u'>v</a> <a id='425' tid='426' class='u'>s</a>)))
  87. (<a id='427' tid='428' class='u'>cond</a>
  88. ((<a id='429' tid='430' class='u'>var?</a> <a id='431' tid='432' class='u'>v</a>) (<a id='433' tid='434' class='u'>eq?</a> <a id='435' tid='436' class='u'>v</a> <a id='437' tid='438' class='u'>x</a>))
  89. ((<a id='439' tid='440' class='u'>pair?</a> <a id='441' tid='442' class='u'>v</a>)
  90. (<a id='443' tid='444' class='u'>or</a>
  91. (<a id='445' tid='446' class='u'>occurs-check</a> <a id='447' tid='448' class='u'>x</a> (<a id='449' tid='450' class='u'>car</a> <a id='451' tid='452' class='u'>v</a>) <a id='453' tid='454' class='u'>s</a>)
  92. (<a id='455' tid='456' class='u'>occurs-check</a> <a id='457' tid='458' class='u'>x</a> (<a id='459' tid='460' class='u'>cdr</a> <a id='461' tid='462' class='u'>v</a>) <a id='463' tid='464' class='u'>s</a>)))
  93. (<a id='465' tid='466' class='u'>else</a> <a id='467' tid='468' class='u'>#f</a>)))))
  94. (<a id='787' tid='788' class='u'>define</a> <a id='789' tid='790' class='u'>walk*</a>
  95. (<a id='791' tid='792' class='u'>lambda</a> (<a id='793' tid='794' class='u'>w</a> <a id='795' tid='796' class='u'>s</a>)
  96. (<a id='797' tid='798' class='u'>let</a> ((<a id='799' tid='800' class='u'>v</a> (<a id='801' tid='802' class='u'>walk</a> <a id='803' tid='804' class='u'>w</a> <a id='805' tid='806' class='u'>s</a>)))
  97. (<a id='807' tid='808' class='u'>cond</a>
  98. ((<a id='809' tid='810' class='u'>var?</a> <a id='811' tid='812' class='u'>v</a>) <a id='813' tid='814' class='u'>v</a>)
  99. ((<a id='815' tid='816' class='u'>pair?</a> <a id='817' tid='818' class='u'>v</a>)
  100. (<a id='819' tid='820' class='u'>cons</a>
  101. (<a id='821' tid='822' class='u'>walk*</a> (<a id='823' tid='824' class='u'>car</a> <a id='825' tid='826' class='u'>v</a>) <a id='827' tid='828' class='u'>s</a>)
  102. (<a id='829' tid='830' class='u'>walk*</a> (<a id='831' tid='832' class='u'>cdr</a> <a id='833' tid='834' class='u'>v</a>) <a id='835' tid='836' class='u'>s</a>)))
  103. (<a id='837' tid='838' class='u'>else</a> <a id='839' tid='840' class='u'>v</a>)))))
  104. (<a id='523' tid='524' class='u'>define</a> <a id='525' tid='526' class='u'>reify-s</a>
  105. (<span class='d'>lambda</span> <span class='d'>(v s)</span>
  106. (<a id='37' tid='38' class='m'>let</a> ((<a id='39' tid='40' class='m'>v</a> (<a id='41' tid='42' class='m'>walk</a> <a id='43' tid='44' class='m'>v</a> <a id='45' tid='46' class='m'>s</a>)))
  107. (<a id='47' tid='48' class='m'>cond</a>
  108. ((<a id='49' tid='50' class='m'>var?</a> <a id='51' tid='52' class='m'>v</a>)
  109. (<a id='53' tid='54' class='m'>ext-s</a> <a id='55' tid='56' class='m'>v</a> (<a id='57' tid='58' class='m'>reify-name</a> (<a id='59' tid='60' class='m'>size-s</a> <a id='61' tid='62' class='m'>s</a>)) <a id='63' tid='64' class='m'>s</a>))
  110. ((<a id='65' tid='66' class='m'>pair?</a> <a id='67' tid='68' class='m'>v</a>) (<a id='69' tid='70' class='m'>reify-s</a> (<a id='71' tid='72' class='m'>cdr</a> <a id='73' tid='74' class='m'>v</a>)
  111. (<a id='75' tid='76' class='m'>reify-s</a> (<a id='77' tid='78' class='m'>car</a> <a id='79' tid='80' class='m'>v</a>) <a id='81' tid='82' class='m'>s</a>)))
  112. (<a id='83' tid='84' class='m'>else</a> <a id='85' tid='86' class='m'>s</a>)))))
  113. (<a id='503' tid='504' class='u'>define</a> <a id='505' tid='506' class='u'>reify-name</a>
  114. (<a id='507' tid='508' class='u'>lambda</a> (<a id='509' tid='510' class='u'>n</a>)
  115. (<a id='511' tid='512' class='u'>string-&gt;symbol</a>
  116. (<a id='513' tid='514' class='u'>string-append</a> <a id='515' tid='516' class='u'>&quot;_&quot;</a> <a id='517' tid='518' class='u'>&quot;.&quot;</a> (<a id='519' tid='520' class='u'>number-&gt;string</a> <a id='521' tid='522' class='u'>n</a>)))))
  117. (<a id='473' tid='474' class='u'>define</a> <a id='475' tid='476' class='u'>reify</a>
  118. (<a id='477' tid='478' class='u'>lambda</a> (<a id='479' tid='480' class='u'>v</a> <a id='481' tid='482' class='u'>s</a>)
  119. (<a id='483' tid='484' class='u'>let</a> ((<a id='485' tid='486' class='u'>v</a> (<a id='487' tid='488' class='u'>walk*</a> <a id='489' tid='490' class='u'>v</a> <a id='491' tid='492' class='u'>s</a>)))
  120. (<a id='493' tid='494' class='u'>walk*</a> <a id='495' tid='496' class='u'>v</a> (<a id='497' tid='498' class='u'>reify-s</a> <a id='499' tid='500' class='u'>v</a> <a id='501' tid='502' class='u'>empty-s</a>)))))
  121. (<a id='177' tid='178' class='u'>define</a> <a id='179' tid='180' class='u'>==</a>
  122. <span class='d'>(lambda (u v)
  123. (lambdag@ (s) (unify u v s)))</span>)
  124. <span class='d'>(define ==-check
  125. (lambda (v w)
  126. (lambdag@ (s)
  127. (unify-check v w s))))</span>
  128. <span class='d'>(define-syntax mzero
  129. (syntax-rules () ((_) #f)))</span>
  130. (<a id='369' tid='370' class='u'>define-syntax</a> <a id='371' tid='372' class='u'>inc</a>
  131. (<a id='373' tid='374' class='u'>syntax-rules</a> () ((<a id='375' tid='376' class='u'>_</a> <a id='377' tid='378' class='u'>e</a>) (<a id='379' tid='380' class='u'>lambdaf@</a> () <a id='381' tid='382' class='u'>e</a>))))
  132. <span class='d'>(define-syntax unit
  133. (syntax-rules () ((_ a) a)))</span>
  134. <span class='d'>(define-syntax choice
  135. (syntax-rules () ((_ a f) (cons a f))))</span>
  136. <span class='d'>(define-syntax case-inf
  137. (syntax-rules ()
  138. ((_ e (() e0) ((f^) e1) ((a^) e2) ((a f) e3))
  139. (let ((a-inf e))
  140. (cond
  141. ((not a-inf) e0)
  142. ((procedure? a-inf) (let ((f^ a-inf)) e1))
  143. ((not (and (pair? a-inf)
  144. (procedure? (cdr a-inf))))
  145. (let ((a^ a-inf)) e2))
  146. (else (let ((a (car a-inf)) (f (cdr a-inf)))
  147. e3)))))))</span>
  148. (<a id='541' tid='542' class='u'>define-syntax</a> <a id='543' tid='544' class='u'>run</a>
  149. (<a id='23' tid='24' class='m'>syntax-rules</a> ()
  150. ((<a id='25' tid='26' class='m'>_</a> <a id='27' tid='28' class='m'>n</a> (<a id='29' tid='30' class='m'>x</a>) <a id='31' tid='32' class='m'>g0</a> <a id='33' tid='34' class='m'>g</a> <a id='35' tid='36' class='m'>...</a>)
  151. <span class='d'>(take n
  152. (lambdaf@ ()
  153. ((exist (x) g0 g ...
  154. (lambdag@ (s)
  155. (cons (reify x s) &#39;())))
  156. empty-s)))</span>)))
  157. (<a id='587' tid='588' class='u'>define</a> <a id='589' tid='590' class='u'>take</a>
  158. (<span class='d'>lambda</span> <span class='d'>(n f)</span>
  159. (<a id='1' tid='2' class='m'>if</a> (<a id='3' tid='4' class='m'>and</a> <a id='5' tid='6' class='m'>n</a> (<a id='7' tid='8' class='m'>zero?</a> <a id='9' tid='10' class='m'>n</a>))
  160. <a id='11' tid='12' class='m'>&#39;</a>()
  161. (<span class='d'>case-inf</span> <span class='d'>(f)</span>
  162. <span class='d'>(() &#39;())</span>
  163. <span class='d'>((f) (take n f))</span>
  164. <span class='d'>((a) a)</span>
  165. (<span class='d'>(a f)</span>
  166. (<span class='d'>cons</span> <span class='d'>(car a)</span>
  167. (<span class='d'>take</span> (<a id='13' tid='14' class='m'>and</a> <a id='15' tid='16' class='m'>n</a> (<a id='17' tid='18' class='m'>-</a> <a id='19' tid='20' class='m'>n</a> <a id='21' tid='22' class='m'>1</a>)) <span class='d'>f</span>)))))))
  168. (<a id='291' tid='292' class='u'>define-syntax</a> <a id='293' tid='294' class='u'>exist</a>
  169. (<a id='87' tid='88' class='m'>syntax-rules</a> ()
  170. ((<a id='89' tid='90' class='m'>_</a> (<a id='91' tid='92' class='m'>x</a> <a id='93' tid='94' class='m'>...</a>) <a id='95' tid='96' class='m'>g0</a> <a id='97' tid='98' class='m'>g</a> <a id='99' tid='100' class='m'>...</a>)
  171. (<span class='d'>lambdag@</span> <span class='d'>(s)</span>
  172. (<span class='d'>inc</span>
  173. (<span class='d'>let</span> ((<a id='101' tid='102' class='m'>x</a> (<a id='103' tid='104' class='m'>var</a> <a id='105' tid='106' class='m'>&#39;</a><a id='107' tid='108' class='m'>x</a>)) <a id='109' tid='110' class='m'>...</a>)
  174. <span class='d'>(bind* (g0 s) g ...)</span>))))))
  175. <span class='d'>(define-syntax bind*
  176. (syntax-rules ()
  177. ((_ e) e)
  178. ((_ e g0 g ...) (bind* (bind e g0) g ...))))</span>
  179. (<a id='181' tid='182' class='u'>define</a> <a id='183' tid='184' class='u'>bind</a>
  180. <span class='d'>(lambda (a-inf g)
  181. (case-inf a-inf
  182. (() (mzero))
  183. ((f) (inc (bind (f) g)))
  184. ((a) (g a))
  185. ((a f) (mplus (g a) (lambdaf@ () (bind (f) g))))))</span>)
  186. (<a id='233' tid='234' class='u'>define-syntax</a> <a id='235' tid='236' class='u'>conde</a>
  187. (<a id='111' tid='112' class='m'>syntax-rules</a> ()
  188. ((<a id='113' tid='114' class='m'>_</a> (<a id='115' tid='116' class='m'>g0</a> <a id='117' tid='118' class='m'>g</a> <a id='119' tid='120' class='m'>...</a>) (<a id='121' tid='122' class='m'>g1</a> <a id='123' tid='124' class='m'>g^</a> <a id='125' tid='126' class='m'>...</a>) <a id='127' tid='128' class='m'>...</a>)
  189. <span class='d'>(lambdag@ (s)
  190. (inc
  191. (mplus*
  192. (bind* (g0 s) g ...)
  193. (bind* (g1 s) g^ ...) ...)))</span>)))
  194. <span class='d'>(define-syntax mplus*
  195. (syntax-rules ()
  196. ((_ e) e)
  197. ((_ e0 e ...) (mplus e0
  198. (lambdaf@ () (mplus* e ...))))))</span>
  199. <span class='d'>(define mplus
  200. (lambda (a-inf f)
  201. (case-inf a-inf
  202. (() (f))
  203. ((f^) (inc (mplus (f) f^)))
  204. ((a) (choice a f))
  205. ((a f^) (choice a (lambdaf@ () (mplus (f) f^)))))))</span>
  206. (<a id='185' tid='186' class='u'>define-syntax</a> <a id='187' tid='188' class='u'>conda</a>
  207. (<a id='189' tid='190' class='u'>syntax-rules</a> ()
  208. ((<a id='191' tid='192' class='u'>_</a> (<a id='193' tid='194' class='u'>g0</a> <a id='195' tid='196' class='u'>g</a> <a id='197' tid='198' class='u'>...</a>) (<a id='199' tid='200' class='u'>g1</a> <a id='201' tid='202' class='u'>g^</a> <a id='203' tid='204' class='u'>...</a>) <a id='205' tid='206' class='u'>...</a>)
  209. (<a id='207' tid='208' class='u'>lambdag@</a> (<a id='209' tid='210' class='u'>s</a>)
  210. (<a id='211' tid='212' class='u'>inc</a>
  211. (<a id='213' tid='214' class='u'>ifa</a> ((<a id='215' tid='216' class='u'>g0</a> <a id='217' tid='218' class='u'>s</a>) <a id='219' tid='220' class='u'>g</a> <a id='221' tid='222' class='u'>...</a>)
  212. ((<a id='223' tid='224' class='u'>g1</a> <a id='225' tid='226' class='u'>s</a>) <a id='227' tid='228' class='u'>g^</a> <a id='229' tid='230' class='u'>...</a>) <a id='231' tid='232' class='u'>...</a>))))))
  213. (<a id='361' tid='362' class='u'>define-syntax</a> <a id='363' tid='364' class='u'>ifa</a>
  214. (<span class='d'>syntax-rules</span> <span class='d'>()</span>
  215. <span class='d'>((_) (mzero))</span>
  216. ((<a id='129' tid='130' class='m'>_</a> (<a id='131' tid='132' class='m'>e</a> <a id='133' tid='134' class='m'>g</a> <a id='135' tid='136' class='m'>...</a>) <a id='137' tid='138' class='m'>b</a> <a id='139' tid='140' class='m'>...</a>)
  217. <span class='d'>(let loop ((a-inf e))
  218. (case-inf a-inf
  219. (() (ifa b ...))
  220. ((f) (inc (loop (f))))
  221. ((a) (bind* a-inf g ...))
  222. ((a f) (bind* a-inf g ...))))</span>)))
  223. (<a id='237' tid='238' class='u'>define-syntax</a> <a id='239' tid='240' class='u'>condu</a>
  224. (<a id='241' tid='242' class='u'>syntax-rules</a> ()
  225. ((<a id='243' tid='244' class='u'>_</a> (<a id='245' tid='246' class='u'>g0</a> <a id='247' tid='248' class='u'>g</a> <a id='249' tid='250' class='u'>...</a>) (<a id='251' tid='252' class='u'>g1</a> <a id='253' tid='254' class='u'>g^</a> <a id='255' tid='256' class='u'>...</a>) <a id='257' tid='258' class='u'>...</a>)
  226. (<a id='259' tid='260' class='u'>lambdag@</a> (<a id='261' tid='262' class='u'>s</a>)
  227. (<a id='263' tid='264' class='u'>inc</a>
  228. (<a id='265' tid='266' class='u'>ifu</a> ((<a id='267' tid='268' class='u'>g0</a> <a id='269' tid='270' class='u'>s</a>) <a id='271' tid='272' class='u'>g</a> <a id='273' tid='274' class='u'>...</a>)
  229. ((<a id='275' tid='276' class='u'>g1</a> <a id='277' tid='278' class='u'>s</a>) <a id='279' tid='280' class='u'>g^</a> <a id='281' tid='282' class='u'>...</a>) <a id='283' tid='284' class='u'>...</a>))))))
  230. (<a id='365' tid='366' class='u'>define-syntax</a> <a id='367' tid='368' class='u'>ifu</a>
  231. (<span class='d'>syntax-rules</span> <span class='d'>()</span>
  232. <span class='d'>((_) (mzero))</span>
  233. ((<a id='141' tid='142' class='m'>_</a> (<a id='143' tid='144' class='m'>e</a> <a id='145' tid='146' class='m'>g</a> <a id='147' tid='148' class='m'>...</a>) <a id='149' tid='150' class='m'>b</a> <a id='151' tid='152' class='m'>...</a>)
  234. <span class='d'>(let loop ((a-inf e))
  235. (case-inf a-inf
  236. (() (ifu b ...))
  237. ((f) (inc (loop (f))))
  238. ((a) (bind* a-inf g ...))
  239. ((a f) (bind* (unit a) g ...))))</span>)))
  240. (<a id='469' tid='470' class='u'>define-syntax</a> <a id='471' tid='472' class='u'>project</a>
  241. (<a id='153' tid='154' class='m'>syntax-rules</a> ()
  242. ((<a id='155' tid='156' class='m'>_</a> (<a id='157' tid='158' class='m'>x</a> <a id='159' tid='160' class='m'>...</a>) <a id='161' tid='162' class='m'>g</a> <a id='163' tid='164' class='m'>g*</a> <a id='165' tid='166' class='m'>...</a>)
  243. (<span class='d'>lambdag@</span> <span class='d'>(s)</span>
  244. (<span class='d'>let</span> ((<a id='167' tid='168' class='m'>x</a> (<a id='169' tid='170' class='m'>walk*</a> <a id='171' tid='172' class='m'>x</a> <a id='173' tid='174' class='m'>s</a>)) <a id='175' tid='176' class='m'>...</a>)
  245. <span class='d'>((exist () g g* ...) s)</span>)))))
  246. (<a id='583' tid='584' class='u'>define</a> <a id='585' tid='586' class='u'>succeed</a> <span class='d'>(== #f #f)</span>)
  247. (<a id='357' tid='358' class='u'>define</a> <a id='359' tid='360' class='u'>fail</a> <span class='d'>(== #f #t)</span>)
  248. <span class='d'>(define onceo
  249. (lambda (g)
  250. (condu
  251. (g succeed)
  252. (else fail))))</span>
  253. </pre>
  254. </div>
  255. <div id="right" class="src">
  256. <pre>
  257. <a id='rightstart' tid='leftstart'></a>
  258. <a id='842' tid='841' class='u'>;;; This file was generated by writeminikanren.pl
  259. </a><a id='844' tid='843' class='u'>;;; Generated at 2007-10-25 15:24:42
  260. </a>
  261. <span class='i'>(define *debug-tags* &#39;())</span>
  262. <span class='i'>(define debug
  263. (lambda (tags format . args)
  264. (let* ((tags (if (not (pair? tags)) (list tags) tags))
  265. (fs (string-append &quot;[&quot; (symbol-&gt;string (car tags)) &quot;] &quot; format &quot;\n&quot;)))
  266. (cond
  267. [(null? tags)]
  268. [(pair? tags)
  269. (if (member (car tags) *debug-tags*)
  270. (apply printf fs args)
  271. (void))]
  272. ))))</span>
  273. <span class='i'>;; Stream primitives
  274. </span>(<a id='388' tid='387' class='u'>define-syntax</a> <a id='390' tid='389' class='u'>lambdag@</a>
  275. <span class='i'>(syntax-rules ()
  276. ((_ (p ...) e ...) (lambda (p ...) e ...)))</span>)
  277. (<a id='384' tid='383' class='u'>define-syntax</a> <a id='386' tid='385' class='u'>lambdaf@</a>
  278. <span class='i'>(syntax-rules ()
  279. ((_ () e ...) (lambda () e ...)))</span>)
  280. (<a id='370' tid='369' class='u'>define-syntax</a> <a id='372' tid='371' class='u'>inc</a>
  281. (<a id='374' tid='373' class='u'>syntax-rules</a> () ((<a id='376' tid='375' class='u'>_</a> <a id='378' tid='377' class='u'>e</a>) (<a id='380' tid='379' class='u'>lambdaf@</a> () <a id='382' tid='381' class='u'>e</a>))))
  282. <span class='i'>(define defunc
  283. (lambda (f)
  284. (if (procedure? f) (defunc (f)) f)))</span>
  285. <span class='i'>(define snull &#39;snull)</span>
  286. <span class='i'>(define snull?
  287. (lambda (s)
  288. (eq? s snull)))</span>
  289. <span class='i'>(define-syntax scons
  290. (syntax-rules ()
  291. ((_ a d) (cons a (lambda () d)))))</span>
  292. <span class='i'>(define scar
  293. (lambda (s)
  294. (cond
  295. [(procedure? s) (scar (s))]
  296. [else (car s)])))</span>
  297. <span class='i'>(define scdr
  298. (lambda (s)
  299. (cond
  300. [(procedure? s) (scdr (s))]
  301. [else ((cdr s))])))</span>
  302. <span class='i'>(define-syntax sunit
  303. (syntax-rules ()
  304. ((_ a) (scons a snull))))</span>
  305. <span class='i'>(define slift
  306. (lambda (f)
  307. (lambda args
  308. (sunit (apply f args)))))</span>
  309. <span class='i'>(define-syntax make-stream
  310. (syntax-rules ()
  311. ((_) snull)
  312. ((_ e1 e2 ...) (scons e1 (make-stream e2 ...)))))</span>
  313. (<a id='588' tid='587' class='u'>define</a> <a id='590' tid='589' class='u'>take</a>
  314. (<span class='i'>lambda</span> <span class='i'>(n s)</span>
  315. (<a id='2' tid='1' class='m'>if</a> (<a id='4' tid='3' class='m'>and</a> <a id='6' tid='5' class='m'>n</a> (<a id='8' tid='7' class='m'>zero?</a> <a id='10' tid='9' class='m'>n</a>))
  316. <a id='12' tid='11' class='m'>&#39;</a>()
  317. (<span class='i'>let</span> <span class='i'>([s (defunc s)])</span>
  318. (<span class='i'>cond</span>
  319. <span class='i'>[(snull? s) &#39;()]</span>
  320. [<span class='i'>else</span> (<span class='i'>cons</span> <span class='i'>(scar s)</span> (<span class='i'>take</span> (<a id='14' tid='13' class='m'>and</a> <a id='16' tid='15' class='m'>n</a> (<a id='18' tid='17' class='m'>-</a> <a id='20' tid='19' class='m'>n</a> <a id='22' tid='21' class='m'>1</a>)) <span class='i'>(scdr s)</span>))])))))
  321. <span class='i'>(define smerge
  322. (lambda (s1 s2)
  323. (cond
  324. [(snull? s1) s2]
  325. [(procedure? s1)
  326. (lambda () (smerge s2 (s1)))]
  327. [else (scons (scar s1) (smerge s2 (scdr s1)))])))</span>
  328. <span class='i'>(define stream-merge
  329. (lambda (ss)
  330. (cond
  331. [(snull? ss) snull]
  332. [(procedure? ss) (lambda () (stream-merge (ss)))]
  333. [(snull? (scar ss)) (stream-merge (scdr ss))]
  334. [(procedure? (scar ss)) (lambda ()
  335. (smerge (stream-merge (scdr ss))
  336. (scar ss)))]
  337. [else (scons (scar (scar ss)) (smerge (scdr (scar ss))
  338. (stream-merge (scdr ss))))])))</span>
  339. <span class='i'>(define smap
  340. (lambda (f s)
  341. (cond
  342. [(snull? s) snull]
  343. [(procedure? s) (lambda () (smap f (s)))]
  344. [else (scons (f (scar s)) (smap f (scdr s)))])))</span>
  345. <span class='i'>;; Substitution
  346. </span>(<a id='528' tid='527' class='u'>define-syntax</a> <a id='530' tid='529' class='u'>rhs</a>
  347. (<a id='532' tid='531' class='u'>syntax-rules</a> ()
  348. ((<a id='534' tid='533' class='u'>_</a> <a id='536' tid='535' class='u'>x</a>) (<a id='538' tid='537' class='u'>cdr</a> <a id='540' tid='539' class='u'>x</a>))))
  349. (<a id='392' tid='391' class='u'>define-syntax</a> <a id='394' tid='393' class='u'>lhs</a>
  350. (<a id='396' tid='395' class='u'>syntax-rules</a> ()
  351. ((<a id='398' tid='397' class='u'>_</a> <a id='400' tid='399' class='u'>x</a>) (<a id='402' tid='401' class='u'>car</a> <a id='404' tid='403' class='u'>x</a>))))
  352. (<a id='570' tid='569' class='u'>define-syntax</a> <a id='572' tid='571' class='u'>size-s</a>
  353. (<a id='574' tid='573' class='u'>syntax-rules</a> ()
  354. ((<a id='576' tid='575' class='u'>_</a> <a id='578' tid='577' class='u'>x</a>) (<a id='580' tid='579' class='u'>length</a> <a id='582' tid='581' class='u'>x</a>))))
  355. (<a id='714' tid='713' class='u'>define-syntax</a> <a id='716' tid='715' class='u'>var</a>
  356. (<a id='718' tid='717' class='u'>syntax-rules</a> ()
  357. ((<a id='720' tid='719' class='u'>_</a> <a id='722' tid='721' class='u'>x</a>) (<a id='724' tid='723' class='u'>vector</a> <a id='726' tid='725' class='u'>x</a>))))
  358. (<a id='728' tid='727' class='u'>define-syntax</a> <a id='730' tid='729' class='u'>var?</a>
  359. (<a id='732' tid='731' class='u'>syntax-rules</a> ()
  360. ((<a id='734' tid='733' class='u'>_</a> <a id='736' tid='735' class='u'>x</a>) (<a id='738' tid='737' class='u'>vector?</a> <a id='740' tid='739' class='u'>x</a>))))
  361. (<a id='286' tid='285' class='u'>define</a> <a id='288' tid='287' class='u'>empty-s</a> <a id='290' tid='289' class='u'>&#39;</a>())
  362. (<a id='742' tid='741' class='u'>define</a> <a id='744' tid='743' class='u'>walk</a>
  363. (<a id='746' tid='745' class='u'>lambda</a> (<a id='748' tid='747' class='u'>v</a> <a id='750' tid='749' class='u'>s</a>)
  364. (<a id='752' tid='751' class='u'>cond</a>
  365. ((<a id='754' tid='753' class='u'>var?</a> <a id='756' tid='755' class='u'>v</a>)
  366. (<a id='758' tid='757' class='u'>let</a> ((<a id='760' tid='759' class='u'>a</a> (<a id='762' tid='761' class='u'>assq</a> <a id='764' tid='763' class='u'>v</a> <a id='766' tid='765' class='u'>s</a>)))
  367. (<a id='768' tid='767' class='u'>cond</a>
  368. (<a id='770' tid='769' class='u'>a</a> (<a id='772' tid='771' class='u'>walk</a> (<a id='774' tid='773' class='u'>rhs</a> <a id='776' tid='775' class='u'>a</a>) <a id='778' tid='777' class='u'>s</a>))
  369. (<a id='780' tid='779' class='u'>else</a> <a id='782' tid='781' class='u'>v</a>))))
  370. (<a id='784' tid='783' class='u'>else</a> <a id='786' tid='785' class='u'>v</a>))))
  371. (<a id='296' tid='295' class='u'>define</a> <a id='298' tid='297' class='u'>ext-s</a>
  372. (<a id='300' tid='299' class='u'>lambda</a> (<a id='302' tid='301' class='u'>x</a> <a id='304' tid='303' class='u'>v</a> <a id='306' tid='305' class='u'>s</a>)
  373. (<a id='308' tid='307' class='u'>cons</a> <a id='310' tid='309' class='u'>`</a>(<a id='312' tid='311' class='u'>,</a><a id='314' tid='313' class='u'>x</a> <a id='316' tid='315' class='u'>.</a> <a id='318' tid='317' class='u'>,</a><a id='320' tid='319' class='u'>v</a>) <a id='322' tid='321' class='u'>s</a>)))
  374. (<a id='592' tid='591' class='u'>define</a> <a id='594' tid='593' class='u'>unify</a>
  375. <span class='i'>(lambda (v w s env)
  376. ((env-unify env) v w s env))</span>)
  377. <span class='i'>(define unify-good
  378. (lambda (v w s env)
  379. ; (printf &quot;[unify-good]: ~a &lt;--&gt; ~a :: ~a\n&quot; v w s)
  380. (let ((v (walk v s))
  381. (w (walk w s)))
  382. (cond
  383. ((eq? v w) s)
  384. ((var? v) (ext-s v w s))
  385. ((var? w) (ext-s w v s))
  386. ((and (pair? v) (pair? w))
  387. (let ((s (unify-good (car v) (car w) s env)))
  388. (and s (unify-good (cdr v) (cdr w) s env))))
  389. ((equal? v w) s)
  390. (else #f)))))</span>
  391. <span class='i'>(define unify-evil
  392. (lambda (v w s env)
  393. (debug &#39;(unify-evil unify)
  394. &quot;v=~a, w=~a, cvars: ~a\n subst:~a&quot; v w (env-cvars env) s)
  395. (let ((vv (walk v s))
  396. (ww (walk w s)))
  397. (cond
  398. ((eq? vv ww) s)
  399. ((and (var? vv) (memq v (env-cvars env))) #f)
  400. ((and (var? ww) (memq w (env-cvars env))) #f)
  401. ((var? vv) (ext-s vv ww s))
  402. ((var? ww) (ext-s ww vv s))
  403. ((and (pair? vv) (pair? ww))
  404. (let ((s (unify-evil (car vv) (car ww) s env)))
  405. (and s (unify-evil (cdr vv) (cdr ww) s env))))
  406. ((equal? vv ww) s)
  407. (else #f)))))</span>
  408. <span class='i'>(define switch-unify
  409. (lambda (env)
  410. (if (eq? (env-unify env) unify-good)
  411. (change-unify env unify-evil)
  412. (change-unify env unify-good))))</span>
  413. <span class='i'>(define unify-pred
  414. (lambda (v pred s env)
  415. (let ((v (walk v s)))
  416. (if (var? v)
  417. (cond
  418. [(eq? pred number?) (ext-s v (random 9999999999) s)]
  419. [(eq? pred string?) (ext-s v &quot;random string...&quot; s)]
  420. [(eq? pred symbol?) (ext-s v &#39;randomstring... s)]
  421. )
  422. (cond
  423. [(pred v) s]
  424. [else #f])))))</span>
  425. <span class='i'>(define predo
  426. (lambda (q pred)
  427. (lambdag@ (s env)
  428. (let ((s1 (unify-pred q pred s env)))
  429. (cond
  430. [(not s1) snull]
  431. [else (sunit s1)])))))</span>
  432. (<a id='596' tid='595' class='u'>define</a> <a id='598' tid='597' class='u'>unify-check</a>
  433. (<a id='600' tid='599' class='u'>lambda</a> (<a id='602' tid='601' class='u'>u</a> <a id='604' tid='603' class='u'>v</a> <a id='606' tid='605' class='u'>s</a>)
  434. (<a id='608' tid='607' class='u'>let</a> ((<a id='610' tid='609' class='u'>u</a> (<a id='612' tid='611' class='u'>walk</a> <a id='614' tid='613' class='u'>u</a> <a id='616' tid='615' class='u'>s</a>))
  435. (<a id='618' tid='617' class='u'>v</a> (<a id='620' tid='619' class='u'>walk</a> <a id='622' tid='621' class='u'>v</a> <a id='624' tid='623' class='u'>s</a>)))
  436. (<a id='626' tid='625' class='u'>cond</a>
  437. ((<a id='628' tid='627' class='u'>eq?</a> <a id='630' tid='629' class='u'>u</a> <a id='632' tid='631' class='u'>v</a>) <a id='634' tid='633' class='u'>s</a>)
  438. ((<a id='636' tid='635' class='u'>var?</a> <a id='638' tid='637' class='u'>u</a>) (<a id='640' tid='639' class='u'>ext-s-check</a> <a id='642' tid='641' class='u'>u</a> <a id='644' tid='643' class='u'>v</a> <a id='646' tid='645' class='u'>s</a>))
  439. ((<a id='648' tid='647' class='u'>var?</a> <a id='650' tid='649' class='u'>v</a>) (<a id='652' tid='651' class='u'>ext-s-check</a> <a id='654' tid='653' class='u'>v</a> <a id='656' tid='655' class='u'>u</a> <a id='658' tid='657' class='u'>s</a>))
  440. ((<a id='660' tid='659' class='u'>and</a> (<a id='662' tid='661' class='u'>pair?</a> <a id='664' tid='663' class='u'>u</a>) (<a id='666' tid='665' class='u'>pair?</a> <a id='668' tid='667' class='u'>v</a>))
  441. (<a id='670' tid='669' class='u'>let</a> ((<a id='672' tid='671' class='u'>s</a> (<a id='674' tid='673' class='u'>unify-check</a> (<a id='676' tid='675' class='u'>car</a> <a id='678' tid='677' class='u'>u</a>) (<a id='680' tid='679' class='u'>car</a> <a id='682' tid='681' class='u'>v</a>) <a id='684' tid='683' class='u'>s</a>)))
  442. (<a id='686' tid='685' class='u'>and</a> <a id='688' tid='687' class='u'>s</a> (<a id='690' tid='689' class='u'>unify-check</a> (<a id='692' tid='691' class='u'>cdr</a> <a id='694' tid='693' class='u'>u</a>) (<a id='696' tid='695' class='u'>cdr</a> <a id='698' tid='697' class='u'>v</a>) <a id='700' tid='699' class='u'>s</a>))))
  443. ((<a id='702' tid='701' class='u'>equal?</a> <a id='704' tid='703' class='u'>u</a> <a id='706' tid='705' class='u'>v</a>) <a id='708' tid='707' class='u'>s</a>)
  444. (<a id='710' tid='709' class='u'>else</a> <a id='712' tid='711' class='u'>#f</a>)))))
  445. (<a id='324' tid='323' class='u'>define</a> <a id='326' tid='325' class='u'>ext-s-check</a>
  446. (<a id='328' tid='327' class='u'>lambda</a> (<a id='330' tid='329' class='u'>x</a> <a id='332' tid='331' class='u'>v</a> <a id='334' tid='333' class='u'>s</a>)
  447. (<a id='336' tid='335' class='u'>cond</a>
  448. ((<a id='338' tid='337' class='u'>occurs-check</a> <a id='340' tid='339' class='u'>x</a> <a id='342' tid='341' class='u'>v</a> <a id='344' tid='343' class='u'>s</a>) <a id='346' tid='345' class='u'>#f</a>)
  449. (<a id='348' tid='347' class='u'>else</a> (<a id='350' tid='349' class='u'>ext-s</a> <a id='352' tid='351' class='u'>x</a> <a id='354' tid='353' class='u'>v</a> <a id='356' tid='355' class='u'>s</a>)))))
  450. (<a id='406' tid='405' class='u'>define</a> <a id='408' tid='407' class='u'>occurs-check</a>
  451. (<a id='410' tid='409' class='u'>lambda</a> (<a id='412' tid='411' class='u'>x</a> <a id='414' tid='413' class='u'>v</a> <a id='416' tid='415' class='u'>s</a>)
  452. (<a id='418' tid='417' class='u'>let</a> ((<a id='420' tid='419' class='u'>v</a> (<a id='422' tid='421' class='u'>walk</a> <a id='424' tid='423' class='u'>v</a> <a id='426' tid='425' class='u'>s</a>)))
  453. (<a id='428' tid='427' class='u'>cond</a>
  454. ((<a id='430' tid='429' class='u'>var?</a> <a id='432' tid='431' class='u'>v</a>) (<a id='434' tid='433' class='u'>eq?</a> <a id='436' tid='435' class='u'>v</a> <a id='438' tid='437' class='u'>x</a>))
  455. ((<a id='440' tid='439' class='u'>pair?</a> <a id='442' tid='441' class='u'>v</a>)
  456. (<a id='444' tid='443' class='u'>or</a>
  457. (<a id='446' tid='445' class='u'>occurs-check</a> <a id='448' tid='447' class='u'>x</a> (<a id='450' tid='449' class='u'>car</a> <a id='452' tid='451' class='u'>v</a>) <a id='454' tid='453' class='u'>s</a>)
  458. (<a id='456' tid='455' class='u'>occurs-check</a> <a id='458' tid='457' class='u'>x</a> (<a id='460' tid='459' class='u'>cdr</a> <a id='462' tid='461' class='u'>v</a>) <a id='464' tid='463' class='u'>s</a>)))
  459. (<a id='466' tid='465' class='u'>else</a> <a id='468' tid='467' class='u'>#f</a>)))))
  460. (<a id='788' tid='787' class='u'>define</a> <a id='790' tid='789' class='u'>walk*</a>
  461. (<a id='792' tid='791' class='u'>lambda</a> (<a id='794' tid='793' class='u'>w</a> <a id='796' tid='795' class='u'>s</a>)
  462. (<a id='798' tid='797' class='u'>let</a> ((<a id='800' tid='799' class='u'>v</a> (<a id='802' tid='801' class='u'>walk</a> <a id='804' tid='803' class='u'>w</a> <a id='806' tid='805' class='u'>s</a>)))
  463. (<a id='808' tid='807' class='u'>cond</a>
  464. ((<a id='810' tid='809' class='u'>var?</a> <a id='812' tid='811' class='u'>v</a>) <a id='814' tid='813' class='u'>v</a>)
  465. ((<a id='816' tid='815' class='u'>pair?</a> <a id='818' tid='817' class='u'>v</a>)
  466. (<a id='820' tid='819' class='u'>cons</a>
  467. (<a id='822' tid='821' class='u'>walk*</a> (<a id='824' tid='823' class='u'>car</a> <a id='826' tid='825' class='u'>v</a>) <a id='828' tid='827' class='u'>s</a>)
  468. (<a id='830' tid='829' class='u'>walk*</a> (<a id='832' tid='831' class='u'>cdr</a> <a id='834' tid='833' class='u'>v</a>) <a id='836' tid='835' class='u'>s</a>)))
  469. (<a id='838' tid='837' class='u'>else</a> <a id='840' tid='839' class='u'>v</a>)))))
  470. (<a id='524' tid='523' class='u'>define</a> <a id='526' tid='525' class='u'>reify-s</a>
  471. (<span class='i'>lambda</span> <span class='i'>(v s)</span>
  472. <span class='i'>(debug &#39;reify-s &quot;v: ~a\ns:~a&quot; v s)</span>
  473. (<a id='38' tid='37' class='m'>let</a> ((<a id='40' tid='39' class='m'>v</a> (<a id='42' tid='41' class='m'>walk</a> <a id='44' tid='43' class='m'>v</a> <a id='46' tid='45' class='m'>s</a>)))
  474. (<a id='48' tid='47' class='m'>cond</a>
  475. ((<a id='50' tid='49' class='m'>var?</a> <a id='52' tid='51' class='m'>v</a>)
  476. (<a id='54' tid='53' class='m'>ext-s</a> <a id='56' tid='55' class='m'>v</a> (<a id='58' tid='57' class='m'>reify-name</a> (<a id='60' tid='59' class='m'>size-s</a> <a id='62' tid='61' class='m'>s</a>)) <a id='64' tid='63' class='m'>s</a>))
  477. ((<a id='66' tid='65' class='m'>pair?</a> <a id='68' tid='67' class='m'>v</a>) (<a id='70' tid='69' class='m'>reify-s</a> (<a id='72' tid='71' class='m'>cdr</a> <a id='74' tid='73' class='m'>v</a>)
  478. (<a id='76' tid='75' class='m'>reify-s</a> (<a id='78' tid='77' class='m'>car</a> <a id='80' tid='79' class='m'>v</a>) <a id='82' tid='81' class='m'>s</a>)))
  479. (<a id='84' tid='83' class='m'>else</a> <a id='86' tid='85' class='m'>s</a>)))))
  480. (<a id='504' tid='503' class='u'>define</a> <a id='506' tid='505' class='u'>reify-name</a>
  481. (<a id='508' tid='507' class='u'>lambda</a> (<a id='510' tid='509' class='u'>n</a>)
  482. (<a id='512' tid='511' class='u'>string-&gt;symbol</a>
  483. (<a id='514' tid='513' class='u'>string-append</a> <a id='516' tid='515' class='u'>&quot;_&quot;</a> <a id='518' tid='517' class='u'>&quot;.&quot;</a> (<a id='520' tid='519' class='u'>number-&gt;string</a> <a id='522' tid='521' class='u'>n</a>)))))
  484. (<a id='474' tid='473' class='u'>define</a> <a id='476' tid='475' class='u'>reify</a>
  485. (<a id='478' tid='477' class='u'>lambda</a> (<a id='480' tid='479' class='u'>v</a> <a id='482' tid='481' class='u'>s</a>)
  486. (<a id='484' tid='483' class='u'>let</a> ((<a id='486' tid='485' class='u'>v</a> (<a id='488' tid='487' class='u'>walk*</a> <a id='490' tid='489' class='u'>v</a> <a id='492' tid='491' class='u'>s</a>)))
  487. (<a id='494' tid='493' class='u'>walk*</a> <a id='496' tid='495' class='u'>v</a> (<a id='498' tid='497' class='u'>reify-s</a> <a id='500' tid='499' class='u'>v</a> <a id='502' tid='501' class='u'>empty-s</a>)))))
  488. <span class='i'>(define pkg
  489. (lambda (s c)
  490. (list s c)))</span>
  491. <span class='i'>(define pkg-subst car)</span> <span class='i'>; current substitution
  492. </span><span class='i'>(define pkg-constraints cadr)</span>
  493. <span class='i'>(define ext-pkg-constraints
  494. (lambda (p cs ctexts env)
  495. (let ([newc (map (lambda (g t)
  496. (make-constraint g (env-vars env) t))
  497. cs ctexts)])
  498. (pkg (pkg-subst p) (append newc (pkg-constraints p))))))</span>
  499. <span class='i'>;; constraints save the current environment vars
  500. </span><span class='i'>(define make-constraint
  501. (lambda (g vars text)
  502. (list g vars text)))</span>
  503. <span class='i'>(define constraint-goal car)</span> <span class='i'>; constraint goal
  504. </span><span class='i'>(define constraint-vars cadr)</span> <span class='i'>; variables which the constraint care about
  505. </span><span class='i'>(define constraint-text caddr)</span>
  506. <span class='i'>;; environment
  507. </span><span class='i'>(define make-env
  508. (lambda (unify constraints vars cvars)
  509. (list unify constraints vars cvars)))</span>
  510. <span class='i'>(define empty-env (list unify-good &#39;() &#39;() &#39;()))</span>
  511. <span class='i'>(define env-unify car)</span> <span class='i'>; which unification to use (env)
  512. </span><span class='i'>(define env-constraints cadr)</span> <span class='i'>; current constraints (env)
  513. </span><span class='i'>(define env-vars caddr)</span> <span class='i'>; variables at this point (env)
  514. </span><span class='i'>(define env-cvars cadddr)</span> <span class='i'>; checked variables at this point (env)
  515. </span><span class='i'>(define env-constraint-goals
  516. (lambda (p)
  517. (map constraint-goal (env-constraint p))))</span>
  518. <span class='i'>(define change-unify
  519. (lambda (p u)
  520. (make-env u (env-constraints p) (env-vars p) (env-cvars p))))</span>
  521. <span class='i'>(define change-constraints
  522. (lambda (p c)
  523. (make-env (env-unify p) c (env-vars p) (env-cvars p))))</span>
  524. <span class='i'>(define change-vars
  525. (lambda (p v)
  526. (make-env (env-unify p) (env-constraints p) v (env-cvars p))))</span>
  527. <span class='i'>(define change-cvars
  528. (lambda (p cv)
  529. (env (env-unify p) (env-constraints p) (env-vars p) cv)))</span>
  530. <span class='i'>(define ext-constraint
  531. (lambda (env new-cg)
  532. (let ([newc (map (lambda (g) (make-constraint g (env-vars env) &#39;a))
  533. new-cg)])
  534. (change-constraints env newc))))</span>
  535. <span class='i'>(define ext-vars
  536. (lambda (env new-vars)
  537. (change-vars env (append new-vars (env-vars env)))))</span>
  538. <span class='i'>(define ext-cvars
  539. (lambda (env new-cvars)
  540. (change-cvars env (append new-cvars (env-cvars env)))))</span>
  541. <span class='i'>;;; miniKanren
  542. </span>
  543. (<a id='182' tid='181' class='u'>define</a> <a id='184' tid='183' class='u'>bind</a>
  544. <span class='i'>(lambda (s f env)
  545. (cond
  546. [(procedure? s) (lambda () (bind (s) f env))]
  547. [else
  548. (stream-merge (smap (lambda (s) (f s env)) s))]))</span>)
  549. <span class='i'>(define bind*
  550. (lambda (s goals env)
  551. (cond
  552. [(null? goals)
  553. (stream-merge
  554. (smap (lambda (s)
  555. (bind-constraints (sunit s) (pkg-constraints s) env))
  556. s))]
  557. [(snull? s) snull]
  558. [else (bind* (bind s (car goals) env) (cdr goals) env)])))</span>
  559. <span class='i'>(define bind*
  560. (lambda (s goals env)
  561. (cond
  562. [(null? goals) s]
  563. [(snull? s) snull]
  564. [else (bind* (bind s (car goals) env) (cdr goals) env)])))</span>
  565. <span class='i'>(define bind-constraints
  566. (lambda (s cs env)
  567. (cond
  568. [(null? cs) s]
  569. [(snull? s) snull]
  570. [else
  571. (debug &#39;bind-constraints
  572. &quot;checking constraint: ~a&quot; (constraint-text (car cs)))
  573. (bind-constraints
  574. (bind s
  575. (constraint-goal (car cs))
  576. (make-env (env-unify env)
  577. &#39;() ; no constraints
  578. (env-vars env)
  579. (constraint-vars (car cs))))
  580. (cdr cs)
  581. env)])))</span>
  582. (<a id='178' tid='177' class='u'>define</a> <a id='180' tid='179' class='u'>==</a>
  583. <span class='i'>(lambda (u v)
  584. (lambdag@ (s env)
  585. (let ((s1 ((env-unify env) u v (pkg-subst s) env)))
  586. (cond
  587. [(not s1) snull]
  588. [else (sunit (pkg s1 (pkg-constraints s)))]))))</span>)
  589. <span class='i'>(define ==
  590. (lambda (u v)
  591. (lambdag@ (s env)
  592. (let ((s1 ((env-unify env) u v (pkg-subst s) env)))
  593. (cond
  594. [(not s1) snull]
  595. [else
  596. (let ([cc (bind-constraints (sunit (pkg s1 &#39;()))
  597. (pkg-constraints s) env)])
  598. (if (snull? cc)
  599. snull
  600. (sunit (pkg s1 (filter (lambda (c)
  601. (not (tautology? c (pkg-subst s))))
  602. (pkg-constraints s))))))])))))</span>
  603. <span class='i'>(define ando
  604. (lambda goals
  605. (lambdag@ (s env)
  606. (bind* (sunit s) goals env))))</span>
  607. <span class='i'>(define org2
  608. (lambda (goals)
  609. (lambdag@ (s env)
  610. (cond
  611. [(null? goals) snull]
  612. [else
  613. (scons (bind (sunit s) (car goals) env)
  614. ((org2 (cdr goals)) s env))]))))</span>
  615. <span class='i'>(define oro
  616. (lambda goals
  617. (lambdag@ (s env)
  618. (stream-merge ((org2 goals) s env)))))</span>
  619. <span class='i'>(define noto
  620. (lambda (g)
  621. (lambdag@ (s env)
  622. (inc
  623. (let ([ans (g s (switch-unify env))])
  624. (letrec ((negate (lambda (s)
  625. (cond
  626. [(procedure? s) (lambda () (negate (s)))]
  627. [(snull? ans) (succeed s env)]
  628. [else (fail s env)]))))
  629. (negate ans)))))))</span>
  630. <span class='i'>(define noto
  631. (lambda (g)
  632. (lambdag@ (s env)
  633. (let ([ans (defunc (g s (switch-unify env)))])
  634. ((if (snull? ans)
  635. ;; (begin (printf &quot;###fail###\n&quot;) succeed)
  636. ;; (begin (printf &quot;###succeed###\n&quot;) fail)
  637. succeed
  638. fail
  639. ) s env)))))</span>
  640. (<a id='292' tid='291' class='u'>define-syntax</a> <a id='294' tid='293' class='u'>exist</a>
  641. (<a id='88' tid='87' class='m'>syntax-rules</a> ()
  642. ((<a id='90' tid='89' class='m'>_</a> (<a id='92' tid='91' class='m'>x</a> <a id='94' tid='93' class='m'>...</a>) <a id='96' tid='95' class='m'>g0</a> <a id='98' tid='97' class='m'>g</a> <a id='100' tid='99' class='m'>...</a>)
  643. (<span class='i'>lambdag@</span> <span class='i'>(s env)</span>
  644. (<span class='i'>inc</span>
  645. (<span class='i'>let</span> ((<a id='102' tid='101' class='m'>x</a> (<a id='104' tid='103' class='m'>var</a> <a id='106' tid='105' class='m'>&#39;</a><a id='108' tid='107' class='m'>x</a>)) <a id='110' tid='109' class='m'>...</a>)
  646. <span class='i'>((ando g0 g ...) s (ext-vars env (list x ...)))</span>))))))
  647. <span class='i'>(define-syntax forall
  648. (syntax-rules ()
  649. ((_ (x ...) g0 g ...)
  650. (lambdag@ (s env)
  651. (inc
  652. (let ((x (var &#39;x)) ...)
  653. ((ando g0 g ...)
  654. (let loop ([ss (pkg-subst s)] [vars (list x ...)])
  655. (cond
  656. [(null? vars) ss]
  657. [else (loop (ext-s (car vars) (gensym) ss) (cdr vars))]))
  658. (ext-vars env (list x ...)))))))))</span>
  659. (<a id='234' tid='233' class='u'>define-syntax</a> <a id='236' tid='235' class='u'>conde</a>
  660. (<a id='112' tid='111' class='m'>syntax-rules</a> ()
  661. ((<a id='114' tid='113' class='m'>_</a> (<a id='116' tid='115' class='m'>g0</a> <a id='118' tid='117' class='m'>g</a> <a id='120' tid='119' class='m'>...</a>) (<a id='122' tid='121' class='m'>g1</a> <a id='124' tid='123' class='m'>g^</a> <a id='126' tid='125' class='m'>...</a>) <a id='128' tid='127' class='m'>...</a>)
  662. <span class='i'>(lambdag@ (s env)
  663. (inc
  664. ((oro (ando g0 g ...)
  665. (ando g1 g^ ...) ...) s env)))</span>)))
  666. <span class='i'>(define-syntax condc
  667. (syntax-rules ()
  668. ((_ (g0 g ...)) (ando g0 g ...))
  669. ((_ (g0 g ...) g^ ...)
  670. (lambdag@ (s env)
  671. (inc
  672. ((oro (ando g0 g ...)
  673. (assert ((noto g0))
  674. (condc g^ ...))) s env))))))</span>
  675. <span class='i'>(define reify-constraint
  676. (lambda (s)
  677. (lambda (c)
  678. (let ((ct (constraint-text c)))
  679. (cond
  680. [(pair? ct)
  681. (cons (car ct)
  682. (map (lambda (v) (walk* v (pkg-subst s))) (cdr ct)))]
  683. [else ct])))))</span>
  684. <span class='i'>(define format-constraints
  685. (lambda (s)
  686. (debug &#39;format-constraints &quot;subst: ~a\nconstraints: ~a\n&quot;
  687. (pkg-subst s)
  688. (pkg-constraints s))
  689. (map (reify-constraint s)
  690. (filter (lambda (c)
  691. (not (tautology? c (pkg-subst s))))
  692. (pkg-constraints s)))))</span>
  693. (<a id='542' tid='541' class='u'>define-syntax</a> <a id='544' tid='543' class='u'>run</a>
  694. (<a id='24' tid='23' class='m'>syntax-rules</a> ()
  695. ((<a id='26' tid='25' class='m'>_</a> <a id='28' tid='27' class='m'>n</a> (<a id='30' tid='29' class='m'>x</a>) <a id='32' tid='31' class='m'>g0</a> <a id='34' tid='33' class='m'>g</a> <a id='36' tid='35' class='m'>...</a>)
  696. <span class='i'>(let ((x (var &#39;x)))
  697. (let ([ss ((ando g0 g ...) (pkg empty-s &#39;())
  698. (make-env unify-good &#39;() (list x) &#39;()))])
  699. (take n (smap (lambda (s)
  700. (let* ((x (walk* x (pkg-subst s)))
  701. (rs (reify-s x empty-s)))
  702. (list
  703. (walk* x rs)
  704. (let ((ctext (walk* (format-constraints s) rs)))
  705. (if (null? ctext)
  706. &#39;()
  707. (list &#39;constraints: ctext))))))
  708. ss))))</span>)))
  709. <span class='i'>(define tautology?
  710. (lambda (c s)
  711. (debug &#39;tautology?
  712. &quot;constraint: ~a\nvars: ~a\nsubst:~a\n&quot;
  713. (constraint-text c)
  714. (constraint-vars c)
  715. s)
  716. (not (snull?
  717. (defunc ((constraint-goal c)
  718. (pkg s &#39;())
  719. (make-env unify-evil &#39;() &#39;() (constraint-vars c))))))))</span>
  720. (<a id='546' tid='545' class='u'>define-syntax</a> <a id='548' tid='547' class='u'>run*</a>
  721. (<a id='550' tid='549' class='u'>syntax-rules</a> ()
  722. ((<a id='552' tid='551' class='u'>_</a> (<a id='554' tid='553' class='u'>x</a>) <a id='556' tid='555' class='u'>g</a> <a id='558' tid='557' class='u'>...</a>) (<a id='560' tid='559' class='u'>run</a> <a id='562' tid='561' class='u'>#f</a> (<a id='564' tid='563' class='u'>x</a>) <a id='566' tid='565' class='u'>g</a> <a id='568' tid='567' class='u'>...</a>))))
  723. <span class='i'>(define-syntax make-text
  724. (syntax-rules (quote quasiquote)
  725. ((_ (quote a)) (quote a))
  726. ((_ (quasiquote a)) (quasiquote a))
  727. ((_ (g a0 ...)) (list &#39;g (make-text a0) ...))
  728. ((_ a) a)))</span>
  729. <span class='i'>(define-syntax make-text*
  730. (syntax-rules (quote quasiquote)
  731. ((_) &#39;())
  732. ((_ (quote a)) (quote a))
  733. ((_ (quasiquote a)) (quasiquote a))
  734. ((_ (g0 a ...) g ...)
  735. (list (make-text (g0 a ...)) (make-text g) ...))
  736. ((_ a) &#39;a)))</span>
  737. <span class='i'>;; (make-text* `b)
  738. </span><span class='i'>;; (make-text* (noto (== `(,a ,d) (cons u v))) (noto (appendo a b c)))
  739. </span><span class='i'>;; (define a 1)
  740. </span><span class='i'>;; (define b 2)
  741. </span><span class='i'>;; (define c 3)
  742. </span><span class='i'>;; (define d 4)
  743. </span><span class='i'>;; (define u 5)
  744. </span><span class='i'>;; (define v 6)
  745. </span><span class='i'>;; (make-text* (a b c) `(,c a))
  746. </span><span class='i'>;; (define q 10)
  747. </span><span class='i'>; (make-text* (noto (== q 3)))
  748. </span>
  749. <span class='i'>(define-syntax assert
  750. (syntax-rules ()
  751. ((_ (c0 c ...) g ...)
  752. (lambdag@ (s env)
  753. (inc
  754. ((ando g ...)
  755. (ext-pkg-constraints s (list c0 c ...) (make-text* c0 c ...) env)
  756. (ext-constraint env (list c0 c ...))))))))</span>
  757. (<a id='186' tid='185' class='u'>define-syntax</a> <a id='188' tid='187' class='u'>conda</a>
  758. (<a id='190' tid='189' class='u'>syntax-rules</a> ()
  759. ((<a id='192' tid='191' class='u'>_</a> (<a id='194' tid='193' class='u'>g0</a> <a id='196' tid='195' class='u'>g</a> <a id='198' tid='197' class='u'>...</a>) (<a id='200' tid='199' class='u'>g1</a> <a id='202' tid='201' class='u'>g^</a> <a id='204' tid='203' class='u'>...</a>) <a id='206' tid='205' class='u'>...</a>)
  760. (<a id='208' tid='207' class='u'>lambdag@</a> (<a id='210' tid='209' class='u'>s</a>)
  761. (<a id='212' tid='211' class='u'>inc</a>
  762. (<a id='214' tid='213' class='u'>ifa</a> ((<a id='216' tid='215' class='u'>g0</a> <a id='218' tid='217' class='u'>s</a>) <a id='220' tid='219' class='u'>g</a> <a id='222' tid='221' class='u'>...</a>)
  763. ((<a id='224' tid='223' class='u'>g1</a> <a id='226' tid='225' class='u'>s</a>) <a id='228' tid='227' class='u'>g^</a> <a id='230' tid='229' class='u'>...</a>) <a id='232' tid='231' class='u'>...</a>))))))
  764. (<a id='362' tid='361' class='u'>define-syntax</a> <a id='364' tid='363' class='u'>ifa</a>
  765. (<span class='i'>syntax-rules</span> <span class='i'>()</span>
  766. <span class='i'>((_) snull)</span>
  767. ((<a id='130' tid='129' class='m'>_</a> (<a id='132' tid='131' class='m'>e</a> <a id='134' tid='133' class='m'>g</a> <a id='136' tid='135' class='m'>...</a>) <a id='138' tid='137' class='m'>b</a> <a id='140' tid='139' class='m'>...</a>)
  768. <span class='i'>(cond
  769. [(snull? (defunc e)) (ifa b ...)]
  770. [else (bind* e (list g ...))])</span>)))
  771. (<a id='238' tid='237' class='u'>define-syntax</a> <a id='240' tid='239' class='u'>condu</a>
  772. (<a id='242' tid='241' class='u'>syntax-rules</a> ()
  773. ((<a id='244' tid='243' class='u'>_</a> (<a id='246' tid='245' class='u'>g0</a> <a id='248' tid='247' class='u'>g</a> <a id='250' tid='249' class='u'>...</a>) (<a id='252' tid='251' class='u'>g1</a> <a id='254' tid='253' class='u'>g^</a> <a id='256' tid='255' class='u'>...</a>) <a id='258' tid='257' class='u'>...</a>)
  774. (<a id='260' tid='259' class='u'>lambdag@</a> (<a id='262' tid='261' class='u'>s</a>)
  775. (<a id='264' tid='263' class='u'>inc</a>
  776. (<a id='266' tid='265' class='u'>ifu</a> ((<a id='268' tid='267' class='u'>g0</a> <a id='270' tid='269' class='u'>s</a>) <a id='272' tid='271' class='u'>g</a> <a id='274' tid='273' class='u'>...</a>)
  777. ((<a id='276' tid='275' class='u'>g1</a> <a id='278' tid='277' class='u'>s</a>) <a id='280' tid='279' class='u'>g^</a> <a id='282' tid='281' class='u'>...</a>) <a id='284' tid='283' class='u'>...</a>))))))
  778. (<a id='366' tid='365' class='u'>define-syntax</a> <a id='368' tid='367' class='u'>ifu</a>
  779. (<span class='i'>syntax-rules</span> <span class='i'>()</span>
  780. <span class='i'>((_) snull)</span>
  781. ((<a id='142' tid='141' class='m'>_</a> (<a id='144' tid='143' class='m'>e</a> <a id='146' tid='145' class='m'>g</a> <a id='148' tid='147' class='m'>...</a>) <a id='150' tid='149' class='m'>b</a> <a id='152' tid='151' class='m'>...</a>)
  782. <span class='i'>(cond
  783. [(snull? (defunc e)) (ifa b ...)]
  784. [else (bind* (sunit (scar e)) (list g ...))])</span>)))
  785. (<a id='470' tid='469' class='u'>define-syntax</a> <a id='472' tid='471' class='u'>project</a>
  786. (<a id='154' tid='153' class='m'>syntax-rules</a> ()
  787. ((<a id='156' tid='155' class='m'>_</a> (<a id='158' tid='157' class='m'>x</a> <a id='160' tid='159' class='m'>...</a>) <a id='162' tid='161' class='m'>g</a> <a id='164' tid='163' class='m'>g*</a> <a id='166' tid='165' class='m'>...</a>)
  788. (<span class='i'>lambdag@</span> <span class='i'>(s env)</span>
  789. (<span class='i'>let</span> ((<a id='168' tid='167' class='m'>x</a> (<a id='170' tid='169' class='m'>walk*</a> <a id='172' tid='171' class='m'>x</a> <a id='174' tid='173' class='m'>s</a>)) <a id='176' tid='175' class='m'>...</a>)
  790. <span class='i'>((exist () g g* ...) s env)</span>)))))
  791. (<a id='584' tid='583' class='u'>define</a> <a id='586' tid='585' class='u'>succeed</a> <span class='i'>(lambda (s env) (sunit s))</span>)
  792. (<a id='358' tid='357' class='u'>define</a> <a id='360' tid='359' class='u'>fail</a> <span class='i'>(lambda (s env) snull)</span>)
  793. <span class='i'>(define prints
  794. (lambda (s env)
  795. (begin
  796. (printf &quot;#[prints]:: ~s\n&quot; s)
  797. (succeed s env))))</span>
  798. <span class='i'>(define print-env
  799. (lambdag@ (s env)
  800. (begin
  801. (printf &quot;env: ~s\n&quot; env)
  802. (succeed s env))))</span>
  803. <span class='i'>(define print-var
  804. (lambda (name v)
  805. (lambda (s env)
  806. (begin
  807. (printf &quot;#[print-var] ~a = ~s\n&quot; name (walk v s))
  808. (succeed s env)))))</span>
  809. <span class='i'>(define-syntax print-var
  810. (syntax-rules ()
  811. ((_ v) (lambda (s env)
  812. (begin
  813. (printf &quot;#[print-var] ~a = ~s\n&quot; &#39;v (walk* v (pkg-subst s)))
  814. (succeed s env))))))</span>
  815. <span class='i'>(define print-constraintso
  816. (lambda (s env)
  817. (printf &quot;#[constraints] \n~a\n&quot;
  818. (map (lambda (s) (format &quot;~a\n&quot; s))
  819. (map (reify-constraint s) (pkg-constraints s))))
  820. (succeed s env)))</span>
  821. </pre>
  822. </div>
  823. </body>
  824. </html>