narju/floor/
read.rs

1use smol_str::SmolStr;
2
3use super::host::{self, Str};
4use super::{list, list_elements, rc_exp, rc_val, Exp, Prim1, Prim2, RcExp, Val};
5
6/// Errors are ordinary narju values: a reader callable at run time must fail
7/// into something a program can catch.
8fn err(tag: &str, detail: impl Into<String>) -> Val {
9    Val::Pair(
10        rc_val(Val::Sym(SmolStr::new(tag))),
11        rc_val(Str::val(detail.into())),
12    )
13}
14
15// ── text to s-expressions ──────────────────────────────────────────────
16
17enum Tok {
18    Open,
19    Close,
20    /// A prefix wrapping the datum after it: `'`, `` ` ``, `,`, `,@`. The token
21    /// carries the wrapping name, so all four are one case here.
22    Mark(&'static str),
23    Datum(Val),
24}
25
26struct Lexer<'a> {
27    rest: &'a str,
28}
29
30impl<'a> Lexer<'a> {
31    fn skip_trivia(&mut self) {
32        loop {
33            let trimmed = self.rest.trim_start();
34            if let Some(after) = trimmed.strip_prefix(';') {
35                self.rest = after.split_once('\n').map_or("", |(_, t)| t);
36                continue;
37            }
38            self.rest = trimmed;
39            return;
40        }
41    }
42
43    fn next_tok(&mut self) -> Result<Option<Tok>, Val> {
44        self.skip_trivia();
45        let mut chars = self.rest.chars();
46        let c = match chars.next() {
47            None => return Ok(None),
48            Some(c) => c,
49        };
50        match c {
51            '(' => {
52                self.rest = chars.as_str();
53                Ok(Some(Tok::Open))
54            }
55            ')' => {
56                self.rest = chars.as_str();
57                Ok(Some(Tok::Close))
58            }
59            '\'' => {
60                self.rest = chars.as_str();
61                Ok(Some(Tok::Mark("quote")))
62            }
63            '`' => {
64                self.rest = chars.as_str();
65                Ok(Some(Tok::Mark("quasiquote")))
66            }
67            ',' => {
68                self.rest = chars.as_str();
69                match chars.next() {
70                    Some('@') => {
71                        self.rest = chars.as_str();
72                        Ok(Some(Tok::Mark("unquote-splicing")))
73                    }
74                    _ => Ok(Some(Tok::Mark("unquote"))),
75                }
76            }
77            '"' => {
78                self.rest = chars.as_str();
79                self.string_literal().map(|v| Some(Tok::Datum(v)))
80            }
81            _ => {
82                let end = self
83                    .rest
84                    .find(|c: char| c.is_whitespace() || "()';\"`,".contains(c))
85                    .unwrap_or(self.rest.len());
86                let (word, tail) = self.rest.split_at(end);
87                self.rest = tail;
88                Ok(Some(Tok::Datum(atom(word))))
89            }
90        }
91    }
92
93    fn string_literal(&mut self) -> Result<Val, Val> {
94        let mut out = String::new();
95        let mut chars = self.rest.chars();
96        loop {
97            match chars.next() {
98                None => return Err(err("read-error", "unterminated string")),
99                Some('"') => {
100                    self.rest = chars.as_str();
101                    return Ok(Str::val(out));
102                }
103                Some('\\') => match chars.next() {
104                    Some('n') => out.push('\n'),
105                    Some('t') => out.push('\t'),
106                    Some(c @ ('\\' | '"')) => out.push(c),
107                    Some(c) => return Err(err("read-error", format!("bad escape \\{c}"))),
108                    None => return Err(err("read-error", "unterminated string")),
109                },
110                Some(c) => out.push(c),
111            }
112        }
113    }
114}
115
116/// Anything that is not a number is a symbol, which is why `-` and `.` survive
117/// as symbols without a special case.
118fn atom(word: &str) -> Val {
119    if let Ok(n) = word.parse::<i64>() {
120        return Val::Num(n);
121    }
122    if let Ok(x) = word.parse::<f64>() {
123        return Val::Flo(x);
124    }
125    Val::Sym(SmolStr::new(word))
126}
127
128/// `marks` holds the prefixes seen since the last complete datum, outermost
129/// first, and lives on the frame the datum will land in - so a prefix before an
130/// open paren applies to the list that paren opens.
131struct Frame {
132    items: Vec<Val>,
133    marks: Vec<&'static str>,
134}
135
136impl Frame {
137    fn accept(&mut self, mut v: Val) {
138        for m in self.marks.drain(..).rev() {
139            v = list(&[Val::Sym(SmolStr::new(m)), v]);
140        }
141        self.items.push(v);
142    }
143}
144
145/// A trailing `. x` names the tail rather than an element, which is what lets
146/// quoted data denote an improper pair.
147fn close(items: Vec<Val>) -> Result<Val, Val> {
148    let dot = items
149        .iter()
150        .position(|v| matches!(v, Val::Sym(s) if s == "."));
151    let (elems, tail) = match dot {
152        None => (&items[..], Val::Nil),
153        Some(i) if i + 2 == items.len() && i > 0 => (&items[..i], items[i + 1].clone()),
154        Some(_) => return Err(err("read-error", "misplaced .")),
155    };
156    Ok(elems
157        .iter()
158        .rev()
159        .fold(tail, |t, h| Val::Pair(rc_val(h.clone()), rc_val(t))))
160}
161
162/// Iterative, so nesting depth is bounded by memory rather than the Rust stack.
163pub fn read(src: &str) -> Result<Vec<Val>, Val> {
164    let mut lex = Lexer { rest: src };
165    let mut stack = vec![Frame {
166        items: Vec::new(),
167        marks: Vec::new(),
168    }];
169
170    while let Some(tok) = lex.next_tok()? {
171        match tok {
172            Tok::Open => stack.push(Frame {
173                items: Vec::new(),
174                marks: Vec::new(),
175            }),
176            Tok::Close => {
177                let done = stack.pop().expect("the base frame is never closed");
178                let v = close(done.items)?;
179                match stack.last_mut() {
180                    Some(f) => f.accept(v),
181                    None => return Err(err("read-error", "unbalanced )")),
182                }
183            }
184            Tok::Mark(m) => stack.last_mut().expect("a frame is open").marks.push(m),
185            Tok::Datum(v) => stack.last_mut().expect("a frame is open").accept(v),
186        }
187    }
188
189    if stack.len() != 1 {
190        return Err(err("read-error", "unbalanced ("));
191    }
192    let base = stack.pop().expect("the base frame");
193    if !base.marks.is_empty() {
194        return Err(err("read-error", "quote with nothing to quote"));
195    }
196    Ok(base.items)
197}
198
199// ── s-expressions to code ──────────────────────────────────────────────
200
201/// Reserved: a binder may not shadow one, since a call site whose syntax
202/// depends on scope cannot be read locally. Primitive and op names are *not*
203/// here - shadowing one only changes which value a name denotes.
204const SPECIAL: &[&str] = &[
205    "lambda", "let", "if", "quote", "lift", "lift-ref", "run", "code?", "evalms", "catch", "throw",
206    "apply", "lift-fun",
207];
208
209fn prim1(name: &str) -> Option<Prim1> {
210    Prim1::from_name(name)
211}
212
213fn prim2(name: &str) -> Option<Prim2> {
214    Prim2::from_name(name)
215}
216
217enum Job {
218    Lower(Val),
219    Quote(Val),
220    Bind(SmolStr),
221    Unbind(usize),
222    Build(Build),
223}
224
225/// Each variant pops its operands off the result stack, in reverse.
226enum Build {
227    Lam(u16),
228    Let,
229    If,
230    App(usize),
231    Apply,
232    LiftFun,
233    P1(Prim1),
234    P2(Prim2),
235    Lift,
236    LiftRef,
237    Run,
238    IsCode,
239    Evalms,
240    Catch,
241    Throw,
242    Op(u16, usize),
243}
244
245/// Lower source against `names`, the variables already in scope, outermost
246/// first — the same order [`Exp::Var`] indexes.
247pub fn trans(src: &Val, names: &Val) -> Result<Val, Val> {
248    let mut env = name_list(names)?;
249    let mut jobs = vec![Job::Lower(src.clone())];
250    let mut out: Vec<RcExp> = Vec::new();
251
252    while let Some(job) = jobs.pop() {
253        match job {
254            Job::Bind(n) => env.push(n),
255            Job::Unbind(k) => env.truncate(env.len() - k),
256            Job::Build(b) => build(b, &mut out),
257            Job::Quote(v) => quote(v, &mut jobs, &mut out),
258            Job::Lower(v) => lower(v, &env, &mut jobs, &mut out)?,
259        }
260    }
261
262    match out.pop() {
263        Some(e) if out.is_empty() => Ok(Val::Code(e)),
264        _ => Err(err("trans", "malformed source")),
265    }
266}
267
268fn name_list(v: &Val) -> Result<Vec<SmolStr>, Val> {
269    let mut out = Vec::new();
270    let mut cur = v;
271    loop {
272        match cur {
273            Val::Nil => return Ok(out),
274            Val::Pair(h, t) => {
275                match &**h {
276                    Val::Sym(s) => out.push(s.clone()),
277                    // A name a program cannot mention still occupies an index,
278                    // so the positions of the ones it can stay right.
279                    _ => out.push(SmolStr::new("")),
280                }
281                cur = t;
282            }
283            _ => return Err(err("trans", "environment is not a list")),
284        }
285    }
286}
287
288fn elements(v: &Val) -> Result<Vec<Val>, Val> {
289    list_elements(v).ok_or_else(|| err("trans", "improper form"))
290}
291
292/// The surface consults this to tell a form it must leave alone from an
293/// application it should curry.
294pub fn form_arity(name: &str) -> Option<usize> {
295    match name {
296        "quote" | "lift" | "catch" | "throw" => Some(1),
297        "lambda" | "let" | "lift-ref" | "run" | "code?" | "evalms" | "apply" | "lift-fun" => {
298            Some(2)
299        }
300        "if" => Some(3),
301        _ if prim1(name).is_some() => Some(1),
302        _ if prim2(name).is_some() => Some(2),
303        _ => {
304            let r = host::registry();
305            r.lookup(name).map(|i| r.get(i).arity)
306        }
307    }
308}
309
310fn build(b: Build, out: &mut Vec<RcExp>) {
311    let pop = |out: &mut Vec<RcExp>| out.pop().expect("build: operand");
312    let e = match b {
313        Build::Lam(n) => Exp::Lam(n, pop(out)),
314        Build::Catch => Exp::Catch(pop(out)),
315        Build::Throw => Exp::Throw(pop(out)),
316        Build::Lift => Exp::Lift(pop(out)),
317        Build::P1(op) => Exp::Prim1(op, pop(out)),
318        Build::Let => {
319            let (body, init) = (pop(out), pop(out));
320            Exp::Let(init, body)
321        }
322        Build::App(n) => {
323            let args: Box<[RcExp]> = out.split_off(out.len() - n).into();
324            Exp::App(pop(out), args)
325        }
326        Build::P2(op) => {
327            let (b2, a) = (pop(out), pop(out));
328            Exp::Prim2(op, a, b2)
329        }
330        Build::Apply => {
331            let (args, f) = (pop(out), pop(out));
332            Exp::Apply(f, args)
333        }
334        Build::LiftFun => {
335            let (f, n) = (pop(out), pop(out));
336            Exp::LiftFun(n, f)
337        }
338        Build::LiftRef => {
339            let (b2, a) = (pop(out), pop(out));
340            Exp::LiftRef(a, b2)
341        }
342        Build::Run => {
343            let (e, b2) = (pop(out), pop(out));
344            Exp::Run(b2, e)
345        }
346        Build::IsCode => {
347            let (b2, a) = (pop(out), pop(out));
348            Exp::IsCode(a, b2)
349        }
350        Build::Evalms => {
351            let (e, env) = (pop(out), pop(out));
352            Exp::Evalms(env, e)
353        }
354        Build::If => {
355            let (f, t, c) = (pop(out), pop(out), pop(out));
356            Exp::If(c, t, f)
357        }
358        Build::Op(idx, n) => {
359            let at = out.len() - n;
360            Exp::Op(idx, out.split_off(at))
361        }
362    };
363    out.push(rc_exp(e));
364}
365
366/// Nothing about quotation is special to the reader: `'(a b)` and
367/// `(cons 'a (cons 'b ()))` lower to the same code.
368fn quote(v: Val, jobs: &mut Vec<Job>, out: &mut Vec<RcExp>) {
369    match v {
370        Val::Pair(h, t) => {
371            jobs.push(Job::Build(Build::P2(Prim2::Cons)));
372            jobs.push(Job::Quote((*t).clone()));
373            jobs.push(Job::Quote((*h).clone()));
374        }
375        Val::Sym(s) => out.push(rc_exp(Exp::Sym(s))),
376        other => out.push(rc_exp(datum(other))),
377    }
378}
379
380/// A value with no syntax rides into the tree as [`Exp::Proc`], the carrier
381/// cross-stage persistence uses - which is how a live closure or cell can be
382/// spliced into source about to be lowered.
383fn datum(v: Val) -> Exp {
384    match v {
385        Val::Num(n) => Exp::Lit(n),
386        Val::Flo(x) => Exp::Flo(x),
387        Val::Atom(a) => Exp::Atom(a),
388        Val::Nil => Exp::Nil,
389        Val::Code(e) => RcExp::unwrap_or_clone(e),
390        other => Exp::Proc(rc_val(other)),
391    }
392}
393
394fn lower(v: Val, env: &[SmolStr], jobs: &mut Vec<Job>, out: &mut Vec<RcExp>) -> Result<(), Val> {
395    let (head, tail) = match v {
396        Val::Sym(ref s) => {
397            return match env.iter().rposition(|n| n == s) {
398                Some(i) => {
399                    out.push(rc_exp(Exp::Var(i)));
400                    Ok(())
401                }
402                None => Err(err("trans", format!("unbound variable {s}"))),
403            }
404        }
405        Val::Pair(h, t) => ((*h).clone(), (*t).clone()),
406        other => {
407            out.push(rc_exp(datum(other)));
408            return Ok(());
409        }
410    };
411
412    let args = elements(&tail)?;
413    if let Val::Sym(s) = &head {
414        if SPECIAL.contains(&s.as_str()) {
415            return special(s, &args, jobs);
416        }
417        // Primitives and ops are shadowable, so the environment is consulted
418        // before the tables are.
419        if !env.iter().any(|n| n == s) {
420            if let Some(()) = table(s, &args, jobs)? {
421                return Ok(());
422            }
423        }
424    }
425
426    jobs.push(Job::Build(Build::App(args.len())));
427    for a in args.iter().rev() {
428        jobs.push(Job::Lower(a.clone()));
429    }
430    jobs.push(Job::Lower(head));
431    Ok(())
432}
433
434fn table(name: &str, args: &[Val], jobs: &mut Vec<Job>) -> Result<Option<()>, Val> {
435    if let Some(op) = prim1(name) {
436        // `receive`'s argument is ignored, so writing it is optional.
437        let arg = match (op, args.len()) {
438            (Prim1::Receive, 0) => Val::Nil,
439            (_, 1) => args[0].clone(),
440            _ => return Err(err("trans", format!("{name} takes one argument"))),
441        };
442        jobs.push(Job::Build(Build::P1(op)));
443        jobs.push(Job::Lower(arg));
444        return Ok(Some(()));
445    }
446    if let Some(op) = prim2(name) {
447        let [a, b] = args else {
448            return Err(err("trans", format!("{name} takes two arguments")));
449        };
450        jobs.push(Job::Build(Build::P2(op)));
451        jobs.push(Job::Lower(b.clone()));
452        jobs.push(Job::Lower(a.clone()));
453        return Ok(Some(()));
454    }
455    if let Some(idx) = host::registry().lookup(name) {
456        let def = host::registry().get(idx);
457        if args.len() != def.arity {
458            return Err(err(
459                "trans",
460                format!("{name} takes {} arguments", def.arity),
461            ));
462        }
463        jobs.push(Job::Build(Build::Op(idx, args.len())));
464        for a in args.iter().rev() {
465            jobs.push(Job::Lower(a.clone()));
466        }
467        return Ok(Some(()));
468    }
469    Ok(None)
470}
471
472fn special(name: &str, args: &[Val], jobs: &mut Vec<Job>) -> Result<(), Val> {
473    let fixed = |n: usize| -> Result<(), Val> {
474        if args.len() == n {
475            Ok(())
476        } else {
477            Err(err("trans", format!("{name} takes {n} arguments")))
478        }
479    };
480    let mut unary = |b: Build| -> Result<(), Val> {
481        fixed(1)?;
482        jobs.push(Job::Build(b));
483        jobs.push(Job::Lower(args[0].clone()));
484        Ok(())
485    };
486    match name {
487        "quote" => {
488            fixed(1)?;
489            jobs.push(Job::Quote(args[0].clone()));
490            Ok(())
491        }
492        "lift" => unary(Build::Lift),
493        "catch" => unary(Build::Catch),
494        "throw" => unary(Build::Throw),
495
496        // A lambda binds its own name and then its parameters; self-binding is
497        // what lets a recursive function be written without a fixed point.
498        "lambda" => {
499            fixed(2)?;
500            let params = elements(&args[0])?;
501            let Some((f, xs)) = params.split_first() else {
502                return Err(err("trans", "lambda takes (self arg ...)"));
503            };
504            let arity = u16::try_from(xs.len())
505                .map_err(|_| err("trans", "lambda takes too many parameters"))?;
506            jobs.push(Job::Build(Build::Lam(arity)));
507            jobs.push(Job::Unbind(xs.len() + 1));
508            jobs.push(Job::Lower(args[1].clone()));
509            for x in xs.iter().rev() {
510                jobs.push(Job::Bind(binder(x)?));
511            }
512            jobs.push(Job::Bind(binder(f)?));
513            Ok(())
514        }
515
516        "let" => {
517            fixed(2)?;
518            let binding = elements(&args[0])?;
519            let [x, init] = binding.as_slice() else {
520                return Err(err("trans", "let takes (name init)"));
521            };
522            jobs.push(Job::Build(Build::Let));
523            jobs.push(Job::Unbind(1));
524            jobs.push(Job::Lower(args[1].clone()));
525            jobs.push(Job::Bind(binder(x)?));
526            jobs.push(Job::Lower(init.clone()));
527            Ok(())
528        }
529
530        "if" => {
531            fixed(3)?;
532            jobs.push(Job::Build(Build::If));
533            for a in args.iter().rev() {
534                jobs.push(Job::Lower(a.clone()));
535            }
536            Ok(())
537        }
538
539        _ => {
540            let b = match name {
541                "lift-ref" => Build::LiftRef,
542                "run" => Build::Run,
543                "code?" => Build::IsCode,
544                "evalms" => Build::Evalms,
545                "apply" => Build::Apply,
546                "lift-fun" => Build::LiftFun,
547                _ => unreachable!("SPECIAL and this match agree"),
548            };
549            fixed(2)?;
550            jobs.push(Job::Build(b));
551            jobs.push(Job::Lower(args[1].clone()));
552            jobs.push(Job::Lower(args[0].clone()));
553
554            Ok(())
555        }
556    }
557}
558
559fn binder(v: &Val) -> Result<SmolStr, Val> {
560    match v {
561        Val::Sym(s) if SPECIAL.contains(&s.as_str()) => {
562            Err(err("trans", format!("{s} is reserved")))
563        }
564        Val::Sym(s) => Ok(s.clone()),
565        _ => Err(err("trans", "binder is not a symbol")),
566    }
567}
568
569// ── the ops ────────────────────────────────────────────────────────────
570
571pub fn read_op(a: &[Val]) -> host::OpResult {
572    match Str::of(&a[0]) {
573        Some(s) => read(s).map(|forms| list(&forms)),
574        None => Err(err("wrong-type", "read")),
575    }
576}
577
578pub fn trans_op(a: &[Val]) -> host::OpResult {
579    trans(&a[0], &a[1])
580}
581
582#[cfg(test)]
583mod tests {
584    use super::*;
585
586    fn one(src: &str) -> Val {
587        let forms = read(src).expect("reads");
588        assert_eq!(forms.len(), 1);
589        forms[0].clone()
590    }
591
592    fn code(src: &str, names: &[&str]) -> Exp {
593        let names = list(
594            &names
595                .iter()
596                .map(|n| Val::Sym(SmolStr::new(n)))
597                .collect::<Vec<_>>(),
598        );
599        match trans(&one(src), &names).expect("lowers") {
600            Val::Code(e) => RcExp::unwrap_or_clone(e),
601            other => panic!("expected code, got {other}"),
602        }
603    }
604
605    #[test]
606    fn a_comment_and_a_string_do_not_confuse_each_other() {
607        assert_eq!(
608            read("; (not a form\n \"a ; b\" 1").expect("reads"),
609            vec![Str::val("a ; b"), Val::Num(1)]
610        );
611    }
612
613    #[test]
614    fn quote_applies_to_the_next_datum_however_deep() {
615        assert_eq!(one("''x"), one("(quote (quote x))"));
616        assert_eq!(one("'(a . b)"), one("(quote (a . b))"));
617    }
618
619    #[test]
620    fn a_word_is_a_symbol_unless_it_is_a_number() {
621        assert_eq!(one("-"), Val::Sym("-".into()));
622        assert_eq!(one("-2"), Val::Num(-2));
623        assert_eq!(one("1.5"), Val::Flo(1.5));
624    }
625
626    #[test]
627    fn binders_resolve_positionally_and_shadow() {
628        // (lambda (f x) (let (x (+ x 1)) x)) - the inner x wins.
629        let e = code("(lambda (f x) (let (x (+ x 1)) x))", &[]);
630        assert_eq!(
631            e,
632            Exp::Lam(
633                1,
634                rc_exp(Exp::Let(
635                    rc_exp(Exp::Prim2(
636                        Prim2::Plus,
637                        rc_exp(Exp::Var(1)),
638                        rc_exp(Exp::Lit(1))
639                    )),
640                    rc_exp(Exp::Var(2)),
641                ))
642            )
643        );
644    }
645
646    #[test]
647    fn an_ambient_environment_shifts_every_index() {
648        assert_eq!(code("(cons a b)", &["a", "b"]), {
649            Exp::Prim2(Prim2::Cons, rc_exp(Exp::Var(0)), rc_exp(Exp::Var(1)))
650        });
651    }
652
653    #[test]
654    fn a_primitive_name_is_shadowable_but_a_special_form_is_not() {
655        // A local `car` is an ordinary variable, so `(car x)` applies it.
656        assert_eq!(
657            code("(car x)", &["car", "x"]),
658            Exp::App(rc_exp(Exp::Var(0)), Box::new([rc_exp(Exp::Var(1))]))
659        );
660        assert!(trans(&one("(lambda (f if) if)"), &Val::Nil).is_err());
661    }
662
663    #[test]
664    fn a_registered_op_lowers_to_an_indexed_call() {
665        let idx = host::registry().lookup("str-len").expect("op present");
666        assert_eq!(
667            code("(str-len \"narju\")", &[]),
668            Exp::Op(
669                idx,
670                vec![rc_exp(Exp::Atom(match Str::val("narju") {
671                    Val::Atom(a) => a,
672                    _ => unreachable!(),
673                }))]
674            )
675        );
676    }
677
678    #[test]
679    fn a_quoted_list_lowers_to_the_conses_that_build_it() {
680        assert_eq!(code("'(a b)", &[]), code("(cons 'a (cons 'b ()))", &[]));
681    }
682
683    #[test]
684    fn a_live_value_splices_in_as_a_persisted_one() {
685        let cell = Val::Cell(3);
686        let src = list(&[Val::Sym("car".into()), cell.clone()]);
687        let got = match trans(&src, &Val::Nil).expect("lowers") {
688            Val::Code(e) => RcExp::unwrap_or_clone(e),
689            other => panic!("expected code, got {other}"),
690        };
691        assert_eq!(got, Exp::Prim1(Prim1::Car, rc_exp(Exp::Proc(rc_val(cell)))));
692    }
693
694    #[test]
695    fn an_unbound_variable_is_a_catchable_value() {
696        assert!(matches!(
697            trans(&one("(car nope)"), &Val::Nil),
698            Err(Val::Pair(_, _))
699        ));
700    }
701}
narju/floor/read.rs

narju/floor/
read.rs
