From 6ac7f824889f85591e9ba337ac1df128f8e1e5d2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 2 Jun 2017 17:13:09 -0700 Subject: [PATCH] working on bit parsing --- .../{pitfall => }/binparser/binary-parse.scm | 0 .../binparser/binary-parsing-slides.pdf | Bin .../binparser/compiled/drracket/main_rkt.dep | 1 + .../binparser/compiled/drracket/main_rkt.zo | Bin 0 -> 27278 bytes pitfall/binparser/gif-parse.rkt | 39 ++++ pitfall/{pitfall => }/binparser/giflexer.rkt | 0 pitfall/{pitfall => }/binparser/gifparser.rkt | 0 pitfall/binparser/main.rkt | 172 ++++++++++++++++++ .../binparser/prototype-binparser.rkt | 0 pitfall/{pitfall => }/binparser/test.gif | Bin pitfall/pitfall/binparser/gif-parse.rkt | 151 --------------- 11 files changed, 212 insertions(+), 151 deletions(-) rename pitfall/{pitfall => }/binparser/binary-parse.scm (100%) rename pitfall/{pitfall => }/binparser/binary-parsing-slides.pdf (100%) create mode 100644 pitfall/binparser/compiled/drracket/main_rkt.dep create mode 100644 pitfall/binparser/compiled/drracket/main_rkt.zo create mode 100644 pitfall/binparser/gif-parse.rkt rename pitfall/{pitfall => }/binparser/giflexer.rkt (100%) rename pitfall/{pitfall => }/binparser/gifparser.rkt (100%) create mode 100644 pitfall/binparser/main.rkt rename pitfall/{pitfall => }/binparser/prototype-binparser.rkt (100%) rename pitfall/{pitfall => }/binparser/test.gif (100%) delete mode 100644 pitfall/pitfall/binparser/gif-parse.rkt diff --git a/pitfall/pitfall/binparser/binary-parse.scm b/pitfall/binparser/binary-parse.scm similarity index 100% rename from pitfall/pitfall/binparser/binary-parse.scm rename to pitfall/binparser/binary-parse.scm diff --git a/pitfall/pitfall/binparser/binary-parsing-slides.pdf b/pitfall/binparser/binary-parsing-slides.pdf similarity index 100% rename from pitfall/pitfall/binparser/binary-parsing-slides.pdf rename to pitfall/binparser/binary-parsing-slides.pdf diff --git a/pitfall/binparser/compiled/drracket/main_rkt.dep b/pitfall/binparser/compiled/drracket/main_rkt.dep new file mode 100644 index 00000000..8a014916 --- /dev/null +++ b/pitfall/binparser/compiled/drracket/main_rkt.dep @@ -0,0 +1 @@ +("6.9.0.1" ("d4acf59c6acf0dad17fcba3329960f093e6d5d28" . "8267c356c2dc2c54a92317aeb6f02701e17cb6e6") (collects #"br" #"define.rkt") (collects #"br" #"syntax.rkt") (collects #"racket" #"base.rkt") (collects #"racket" #"function.rkt") (collects #"racket" #"list.rkt") (collects #"racket" #"match.rkt") (collects #"racket" #"port.rkt") (collects #"racket" #"runtime-config.rkt") (collects #"rackunit" #"main.rkt") (collects #"sugar" #"debug.rkt") (collects #"sugar" #"list.rkt") (indirect collects #"racket" #"match" #"gen-match.rkt") (indirect collects #"racket" #"match" #"parse.rkt")) diff --git a/pitfall/binparser/compiled/drracket/main_rkt.zo b/pitfall/binparser/compiled/drracket/main_rkt.zo new file mode 100644 index 0000000000000000000000000000000000000000..8f8a49e5470cb2b4aa8c82568cf0b289b678839f GIT binary patch literal 27278 zcmeHvd3aREm2cm=x4WymwX}rPEzm+=kb9F_y=ZSXgAEuAm|%?Yf^Z{RAfwG%Fp$I% zUa*Y~0`E4)3*NWbvEw-2VgnLj8yqK@%*>bMd6`V!d~YUS#`7jK1K9KC{Z8H6o76(s zPTtEO1G=~CR-HO^>eQ)Ir?xZwI&(u!b4{owe7<5Z7@T;N{&-)1L2GwcTliLN;gP{uU2~m;CF+pUwTrrhotT3@Q=O+%Uy3)zE~GkMPKnvAwIWCv?#m zg6DO{+Pli7;@(*6rg(o)uSP(Fv+ea+ini@#lE*ID?1rM!{H8UGwJ@16CYRf6_^{!h z#e$dBw|vOsNkCUHWnr=`->|`M@cKP=1N{Nkj&FoK-kem}mKL^4CmpZnTU*Lo&bwxy zyFb2Q`Z=58y#d@7bz{u7Ug@&cI75zxALU& zy7Cj{ZP5)&2cT=5t zhIzTU)!c2~VcuolYre<4&-|GAMe`B!hvv`Be>6*cGM~mhyoNXM`Ft(k$hYyE`5k;e zf13Z8|C0ZT|CaxO{}(T?OtaKk7FbqWHdwB)++exe@|5Lu%LkU%8CP{b%0X{0sB1$lsK|E&r{8BL%-JFcrEB?2`zxV&JDzAEO^##?dt6#5vxB8>%6@i(-+k=N0~=z!!S(TV0~>7Ri}ke5SbytA zTlrG`vu&WOwZFZ)3*dT8Pj_#>t$g7+%GuW51w1TCQBUzqrwvsjcDm@P_Qs(&O>m+0T^UH$P5@!myRm7qvF;!@GZSl`CLY^q4$ z+V=j9flcwPeM>|nUgB%c5v^O4G9{>e?f%ukK zYyUFso4BGyNQJ%ezV43A@xc0lo{sj`7*a0m>+fyv+7J}An6p&>>WKBXcLl<85~&0I zZGomaQZbSTTKl7!%o1(Zx3#N3w#7Epu*S$q>(=yc>X!{xT|(+>LJJbXRBU4^wox{4 zYRhn_CUm|QNW?@EF%j8NkXdrLCN!$y!oWVz)dPJWM&g1*P&Qb!U_(u4z8)$!+3h{O z?VG`cAPFu}%#7uxoSYsoG#S%aZZezOx_d=()BJEW60MEaohN?FO`KE1h%^A2Oq;IN z;LazgKyA6nX46LAfMiA>I|x`h_&5rlzJpn4m{P6K#&vMjJzl(!aGQe%{)i zSbtc&1=_y;Ev-7$<)*?y{WH+lx-s4<>QZj9S~al~MVs>TJG)V_6aZ_Ysv)Bw`Fsp{ zw!~0czF2F|U{9=ApfA2i%NAcBXkWi1 z8SdW*30v0R8|&%=BRi3edjAq3$9)@Py#ib+>5OdxdD^#@7tCqx?LJ?t#hfj3<6F8G z07IaoySv9!Tugn;rAe%-Bi^;4f1~TV7+O`xvP-1SbcG{L^9Wul0f!+Os84S&A)(R6 zrfBVaO^XGxw?RW)C>m)LX=8GSLy>4xqseHzE*7{hCQZ&(LO6^f#>pP3i$-cqWo6W@ zUBnL1?;>qb?V=9du@&FrWo?Q^noI=+Bz~^$Hp&P!HW2R{2fj8Ets9Sw+WKg1?OgOe zcib+ou``kcm_co<-Q70CHozvR++g-pZZ!Ga?Q4eE)gJfNcC&|V^0F=;>tU>N6TjCx z#5(K>GkQEs(t@T`(3}eLRM3(NT2nz=Dwsn-djnHgC(Ff?hbJG89ZvzCLOhf36yYhx zlT&sQsqR@E9yx>Pbz5kBmt}xv>V*rL#&InRrXl-c!!3-tTw{q6={VCDlBd{ zGA~~e=8t=8eC}SmY#CyG>{`}d*_Suuvoq#jgN%Kwe-BZ^eD3}sHo!Jl4&?gWo7b>S z?rYbufkL~?{H)jK-YW8M6ZyBZR{wVSfFJ8X_o9kLnNe z19Pf;?&}1?@3HF{DEeNZz*s{VzsCldMpD2%$cA7sf~f7Rz~{amR^)a@_-oj8KKG4G zpty-?IBsG^0!fIFATog^NEt%xMkXlB*U5;4`OuVF_brULR2$;YnCgj2JBzbh2vUI{ zB!h)o(0#jB;x5p!o5M`*!f3{J;xU?8h^^#dorRpHgFn`(BNQkHDF`Z$4-^^x;nXbizLi}-K9Ys`X z5y23DLlIcc(IRR>{1F8Z3VM}jpvouMB+&|W)Cy0e8eZ_IPRIyiNzQzgPqBOf+d!~S zv4rpnx*G&2BGE^Dg+q2WWM%Oo8)7Z2o!*xJbX-}KwbKp{=0D5MEm;SeK9Ipr_|k53fg^Li`TENPM$zo5OZ?e1M4&;~Hu zA&Dagx+dP}b)&K&5?usulKawAj>i-r^?PcZBdoOS2ytU>aKNUljH2Ssw3^PoT)to8#gB+$HT zTh-z`B+>hzWGj33lw-x=L;6=T1?i<_CZo zUrlifo5#*O=~$Uc7HCd826NaHQ)OjWw@X+-uo7Hk)3`9kBhb-75wLptF+D!%IG{M+ zLmeECDhEN5U{$rh=1}G9tk~y%1AYBXR{16~cq-pw(q3rnw;6xTAtS9_}l0Tk}Hp=;h^ z><#Ar3B!Owp9|T7%6AyM2LukvfvAyR=Hi4X^6dE@B?Ebcp$!5b03 zC@o&VV3b^rBCgl!;$zEE1m5oJQN(tcinu{mNG5I+MfgM!TG&rAVQ}9F$QuOYO|nr8 z)i==>HIN_Bc0=LNyp8c**hfQ%TfnSfnv^h=77Vf1sUpx-S9{hB*=-)Qx)+u6p>#j+ zRxx1vmWQ;6rrF)M$YR*v&Fc6QD|xy5R_%K)<5m2DOa1Ph+V@>7#9z9M6zy8%{g$qd zce4P0Xl1}Iw;*yJsaIJGuSfzk^JiCj$(WO+!q$P_-gsAkpuMYSpg%y<>?GJs{=&-U z~kvmBTqUP`i zS10JeXBEF?H80UJVk{6D@1%^kUzVN`QFHjimnAadvx?t#8BYxTAk@zvT*Yqz9SQDu z`LmbsHz|Vn4R$&C{g?1v3UOSAnZ@tBgbyiN>F1#e5DS?lTKO(EgTHy1S41bX)bLv` z;jbpl%H6D*?_bFe7*nF>+9j{Po4ft>HoF-MeqP?_;}4bbHk;>@ka~yg+AWf+`Q)+b zFTJbom0d#`z^p9k$JIS@*(t}@S)R=>vPy-lf}~C-RdqEb-~HCPGzK9U}OJ<4$D+Sp@2G)1*ma(yy-tgt2;B=V~Iu zNXX<7mS_s9&{5cME3||Wg%84TdD;Tz=+y~S``Icqfe;ig1XqJR3|ZD%3Nj7oGoc7) zqByEcDo~uzQJk0vMZJ#V^zuFRywRT$MlZ;K@QA;YjyKJTh94FU??b~6>kU7mNtnlZ zSTFP_^PGul7=ohWqP|{@1CJFu-)Cr}@!1tg&*e+<=mhhfDOZ;2olyL!6#aMIujwgX zl2A0Y4g94k{6e9q9?_8_nfPP9qr`i3o^QV&YBP5ZQI;Ln<07Vi+STxQ7GxZkgl~LH@)Hn|pgIGZz zHBLHt?=z3ieo}KOvX3)OU-_Uu(&Im5J^}9s-~(TmU`>L*;&3|Q@b+kOcvCWl zH}Efgc%#vF3`=#DnAUGH2Dk%qmI3ao+5;0*VEp8tX~XwJvh!z>^XH257n1X@&?m_D zAZr4ZIU(uxg%==N{nD$P7`|z)DMk(G>tnj=JVwgqOO_PAqJ7wF)>hm%gV21>X;UJc1u-I|b&gvvk^WExox9b))<_g&Wu z8r{v==>GmUp!+m?;jE|t2``?3gqOY%2``={31HXdupGtm61Dm)AFRK0YqzS_4^uV> zvv!3Lk1O<1Il!GXEECH;Fr+Imr(5cndH9s_|#CD+Sm;P)%vh~F=tCBI!iJOc@@ej^fo zc$OrHX1oom;wIScSCKZ-W&_2hsZ$fX@rm8Rn5z>@2<<%`aoRF#(%>~CO|Rs^~+jYTSiGuU`$Jgk}Vy|-qN*+mi}R~rIVCE^So+79Wgl* zlwv&@A`|3Oe0bMG99inKfj*G|bEzYYO;5lt-xFx`dM2iE^ubH% z3vX2D9V0Ly{~_rl9z9|-d z0iZ>55OG+7AP9*NO9*GlcO&EK>oS_0G%E2O61YP-?1!SIZga>YBoajpv$-_L9Xe?H z@0R(0)-rEpw2bKWwBbaZ9UDrbvy-8kt&3vWK@$dj^`tu4PmgMy-5>TJqQxMgC15OR z3rHgvs*`;?wSaU)8aagC>=RPeLe`kKo=F zp=rnnRuL?krA;*yrZ$aVqO#d2JT?J^A0$c`rv@KRkp8nox}Xq~K#fAfqhBn87laBUNjvw0@q!a6+d^!dbA%313GODk@7}CZs<@Yqt zw0>ezZ^j}nth84lH!u#lk4Cfq#1<-+)@?S&A}dlI&zlhwOvZdbF|M6jv+~k}rQQ?Z z_s`2eYMPC{n#GX-lzbo7y&*}Oqy|V*k1@z)Bq^5(New4s-e-_hTTV)y3lUsP z`sx^&Y2bsV)Kc1P7#&Y&vqY|hLXS~AmJW`rSl)Gz(RIm!_&SczsgmHRvA8 zIW3XMI8)*W>=e6GaiRx62cvtVXxBYjxidw%_l`eAB#PI$DM-ks_BFWo(S~OpNJhb( zV)y8S!{vMY*oX0ZXv+h3J=)Ox|r{ht)Fs}x|jHcnZPl&YOU6e#MV+Wwu7X})*;J{wCy=~5ihrX!qqz{ z164s7_=1TDuO;*Eh(sL=8t$0TaDso>{X3CpP(Y#K4kw^Qheof zF7fYC@mIjKNDSjNVqJx?)TY@$qII!Wb(qF-6i(Zk!iXMsuEHl%OYzSQw`01pV=^C9 zz|J+GVzZy`KbPNHpv_qBqX7qK$=q45Yb(LkjIQ%_)zkyy>Xn)dy;8%me}Nq}l>8T` zS02{-cZ2BPk9-5Ya*91nhmBII<7_)Bc=M<4s1JU%j=KM=cGQP5I;yBUWL9*P3A)W` z8fRSo@jK6>#Kw~}V4T1d|LaUAQ$6Em^b9_xXV9EdoDBQ3^^C{Qx@XJ~J>!&Pr*hZ_ z`++)VwmI!zWZ!uxEch2*HLK@9IP|u18=vzKx86cUJH+>!(aoUr{uxQn02rvF;eQE4cXyO2)?(2@6~^ z`70~9-};$iWaR_^3?CLfO-RCL3IaX`RdJ#+0|PaD^Pbb zR;b>_SXdomY?8W%u_ARZW5wznj5*Xh8FQ+4F;=49&Ddo19>%7q_c2zg-p^Q>`T%3) z>ORIQ)CU=xs_tjZr9Q-%sy@uvH1!dzMyrqF+K769v2)bN7;~$SGghlU$ymMmGz=;2 z(yjUoYf4_bt+viZNz{q^MQk|-S~$uU_LteUDOr7Hkw>m05DzNsT#IaFn%5#zT9dXQ4n6xz8=Rg z+xxfrhs~^>RZ-Td;?Q_^4_$?fbe`msNl`v$-?Yqg^q>HO!s} zn>`G!v#Ax#A{C3{ncV~ZJvips->uivKkQ&-6>O$#F!$le6)t+)M$*1<2d{Rxlt?Mj zFZYc{Lqpy0T7sKA1^~AUak;CtKLA8@C62B$2^t$0iVKU#(B~h8Hmq8JXpF2EbWT*572q$xuIxycrgo9usMswvGAxk@>xTGbM#APfxh0>j_y`q zHM3e4WVw)m3t~Mz@vikaecc1DNE9O)mac-fqIJ*3HE*AGPkS=15s~;zf&dlc#zqMw zrW6+|%5g<#Dnv@f%?CG5?^dw@kcUx3JGq?bFDRqjnRgNhG<>r6Ip#0la4Db76BX>2e>g@ z8?CSZM8?^BPqjCYyt7`8%VPRb^%QE>Bu&$<-NifF0uAt^?9bgz|`+E^+l$>#B88n!Ab&dT0mcUfM;o|WCo0*F6M3U@Tbg}jM~7|J7weuiyS(jSdUjR`ZzuO85@64fZau4 zbpnj$1i%=krGd!+!%D=>c77Y3qPUx&>eHbj1XT_ww};;~iNC`Dbq_%`XhqU_Wo?%1 z@$hp2OXrpYxGm-2H^?^cry+xSFM;EXWTGzKnPe3BG;k-tt3CW~2gHY}a~}aW>ecah zXQJBhDFM9s0E~F}jw$?Fg4;)M%{m;6ggOEg{3!t-81zml-@yp-S%QotF#5O?r4OFV z2W2e4Fd)7Z@N+_ZP~|t72>u6x+$Nn|kT43q81OT|vI?x<5d4n_er5u{zb>`C*#zu< zKriv|eO|sdhoFBfu$Lsk8#2KgMuEQ}z{>>qmt=xeh$$VKFJfbtf2_WVO@5C*6UjK& zX&a)UH00J#jOyF6=+|V>gs~;77>FH88juY@?+6OY1qHg~2$`q=T#JW)zm6|~NL;Ug z34E$vEs%!=Ei}j=wOlD6V;=riJ#Qrr+$2ENB&cRg1<6F53dp#JKiY^h_XK*20G*Zu z^)->*rLUWn0eGW_zue3p5Wu$z;L0Sh7v`BlZOjKzpHCZ^DJqfkC3@`T2svZ5ICg7TlafTGNJ_r1 z=u#5$!i2_Z*dQ17d|n2nM)hSuN>US@;|o&dsTIr^n!S7{^YGWd#RrH{KN7GJ?|Nor zCT3O2aIC z{yNRy%sldv^Ua;kw2*1O7F_~AOu^l25kWRZR@XDeKacAfBep;?T+j3_y>i>&-#_&1 z;=La{`p>po)VikSFTRjsNTH#`P-bu$LWbFfrH0E4ordj(y@p2(KQO#yIA|C#oG|>g z;a7%#F#K-=mz>fpX_0h=6q7bf+obEH+oZ>(cctG*|0d<3H&(J)Y(5sKH{dGpO}N#2 zkd3et>}Twk>@#MQi{&!8(Kyez*!V5u{l-U(uNsdTe{KAOQ8E>oJf<2`)U?#J&eUf5 zu4%hzpXp)K>!!C&e`ESJ+{m0Z6`8Bd^UQ0_+swmo9P_35e0~M*GS=$?@f! zn{#PSf6l!*zs)h^PS3qMcYE%>+@IwBGWVZz3-f$==jCYKB>T8u&`iN!Q%x73qC5CTo@``TzDBgB>f*(nwu38 zuY|7^I3t?7F4jvo^UGV#hn>;cz23xFO${U_;TeToR*dntlIBlkjNg;9^o26o1&e`0vCdJ>LEt*0tv|lLCY0`pgDNfN z4)$`~6cNU#_$(Rim?J$?(pd*j^T9Ete5rmL5;Fz(Gl8!e?TT1=7FQTk<^ssb=FVFz ziVVcB8Hjbvk(?Pf-U9m7xB6ybg9b*17PoU{gb3~3q%VME<`2~EqoF{#n7 z?un_aQ4U9H#{qAQ7)?m6t8W+&pvh>~02;@EXlgLXp_)3QG}j%X%Z}s>0>Z}>1WAh~ z?mU`?FfWSW#$!F*cr<%hvzN{Cu{likRECWncVvjwu3>eRwUVc@&fs&`+hq@H5Z<*a z8%(%i$uMj&yYTRk1AROL6S5hYlFh)RYzC%fGcYlm;cgsa4OCE*yJ?6uvq)t#BTo|; zp_%ST0>Mm&LxfR-(EUpgM8bbb((6zXD%pF4`=Mks(>+p9=5#kiNq}TNl5*j*!rqYZ zhs2@@|3oY*JQT5LhL0i^9p$BnMKLTzSq`3D7ESsd!e<_fraTS-jSvCd=Ma+f36*g0 zGh25U#G>iGhFCPaw;^N`GjqH&e?y4K^f*L0scL~yK8FC9T$~VIhgfuJZ>HZN79Hbx z2-vdt9%9jie<98L5Kv*(iA&$Xg#V!wgyw+=c(VH-Vo`S#H-I4}5;M7HAlS%ex@Xd- zQaMXpFP<%gMmXpYL0pK2pdgs;zbF~WEabpLq(c@oUmmlEFjPe<=P2TW@EjH)j0s;J zGK4sU39*CkgCB>dukdR=1GK1T5w*8X_}(bgp&mfgk1rQclk}(qhDOS@?xsUxY#17UWALsp4!SK=Cq_GY=KC7i23IyyeNu=J=%3ouZD>XM98ci$p6%M)5L6?2SnDlzbiv}FF%rP;h!(mtA5Dm7}>#)mRgM zDnB(U>SdUhBkOn+oO4DBw8H(O@Tx3@f3BR18R+y+6idQ|!!q@{BF{49vl7d$0111z7K_vVb2=UpNjYx=3`M4a&BDROFGwYZsI<^bdg-CF zmhPY~-Phx)T%y-EP_IvD#~bKO%o)^U)mhOpk;pgdB7aj>G9dFi=p^%a3_P>YpP5a6 zF*qSUdUFP;5rfp6iBR!X96p|o^E&?O-wJ|@vP)5x=<%fp9)w6IXj1zn$x)aJ4pYGy zp|chyEE;RN^3JqoY)qG?yC#sPz*nJZBBA2v>QZ%2R&pR!_a>z(E9WLwLKCoUytbN1 zV9D6|bD-8$lt7(O6)B}5LeN;o^RRLe2=lP`t>ty%7Y+^1!?LlH=_2=dS{rAWEl*4!a=|erPbgP|xUDJ-m#4B83c-3hDOg## za3;Y@v0!g>)VY8(f7eX0=P{#tE;jz>V&8urcKpx7hX484z8f7TA0=o3d9#71nm89SEcEvy{w!i5XgZMKWn z^~PhH0yu4e^48Nl-Uiw#E+Wrq`cf6#0e7$88W_gWhYGMO-Vw(xy}pVS?CK5(41IxN z2Z~Dbw`&`jg4t|wS|r@^28Jh#h=fmHoE)%?;P3@9CZg&I$|<(h3+!g~LUpNnk@_w5 zV)YW6?jhX_ylFe{HISC3bfl)UUplqE+K23u7&5GFF83PkXF*CAJ?;b;a8&TxV zM*UdW4Fu~;qrNx`^*Uib+Q!RF2k}>D5MPxQrW2)Li#92XjvXe*;3yFqO&n9Z^c9Ed zMsFz$s2a@rN0@$%l}u;aGM)aJ8KXcqY*tv$`l3T>R5F{?9!$w5D$1x{qZbv_iV9~h z%8H_T$0^EcQv0Z=iORC5{d!roVlAUiU&|1eb5pg-l@)aWRl;O}#2*{P+WNpJx$0)> zy%FlY5z%`iUcL7+R||tnN&I=3i@I)es_QZrT^#s8vL;&r{x7K=yrT)8HcFrr^;(_a z8bNR{JHZ?TZ_x-Iv-ZP{>Q=CAqLO5Fn_f~tltc|aoTb50(znMc$!t`=LnTdI)OXLe zsOwU#KsrOr*FG_;-=kKjrdFsHtx)Ytw1T&V6^cI(^HM9+rnQ1M(F$W#sBaYC4eB7S zwRmvhC5yft3%p$bSEY63N#k|pYsGGVW-@y6jZo^OMn!kOwvl@B7?_(yDU(O_W&db) zk0y_)x6o}nT0We(Gv7)k9hk0*QEHNm-njLohWX?E{!$mWS^!pMVd6_;t=WRPVG;KlfQ*c5`P}%AKj__D(>d`zOO(4T@+Orm@ z2Qr&DHBW{>?aL-mqf0a5wC-68)c)~GgFro$RiH)}XTfP;y|@Vl>X9^oO7;{C5|54% zsH%iORkyGr@#kUHqXnvZe1Qs#5vT*A?P{_K)L7uh1aL4-pbEwlsGFgI7)eVe1Vrk| zbde%3B`er7qO8(ULKPe>RHKPxI7WKbLiJo`GiTTw&x>X*zRC(Cp89o=hKZmUCW6&^ gGqkV*8mEJpxCl6EiH6ijp|t}Yc`-A)IDzti0mQ;kGynhq literal 0 HcmV?d00001 diff --git a/pitfall/binparser/gif-parse.rkt b/pitfall/binparser/gif-parse.rkt new file mode 100644 index 00000000..5d7f66e2 --- /dev/null +++ b/pitfall/binparser/gif-parse.rkt @@ -0,0 +1,39 @@ +#lang br +(require pitfall/binprint binparser) + +;; http://www.matthewflickinger.com/lab/whatsinagif/bits_and_bytes.asp + + +(define-rule gif (:seq signature version logical-screen-descriptor #:type hash?)) +(define-rule signature (:atomic 3 #:type string/ascii?)) +(define-rule version (:atomic 3 #:type string/ascii?)) + +(define-rule logical-screen-descriptor (:seq width height lsd-flags bgcolor-idx aspect #:type hash?)) +(define-rule width (:atomic 2 #:type integer?)) +(define-rule height (:atomic 2 #:type integer?)) +(define-rule lsd-flags (:seq reserved disposal user-input transparent #:type hash?)) +(define-rule reserved (:atomic .3)) +(define-rule disposal (:atomic .3)) +(define-rule user-input (:atomic .1)) +(define-rule transparent (:atomic .1)) +(define-rule bgcolor-idx (:atomic 1 #:type integer?)) +(define-rule aspect (:atomic 1 #:type integer?)) + + + +(gif (open-input-file "test.gif")) + + +#;(check-equal? (gif (gif (open-input-file "test.gif"))) (read-bytes 13 (open-input-file "test.gif"))) + + + + + + +(require rackunit) +#;(check-equal? (parse-with-template "test.gif" gif) + (cons 'gif + (make-hasheq (list (cons 'logical-screen-descriptor '(162 162 (#f #t #f #f #f #t #f #t) 0 0)) + '(signature . "GIF") + '(version . "87a"))))) diff --git a/pitfall/pitfall/binparser/giflexer.rkt b/pitfall/binparser/giflexer.rkt similarity index 100% rename from pitfall/pitfall/binparser/giflexer.rkt rename to pitfall/binparser/giflexer.rkt diff --git a/pitfall/pitfall/binparser/gifparser.rkt b/pitfall/binparser/gifparser.rkt similarity index 100% rename from pitfall/pitfall/binparser/gifparser.rkt rename to pitfall/binparser/gifparser.rkt diff --git a/pitfall/binparser/main.rkt b/pitfall/binparser/main.rkt new file mode 100644 index 00000000..9a5c7563 --- /dev/null +++ b/pitfall/binparser/main.rkt @@ -0,0 +1,172 @@ +#lang sugar/debug racket/base +(require sugar/debug) +(require (for-syntax racket/base br/syntax)) +(require racket/match racket/function racket/port br/define sugar/list racket/list) +(provide define-rule :atomic :seq :repeat string/utf-8? string/latin-1? string/ascii? bitfield?) + +(define string/utf-8? #t) +(define string/latin-1? 'string/latin-1?) +(define string/ascii? 'string/ascii?) +(define bitfield? 'bitfield?) + +(struct binary-problem (msg val) #:transparent) + +(define bitfield #f) +(define (read-bits-exact count p) + (define bitcount (inexact->exact (* 10 count))) + (unless (pair? bitfield) + (set! bitfield (bytes->bitfield (read-bytes 1 p)))) + (define-values (bits rest) (split-at bitfield bitcount)) + (set! bitfield rest) + bits) + +(define (read-bytes-exact count p) + (cond + [(integer? count) + (define bs (read-bytes count p)) + (unless (and (bytes? bs) (= (bytes-length bs) count)) + (raise (binary-problem (format "byte string length ~a" count) bs))) + bs] + [else (read-bits-exact count p)])) + +(define (bytes->integer len x) + (when (< (bytes-length x) len) (raise-argument-error 'bytes->integer "too short" x)) + (cond + [(= len 1) (bytes-ref x 0)] + [else (integer-bytes->integer x #f #f)])) + +(define (integer->bytes len x) + (case len + [(1) (bytes x)] + [(2 4 8) (integer->integer-bytes x len #f #f)] + [else (raise-argument-error 'integer->bytes "byte length 1 2 4 8" len)])) + +(define (bytes->ascii bs) + (list->string (for/list ([b (in-bytes bs)]) + (if (< b 128) + (integer->char b) + (raise (binary-problem "ascii byte < 128" b)))))) + +(define (ascii->bytes str) + (apply bytes (for/list ([c (in-string str)]) + (char->integer c)))) + +(define (bytes->bitfield bs) + (for*/list ([b (in-bytes bs)] + [idx (in-range 8)]) + (bitwise-bit-set? b idx))) + +(define (bitfield->bytes bf) + (unless (zero? (modulo (length bf) 8)) + (raise-argument-error 'bitfield->bytes "bitfield length a multiple of 8" (length bf))) + (apply bytes + (let loop ([bf bf][acc null]) + (if (null? bf) + (reverse acc) + (let-values ([(bits rest) (split-at bf 8)]) + (loop rest (cons (for/sum ([b (in-list bits)] + [pow (in-range 8)] + #:when b) + (expt 2 pow)) acc))))))) + +(module+ test + (check-equal? (bitfield->bytes (bytes->bitfield #"AB")) #"AB")) + + +(define (:atomic count #:type [type #f]) + (procedure-rename + (λ (x) + (define-values (input-proc output-proc) + (cond + [(equal? type integer?) (values (curry bytes->integer count) + (curry integer->bytes count))] + [(equal? type string/ascii?) (values bytes->ascii ascii->bytes)] + [(equal? type bitfield?) (values bytes->bitfield bitfield->bytes)] + [else (values identity identity)])) + + (if (input-port? x) + (input-proc (read-bytes-exact count x)) + (let ([result (output-proc x)]) + (unless (and (bytes? result) (= (bytes-length result) count)) + (raise (binary-problem (format "byte string length ~a" count) result))) + result))) (gensym 'atomic-))) + +(define (list->hash-with-keys keys vals) + (make-hash (map cons keys vals))) + +(define (hash->list-with-keys keys h) + (for/list ([k (in-list keys)]) + (hash-ref h k))) + +(define (procedure-name proc) + (string->symbol (cadr (regexp-match #rx"^#$" (with-output-to-string (λ () (display proc))))))) + +(define (hash-has-keys? h keys) + (define (sortation xs) (sort xs #:key symbol->string stringsymbol (format "~a-~a" x idx))))) + +(define (:seq #:type [type #f] . rule-procs) + (procedure-rename + (λ (x) (define-values (input-proc output-proc output-check) + (cond + [(equal? type hash?) + (define rule-proc-names (resolve-duplicates (map procedure-name rule-procs))) + (values (curry list->hash-with-keys rule-proc-names) + (curry hash->list-with-keys rule-proc-names) + (λ (x) + (unless (and (hash? x) (hash-has-keys? x rule-proc-names)) + (raise (binary-problem (format "hash with ~a keys, namely ~a" (length rule-procs) rule-proc-names) x)))))] + [else (values identity identity + (λ (x) + (unless (and (list? x) (= (length rule-procs) (length x))) + (raise (binary-problem (format "list of ~a values" (length rule-procs)) x)))))])) + (match x + [(? input-port? p) (input-proc (map (λ (rule-proc) (rule-proc p)) rule-procs))] + [else + (output-check x) + (apply bytes-append (map (λ (rp xi) (rp xi)) rule-procs (output-proc x)))])) (gensym 'seq))) + + +(define (:repeat count . rule-procs) + (λ (p) (append-map (λ (i) (map (λ (r-p) (r-p p) rule-procs))) (range count)))) + +(define-macro (define-rule ID RULE-PROC) + #'(define (ID [x (current-input-port)]) + (with-handlers ([binary-problem? (λ (exn) + (raise-result-error + 'ID + (binary-problem-msg exn) + (binary-problem-val exn)))]) + (RULE-PROC x)))) + + +(module+ test + (require rackunit) + + (define-rule foo (:seq bar zam #:type hash?)) + (define-rule bar (:atomic 1 #:type integer?)) + (define-rule zam (:atomic 2 #:type integer?)) + + (check-equal? #"AB" (zam (zam (open-input-bytes #"AB"))) (zam 16961)) + (check-equal? #"123" (foo (foo (open-input-bytes #"123"))) (foo '#hash((bar . 49) (zam . 13106)))) + + + (define-rule foolist (:seq bar zam bar zam)) + (check-equal? #"123456" (foolist (foolist (open-input-bytes #"123456"))) (foolist '(49 13106 52 13877))) + + (define-rule hashrule (:seq bar zam bar zam bar #:type hash?)) + (check-equal? #"1234567" (hashrule (hashrule (open-input-bytes #"1234567"))) + (hashrule '#hash((zam-4 . 13877) (bar-3 . 52) (zam-2 . 13106) (bar-1 . 49) (bar-5 . 55)))) + + + (define-rule flag (:atomic .4)) + (check-equal? (flag (open-input-bytes #"A")) '(#t #f #f #f)) + ) \ No newline at end of file diff --git a/pitfall/pitfall/binparser/prototype-binparser.rkt b/pitfall/binparser/prototype-binparser.rkt similarity index 100% rename from pitfall/pitfall/binparser/prototype-binparser.rkt rename to pitfall/binparser/prototype-binparser.rkt diff --git a/pitfall/pitfall/binparser/test.gif b/pitfall/binparser/test.gif similarity index 100% rename from pitfall/pitfall/binparser/test.gif rename to pitfall/binparser/test.gif diff --git a/pitfall/pitfall/binparser/gif-parse.rkt b/pitfall/pitfall/binparser/gif-parse.rkt deleted file mode 100644 index d375eab3..00000000 --- a/pitfall/pitfall/binparser/gif-parse.rkt +++ /dev/null @@ -1,151 +0,0 @@ -#lang br -(require "../binprint.rkt" racket/file) - -;; http://www.matthewflickinger.com/lab/whatsinagif/bits_and_bytes.asp - -(define unparse-val (make-parameter #f)) - -(struct binary-problem (msg val) #:transparent) - -(define (read-bytes-exact count p) - (define bs (read-bytes count p)) - (unless (and (bytes? bs) (= (bytes-length bs) count)) - (raise (binary-problem (format "byte string length ~a" count) bs))) - bs) - - - -(define (seq->hash xs) (make-hasheq xs)) - -(define (seq->list xs) (map cdr xs)) - - - - - -(define-macro (:bidi X) #'X) - -(define (val->hash x) - (if (unparse-val) - (report (car (map cdr (hash->list x)))) - (make-hasheq (list x)))) - -(define (bytes->integer len x) - (when (< (bytes-length x) len) (raise-argument-error 'bytes->integer "too short" x)) - (cond - [(= len 1) (bytes-ref x 0)] - [else (integer-bytes->integer x #f #f)])) - -(define (integer->bytes len x) - (cond - [(= len 1) (bytes x)] - [else (integer->integer-bytes x len #f #f)])) - -(define (bytes->bitfield bs) - (for*/list ([b (in-bytes bs)] - [idx (in-range 8)]) - (bitwise-bit-set? b idx))) - -(define (bytes->string bs) - (bytes->string/latin-1 bs)) - -#| -(define-rule gif (:seq signature version logical-screen-descriptor (:bidi seq->hash))) -(define-rule signature (:atomic 3 (:bidi bytes->string))) -(define-rule version (:atomic 3 (:bidi bytes->string))) - - -(define-rule logical-screen-descriptor (:seq width height packed bgcolor-idx aspect (:bidi seq->list))) -(define-rule width (:atomic 2 (:bidi bytes->int))) -(define-rule height (:atomic 2 (:bidi bytes->int))) -(define-rule packed (:atomic 1 (:bidi bytes->bitfield))) -(define-rule bgcolor-idx (:atomic 1 (:bidi bytes->int))) -(define-rule aspect (:atomic 1 (:bidi bytes->int))) -|# - -(define (:atomic count #:type [type #f]) - (λ (x) - (define-values (input-proc output-proc) - (match type - [integer? - (values (curry bytes->integer count) - (curry integer->bytes count))] - [else (values identity identity)])) - (if (input-port? x) - (input-proc (read-bytes-exact count x)) - (let ([result (output-proc x)]) - (unless (and (bytes? result) (= (bytes-length result) count)) - (raise (binary-problem (format "byte string length ~a" count) result))) - result)))) - - -(define (list->hash-with-keys keys vals) - (make-hash (map cons keys vals))) - -(define (hash->list-with-keys keys h) - (for/list ([k (in-list keys)]) - (hash-ref h k))) - -(define (procedure-name proc) - (string->symbol (cadr (regexp-match #rx"^#$" (with-output-to-string (λ () (display proc))))))) - -(define (hash-has-keys? h keys) - (define (sortation xs) (sort xs #:key symbol->string stringhash-with-keys rule-proc-names) - (curry hash->list-with-keys rule-proc-names) - (λ (x) - (unless (and (hash? x) (hash-has-keys? x rule-proc-names)) - (raise (binary-problem (format "hash with ~a keys, namely ~a" (length rule-procs) rule-proc-names) x)))))] - [else (values identity identity - (λ (x) - (unless (and (list? x) (= (length rule-procs) (length x))) - (raise (binary-problem (format "list of ~a values" (length rule-procs)) x)))))])) - (match x - [(? input-port? p) (input-proc (map (λ (rule-proc) (rule-proc p)) rule-procs))] - [else - (output-check x) - (apply bytes-append (map (λ (rp xi) (rp xi)) rule-procs (output-proc x)))]))) - -(define-macro-cases :repeat - [(_ COUNT RULE-PROC ...) #'(λ (p) (append-map (λ (i) (list (RULE-PROC p) ...)) (range COUNT)))]) - -(define-macro-cases define-rule - [(_ ID RULE-PROC) - (with-pattern ([ID$ (suffix-id #'ID "$")]) - #'(begin - (define (ID [x (current-input-port)]) - (with-handlers ([binary-problem? (λ (exn) - (raise-result-error - 'ID - (binary-problem-msg exn) - (binary-problem-val exn)))]) - (RULE-PROC x))) - (struct ID$ (val) #:transparent)))]) - -(define-rule foo (:seq bar zam #:type hash?)) -(define-rule bar (:atomic 1 #:type integer?)) -(define-rule zam (:atomic 2 #:type integer?)) - -(define-rule foolist (:seq bar zam bar zam)) - -(check-equal? #"AB" (zam (zam (open-input-bytes #"AB"))) (zam 16961)) -(check-equal? #"123" (foo (foo (open-input-bytes #"123"))) (foo '#hash((bar . 49) (zam . 13106)))) - -(foolist (open-input-bytes #"123456")) -(foolist '(49 13106 52 13877)) - -(require rackunit) -#;(check-equal? (parse-with-template "test.gif" gif) - (cons 'gif - (make-hasheq (list (cons 'logical-screen-descriptor '(162 162 (#f #t #f #f #f #t #f #t) 0 0)) - '(signature . "GIF") - '(version . "87a"))))) - -#;(define parse-width-bytes (make-byte-parser width)) \ No newline at end of file