124 lines
4.8 KiB
Plaintext
124 lines
4.8 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)))
|
|
|
|
(defn digit? [b u8] bool
|
|
(and (>= b \0) (<= b \9)))
|
|
|
|
;; ── 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 (nth args 1)))
|
|
(Some v) (do (print-f64 v) (print-line "") 0)
|
|
None (do (print-line "calc-me: cannot parse") 1))))
|