giles
84d210b6b3
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m2s
142 lines
3.9 KiB
Plaintext
142 lines
3.9 KiB
Plaintext
; APL transpile / AST evaluator
|
||
;
|
||
; Walks parsed AST nodes and evaluates against the runtime.
|
||
; Entry points:
|
||
; apl-eval-ast : node × env → value
|
||
; apl-call-dfn : dfn-ast × ⍺ × ⍵ → value (dyadic)
|
||
; apl-call-dfn-m : dfn-ast × ⍵ → value (monadic)
|
||
;
|
||
; Env is a dict; ⍺ stored under key "alpha", ⍵ under "omega",
|
||
; user names under their literal name. nil means absent.
|
||
|
||
(define
|
||
apl-monadic-fn
|
||
(fn
|
||
(g)
|
||
(cond
|
||
((= g "+") apl-plus-m)
|
||
((= g "-") apl-neg-m)
|
||
((= g "×") apl-signum)
|
||
((= g "÷") apl-recip)
|
||
((= g "⌈") apl-ceil)
|
||
((= g "⌊") apl-floor)
|
||
((= g "⍳") apl-iota)
|
||
((= g "|") apl-abs)
|
||
((= g "*") apl-exp)
|
||
((= g "⍟") apl-ln)
|
||
((= g "!") apl-fact)
|
||
((= g "○") apl-pi-times)
|
||
((= g "~") apl-not)
|
||
((= g "≢") apl-tally)
|
||
((= g "⍴") apl-shape)
|
||
((= g "≡") apl-depth)
|
||
((= g "⊂") apl-enclose)
|
||
((= g "⊃") apl-disclose)
|
||
((= g ",") apl-ravel)
|
||
((= g "⌽") apl-reverse)
|
||
((= g "⊖") apl-reverse-first)
|
||
((= g "⍋") apl-grade-up)
|
||
((= g "⍒") apl-grade-down)
|
||
(else (error "no monadic fn for glyph")))))
|
||
|
||
(define
|
||
apl-dyadic-fn
|
||
(fn
|
||
(g)
|
||
(cond
|
||
((= g "+") apl-add)
|
||
((= g "-") apl-sub)
|
||
((= g "×") apl-mul)
|
||
((= g "÷") apl-div)
|
||
((= g "⌈") apl-max)
|
||
((= g "⌊") apl-min)
|
||
((= g "*") apl-pow)
|
||
((= g "⍟") apl-log)
|
||
((= g "|") apl-mod)
|
||
((= g "!") apl-binomial)
|
||
((= g "○") apl-trig)
|
||
((= g "<") apl-lt)
|
||
((= g "≤") apl-le)
|
||
((= g "=") apl-eq)
|
||
((= g "≥") apl-ge)
|
||
((= g ">") apl-gt)
|
||
((= g "≠") apl-ne)
|
||
((= g "∧") apl-and)
|
||
((= g "∨") apl-or)
|
||
((= g "⍱") apl-nor)
|
||
((= g "⍲") apl-nand)
|
||
((= g ",") apl-catenate)
|
||
((= g "⍪") apl-catenate-first)
|
||
((= g "⍴") apl-reshape)
|
||
((= g "↑") apl-take)
|
||
((= g "↓") apl-drop)
|
||
((= g "⌷") apl-squad)
|
||
((= g "⌽") apl-rotate)
|
||
((= g "⊖") apl-rotate-first)
|
||
((= g "∊") apl-member)
|
||
((= g "⍳") apl-index-of)
|
||
((= g "~") apl-without)
|
||
(else (error "no dyadic fn for glyph")))))
|
||
|
||
(define
|
||
apl-eval-ast
|
||
(fn
|
||
(node env)
|
||
(let
|
||
((tag (first node)))
|
||
(cond
|
||
((= tag :num) (apl-scalar (nth node 1)))
|
||
((= tag :vec)
|
||
(let
|
||
((items (rest node)))
|
||
(let
|
||
((vals (map (fn (n) (apl-eval-ast n env)) items)))
|
||
(make-array
|
||
(list (len vals))
|
||
(map (fn (v) (first (get v :ravel))) vals)))))
|
||
((= tag :name)
|
||
(let
|
||
((nm (nth node 1)))
|
||
(cond
|
||
((= nm "⍺") (get env "alpha"))
|
||
((= nm "⍵") (get env "omega"))
|
||
(else (get env nm)))))
|
||
((= tag :monad)
|
||
(let
|
||
((fn-node (nth node 1)) (arg (nth node 2)))
|
||
(let
|
||
((g (nth fn-node 1)))
|
||
((apl-monadic-fn g) (apl-eval-ast arg env)))))
|
||
((= tag :dyad)
|
||
(let
|
||
((fn-node (nth node 1))
|
||
(lhs (nth node 2))
|
||
(rhs (nth node 3)))
|
||
(let
|
||
((g (nth fn-node 1)))
|
||
((apl-dyadic-fn g)
|
||
(apl-eval-ast lhs env)
|
||
(apl-eval-ast rhs env)))))
|
||
((= tag :program)
|
||
(let
|
||
((stmts (rest node)))
|
||
(reduce (fn (acc s) (apl-eval-ast s env)) nil stmts)))
|
||
((= tag :dfn) node)
|
||
(else (error "apl-eval-ast: unknown node tag"))))))
|
||
|
||
(define
|
||
apl-call-dfn
|
||
(fn
|
||
(dfn-ast alpha omega)
|
||
(let
|
||
((stmts (rest dfn-ast)) (env {:omega omega :alpha alpha}))
|
||
(reduce (fn (acc s) (apl-eval-ast s env)) nil stmts))))
|
||
|
||
(define
|
||
apl-call-dfn-m
|
||
(fn
|
||
(dfn-ast omega)
|
||
(let
|
||
((stmts (rest dfn-ast)) (env {:omega omega :alpha nil}))
|
||
(reduce (fn (acc s) (apl-eval-ast s env)) nil stmts))))
|