Joseph Ferano
5ea0bcae84
nth and at were documented as the same operation, and as reads they were: check.ml matched "at" | "nth" in one arm. But a place is recovered in two other spots -- parse.ml for (set ...) and place_of_expr for (addr ...) -- and both match only Sym "at". So (set (nth a i) x) and (addr (nth a i)) were refused while the at forms worked. Two names said to be identical that disagree about writing is worse than one name, and the asymmetry is not worth fixing in three places to keep a synonym. at is the indexing operation; nth is gone. The six call sites were all reads, so they rewrite directly. get/put stay the Map pair: get returns (Option V) and is deliberately not a place. nth-gone.flan pins the removal -- it has to fail as a name nobody defined, not quietly resolve to at again. destructure~nth is compiler-generated and unrelated.
126 lines
5.0 KiB
Plaintext
126 lines
5.0 KiB
Plaintext
;;;; calc-me — THE FIRST ACCEPTANCE PROGRAM (build sequence milestone 2).
|
|
;;;;
|
|
;;;; $ calc-me "1 + 2 * (3 - 0.5) / 2"
|
|
;;;; 3.5
|
|
;;;;
|
|
;;;; Chosen to be the smallest program that is still a real one. What it needs:
|
|
;;;; functions, recursion, structs, (Ptr T) and `addr`, byte slices, `at`/`len`,
|
|
;;;; `while`, `set` on locals and on fields, `cond`, `match`, Option, i32/u8/f64,
|
|
;;;; and argv. What it deliberately does NOT need: an allocator, Vec, Map, any
|
|
;;;; generic function, any macro the user wrote, FFI beyond argv and stdout,
|
|
;;;; a window, or a frame loop. It runs headless, so it is the same test on
|
|
;;;; native and on wasm32 — which is how the second target gets proven early.
|
|
;;;;
|
|
;;;; No `ns` form and no package declaration: the package name is inferred from
|
|
;;;; the directory. `(package calc)` is written only when the name must differ
|
|
;;;; from the directory name. See plan.org "Modules".
|
|
|
|
;; ── Cursor over the input. A plain value struct; recursive descent shares
|
|
;; ── one by pointer. `addr` takes the address of a local; the pointer never
|
|
;; ── outlives the frame, so no allocator is involved.
|
|
(defstruct Cursor
|
|
[src [u8] ; non-owning slice into argv — calc-me never owns a byte
|
|
pos i32]) ; no initialiser means zeroed
|
|
|
|
(defn peek [c (Ptr Cursor)] u8
|
|
(if (< (.pos c) (len (.src c)))
|
|
(at (.src c) (.pos c))
|
|
0)) ; 0 doubles as end-of-input
|
|
|
|
(defn advance [c (Ptr Cursor)]
|
|
(set (.pos c) (+ (.pos c) 1))) ; field access auto-derefs one level
|
|
|
|
(defn skip-spaces [c (Ptr Cursor)]
|
|
(while (= (peek c) \space)
|
|
(advance c)))
|
|
|
|
;; digit? was written here until the prelude grew one. There is a single
|
|
;; top-level namespace, so a second definition is now an error rather than a
|
|
;; shadow — which is the rule working: two byte-identical digit? functions
|
|
;; that later drift apart is exactly what it exists to prevent.
|
|
|
|
;; ── number := digit+ ("." digit+)? ────────────────────────────────────
|
|
(defn parse-number [c (Ptr Cursor)] (Option f64)
|
|
(skip-spaces c)
|
|
(let [start (.pos c)]
|
|
(while (digit? (peek c))
|
|
(advance c))
|
|
(when (= (peek c) \.)
|
|
(advance c)
|
|
(while (digit? (peek c))
|
|
(advance c)))
|
|
(if (= start (.pos c))
|
|
None
|
|
(Some (bytes->f64 (slice (.src c) start (.pos c)))))))
|
|
|
|
;; ── primary := number | "(" expr ")" | "-" primary ────────────────────
|
|
;; `some` unwraps Some and early-returns None from THIS function. It and
|
|
;; Option are the only error handling here; Result, try and errdefer wait.
|
|
(defn parse-primary [c (Ptr Cursor)] (Option f64)
|
|
(skip-spaces c)
|
|
(cond
|
|
(= (peek c) \-)
|
|
(do (advance c)
|
|
(Some (- 0.0 (some (parse-primary c)))))
|
|
|
|
(= (peek c) \()
|
|
(do (advance c)
|
|
(let [v (some (parse-expr c 1))]
|
|
(skip-spaces c)
|
|
(if (= (peek c) \))
|
|
(do (advance c) (Some v))
|
|
None))) ; unbalanced paren
|
|
|
|
:else
|
|
(parse-number c)))
|
|
|
|
(defn precedence [op u8] i32
|
|
(cond
|
|
(or (= op \+) (= op \-)) 1
|
|
(or (= op \*) (= op \/)) 2
|
|
:else 0)) ; 0 means "not an operator"
|
|
|
|
(defn apply-op [op u8 l f64 r f64] f64
|
|
(cond
|
|
(= op \+) (+ l r)
|
|
(= op \-) (- l r)
|
|
(= op \*) (* l r)
|
|
:else (/ l r)))
|
|
|
|
;; ── expr := primary (op primary)*, precedence climbing ────────────────
|
|
;; Left-associative: the right operand is parsed at prec+1, so 1-2-3 is
|
|
;; (1-2)-3 and not 1-(2-3). Mutually recursive with parse-primary; top-level
|
|
;; names in a package are order-independent, so no forward declaration.
|
|
(defn parse-expr [c (Ptr Cursor) min-prec i32] (Option f64)
|
|
(let [lhs (some (parse-primary c))]
|
|
(skip-spaces c)
|
|
(let [prec (precedence (peek c))]
|
|
(while (and (> prec 0) (>= prec min-prec))
|
|
(let [op (peek c)]
|
|
(advance c)
|
|
(set lhs (apply-op op lhs (some (parse-expr c (+ prec 1))))))
|
|
(skip-spaces c)
|
|
(set prec (precedence (peek c)))))
|
|
(Some lhs)))
|
|
|
|
;; ── Whole input, or nothing. Trailing junk is an error, not ignored. ──
|
|
(defn evaluate [src [u8]] (Option f64)
|
|
(let [c (Cursor {:src src})] ; pos omitted: zeroed
|
|
(let [v (some (parse-expr (addr c) 1))]
|
|
(skip-spaces (addr c))
|
|
(if (= (peek (addr c)) 0)
|
|
(Some v)
|
|
None))))
|
|
|
|
;; Entry point: (defn main [args [string]] i32). Both the parameter and the
|
|
;; return type are optional — sand.flan uses the bare (defn main []) form.
|
|
;; print-str/print-f64/print-line are Flan functions over the write-stdout
|
|
;; primitive, NOT an overloaded println: compile-time overloading waits for
|
|
;; milestone 5, so until then the acceptance programs name the type.
|
|
(defn main [args [string]] i32
|
|
(if (< (len args) 2)
|
|
(do (print-line "usage: calc-me \"1 + 2 * 3\"") 1)
|
|
(match (evaluate (bytes (at args 1)))
|
|
(Some v) (do (print-f64 v) (print-line "") 0)
|
|
None (do (print-line "calc-me: cannot parse") 1))))
|