head 1.306; access; symbols; locks strick:1.306; strict; comment @# @; 1.306 date 2011.09.26.08.28.49; author strick; state Exp; branches; next 1.305; 1.305 date 2011.09.26.08.27.39; author strick; state Exp; branches; next 1.304; 1.304 date 2011.09.26.08.19.55; author strick; state Exp; branches; next 1.303; 1.303 date 2011.09.26.08.18.32; author strick; state Exp; branches; next 1.302; 1.302 date 2011.09.26.08.12.24; author strick; state Exp; branches; next 1.301; 1.301 date 2011.09.26.08.02.52; author strick; state Exp; branches; next 1.300; 1.300 date 2011.09.26.08.02.07; author strick; state Exp; branches; next 1.299; 1.299 date 2011.09.26.08.00.37; author strick; state Exp; branches; next 1.298; 1.298 date 2011.09.26.07.56.11; author strick; state Exp; branches; next 1.297; 1.297 date 2011.09.26.07.55.37; author strick; state Exp; branches; next 1.296; 1.296 date 2011.09.26.07.53.43; author strick; state Exp; branches; next 1.295; 1.295 date 2011.09.26.07.50.49; author strick; state Exp; branches; next 1.294; 1.294 date 2011.09.26.07.50.08; author strick; state Exp; branches; next 1.293; 1.293 date 2011.09.26.07.49.30; author strick; state Exp; branches; next 1.292; 1.292 date 2011.09.26.07.45.02; author strick; state Exp; branches; next 1.291; 1.291 date 2011.09.26.07.44.24; author strick; state Exp; branches; next 1.290; 1.290 date 2011.09.26.07.44.11; author strick; state Exp; branches; next 1.289; 1.289 date 2011.09.26.07.39.46; author strick; state Exp; branches; next 1.288; 1.288 date 2011.09.26.07.36.23; author strick; state Exp; branches; next 1.287; 1.287 date 2011.09.26.07.30.38; author strick; state Exp; branches; next 1.286; 1.286 date 2011.09.26.07.28.48; author strick; state Exp; branches; next 1.285; 1.285 date 2011.09.26.07.27.57; author strick; state Exp; branches; next 1.284; 1.284 date 2011.09.26.07.24.42; author strick; state Exp; branches; next 1.283; 1.283 date 2011.09.26.07.23.40; author strick; state Exp; branches; next 1.282; 1.282 date 2011.09.26.07.16.06; author strick; state Exp; branches; next 1.281; 1.281 date 2011.09.26.07.02.21; author strick; state Exp; branches; next 1.280; 1.280 date 2011.09.26.06.46.58; author strick; state Exp; branches; next 1.279; 1.279 date 2011.09.26.06.31.49; author strick; state Exp; branches; next 1.278; 1.278 date 2011.09.26.06.31.36; author strick; state Exp; branches; next 1.277; 1.277 date 2011.09.26.06.29.18; author strick; state Exp; branches; next 1.276; 1.276 date 2011.09.26.06.24.13; author strick; state Exp; branches; next 1.275; 1.275 date 2011.09.26.06.23.33; author strick; state Exp; branches; next 1.274; 1.274 date 2011.09.26.06.20.51; author strick; state Exp; branches; next 1.273; 1.273 date 2011.09.26.06.14.47; author strick; state Exp; branches; next 1.272; 1.272 date 2011.09.26.06.14.09; author strick; state Exp; branches; next 1.271; 1.271 date 2011.09.26.06.13.50; author strick; state Exp; branches; next 1.270; 1.270 date 2011.09.26.06.13.14; author strick; state Exp; branches; next 1.269; 1.269 date 2011.09.26.06.10.59; author strick; state Exp; branches; next 1.268; 1.268 date 2011.09.26.06.10.26; author strick; state Exp; branches; next 1.267; 1.267 date 2011.09.26.06.06.58; author strick; state Exp; branches; next 1.266; 1.266 date 2011.09.26.06.04.04; author strick; state Exp; branches; next 1.265; 1.265 date 2011.09.26.06.03.30; author strick; state Exp; branches; next 1.264; 1.264 date 2011.09.26.06.01.04; author strick; state Exp; branches; next 1.263; 1.263 date 2011.09.26.06.00.17; author strick; state Exp; branches; next 1.262; 1.262 date 2011.09.26.06.00.07; author strick; state Exp; branches; next 1.261; 1.261 date 2011.09.26.05.59.55; author strick; state Exp; branches; next 1.260; 1.260 date 2011.09.26.05.37.09; author strick; state Exp; branches; next 1.259; 1.259 date 2011.09.26.05.35.27; author strick; state Exp; branches; next 1.258; 1.258 date 2011.09.26.05.32.10; author strick; state Exp; branches; next 1.257; 1.257 date 2011.09.26.05.31.59; author strick; state Exp; branches; next 1.256; 1.256 date 2011.09.26.05.31.18; author strick; state Exp; branches; next 1.255; 1.255 date 2011.09.26.05.30.42; author strick; state Exp; branches; next 1.254; 1.254 date 2011.09.26.05.29.50; author strick; state Exp; branches; next 1.253; 1.253 date 2011.09.26.05.29.11; author strick; state Exp; branches; next 1.252; 1.252 date 2011.09.26.05.28.40; author strick; state Exp; branches; next 1.251; 1.251 date 2011.09.26.05.28.18; author strick; state Exp; branches; next 1.250; 1.250 date 2011.09.26.05.25.46; author strick; state Exp; branches; next 1.249; 1.249 date 2011.09.26.05.20.48; author strick; state Exp; branches; next 1.248; 1.248 date 2011.09.26.05.19.56; author strick; state Exp; branches; next 1.247; 1.247 date 2011.09.26.05.19.31; author strick; state Exp; branches; next 1.246; 1.246 date 2011.09.26.05.17.18; author strick; state Exp; branches; next 1.245; 1.245 date 2011.09.26.05.16.12; author strick; state Exp; branches; next 1.244; 1.244 date 2011.09.26.05.14.15; author strick; state Exp; branches; next 1.243; 1.243 date 2011.09.26.05.14.06; author strick; state Exp; branches; next 1.242; 1.242 date 2011.09.26.05.13.22; author strick; state Exp; branches; next 1.241; 1.241 date 2011.09.26.05.13.19; author strick; state Exp; branches; next 1.240; 1.240 date 2011.09.26.05.12.44; author strick; state Exp; branches; next 1.239; 1.239 date 2011.09.26.05.03.45; author strick; state Exp; branches; next 1.238; 1.238 date 2011.09.26.05.03.31; author strick; state Exp; branches; next 1.237; 1.237 date 2011.09.26.05.02.12; author strick; state Exp; branches; next 1.236; 1.236 date 2011.09.26.04.59.34; author strick; state Exp; branches; next 1.235; 1.235 date 2011.09.26.04.55.48; author strick; state Exp; branches; next 1.234; 1.234 date 2011.09.26.04.28.50; author strick; state Exp; branches; next 1.233; 1.233 date 2011.09.26.04.28.35; author strick; state Exp; branches; next 1.232; 1.232 date 2011.09.26.04.28.16; author strick; state Exp; branches; next 1.231; 1.231 date 2011.09.26.04.28.11; author strick; state Exp; branches; next 1.230; 1.230 date 2011.09.26.04.27.57; author strick; state Exp; branches; next 1.229; 1.229 date 2011.09.26.04.27.39; author strick; state Exp; branches; next 1.228; 1.228 date 2011.09.25.08.41.41; author strick; state Exp; branches; next 1.227; 1.227 date 2011.09.25.08.39.52; author strick; state Exp; branches; next 1.226; 1.226 date 2011.09.25.08.36.47; author strick; state Exp; branches; next 1.225; 1.225 date 2011.09.25.08.32.29; author strick; state Exp; branches; next 1.224; 1.224 date 2011.09.25.08.22.20; author strick; state Exp; branches; next 1.223; 1.223 date 2011.09.25.08.16.04; author strick; state Exp; branches; next 1.222; 1.222 date 2011.09.25.08.14.14; author strick; state Exp; branches; next 1.221; 1.221 date 2011.09.25.08.11.37; author strick; state Exp; branches; next 1.220; 1.220 date 2011.09.25.08.11.20; author strick; state Exp; branches; next 1.219; 1.219 date 2011.09.25.08.10.50; author strick; state Exp; branches; next 1.218; 1.218 date 2011.09.25.08.03.10; author strick; state Exp; branches; next 1.217; 1.217 date 2011.09.25.07.53.16; author strick; state Exp; branches; next 1.216; 1.216 date 2011.09.25.07.40.13; author strick; state Exp; branches; next 1.215; 1.215 date 2011.09.25.07.39.38; author strick; state Exp; branches; next 1.214; 1.214 date 2011.09.25.07.38.51; author strick; state Exp; branches; next 1.213; 1.213 date 2011.09.25.07.29.25; author strick; state Exp; branches; next 1.212; 1.212 date 2011.09.25.07.19.15; author strick; state Exp; branches; next 1.211; 1.211 date 2011.09.25.07.19.10; author strick; state Exp; branches; next 1.210; 1.210 date 2011.09.25.07.18.59; author strick; state Exp; branches; next 1.209; 1.209 date 2011.09.25.07.18.08; author strick; state Exp; branches; next 1.208; 1.208 date 2011.09.25.07.16.55; author strick; state Exp; branches; next 1.207; 1.207 date 2011.09.25.07.01.10; author strick; state Exp; branches; next 1.206; 1.206 date 2011.09.25.06.49.10; author strick; state Exp; branches; next 1.205; 1.205 date 2011.09.25.06.49.05; author strick; state Exp; branches; next 1.204; 1.204 date 2011.09.25.06.33.42; author strick; state Exp; branches; next 1.203; 1.203 date 2011.09.25.05.32.40; author strick; state Exp; branches; next 1.202; 1.202 date 2011.09.25.05.31.46; author strick; state Exp; branches; next 1.201; 1.201 date 2011.09.25.05.31.39; author strick; state Exp; branches; next 1.200; 1.200 date 2011.09.25.05.29.32; author strick; state Exp; branches; next 1.199; 1.199 date 2011.09.25.05.29.10; author strick; state Exp; branches; next 1.198; 1.198 date 2011.09.25.05.27.20; author strick; state Exp; branches; next 1.197; 1.197 date 2011.09.25.05.26.23; author strick; state Exp; branches; next 1.196; 1.196 date 2011.09.25.05.25.58; author strick; state Exp; branches; next 1.195; 1.195 date 2011.09.25.05.25.10; author strick; state Exp; branches; next 1.194; 1.194 date 2011.09.25.05.23.19; author strick; state Exp; branches; next 1.193; 1.193 date 2011.09.25.05.23.00; author strick; state Exp; branches; next 1.192; 1.192 date 2011.09.25.05.22.41; author strick; state Exp; branches; next 1.191; 1.191 date 2011.09.25.05.22.01; author strick; state Exp; branches; next 1.190; 1.190 date 2011.09.25.05.20.46; author strick; state Exp; branches; next 1.189; 1.189 date 2011.09.25.05.20.19; author strick; state Exp; branches; next 1.188; 1.188 date 2011.09.25.05.19.51; author strick; state Exp; branches; next 1.187; 1.187 date 2011.09.25.05.19.19; author strick; state Exp; branches; next 1.186; 1.186 date 2011.09.25.05.19.11; author strick; state Exp; branches; next 1.185; 1.185 date 2011.09.25.05.18.51; author strick; state Exp; branches; next 1.184; 1.184 date 2011.09.25.05.18.14; author strick; state Exp; branches; next 1.183; 1.183 date 2011.09.25.05.13.48; author strick; state Exp; branches; next 1.182; 1.182 date 2011.09.25.05.13.19; author strick; state Exp; branches; next 1.181; 1.181 date 2011.09.25.05.11.34; author strick; state Exp; branches; next 1.180; 1.180 date 2011.09.25.05.10.07; author strick; state Exp; branches; next 1.179; 1.179 date 2011.09.25.05.09.43; author strick; state Exp; branches; next 1.178; 1.178 date 2011.09.25.04.49.29; author strick; state Exp; branches; next 1.177; 1.177 date 2011.09.25.04.30.58; author strick; state Exp; branches; next 1.176; 1.176 date 2011.09.25.04.29.52; author strick; state Exp; branches; next 1.175; 1.175 date 2011.09.25.04.29.43; author strick; state Exp; branches; next 1.174; 1.174 date 2011.09.25.04.27.31; author strick; state Exp; branches; next 1.173; 1.173 date 2011.09.25.04.23.57; author strick; state Exp; branches; next 1.172; 1.172 date 2011.09.25.04.23.50; author strick; state Exp; branches; next 1.171; 1.171 date 2011.09.25.04.23.34; author strick; state Exp; branches; next 1.170; 1.170 date 2011.09.25.04.01.43; author strick; state Exp; branches; next 1.169; 1.169 date 2011.09.25.04.00.39; author strick; state Exp; branches; next 1.168; 1.168 date 2011.09.25.04.00.34; author strick; state Exp; branches; next 1.167; 1.167 date 2011.09.25.03.58.52; author strick; state Exp; branches; next 1.166; 1.166 date 2011.09.25.03.58.22; author strick; state Exp; branches; next 1.165; 1.165 date 2011.09.25.03.57.43; author strick; state Exp; branches; next 1.164; 1.164 date 2011.09.25.03.56.47; author strick; state Exp; branches; next 1.163; 1.163 date 2011.09.25.03.53.48; author strick; state Exp; branches; next 1.162; 1.162 date 2011.09.25.03.52.14; author strick; state Exp; branches; next 1.161; 1.161 date 2011.09.25.03.51.04; author strick; state Exp; branches; next 1.160; 1.160 date 2011.09.25.03.49.44; author strick; state Exp; branches; next 1.159; 1.159 date 2011.09.25.03.49.17; author strick; state Exp; branches; next 1.158; 1.158 date 2011.09.25.03.47.12; author strick; state Exp; branches; next 1.157; 1.157 date 2011.09.25.03.38.14; author strick; state Exp; branches; next 1.156; 1.156 date 2011.09.25.03.37.54; author strick; state Exp; branches; next 1.155; 1.155 date 2011.09.25.03.37.34; author strick; state Exp; branches; next 1.154; 1.154 date 2011.09.25.03.36.08; author strick; state Exp; branches; next 1.153; 1.153 date 2011.09.25.03.29.47; author strick; state Exp; branches; next 1.152; 1.152 date 2011.09.25.03.29.15; author strick; state Exp; branches; next 1.151; 1.151 date 2011.09.25.03.28.05; author strick; state Exp; branches; next 1.150; 1.150 date 2011.09.25.03.26.49; author strick; state Exp; branches; next 1.149; 1.149 date 2011.09.25.03.18.51; author strick; state Exp; branches; next 1.148; 1.148 date 2011.09.25.03.17.02; author strick; state Exp; branches; next 1.147; 1.147 date 2011.09.25.03.16.42; author strick; state Exp; branches; next 1.146; 1.146 date 2011.09.25.03.16.27; author strick; state Exp; branches; next 1.145; 1.145 date 2011.09.25.03.11.02; author strick; state Exp; branches; next 1.144; 1.144 date 2011.09.25.03.10.35; author strick; state Exp; branches; next 1.143; 1.143 date 2011.09.25.03.09.57; author strick; state Exp; branches; next 1.142; 1.142 date 2011.09.25.03.09.45; author strick; state Exp; branches; next 1.141; 1.141 date 2011.09.25.03.09.32; author strick; state Exp; branches; next 1.140; 1.140 date 2011.09.25.03.09.21; author strick; state Exp; branches; next 1.139; 1.139 date 2011.09.25.03.07.58; author strick; state Exp; branches; next 1.138; 1.138 date 2011.09.25.03.04.19; author strick; state Exp; branches; next 1.137; 1.137 date 2011.09.25.03.04.03; author strick; state Exp; branches; next 1.136; 1.136 date 2011.09.25.03.03.42; author strick; state Exp; branches; next 1.135; 1.135 date 2011.09.25.03.03.17; author strick; state Exp; branches; next 1.134; 1.134 date 2011.09.25.03.01.23; author strick; state Exp; branches; next 1.133; 1.133 date 2011.09.25.02.51.05; author strick; state Exp; branches; next 1.132; 1.132 date 2011.09.25.02.48.29; author strick; state Exp; branches; next 1.131; 1.131 date 2011.09.25.02.47.58; author strick; state Exp; branches; next 1.130; 1.130 date 2011.09.25.02.46.13; author strick; state Exp; branches; next 1.129; 1.129 date 2011.09.25.02.41.54; author strick; state Exp; branches; next 1.128; 1.128 date 2011.09.25.02.40.21; author strick; state Exp; branches; next 1.127; 1.127 date 2011.09.25.02.39.15; author strick; state Exp; branches; next 1.126; 1.126 date 2011.09.25.02.38.16; author strick; state Exp; branches; next 1.125; 1.125 date 2011.09.25.02.37.53; author strick; state Exp; branches; next 1.124; 1.124 date 2011.09.25.02.37.39; author strick; state Exp; branches; next 1.123; 1.123 date 2011.09.25.02.36.05; author strick; state Exp; branches; next 1.122; 1.122 date 2011.09.25.02.35.47; author strick; state Exp; branches; next 1.121; 1.121 date 2011.09.25.02.35.23; author strick; state Exp; branches; next 1.120; 1.120 date 2011.09.25.02.34.51; author strick; state Exp; branches; next 1.119; 1.119 date 2011.09.25.02.34.34; author strick; state Exp; branches; next 1.118; 1.118 date 2011.09.25.02.32.28; author strick; state Exp; branches; next 1.117; 1.117 date 2011.09.25.02.31.55; author strick; state Exp; branches; next 1.116; 1.116 date 2011.09.25.02.31.44; author strick; state Exp; branches; next 1.115; 1.115 date 2011.09.25.02.31.11; author strick; state Exp; branches; next 1.114; 1.114 date 2011.09.25.02.30.57; author strick; state Exp; branches; next 1.113; 1.113 date 2011.09.25.02.29.24; author strick; state Exp; branches; next 1.112; 1.112 date 2011.09.25.02.28.42; author strick; state Exp; branches; next 1.111; 1.111 date 2011.09.25.02.28.41; author strick; state Exp; branches; next 1.110; 1.110 date 2011.09.25.01.55.02; author strick; state Exp; branches; next 1.109; 1.109 date 2011.09.25.01.52.34; author strick; state Exp; branches; next 1.108; 1.108 date 2011.09.25.01.51.51; author strick; state Exp; branches; next 1.107; 1.107 date 2011.09.25.01.50.48; author strick; state Exp; branches; next 1.106; 1.106 date 2011.09.25.01.50.22; author strick; state Exp; branches; next 1.105; 1.105 date 2011.09.25.01.47.15; author strick; state Exp; branches; next 1.104; 1.104 date 2011.09.25.01.47.00; author strick; state Exp; branches; next 1.103; 1.103 date 2011.09.25.01.43.41; author strick; state Exp; branches; next 1.102; 1.102 date 2011.09.25.01.42.11; author strick; state Exp; branches; next 1.101; 1.101 date 2011.09.25.01.37.34; author strick; state Exp; branches; next 1.100; 1.100 date 2011.09.25.01.07.58; author strick; state Exp; branches; next 1.99; 1.99 date 2011.09.25.01.07.42; author strick; state Exp; branches; next 1.98; 1.98 date 2011.09.25.01.05.20; author strick; state Exp; branches; next 1.97; 1.97 date 2011.09.25.01.04.33; author strick; state Exp; branches; next 1.96; 1.96 date 2011.09.25.01.04.08; author strick; state Exp; branches; next 1.95; 1.95 date 2011.09.25.01.01.12; author strick; state Exp; branches; next 1.94; 1.94 date 2011.09.25.01.01.04; author strick; state Exp; branches; next 1.93; 1.93 date 2011.09.25.00.57.59; author strick; state Exp; branches; next 1.92; 1.92 date 2011.09.24.09.28.17; author strick; state Exp; branches; next 1.91; 1.91 date 2011.09.24.09.27.40; author strick; state Exp; branches; next 1.90; 1.90 date 2011.09.24.09.25.13; author strick; state Exp; branches; next 1.89; 1.89 date 2011.09.24.09.03.17; author strick; state Exp; branches; next 1.88; 1.88 date 2011.09.24.09.02.07; author strick; state Exp; branches; next 1.87; 1.87 date 2011.09.24.09.01.58; author strick; state Exp; branches; next 1.86; 1.86 date 2011.09.24.09.00.12; author strick; state Exp; branches; next 1.85; 1.85 date 2011.09.24.08.59.48; author strick; state Exp; branches; next 1.84; 1.84 date 2011.09.24.08.41.31; author strick; state Exp; branches; next 1.83; 1.83 date 2011.09.24.08.41.01; author strick; state Exp; branches; next 1.82; 1.82 date 2011.09.24.08.39.57; author strick; state Exp; branches; next 1.81; 1.81 date 2011.09.24.08.39.33; author strick; state Exp; branches; next 1.80; 1.80 date 2011.09.24.08.38.19; author strick; state Exp; branches; next 1.79; 1.79 date 2011.09.24.08.37.41; author strick; state Exp; branches; next 1.78; 1.78 date 2011.09.24.08.37.28; author strick; state Exp; branches; next 1.77; 1.77 date 2011.09.24.08.06.31; author strick; state Exp; branches; next 1.76; 1.76 date 2011.09.24.08.04.05; author strick; state Exp; branches; next 1.75; 1.75 date 2011.09.24.08.02.00; author strick; state Exp; branches; next 1.74; 1.74 date 2011.09.24.08.01.45; author strick; state Exp; branches; next 1.73; 1.73 date 2011.09.24.07.59.07; author strick; state Exp; branches; next 1.72; 1.72 date 2011.09.24.07.55.31; author strick; state Exp; branches; next 1.71; 1.71 date 2011.09.24.07.52.49; author strick; state Exp; branches; next 1.70; 1.70 date 2011.09.24.07.52.46; author strick; state Exp; branches; next 1.69; 1.69 date 2011.09.24.07.52.25; author strick; state Exp; branches; next 1.68; 1.68 date 2011.09.24.07.51.55; author strick; state Exp; branches; next 1.67; 1.67 date 2011.09.24.07.51.04; author strick; state Exp; branches; next 1.66; 1.66 date 2011.09.24.07.49.56; author strick; state Exp; branches; next 1.65; 1.65 date 2011.09.24.07.29.54; author strick; state Exp; branches; next 1.64; 1.64 date 2011.09.24.07.29.08; author strick; state Exp; branches; next 1.63; 1.63 date 2011.09.24.07.12.41; author strick; state Exp; branches; next 1.62; 1.62 date 2011.09.24.07.11.31; author strick; state Exp; branches; next 1.61; 1.61 date 2011.09.24.07.09.20; author strick; state Exp; branches; next 1.60; 1.60 date 2011.09.24.07.01.53; author strick; state Exp; branches; next 1.59; 1.59 date 2011.09.24.07.01.25; author strick; state Exp; branches; next 1.58; 1.58 date 2011.09.24.07.00.02; author strick; state Exp; branches; next 1.57; 1.57 date 2011.09.24.06.02.15; author strick; state Exp; branches; next 1.56; 1.56 date 2011.09.24.05.59.20; author strick; state Exp; branches; next 1.55; 1.55 date 2011.09.24.05.58.17; author strick; state Exp; branches; next 1.54; 1.54 date 2011.09.24.05.57.28; author strick; state Exp; branches; next 1.53; 1.53 date 2011.09.16.05.01.09; author strick; state Exp; branches; next 1.52; 1.52 date 2011.09.16.05.00.41; author strick; state Exp; branches; next 1.51; 1.51 date 2011.09.16.05.00.17; author strick; state Exp; branches; next 1.50; 1.50 date 2011.09.16.04.56.47; author strick; state Exp; branches; next 1.49; 1.49 date 2011.09.16.04.56.20; author strick; state Exp; branches; next 1.48; 1.48 date 2011.09.16.04.56.13; author strick; state Exp; branches; next 1.47; 1.47 date 2011.09.16.04.55.39; author strick; state Exp; branches; next 1.46; 1.46 date 2011.09.16.04.54.39; author strick; state Exp; branches; next 1.45; 1.45 date 2011.09.16.04.54.00; author strick; state Exp; branches; next 1.44; 1.44 date 2011.09.16.04.53.26; author strick; state Exp; branches; next 1.43; 1.43 date 2011.09.16.04.52.37; author strick; state Exp; branches; next 1.42; 1.42 date 2011.09.16.04.52.03; author strick; state Exp; branches; next 1.41; 1.41 date 2011.09.16.04.49.54; author strick; state Exp; branches; next 1.40; 1.40 date 2011.09.16.04.49.44; author strick; state Exp; branches; next 1.39; 1.39 date 2011.09.16.04.49.23; author strick; state Exp; branches; next 1.38; 1.38 date 2011.09.16.04.48.34; author strick; state Exp; branches; next 1.37; 1.37 date 2011.09.16.04.48.22; author strick; state Exp; branches; next 1.36; 1.36 date 2011.09.16.04.48.01; author strick; state Exp; branches; next 1.35; 1.35 date 2011.09.16.04.47.43; author strick; state Exp; branches; next 1.34; 1.34 date 2011.09.16.04.44.22; author strick; state Exp; branches; next 1.33; 1.33 date 2011.09.16.04.44.15; author strick; state Exp; branches; next 1.32; 1.32 date 2011.09.16.04.43.59; author strick; state Exp; branches; next 1.31; 1.31 date 2011.09.16.04.43.14; author strick; state Exp; branches; next 1.30; 1.30 date 2011.09.16.04.42.18; author strick; state Exp; branches; next 1.29; 1.29 date 2011.09.16.04.41.56; author strick; state Exp; branches; next 1.28; 1.28 date 2011.09.16.04.41.25; author strick; state Exp; branches; next 1.27; 1.27 date 2011.09.16.04.36.44; author strick; state Exp; branches; next 1.26; 1.26 date 2011.09.16.04.35.43; author strick; state Exp; branches; next 1.25; 1.25 date 2011.09.16.04.19.22; author strick; state Exp; branches; next 1.24; 1.24 date 2011.09.16.04.14.59; author strick; state Exp; branches; next 1.23; 1.23 date 2011.09.16.04.14.41; author strick; state Exp; branches; next 1.22; 1.22 date 2011.09.16.04.12.14; author strick; state Exp; branches; next 1.21; 1.21 date 2011.09.16.04.08.40; author strick; state Exp; branches; next 1.20; 1.20 date 2011.09.16.04.07.56; author strick; state Exp; branches; next 1.19; 1.19 date 2011.09.16.03.58.03; author strick; state Exp; branches; next 1.18; 1.18 date 2011.09.16.02.54.31; author strick; state Exp; branches; next 1.17; 1.17 date 2011.09.13.02.49.15; author strick; state Exp; branches; next 1.16; 1.16 date 2011.09.13.02.46.38; author strick; state Exp; branches; next 1.15; 1.15 date 2011.09.13.02.45.29; author strick; state Exp; branches; next 1.14; 1.14 date 2011.09.13.02.41.35; author strick; state Exp; branches; next 1.13; 1.13 date 2011.09.13.02.31.47; author strick; state Exp; branches; next 1.12; 1.12 date 2011.09.13.02.27.26; author strick; state Exp; branches; next 1.11; 1.11 date 2011.09.13.02.22.21; author strick; state Exp; branches; next 1.10; 1.10 date 2011.09.13.02.06.43; author strick; state Exp; branches; next 1.9; 1.9 date 2011.09.12.21.18.34; author strick; state Exp; branches; next 1.8; 1.8 date 2011.09.12.21.15.17; author strick; state Exp; branches; next 1.7; 1.7 date 2011.09.12.21.11.24; author strick; state Exp; branches; next 1.6; 1.6 date 2011.09.12.20.56.32; author strick; state Exp; branches; next 1.5; 1.5 date 2011.09.12.19.37.47; author strick; state Exp; branches; next 1.4; 1.4 date 2011.09.12.19.35.58; author strick; state Exp; branches; next 1.3; 1.3 date 2011.09.12.19.34.18; author strick; state Exp; branches; next 1.2; 1.2 date 2011.09.12.19.28.30; author strick; state Exp; branches; next 1.1; 1.1 date 2011.09.12.19.24.43; author strick; state Exp; branches; next ; desc @@ 1.306 log @/dev/null @ text @-- TCL Subset. -- Copyright 2011 Henry Strickland. -- MIT License. module Main where import Control.Monad.State import Text.ParserCombinators.Parsec hiding (State) import qualified Char(ord) import qualified Data.Map as M --import Numeric(readInt) main :: IO () main = do lines <- getContents putStrLn $ "INPUT: " ++ (show lines) (result, terp) <- runStateT (evalProcBody [] lines []) freshTerp putStrLn $ "END: " ++ (show terp) putStrLn $ "END: " ++ (show result) say :: String -> Action say s = do lift $ putStrLn s good -- Instead of using the Either Monad, we use ifOk to run another -- monad if the previous was Right, or produce a Left NotOk if the -- previous was Left. ifOk :: (Show a) => (Show b) => Either a b -> (b -> Action) -> Action ifOk (Left e) _ = do say $ "ERROR(ifOk): " ++ show e return $ Left $ Err $ show e ifOk (Right y) f = do f y -- Just evalling a string does not need pusher or popper evalString :: String -> Action evalString body = eval' body good good -- Evalling a proc must push & pop a stack Frame. evalProcBody :: [String] -> String -> [String] -> Action evalProcBody params body args = eval' body pushFrame popFrame where pushFrame = do terp <- get put $ terp { frames = Frame M.empty : frames terp } ok <- putLocalList params args ifOk ok $ \_ -> good popFrame = do terp <- get put $ terp { frames = tail (frames terp) } good -- Shared eval for both evalString and evalProcBody eval' :: String -> Action -> Action -> Action eval' body pusher popper = do ifOk (parse parseString "" body) $ \scripts -> do pusher result <- runScripts scripts popper ifOk result $ \str -> do say $ "RESULT: " ++ show str return $ Right str ---------------------------------------------------------- type Result = Either NotOk String data NotOk = Err String | Return String | Break | Continue deriving Show data Frame = Frame VarMap deriving Show --data Var = Var String String -- deriving Show data Cmd = Cmd String CmdGuts deriving Show data CmdGuts = Proc [String] String | Builtin ([String] -> Action) instance Show CmdGuts where show (Proc args body) = "" show (Builtin _) = "" type CmdMap = M.Map String CmdGuts type VarMap = M.Map String String -- the state of the Tcl Interpreter, to act on. data Terp = Terp { cmds :: CmdMap, frames :: [Frame] } deriving Show type Act = StateT Terp IO -- Monad resulting in a Result. type Action = Act Result -- Returning a Right "" is the default good action. good :: Action good = return $ Right "" getLocal :: String -> Action getLocal name = do terp <- get return $ case frames terp of [] -> Left $ Err $ "ERROR: empty frames in getLocal " ++ name (Frame vars) :fs -> case findVarIn vars of Nothing -> Left $ Err $ "ERROR: not found in getLocdal " ++ name Just z -> Right z where findVarIn vars = M.lookup name vars --findVarIn [] = Nothing --findVarIn (Var name' value' : vs) = --if name == name' --then Just value' --else findVarIn vs putLocalList :: [String] -> [String] -> Action putLocalList [] [] = good putLocalList [] _ = return $ Left $ Err "Too Many Args" putLocalList _ [] = return $ Left $ Err "Too FeW Args" putLocalList (name:names) (value:values) = do putLocal name value putLocalList names values putLocal :: String -> String -> Action putLocal name value = do terp <- get case frames terp of [] -> do return $ Left $ Err $ "ERROR: empty frames in getLocal " ++ name (Frame vars) :fs -> do put $ terp { frames = Frame (setVarIn vars) : fs } return $ Right $ value where setVarIn vars = M.insert name value vars freshTerp = Terp { cmds = freshCmds, frames = [] } where freshCmds :: CmdMap freshCmds = M.insert "if" (Builtin builtin_if) $ M.insert "one" (Proc ["foo"] "seven") $ M.insert "seven" (Builtin builtin_seven) $ M.insert "set" (Builtin builtin_set) $ M.insert "proc" (Builtin builtin_proc) $ M.insert "+" (Builtin builtinPlus) $ M.insert "*" (Builtin builtinTimes) $ M.insert "==" (Builtin builtinEQ) $ M.insert "!=" (Builtin builtinNE) $ M.insert "<" (Builtin builtinLT) $ M.insert "<=" (Builtin builtinLE) $ M.insert ">" (Builtin builtinGT) $ M.insert ">=" (Builtin builtinGE) $ M.empty truth s = if s == "0" then False else True builtin_if [cond, onTrue, onFalse] = if truth cond then evalString onTrue else evalString onFalse builtin_if [cond, onTrue] = builtin_if [cond, onTrue, ""] builtin_if [cond, onTrue, kwElse, onFalse] = builtin_if [cond, onTrue, onFalse] builtin_if args = return $ Left $ Err $ "bad args: " ++ show args builtin_set [name, value] = putLocal name value builtin_set [name] = getLocal name builtin_seven _ = return $ Right "7" builtinPlus args = return $ Right $ show $ foldr (+) 0 $ map atoi args builtinTimes args = return $ Right $ show $ foldr (*) 1 $ map atoi args builtinEQ [a, b] = return $ Right $ if a == b then "1" else "0" builtinNE [a, b] = return $ Right $ if a == b then "1" else "0" builtinLT [a, b] = return $ Right $ if a == b then "1" else "0" builtinLE [a, b] = return $ Right $ if a == b then "1" else "0" builtinGT [a, b] = return $ Right $ if a == b then "1" else "0" builtinGE [a, b] = return $ Right $ if a == b then "1" else "0" builtin_proc [name, params, body] = do x <- parseListAct params case x of Left e -> return $ Left e Right paramList -> do terp <- get put $ terp { cmds = M.insert name (Proc paramList body) $ cmds terp } good -- Run a list of commands, stopping if any is NotOk. runScripts :: [Script] -> Action runScripts [] = good -- case of empty scripts. runScripts (script:scripts) = do terp <- get say ("<<<<<<<<< " ++ show terp) say ("<<<<<< " ++ show script) result <- runScript script say (">>>>>> " ++ show result) terp' <- get say (">>>>>>>>> " ++ show terp') case result of Left e -> return $ Left e -- stop when one is NotOk Right _ -> finish scripts -- continue executing scripts when Right. where finish [] = return result -- usual stop to recursion. finish scripts = runScripts scripts -- run the rest. -- Run one command, first doing needed substitutions on each word. runScript :: Script -> Action runScript (Script words) = do say ("<<< " ++ show words) terp <- get rs <- substWords words say ("rs: " ++ show rs) ifOk rs $ \(rstr:astrs) -> do case (M.lookup rstr $ cmds terp) of Nothing -> do say (">>> Nothing: " ++ rstr) return $ Left $ Err $ "Cannot find cmd: " ++ rstr Just guts -> do say (">>> Guts: " ++ show guts) z <- runGuts guts astrs say (">>> z: " ++ show z) return z -- Running a command that is a Proc runGuts (Proc params body) args = do return $ Right $ show $ (params, body, args) evalProcBody params body args -- Running a command that is a Builtin runGuts (Builtin func) args = do say $ show $ ("builtin func args=", args) func args substWords :: [Word] -> Act (Either NotOk [String]) substWords [] = return $ Right $ [] substWords (w : ws) = do x <- substWord w case x of Left e -> do return $ Left e Right s -> do y <- substWords ws case y of Left e -> do return $ Left e Right ss -> do return $ Right $ s : ss substWord :: Word -> Action substWord w = _substWord [] w where _substWord :: [String] -> Word -> Action _substWord ss (Word []) = return $ Right $ concat ss _substWord ss (Word (t:ts)) = do a <- _substThing t case a of Left z -> return $ Left z Right s -> _substWord (s:ss) (Word ts) _substThing :: Thing -> Action _substThing (BareThing s) = return $ Right s _substThing (VarThing s) = getLocal s _substThing (CmdThing s) = evalString s ---------------------------------------------------------- data Thing = BareThing String | VarThing String | CmdThing String deriving Show data Word = Word [Thing] deriving Show data Script = Script [Word] instance Show Script where show (Script things) = "<" ++ (joinOnCommas (map show things)) ++ ">" where joinOnCommas ss = foldr (\ x y -> x ++ ";" ++ y) " " ss parseString :: Parser [Script] parseString = do skipToNextCommand (eof >> return []) <|> parseCommands parseCommands :: Parser [Script] parseCommands = do c <- parseCommand cs <- parseString return $ c : cs skipToNextCommand :: Parser () skipToNextCommand = skip $ many $ (blank <|> comment <|> endCommand) parseCommand :: Parser Script parseCommand = do words <- many1 $ parseWord return $ Script words parseWord :: Parser Word parseWord = do thing <- parseThing many $ oneOf $ blankChars return $ Word [thing] parseThing :: Parser Thing parseThing = do parseCmdThing <|> parseVarThing <|> parseBareThing parseBareThing = do z <- bares <|> parseCurlyQuoted return $ BareThing z parseVarThing = do z <- varDeref return $ VarThing z parseCmdThing = do z <- parseSquareBracketed return $ CmdThing z parseCurlyQuoted :: Parser String parseCurlyQuoted = do char '{' z <- many $ (eof >> return "") <|> parseCurlyQuoted <|> (many1 $ noneOf "{}\\") char '}' return $ concat z parseSquareBracketed :: Parser String parseSquareBracketed = do char '[' z <- many $ (eof >> return "") <|> parseCurlyQuoted <|> parseSquareBracketed <|> (many1 $ noneOf "[]{}\\") char ']' return $ concat z parseListAct :: String -> Act (Either NotOk [String]) parseListAct s = do case (parse parseList "LIST" s) of Left e -> return $ Left $ Err $ show e Right z -> return $ Right z parseList :: Parser [String] parseList = do many blank (eof >> return []) <|> parseItems parseItems = do s <- (parseCurlyQuoted) <|> (many1 $ noneOf $ blankChars) ss <- parseList return $ s : ss alphanumChars = "0123456789ABCDEFGHIJKLMNOPQSTUVWXYZ_abcdefghijklmnopqstuvwxyz" specialChars = "{}[];\"$" blankChars = "\t\v " endCommandChars = "\n\r;" bares :: Parser String bares = many1 $ noneOf $ specialChars ++ blankChars ++ endCommandChars blank = skip $ oneOf $ blankChars endCommand = skip $ oneOf $ endCommandChars esc = skip $ char '\\' comment = do char '#' many $ noneOf "\n" char '\n' return () varDeref :: Parser String varDeref = do char '$' many1 $ oneOf $ alphanumChars skip :: Parser a -> Parser () skip p = p >> return () ---------------------------------------------------------- --xatoi :: String -> Int --xatoi s = readInt s atoi :: String -> Int atoi s = case parse (parseInt 0) "atoi" s of Left e -> 0 Right n -> n where parseInt :: Int -> Parser Int parseInt a = do x <- (eof >> return '?') <|> oneOf "-0123456789" if x == '-' then do t <- parseInt a return $ 0 - t else do let n = Char.ord x - Char.ord '0' if 0 <= n && n <= 9 then parseInt $ a * 10 + n else return a @ 1.305 log @/dev/null @ text @d384 1 a384 1 x <- (eof >> return '.') <|> oneOf "-0123456789" @ 1.304 log @/dev/null @ text @d384 10 a393 5 x <- (eof >> return '.') <|> oneOf "0123456789" let n = Char.ord x - Char.ord '0' if 0 <= n && n <= 9 then parseInt $ a * 10 + n else return a @ 1.303 log @/dev/null @ text @d161 1 @ 1.302 log @/dev/null @ text @d160 1 @ 1.301 log @/dev/null @ text @d11 1 d165 2 a166 2 builtinPlus args = return $ Right $ show $ foldr (+) 0 $ map readInt args builtinTimes args = return $ Right $ show $ foldr (*) 1 $ map readInt args d372 2 a373 2 xreadInt :: String -> Int xreadInt s = readInt s d375 2 a376 2 readInt :: String -> Int readInt s = case parse (parseInt 0) "readInt" s of @ 1.300 log @/dev/null @ text @d161 1 @ 1.299 log @/dev/null @ text @d158 1 @ 1.298 log @/dev/null @ text @d139 5 a143 4 M.insert "one" (Proc ["one_arg"] "seven") $ M.insert "seven" (Builtin builtinSeven) $ M.insert "set" (Builtin builtinSet) $ M.insert "proc" (Builtin builtinProc) $ d145 7 a151 7 M.insert "*" (Builtin builtinPlus) $ M.insert "==" (Builtin builtinOpEQ) $ M.insert "!=" (Builtin builtinOpNE) $ M.insert "<" (Builtin builtinOpLT) $ M.insert "<=" (Builtin builtinOpLE) $ M.insert ">" (Builtin builtinOpGT) $ M.insert ">=" (Builtin builtinOpGE) $ d154 7 a160 2 builtinSet [name, value] = putLocal name value builtinSeven _ = return $ Right "7" d163 7 a169 7 builtinPlus args = return $ Right $ show $ foldr (*) 1 $ map readInt args builtinOpEQ [a, b] = return $ Right $ if a == b then "1" else "0" builtinOpNE [a, b] = return $ Right $ if a == b then "1" else "0" builtinOpLT [a, b] = return $ Right $ if a == b then "1" else "0" builtinOpLE [a, b] = return $ Right $ if a == b then "1" else "0" builtinOpGT [a, b] = return $ Right $ if a == b then "1" else "0" builtinOpGE [a, b] = return $ Right $ if a == b then "1" else "0" d171 1 a171 1 builtinProc [name, params, body] = do @ 1.297 log @/dev/null @ text @a152 1 builtinSet :: [String] -> Action a153 1 @ 1.296 log @/dev/null @ text @d144 7 a150 1 M.insert "==" (Builtin builtinOpEq) $ d159 7 a165 1 builtinOpEq [a, b] = return $ Right $ if a == b then "1" else "0" @ 1.295 log @/dev/null @ text @d144 1 d152 2 a153 2 builtinPlus args = do return $ Right $ show $ foldr (+) 0 $ map readInt args @ 1.294 log @/dev/null @ text @d148 1 @ 1.293 log @/dev/null @ text @a133 5 --setVarIn [] = [Var name value] --setVarIn (Var name' value' : vs) = --if name == name' --then Var name value : vs --else Var name' value' : setVarIn vs @ 1.292 log @/dev/null @ text @d166 2 a167 1 ---------------------------------------------------------- d185 1 d203 1 a203 1 d208 1 @ 1.291 log @/dev/null @ text @d191 9 a199 9 case (M.lookup rstr $ cmds terp) of Nothing -> do say (">>> Nothing: " ++ rstr) return $ Left $ Err $ "Cannot find cmd: " ++ rstr Just guts -> do say (">>> Guts: " ++ show guts) z <- runGuts guts astrs say (">>> z: " ++ show z) return z @ 1.290 log @/dev/null @ text @a190 5 --case rs of --Left e -> do --say (">>> Left e:::" ++ show e) --return $ Left $ Err $ show e --Right (rstr:astrs) -> do @ 1.289 log @/dev/null @ text @d190 6 a195 5 case rs of Left e -> do say (">>> Left e:::" ++ show e) return $ Left $ Err $ show e Right (rstr:astrs) -> do @ 1.288 log @/dev/null @ text @a187 2 r <- substWord (words !! 0) say ("r: " ++ show r) @ 1.287 log @/dev/null @ text @a215 7 --findCmd :: [Cmd] -> String -> Maybe CmdGuts --findCmd [] s = Nothing --findCmd (Cmd name guts : cs) s = -- if s == name -- then Just guts -- else findCmd cs s @ 1.286 log @/dev/null @ text @d168 1 a168 1 runScripts [] = good d181 2 a182 2 finish [] = return result finish scripts = runScripts scripts @ 1.285 log @/dev/null @ text @d178 2 a179 2 Left e -> return $ Left e Right _ -> finish scripts @ 1.284 log @/dev/null @ text @d173 2 a174 1 x <- runScript script a175 1 say (">>>>>> " ++ show x) d177 2 a178 2 case x of Left e -> return x d181 1 a181 1 finish [] = return x @ 1.283 log @/dev/null @ text @a202 1 return $ Right $ show guts @ 1.282 log @/dev/null @ text @d88 1 a88 1 data Terp = Terp { cmds :: [Cmd], frames :: [Frame] } d142 8 a149 8 freshCmds :: [Cmd] freshCmds = [ Cmd "one" $ Proc ["one_arg"] "seven" , Cmd "seven" $ Builtin builtinSeven , Cmd "set" $ Builtin builtinSet , Cmd "proc" $ Builtin builtinProc , Cmd "+" $ Builtin builtinPlus ] d164 1 a164 1 put $ terp { cmds = Cmd name (Proc paramList body) : cmds terp } a187 1 let cmdList = cmds terp d197 1 a197 1 case findCmd cmdList rstr of d217 6 a222 6 findCmd :: [Cmd] -> String -> Maybe CmdGuts findCmd [] s = Nothing findCmd (Cmd name guts : cs) s = if s == name then Just guts else findCmd cs s @ 1.281 log @/dev/null @ text @d46 1 a46 1 put $ terp { frames = Frame [] : frames terp } d71 1 a71 3 data Frame = Frame [Var] deriving Show data Var = Var String String d73 2 d108 6 a113 5 findVarIn [] = Nothing findVarIn (Var name' value' : vs) = if name == name' then Just value' else findVarIn vs d133 6 a138 5 setVarIn [] = [Var name value] setVarIn (Var name' value' : vs) = if name == name' then Var name value : vs else Var name' value' : setVarIn vs @ 1.280 log @/dev/null @ text @d213 1 a213 1 return $ Right $ show $ ("builtin func", args) d366 3 d370 11 a380 1 readInt s = readInt s @ 1.279 log @/dev/null @ text @d10 1 a70 2 data Interp = Interp [Cmd] [Frame] deriving Show d84 3 d327 1 a327 2 let x = parse parseList "LIST" s case x of a367 13 xreadInt :: String -> Int xreadInt s = case parse (parseInt 0) "readInt" s of Left e -> 0 Right n -> n where parseInt :: Int -> Parser Int parseInt a = do x <- (eof >> return '.') <|> oneOf "0123456789" let n = Char.ord x - Char.ord '0' if 0 <= n && n <= 9 then parseInt $ a * 10 + n else return a @ 1.278 log @/dev/null @ text @d365 2 d368 1 a368 3 xreadInt s = readInt s readInt :: String -> Int readInt s = case parse (parseInt 0) "readInt" s of @ 1.277 log @/dev/null @ text @d365 2 a366 2 --readInt :: String -> Int --readInt s = reads s @ 1.276 log @/dev/null @ text @d365 2 @ 1.275 log @/dev/null @ text @a63 3 joinOnCommas :: [String] -> String joinOnCommas ss = foldr (\ x y -> x ++ ";" ++ y) " " ss d262 1 @ 1.274 log @/dev/null @ text @d35 5 d53 1 a53 3 evalString :: String -> Action evalString body = eval' body good good @ 1.273 log @/dev/null @ text @d19 1 a19 1 say :: String -> Act () d22 1 a22 1 return () @ 1.272 log @/dev/null @ text @d92 1 @ 1.271 log @/dev/null @ text @d46 1 a46 1 return $ Right "" d49 1 a49 3 evalString body = eval' body nop nop where nop = return $ Right "" @ 1.270 log @/dev/null @ text @d42 1 a42 1 ifOk ok $ \_ -> return $ Right "" d114 1 a114 1 putLocalList [] [] = return $ Right "" d162 1 a162 1 return $ Right "" d165 1 a165 1 runScripts [] = return $ Right "" @ 1.269 log @/dev/null @ text @d94 2 a95 1 --unVar var = let Var v = var in v @ 1.268 log @/dev/null @ text @d57 1 a57 1 z <- runScripts scripts d59 3 a61 3 ifOk z $ \zz -> do say $ "RESULT: " ++ show zz return $ Right zz @ 1.267 log @/dev/null @ text @d54 1 a54 1 eval' body pushFrame popFrame = do d56 1 a56 1 pushFrame d58 1 a58 1 popFrame @ 1.266 log @/dev/null @ text @d47 1 @ 1.265 log @/dev/null @ text @d30 2 a31 2 say $ "ERROR(ifOk): " ++ show e return $ Left $ Err $ show e d33 1 a33 1 f y d39 4 a42 4 terp <- get put $ terp { frames = Frame [] : frames terp } ok <- putLocalList params args ifOk ok $ \_ -> return $ Right "" d44 3 a46 3 terp <- get put $ terp { frames = tail (frames terp) } return $ Right "" @ 1.264 log @/dev/null @ text @d24 5 a28 1 ifOk :: (Show a) => (Show b) => Either a b -> (b -> Action) -> Action @ 1.263 log @/dev/null @ text @a30 21 zzzevalProcBody :: [String] -> String -> [String] -> Action zzzevalProcBody params body args = do say $ "BODY: " ++ (show body) ifOk (parse parseString "" body) f where f scripts = do -- Push frame: cons an empty frame on front of frames list. terp1 <- get put $ terp1 { frames = Frame [] : frames terp1 } putLocalList params args z <- runScripts scripts -- Pop frame: replace frames list with its tail. terp2 <- get put $ terp2 { frames = tail (frames terp2) } ifOk z $ \zz -> do say $ "RESULT: " ++ show zz return $ Right zz @ 1.262 log @/dev/null @ text @d58 1 a58 1 ok :: Result <- putLocalList params args @ 1.261 log @/dev/null @ text @d58 1 a58 1 ok :: Either NotOk String <- putLocalList params args @ 1.260 log @/dev/null @ text @d25 1 a25 3 ifOk x f = do case x of Left e -> do d28 1 a28 1 Right y -> do d58 2 a59 2 putLocalList params args return () d63 1 d67 1 a67 1 nop = return () d69 1 a69 1 eval' :: String -> Act () -> Act () -> Action d128 2 a129 2 putLocalList :: [String] -> [String] -> Act (Either NotOk ()) putLocalList [] [] = return $ Right () @ 1.259 log @/dev/null @ text @d60 2 @ 1.258 log @/dev/null @ text @d33 2 a34 2 evalProcBody :: [String] -> String -> [String] -> Action evalProcBody params body args = do d54 9 @ 1.257 log @/dev/null @ text @d56 2 a57 1 where nop = return () @ 1.256 log @/dev/null @ text @a57 2 --nop :: Act () @ 1.255 log @/dev/null @ text @d63 6 a68 6 pushFrame z <- runScripts scripts popFrame ifOk z $ \zz -> do say $ "RESULT: " ++ show zz return $ Right zz @ 1.254 log @/dev/null @ text @d62 1 a62 3 ifOk (parse parseString "" body) f where f scripts = do @ 1.253 log @/dev/null @ text @d61 1 a61 1 eval' body pushAction popAction = do d65 1 d67 1 @ 1.252 log @/dev/null @ text @d55 2 a56 1 evalString body = eval' body nopAction (return ()) d58 1 a58 2 nopAction :: Act () nopAction = return () @ 1.251 log @/dev/null @ text @d55 1 a55 1 evalString body = eval' body nopAction nopAction @ 1.250 log @/dev/null @ text @d55 1 a55 1 evalString body = eval' body d57 5 a61 2 eval' :: String -> Action eval' body = do @ 1.249 log @/dev/null @ text @d55 4 a58 1 evalString body = do @ 1.248 log @/dev/null @ text @d58 5 a62 9 f scripts = do z <- runScripts scripts case z of Left e -> do say $ "RUNTIME ERROR: " ++ show e return $ Left $ Err $ show e Right z -> do say $ "RESULT: " ++ show z return $ Right z @ 1.247 log @/dev/null @ text @d50 3 a52 3 ifOk z $ \z -> do say $ "RESULT: " ++ show z return $ Right z @ 1.246 log @/dev/null @ text @d50 3 a52 1 ifOk z $ \zz -> return $ Right zz @ 1.245 log @/dev/null @ text @a49 5 --case z of -- Left e -> do -- say $ "RUNTIME ERROR: " ++ show e -- return $ Left $ Err $ show e -- Right z -> do @ 1.244 log @/dev/null @ text @d50 6 a55 7 case z of Left e -> do say $ "RUNTIME ERROR: " ++ show e return $ Left $ Err $ show e Right z -> do say $ "RESULT: " ++ show z return $ Right z @ 1.243 log @/dev/null @ text @a30 1 say $ "Parsed: " ++ show y @ 1.242 log @/dev/null @ text @d28 1 a28 1 say $ "PARSE ERROR: " ++ show e @ 1.241 log @/dev/null @ text @a63 1 a64 1 @ 1.240 log @/dev/null @ text @d61 3 a63 7 let parsed = parse parseString "" body case parsed of Left parseError -> do say $ "PARSE ERROR: " ++ show parseError return $ Left $ Err $ show parseError Right scripts -> do say $ "Parsed: " ++ show parsed @ 1.239 log @/dev/null @ text @d37 1 a37 9 let parsed = parse parseString "" body --case parsed of -- Left parseError -> do -- say $ "PARSE ERROR: " ++ show parseError -- return $ Left $ Err $ show parseError -- Right scripts -> do -- say $ "Parsed: " ++ show parsed ifOk parsed f d39 19 a57 19 f scripts = do -- Push frame: cons an empty frame on front of frames list. terp1 <- get put $ terp1 { frames = Frame [] : frames terp1 } putLocalList params args z <- runScripts scripts -- Pop frame: replace frames list with its tail. terp2 <- get put $ terp2 { frames = tail (frames terp2) } case z of Left e -> do say $ "RUNTIME ERROR: " ++ show e return $ Left $ Err $ show e Right z -> do say $ "RESULT: " ++ show z return $ Right z @ 1.238 log @/dev/null @ text @d45 2 a46 1 ifOk parsed f where @ 1.237 log @/dev/null @ text @d45 2 a46 3 --ifOk parsed f where -- f scripts = do ifOk parsed $ \scripts -> do @ 1.236 log @/dev/null @ text @d45 3 a47 2 ifOk parsed f where f scripts = do @ 1.235 log @/dev/null @ text @d38 6 a43 6 case parsed of Left parseError -> do say $ "PARSE ERROR: " ++ show parseError return $ Left $ Err $ show parseError Right scripts -> do say $ "Parsed: " ++ show parsed d45 2 @ 1.234 log @/dev/null @ text @d24 10 @ 1.233 log @/dev/null @ text @a6 2 --import Prelude --import IO @ 1.232 log @/dev/null @ text @d7 1 a7 1 import Prelude @ 1.231 log @/dev/null @ text @d8 1 a8 1 import IO @ 1.230 log @/dev/null @ text @a9 1 --import System.Environment @ 1.229 log @/dev/null @ text @a8 1 --import Control.Monad.Error d10 1 a10 1 import System.Environment @ 1.228 log @/dev/null @ text @d9 1 a9 1 import Control.Monad.Error @ 1.227 log @/dev/null @ text @d281 1 a281 1 parseEnd <|> parseCommands a353 5 parseEnd :: Parser [Script] parseEnd = do eof return [] @ 1.226 log @/dev/null @ text @d350 1 a350 1 s <- many1 $ noneOf $ blankChars @ 1.225 log @/dev/null @ text @d347 1 a347 1 endOfList <|> parseItems a353 4 endOfList = do eof return [] @ 1.224 log @/dev/null @ text @d58 20 d264 1 @ 1.223 log @/dev/null @ text @a253 1 @ 1.222 log @/dev/null @ text @d294 1 a294 3 char '[' z <- many $ noneOf "]" char ']' @ 1.221 log @/dev/null @ text @d308 10 @ 1.220 log @/dev/null @ text @d303 2 a304 2 <|> parseCurlyQuoted <|> (many1 $ noneOf "{}\\") @ 1.219 log @/dev/null @ text @d302 3 a304 1 z <- many $ (eof >> return "") <|> parseCurlyQuoted <|> (many1 $ noneOf "{}\\") @ 1.218 log @/dev/null @ text @d302 1 a302 1 z <- many $ (parseCurlyQuoted <|> (many1 $ noneOf "{}\\") <|> (eof >> return "")) @ 1.217 log @/dev/null @ text @d243 1 @ 1.216 log @/dev/null @ text @d287 1 a287 1 z <- bares d298 8 @ 1.215 log @/dev/null @ text @a323 13 readInt :: String -> Int readInt s = case parse (parseInt 0) "readInt" s of Left e -> 0 Right n -> n where parseInt :: Int -> Parser Int parseInt a = do x <- (eof >> return '.') <|> oneOf "0123456789" let n = Char.ord x - Char.ord '0' if 0 <= n && n <= 9 then parseInt $ a * 10 + n else return a d348 13 a361 1 ---------------------------------------------------------- @ 1.214 log @/dev/null @ text @d326 2 a327 2 Left e -> 0 Right n -> n @ 1.213 log @/dev/null @ text @d328 8 a335 8 parseInt :: Int -> Parser Int parseInt a = do x <- (eof >> return '.') <|> oneOf "0123456789" let n = Char.ord x - Char.ord '0' if 0 <= n && n <= 9 then parseInt $ a * 10 + n else return a @ 1.212 log @/dev/null @ text @d333 1 a333 1 if 0 <= n && n <= 0 @ 1.211 log @/dev/null @ text @a146 2 let nums :: [Int] = map readInt args let sum = foldr (+) 0 nums @ 1.210 log @/dev/null @ text @a148 1 return $ Right $ show sum @ 1.209 log @/dev/null @ text @d150 1 @ 1.208 log @/dev/null @ text @d139 1 @ 1.207 log @/dev/null @ text @d145 5 @ 1.206 log @/dev/null @ text @d320 7 a326 2 readInt :: Int -> Parser Int readInt a = do d330 1 a330 1 then readInt $ a * 10 + n @ 1.205 log @/dev/null @ text @d325 1 a325 2 then do readInt $ a * 10 + n @ 1.204 log @/dev/null @ text @d13 1 d320 9 @ 1.203 log @/dev/null @ text @d1 3 a3 7 -- Read stdin, which has lines of form "key=value". -- Lookup the command line args as keys, and print their values. -- -- $ ghc --make lmap.hs && (echo alpha=male; echo beta=max; echo 0=1; echo = ) | ./lmap alpha beta gamma 0 -- "alpha"="male","beta"="max","0"="1",""="",Nil -- male,max,NotFound,1,. -- $ a5 1 a6 1 @ 1.202 log @/dev/null @ text @d44 1 a44 1 -- Push frame d51 1 a51 1 -- Pop frame @ 1.201 log @/dev/null @ text @a52 1 let _ : ttail = frames terp2 @ 1.200 log @/dev/null @ text @d53 2 a54 2 let _ : tail = frames terp2 put $ terp2 { frames = tail } @ 1.199 log @/dev/null @ text @d54 1 a54 1 put $ terp2 { frames = Frame [] : tail } @ 1.198 log @/dev/null @ text @d53 2 a54 2 let _ : frames2 = frames terp2 put $ terp2 { frames = Frame [] : frames2 } @ 1.197 log @/dev/null @ text @d43 2 d47 1 d50 2 d55 1 @ 1.196 log @/dev/null @ text @a132 2 oneFrame :: Frame oneFrame = Frame [Var "_frame_" "_first_"] @ 1.195 log @/dev/null @ text @d131 1 a131 1 freshTerp = Terp { cmds = freshCmds, frames = [oneFrame] } @ 1.194 log @/dev/null @ text @d43 2 a44 3 terp <- get let oldFrames = frames terp put $ terp { frames = Frame [] : oldFrames } d47 3 a49 1 put $ terp { frames = oldFrames } @ 1.193 log @/dev/null @ text @d48 1 @ 1.192 log @/dev/null @ text @d45 1 a45 1 put $ terp { frames = oldFrames } @ 1.191 log @/dev/null @ text @d44 2 a45 1 put $ terp { frames = frames terp } @ 1.190 log @/dev/null @ text @d43 2 a44 1 --TODO: start new frame. @ 1.189 log @/dev/null @ text @d48 1 a48 1 lift $ putStrLn $ "RUNTIME ERROR: " ++ show e d51 1 a51 1 lift $ putStrLn $ "RESULT: " ++ show z d156 2 a157 2 lift $ putStrLn ("<<<<<<<<< " ++ show terp) lift $ putStrLn ("<<<<<< " ++ show script) d160 2 a161 2 lift $ putStrLn (">>>>>> " ++ show x) lift $ putStrLn (">>>>>>>>> " ++ show terp') d171 1 a171 1 lift $ putStrLn ("<<< " ++ show words) d175 1 a175 1 lift $ putStrLn ("r: " ++ show r) d177 1 a177 1 lift $ putStrLn ("rs: " ++ show rs) d180 1 a180 1 lift $ putStrLn (">>> Left e:::" ++ show e) d185 1 a185 1 lift $ putStrLn (">>> Nothing: " ++ rstr) d188 1 a188 1 lift $ putStrLn (">>> Guts: " ++ show guts) d191 1 a191 1 lift $ putStrLn (">>> z: " ++ show z) @ 1.188 log @/dev/null @ text @d39 1 a39 1 lift $ putStrLn $ "PARSE ERROR: " ++ show parseError d42 1 a42 1 lift $ putStrLn $ "Parsed: " ++ show parsed @ 1.187 log @/dev/null @ text @a27 13 --let parsed = parse parseString "" lines --case parsed of --Left parseError -> do --putStrLn $ "PARSE ERROR: " ++ show parseError --Right scripts -> do --putStrLn $ "Parsed: " ++ show parsed --(z, _) <- evalInIO scripts freshTerp --case z of --Left e -> putStrLn $ "RUNTIME ERROR: " ++ show e --Right z -> putStrLn $ "RESULT: " ++ show z a53 5 evalInIO :: [Script] -> Terp -> IO (Result, Terp) evalInIO scripts terp = do (result', terp') <- runStateT (runScripts scripts) terp return (result', terp') @ 1.186 log @/dev/null @ text @d24 3 a26 3 (result', terp') <- runStateT (evalProcBody [] lines []) freshTerp putStrLn $ "END: " ++ (show terp') putStrLn $ "END: " ++ (show result') @ 1.185 log @/dev/null @ text @d25 1 @ 1.184 log @/dev/null @ text @d25 1 d28 11 a38 10 let parsed = parse parseString "" lines case parsed of Left parseError -> do putStrLn $ "PARSE ERROR: " ++ show parseError Right scripts -> do putStrLn $ "Parsed: " ++ show parsed (z, _) <- evalInIO scripts freshTerp case z of Left e -> putStrLn $ "RUNTIME ERROR: " ++ show e Right z -> putStrLn $ "RESULT: " ++ show z @ 1.183 log @/dev/null @ text @d24 3 @ 1.182 log @/dev/null @ text @d161 1 a161 1 put Terp { cmds = Cmd name (Proc paramList body) : cmds terp } @ 1.181 log @/dev/null @ text @d275 1 a275 1 skipToNextCommand = skip $ many $ (blanks <|> comment <|> endCommand) d313 1 a313 1 blanks d338 1 a338 1 blanks = skip $ many $ oneOf $ blankChars @ 1.180 log @/dev/null @ text @d338 1 a338 1 blanks = skip $ oneOf $ blankChars @ 1.179 log @/dev/null @ text @d148 1 @ 1.178 log @/dev/null @ text @d145 1 a145 1 Cmd "one" $ Proc ["one_arg"] "one_body" @ 1.177 log @/dev/null @ text @d152 1 a152 1 builtinSeven [name, value] = return $ Right "7" d154 8 d303 20 @ 1.176 log @/dev/null @ text @d200 2 @ 1.175 log @/dev/null @ text @d42 1 a42 1 lift $ putStrLn $ "BODY: " ++ (show body) @ 1.174 log @/dev/null @ text @d35 5 @ 1.173 log @/dev/null @ text @d37 1 @ 1.172 log @/dev/null @ text @a54 5 evalInAct :: [Script] -> Action evalInAct scripts = do z <- runScripts scripts return z @ 1.171 log @/dev/null @ text @d46 1 a46 1 z <- evalInAct scripts @ 1.170 log @/dev/null @ text @d30 1 a30 1 (z, _) <- eval scripts freshTerp d35 27 a61 2 eval :: [Script] -> Terp -> IO (Result, Terp) eval scripts terp = do d114 8 d210 1 a210 1 substWords :: [Word] -> StateT Terp IO (Either NotOk [String]) @ 1.169 log @/dev/null @ text @d168 1 @ 1.168 log @/dev/null @ text @d112 2 a113 2 ,Cmd "seven" $ Builtin builtinSeven ,Cmd "set" $ Builtin builtinSet @ 1.167 log @/dev/null @ text @d112 1 d118 1 @ 1.166 log @/dev/null @ text @d157 4 a160 1 runGuts guts astrs @ 1.165 log @/dev/null @ text @d155 1 a155 1 lift $ putStrLn (">>> Right: " ++ show guts) @ 1.164 log @/dev/null @ text @d157 1 a157 1 runGuts guts ["1", "2", "3"] @ 1.163 log @/dev/null @ text @d141 1 a141 1 r <- substWord [] (words !! 0) d174 1 a174 1 x <- substWord [] w d186 2 a187 7 substWord :: [String] -> Word -> Action substWord ss (Word []) = return $ Right $ concat ss substWord ss (Word (t:ts)) = do a <- _substThing t case a of Left z -> return $ Left z Right s -> substWord (s:ss) (Word ts) d189 7 @ 1.162 log @/dev/null @ text @d140 1 a140 1 let cmds' = cmds terp d150 1 a150 1 case findCmd cmds' rstr of @ 1.161 log @/dev/null @ text @d145 1 a145 1 case r of d149 1 a149 1 Right rstr -> do @ 1.160 log @/dev/null @ text @d146 3 a148 3 Left z -> do lift $ putStrLn (">>> Left z:::" ++ show r) return $ Left $ Err $ show r @ 1.159 log @/dev/null @ text @d142 1 d144 1 a144 1 lift $ putStrLn ("rs: " ++ show r) @ 1.158 log @/dev/null @ text @d142 1 @ 1.157 log @/dev/null @ text @d169 15 @ 1.156 log @/dev/null @ text @d172 1 a172 1 a <- _'substThing' t d177 2 a178 2 _'substThing' :: Thing -> Action _'substThing' (BareThing s) = return $ Right s @ 1.155 log @/dev/null @ text @d172 1 a172 1 a <- _substThing' t d177 2 a178 2 _substThing' :: Thing -> Action _substThing' (BareThing s) = return $ Right s @ 1.154 log @/dev/null @ text @d172 1 a172 1 a <- substThing' t d177 2 a178 2 substThing' :: Thing -> Action substThing' (BareThing s) = return $ Right s @ 1.153 log @/dev/null @ text @d141 1 a141 2 let Word ws = (words !! 0) r <- substThings [] ws d169 3 a171 10 substThings :: [String] -> [Thing] -> Action substThings ws [] = return $ Right $ concat ws substThings ws (t:ts) = do ----demo --terp <- get --let (f:fs) = frames terp --let Frame (v:vs) = f --let f_new = Frame $ Var "foo" "bar" : vs --put $ terp { frames = f_new : fs } ----end d175 1 a175 1 Right s -> substThings (s:ws) ts a179 3 ---------------------------------------------------------- ---------------------------------------------------------- @ 1.152 log @/dev/null @ text @d174 5 a178 5 terp <- get let (f:fs) = frames terp let Frame (v:vs) = f let f_new = Frame $ Var "foo" "bar" : vs put $ terp { frames = f_new : fs } @ 1.151 log @/dev/null @ text @d122 2 d126 1 d128 1 @ 1.150 log @/dev/null @ text @d122 1 d124 1 @ 1.149 log @/dev/null @ text @d150 6 @ 1.148 log @/dev/null @ text @d139 3 a141 1 Left z -> return $ Left $ Err $ show r d144 6 a149 2 Nothing -> return $ Left $ Err $ "Cannot find cmd: " ++ rstr Just guts -> return $ Right $ show guts @ 1.147 log @/dev/null @ text @a150 6 -- case guts of -- Proc args body -> -- Builtin func -> -- if s == name -- then Just (args, body ++ " // " ++ s ++ " // " ++ name) -- HACK -- else findCmd cs s @ 1.146 log @/dev/null @ text @a143 5 --case cmd in --let zz = findCmd cmds' rstr --lift $ putStrLn $ ">>> " ++ (show zz) --return $ Right (show zz) where unWord (Word x) = x @ 1.145 log @/dev/null @ text @d135 2 a136 1 r <- substThings [] (unWord (words !! 0)) d141 8 a148 5 let cmd = findCmd cmds' rstr let zz = findCmd cmds' rstr lift $ putStrLn $ ">>> " ++ (show zz) return $ Right (show zz) where unWord (Word x) = x @ 1.144 log @/dev/null @ text @d140 1 @ 1.143 log @/dev/null @ text @d132 1 a132 1 lift $ putStrLn ("RC: " ++ show words) d141 1 a141 1 lift $ putStrLn $ "zz: " ++ (show zz) @ 1.142 log @/dev/null @ text @d111 2 a112 2 Cmd "one" (Proc ["one_arg"] "one_body"), Cmd "set" $ Builtin builtinSet @ 1.141 log @/dev/null @ text @d112 1 a112 1 Cmd "set" (Builtin builtinSet) @ 1.140 log @/dev/null @ text @d111 2 a112 2 (Cmd "one" (Proc ["one_arg"] "one_body")), (Cmd "set" (Builtin builtinSet)) @ 1.139 log @/dev/null @ text @a106 2 freshCmds :: [Cmd] freshCmds = [Cmd "one" (Proc ["one_arg"] "one_body")] d109 5 @ 1.138 log @/dev/null @ text @d112 3 @ 1.137 log @/dev/null @ text @d135 1 a135 1 (lift putStrLn) $ "zz: " ++ (show zz) @ 1.136 log @/dev/null @ text @d135 1 a135 1 lift $ putStrLn $ "zz: " ++ (show zz) @ 1.135 log @/dev/null @ text @a134 1 zzz <- return $ findCmd cmds' rstr a135 1 lift $ putStrLn $ "zzz: " ++ (show zzz) @ 1.134 log @/dev/null @ text @d137 1 @ 1.133 log @/dev/null @ text @d55 8 a62 5 data Cmd = Proc String [String] String | Builtin String ([String] -> Action) instance Show Cmd where show (Proc name args body) = "" show (Builtin name _) = "" d108 1 a108 1 freshCmds = [Proc "one" ["one_arg"] "one_body"] d140 1 a140 1 findCmd :: [Cmd] -> String -> Maybe (String, String) d142 10 a151 6 findCmd (c:cs) s = case c of Proc name [args] body -> if s == name then Just (args, body ++ " // " ++ s ++ " // " ++ name) -- HACK else findCmd cs s @ 1.132 log @/dev/null @ text @d140 5 a144 4 let Proc name [args] body = c in if s == name then Just (args, body ++ " // " ++ s ++ " // " ++ name) -- HACK else findCmd cs s @ 1.131 log @/dev/null @ text @d58 2 a59 2 show (Proc name args body) = "" show (Builtin name _) = "" @ 1.130 log @/dev/null @ text @d57 3 a174 2 instance Show Cmd where show _ = "" @ 1.129 log @/dev/null @ text @d56 1 a56 1 deriving Show d172 3 @ 1.128 log @/dev/null @ text @d55 1 a55 1 data Cmd = Cmd String [String] String d102 1 a102 1 freshCmds = [Cmd "one" ["one_arg"] "one_body"] d137 1 a137 1 let Cmd name [args] body = c @ 1.127 log @/dev/null @ text @d99 1 a99 1 freshTerp = Terp { cmds = [oneCmd], frames = [oneFrame] } d101 2 a102 2 oneCmd :: Cmd oneCmd = Cmd "one" ["one_arg"] "one_body" @ 1.126 log @/dev/null @ text @d102 1 a102 1 oneCmd = Cmd "threetwoone" ["one_arg"] "one_body" @ 1.125 log @/dev/null @ text @d37 2 a38 2 (result2, terp2) <- runStateT (runScripts scripts) terp return (result2, terp2) @ 1.124 log @/dev/null @ text @d89 9 a97 10 (Frame vars) :fs -> do put $ terp { frames = Frame (setVarIn vars) : fs } return $ Right $ value where setVarIn [] = [Var name value] setVarIn (Var name' value' : vs) = if name == name' then Var name value : vs else Var name' value' : setVarIn vs @ 1.123 log @/dev/null @ text @d87 1 a87 1 [] -> @ 1.122 log @/dev/null @ text @d69 2 a70 2 guts <- get return $ case frames guts of d85 2 a86 2 guts <- get case frames guts of d91 1 a91 1 put $ guts { frames = Frame (setVarIn vars) : fs } @ 1.121 log @/dev/null @ text @d147 2 a148 2 j <- get let (f:fs) = frames j d151 1 a151 1 put $ j { frames = f_new : fs } @ 1.120 log @/dev/null @ text @d122 2 a123 2 st <- get let cmds' = cmds st @ 1.119 log @/dev/null @ text @d129 2 a130 2 let zz = findCmd' cmds' rstr zzz <- return $ findCmd' cmds' rstr d135 3 a137 3 findCmd' :: [Cmd] -> String -> Maybe (String, String) findCmd' [] s = Nothing findCmd' (c:cs) s = d141 1 a141 1 else findCmd' cs s @ 1.118 log @/dev/null @ text @d124 1 a124 2 --let rs = map ((substThings' []) . unWord) words r <- substThings' [] (unWord (words !! 0)) d143 3 a145 3 substThings' :: [String] -> [Thing] -> Action substThings' ws [] = return $ Right $ concat ws substThings' ws (t:ts) = do d156 1 a156 1 Right s -> substThings' (s:ws) ts @ 1.117 log @/dev/null @ text @d36 3 a38 1 eval scripts terp = runStateT (runScripts scripts) terp @ 1.116 log @/dev/null @ text @d36 1 a36 4 eval scripts terp = do runStateT (runScripts scripts) terp -- (result2, terp2) <- runStateT (runScripts scripts) terp -- return (result2, terp2) @ 1.115 log @/dev/null @ text @d37 3 a39 2 (result2, terp2) <- runStateT (runScripts scripts) terp return (result2, terp2) @ 1.114 log @/dev/null @ text @d30 1 a30 1 (z, terp2) <- eval scripts freshTerp @ 1.113 log @/dev/null @ text @d30 1 a30 1 z <- eval scripts newTerp d35 1 a35 1 eval :: [Script] -> Terp -> IO Result d38 1 a38 1 return result2 d100 1 a100 1 newTerp = Terp { cmds = [oneCmd], frames = [oneFrame] } @ 1.112 log @/dev/null @ text @a39 16 --putStrLn $ show $ parsed --z' <- eval parsed newTerp --putStrLn $ show z' eval' :: Either ParseError [Script] -> Terp -> IO String eval' (Left err) terp = return $ "ParseError: " ++ show err eval' (Right commands) terp = do (result2, terp2) <- runStateT (runScript (commands !! 0)) newTerp putStrLn $ "result2: " ++ show result2 putStrLn $ "terp2: " ++ show terp2 return $ show result2 --stringify :: Either ParseError [Script] -> String --stringify (Left x) = "ERROR: " ++ (show x) --stringify (Right x) = "PARSED " ++ (show x) a43 1 ---------------------------------------------------------- @ 1.111 log @/dev/null @ text @a39 2 @ 1.110 log @/dev/null @ text @d25 25 a49 8 putStrLn $ show $ parsed z' <- eval parsed newTerp putStrLn $ show z' eval :: Either ParseError [Command] -> Terp -> IO String eval (Left err) terp = return $ "ParseError: " ++ show err eval (Right commands) terp = do (result2, terp2) <- runStateT (runCommand' (commands !! 0)) newTerp d54 1 a54 1 --stringify :: Either ParseError [Command] -> String d127 13 a139 2 runCommand' :: Command -> Action runCommand' (Command words) = do d191 1 a191 1 data Command = Command [Word] d193 2 a194 2 instance Show Command where show (Command things) = "<" ++ (joinOnCommas (map show things)) ++ ">" d196 1 a196 1 parseString :: Parser [Command] d201 1 a201 1 parseCommands :: Parser [Command] d210 1 a210 1 parseCommand :: Parser Command d213 1 a213 1 return $ Command words d238 1 a238 1 parseEnd :: Parser [Command] @ 1.109 log @/dev/null @ text @d24 3 a26 2 putStrLn $ show $ parse parseString "" lines z' <- eval ( parse parseString "" lines ) newTerp @ 1.108 log @/dev/null @ text @d23 1 @ 1.107 log @/dev/null @ text @d24 1 a24 1 z' <- eval'' ( parse parseString "" lines ) newTerp d27 3 a29 3 eval'' :: Either ParseError [Command] -> Terp -> IO String eval'' (Left err) terp = return $ "ParseError: " ++ show err eval'' (Right commands) terp = do @ 1.106 log @/dev/null @ text @d196 2 a197 2 x <- bares return $ BareThing x d199 2 a200 2 x <- varDeref return $ VarThing x d203 1 a203 1 x <- many $ noneOf "]" d205 1 a205 1 return $ CmdThing x @ 1.105 log @/dev/null @ text @d193 1 a193 1 parseBares <|> parseVarDeref d195 1 a195 1 parseBares = do d198 1 a198 1 parseVarDeref = do d201 6 @ 1.104 log @/dev/null @ text @d192 1 a192 1 parseThing = @ 1.103 log @/dev/null @ text @d149 1 a149 1 substThing' (Bare s) = return $ Right s d154 1 a154 1 data Thing = Bare String d192 9 a200 3 parseThing = do x <- bares <|> varDeref return $ Bare x @ 1.102 log @/dev/null @ text @d188 1 d193 1 a193 3 x <- many1 $ noneOf $ specialChars ++ blankChars ++ ";" -- TODO: special chars. many $ oneOf $ blankChars @ 1.101 log @/dev/null @ text @d202 1 d219 5 @ 1.100 log @/dev/null @ text @a162 3 specialChars = "{}[];\"$" blankChars = "\t\v " d202 7 d210 1 a210 1 endCommand = skip $ oneOf $ "\n\r;" @ 1.99 log @/dev/null @ text @d195 1 a195 1 x <- many1 $ noneOf $ specialChars ++ blankChars @ 1.98 log @/dev/null @ text @a163 1 whiteChars = "\t\n\r\v " d181 1 a181 2 skipToNextCommand = skip $ many $ (skip (oneOf whiteChars) <|> comment) d195 1 a195 1 x <- many1 $ noneOf $ specialChars ++ whiteChars d205 1 @ 1.97 log @/dev/null @ text @d207 2 a208 1 esc = skip (char '\\') @ 1.96 log @/dev/null @ text @a184 7 esc = skip (char '\\') comment = do char '#' many $ noneOf "\n" char '\n' return () d207 7 @ 1.95 log @/dev/null @ text @d185 1 a185 1 comment :: Parser () @ 1.94 log @/dev/null @ text @d183 1 a183 1 skip $ many $ ((skip (oneOf whiteChars)) <|> comment) @ 1.93 log @/dev/null @ text @d183 1 a183 1 skip $ many $ ((oneOf whiteChars >> return ()) <|> parseComment) d185 2 a186 2 parseComment :: Parser () parseComment = do @ 1.92 log @/dev/null @ text @d164 2 a165 2 whiteChars = " \t\r\n" blankChars = " \t" d172 1 a172 1 skipComments d181 10 a190 2 skipComments :: Parser () skipComments = skip $ many $ oneOf $ whiteChars ++ specialChars @ 1.91 log @/dev/null @ text @d35 3 a37 3 stringify :: Either ParseError [Command] -> String stringify (Left x) = "ERROR: " ++ (show x) stringify (Right x) = "PARSED " ++ (show x) @ 1.90 log @/dev/null @ text @d23 1 a23 1 putStrLn $ stringify $ parse parseString "" lines @ 1.89 log @/dev/null @ text @d109 2 a110 2 runCommand' (Command things) = do lift $ putStrLn ("RC: " ++ show things) d113 3 a115 2 r <- substThings' [] things lift $ putStrLn ("r: " ++ show r) d117 1 a117 1 Left z -> return r d123 1 d159 4 a162 1 data Command = Command [Thing] d186 7 a192 2 things <- many1 $ parseThing return $ Command things @ 1.88 log @/dev/null @ text @d97 2 a98 2 then (Var name value) : vs else (Var name' value') : (setVarIn vs) @ 1.87 log @/dev/null @ text @d91 1 a91 1 put $ guts { frames = Frame (setVarIn vars ) : fs } d98 1 a98 1 else (Var name' value') : (setVarIn vs ) @ 1.86 log @/dev/null @ text @d91 1 a91 1 put $ guts { frames = Frame (setVarIn vars value) : fs } d94 2 a95 2 setVarIn [] value = [Var name value] setVarIn (Var name' value' : vs) value = d98 1 a98 1 else (Var name' value') : (setVarIn vs value) @ 1.85 log @/dev/null @ text @d87 2 a88 1 [] -> return $ Left $ Err $ "ERROR: empty frames in getLocal " ++ name @ 1.84 log @/dev/null @ text @d72 2 a73 3 f0:fs -> let Frame vars = f0 in case findVarIn vars of d83 16 @ 1.83 log @/dev/null @ text @d75 8 a82 8 Nothing -> Left $ Err $ "ERROR: not found in getLocdal " ++ name Just z -> Right z where findVarIn [] = Nothing findVarIn (Var name' value' : vs) = if name == name' then Just value' else findVarIn vs @ 1.82 log @/dev/null @ text @d74 1 a74 2 in case findVarIn vars of @ 1.81 log @/dev/null @ text @d70 3 a72 3 case frames guts of [] -> return $ Left $ Err $ "ERROR: empty frames in getLocal " ++ name f0:fs -> return $ @ 1.80 log @/dev/null @ text @d72 2 a73 2 f:fs -> return $ let Frame vars = f @ 1.79 log @/dev/null @ text @d69 2 a70 2 t <- get case frames t of @ 1.78 log @/dev/null @ text @a72 2 --case findVarIn varList of --let Frame vars = frames t !! 0 a78 1 --Var varList = frames t !! 0 @ 1.77 log @/dev/null @ text @d58 30 a94 8 -- the state of the Tcl Interpreter, to act on. data Terp = Terp { cmds :: [Cmd], frames :: [Frame] } deriving Show type Act = StateT Terp IO -- Monad resulting in a Result. type Action = Act Result @ 1.76 log @/dev/null @ text @d69 1 a69 2 -- that state, held in a State Mondad. -- type Act = State Terp d71 1 a71 1 -- type Action = Act Result d74 1 a74 6 type Act' = StateT Terp IO -- Monad resulting in a Result. type Action' = Act' Result ---------------------------------------------------------- runCommand' :: Command -> Action' d97 1 a97 1 substThings' :: [String] -> [Thing] -> Action' d112 1 a112 1 substThing' :: Thing -> Action' @ 1.75 log @/dev/null @ text @a23 2 --putStrLn $ show $ eval newTerp $ parse parseString "" lines --z <- eval' newTerp $ parse parseString "" lines a33 14 --eval' :: Terp -> Either ParseError [Command] -> IO Action --eval' terp (Left x) = return $ Left $ Err $ "ERROR: " ++ (show x) --eval' terp (Right x) = return $ do -- z <- runCommand' (x !! 0) -- let (result', terp') = runStateT z terp -- return result' -- eval :: Terp -> Either ParseError [Command] -> Result -- eval terp (Left x) = Left $ Err $ "ERROR: " ++ (show x) -- eval terp (Right x) = -- let (result', terp') = runState (runCommand (x !! 0)) terp -- in result' d70 1 a70 1 type Act = State Terp d72 1 a72 1 type Action = Act Result @ 1.74 log @/dev/null @ text @d126 1 a126 1 let f_new = Frame $ (Var "foo" "bar") : vs @ 1.73 log @/dev/null @ text @d126 1 a126 1 let f_new = Frame $ Var "foo" "bar" : vs @ 1.72 log @/dev/null @ text @d74 1 a74 1 newTerp = Terp { cmds = [oneCmd], frames = [] } d78 2 @ 1.71 log @/dev/null @ text @d33 2 @ 1.70 log @/dev/null @ text @d104 1 a104 1 lift $ putStrLn $ "zzz: " ++ (show zz) @ 1.69 log @/dev/null @ text @d105 1 a105 1 return $ Right (show zzz) @ 1.68 log @/dev/null @ text @d104 1 a104 1 lift $ putStrLn $ "zzz: " ++ (show zzz) @ 1.67 log @/dev/null @ text @d102 1 @ 1.66 log @/dev/null @ text @d103 1 @ 1.65 log @/dev/null @ text @d24 1 a24 1 putStrLn $ show $ eval newTerp $ parse parseString "" lines d43 5 a47 5 eval :: Terp -> Either ParseError [Command] -> Result eval terp (Left x) = Left $ Err $ "ERROR: " ++ (show x) eval terp (Right x) = let (result', terp') = runState (runCommand (x !! 0)) terp in result' d101 3 a103 1 Right rstr -> return $ Right (show (findCmd cmds' rstr)) a131 27 runCommand :: Command -> Action runCommand (Command things) = do st <- get let cmds' = cmds st r <- substThings [] things case r of Left z -> return r Right rstr -> return $ Right (show (findCmd cmds' rstr)) findCmd :: [Cmd] -> String -> Maybe (String, String) findCmd [] s = Nothing findCmd (c:cs) s = let Cmd name [args] body = c in if s == name then Just (args, body ++ " // " ++ s ++ " // " ++ name) -- HACK else findCmd cs s substThings :: [String] -> [Thing] -> State Terp Result substThings ws [] = return $ Right $ concat ws substThings ws (t:ts) = do a <- substThing t case a of Left z -> return $ Left z Right s -> substThings (s:ws) ts where substThing :: Thing -> State Terp Result substThing (Bare s) = return $ Right s @ 1.64 log @/dev/null @ text @d114 1 d120 1 @ 1.63 log @/dev/null @ text @d115 4 a118 2 let f:fs = frames j put $ j { cmds = (cmds j) } @ 1.62 log @/dev/null @ text @d115 1 @ 1.61 log @/dev/null @ text @d115 1 @ 1.60 log @/dev/null @ text @d114 1 @ 1.59 log @/dev/null @ text @d98 1 @ 1.58 log @/dev/null @ text @d94 1 @ 1.57 log @/dev/null @ text @d25 17 @ 1.56 log @/dev/null @ text @d75 29 @ 1.55 log @/dev/null @ text @a75 1 --runCommand (Command (Bare "puts" : ts)) = do @ 1.54 log @/dev/null @ text @d55 6 a68 4 oneCmd :: Cmd oneCmd = Cmd "threetwoone" ["one_arg"] "one_body" newTerp = Terp { cmds = [oneCmd], frames = [] } @ 1.53 log @/dev/null @ text @d68 5 @ 1.52 log @/dev/null @ text @a77 3 --let cmd' = findCmd cmds' (show r) --return $ Right (show cmd') @ 1.51 log @/dev/null @ text @d85 1 a85 1 in if s == name || s == s ------------ HACKED. @ 1.50 log @/dev/null @ text @d74 6 a79 2 let cmd' = findCmd cmds' (show r) return $ Right (show cmd') @ 1.49 log @/dev/null @ text @d64 1 a64 1 oneCmd = Cmd "one" ["one_arg"] "one_body" @ 1.48 log @/dev/null @ text @d82 1 a82 1 then Just (args, body ++ " // " ++ s ++ " // " ++ name) @ 1.47 log @/dev/null @ text @d81 1 a81 1 in if s == name || s == s @ 1.46 log @/dev/null @ text @d64 1 a64 1 oneCmd = Cmd "threetwoone" ["one_arg"] "one_body" d81 2 a82 2 in if s == name then Just (args, body) d132 1 a132 1 -- TODO: special chars, jammed things. @ 1.45 log @/dev/null @ text @d64 1 a64 1 oneCmd = Cmd "onetwothree" ["one_arg"] "one_body" d81 2 a82 2 in if s == s || s == name then Just (args, body ++ "/" ++ s ++ "/" ++ name) @ 1.44 log @/dev/null @ text @d82 1 a82 1 then Just (args, body) @ 1.43 log @/dev/null @ text @d81 1 a81 1 in if s == name @ 1.42 log @/dev/null @ text @d64 1 a64 1 oneCmd = Cmd "one" ["one_arg"] "one_body" @ 1.41 log @/dev/null @ text @d132 1 @ 1.40 log @/dev/null @ text @d94 1 a94 1 substThing (VarThing s) = return $ Right s @ 1.39 log @/dev/null @ text @d94 1 a94 1 substThing (Bare s) = return $ Right s @ 1.38 log @/dev/null @ text @d94 1 a94 2 substThing (Bare s) = do return $ Right s @ 1.37 log @/dev/null @ text @d93 3 a95 3 substThing :: Thing -> State Terp Result substThing (Bare s) = do return $ Right s @ 1.36 log @/dev/null @ text @d92 1 a92 1 @ 1.35 log @/dev/null @ text @d84 1 @ 1.34 log @/dev/null @ text @d77 7 a91 1 a94 10 findCmd :: [Cmd] -> String -> Maybe (String, String) findCmd [] s = Nothing findCmd (c:cs) s = let Cmd name [args] body = c in if s == name then Just (args, body) else findCmd cs s @ 1.33 log @/dev/null @ text @d64 1 a64 1 oneCmd = Cmd "onetwothree" ["one_arg"] "one_body" @ 1.32 log @/dev/null @ text @d65 1 a65 1 newTerp = Terp { cmds = [], frames = [] } @ 1.31 log @/dev/null @ text @d64 1 a64 1 oneCmd = Cmd "one" ["one_arg"] "one_body" @ 1.30 log @/dev/null @ text @d63 2 @ 1.29 log @/dev/null @ text @d24 1 a24 1 putStrLn $ show $ eval emptyTerp $ parse parseString "" lines d63 1 a63 1 emptyTerp = Terp { cmds = [], frames = [] } @ 1.28 log @/dev/null @ text @d73 1 a73 1 return $ Right "foo" @ 1.27 log @/dev/null @ text @d68 1 a68 1 runCommand _ = do d71 2 @ 1.26 log @/dev/null @ text @d71 1 a71 1 return $ Right "" @ 1.25 log @/dev/null @ text @d24 7 d63 1 a63 1 emptyState = Terp { cmds = [], frames = [] } a71 6 xrunCommand :: Command -> Act () xrunCommand _ = do st <- get return $ () @ 1.24 log @/dev/null @ text @d74 5 a78 1 substThings ws (t:ts) = return $ Right $ concat ws @ 1.23 log @/dev/null @ text @d73 2 a74 2 substThings ws [] = do return $ Right $ concat ws @ 1.22 log @/dev/null @ text @d72 5 @ 1.21 log @/dev/null @ text @d52 1 a52 1 --type Act = State Terp d54 1 a54 1 -- type Action = Act Result d59 1 a59 1 runCommand :: Command -> State Terp Result d66 1 a66 1 xrunCommand :: Command -> State Terp () d68 1 a68 1 s <- get d72 4 @ 1.20 log @/dev/null @ text @d63 1 a63 1 let y = cmds st @ 1.19 log @/dev/null @ text @d62 2 a63 1 x <- get @ 1.18 log @/dev/null @ text @d16 1 d18 1 a18 1 import Text.ParserCombinators.Parsec d35 1 a35 1 data Result = Either NotOk String d49 1 a49 1 data ActState = ActState { cmds :: [Cmd], frames :: [Frame] } d52 1 a52 1 type Act = State ActState d54 1 a54 1 type Action = Act Result d56 1 a56 1 emptyState = ActState { cmds = [], frames = [] } d59 5 a63 3 runCommand :: Command -> Act Result runCommand (Command ("puts" : ts)) = do blah. d65 6 d72 8 @ 1.17 log @/deb/null @ text @d58 6 @ 1.16 log @/deb/null @ text @a23 1 @ 1.15 log @/deb/null @ text @d30 1 a30 1 joinOnCommas ss = foldr (\ x y -> x ++ ";" ++ y) ":" ss @ 1.14 log @/deb/null @ text @d30 1 a30 1 joinOnCommas ss = foldr (\ x y -> x ++ "," ++ y) "." ss @ 1.13 log @/deb/null @ text @d71 1 a71 1 show (Command things) = joinOnCommas (map show things) @ 1.12 log @/deb/null @ text @d67 2 a68 1 whiteChars = "\t\r\n" d95 1 @ 1.11 log @/deb/null @ text @a28 14 -- args <- getArgs -- --putStrLn $ joinOnCommas args -- --putStrLn $ joinOnCommas ["one","two","three"] -- lines <- getContents -- let emap = parseEmap "stdin" lines -- putStrLn $ elmShow emap -- putStrLn $ joinOnCommas $ map (elmLookupAsStr emap) args parseEmap :: String -> String -> Either ParseError LMap parseEmap name input = parse parseFile name input a58 30 ---------------------------------------------------------- data LMap = LMapNode String String LMap | LMapNil instance Show LMap where show (LMapNode k v ms) = show k ++ "=" ++ show v ++ "," ++ show ms show (LMapNil) = "Nil" type EMap = Either ParseError LMap elmShow :: EMap -> String elmShow (Left s) = "\nfail ******\n" ++ show s ++ "\n******\n" elmShow (Right lmap) = show lmap elmLookupAsStr :: EMap -> String -> String elmLookupAsStr (Left _) key = "FAIL" elmLookupAsStr (Right lmap) key = lmLookupAsStr lmap key lmLookup :: LMap -> String -> Maybe String lmLookup (LMapNil) _ = Nothing lmLookup (LMapNode k v ms) key | k == key = Just v | otherwise = lmLookup ms key lmLookupAsStr :: LMap -> String -> String lmLookupAsStr ms key = case lmLookup ms key of Just s -> s Nothing -> "NotFound" a59 1 ---------------------------------------------------------- a100 28 ---------------------------------------------------------- parseFile :: Parser LMap parseFile = parseEof <|> parseLine parseLine :: Parser LMap parseLine = do skipWhite k <- many $ noneOf ("=" ++ white) skipWhite char '=' v <- many $ noneOf white char '\n' lmap <- parseFile return (LMapNode k v lmap) parseEof :: Parser LMap parseEof = do eof return (LMapNil) white :: String white = " \t\r\n" skipWhite :: Parser () skipWhite = skip $ many $ oneOf white @ 1.10 log @/deb/null @ text @d133 1 a133 1 things <- many $ parseThing d138 1 a138 1 x <- many $ noneOf $ specialChars ++ whiteChars @ 1.9 log @/deb/null @ text @a20 3 args <- getArgs --putStrLn $ joinOnCommas args --putStrLn $ joinOnCommas ["one","two","three"] d22 16 a37 3 let emap = parseEmap "stdin" lines putStrLn $ elmShow emap putStrLn $ joinOnCommas $ map (elmLookupAsStr emap) args d70 2 d108 1 d114 3 @ 1.8 log @/deb/null @ text @a59 1 @ 1.7 log @/deb/null @ text @d54 1 @ 1.6 log @/deb/null @ text @d41 1 d44 1 d46 1 d48 1 d50 1 @ 1.5 log @/deb/null @ text @d88 38 @ 1.4 log @/deb/null @ text @d47 1 d49 1 d51 1 d53 2 @ 1.3 log @/deb/null @ text @d47 3 a49 1 data TclState = TclState { cmds :: [Cmd], frames :: [Frame] } @ 1.2 log @/deb/null @ text @d39 5 a45 2 data Result = Either NotOk String data NotOk = Err String | Return String | Break | Continue d47 1 @ 1.1 log @/deb/null @ text @d39 4 @