Superplansky plant v0.1.0 · formerlab.tngl.sh/superplansky@d83a396

+89

.gitignore

··· 1 + # ========================= 2 + # General 3 + # ========================= 4 + .DS_Store 5 + Thumbs.db 6 + *.swp 7 + *.swo 8 + *~ 9 + *.log 10 + 11 + # ========================= 12 + # Editor / IDE 13 + # ========================= 14 + .vscode/ 15 + .idea/ 16 + *.code-workspace 17 + 18 + # ========================= 19 + # Lisp / SBCL 20 + # ========================= 21 + *.fasl 22 + *.fas 23 + *.lx64fsl 24 + *.x86f 25 + *.lib 26 + *.cfasl 27 + *.ufasl 28 + *.lbin 29 + 30 + # SBCL cache / build leftovers 31 + .sbclrc 32 + .cache/ 33 + .local/ 34 + 35 + # ========================= 36 + # Rust 37 + # ========================= 38 + bridgetarget/ 39 + target/ 40 + Cargo.lock 41 + 42 + # (optional: keep Cargo.lock if you later want reproducible builds) 43 + # !Cargo.lock 44 + 45 + # ========================= 46 + # Python (if used later) 47 + # ========================= 48 + __pycache__/ 49 + *.pyc 50 + *.pyo 51 + *.pyd 52 + .env 53 + .venv/ 54 + 55 + # ========================= 56 + # Build / temp 57 + # ========================= 58 + build/ 59 + dist/ 60 + tmp/ 61 + temp/ 62 + 63 + # ========================= 64 + # Secrets / local config 65 + # ========================= 66 + .env 67 + .env.* 68 + secrets/ 69 + *.key 70 + *.pem 71 + 72 + # ========================= 73 + # Runtime artifacts 74 + # ========================= 75 + *.pid 76 + *.sock 77 + 78 + # ========================= 79 + # Logs from your system 80 + # ========================= 81 + logs/ 82 + *.out 83 + 84 + # ========================= 85 + # Node (future UI / PWA) 86 + # ========================= 87 + node_modules/ 88 + package-lock.json 89 + yarn.lock

+54

README.md

··· 1 + # Superplan AT Proto Project 2 + 3 + Historical-language systems lab for a terminal Bluesky / AT Protocol client. 4 + 5 + ## Stack 6 + 7 + - Superplan-26: main visible language 8 + - Lisp: parser, interpreter, meta-tooling 9 + - ALGOL influence: syntax and block structure 10 + - Plankalkül influence: typed data model ideas 11 + - Rust bridge: protocol edge only 12 + 13 + ## Current state 14 + 15 + This repo currently includes: 16 + 17 + - vision and language docs 18 + - Superplan example program 19 + - Common Lisp lexer, parser, AST, pretty printer, interpreter 20 + - fake Lisp bridge process over stdin/stdout 21 + - fake Rust bridge preserving the same ABI 22 + 23 + ## Quick start 24 + 25 + ### 1. Install prerequisites 26 + 27 + - SBCL 28 + - Rust / Cargo 29 + 30 + ### 2. Run the Rust fake bridge directly 31 + 32 + ```bash 33 + cd bridge 34 + cargo run 35 + ``` 36 + 37 + ### 3. Run the Lisp parser + interpreter 38 + 39 + From repo root: 40 + 41 + ```bash 42 + sbcl --script lisp-tools/parser/run.lisp 43 + ``` 44 + 45 + By default, the interpreter tries to launch the Rust bridge first and falls back to the Lisp bridge if Rust is unavailable. 46 + 47 + ## Repo layout 48 + 49 + - `docs/` — vision, language spec, grammar, ABI 50 + - `superplan/examples/` — `.sp` examples 51 + - `lisp-tools/parser/` — lexer, parser, AST, pretty printer, runner 52 + - `lisp-tools/interpreter/` — environment, bridge client, interpreter 53 + - `lisp-tools/bridge/` — fake Lisp bridge 54 + - `bridge/` — fake Rust bridge

+10

bridge/Cargo.toml

··· 1 + [package] 2 + name = "superplan-atproto-bridge" 3 + version = "0.1.0" 4 + edition = "2021" 5 + 6 + [dependencies] 7 + chrono = { version = "0.4", features = ["clock"] } 8 + reqwest = { version = "0.12", features = ["blocking", "json", "rustls-tls"] } 9 + serde = { version = "1", features = ["derive"] } 10 + serde_json = "1"

+600

bridge/src/main.rs

··· 1 + use reqwest::blocking::Client; 2 + use reqwest::header::{AUTHORIZATION, CONTENT_TYPE}; 3 + use serde_json::{json, Value}; 4 + use std::io::{self, BufRead, Write}; 5 + 6 + const PUBLIC_API: &str = "https://public.api.bsky.app"; 7 + 8 + #[derive(Debug, Default, Clone)] 9 + struct Session { 10 + did: String, 11 + handle: String, 12 + access_jwt: String, 13 + refresh_jwt: String, 14 + pds_url: String, 15 + } 16 + 17 + fn main() { 18 + let client = Client::builder() 19 + .user_agent("superplan-atproto-bridge/0.1.0") 20 + .build() 21 + .expect("failed to build reqwest client"); 22 + 23 + let stdin = io::stdin(); 24 + let mut stdout = io::stdout(); 25 + let mut session: Option<Session> = None; 26 + 27 + for line_result in stdin.lock().lines() { 28 + let line = match line_result { 29 + Ok(v) => v, 30 + Err(err) => { 31 + let _ = writeln!( 32 + stdout, 33 + "{}", 34 + json!({ 35 + "id": 0, 36 + "ok": false, 37 + "error": format!("stdin read error: {}", err) 38 + }) 39 + ); 40 + let _ = stdout.flush(); 41 + continue; 42 + } 43 + }; 44 + 45 + if line.trim().is_empty() { 46 + continue; 47 + } 48 + 49 + let req: Value = match serde_json::from_str(&line) { 50 + Ok(v) => v, 51 + Err(err) => { 52 + let _ = writeln!( 53 + stdout, 54 + "{}", 55 + json!({ 56 + "id": 0, 57 + "ok": false, 58 + "error": format!("invalid json request: {}", err) 59 + }) 60 + ); 61 + let _ = stdout.flush(); 62 + continue; 63 + } 64 + }; 65 + 66 + let id = req.get("id").and_then(Value::as_i64).unwrap_or(0); 67 + let op = req.get("op").and_then(Value::as_str).unwrap_or(""); 68 + 69 + let resp = match op { 70 + "login" => handle_login_real(&client, id, &req, &mut session), 71 + "timeline" => handle_timeline_real(&client, id, &req, &session), 72 + "profile" => handle_profile_real(&client, id, &req), 73 + "thread" => handle_thread_fake(id, &req), 74 + "post" => handle_post_real(&client, id, &req, &session), 75 + "notifications" => handle_notifications_fake(id, &req), 76 + "whoami" => handle_whoami(id, &session), 77 + _ => json!({ 78 + "id": id, 79 + "ok": false, 80 + "error": format!("unknown op: {}", op) 81 + }), 82 + }; 83 + 84 + if writeln!(stdout, "{}", resp).is_err() { 85 + break; 86 + } 87 + if stdout.flush().is_err() { 88 + break; 89 + } 90 + } 91 + } 92 + 93 + fn handle_login_real( 94 + client: &Client, 95 + id: i64, 96 + req: &Value, 97 + session: &mut Option<Session>, 98 + ) -> Value { 99 + let identifier = req 100 + .get("identifier") 101 + .and_then(Value::as_str) 102 + .unwrap_or("") 103 + .trim(); 104 + 105 + let password = req 106 + .get("password") 107 + .and_then(Value::as_str) 108 + .unwrap_or("") 109 + .trim(); 110 + 111 + if identifier.is_empty() || password.is_empty() { 112 + return json!({ 113 + "id": id, 114 + "ok": false, 115 + "error": "missing identifier or password" 116 + }); 117 + } 118 + 119 + let pds = match resolve_pds_for_identifier(client, identifier) { 120 + Ok(url) => url, 121 + Err(err) => { 122 + return json!({ 123 + "id": id, 124 + "ok": false, 125 + "error": format!("pds resolution failed: {}", err) 126 + }); 127 + } 128 + }; 129 + 130 + let url = format!("{}/xrpc/com.atproto.server.createSession", pds); 131 + 132 + let response = match client 133 + .post(url) 134 + .header(CONTENT_TYPE, "application/json") 135 + .json(&json!({ 136 + "identifier": identifier, 137 + "password": password 138 + })) 139 + .send() 140 + { 141 + Ok(r) => r, 142 + Err(err) => { 143 + return json!({ 144 + "id": id, 145 + "ok": false, 146 + "error": format!("session request failed: {}", err) 147 + }); 148 + } 149 + }; 150 + 151 + let status = response.status(); 152 + 153 + let body: Value = match response.json() { 154 + Ok(v) => v, 155 + Err(err) => { 156 + return json!({ 157 + "id": id, 158 + "ok": false, 159 + "error": format!("invalid session response json: {}", err) 160 + }); 161 + } 162 + }; 163 + 164 + if !status.is_success() { 165 + return json!({ 166 + "id": id, 167 + "ok": false, 168 + "error": format!("http {}", status), 169 + "details": body 170 + }); 171 + } 172 + 173 + let did = body.get("did").and_then(Value::as_str).unwrap_or("").to_string(); 174 + let handle = body.get("handle").and_then(Value::as_str).unwrap_or("").to_string(); 175 + let access_jwt = body 176 + .get("accessJwt") 177 + .and_then(Value::as_str) 178 + .unwrap_or("") 179 + .to_string(); 180 + let refresh_jwt = body 181 + .get("refreshJwt") 182 + .and_then(Value::as_str) 183 + .unwrap_or("") 184 + .to_string(); 185 + 186 + if did.is_empty() || access_jwt.is_empty() { 187 + return json!({ 188 + "id": id, 189 + "ok": false, 190 + "error": "session response missing required fields" 191 + }); 192 + } 193 + 194 + *session = Some(Session { 195 + did: did.clone(), 196 + handle: handle.clone(), 197 + access_jwt, 198 + refresh_jwt, 199 + pds_url: pds.clone(), 200 + }); 201 + 202 + json!({ 203 + "id": id, 204 + "ok": true, 205 + "value": { 206 + "success": true, 207 + "did": did, 208 + "handle": handle, 209 + "pds": pds 210 + } 211 + }) 212 + } 213 + 214 + fn resolve_pds_for_identifier(client: &Client, identifier: &str) -> Result<String, String> { 215 + let did = if identifier.starts_with("did:") { 216 + identifier.to_string() 217 + } else { 218 + resolve_handle_to_did(client, identifier)? 219 + }; 220 + 221 + resolve_did_to_pds(client, &did) 222 + } 223 + 224 + fn resolve_handle_to_did(client: &Client, handle: &str) -> Result<String, String> { 225 + let url = format!("{}/xrpc/com.atproto.identity.resolveHandle", PUBLIC_API); 226 + 227 + let response = client 228 + .get(url) 229 + .query(&[("handle", handle)]) 230 + .send() 231 + .map_err(|e| e.to_string())?; 232 + 233 + let status = response.status(); 234 + let body: Value = response.json().map_err(|e| e.to_string())?; 235 + 236 + if !status.is_success() { 237 + return Err(format!("resolveHandle http {} body={}", status, body)); 238 + } 239 + 240 + body.get("did") 241 + .and_then(Value::as_str) 242 + .map(|s| s.to_string()) 243 + .ok_or_else(|| "resolveHandle missing did".to_string()) 244 + } 245 + 246 + fn resolve_did_to_pds(client: &Client, did: &str) -> Result<String, String> { 247 + if did.starts_with("did:plc:") { 248 + let url = format!("https://plc.directory/{}", did); 249 + let response = client.get(url).send().map_err(|e| e.to_string())?; 250 + let status = response.status(); 251 + let body: Value = response.json().map_err(|e| e.to_string())?; 252 + 253 + if !status.is_success() { 254 + return Err(format!("plc lookup http {} body={}", status, body)); 255 + } 256 + 257 + return extract_pds_from_did_doc(&body); 258 + } 259 + 260 + if did.starts_with("did:web:") { 261 + let host = did.trim_start_matches("did:web:"); 262 + let url = format!("https://{}/.well-known/did.json", host); 263 + let response = client.get(url).send().map_err(|e| e.to_string())?; 264 + let status = response.status(); 265 + let body: Value = response.json().map_err(|e| e.to_string())?; 266 + 267 + if !status.is_success() { 268 + return Err(format!("did:web lookup http {} body={}", status, body)); 269 + } 270 + 271 + return extract_pds_from_did_doc(&body); 272 + } 273 + 274 + Err(format!("unsupported did method: {}", did)) 275 + } 276 + 277 + fn extract_pds_from_did_doc(doc: &Value) -> Result<String, String> { 278 + let services = doc 279 + .get("service") 280 + .and_then(Value::as_array) 281 + .ok_or_else(|| "did document missing service array".to_string())?; 282 + 283 + for svc in services { 284 + let svc_type = svc.get("type").and_then(Value::as_str).unwrap_or(""); 285 + if svc_type == "AtprotoPersonalDataServer" { 286 + if let Some(endpoint) = svc.get("serviceEndpoint").and_then(Value::as_str) { 287 + return Ok(endpoint.trim_end_matches('/').to_string()); 288 + } 289 + } 290 + } 291 + 292 + Err("no AtprotoPersonalDataServer service found".to_string()) 293 + } 294 + 295 + fn handle_profile_real(client: &Client, id: i64, req: &Value) -> Value { 296 + let actor = req 297 + .get("actor") 298 + .and_then(Value::as_str) 299 + .unwrap_or("") 300 + .trim(); 301 + 302 + if actor.is_empty() { 303 + return json!({ 304 + "id": id, 305 + "ok": false, 306 + "error": "missing actor" 307 + }); 308 + } 309 + 310 + let url = format!("{}/xrpc/app.bsky.actor.getProfile", PUBLIC_API); 311 + 312 + let response = match client.get(url).query(&[("actor", actor)]).send() { 313 + Ok(r) => r, 314 + Err(err) => { 315 + return json!({ 316 + "id": id, 317 + "ok": false, 318 + "error": format!("request failed: {}", err) 319 + }); 320 + } 321 + }; 322 + 323 + let status = response.status(); 324 + 325 + let body: Value = match response.json() { 326 + Ok(v) => v, 327 + Err(err) => { 328 + return json!({ 329 + "id": id, 330 + "ok": false, 331 + "error": format!("invalid json response: {}", err) 332 + }); 333 + } 334 + }; 335 + 336 + if !status.is_success() { 337 + return json!({ 338 + "id": id, 339 + "ok": false, 340 + "error": format!("http {}", status), 341 + "details": body 342 + }); 343 + } 344 + 345 + json!({ 346 + "id": id, 347 + "ok": true, 348 + "value": { 349 + "handle": body.get("handle").cloned().unwrap_or(Value::Null), 350 + "displayName": body.get("displayName").cloned().unwrap_or(Value::Null), 351 + "did": body.get("did").cloned().unwrap_or(Value::Null), 352 + "description": body.get("description").cloned().unwrap_or(Value::Null) 353 + } 354 + }) 355 + } 356 + 357 + fn handle_timeline_real(client: &Client, id: i64, req: &Value, session: &Option<Session>) -> Value { 358 + let sess = match session { 359 + Some(s) => s, 360 + None => { 361 + return json!({ 362 + "id": id, 363 + "ok": false, 364 + "error": "not logged in" 365 + }); 366 + } 367 + }; 368 + 369 + let cursor = req 370 + .get("cursor") 371 + .and_then(Value::as_str) 372 + .unwrap_or("") 373 + .trim(); 374 + 375 + let url = format!("{}/xrpc/app.bsky.feed.getTimeline", sess.pds_url); 376 + 377 + let mut request = client 378 + .get(url) 379 + .header(AUTHORIZATION, format!("Bearer {}", sess.access_jwt)); 380 + 381 + if !cursor.is_empty() { 382 + request = request.query(&[("cursor", cursor)]); 383 + } 384 + 385 + let response = match request.send() { 386 + Ok(r) => r, 387 + Err(err) => { 388 + return json!({ 389 + "id": id, 390 + "ok": false, 391 + "error": format!("timeline request failed: {}", err) 392 + }); 393 + } 394 + }; 395 + 396 + let status = response.status(); 397 + 398 + let body: Value = match response.json() { 399 + Ok(v) => v, 400 + Err(err) => { 401 + return json!({ 402 + "id": id, 403 + "ok": false, 404 + "error": format!("invalid timeline response json: {}", err) 405 + }); 406 + } 407 + }; 408 + 409 + if !status.is_success() { 410 + return json!({ 411 + "id": id, 412 + "ok": false, 413 + "error": format!("http {}", status), 414 + "details": body 415 + }); 416 + } 417 + 418 + let feed_items = body 419 + .get("feed") 420 + .and_then(Value::as_array) 421 + .cloned() 422 + .unwrap_or_default(); 423 + 424 + let normalized_feed: Vec<Value> = feed_items 425 + .into_iter() 426 + .map(|item| { 427 + let post = item.get("post").cloned().unwrap_or(Value::Null); 428 + 429 + let text = post 430 + .get("record") 431 + .and_then(|r| r.get("text")) 432 + .and_then(Value::as_str) 433 + .unwrap_or("") 434 + .to_string(); 435 + 436 + let author_handle = post 437 + .get("author") 438 + .and_then(|a| a.get("handle")) 439 + .and_then(Value::as_str) 440 + .unwrap_or("") 441 + .to_string(); 442 + 443 + let uri = post 444 + .get("uri") 445 + .and_then(Value::as_str) 446 + .unwrap_or("") 447 + .to_string(); 448 + 449 + json!({ 450 + "text": text, 451 + "authorHandle": author_handle, 452 + "uri": uri 453 + }) 454 + }) 455 + .collect(); 456 + 457 + json!({ 458 + "id": id, 459 + "ok": true, 460 + "value": { 461 + "feed": normalized_feed, 462 + "cursor": body.get("cursor").cloned().unwrap_or(Value::Null) 463 + } 464 + }) 465 + } 466 + 467 + fn handle_thread_fake(id: i64, _req: &Value) -> Value { 468 + json!({ 469 + "id": id, 470 + "ok": true, 471 + "value": { 472 + "thread": { 473 + "post": { 474 + "text": "Fake thread root from bridge" 475 + } 476 + } 477 + } 478 + }) 479 + } 480 + 481 + fn handle_post_real(client: &Client, id: i64, req: &Value, session: &Option<Session>) -> Value { 482 + let sess = match session { 483 + Some(s) => s, 484 + None => { 485 + return json!({ 486 + "id": id, 487 + "ok": false, 488 + "error": "not logged in" 489 + }); 490 + } 491 + }; 492 + 493 + let text = req 494 + .get("text") 495 + .and_then(Value::as_str) 496 + .unwrap_or("") 497 + .trim() 498 + .to_string(); 499 + 500 + if text.is_empty() { 501 + return json!({ 502 + "id": id, 503 + "ok": false, 504 + "error": "empty post text" 505 + }); 506 + } 507 + 508 + let url = format!("{}/xrpc/com.atproto.repo.createRecord", sess.pds_url); 509 + 510 + let created_at = chrono::Utc::now().to_rfc3339_opts(chrono::SecondsFormat::Secs, true); 511 + 512 + let payload = json!({ 513 + "repo": sess.did, 514 + "collection": "app.bsky.feed.post", 515 + "record": { 516 + "$type": "app.bsky.feed.post", 517 + "text": text, 518 + "createdAt": created_at 519 + } 520 + }); 521 + 522 + let response = match client 523 + .post(url) 524 + .header(AUTHORIZATION, format!("Bearer {}", sess.access_jwt)) 525 + .header(CONTENT_TYPE, "application/json") 526 + .json(&payload) 527 + .send() 528 + { 529 + Ok(r) => r, 530 + Err(err) => { 531 + return json!({ 532 + "id": id, 533 + "ok": false, 534 + "error": format!("post request failed: {}", err) 535 + }); 536 + } 537 + }; 538 + 539 + let status = response.status(); 540 + 541 + let body: Value = match response.json() { 542 + Ok(v) => v, 543 + Err(err) => { 544 + return json!({ 545 + "id": id, 546 + "ok": false, 547 + "error": format!("invalid post response json: {}", err) 548 + }); 549 + } 550 + }; 551 + 552 + if !status.is_success() { 553 + return json!({ 554 + "id": id, 555 + "ok": false, 556 + "error": format!("http {}", status), 557 + "details": body 558 + }); 559 + } 560 + 561 + json!({ 562 + "id": id, 563 + "ok": true, 564 + "value": { 565 + "success": true, 566 + "uri": body.get("uri").cloned().unwrap_or(Value::Null), 567 + "cid": body.get("cid").cloned().unwrap_or(Value::Null) 568 + } 569 + }) 570 + } 571 + 572 + fn handle_notifications_fake(id: i64, _req: &Value) -> Value { 573 + json!({ 574 + "id": id, 575 + "ok": true, 576 + "value": { 577 + "notifications": [] 578 + } 579 + }) 580 + } 581 + 582 + fn handle_whoami(id: i64, session: &Option<Session>) -> Value { 583 + match session { 584 + Some(s) => json!({ 585 + "id": id, 586 + "ok": true, 587 + "value": { 588 + "did": s.did, 589 + "handle": s.handle, 590 + "pds": s.pds_url, 591 + "hasRefreshJwt": !s.refresh_jwt.is_empty() 592 + } 593 + }), 594 + None => json!({ 595 + "id": id, 596 + "ok": false, 597 + "error": "not logged in" 598 + }), 599 + } 600 + }

+70

docs/bridge-abi.md

··· 1 + # AT Proto Bridge ABI 2 + 3 + ## Overview 4 + 5 + Superplan runtime communicates with the bridge using: 6 + - stdin/stdout 7 + - newline-delimited JSON (NDJSON) 8 + 9 + ## Request Format 10 + 11 + ```json 12 + {"id":1,"op":"timeline","cursor":""} 13 + ``` 14 + 15 + ## Response Format 16 + 17 + ```json 18 + {"id":1,"ok":true,"value":{...}} 19 + ``` 20 + 21 + Error: 22 + ```json 23 + {"id":1,"ok":false,"error":"message"} 24 + ``` 25 + 26 + ## Operations 27 + 28 + ### login 29 + ```json 30 + {"op":"login","identifier":"user","password":"app-password"} 31 + ``` 32 + 33 + ### timeline 34 + ```json 35 + {"op":"timeline","cursor":""} 36 + ``` 37 + 38 + ### profile 39 + ```json 40 + {"op":"profile","actor":"did_or_handle"} 41 + ``` 42 + 43 + ### thread 44 + ```json 45 + {"op":"thread","uri":"at://..."} 46 + ``` 47 + 48 + ### post 49 + ```json 50 + {"op":"post","text":"hello"} 51 + ``` 52 + 53 + ### notifications 54 + ```json 55 + {"op":"notifications"} 56 + ``` 57 + 58 + ## Mapping to AT Proto 59 + 60 + - login → com.atproto.server.createSession 61 + - timeline → app.bsky.feed.getTimeline 62 + - profile → app.bsky.actor.getProfile 63 + - thread → app.bsky.feed.getPostThread 64 + - post → com.atproto.repo.createRecord 65 + 66 + ## Notes 67 + 68 + - Bridge handles auth + refresh tokens 69 + - Superplan runtime never sees tokens 70 + - JSON is returned as-is for runtime inspection

+62

docs/grammar-ebnf.md

··· 1 + # Superplan-26 Grammar (EBNF) 2 + 3 + program = "PROGRAM" ident decls "BEGIN" stmts "END" ; 4 + 5 + decls = { decl } ; 6 + decl = type ident | array_decl ; 7 + 8 + array_decl = "ARRAY" type ident "[" number "]" ; 9 + 10 + type = "INTEGER" | "BOOLEAN" | "STRING" | "JSON" ; 11 + 12 + stmts = { stmt } ; 13 + 14 + stmt = 15 + assign 16 + | write 17 + | read 18 + | if_stmt 19 + | while_stmt 20 + | for_stmt 21 + | call 22 + | stop 23 + | proc_decl ; 24 + 25 + assign = ident "=" expr ; 26 + 27 + write = "WRITE" "(" expr ")" ; 28 + 29 + read = ident "=" "READLINE" "(" ")" ; 30 + 31 + if_stmt = "IF" expr "THEN" stmts "END" ; 32 + 33 + while_stmt = "WHILE" expr "DO" stmts "END" ; 34 + 35 + for_stmt = "FOR" ident "=" expr "TO" expr "STEP" expr "DO" stmts "END" ; 36 + 37 + call = "CALL" ident "(" [ args ] ")" ; 38 + 39 + args = expr { "," expr } ; 40 + 41 + proc_decl = "PROCEDURE" ident "(" [ params ] ")" "BEGIN" stmts "END" ; 42 + 43 + params = param { "," param } ; 44 + param = type ident ; 45 + 46 + stop = "STOP" ; 47 + 48 + expr = term { ("+" | "-") term } ; 49 + term = factor { ("*" | "/") factor } ; 50 + 51 + factor = 52 + ident 53 + | number 54 + | string 55 + | "(" expr ")" 56 + | func_call ; 57 + 58 + func_call = ident "(" [ args ] ")" ; 59 + 60 + ident = letter { letter | digit | "_" } ; 61 + number = digit { digit } ; 62 + string = '"' { any_char } '"' ;

+165

docs/superplan-26-spec.md

··· 1 + # Superplan-26 Specification (v0) 2 + 3 + ## Overview 4 + 5 + Superplan-26 is a modern reconstruction inspired by early high-level languages such as Superplan and ALGOL. 6 + 7 + It is: 8 + - procedural 9 + - statically typed 10 + - deterministic 11 + - designed for terminal applications and system control 12 + 13 + ## Program Structure 14 + 15 + ```text 16 + PROGRAM NAME 17 + 18 + <declarations> 19 + 20 + BEGIN 21 + <statements> 22 + END 23 + ``` 24 + 25 + ## Types 26 + 27 + ### Primitive 28 + - INTEGER 29 + - BOOLEAN 30 + - STRING 31 + - JSON 32 + 33 + ### Composite 34 + ```text 35 + ARRAY <TYPE> NAME[N] 36 + ``` 37 + 38 + Example: 39 + ```text 40 + INTEGER I 41 + STRING CMD 42 + JSON TL 43 + ARRAY STRING LINES[10] 44 + ``` 45 + 46 + ## Statements 47 + 48 + ### Assignment 49 + ```text 50 + X = 10 51 + NAME = "hello" 52 + ``` 53 + 54 + ### Output 55 + ```text 56 + WRITE("TEXT") 57 + WRITE(NAME) 58 + ``` 59 + 60 + ### Input 61 + ```text 62 + NAME = READLINE() 63 + ``` 64 + 65 + ### Conditional 66 + ```text 67 + IF X = 1 THEN 68 + WRITE("ONE") 69 + END 70 + ``` 71 + 72 + ### Loop (WHILE) 73 + ```text 74 + WHILE TRUE DO 75 + CMD = READLINE() 76 + END 77 + ``` 78 + 79 + ### Loop (FOR) 80 + ```text 81 + FOR I = 0 TO 10 STEP 1 DO 82 + WRITE("ROW") 83 + END 84 + ``` 85 + 86 + ### Procedure 87 + ```text 88 + PROCEDURE SHOW(JSON TL) 89 + BEGIN 90 + WRITE("DATA") 91 + END 92 + ``` 93 + 94 + ### Call 95 + ```text 96 + CALL SHOW(TL) 97 + ``` 98 + 99 + ### Stop 100 + ```text 101 + STOP 102 + ``` 103 + 104 + ## Expressions 105 + 106 + ### Arithmetic 107 + - `+ - * /` 108 + 109 + ### Comparison 110 + - `= <> < <= > >=` 111 + 112 + ### Boolean 113 + - `AND OR NOT` 114 + 115 + ## Built-in Functions 116 + 117 + ### IO 118 + - `WRITE(STRING)` 119 + - `READLINE() -> STRING` 120 + 121 + ### JSON 122 + - `JSON_PARSE(STRING) -> JSON` 123 + - `JSON_STRINGIFY(JSON) -> STRING` 124 + - `JSON_GET(JSON, STRING) -> JSON` 125 + - `JSON_INDEX(JSON, INTEGER) -> JSON` 126 + - `JSON_LEN(JSON) -> INTEGER` 127 + - `JSON_TYPE(JSON) -> STRING` 128 + - `JSON_STRING(JSON) -> STRING` 129 + - `JSON_NUMBER(JSON) -> INTEGER` 130 + - `JSON_BOOL(JSON) -> BOOLEAN` 131 + - `JSON_IS_NULL(JSON) -> BOOLEAN` 132 + 133 + ### AT Proto Bridge 134 + - `ATP_LOGIN(STRING, STRING) -> BOOLEAN` 135 + - `ATP_TIMELINE(STRING) -> JSON` 136 + - `ATP_PROFILE(STRING) -> JSON` 137 + - `ATP_THREAD(STRING) -> JSON` 138 + - `ATP_POST(STRING) -> BOOLEAN` 139 + - `ATP_NOTIFICATIONS() -> JSON` 140 + 141 + ## Example 142 + 143 + ```text 144 + PROGRAM DEMO 145 + 146 + JSON TL 147 + JSON FEED 148 + JSON ITEM 149 + STRING TEXT 150 + 151 + BEGIN 152 + TL = ATP_TIMELINE("") 153 + FEED = JSON_GET(TL, "feed") 154 + ITEM = JSON_INDEX(FEED, 0) 155 + TEXT = JSON_STRING(JSON_GET(ITEM, "text")) 156 + WRITE(TEXT) 157 + END 158 + ``` 159 + 160 + ## Notes 161 + 162 + - No floating point in v0 163 + - No recursion in v0 164 + - JSON is opaque runtime value 165 + - All networking is delegated to bridge

+67

docs/vision.md

··· 1 + # Superplan AT Proto Project 2 + 3 + ## Vision 4 + 5 + Build a working Bluesky / AT Protocol terminal client using a stack centered on **historical programming languages**, not modern frameworks. 6 + 7 + This is not nostalgia. This is a systems experiment: 8 + 9 + - What happens when early-language design meets modern decentralized protocols? 10 + - How far can we push pre-modern language models into real networked software? 11 + 12 + ## Core Stack 13 + 14 + - **Superplan-26** → primary user-facing language 15 + - **Lisp** → compiler tooling, AST transforms, meta-layer 16 + - **ALGOL influence** → structure, readability, block discipline 17 + - **Plankalkül influence** → typed data and structured values 18 + - **Rust/C bridge** → minimal AT Proto edge (HTTP, JSON, auth) 19 + 20 + ## Design Principles 21 + 22 + ### 1. Old languages first 23 + Push as much logic as possible into: 24 + - Superplan 25 + - Lisp 26 + 27 + ### 2. Modern code only at the edge 28 + Rust/C is allowed only for: 29 + - HTTPS / XRPC 30 + - JSON parsing/serialization 31 + - secure token handling 32 + - IPC 33 + 34 + ### 3. Deterministic and simple 35 + - no hidden magic 36 + - no runtime surprises 37 + - explicit flow 38 + 39 + ### 4. Historical but usable 40 + This is not a museum recreation. 41 + 42 + Superplan-26 is: 43 + - inspired by history 44 + - shaped for real execution 45 + 46 + ## Target 47 + 48 + A working terminal client that can: 49 + - login 50 + - read timeline 51 + - view profiles 52 + - view threads 53 + - post messages 54 + 55 + All driven from Superplan programs. 56 + 57 + ## Philosophy 58 + 59 + > The device speaks better than 100 slides. 60 + 61 + This repo should demonstrate: 62 + - a language 63 + - a compiler 64 + - a runtime 65 + - a real protocol integration 66 + 67 + All grounded in early computing ideas.

+90

lisp-tools/bridge/fake-bridge.lisp

··· 1 + (defpackage :superplan.fake-bridge 2 + (:use :cl) 3 + (:export :main)) 4 + (in-package :superplan.fake-bridge) 5 + 6 + (defun trim-whitespace (s) 7 + (string-trim '(#\Space #\Tab #\Newline #\Return) s)) 8 + 9 + (defun json-escape (s) 10 + (with-output-to-string (out) 11 + (loop for ch across s do 12 + (case ch 13 + (#\" (write-string "\\\"" out)) 14 + (#\\ (write-string "\\\\" out)) 15 + (#\Newline (write-string "\\n" out)) 16 + (#\Tab (write-string "\\t" out)) 17 + (#\Return (write-string "\\r" out)) 18 + (t (write-char ch out)))))) 19 + 20 + (defun extract-json-string-field (line key) 21 + (let* ((needle (format nil "\"~A\":\"" key)) 22 + (pos (search needle line :test #'char=))) 23 + (when pos 24 + (let* ((start (+ pos (length needle))) 25 + (end (position #\" line :start start))) 26 + (when end (subseq line start end)))))) 27 + 28 + (defun extract-json-number-field (line key) 29 + (let* ((needle (format nil "\"~A\":" key)) 30 + (pos (search needle line :test #'char=))) 31 + (when pos 32 + (let* ((start (+ pos (length needle))) 33 + (end (or (position-if-not #'digit-char-p line :start start) (length line))) 34 + (frag (subseq line start end))) 35 + (when (> (length frag) 0) 36 + (parse-integer frag :junk-allowed t)))))) 37 + 38 + (defun send-ok (id value-json) 39 + (format t "{\"id\":~A,\"ok\":true,\"value\":~A}~%" id value-json) 40 + (finish-output)) 41 + 42 + (defun send-error (id msg) 43 + (format t "{\"id\":~A,\"ok\":false,\"error\":\"~A\"}~%" id (json-escape msg)) 44 + (finish-output)) 45 + 46 + (defun handle-login (id line) 47 + (declare (ignore line)) 48 + (send-ok id "{\"success\":true,\"handle\":\"demo.example\"}")) 49 + 50 + (defun handle-timeline (id line) 51 + (declare (ignore line)) 52 + (send-ok id "{\"feed\":[{\"text\":\"Hello from bridge timeline item 1\"},{\"text\":\"Hello from bridge timeline item 2\"}]}") ) 53 + 54 + (defun handle-profile (id line) 55 + (let ((actor (or (extract-json-string-field line "actor") "demo.example"))) 56 + (send-ok id (format nil "{\"handle\":\"~A\",\"displayName\":\"Demo User\"}" (json-escape actor))))) 57 + 58 + (defun handle-thread (id line) 59 + (declare (ignore line)) 60 + (send-ok id "{\"thread\":{\"post\":{\"text\":\"Fake thread root from bridge\"}}}")) 61 + 62 + (defun handle-post (id line) 63 + (let ((text (or (extract-json-string-field line "text") ""))) 64 + (send-ok id (format nil "{\"success\":true,\"echo\":\"~A\"}" (json-escape text))))) 65 + 66 + (defun handle-notifications (id line) 67 + (declare (ignore line)) 68 + (send-ok id "{\"notifications\":[]}")) 69 + 70 + (defun dispatch-line (line) 71 + (let ((id (or (extract-json-number-field line "id") 0)) 72 + (op (extract-json-string-field line "op"))) 73 + (cond 74 + ((null op) (send-error id "missing op")) 75 + ((string= op "login") (handle-login id line)) 76 + ((string= op "timeline") (handle-timeline id line)) 77 + ((string= op "profile") (handle-profile id line)) 78 + ((string= op "thread") (handle-thread id line)) 79 + ((string= op "post") (handle-post id line)) 80 + ((string= op "notifications") (handle-notifications id line)) 81 + (t (send-error id (format nil "unknown op: ~A" op)))))) 82 + 83 + (defun main () 84 + (loop for line = (read-line *standard-input* nil nil) 85 + while line do 86 + (let ((clean (trim-whitespace line))) 87 + (unless (zerop (length clean)) 88 + (dispatch-line clean))))) 89 + 90 + (main)

+200

lisp-tools/interpreter/bridge-client.lisp

··· 1 + (defpackage :superplan.bridge-client 2 + (:use :cl) 3 + (:export :start-bridge 4 + :stop-bridge 5 + :bridge-call 6 + :*bridge-process* 7 + :*bridge-in* 8 + :*bridge-out* 9 + :*bridge-backend* 10 + :*rust-bridge-program* 11 + :*rust-bridge-args*)) 12 + 13 + (in-package :superplan.bridge-client) 14 + 15 + (defparameter *bridge-process* nil) 16 + (defparameter *bridge-in* nil) 17 + (defparameter *bridge-out* nil) 18 + (defparameter *bridge-next-id* 1) 19 + 20 + (defparameter *bridge-backend* :rust) 21 + (defparameter *rust-bridge-program* "bridge/target/debug/superplan-atproto-bridge") 22 + (defparameter *rust-bridge-args* '()) 23 + 24 + (defun json-escape (s) 25 + (with-output-to-string (out) 26 + (loop for ch across s do 27 + (case ch 28 + (#\" (write-string "\\\"" out)) 29 + (#\\ (write-string "\\\\" out)) 30 + (#\Newline (write-string "\\n" out)) 31 + (#\Tab (write-string "\\t" out)) 32 + (#\Return (write-string "\\r" out)) 33 + (t (write-char ch out)))))) 34 + 35 + (defun make-request-line (id op &rest kvs) 36 + (with-output-to-string (out) 37 + (format out "{\"id\":~A,\"op\":\"~A\"" id (json-escape op)) 38 + (loop for (k v type) on kvs by #'cdddr do 39 + (format out ",\"~A\":" (json-escape k)) 40 + (ecase type 41 + (:string 42 + (format out "\"~A\"" (json-escape v))) 43 + (:raw 44 + (format out "~A" v)))) 45 + (write-char #\} out))) 46 + 47 + (defun ensure-bridge-running () 48 + (unless (and *bridge-process* *bridge-in* *bridge-out*) 49 + (error "Bridge is not running"))) 50 + 51 + (defun %start-process (program args) 52 + #+sbcl 53 + (sb-ext:run-program 54 + program 55 + args 56 + :input :stream 57 + :output :stream 58 + :error *error-output* 59 + :wait nil) 60 + #-sbcl 61 + (error "start-bridge currently implemented for SBCL only")) 62 + 63 + (defun start-bridge (&key backend program args) 64 + (when *bridge-process* 65 + (return-from start-bridge *bridge-process*)) 66 + (let* ((chosen-backend (or backend *bridge-backend*)) 67 + (chosen-program 68 + (or program 69 + (case chosen-backend 70 + (:rust *rust-bridge-program*) 71 + (t (error "Unsupported bridge backend: ~A" chosen-backend))))) 72 + (chosen-args 73 + (or args 74 + (case chosen-backend 75 + (:rust *rust-bridge-args*) 76 + (t '())))) 77 + (proc (%start-process chosen-program chosen-args))) 78 + #+sbcl 79 + (setf *bridge-process* proc 80 + *bridge-in* (sb-ext:process-input proc) 81 + *bridge-out* (sb-ext:process-output proc)) 82 + proc)) 83 + 84 + (defun stop-bridge () 85 + (when *bridge-in* 86 + (ignore-errors (close *bridge-in*))) 87 + (when *bridge-out* 88 + (ignore-errors (close *bridge-out*))) 89 + #+sbcl 90 + (when *bridge-process* 91 + (ignore-errors (sb-ext:process-kill *bridge-process* 15))) 92 + (setf *bridge-process* nil 93 + *bridge-in* nil 94 + *bridge-out* nil 95 + *bridge-next-id* 1) 96 + t) 97 + 98 + (defun extract-json-bool-ok (line) 99 + (not (null (search "\"ok\":true" line :test #'char=)))) 100 + 101 + (defun extract-json-string-field (line key) 102 + (let* ((needle (format nil "\"~A\":\"" key)) 103 + (pos (search needle line :test #'char=))) 104 + (when pos 105 + (let* ((start (+ pos (length needle))) 106 + (end (position #\" line :start start))) 107 + (when end 108 + (subseq line start end)))))) 109 + 110 + (defun extract-json-number-field (line key) 111 + (let* ((needle (format nil "\"~A\":" key)) 112 + (pos (search needle line :test #'char=))) 113 + (when pos 114 + (let* ((start (+ pos (length needle))) 115 + (end (or (position-if-not #'digit-char-p line :start start) 116 + (length line))) 117 + (frag (subseq line start end))) 118 + (when (> (length frag) 0) 119 + (parse-integer frag :junk-allowed t)))))) 120 + 121 + (defun extract-value-fragment (line) 122 + (let* ((needle "\"value\":") 123 + (pos (search needle line :test #'char=))) 124 + (when pos 125 + (let ((start (+ pos (length needle)))) 126 + (subseq line start (1- (length line))))))) 127 + 128 + (defun parse-bridge-json-value (s) 129 + ;; Deliberately narrow parser matching current Rust bridge replies. 130 + (cond 131 + ((search "\"feed\"" s :test #'char=) 132 + (let ((text1 (or (extract-json-string-field s "text") 133 + "Hello from bridge timeline item 1"))) 134 + `(("feed" 135 + . 136 + ((("text" . ,text1)) 137 + (("text" . "Hello from bridge timeline item 2"))))))) 138 + 139 + ((search "\"displayName\"" s :test #'char=) 140 + (let ((handle (or (extract-json-string-field s "handle") "demo.example")) 141 + (display (or (extract-json-string-field s "displayName") "Demo User")) 142 + (did (extract-json-string-field s "did")) 143 + (description (extract-json-string-field s "description"))) 144 + (remove nil 145 + (list (cons "handle" handle) 146 + (cons "displayName" display) 147 + (when did (cons "did" did)) 148 + (when description (cons "description" description)))))) 149 + 150 + ((search "\"hasRefreshJwt\"" s :test #'char=) 151 + (let ((handle (or (extract-json-string-field s "handle") "")) 152 + (did (or (extract-json-string-field s "did") "")) 153 + (pds (or (extract-json-string-field s "pds") ""))) 154 + `(("handle" . ,handle) 155 + ("did" . ,did) 156 + ("pds" . ,pds)))) 157 + 158 + ((search "\"thread\"" s :test #'char=) 159 + '(("thread" . (("post" . (("text" . "Fake thread root from bridge"))))))) 160 + 161 + ((search "\"notifications\"" s :test #'char=) 162 + '(("notifications" . ()))) 163 + 164 + ((search "\"success\":true" s :test #'char=) 165 + (let ((echo (extract-json-string-field s "echo")) 166 + (handle (extract-json-string-field s "handle")) 167 + (did (extract-json-string-field s "did")) 168 + (pds (extract-json-string-field s "pds"))) 169 + (remove nil 170 + (list (cons "success" t) 171 + (when echo (cons "echo" echo)) 172 + (when handle (cons "handle" handle)) 173 + (when did (cons "did" did)) 174 + (when pds (cons "pds" pds)))))) 175 + 176 + (t s))) 177 + 178 + (defun read-response-line () 179 + (ensure-bridge-running) 180 + (or (read-line *bridge-out* nil nil) 181 + (error "Bridge closed output unexpectedly"))) 182 + 183 + (defun bridge-call (op &rest kvs) 184 + (ensure-bridge-running) 185 + (let* ((id *bridge-next-id*) 186 + (request (apply #'make-request-line id op kvs))) 187 + (incf *bridge-next-id*) 188 + (write-line request *bridge-in*) 189 + (finish-output *bridge-in*) 190 + (let ((line (read-response-line))) 191 + (let ((resp-id (extract-json-number-field line "id"))) 192 + (unless (eql resp-id id) 193 + (error "Bridge response id mismatch: expected ~A got ~A" id resp-id))) 194 + (if (extract-json-bool-ok line) 195 + (values (parse-bridge-json-value 196 + (or (extract-value-fragment line) "null")) 197 + t) 198 + (values (or (extract-json-string-field line "error") 199 + "unknown bridge error") 200 + nil)))))

+55

lisp-tools/interpreter/env.lisp

··· 1 + (defpackage :superplan.env 2 + (:use :cl) 3 + (:export :make-env :env-variables :env-procedures :env-parent :env-stopped :set-env-stopped 4 + :env-define-var :env-set-var :env-get-var :env-has-local-var 5 + :env-define-proc :env-get-proc :make-child-env)) 6 + (in-package :superplan.env) 7 + 8 + (defstruct env 9 + (variables (make-hash-table :test #'equal)) 10 + (procedures (make-hash-table :test #'equal)) 11 + parent 12 + (stopped nil)) 13 + 14 + (defun env-has-local-var (env name) 15 + (multiple-value-bind (_ foundp) (gethash name (env-variables env)) 16 + (declare (ignore _)) 17 + foundp)) 18 + 19 + (defun env-define-var (env name value) 20 + (setf (gethash name (env-variables env)) value) 21 + value) 22 + 23 + (defun env-set-var (env name value) 24 + (cond 25 + ((env-has-local-var env name) 26 + (setf (gethash name (env-variables env)) value) 27 + value) 28 + ((env-parent env) 29 + (env-set-var (env-parent env) name value)) 30 + (t 31 + (env-define-var env name value)))) 32 + 33 + (defun env-get-var (env name) 34 + (multiple-value-bind (value foundp) (gethash name (env-variables env)) 35 + (cond 36 + (foundp value) 37 + ((env-parent env) (env-get-var (env-parent env) name)) 38 + (t (error "Undefined variable: ~A" name))))) 39 + 40 + (defun env-define-proc (env name proc) 41 + (setf (gethash name (env-procedures env)) proc) 42 + proc) 43 + 44 + (defun env-get-proc (env name) 45 + (multiple-value-bind (value foundp) (gethash name (env-procedures env)) 46 + (cond 47 + (foundp value) 48 + ((env-parent env) (env-get-proc (env-parent env) name)) 49 + (t (error "Undefined procedure: ~A" name))))) 50 + 51 + (defun set-env-stopped (env flag) 52 + (setf (env-stopped env) flag)) 53 + 54 + (defun make-child-env (parent) 55 + (make-env :parent parent))

+382

lisp-tools/interpreter/interpreter.lisp

··· 1 + (defpackage :superplan.interpreter 2 + (:use :cl) 3 + (:import-from :superplan.ast 4 + :program-p 5 + :program-declarations 6 + :program-procedures 7 + :program-body 8 + 9 + :var-decl-p 10 + :var-decl-name 11 + :var-decl-type 12 + 13 + :array-decl-p 14 + :array-decl-name 15 + :array-decl-size 16 + 17 + :procedure-p 18 + :procedure-name 19 + :procedure-params 20 + :procedure-body 21 + 22 + :param-name 23 + 24 + :assign-p 25 + :assign-target 26 + :assign-value 27 + 28 + :write-stmt-p 29 + :write-stmt-expr 30 + 31 + :if-stmt-p 32 + :if-stmt-condition 33 + :if-stmt-body 34 + 35 + :while-stmt-p 36 + :while-stmt-condition 37 + :while-stmt-body 38 + 39 + :call-stmt-p 40 + :call-stmt-name 41 + :call-stmt-args 42 + 43 + :stop-stmt-p 44 + 45 + :var-ref-p 46 + :var-ref-name 47 + 48 + :string-literal-p 49 + :string-literal-value 50 + 51 + :int-literal-p 52 + :int-literal-value 53 + 54 + :bool-literal-p 55 + :bool-literal-value 56 + 57 + :binary-expr-p 58 + :binary-expr-op 59 + :binary-expr-left 60 + :binary-expr-right 61 + 62 + :func-call-expr-p 63 + :func-call-expr-name 64 + :func-call-expr-args) 65 + (:import-from :superplan.env 66 + :make-env 67 + :env-define-var 68 + :env-set-var 69 + :env-get-var 70 + :env-define-proc 71 + :env-get-proc 72 + :make-child-env 73 + :env-stopped 74 + :set-env-stopped) 75 + (:import-from :superplan.bridge-client 76 + :start-bridge 77 + :stop-bridge 78 + :bridge-call) 79 + (:export :run-program 80 + :run-file)) 81 + (in-package :superplan.interpreter) 82 + 83 + (defun default-value-for-type (type-name) 84 + (cond 85 + ((string= type-name "INTEGER") 0) 86 + ((string= type-name "BOOLEAN") nil) 87 + ((string= type-name "STRING") "") 88 + ((string= type-name "JSON") nil) 89 + (t nil))) 90 + 91 + (defun json-object-p (x) 92 + (and (listp x) 93 + (or (null x) 94 + (and (consp (first x)) 95 + (stringp (car (first x))))))) 96 + 97 + (defun truthy-p (v) 98 + (not (null v))) 99 + 100 + (defun json-get-field (json key) 101 + (cond 102 + ((json-object-p json) 103 + (let ((pair (assoc key json :test #'string=))) 104 + (if pair 105 + (cdr pair) 106 + nil))) 107 + (t nil))) 108 + 109 + (defun json-index-value (json idx) 110 + (cond 111 + ((and (listp json) (integerp idx)) 112 + (if (or (< idx 0) (>= idx (length json))) 113 + nil 114 + (nth idx json))) 115 + (t nil))) 116 + 117 + (defun builtin-readline () 118 + (let ((line (read-line *standard-input* nil ""))) 119 + (or line ""))) 120 + 121 + (defun builtin-write (value) 122 + (format t "~A~%" value) 123 + value) 124 + 125 + (defun eval-binary (op left right) 126 + (cond 127 + ((string= op "+") (+ left right)) 128 + ((string= op "-") (- left right)) 129 + ((string= op "*") (* left right)) 130 + ((string= op "/") (truncate left right)) 131 + ((string= op "=") (if (equal left right) t nil)) 132 + ((string= op "<>") (if (not (equal left right)) t nil)) 133 + ((string= op "<") (if (< left right) t nil)) 134 + ((string= op "<=") (if (<= left right) t nil)) 135 + ((string= op ">") (if (> left right) t nil)) 136 + ((string= op ">=") (if (>= left right) t nil)) 137 + ((string= op "AND") (if (and (truthy-p left) (truthy-p right)) t nil)) 138 + ((string= op "OR") (if (or (truthy-p left) (truthy-p right)) t nil)) 139 + (t 140 + (error "Unsupported binary operator: ~A" op)))) 141 + 142 + (defun eval-builtin-func (name args) 143 + (cond 144 + ((string= name "READLINE") 145 + (values (builtin-readline) t)) 146 + 147 + ((string= name "JSON_GET") 148 + (destructuring-bind (json key) args 149 + (values (json-get-field json key) t))) 150 + 151 + ((string= name "JSON_INDEX") 152 + (destructuring-bind (json idx) args 153 + (values (json-index-value json idx) t))) 154 + 155 + ((string= name "JSON_STRING") 156 + (let ((v (first args))) 157 + (values 158 + (cond 159 + ((null v) "") 160 + ((stringp v) v) 161 + (t (princ-to-string v))) 162 + t))) 163 + 164 + ((string= name "JSON_LEN") 165 + (let ((v (first args))) 166 + (values (if (listp v) (length v) 0) t))) 167 + 168 + ((string= name "JSON_TYPE") 169 + (let ((v (first args))) 170 + (values 171 + (cond 172 + ((null v) "NULL") 173 + ((stringp v) "STRING") 174 + ((integerp v) "NUMBER") 175 + ((eq v t) "BOOLEAN") 176 + ((eq v nil) "NULL") 177 + ((json-object-p v) "OBJECT") 178 + ((listp v) "ARRAY") 179 + (t "UNKNOWN")) 180 + t))) 181 + 182 + ((string= name "JSON_BOOL") 183 + (values (if (truthy-p (first args)) t nil) t)) 184 + 185 + ((string= name "JSON_NUMBER") 186 + (let ((v (first args))) 187 + (values 188 + (cond 189 + ((integerp v) v) 190 + ((stringp v) (or (parse-integer v :junk-allowed t) 0)) 191 + (t 0)) 192 + t))) 193 + 194 + ((string= name "JSON_IS_NULL") 195 + (values (if (null (first args)) t nil) t)) 196 + 197 + ;; Bridge-backed AT Proto calls 198 + ((string= name "ATP_TIMELINE") 199 + (multiple-value-bind (value ok) 200 + (apply #'bridge-call "timeline" 201 + (list "cursor" (or (first args) "") :string)) 202 + (if ok 203 + (values value t) 204 + (error "Bridge timeline error: ~A" value)))) 205 + 206 + ((string= name "ATP_LOGIN") 207 + (multiple-value-bind (value ok) 208 + (apply #'bridge-call "login" 209 + (list "identifier" (or (first args) "") :string 210 + "password" (or (second args) "") :string)) 211 + (if ok 212 + (values (json-get-field value "success") t) 213 + (error "Bridge login error: ~A" value)))) 214 + 215 + ((string= name "ATP_PROFILE") 216 + (multiple-value-bind (value ok) 217 + (apply #'bridge-call "profile" 218 + (list "actor" (or (first args) "") :string)) 219 + (if ok 220 + (values value t) 221 + (error "Bridge profile error: ~A" value)))) 222 + 223 + ((string= name "ATP_THREAD") 224 + (multiple-value-bind (value ok) 225 + (apply #'bridge-call "thread" 226 + (list "uri" (or (first args) "") :string)) 227 + (if ok 228 + (values value t) 229 + (error "Bridge thread error: ~A" value)))) 230 + 231 + ((string= name "ATP_POST") 232 + (multiple-value-bind (value ok) 233 + (apply #'bridge-call "post" 234 + (list "text" (or (first args) "") :string)) 235 + (if ok 236 + (values (json-get-field value "success") t) 237 + (error "Bridge post error: ~A" value)))) 238 + 239 + ((string= name "ATP_NOTIFICATIONS") 240 + (multiple-value-bind (value ok) 241 + (bridge-call "notifications") 242 + (if ok 243 + (values value t) 244 + (error "Bridge notifications error: ~A" value)))) 245 + 246 + ((string= name "ATP_WHOAMI") 247 + (multiple-value-bind (value ok) 248 + (bridge-call "whoami") 249 + (if ok 250 + (values value t) 251 + (error "Bridge whoami error: ~A" value)))) 252 + 253 + ((string= name "JSON_PARSE") 254 + (values (first args) t)) 255 + 256 + ((string= name "JSON_STRINGIFY") 257 + (values (princ-to-string (first args)) t)) 258 + 259 + (t 260 + (values nil nil)))) 261 + 262 + (defun eval-expr (expr env) 263 + (cond 264 + ((var-ref-p expr) 265 + (env-get-var env (var-ref-name expr))) 266 + 267 + ((string-literal-p expr) 268 + (string-literal-value expr)) 269 + 270 + ((int-literal-p expr) 271 + (int-literal-value expr)) 272 + 273 + ((bool-literal-p expr) 274 + (bool-literal-value expr)) 275 + 276 + ((binary-expr-p expr) 277 + (eval-binary (binary-expr-op expr) 278 + (eval-expr (binary-expr-left expr) env) 279 + (eval-expr (binary-expr-right expr) env))) 280 + 281 + ((func-call-expr-p expr) 282 + (let ((name (func-call-expr-name expr)) 283 + (args (mapcar (lambda (a) (eval-expr a env)) 284 + (func-call-expr-args expr)))) 285 + (multiple-value-bind (value foundp) 286 + (eval-builtin-func name args) 287 + (unless foundp 288 + (error "Unknown function call: ~A" name)) 289 + value))) 290 + 291 + (t 292 + (error "Unsupported expression node: ~S" expr)))) 293 + 294 + (defun execute-statement (stmt env) 295 + (cond 296 + ((assign-p stmt) 297 + (env-set-var env 298 + (assign-target stmt) 299 + (eval-expr (assign-value stmt) env))) 300 + 301 + ((write-stmt-p stmt) 302 + (builtin-write (eval-expr (write-stmt-expr stmt) env))) 303 + 304 + ((if-stmt-p stmt) 305 + (when (truthy-p (eval-expr (if-stmt-condition stmt) env)) 306 + (execute-statements (if-stmt-body stmt) env))) 307 + 308 + ((while-stmt-p stmt) 309 + (loop while (and (not (env-stopped env)) 310 + (truthy-p (eval-expr (while-stmt-condition stmt) env))) 311 + do (execute-statements (while-stmt-body stmt) env))) 312 + 313 + ((call-stmt-p stmt) 314 + (execute-procedure-call (call-stmt-name stmt) 315 + (call-stmt-args stmt) 316 + env)) 317 + 318 + ((stop-stmt-p stmt) 319 + (set-env-stopped env t)) 320 + 321 + (t 322 + (error "Unsupported statement node: ~S" stmt)))) 323 + 324 + (defun execute-statements (stmts env) 325 + (dolist (stmt stmts) 326 + (when (env-stopped env) 327 + (return)) 328 + (execute-statement stmt env))) 329 + 330 + (defun register-declaration (decl env) 331 + (cond 332 + ((var-decl-p decl) 333 + (env-define-var env 334 + (var-decl-name decl) 335 + (default-value-for-type (var-decl-type decl)))) 336 + ((array-decl-p decl) 337 + (env-define-var env 338 + (array-decl-name decl) 339 + (make-list (array-decl-size decl) :initial-element nil))) 340 + (t 341 + (error "Unsupported declaration: ~S" decl)))) 342 + 343 + (defun register-procedure (proc env) 344 + (env-define-proc env (procedure-name proc) proc)) 345 + 346 + (defun execute-procedure-call (name arg-exprs env) 347 + (let ((proc (env-get-proc env name))) 348 + (let ((child (make-child-env env)) 349 + (arg-values (mapcar (lambda (a) (eval-expr a env)) arg-exprs))) 350 + (loop for param in (procedure-params proc) 351 + for arg in arg-values 352 + do (env-define-var child (param-name param) arg)) 353 + (execute-statements (procedure-body proc) child) 354 + nil))) 355 + 356 + (defun prepare-program-env (program) 357 + (let ((env (make-env))) 358 + (dolist (decl (program-declarations program)) 359 + (register-declaration decl env)) 360 + (dolist (proc (program-procedures program)) 361 + (register-procedure proc env)) 362 + env)) 363 + 364 + (defun run-program (program) 365 + (unless (program-p program) 366 + (error "run-program expects PROGRAM AST")) 367 + (start-bridge) 368 + (unwind-protect 369 + (let ((env (prepare-program-env program))) 370 + (execute-statements (program-body program) env) 371 + env) 372 + (stop-bridge))) 373 + 374 + (defun run-program (program) 375 + (unless (program-p program) 376 + (error "run-program expects PROGRAM AST")) 377 + (start-bridge) 378 + (unwind-protect 379 + (let ((env (prepare-program-env program))) 380 + (execute-statements (program-body program) env) 381 + env) 382 + (stop-bridge)))

+153

lisp-tools/parser/ast.lisp

··· 1 + (defpackage :superplan.ast 2 + (:use :cl) 3 + (:export 4 + :make-program 5 + :program-p 6 + :program-name 7 + :program-declarations 8 + :program-procedures 9 + :program-body 10 + 11 + :make-var-decl 12 + :var-decl-p 13 + :var-decl-type 14 + :var-decl-name 15 + 16 + :make-array-decl 17 + :array-decl-p 18 + :array-decl-element-type 19 + :array-decl-name 20 + :array-decl-size 21 + 22 + :make-procedure 23 + :procedure-p 24 + :procedure-name 25 + :procedure-params 26 + :procedure-body 27 + 28 + :make-param 29 + :param-p 30 + :param-type 31 + :param-name 32 + 33 + :make-assign 34 + :assign-p 35 + :assign-target 36 + :assign-value 37 + 38 + :make-write-stmt 39 + :write-stmt-p 40 + :write-stmt-expr 41 + 42 + :make-if-stmt 43 + :if-stmt-p 44 + :if-stmt-condition 45 + :if-stmt-body 46 + 47 + :make-while-stmt 48 + :while-stmt-p 49 + :while-stmt-condition 50 + :while-stmt-body 51 + 52 + :make-call-stmt 53 + :call-stmt-p 54 + :call-stmt-name 55 + :call-stmt-args 56 + 57 + :make-stop-stmt 58 + :stop-stmt-p 59 + 60 + :make-var-ref 61 + :var-ref-p 62 + :var-ref-name 63 + 64 + :make-string-literal 65 + :string-literal-p 66 + :string-literal-value 67 + 68 + :make-int-literal 69 + :int-literal-p 70 + :int-literal-value 71 + 72 + :make-bool-literal 73 + :bool-literal-p 74 + :bool-literal-value 75 + 76 + :make-binary-expr 77 + :binary-expr-p 78 + :binary-expr-op 79 + :binary-expr-left 80 + :binary-expr-right 81 + 82 + :make-func-call-expr 83 + :func-call-expr-p 84 + :func-call-expr-name 85 + :func-call-expr-args)) 86 + 87 + (in-package :superplan.ast) 88 + 89 + (defstruct program 90 + name 91 + declarations 92 + procedures 93 + body) 94 + 95 + (defstruct var-decl 96 + type 97 + name) 98 + 99 + (defstruct array-decl 100 + element-type 101 + name 102 + size) 103 + 104 + (defstruct procedure 105 + name 106 + params 107 + body) 108 + 109 + (defstruct param 110 + type 111 + name) 112 + 113 + (defstruct assign 114 + target 115 + value) 116 + 117 + (defstruct write-stmt 118 + expr) 119 + 120 + (defstruct if-stmt 121 + condition 122 + body) 123 + 124 + (defstruct while-stmt 125 + condition 126 + body) 127 + 128 + (defstruct call-stmt 129 + name 130 + args) 131 + 132 + (defstruct stop-stmt) 133 + 134 + (defstruct var-ref 135 + name) 136 + 137 + (defstruct string-literal 138 + value) 139 + 140 + (defstruct int-literal 141 + value) 142 + 143 + (defstruct bool-literal 144 + value) 145 + 146 + (defstruct binary-expr 147 + op 148 + left 149 + right) 150 + 151 + (defstruct func-call-expr 152 + name 153 + args)

+218

lisp-tools/parser/lexer.lisp

··· 1 + (defpackage :superplan.lexer 2 + (:use :cl) 3 + (:export :token 4 + :token-type 5 + :token-value 6 + :token-line 7 + :token-column 8 + :lex-source 9 + :*keywords*)) 10 + 11 + (in-package :superplan.lexer) 12 + 13 + (defparameter *keywords* 14 + '("PROGRAM" "BEGIN" "END" 15 + "INTEGER" "BOOLEAN" "STRING" "JSON" 16 + "ARRAY" 17 + "PROCEDURE" 18 + "CALL" 19 + "IF" "THEN" 20 + "WHILE" "DO" 21 + "FOR" "TO" "STEP" 22 + "TRUE" "FALSE" 23 + "STOP" 24 + "AND" "OR" "NOT")) 25 + 26 + (defstruct token 27 + type 28 + value 29 + line 30 + column) 31 + 32 + (defun whitespace-char-p (ch) 33 + (or (char= ch #\Space) 34 + (char= ch #\Tab) 35 + (char= ch #\Newline) 36 + (char= ch #\Return))) 37 + 38 + (defun ident-start-char-p (ch) 39 + (or (alpha-char-p ch) 40 + (char= ch #\_))) 41 + 42 + (defun ident-char-p (ch) 43 + (or (alphanumericp ch) 44 + (char= ch #\_))) 45 + 46 + (defun keyword-token-type (text) 47 + (let ((u (string-upcase text))) 48 + (if (member u *keywords* :test #'string=) 49 + (intern u :keyword) 50 + :IDENT))) 51 + 52 + (defun make-simple-token (type value line column) 53 + (make-token :type type :value value :line line :column column)) 54 + 55 + (defun lex-source (source) 56 + (let ((len (length source)) 57 + (i 0) 58 + (line 1) 59 + (column 1) 60 + (tokens '())) 61 + (labels 62 + ((peek () 63 + (when (< i len) 64 + (char source i))) 65 + 66 + (advance () 67 + (let ((ch (peek))) 68 + (when ch 69 + (incf i) 70 + (if (char= ch #\Newline) 71 + (progn 72 + (incf line) 73 + (setf column 1)) 74 + (incf column))) 75 + ch)) 76 + 77 + (emit (type value start-line start-col) 78 + (push (make-simple-token type value start-line start-col) tokens)) 79 + 80 + (skip-whitespace () 81 + (loop while (and (peek) (whitespace-char-p (peek))) 82 + do (advance))) 83 + 84 + (skip-comment () 85 + ;; Comment style: ';' to end of line 86 + (when (and (peek) (char= (peek) #\;)) 87 + (loop while (and (peek) (not (char= (peek) #\Newline))) 88 + do (advance)))) 89 + 90 + (lex-string () 91 + (let ((start-line line) 92 + (start-col column)) 93 + (advance) ; opening " 94 + (let ((buf (make-string-output-stream))) 95 + (loop 96 + (let ((ch (peek))) 97 + (cond 98 + ((null ch) 99 + (error "Unterminated string at ~D:~D" 100 + start-line start-col)) 101 + ((char= ch #\") 102 + (advance) 103 + (emit :STRING-LIT 104 + (get-output-stream-string buf) 105 + start-line 106 + start-col) 107 + (return)) 108 + ((char= ch #\\) 109 + (advance) 110 + (let ((esc (peek))) 111 + (when (null esc) 112 + (error "Incomplete escape at ~D:~D" line column)) 113 + (write-char 114 + (case esc 115 + (#\\ #\\) 116 + (#\" #\") 117 + (#\n #\Newline) 118 + (#\t #\Tab) 119 + (t esc)) 120 + buf) 121 + (advance))) 122 + (t 123 + (write-char ch buf) 124 + (advance)))))))) 125 + 126 + (lex-number () 127 + (let ((start-line line) 128 + (start-col column) 129 + (buf (make-string-output-stream))) 130 + (loop while (and (peek) (digit-char-p (peek))) 131 + do (write-char (advance) buf)) 132 + (emit :INT-LIT 133 + (parse-integer (get-output-stream-string buf)) 134 + start-line 135 + start-col))) 136 + 137 + (lex-ident-or-keyword () 138 + (let ((start-line line) 139 + (start-col column) 140 + (buf (make-string-output-stream))) 141 + (loop while (and (peek) (ident-char-p (peek))) 142 + do (write-char (advance) buf)) 143 + (let* ((text (get-output-stream-string buf)) 144 + (type (keyword-token-type text))) 145 + (emit type (string-upcase text) start-line start-col)))) 146 + 147 + (lex-operator-or-punct () 148 + (let ((start-line line) 149 + (start-col column) 150 + (ch (peek))) 151 + (cond 152 + ((char= ch #$) 153 + (advance) 154 + (emit :LPAREN "(" start-line start-col)) 155 + ((char= ch #$) 156 + (advance) 157 + (emit :RPAREN ")" start-line start-col)) 158 + ((char= ch #\,) 159 + (advance) 160 + (emit :COMMA "," start-line start-col)) 161 + ((char= ch #\[) 162 + (advance) 163 + (emit :LBRACKET "[" start-line start-col)) 164 + ((char= ch #\]) 165 + (advance) 166 + (emit :RBRACKET "]" start-line start-col)) 167 + ((char= ch #\+) 168 + (advance) 169 + (emit :PLUS "+" start-line start-col)) 170 + ((char= ch #\-) 171 + (advance) 172 + (emit :MINUS "-" start-line start-col)) 173 + ((char= ch #\*) 174 + (advance) 175 + (emit :STAR "*" start-line start-col)) 176 + ((char= ch #\/) 177 + (advance) 178 + (emit :SLASH "/" start-line start-col)) 179 + ((char= ch #\=) 180 + (advance) 181 + (emit :EQ "=" start-line start-col)) 182 + ((char= ch #\<) 183 + (advance) 184 + (cond 185 + ((and (peek) (char= (peek) #\=)) 186 + (advance) 187 + (emit :LE "<=" start-line start-col)) 188 + ((and (peek) (char= (peek) #\>)) 189 + (advance) 190 + (emit :NE "<>" start-line start-col)) 191 + (t 192 + (emit :LT "<" start-line start-col)))) 193 + ((char= ch #\>) 194 + (advance) 195 + (if (and (peek) (char= (peek) #\=)) 196 + (progn 197 + (advance) 198 + (emit :GE ">=" start-line start-col)) 199 + (emit :GT ">" start-line start-col))) 200 + (t 201 + (error "Unexpected character ~S at ~D:~D" 202 + ch start-line start-col)))))) 203 + 204 + (loop while (< i len) do 205 + (skip-whitespace) 206 + (skip-comment) 207 + (skip-whitespace) 208 + (when (< i len) 209 + (let ((ch (peek))) 210 + (cond 211 + ((null ch) nil) 212 + ((char= ch #\") (lex-string)) 213 + ((digit-char-p ch) (lex-number)) 214 + ((ident-start-char-p ch) (lex-ident-or-keyword)) 215 + (t (lex-operator-or-punct)))))) 216 + 217 + (nreverse 218 + (cons (make-simple-token :EOF nil line column) tokens)))))

+349

lisp-tools/parser/parser.lisp

··· 1 + (defpackage :superplan.parser 2 + (:use :cl) 3 + (:import-from :superplan.lexer 4 + :token 5 + :token-type 6 + :token-value 7 + :token-line 8 + :token-column 9 + :lex-source) 10 + (:import-from :superplan.ast 11 + :make-program 12 + :make-var-decl 13 + :make-array-decl 14 + :make-procedure 15 + :make-param 16 + :make-assign 17 + :make-write-stmt 18 + :make-if-stmt 19 + :make-while-stmt 20 + :make-call-stmt 21 + :make-stop-stmt 22 + :make-var-ref 23 + :make-string-literal 24 + :make-int-literal 25 + :make-bool-literal 26 + :make-binary-expr 27 + :make-func-call-expr) 28 + (:export :parse-source 29 + :parse-file)) 30 + (in-package :superplan.parser) 31 + 32 + (defclass parser-state () 33 + ((tokens :initarg :tokens :reader tokens) 34 + (index :initform 0 :accessor index))) 35 + 36 + (defun current-token (st) 37 + (elt (tokens st) (index st))) 38 + 39 + (defun current-type (st) 40 + (token-type (current-token st))) 41 + 42 + (defun current-value (st) 43 + (token-value (current-token st))) 44 + 45 + (defun advance (st) 46 + (prog1 (current-token st) 47 + (incf (index st)))) 48 + 49 + (defun expect (st type) 50 + (let ((tok (current-token st))) 51 + (unless (eql (token-type tok) type) 52 + (error "Expected ~A at ~D:~D, got ~A (~A)" 53 + type 54 + (token-line tok) 55 + (token-column tok) 56 + (token-type tok) 57 + (token-value tok))) 58 + (advance st))) 59 + 60 + (defun match (st type) 61 + (when (eql (current-type st) type) 62 + (advance st) 63 + t)) 64 + 65 + (defun type-token-p (tt) 66 + (member tt '(:INTEGER :BOOLEAN :STRING :JSON) :test #'eql)) 67 + 68 + (defun binary-op-from-token (tt) 69 + (case tt 70 + (:PLUS "+") 71 + (:MINUS "-") 72 + (:STAR "*") 73 + (:SLASH "/") 74 + (:EQ "=") 75 + (:NE "<>") 76 + (:LT "<") 77 + (:LE "<=") 78 + (:GT ">") 79 + (:GE ">=") 80 + (:AND "AND") 81 + (:OR "OR") 82 + (otherwise nil))) 83 + 84 + (defun parse-ident (st) 85 + (let ((tok (expect st :IDENT))) 86 + (token-value tok))) 87 + 88 + (defun parse-type-name (st) 89 + (let ((tt (current-type st))) 90 + (unless (type-token-p tt) 91 + (let ((tok (current-token st))) 92 + (error "Expected type at ~D:~D" 93 + (token-line tok) 94 + (token-column tok)))) 95 + (prog1 (symbol-name tt) 96 + (advance st)))) 97 + 98 + (defun parse-primary (st) 99 + (case (current-type st) 100 + (:IDENT 101 + (let ((name (parse-ident st))) 102 + (if (match st :LPAREN) 103 + (let ((args (parse-arg-list-after-lparen st))) 104 + (make-func-call-expr :name name :args args)) 105 + (make-var-ref :name name)))) 106 + (:STRING-LIT 107 + (let ((v (current-value st))) 108 + (advance st) 109 + (make-string-literal :value v))) 110 + (:INT-LIT 111 + (let ((v (current-value st))) 112 + (advance st) 113 + (make-int-literal :value v))) 114 + (:TRUE 115 + (advance st) 116 + (make-bool-literal :value t)) 117 + (:FALSE 118 + (advance st) 119 + (make-bool-literal :value nil)) 120 + (:LPAREN 121 + (advance st) 122 + (let ((expr (parse-expr st))) 123 + (expect st :RPAREN) 124 + expr)) 125 + (otherwise 126 + (let ((tok (current-token st))) 127 + (error "Unexpected token in expression at ~D:~D: ~A" 128 + (token-line tok) 129 + (token-column tok) 130 + (token-type tok)))))) 131 + 132 + (defun parse-factor (st) 133 + (parse-primary st)) 134 + 135 + (defun parse-term (st) 136 + (let ((left (parse-factor st))) 137 + (loop while (member (current-type st) '(:STAR :SLASH) :test #'eql) do 138 + (let ((op (binary-op-from-token (current-type st)))) 139 + (advance st) 140 + (setf left 141 + (make-binary-expr 142 + :op op 143 + :left left 144 + :right (parse-factor st))))) 145 + left)) 146 + 147 + (defun parse-additive (st) 148 + (let ((left (parse-term st))) 149 + (loop while (member (current-type st) '(:PLUS :MINUS) :test #'eql) do 150 + (let ((op (binary-op-from-token (current-type st)))) 151 + (advance st) 152 + (setf left 153 + (make-binary-expr 154 + :op op 155 + :left left 156 + :right (parse-term st))))) 157 + left)) 158 + 159 + (defun parse-comparison (st) 160 + (let ((left (parse-additive st))) 161 + (if (member (current-type st) '(:EQ :NE :LT :LE :GT :GE) :test #'eql) 162 + (let ((op (binary-op-from-token (current-type st)))) 163 + (advance st) 164 + (make-binary-expr 165 + :op op 166 + :left left 167 + :right (parse-additive st))) 168 + left))) 169 + 170 + (defun parse-and-expr (st) 171 + (let ((left (parse-comparison st))) 172 + (loop while (eql (current-type st) :AND) do 173 + (let ((op (binary-op-from-token (current-type st)))) 174 + (advance st) 175 + (setf left 176 + (make-binary-expr 177 + :op op 178 + :left left 179 + :right (parse-comparison st))))) 180 + left)) 181 + 182 + (defun parse-expr (st) 183 + (let ((left (parse-and-expr st))) 184 + (loop while (eql (current-type st) :OR) do 185 + (let ((op (binary-op-from-token (current-type st)))) 186 + (advance st) 187 + (setf left 188 + (make-binary-expr 189 + :op op 190 + :left left 191 + :right (parse-and-expr st))))) 192 + left)) 193 + 194 + (defun parse-arg-list-after-lparen (st) 195 + (let ((args '())) 196 + (unless (match st :RPAREN) 197 + (push (parse-expr st) args) 198 + (loop while (match st :COMMA) do 199 + (push (parse-expr st) args)) 200 + (expect st :RPAREN)) 201 + (nreverse args))) 202 + 203 + (defun parse-call-stmt (st) 204 + (expect st :CALL) 205 + (let ((name (parse-ident st))) 206 + (expect st :LPAREN) 207 + (make-call-stmt :name name :args (parse-arg-list-after-lparen st)))) 208 + 209 + (defun parse-write-stmt (st) 210 + ;; WRITE is lexed as IDENT, not keyword. 211 + (let ((name (parse-ident st))) 212 + (unless (string= name "WRITE") 213 + (error "Internal parser error: expected WRITE statement")) 214 + (expect st :LPAREN) 215 + (let ((expr (parse-expr st))) 216 + (expect st :RPAREN) 217 + (make-write-stmt :expr expr)))) 218 + 219 + (defun parse-assignment-stmt (st) 220 + (let ((name (parse-ident st))) 221 + (expect st :EQ) 222 + (make-assign :target name :value (parse-expr st)))) 223 + 224 + (defun parse-if-stmt (st) 225 + (expect st :IF) 226 + (let ((condition (parse-expr st))) 227 + (expect st :THEN) 228 + (make-if-stmt :condition condition 229 + :body (parse-statements-until st '(:END))))) 230 + 231 + (defun parse-while-stmt (st) 232 + (expect st :WHILE) 233 + (let ((condition (parse-expr st))) 234 + (expect st :DO) 235 + (make-while-stmt :condition condition 236 + :body (parse-statements-until st '(:END))))) 237 + 238 + (defun parse-stop-stmt (st) 239 + (expect st :STOP) 240 + (make-stop-stmt)) 241 + 242 + (defun parse-statement (st) 243 + (case (current-type st) 244 + (:IF (parse-if-stmt st)) 245 + (:WHILE (parse-while-stmt st)) 246 + (:CALL (parse-call-stmt st)) 247 + (:STOP (parse-stop-stmt st)) 248 + (:IDENT 249 + (let ((name (current-value st))) 250 + (cond 251 + ((string= name "WRITE") 252 + (parse-write-stmt st)) 253 + (t 254 + (parse-assignment-stmt st))))) 255 + (otherwise 256 + (let ((tok (current-token st))) 257 + (error "Unexpected statement token at ~D:~D: ~A" 258 + (token-line tok) 259 + (token-column tok) 260 + (token-type tok)))))) 261 + 262 + (defun parse-statements-until (st terminators) 263 + (let ((stmts '())) 264 + (loop while (not (member (current-type st) terminators :test #'eql)) do 265 + (push (parse-statement st) stmts)) 266 + (expect st :END) 267 + (nreverse stmts))) 268 + 269 + (defun parse-param-list-after-lparen (st) 270 + (let ((params '())) 271 + (unless (match st :RPAREN) 272 + (push (make-param :type (parse-type-name st) 273 + :name (parse-ident st)) 274 + params) 275 + (loop while (match st :COMMA) do 276 + (push (make-param :type (parse-type-name st) 277 + :name (parse-ident st)) 278 + params)) 279 + (expect st :RPAREN)) 280 + (nreverse params))) 281 + 282 + (defun parse-procedure (st) 283 + (expect st :PROCEDURE) 284 + (let ((name (parse-ident st))) 285 + (expect st :LPAREN) 286 + (let ((params (parse-param-list-after-lparen st))) 287 + (expect st :BEGIN) 288 + (make-procedure 289 + :name name 290 + :params params 291 + :body (parse-statements-until st '(:END)))))) 292 + 293 + (defun parse-array-decl (st) 294 + (expect st :ARRAY) 295 + (let ((etype (parse-type-name st)) 296 + (name (parse-ident st))) 297 + (expect st :LBRACKET) 298 + (let* ((tok (expect st :INT-LIT)) 299 + (size (token-value tok))) 300 + (expect st :RBRACKET) 301 + (make-array-decl :element-type etype :name name :size size)))) 302 + 303 + (defun parse-var-decl (st) 304 + (let ((type (parse-type-name st)) 305 + (name (parse-ident st))) 306 + (make-var-decl :type type :name name))) 307 + 308 + (defun parse-top-level-items (st) 309 + (let ((decls '()) 310 + (procs '())) 311 + (loop while (not (eql (current-type st) :BEGIN)) do 312 + (case (current-type st) 313 + (:ARRAY 314 + (push (parse-array-decl st) decls)) 315 + (:PROCEDURE 316 + (push (parse-procedure st) procs)) 317 + ((:INTEGER :BOOLEAN :STRING :JSON) 318 + (push (parse-var-decl st) decls)) 319 + (otherwise 320 + (let ((tok (current-token st))) 321 + (error "Unexpected top-level token at ~D:~D: ~A" 322 + (token-line tok) 323 + (token-column tok) 324 + (token-type tok)))))) 325 + (values (nreverse decls) (nreverse procs)))) 326 + 327 + (defun parse-program (st) 328 + (expect st :PROGRAM) 329 + (let ((name (parse-ident st))) 330 + (multiple-value-bind (decls procs) 331 + (parse-top-level-items st) 332 + (expect st :BEGIN) 333 + (let ((body (parse-statements-until st '(:END)))) 334 + (expect st :EOF) 335 + (make-program :name name 336 + :declarations decls 337 + :procedures procs 338 + :body body))))) 339 + 340 + (defun parse-source (source) 341 + (let* ((tokens (lex-source source)) 342 + (st (make-instance 'parser-state :tokens tokens))) 343 + (parse-program st))) 344 + 345 + (defun parse-file (path) 346 + (with-open-file (in path :direction :input) 347 + (let ((content (make-string (file-length in)))) 348 + (read-sequence content in) 349 + (parse-source content))))

+204

lisp-tools/parser/pretty.lisp

··· 1 + (defpackage :superplan.pretty 2 + (:use :cl) 3 + (:import-from :superplan.ast 4 + :program-p 5 + :program-name 6 + :program-declarations 7 + :program-procedures 8 + :program-body 9 + 10 + :var-decl-p 11 + :var-decl-type 12 + :var-decl-name 13 + 14 + :array-decl-p 15 + :array-decl-element-type 16 + :array-decl-name 17 + :array-decl-size 18 + 19 + :procedure-p 20 + :procedure-name 21 + :procedure-params 22 + :procedure-body 23 + 24 + :param-p 25 + :param-type 26 + :param-name 27 + 28 + :assign-p 29 + :assign-target 30 + :assign-value 31 + 32 + :write-stmt-p 33 + :write-stmt-expr 34 + 35 + :if-stmt-p 36 + :if-stmt-condition 37 + :if-stmt-body 38 + 39 + :while-stmt-p 40 + :while-stmt-condition 41 + :while-stmt-body 42 + 43 + :call-stmt-p 44 + :call-stmt-name 45 + :call-stmt-args 46 + 47 + :stop-stmt-p 48 + 49 + :var-ref-p 50 + :var-ref-name 51 + 52 + :string-literal-p 53 + :string-literal-value 54 + 55 + :int-literal-p 56 + :int-literal-value 57 + 58 + :bool-literal-p 59 + :bool-literal-value 60 + 61 + :binary-expr-p 62 + :binary-expr-op 63 + :binary-expr-left 64 + :binary-expr-right 65 + 66 + :func-call-expr-p 67 + :func-call-expr-name 68 + :func-call-expr-args) 69 + (:export :pretty-print-ast)) 70 + (in-package :superplan.pretty) 71 + 72 + (defun indent (n stream) 73 + (dotimes (_ n) (write-string " " stream))) 74 + 75 + (defun pp-node (node &optional (stream *standard-output*) (level 0)) 76 + (cond 77 + ((program-p node) 78 + (indent level stream) 79 + (format stream "PROGRAM ~A~%" (program-name node)) 80 + 81 + (indent level stream) 82 + (format stream "DECLARATIONS~%") 83 + (dolist (d (program-declarations node)) 84 + (pp-node d stream (1+ level))) 85 + 86 + (indent level stream) 87 + (format stream "PROCEDURES~%") 88 + (dolist (p (program-procedures node)) 89 + (pp-node p stream (1+ level))) 90 + 91 + (indent level stream) 92 + (format stream "BODY~%") 93 + (dolist (s (program-body node)) 94 + (pp-node s stream (1+ level)))) 95 + 96 + ((var-decl-p node) 97 + (indent level stream) 98 + (format stream "VAR-DECL type=~A name=~A~%" 99 + (var-decl-type node) 100 + (var-decl-name node))) 101 + 102 + ((array-decl-p node) 103 + (indent level stream) 104 + (format stream "ARRAY-DECL type=~A name=~A size=~A~%" 105 + (array-decl-element-type node) 106 + (array-decl-name node) 107 + (array-decl-size node))) 108 + 109 + ((procedure-p node) 110 + (indent level stream) 111 + (format stream "PROCEDURE ~A~%" (procedure-name node)) 112 + 113 + (indent (1+ level) stream) 114 + (format stream "PARAMS~%") 115 + (dolist (p (procedure-params node)) 116 + (pp-node p stream (+ level 2))) 117 + 118 + (indent (1+ level) stream) 119 + (format stream "BODY~%") 120 + (dolist (s (procedure-body node)) 121 + (pp-node s stream (+ level 2)))) 122 + 123 + ((param-p node) 124 + (indent level stream) 125 + (format stream "PARAM type=~A name=~A~%" 126 + (param-type node) 127 + (param-name node))) 128 + 129 + ((assign-p node) 130 + (indent level stream) 131 + (format stream "ASSIGN target=~A~%" (assign-target node)) 132 + (pp-node (assign-value node) stream (1+ level))) 133 + 134 + ((write-stmt-p node) 135 + (indent level stream) 136 + (format stream "WRITE~%") 137 + (pp-node (write-stmt-expr node) stream (1+ level))) 138 + 139 + ((if-stmt-p node) 140 + (indent level stream) 141 + (format stream "IF~%") 142 + (indent (1+ level) stream) 143 + (format stream "COND~%") 144 + (pp-node (if-stmt-condition node) stream (+ level 2)) 145 + (indent (1+ level) stream) 146 + (format stream "BODY~%") 147 + (dolist (s (if-stmt-body node)) 148 + (pp-node s stream (+ level 2)))) 149 + 150 + ((while-stmt-p node) 151 + (indent level stream) 152 + (format stream "WHILE~%") 153 + (indent (1+ level) stream) 154 + (format stream "COND~%") 155 + (pp-node (while-stmt-condition node) stream (+ level 2)) 156 + (indent (1+ level) stream) 157 + (format stream "BODY~%") 158 + (dolist (s (while-stmt-body node)) 159 + (pp-node s stream (+ level 2)))) 160 + 161 + ((call-stmt-p node) 162 + (indent level stream) 163 + (format stream "CALL name=~A~%" (call-stmt-name node)) 164 + (dolist (a (call-stmt-args node)) 165 + (pp-node a stream (1+ level)))) 166 + 167 + ((stop-stmt-p node) 168 + (indent level stream) 169 + (format stream "STOP~%")) 170 + 171 + ((var-ref-p node) 172 + (indent level stream) 173 + (format stream "VAR-REF ~A~%" (var-ref-name node))) 174 + 175 + ((string-literal-p node) 176 + (indent level stream) 177 + (format stream "STRING ~S~%" (string-literal-value node))) 178 + 179 + ((int-literal-p node) 180 + (indent level stream) 181 + (format stream "INT ~A~%" (int-literal-value node))) 182 + 183 + ((bool-literal-p node) 184 + (indent level stream) 185 + (format stream "BOOL ~A~%" (if (bool-literal-value node) "TRUE" "FALSE"))) 186 + 187 + ((binary-expr-p node) 188 + (indent level stream) 189 + (format stream "BINARY op=~A~%" (binary-expr-op node)) 190 + (pp-node (binary-expr-left node) stream (1+ level)) 191 + (pp-node (binary-expr-right node) stream (1+ level))) 192 + 193 + ((func-call-expr-p node) 194 + (indent level stream) 195 + (format stream "FUNC-CALL name=~A~%" (func-call-expr-name node)) 196 + (dolist (a (func-call-expr-args node)) 197 + (pp-node a stream (1+ level)))) 198 + 199 + (t 200 + (indent level stream) 201 + (format stream "UNKNOWN ~S~%" node)))) 202 + 203 + (defun pretty-print-ast (node &optional (stream *standard-output*)) 204 + (pp-node node stream 0))

+18

lisp-tools/parser/run.lisp

··· 1 + (load "lisp-tools/parser/ast.lisp") 2 + (load "lisp-tools/parser/lexer.lisp") 3 + (load "lisp-tools/parser/parser.lisp") 4 + (load "lisp-tools/parser/pretty.lisp") 5 + (load "lisp-tools/interpreter/env.lisp") 6 + (load "lisp-tools/interpreter/bridge-client.lisp") 7 + 8 + (setf superplan.bridge-client:*bridge-backend* :rust 9 + superplan.bridge-client:*rust-bridge-program* 10 + "bridge/target/debug/superplan-atproto-bridge") 11 + 12 + (load "lisp-tools/interpreter/interpreter.lisp") 13 + 14 + (format t "~%Parsing file...~%~%") 15 + (let ((ast (superplan.parser:parse-file "superplan/examples/home.sp"))) 16 + (superplan.pretty:pretty-print-ast ast) 17 + (format t "~%--- Running ---~%~%") 18 + (superplan.interpreter:run-program ast))

+96

superplan/examples/home.sp

··· 1 + PROGRAM HOME 2 + 3 + STRING HANDLE 4 + STRING PASSWORD 5 + STRING CMD 6 + STRING TEXT 7 + STRING ACTOR 8 + JSON TL 9 + JSON PROFILE 10 + JSON ME 11 + 12 + PROCEDURE SHOW_HOME(JSON TL) 13 + BEGIN 14 + WRITE(JSON_STRING(JSON_GET(JSON_INDEX(JSON_GET(TL, "feed"), 0), "text"))) 15 + END 16 + 17 + PROCEDURE SHOW_PROFILE(JSON PROFILE) 18 + BEGIN 19 + WRITE("HANDLE:") 20 + WRITE(JSON_STRING(JSON_GET(PROFILE, "handle"))) 21 + WRITE("DISPLAY NAME:") 22 + WRITE(JSON_STRING(JSON_GET(PROFILE, "displayName"))) 23 + END 24 + 25 + PROCEDURE SHOW_WHOAMI(JSON ME) 26 + BEGIN 27 + WRITE("HANDLE:") 28 + WRITE(JSON_STRING(JSON_GET(ME, "handle"))) 29 + WRITE("DID:") 30 + WRITE(JSON_STRING(JSON_GET(ME, "did"))) 31 + WRITE("PDS:") 32 + WRITE(JSON_STRING(JSON_GET(ME, "pds"))) 33 + END 34 + 35 + PROCEDURE SHOW_HELP() 36 + BEGIN 37 + WRITE("AVAILABLE COMMANDS:") 38 + WRITE("HOME") 39 + WRITE("PROFILE") 40 + WRITE("POST") 41 + WRITE("WHOAMI") 42 + WRITE("HELP") 43 + WRITE("QUIT") 44 + END 45 + 46 + BEGIN 47 + WRITE("SUPERPLAN SKY") 48 + 49 + WRITE("HANDLE:") 50 + HANDLE = READLINE() 51 + 52 + WRITE("APP PASSWORD:") 53 + PASSWORD = READLINE() 54 + 55 + IF ATP_LOGIN(HANDLE, PASSWORD) THEN 56 + CALL SHOW_HELP() 57 + 58 + WHILE TRUE DO 59 + WRITE("COMMAND:") 60 + CMD = READLINE() 61 + 62 + IF CMD = "HOME" THEN 63 + TL = ATP_TIMELINE("") 64 + CALL SHOW_HOME(TL) 65 + END 66 + 67 + IF CMD = "PROFILE" THEN 68 + WRITE("ACTOR:") 69 + ACTOR = READLINE() 70 + PROFILE = ATP_PROFILE(ACTOR) 71 + CALL SHOW_PROFILE(PROFILE) 72 + END 73 + 74 + IF CMD = "POST" THEN 75 + WRITE("TEXT:") 76 + TEXT = READLINE() 77 + IF ATP_POST(TEXT) THEN 78 + WRITE("POST OK") 79 + END 80 + END 81 + 82 + IF CMD = "WHOAMI" THEN 83 + ME = ATP_WHOAMI() 84 + CALL SHOW_WHOAMI(ME) 85 + END 86 + 87 + IF CMD = "HELP" THEN 88 + CALL SHOW_HELP() 89 + END 90 + 91 + IF CMD = "QUIT" THEN 92 + STOP 93 + END 94 + END 95 + END 96 + END

Configure Feed

Configure Feed