Permalink
Browse files

Initial import of smug sources

  • Loading branch information...
0 parents commit 4c15f842c9f5fa369a60b480a42319ddfb76cb1c Drew Crampsie committed May 2, 2011
Showing with 1,527 additions and 0 deletions.
  1. +3 −0 README.txt
  2. +213 −0 images/mascot.svg
  3. +90 −0 input.lisp
  4. +52 −0 package.lisp
  5. +8 −0 smug.asd
  6. +353 −0 smug.lisp
  7. +808 −0 smug.org
3 README.txt
@@ -0,0 +1,3 @@
+Monadic Parser Combinators for Common Lisp
+
+see smug.org
213 images/mascot.svg
@@ -0,0 +1,213 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!-- Created with Inkscape (http://www.inkscape.org/) -->
+
+<svg
+ xmlns:dc="http://purl.org/dc/elements/1.1/"
+ xmlns:cc="http://creativecommons.org/ns#"
+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:svg="http://www.w3.org/2000/svg"
+ xmlns="http://www.w3.org/2000/svg"
+ xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+ xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+ width="800px"
+ height="600px"
+ id="svg5093"
+ version="1.1"
+ inkscape:version="0.47 r22583"
+ sodipodi:docname="New document 118">
+ <defs
+ id="defs5095">
+ <inkscape:perspective
+ sodipodi:type="inkscape:persp3d"
+ inkscape:vp_x="0 : 300 : 1"
+ inkscape:vp_y="0 : 1000 : 0"
+ inkscape:vp_z="800 : 300 : 1"
+ inkscape:persp3d-origin="400 : 200 : 1"
+ id="perspective5101" />
+ <inkscape:perspective
+ id="perspective5055"
+ inkscape:persp3d-origin="0.5 : 0.33333333 : 1"
+ inkscape:vp_z="1 : 0.5 : 1"
+ inkscape:vp_y="0 : 1000 : 0"
+ inkscape:vp_x="0 : 0.5 : 1"
+ sodipodi:type="inkscape:persp3d" />
+ </defs>
+ <sodipodi:namedview
+ id="base"
+ pagecolor="#ffffff"
+ bordercolor="#666666"
+ borderopacity="1.0"
+ inkscape:pageopacity="0.0"
+ inkscape:pageshadow="2"
+ inkscape:zoom="0.6"
+ inkscape:cx="400"
+ inkscape:cy="601.55945"
+ inkscape:current-layer="layer1"
+ inkscape:document-units="px"
+ showgrid="false"
+ inkscape:window-width="1400"
+ inkscape:window-height="1022"
+ inkscape:window-x="0"
+ inkscape:window-y="1"
+ inkscape:window-maximized="1" />
+ <metadata
+ id="metadata5098">
+ <rdf:RDF>
+ <cc:Work
+ rdf:about="">
+ <dc:format>image/svg+xml</dc:format>
+ <dc:type
+ rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
+ <dc:title></dc:title>
+ </cc:Work>
+ </rdf:RDF>
+ </metadata>
+ <g
+ id="layer1"
+ inkscape:label="Layer 1"
+ inkscape:groupmode="layer">
+ <path
+ style="fill:#ac9d93;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-width:5.65052652;stroke-linecap:butt;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path3229"
+ d="m 420.35181,230.29271 c 13.3392,-89.81749 -76.84592,-95.86079 -66.69617,-131.613741 10.55657,-37.186068 51.57837,-26.678465 72.92114,-32.014157 21.34273,-5.335691 18.19357,-25.051198 5.33569,-35.571276 -9.78212,-8.00355 -89.76967,-12.331341 -108.49242,46.242663 -26.04413,81.478891 64.02832,74.699691 64.02828,151.177951 0,65.01497 31.12489,1.77856 32.90348,1.77856 z" />
+ <path
+ style="fill:#ac9d93;fill-opacity:1;fill-rule:nonzero;stroke:#000000;stroke-width:5.65052605;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path2383"
+ d="m 218.48475,377.91351 a 174.29928,174.29928 0 0 0 348.59855,0 174.29928,174.29928 0 1 0 -348.59855,0 z" />
+ <path
+ style="fill:#241f1c;fill-opacity:0.31372549;fill-rule:evenodd;stroke:none"
+ id="path3334"
+ d="m 345.18739,45.594254 c -4.69032,5.913855 -8.53572,12.908358 -11.16863,21.145329 -26.04412,81.478877 64.00991,74.717457 64.00987,151.195717 0,26.41234 5.17014,31.64358 11.38937,28.56165 -9.59392,13.00155 -21.9841,23.07037 -21.9841,-17.96691 4e-5,-76.47826 -90.05399,-69.71684 -64.00987,-151.195722 4.42186,-13.83366 12.23896,-24.1433 21.76336,-31.740064 z m 96.27968,9.049671 c -1.57742,5.333433 -6.20625,9.839743 -14.87678,12.007366 -15.21166,3.802905 -40.42656,-0.424818 -57.47644,10.285728 14.99605,-23.800765 49.21419,-16.166215 68.07117,-20.880462 1.57077,-0.392685 2.97075,-0.87357 4.28205,-1.412632 z" />
+ <path
+ style="fill:#241f1c;fill-opacity:0.31372549;fill-rule:nonzero;stroke:none"
+ id="path3306"
+ d="m 457.97718,216.2578 c 20.28679,8.19683 38.68007,20.10141 54.34219,34.87435 -4.57982,7.79514 -10.52323,14.95784 -18.05521,20.35072 17.37205,22.74067 27.67874,51.1272 27.67874,81.93263 5e-5,74.61434 -60.55685,135.17122 -135.17114,135.17122 -74.61433,0 -135.1712,-60.55692 -135.1712,-135.17122 0,-30.51321 10.16281,-58.63929 27.23732,-81.27046 -5.25938,-3.59804 -9.73033,-8.04274 -13.55248,-12.97855 14.92518,-16.01806 32.79941,-29.25009 52.79711,-38.75908 0.42966,0.50949 0.8328,1.02557 1.23607,1.54507 3.04699,3.92534 5.01989,7.57293 6.13613,10.99203 18.41324,-9.40123 39.23657,-14.70019 61.31705,-14.70019 21.59265,1e-5 42.01394,5.06627 60.12511,14.08217 1.14855,-3.23918 3.05403,-6.6878 5.91538,-10.37401 1.53133,-1.97273 3.28168,-3.87124 5.16493,-5.69468 z" />
+ <path
+ style="fill:#ac9d93;fill-opacity:1;fill-rule:nonzero;stroke:#000000;stroke-width:5.65052605;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path2385"
+ d="m 522.38438,170.85672 c 3.62302,0.0804 6.30011,0.82974 7.63704,2.33967 4.92639,5.56396 0.83356,56.41251 -29.75356,78.31276 17.37201,22.74066 27.67875,51.1272 27.67875,81.93263 0,74.61432 -60.55686,135.17119 -135.17119,135.17119 -74.61433,0 -135.1712,-60.55689 -135.1712,-135.17119 0,-30.51323 10.16281,-58.63928 27.23732,-81.27046 -31.45168,-21.51686 -35.70168,-73.35389 -30.72478,-78.97493 7.13017,-8.05296 52.99399,5.32103 71.20549,28.78237 3.04698,3.92533 5.01993,7.57293 6.13612,10.99203 18.41329,-9.40124 39.23657,-14.70019 61.31705,-14.70019 21.59265,0 42.01399,5.06627 60.12511,14.08217 1.14856,-3.23919 3.05403,-6.6878 5.91543,-10.37401 14.79687,-19.06234 47.86867,-31.47043 63.56842,-31.12204 z" />
+ <path
+ sodipodi:type="arc"
+ style="fill:#e3dedb;stroke:none"
+ id="path2897"
+ sodipodi:cx="123.79275"
+ sodipodi:cy="261.73843"
+ sodipodi:rx="74.865143"
+ sodipodi:ry="51.875057"
+ d="m 198.65789,261.73843 a 74.865143,51.875057 0 1 1 -149.730285,0 74.865143,51.875057 0 1 1 149.730285,0 z"
+ transform="matrix(-1.3313551,0,0,1.423756,576.62019,5.1756753)" />
+ <path
+ id="path4885"
+ d="m 412.46866,420.43657 c 21.67849,-1.64968 42.94551,-8.79829 60.58067,-20.36336 8.62546,-5.65652 17.20939,-12.89417 22.45892,-18.93634 l 2.10758,-2.42584 -1.5134,-1.30447 c -0.83236,-0.71746 -2.23446,-1.80279 -3.11583,-2.41178 l -1.60248,-1.10729 -3.39776,3.63085 c -3.81001,4.07136 -10.7182,9.99953 -15.85776,13.60822 -15.77577,11.07673 -33.51093,17.9312 -53.83456,20.80655 -7.14598,1.01103 -26.35364,1.01547 -34.55054,0.008 -34.67676,-4.26193 -62.14189,-18.4283 -76.73887,-39.58166 -6.13559,-8.8915 -9.41231,-18.33704 -9.98687,-28.78864 l -0.25324,-4.60684 -3.97984,-0.11542 -3.97989,-0.1154 0.25505,5.01784 c 1.82729,35.94977 34.11999,65.12032 82.22937,74.27909 12.90932,2.45762 28.51929,3.3698 41.17945,2.4064 l 0,4e-5 z m -28.53669,-81.31766 c 8.49777,-1.23424 14.77637,-5.93385 17.32689,-12.96948 0.77626,-2.14133 1.04491,-2.47014 2.42562,-2.9689 5.33347,-1.9266 7.16599,-2.79937 10.49012,-4.99613 2.04303,-1.3502 3.71528,-2.57796 3.71616,-2.72836 0,-0.15039 -0.40527,-0.39929 -0.90249,-0.5531 -0.49713,-0.15381 -2.50536,-0.99555 -4.46285,-1.87054 -7.3236,-3.27374 -17.38343,-4.15594 -43.26822,-3.79444 -19.94612,0.27856 -43.99804,1.76147 -44.61112,2.75048 -0.54818,0.88444 -0.72111,6.93694 -0.213,7.45491 0.85189,0.86843 15.48424,3.62539 29.12291,5.48718 2.28913,0.31249 4.21112,0.62344 4.27115,0.69101 0.06,0.0676 0.65665,1.20444 1.32582,2.52641 1.95975,3.87152 5.57055,7.47314 9.54654,9.5222 3.00135,1.5468 9.98462,2.21097 15.23247,1.44876 z m 78.55464,-0.34581 c 6.53006,-1.24043 10.69009,-4.9365 12.85403,-11.42046 0.7308,-2.18966 1.04438,-2.64936 1.94319,-2.84876 4.76878,-1.05786 14.61681,-4.25337 18.6485,-6.05107 1.6441,-0.7331 2.31004,-1.25039 2.31004,-1.79435 0,-1.28504 -1.28381,-6.10685 -1.76075,-6.61322 -0.34125,-0.36229 -2.71198,-0.38939 -9.88996,-0.11304 -5.19264,0.1999 -17.48623,0.55107 -27.31908,0.78035 -16.93614,0.39492 -20.54977,0.3221 -31.13564,-0.62743 l -2.81231,-0.25225 3.41494,3.4772 c 4.42221,4.50296 7.85149,7.06093 11.92055,8.89189 l 3.283,1.47724 0.657,2.60789 c 1.45403,5.77174 4.49265,10.02225 8.35943,11.69327 2.32978,1.00679 6.55104,1.35804 9.52706,0.79274 z m 29.59644,-66.00121 c 1.142,-0.0803 2.27948,-0.39001 2.52776,-0.68826 0.27741,-0.33325 0.40606,-1.82792 0.33399,-3.87776 l -0.11728,-3.33551 -1.8079,-0.27052 c -0.99431,-0.14879 -4.33889,-0.57107 -7.43241,-0.93841 -8.60279,-1.02154 -14.52123,-2.10906 -22.88991,-4.20604 -8.92917,-2.23744 -13.89619,-4.01428 -17.80538,-6.36943 -3.04132,-1.83231 -3.25746,-2.15919 -4.33739,-6.5593 -0.39495,-1.60927 -0.87469,-2.70401 -1.18503,-2.70401 -0.96456,0 -6.6105,6.54055 -7.91857,9.17316 -1.6448,3.31045 -1.80259,7.27832 -0.39495,9.93271 2.75882,5.20255 8.60686,7.66594 21.18596,8.92418 7.46832,0.74703 33.68648,1.35192 39.84111,0.91919 z m -177.84244,-7.79076 c 0.77339,-0.52535 2.27236,-2.21103 3.33108,-3.74597 2.49098,-3.61138 4.64238,-5.77555 8.11881,-8.16696 13.83776,-9.51881 37.85935,-14.9222 73.72128,-16.58278 l 10.24462,-0.47439 0.32071,-3.57165 c 0.24792,-2.76032 0.20069,-3.69144 -0.20799,-4.09894 -0.62858,-0.62678 -7.69136,-1.4909 -17.7195,-2.16798 -9.1036,-0.61466 -30.20261,-0.27178 -37.23219,0.60504 -19.2873,2.4058 -32.31705,6.53738 -43.01715,13.64031 -6.63945,4.40735 -13.34004,11.95983 -16.03432,18.07285 -1.10166,2.49969 -1.23758,3.09558 -0.77184,3.38565 0.31079,0.19363 2.82497,1.09805 5.58702,2.00984 3.88524,1.28256 5.84021,1.70219 8.63763,1.85396 3.32369,0.18034 3.72931,0.11903 5.02184,-0.75898 z"
+ style="fill:#040401"
+ sodipodi:nodetypes="csccccccsssscccccscccsssssssssssssccsssssssccccccsccscccssssssssccsscccssssssssc" />
+ <path
+ style="fill:#000000;fill-opacity:0.31372549;fill-rule:nonzero;stroke:none"
+ id="path3293"
+ d="m 269.51392,292.44655 c -1.70722,8.59701 -2.61684,17.47643 -2.61684,26.57658 0,75.11747 60.843,136.08278 135.80992,136.08274 56.22517,0 104.49455,-34.2707 125.12074,-83.10736 -12.44943,62.27697 -67.35082,109.28396 -133.1487,109.28396 -74.96692,-4e-5 -135.80992,-60.96528 -135.80992,-136.08275 0,-18.70701 3.80918,-36.53521 10.6448,-52.75317 z" />
+ <path
+ style="fill:#f6ffd5;fill-opacity:1;fill-rule:nonzero;stroke:none"
+ id="path2393"
+ d="m 459.39083,326.08706 a 2.4826508,8.2182323 0 0 0 4.96531,0 2.4826508,8.2182323 0 1 0 -4.96531,0 z" />
+ <path
+ style="fill:#000000;fill-opacity:1;fill-rule:nonzero;stroke:none"
+ id="path2397"
+ d="m 397.62225,361.75111 c 0,12.4729 13.65969,22.59585 22.69631,22.59585 9.73496,0 22.69631,-10.12295 22.69631,-22.59585 0,-12.4729 -10.16795,-15.64327 -22.69631,-15.64327 -12.52841,0 -22.69631,3.17037 -22.69631,15.64327 z" />
+ <g
+ id="g3188"
+ transform="matrix(-1.4126316,0,0,1.4126316,837.36382,-385.1939)">
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path3182"
+ d="m 365.34735,505.66655 c 44.67355,-16.60772 66.50445,3.89308 66.50445,3.89308" />
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path3184"
+ d="m 358.93972,516.80324 c 31.63347,-8.95824 52.35147,13.88671 52.35147,13.88671" />
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path3186"
+ d="m 356.30922,528.71442 c 24.33775,-2.57606 33.65692,19.1258 33.65692,19.1258" />
+ </g>
+ <g
+ id="g3193"
+ transform="matrix(1.4126316,0,0,1.4126316,70.012123,-263.76165)">
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path3195"
+ d="m 302.66692,425.07743 c 44.67355,-16.60772 66.50445,3.89308 66.50445,3.89308" />
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path3197"
+ d="m 296.25929,436.21412 c 31.63347,-8.95824 52.35147,13.88671 52.35147,13.88671" />
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path3199"
+ d="m 293.62879,448.1253 c 24.33775,-2.57606 33.65692,19.1258 33.65692,19.1258" />
+ </g>
+ <path
+ style="fill:#2b2200;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-width:5.65052652;stroke-linecap:butt;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path3231"
+ d="m 313.63793,224.95702 c -3.55713,-27.56775 -44.46411,-46.24267 -49.79979,-41.79627 -5.33569,4.44641 6.59611,47.18661 29.34631,57.80334 13.33926,6.22496 20.45348,-8.89282 20.45348,-16.00707 z" />
+ <path
+ style="fill:#2b2200;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-width:5.65052652;stroke-linecap:butt;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path3233"
+ d="m 471.55798,224.95702 c 3.55714,-27.56775 44.46414,-46.24267 49.79982,-41.79627 5.33568,4.44641 -6.59611,47.18661 -29.3463,57.80334 -13.33925,6.22496 -20.45348,-8.89282 -20.45352,-16.00707 z" />
+ <path
+ style="fill:#ac9d93;fill-opacity:1;fill-rule:nonzero;stroke:#000000;stroke-width:5.65052652;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1"
+ id="path3235"
+ d="m 274.06488,547.32802 c 0,30.43477 24.7007,29.34634 55.13548,29.34634 30.43482,0 55.1355,1.08843 55.1355,-29.34634 0,-30.43478 -24.70068,-55.13546 -55.1355,-55.13546 -30.43478,0 -55.13548,24.70068 -55.13548,55.13546 z" />
+ <path
+ style="fill:#e3e2db;fill-opacity:1;fill-rule:nonzero;stroke:#000000;stroke-width:5.65052652;stroke-linecap:round;stroke-linejoin:round;stroke-miterlimit:4;stroke-opacity:1"
+ id="path3238"
+ d="m 401.2322,547.32802 c 0,30.43477 24.70069,29.34629 55.13551,29.34629 16.92317,0 32.07346,0.33656 42.19001,-4.59709 8.0771,-3.93902 12.94549,-11.2376 12.94549,-24.7492 0,-30.43478 -24.70073,-55.13546 -55.1355,-55.13546 -30.43482,0 -55.13551,24.70068 -55.13551,55.13546 z" />
+ <path
+ style="fill:#241f1c;fill-opacity:0.31372549;fill-rule:nonzero;stroke:none"
+ id="path3327"
+ d="m 300.24804,500.41748 c -6.67164,9.15385 -10.63887,20.43701 -10.63887,32.62297 0,17.61041 8.2429,33.27958 21.05704,43.4384 -21.30426,-0.80881 -36.59602,-5.21787 -36.59602,-29.13552 0,-19.82167 10.46286,-37.20824 26.17785,-46.92585 z" />
+ <path
+ style="fill:#241f1c;fill-opacity:0.31372549;fill-rule:nonzero;stroke:none"
+ id="path3332"
+ d="m 428.0912,500.41748 c -6.67164,9.15385 -10.63887,20.43701 -10.63887,32.62297 0,17.61041 8.24291,33.27958 21.05705,43.4384 -21.30426,-0.80881 -36.596,-5.21787 -36.596,-29.13552 0,-19.82167 10.46284,-37.20824 26.17782,-46.92585 z" />
+ <path
+ style="fill:#000000;fill-opacity:0.31372549;fill-rule:nonzero;stroke:none"
+ id="path3349"
+ d="m 376.97163,519.79701 c 4.67939,8.1011 7.37216,17.52456 7.37216,27.54632 0,24.72827 -16.3197,28.62396 -38.7591,29.22384 22.29104,-9.29233 33.6272,-31.37113 31.38694,-56.77016 z" />
+ <g
+ id="g2469"
+ transform="matrix(1.4126316,0,0,1.4126316,-69.165074,-314.47193)">
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path2471"
+ d="m 357.34172,628.69417 c -3.5026,-11.33139 0.50038,-24.55134 0.50038,-24.55134" />
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path2473"
+ d="m 375.36715,631.21226 c 4.29303,-18.25613 -0.61329,-32.73512 -0.61329,-32.73512" />
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path2475"
+ d="m 393.62142,629.3237 c 8.81331,-13.84948 1.25905,-25.18087 1.25905,-25.18087" />
+ </g>
+ <g
+ id="g2508"
+ transform="matrix(-1.4126316,0,0,1.4126316,853.70534,-314.47193)">
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path2510"
+ d="m 357.34172,628.69417 c -3.5026,-11.33139 0.50038,-24.55134 0.50038,-24.55134" />
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path2512"
+ d="m 375.36715,631.21226 c 4.29303,-18.25613 -0.61329,-32.73512 -0.61329,-32.73512" />
+ <path
+ style="fill:none;stroke:#000000;stroke-width:4;stroke-linecap:round;stroke-linejoin:miter;stroke-miterlimit:4;stroke-opacity:1;stroke-dasharray:none"
+ id="path2514"
+ d="m 393.62142,629.3237 c 8.81331,-13.84948 1.25905,-25.18087 1.25905,-25.18087" />
+ </g>
+ <path
+ style="fill:#f6ffd5;fill-opacity:1;fill-rule:nonzero;stroke:none"
+ id="path2393-0"
+ d="m 378.21165,325.63287 a 2.4826508,8.2182323 0 0 0 4.9653,0 2.4826508,8.2182323 0 1 0 -4.9653,0 z" />
+ </g>
+</svg>
90 input.lisp
@@ -0,0 +1,90 @@
+(in-package :smug)
+
+(defgeneric input-empty-p (input)
+ (:method ((input cl:string))
+ (zerop (length input))))
+
+(defgeneric input-first (input)
+ (:method ((input cl:string))
+ (declare (optimize (speed 3) (safety 0)))
+ (aref input 0)))
+
+(defgeneric input-rest (input)
+ (:method ((input cl:string))
+ (declare (optimize (speed 3)))
+ (multiple-value-bind (string index)
+ (array-displacement input)
+ (let ((original-string (or string input)))
+ (make-array (1- (length input))
+ :displaced-to original-string
+ :displaced-index-offset (1+ index)
+ :element-type 'character)))))
+
+(defgeneric input-error (input message &rest args)
+ (:method (input message &rest args) (error message args)))
+
+(define-condition input-error (simple-error) ((input :accessor input-error-input :initarg :input)))
+
+(defstruct (file-stream-input (:constructor %make-file-input))
+ stream (file-position 0))
+
+(defmethod input-first (input &aux (stream (file-stream-input-stream input)))
+ (file-position stream (file-stream-input-file-position input))
+ (read-char stream))
+
+(defmethod input-rest (input)
+ (%make-file-input :stream (file-stream-input-stream input)
+ :file-position (1+ (file-stream-input-file-position input))))
+
+(defmethod input-empty-p (input)
+ (= (file-stream-input-file-position input) (file-length (file-stream-input-stream input))))
+
+(defun make-file-stream-input (stream)
+ (%make-file-input :stream stream))
+
+(defmethod input-error ((input file-stream-input) message &rest args)
+ (error 'input-error
+ :input input
+ :format-control "Error at ~A : ~A"
+ :format-arguments (list (file-stream-input-file-position input)
+ (apply #'format nil message args))))
+
+(defstruct (line-input (:constructor %make-line-input))
+ string (index 0) (line-count 1))
+
+(defun make-line-input (string)
+ (%make-line-input :string string))
+
+(defmethod input-empty-p ((input line-input))
+ (= (line-input-index input)
+ (1- (length (line-input-string input)))))
+
+(defmethod input-first ((input line-input))
+ (aref (line-input-string input)
+ (line-input-index input)))
+
+(defmethod input-rest ((input line-input))
+ (%make-line-input :index (1+ (line-input-index input))
+ :string (line-input-string input)
+ :line-count (line-input-line-count input)))
+
+(define-condition input-error (simple-error) ((input :accessor input-error-input :initarg :input)))
+
+(defmethod input-error ((input line-input) message &rest args)
+ (error 'input-error
+ :input input
+ :format-control "Error on line ~A : ~A"
+ :format-arguments (list (line-input-line-count input) (apply #'format nil message args))))
+
+(defun fail (&key (error nil))
+ (if error
+ (lambda (input)
+ (input-error input error)
+ (funcall (result t) input))
+ (constantly nil)))
+
+(defun increment-line-count (&optional (delta 1))
+ (lambda (input)
+ (funcall (result (incf (line-input-line-count input) delta))
+ input)))
+
52 package.lisp
@@ -0,0 +1,52 @@
+;;;; package.lisp
+
+(defpackage :smug
+ (:use :cl)
+ (:export
+ #:bind
+ #:result
+ #:parse
+ #:item
+
+ #:=let*
+ #:=char
+ #:=and
+ #:=or
+ #:=not
+
+ #:zero-or-more
+ #:one-or-more
+
+ #:no-more-input
+
+ #:text
+ #:whitespace
+ #:none-of
+ #:skip-whitespace
+
+ #:run
+ #:bracket
+ #:maybe
+ #:range
+ #:at-least
+ #:=string
+ #:one-to
+ #:zero-to
+ #:=satisfies
+ #:digit
+ #:fail
+ #:=unless
+ #:line
+ #:=prog1
+ #:string-of
+ #:=list
+ #:call
+ #:=digit-char
+ #:exactly
+ #:natural-number
+ #:int
+ #:=prog2))
+
+(defpackage :smug.examples
+ (:use :cl :smug))
+
8 smug.asd
@@ -0,0 +1,8 @@
+;;;; smug.asd
+
+(asdf:defsystem #:smug
+ :serial t
+ :components ((:file "package")
+ (:file "input")
+ (:file "smug")))
+
353 smug.lisp
@@ -0,0 +1,353 @@
+(in-package :smug)
+
+(defun result (value)
+ (declare (optimize (speed 3)))
+ (lambda (input)
+ (list (cons value input))))
+
+(defun fail (&key (error nil))
+ (if error
+ (lambda (input)
+ (declare (ignore input))
+ (error error))
+ (constantly nil)))
+
+(defun item ()
+ (lambda (input)
+ (unless (input-empty-p input)
+ (list (cons (input-first input)
+ (input-rest input))))))
+
+(defun bind (parser function)
+ (lambda (input)
+ (loop :for (value . input) :in (funcall parser input)
+ :append (funcall (funcall function value) input))))
+
+(defun run (parser input &key (result #'caar))
+ (funcall result (funcall parser input)))
+
+(defun =satisfies (predicate)
+ (bind (item)
+ (lambda (x)
+ (if (funcall predicate x)
+ (result x)
+ (fail)))))
+
+(defun plus (&rest parsers)
+ (lambda (input)
+ (loop :for parser in parsers
+ :append (funcall parser input))))
+
+;;;; PARSER-LET* is the natural syntax for lispers
+(defmacro =let* (bindings &body body)
+ (if bindings
+ (let ((symbol (first (first bindings))))
+ `(bind ,@(cdr (first bindings))
+ (lambda (,symbol)
+ ,@(when (string-equal (symbol-name symbol) "_")
+ `((declare (ignorable ,symbol))))
+ (=let* ,(cdr bindings)
+ ,@body))))
+ `(progn ,@body)))
+
+(defun end-of-input ()
+ (lambda (input)
+ (when (input-empty-p input)
+ (list (cons t input)))))
+
+
+(defun =or (&rest parsers)
+ (declare (optimize (speed 3)))
+ (labels ((non-consing-or (parsers)
+ (lambda (input)
+ (or (funcall (the function (first parsers)) input)
+ (when (rest parsers)
+ (funcall (the function (non-consing-or (rest parsers))) input))))))
+ (non-consing-or parsers)))
+
+(defun =and (p1 &rest ps)
+ (=let* ((result p1))
+ (if ps
+ (apply #'=and ps)
+ (result result))))
+
+(defun =not (parser)
+ (lambda (input)
+ (cl:when (cl:not (funcall parser input))
+ (list (cons t input)))))
+
+(defun =unless (parser &rest parsers)
+ (apply #'=and (=not parser) parsers))
+
+(defun =char (x)
+ (=satisfies (lambda (y) (eql x y))))
+
+(defun before (parser end-parser)
+ (=let* ((i parser)
+ (result (lambda (input)
+ (if (funcall end-parser input)
+ (list (cons i input))
+ nil))))
+ (result result)))
+
+(defun =string (string)
+ (if (input-empty-p string)
+ (result "")
+ (=let*
+ ((_ (=char (input-first string)))
+ (_ (=string (input-rest string))))
+ (result string))))
+
+(defun =digit-char (&optional (base 10))
+ (=satisfies (lambda (x) (digit-char-p x base))))
+
+(defun digit ()
+ (=let* ((char (item))
+ (digit (result (digit-char-p char))))
+ (if digit (result digit) (fail))))
+
+(defun natural-number (&optional (base 10))
+ (labels ((evaluate (chars)
+ (reduce #'op (mapcar (lambda (c) (digit-char-p c base)) chars)))
+ (op (m n)
+ (+ (* base m) n)))
+ (=let* ((xs (one-or-more (=digit-char base))))
+ (result (evaluate xs)))))
+
+(defun sophisticated-int ()
+ (flet ((op ()
+ (plus (=let* ((_ (=char #\-)))
+ (result #'-))
+ (result #'identity))))
+ (=let* ((op (op))
+ (n (natural-number)))
+ (result (funcall op n)))))
+
+(defun int ()
+ (sophisticated-int))
+
+(defun bracket (open-parser body-parser close-parser)
+ (=let* ((_ open-parser)
+ (x body-parser)
+ (_ close-parser))
+ (result x)))
+
+(defun none-of (char-bag)
+ (=let* ((char (item)))
+ (if (not (find char char-bag))
+ (result char)
+ (fail))))
+
+(defun one-of (char-bag)
+ (=let* ((char (item)))
+ (if (find char char-bag)
+ (result char)
+ (fail))))
+
+(defun text (&optional (parser (item)))
+ (=let* ((text (one-or-more parser)))
+ (result (coerce text 'cl:string))))
+
+(defun eof (&optional (result :eof))
+ (bind (end-of-input)
+ (lambda (_) (declare (ignore _ ))
+ (result result))))
+
+(defun zero-or-more-recursive (parser &optional (combinator #'=or))
+ (funcall (the function combinator)
+ (=let* ((x (the function parser))
+ (y (=or (zero-or-more-recursive parser combinator)
+ (result nil))))
+ (result (cons x y)))
+ (result nil)))
+
+(defun zero-or-more (parser)
+ (lambda (input) :result #'identity
+ (loop
+ :for value := (funcall parser input)
+ :for ((result . i)) := value
+ :while value :collect result :into results
+ :do (setf input i)
+ :finally (return (list (cons results input))))))
+
+
+(defun one-or-more (parser)
+ (=let* ((x parser)
+ (y (zero-or-more parser)))
+ (result (cons x y))))
+
+(defun one-to (n parser)
+ (case n
+ (0 (result nil))
+ (t (=let* ((x parser)
+ (xs (=or (one-to (1- n) parser)
+ (result nil))))
+ (result (cons x xs))))))
+
+(defun zero-to (n parser)
+ (maybe (one-to n parser)))
+
+
+(defun at-least (n parser &key limit)
+ (case n
+ (0 (if limit
+ (if (zerop limit)
+ (result nil)
+ (zero-to limit parser))
+ (zero-or-more parser)))
+ (t (=let* ((x parser)
+ (xs (at-least (1- n) parser :limit (1- limit))))
+ (result (cons x xs))))))
+
+(defun exactly (n parser)
+ (at-least n parser :limit n))
+
+
+(defun line ()
+ (=or
+ (=let* ((xs (text (none-of '(#\Newline))))
+ (end (=or (end-of-input)
+ (=char #\Newline))))
+ (result
+ (list* :line xs (list end))))
+ (bind (=char #\Newline)
+ (constantly
+ (result '(:line "" :terminator #\Newline))))))
+
+(defun =progn (&rest parsers)
+ (apply #'=and parsers))
+
+(defun =prog1 (parser &rest parsers)
+ (=let* ((result parser)
+ (_ (apply #'=and parsers)))
+ (result result)))
+
+(defun =prog2 (parser1 parser2 &rest parsers)
+ (=and parser1 (apply #'=prog1 parser2 parsers)))
+
+(defun string-of (parser)
+ (bind parser (lambda (s) (result (coerce s 'string)))))
+
+(defun whitespace ()
+ (one-of '(#\Tab #\Newline #\Space #\Return #\Linefeed)))
+
+(defun =list (&rest parsers)
+ (if parsers
+ (=let* ((x (first parsers))
+ (xs (apply '=list (rest parsers))))
+ (result (cons x xs)))
+ (result nil)))
+
+(defun call (function-designator &rest args)
+ (result (apply function-designator args)))
+
+
+(defun skip-whitespace (parser)
+ (=let* ((_ (zero-or-more (whitespace)))
+ (v parser)
+ (_ (zero-or-more (whitespace))))
+ (result v)))
+
+(defun maybe (parser)
+ (=or parser (result nil)))
+
+(defun range (from to &key (parser (item)) (predicate 'char<=))
+ (=let* ((char parser))
+ (if (funcall predicate from char to)
+ (result char)
+ (fail))))
+
+(defun org-block (&optional (level 0))
+ (=or (section level)
+ (simple-list)
+ (text-block (line))))
+
+(defun text-block (parser)
+ (=and (=not (section-heading))
+ parser))
+
+(defun section-heading (&optional (level 0))
+ (=let* ((indicator (at-least (1+ level)
+ (=char #\*)))
+ (space (one-or-more (=char #\Space)))
+ (name (line)))
+ (result (list :level (length indicator)
+ :indicator (cons indicator space)
+ :name name))))
+
+(defun section (&optional (level 0))
+ (=let* ((heading (section-heading level))
+ (contents (zero-or-more
+ (org-block (1+ level)))))
+ (result (list :section :heading heading :contents contents))))
+
+(defun section-line (&optional (level 0))
+ (=and (=not (section-heading level))
+ (line)))
+
+(defun list-item-content-line (indentation-level)
+ (=let* ((indentation (at-least indentation-level (whitespace)))
+ (line (line)))
+ (result (cons indentation line))))
+
+(defun list-item ()
+ (=let* ((pre-space (zero-or-more (whitespace)))
+ (indicator (one-of "*+-"))
+ (post-space (one-or-more (whitespace)))
+ (first-line (line))
+ (rest-lines (zero-or-more
+ (list-item-content-line
+ (+ 1 (length pre-space)
+ (length post-space))))))
+ (result (list :list-item
+ :indicator (list pre-space
+ indicator
+ post-space)
+ :content (cons (cons nil first-line)
+ rest-lines)))))
+
+(defun simple-list ()
+ (=let* ((list (text-block (one-or-more (list-item)))))
+ (result (cons :unordered-list list))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
808 smug.org
@@ -0,0 +1,808 @@
+smug: parsing for lisp, made easy.
+
+* Introduction
+
+ Smug is a library for parsing text, based on monadic parser
+ combinators [fn:1]. Using a simple technique from the functional
+ programming camp, smug makes it simple to create quick extensible
+ recursive descent parsers without funky syntax or impenetrable
+ macrology.
+
+* Features
+ - pure ANSI common lisp with no external dependencies
+ - parsers are first class values written in basic lisp
+ - non-deterministic infinite look-ahead
+ - easy to learn, easy to use
+ - extensible input protocol : parse strings, streams, lists etc
+ - in-depth tutorial : no previous experience required!
+
+* Download and Install
+
+* Example : Parsing S-Expressions
+
+#+BEGIN_SRC lisp
+(defun open-paren ()
+ (=char #\())
+
+(defun close-paren ()
+ (=char #\)))
+
+(defun non-constituent ()
+ (=or (whitespace) (open-paren) (close-paren)))
+
+(defun constituent ()
+ (=and (=not (non-constituent)) (item)))
+
+(defun <atom> ()
+ (=let* ((exp (one-or-more (constituent))))
+ (result (coerce exp 'string))))
+
+(defun sexp ()
+ (skip-whitespace
+ (=or (<atom>)
+ (=let* ((_ (open-paren))
+ (exp (zero-or-more (sexp)))
+ (_ (close-paren)))
+ (result exp)))))
+#+END_SRC
+
+* Tutorial
+
+ The tutorial is essentially a translation of Monadic Parser
+ Combinators[fn:1], or at least the first half, into common
+ lisp. Discussion of static types and the details of monads are
+ omitted as we're simply concerned with parsing.
+
+ The example code in the following document is completely
+ self-contained, and does not require an installation of the smug
+ library.
+
+ In some cases, the natural name for a parser conflicts with a name
+ in the COMMON-LISP package. In those cases, rather then shadow the
+ symbols, i've chosen to prefix those names with a #\= character. It
+ is thought that this aids usability, as one can simply
+ (:use :smug).
+
+ No prior experience with functional programming, monads or recursive
+ descent parsing is assumed. The only requirements are an ANSI
+ common lisp environment, and a burning desire to find a better way
+ to parse.
+
+** Introduction
+
+ This tutorial, like this library, is based on an approach to
+ building parsers using higher-order functions (combinators) that is
+ popular in the functional programming community. Incidentally, these
+ parsers form an instance of something called a monad, which is
+ itself a useful construct with implications beyond parsing.
+
+ With great debt to Monadic Parser Combinators[fn:1], the paper from
+ which this library is derived, this tutorial presents a step by step
+ introduction to the topics of parser combinators and monads and
+ their use in common lisp.
+
+** How To Combine Parsers
+
+#+BEGIN_QUOTE
+ A Parser for Things
+ is a functions from Strings
+ to Lists of Pairs
+ of Things and Strings!
+ --- Fritz Ruehr, Willamette University [fn:2]
+#+END_QUOTE
+
+ A parser is something that is familiar to all programmers... a
+ function that, given a series of tokens as input, produces a data
+ structure that relates to the grammatical structure of the input in
+ some way. Or, to put it simply, a function from strings to things.
+
+#+BEGIN_SRC lisp
+ ;; our fictional parser matches the string "string"
+ ;; and returns an instance of THING
+
+(parse-thing "string") => #<THING>
+#+END_SRC
+
+ In order to combine simple parsers into larger more complex ones,
+ they need a way to communicate between them. First, because any
+ given parser might consume only a part of the input, we'll have our
+ parser return a cons with the result in the CAR and the remaining
+ input in the CDR.
+
+#+BEGIN_SRC lisp
+(parse-thing "string string") => (#<THING> . " string")
+#+END_SRC lisp
+
+ Because a parser may return multiple results when the
+ grammar is ambiguous, or may return no results all, we'll put our
+ conses in a list, and have the empty list, NIL, denote a failed
+ parse.
+
+#+BEGIN_SRC lisp
+(parse-thing "string string") => ((#<THING> . " string"))
+(parse-thing "strong string") => NIL
+#+END_SRC
+
+ So, for our purposes, a parser is just a function that takes a
+ single value as the input and returns a list of conses of results
+ and unconsumed input.
+
+ It is this trivial protocol that allows us to combine small simple
+ parsers into larger more useful ones.
+
+** Reading Input
+
+ Smug parsers allow infinite look-ahead and backtracking. To support
+ parsing many different things, it's useful to define an input
+ protocol. Smug parsers only require three operations on input :
+ INPUT-FIRST, INPUT-REST and INPUT-EMPTY-P. We'll define them in
+ terms of strings. This is not a particularly efficient
+ implementation, but it serves our purposes.
+
+#+BEGIN_SRC lisp
+(defmethod input-empty-p ((input string))
+ (zerop (length input)))
+
+(defmethod input-first ((input string))
+ (aref input 0))
+
+(defmethod input-rest ((input string))
+ (make-array (1- (length input))
+ :displaced-to input
+ :displaced-index-offset 1
+ :element-type (array-element-type input)))
+
+(input-empty-p "") => t
+(input-empty-p "foo") => nil
+(input-first "foo") => #\f
+(input-rest "foo") => "oo"
+#+END_SRC
+
+** The Three Primitive Parsers
+
+ There are 3 simple primitive parsers. It it only necessary to
+ understand them, and one sequencing combinator, BIND, to understand
+ all of smug.
+
+*** RESULT
+
+ The first parser is RESULT, which always succeeds by returning the
+ value passed to it, and does not consume any input. Because we've
+ earlier defined parsers as functions that take a single argument
+ we'll curry the input parameter.
+
+#+BEGIN_SRC lisp
+(defun result (value)
+(lambda (input)
+ (list (cons value input))))
+
+(funcall (result :foo) "bar baz") => ((:foo . "bar baz"))
+#+END_SRC
+
+*** FAIL
+
+ The second parser, FAIL, is the inverse of RESULT. It simply fails
+ regardless of the input. we could define FAIL as a function that
+ takes a single argument, but then we'd have to access it using
+ FUNCTION (#'), and aesthetically that inconsistency is
+ undesirable, so we'll again curry the input parameter.
+
+#+BEGIN_SRC lisp
+(defun fail ()
+ (constantly nil))
+
+(funcall (fail) "foo") => NIL
+#+END_SRC
+
+*** ITEM
+
+ The last true primitive is ITEM, which is a parser that consumes
+ the first token in the input, or fails in the input is empty.
+
+#+BEGIN_SRC lisp
+(defun item ()
+ (lambda (input)
+ (unless (input-empty-p input)
+ (list (cons (input-first input)
+ (input-rest input))))))
+
+(funcall (item) "foo") => ((#\f . "oo"))
+(funcall (item) "") => NIL
+#+END_SRC
+
+** BIND, Our First Combinator
+
+ Now that we have our primitive parsers, we need a way to combine
+ them. We'd like to be able to apply parsers in sequence, and it
+ would also come in handy if we could give names to the intermediate
+ results of parsers. Both these requirements are fulfilled by using
+ the monadic sequencing operator, BIND.
+
+ BIND is a function that takes as arguments a parser P, and a
+ function F which take a value and returns a parser P2. BIND returns
+ a parser that first applies P to the input, returning a list of
+ (VALUE . INPUT) pairs. The the function F is applied to each VALUE,
+ and the result P2 then applied to the INPUT. The collected lists of
+ pairs returned from the P2's are then concatenated and the result
+ returned.
+
+#+BEGIN_SRC lisp
+(defun bind (parser function)
+ (lambda (input)
+ (loop :for (value . input) :in (funcall parser input)
+ :append (funcall (funcall function value) input))))
+
+(let ((char-token
+ (bind (item)
+ (lambda (char)
+ (result (list :char char))))))
+ (funcall char-token "foo"))
+=> (((:CHAR #\f) . "oo"))
+#+END_SRC
+
+ Because BIND itself returns a parser, the result of a BIND can be
+ returned as P2. This allows parsers to be chained, and allows us to
+ use LAMBDA to provide names for the values of parser results. For
+ example, the following parser uses BIND to return the first two
+ characters as a cons.
+
+#+BEGIN_SRC lisp
+(let ((two-chars
+ (bind (item)
+ (lambda (char)
+ (bind (item)
+ (lambda (char2)
+ (result (cons char char2))))))))
+ (funcall two-chars "asd"))
+=> (((#\a . #\s) . "d"))
+#+END_SRC
+
+ The next section gets into some details about why our parser is a
+ monad. You don't really need to know this, so feel free to [[**Some%20Parsers%20Using%20Bind][skip it]]
+ if you're in a hurry.
+
+*** A quick word on monads
+
+ By virtue of having the functions BIND and RESULT defined as they
+ are, our parser interface forms a monad. A monad is, essentially,
+ a category of things that provide the functions BIND and RESULT.
+
+ Of course, just having functions called BIND and RESULT does not a
+ monad make. There are other contracts that BIND (also known as
+ pipe, >>=, *, or let) or RESULT (aka lift, unit, return) must
+ fulfil.
+
+**** The monad laws
+
+ In order to be properly categorized as a monad, the thing
+ providing a definition for BIND and RESULT must obey three laws
+ (a static functional programmer would say 'must have a certain
+ type', but the word type means something different to a dynamic
+ functional programmer, so we'll avoid it here)
+
+ In order to describe those laws we need to define a few terms
+
+ - Monadic Value (MV) :: a function that, given a value, returns a
+ value in the form expected by the internals of BIND. In our
+ examples above, a parser (taking an input and returning a
+ list of results) is the Monadic Value.
+
+ - Monadic Function (MF) :: A function that, given a value returns
+ a monadic value encapsulating that value. RESULT is the
+ canonical Monadic Function
+
+ In Object-Oriented terms, the MF is a constructor, and the MV an
+ object.
+
+ The laws which all things must obey in order to be called a monad
+ are simple :
+
+ - "Left identity" :: (bind (result x) MF) = (funcall MF x)
+
+ - "Right identity" :: (bind MV result) = MV
+
+ - "Associativity" :: (bind (bind MV MF) MF2)
+ = (bind MV (lambda (x) (bind (MF x) MF2)))
+
+ With static type systems, the compiler will enforce this contract
+ for you. In a dynamic system, we just need to be a little more
+ careful. Proving the monad laws for our BIND and RESULT is
+ left as an exercise.
+
+ That's really all there is to monads except for syntax, which
+ we'll get to later. There are extended laws that other monads
+ obey, and monads have other uses beyond parsing, but we're
+ reaching the end of our scope already.
+
+** =satisfies : the parser predicate
+
+ Often, we only want to consume input if a certain
+ condition is true. This where =SATISFIES comes in.
+
+#+BEGIN_SRC lisp
+(defun =satisfies (predicate)
+ (bind (item)
+ (lambda (x)
+ (if (funcall predicate x)
+ (result x)
+ (fail)))))
+
+(funcall (=satisfies #'digit-char-p) "1 and")
+=> ((#\1 . " and"))
+#+END_SRC
+
+ If ITEM fails, so will the =SATISFIES parser. This is because (bind
+ (fail) MF) will always fail. FAIL, also known as zero, is a function
+ belonging to a category of monads knows as "monads with a
+ zero". That's not terribly important for parsing, but interesting if
+ you're into that sort of thing.
+
+*** Example Parsers for letters and numbers using =SATISFIES
+
+ =SATISFIES allows us to defun some simple parsers
+
+#+BEGIN_SRC lisp
+(defun =char (x)
+ (=satisfies (lambda (y) (eql x y))))
+
+(defun =digit-char ()
+ (=satisfies #'digit-char-p))
+
+(defun lower-case-char ()
+ (=satisfies #'lower-case-p))
+
+(defun upper-case-char ()
+ (=satisfies #'upper-case-p))
+
+(funcall (=char #\x) "xyzzy") => ((#\x . "yzzy"))
+(funcall (digit) "1234") => ((#\1 . "234"))
+(funcall (lower-case-char) "abcd") => ((#\a . "bcd"))
+(funcall (upper-case-char) "Abcd") => ((#\A . "bcd"))
+#+END_SRC
+
+** PLUS, the non-deterministic choice combinator
+
+ If we want to combine our earlier parsers, say to create an
+ ALPHANUMERIC-CHAR from UPPER-CASE-CHAR and LOWER-CASE-CHAR, we need
+ a combinator capable of making the choice between them.
+
+ In some cases, it may not be an exclusive choice. There might be
+ multiple ways to parse a string, or a later pass might resolve the
+ ambiguity.
+
+ For example, in one of our earlier examples of BIND, we saw a
+ parser that returned the first two characters in a stream. This
+ parser will fail if there is only one character left in the input.
+
+#+BEGIN_SRC lisp
+(let ((two-chars
+ (bind (item)
+ (lambda (char)
+ (bind (item)
+ (lambda (char2)
+ (result (cons char char2))))))))
+ (funcall two-chars "a"))
+=> NIL
+#+END_SRC
+
+ If we want to parse one or two characters, or an arbitrarily long
+ series of characters, we need some a way to express that.
+
+ Enter the PLUS combinator.
+
+#+BEGIN_SRC lisp
+(defun plus (p1 p2)
+ (lambda (input)
+ (append (funcall p1 input) (funcall p2 input))))
+
+(let ((two-chars
+ (bind (item)
+ (lambda (char)
+ (bind (item)
+ (lambda (char2)
+ (result (cons char char2))))))))
+
+ (funcall (plus two-chars (item)) "a")
+ => ((#\a . ""))
+ (funcall (plus two-chars (item)) "asd"))
+ => (((#\a . #\s) . "d") (#\a . "sd"))
+#+END_SRC
+
+ Note that the second parse returned two pairs, as both parsers were
+ successful... the string parsed as both two chars and a single item.
+
+*** Example parsers using PLUS
+
+ The examples used in the original paper[fn:1] are for letters and
+ alphanumeric characters. There's no good reason to use them over
+ /(=satisfies #'alpha-char-p)/ and the like, but they do serve as a
+ simple example.
+
+#+BEGIN_SRC lisp
+(defun letter () (plus (lower-case-char) (upper-case-char)))
+
+(funcall (letter) "foo") => ((#\f . "oo"))
+(funcall (letter) "1foo") => NIL
+
+(defun alphanumeric () (plus (letter) (=digit-char)))
+
+(funcall (alphanumeric) "1foo") => ((#\1 . "foo"))
+(funcall (alphanumeric) "!1foo") => NIL
+#+END_SRC
+
+ The other example is more illustrative, a parser that returns a
+ series of letters or the empty string.
+
+#+BEGIN_SRC lisp
+(defun word ()
+ (let ((non-empty-letters
+ (bind (letter)
+ (lambda (first-letter)
+ (bind (word)
+ (lambda (rest-of-letters)
+ (result (format nil "~A~A"
+ first-letter
+ rest-of-letters))))))))
+ (plus non-empty-letters (result ""))))
+
+(funcall (word) "asd")
+=>
+(("asd" . "") ("as" . "d") ("a" . "sd") ("" . "asd"))
+
+#+END_SRC
+
+ This is our first recursive parser, but it's a common idiom. Notice
+ that it returns all the possible strings of letters. This is
+ obviously inefficient when one only requires the first value.
+ required, a deterministic combinator =OR, will be introduced later
+ in the tutorial.
+
+** Syntax : LET* and the identity monad
+
+ If you read the earlier section on monads, you'd know that BIND and
+RESULT are the interface to many different types of monads, of which
+our parser is but one example. If you didn't, you know now. Again, if
+you're not at all interested and really just want to keep on parsing,
+[[*** =LET*, our version of LET* like do notation ][skip down to the macro]].
+
+ The most basic monad is the identity monad. A definition of
+ its BIND and RESULT might look like the following.
+
+#+BEGIN_SRC lisp
+
+(defun i-bind (mv mf) (funcall mf mv))
+(defun i-result (value) value)
+
+#+END_SRC
+
+ In Lisp, the identity monad is so trivial as to be useless. In a
+ functional programming language, or any language where the order
+ of operations is not guaranteed, the identity monad serves to
+ sequence operations.
+
+ Imagine a silly lisp where the order of evaluation isn't defined
+ as strict left to right[fn:3]. The following form could have
+ disastrous consequences.
+
+#+BEGIN_SRC lisp
+
+(progn (remove-gun-from-pants)
+ (point-gun-at-bad-guy)
+ (pull-trigger))
+
+#+END_SRC
+
+ The identity monad makes the sequencing explicit. In a purely
+ functional lisp, one might sequence the operations as follows.
+
+#+BEGIN_SRC lisp
+(i-bind (remove-gun-from-pants)
+ (lambda (gun)
+ (i-bind (point-gun-at-bad-guy gun)
+ (lambda (pointed-gun)
+ (i-bind (pull-trigger pointed-gun)
+ (lambda (fired-gun)
+ (i-result fired-gun)))))))
+#+END_SRC
+
+ In functional programming languages this pattern is so common that
+ there is special syntax for it. The usual choices are 'do notation'
+ or 'list comprehension syntax'.
+
+ First, the previous example rendered in list comprehension
+ notation :
+
+#+BEGIN_SRC haskell
+[fgun | gun <- removeGun
+ , pgun <- pointGunAtBadGuy gun
+ , fgun <- pullTrigger pgun]
+
+#+END_SRC
+
+ And in do notation :
+
+#+BEGIN_SRC haskell
+do
+ gun <- removeGun
+ pgun <- pointGunAtBadGuy
+ fgun <- pullTrigger pgun
+ return fgun
+#+END_SRC
+
+ The astute lisper might notice that do notation looks a lot like
+ LET*. In fact, that's really all it is. LET* is lisp syntax for the
+ identity monad, and our i-bind using forms above are directly
+ translatable.
+
+#+BEGIN_SRC lisp
+(let* ((gun (remove-gun-from-pants))
+ (pointed-gun (point-gun-at-bad-guy gun))
+ (fired-gun (pull-trigger pointed-gun)))
+ (identity fired-gun))
+#+BEGIN_SRC
+
+ One could legitimately say that the common lisp package is an
+ instance of the identity monad, if one cared for such insights.
+
+*** =LET*, our version of LET* like do notation
+
+ A LET* like construct is the obvious notation for a lisper to take
+ advantage of the monadic nature of parsers. It's often useful to
+ ignore a value. In haskell, the underscore character is used to
+ denote an ignorable variable, so we'll use the same convention.
+
+#+BEGIN_SRC lisp
+(defmacro =let* (bindings &body body)
+ (if bindings
+ (let ((symbol (first (first bindings))))
+ `(bind ,@(cdr (first bindings))
+ (lambda (,symbol)
+ ,@(when (string-equal (symbol-name symbol) "_")
+ `((declare (ignorable ,symbol))))
+ (=let* ,(cdr bindings)
+ ,@body))))
+ `(progn ,@body)))
+#+END_SRC
+
+If we replace BIND with our I-BIND function above, we get a macro that
+is equivalent to LET*. =LET* binds the results of parsers, and is a
+much nicer way to work than nesting BINDs.
+
+*** Examples using =LET*
+
+ Using recursion like we did in our WORD parser, we'll create a
+ parser that matches a specific string.
+
+#+BEGIN_SRC lisp
+(defun =string (string)
+ (if (input-empty-p string)
+ (result "")
+ (=let*
+ ((_ (=char (input-first string)))
+ (_ (=string (input-rest string))))
+ (result string))))
+
+(funcall (=string "asdf") "asdfjkl") => (("asdf" . "jkl"))
+(funcall (=string "asdf") "asd") => NIL
+#+END_SRC
+
+ Once can see how much nicer =LET* notation is, and also how the
+ ignorable _ comes in handy.
+
+** =OR, =NOT, and =AND : deterministic logic combinators
+
+ =OR is a deterministic PLUS. It take any number of parsers. The
+ first parser is run, and if it succeeds, evaluation short circuits
+ and the result of the parser is returned. Otherwise, the next
+ parser is run, and so on, until one succeeds or there are no more
+ parsers.
+
+ We can't use BIND or =LET* for =OR because it would fail if one of
+ its parsers fails. As such, =OR must be a primitive.
+
+#+BEGIN_SRC lisp
+(defun =or (parser &rest parsers)
+ (lambda (input)
+ (or (funcall parser input)
+ (when parsers
+ (funcall (apply #'=or parsers) input)))))
+#+END_SRC
+
+ Similarly, =NOT, which continues parsing only when the parser
+ fails, is primitive as well.
+
+#+BEGIN_SRC lisp
+(defun =not (parser)
+ (lambda (input)
+ (let ((result (funcall parser input)))
+ (if result
+ nil
+ (list (cons t input))))))
+#+END_SRC
+
+ On the other hand, =AND can be defined in terms of =IF*, and
+ doesn't even need to test for failure, as BIND handles failure
+ automatically.
+
+ =AND (known as '>>' in haskell) sequentially composes parsers,
+ discarding the results of all but the last one, and returning that
+ result.
+
+#+BEGIN_SRC lisp
+
+(defun =and (p1 &rest ps)
+ (=let* ((result p1))
+ (if ps
+ (apply #'=and ps)
+ (result result))))
+
+#+END_SRC
+
+*** Examples using =OR, =NOT, and =AND
+
+ Now that we have =NOT, we can specifically test for failure rather
+ than abort the parse entirely. since the primitive parser ITEM
+ only fails when the input is empty, we can define NO-MORE-INPUT by
+ negating it.
+
+#+BEGIN_SRC
+(defun no-more-input ()
+ (=not (item)))
+#+END_SRC
+
+ Using =AND, we can implement =PROGN (which is really just =AND
+ because it will fail when the parser does), =PROG1 (which comes in
+ handy for matching things and the end of the line, or when there
+ is no more input) and =PROG2, which as we will see is also quite useful.
+
+#+BEGIN_SRC lisp
+(defun =progn (&rest parsers)
+ (apply #'=and parsers))
+
+(defun =prog1 (parser &rest parsers)
+ (=let* ((result parser)
+ (_ (apply #'=and parsers)))
+ (result result)))
+
+(defun =prog2 (parser1 parser2 &rest parsers)
+ (=and parser1 (apply #'=prog1 parser2 parsers)))
+
+
+#+END_SRC
+
+ The MAYBE combinator, which allows a parser to fail and still
+ continue, is a natural use of =OR.
+
+#+BEGIN_SRC lisp
+
+(defun maybe (parser)
+ (=or parser (result nil)))
+
+#+END_SRC
+
+ Finally, using =OR, =AND and =NOT, we can make parser versions of
+ the lisp conditionals we all know and love.
+
+#+BEGIN_SRC
+
+(defun =if (test-parser then-parser &optional (else-parser (result nil)))
+ (=or (=and test-parser then-parser)
+ else-parser))
+
+(defun =when (test-parser then-parser)
+ "we define =when in terms of IF, but it's really just =AND again"
+ (=if test-parser then-parser))
+
+(defun =unless (test-parser then-parser)
+ "defined in term of =when, even though it's just (=AND (=NOT ...))"
+ (=when (=not test-parser) then-parser))
+
+#+END_SRC
+
+
+** ZERO-OR-MORE, ONE-OR-MORE : The repetition combinators
+
+ Earlier, we defined a parser, WORD, using BIND and a recursive
+ call. Lets define a similar parser using =LET* that returns a list
+ of letters.
+
+#+BEGIN_SRC lisp
+(defun letters ()
+ (=or (=let* ((x (letter))
+ (xs (letters)))
+ (result (cons x xs)))
+ (result nil)))
+#+END_SRC
+
+ This pattern can easily be abstracted into a more general
+ combinator, ZERO-OR-MORE
+
+#+BEGIN_SRC lisp
+(defun zero-or-more (parser)
+ (=or (=let* ((x parser)
+ (xs (zero-or-more parser)))
+ (result (cons x xs)))
+ (result nil)))
+
+(funcall (zero-or-more (=char #\a)) "aaaab")
+=>
+(((#\a #\a #\a #\a) . "b"))
+
+(funcall (zero-or-more (=char #\a)) "bbbba")
+=>
+((NIL . "bbbba"))
+#+END_SRC
+
+ Note that zero or more always succeeds. If one needs a parser that
+ matches one or more items and fails otherwise, we can define one in
+ terms of ZERO-OR-MORE, can call it, appropriately enough,
+ ONE-OR-MORE.
+
+#+BEGIN_SRC
+(defun one-or-more (parser)
+ (=let* ((x parser)
+ (y (zero-or-more parser)))
+ (result (cons x y))))
+
+(funcall (one-or-more (=char #\a)) "aaaab")
+=>
+(((#\a #\a #\a #\a) . "b"))
+
+(funcall (one-or-more (=char #\a)) "bbbba")
+=>
+NIL
+#+END_SRC
+
+*** Examples using ZERO-OR-MORE and ONE-OR-MORE
+
+ First, lets make a parser for standard quoted strings. We'll use
+ the #\' character as the quotes, and the #\| character as the
+ escape character, simply to make it easier to embed in our example
+ text in common lisp strings.
+
+
+#+BEGIN_SRC lisp
+(defun quoted-string (&key (quote (=char #\'))
+ (escape (=char #\|)))
+ (let ((escaped-char (=and escape (item)))
+ (string-char (=and (=not quote) (item))))
+ (=let* ((chars (=prog2 (=char #\')
+ (zero-or-more
+ (=or escaped-char
+ string-char))
+ (=char #\'))))
+ (result (coerce chars 'string)))))
+
+(funcall (quoted-string) "'The quote char is |' and the escape char is ||.'")
+=>
+(("The quote char is ' and the escape char is |." . ""))
+#+END_SRC
+
+
+
+
+
+
+
+* footnotes
+[fn:1] Monadic parser combinators (pdf, ps, bibtex) Graham Hutton and
+Erik Meijer. Technical Report NOTTCS-TR-96-4, Department of Computer
+Science, University of
+Nottingham, 1996. http://www.cs.nott.ac.uk/~gmh/bib.html#monparsing
+
+[fn:2] http://www.willamette.edu/~fruehr/haskell/seuss.html
+
+[fn:3] like, say, scheme
+
+
+#(end-lisp)
+
+
+
+
+
+
+
+
+
+

0 comments on commit 4c15f84

Please sign in to comment.