From fa26249931c1cf71edd78cb1c030b501783ae027 Mon Sep 17 00:00:00 2001 From: "Kartik K. Agaram" Date: Sun, 20 Jun 2021 22:24:03 -0700 Subject: new macro: with --- shell/data.limg | 13 ++++++++++++- shell/evaluate.mu | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ shell/primitives.mu | 3 ++- shell/tokenize.mu | 6 ++++-- 4 files changed, 66 insertions(+), 4 deletions(-) diff --git a/shell/data.limg b/shell/data.limg index 31510aef..3c1656dc 100644 --- a/shell/data.limg +++ b/shell/data.limg @@ -35,7 +35,7 @@ (map1 f (cdr xs)))]) (compose . [def (compose f g) (fn args - (f (g args)))]) + (f (apply g args)))]) (some . [def (some f xs) if (no xs) () @@ -55,6 +55,17 @@ if (= x (car xs)) 1 (find x (cdr xs))]) + (pair . [def (pair xs) + if (no xs) + () + if (no (cdr xs)) + (list (list (car xs))) + (cons (list (car xs) (car (cdr xs))) + (pair (cdr (cdr xs))))]) + (with . [mac (with vars_vals . body) + `((fn ,(map1 car (pair vars_vals)) + ,@body) + ,@(map1 (compose car cdr) (pair vars_vals)))]) (afn . [mac (afn params . body) `(let self () (set self (fn ,params ,@body)))]) diff --git a/shell/evaluate.mu b/shell/evaluate.mu index 8574e8a5..3fcd07d9 100644 --- a/shell/evaluate.mu +++ b/shell/evaluate.mu @@ -220,6 +220,50 @@ fn evaluate _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (han trace-higher trace return } + $evaluate:apply: { + var expr/esi: (addr cell) <- copy in + # if its first elem is not "apply", break + var first-ah/ecx: (addr handle cell) <- get in, left + var rest-ah/edx: (addr handle cell) <- get in, right + var first/eax: (addr cell) <- lookup *first-ah + var apply?/eax: boolean <- symbol-equal? first, "apply" + compare apply?, 0/false + break-if-= + # + trace-text trace, "eval", "apply" + trace-text trace, "eval", "evaluating first arg" + var first-arg-value-h: (handle cell) + var first-arg-value-ah/esi: (addr handle cell) <- address first-arg-value-h + var rest/eax: (addr cell) <- lookup *rest-ah + var first-arg-ah/ecx: (addr handle cell) <- get rest, left + debug-print "A2", 4/fg, 0/bg + evaluate first-arg-ah, first-arg-value-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + debug-print "Y2", 4/fg, 0/bg + # errors? skip + { + var error?/eax: boolean <- has-errors? trace + compare error?, 0/false + break-if-= + trace-higher trace + return + } + # + trace-text trace, "eval", "evaluating second arg" + var rest/eax: (addr cell) <- lookup *rest-ah + rest-ah <- get rest, right + rest <- lookup *rest-ah + var second-ah/eax: (addr handle cell) <- get rest, left + var second-arg-value-h: (handle cell) + var second-arg-value-ah/edi: (addr handle cell) <- address second-arg-value-h + debug-print "T2", 4/fg, 0/bg + evaluate second-ah, second-arg-value-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + debug-print "U2", 4/fg, 0/bg + # apply + apply first-arg-value-ah, second-arg-value-ah, _out-ah, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + # + trace-higher trace + return + } $evaluate:define: { # trees starting with "define" define globals var expr/esi: (addr cell) <- copy in @@ -360,6 +404,8 @@ fn evaluate _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (han trace-higher trace return } + # + trace-text trace, "eval", "evaluating second arg" var rest/eax: (addr cell) <- lookup *rest-ah rest-ah <- get rest, right rest <- lookup *rest-ah @@ -405,6 +451,8 @@ fn evaluate _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (han trace-higher trace return } + # + trace-text trace, "eval", "evaluating second arg" var rest/eax: (addr cell) <- lookup *rest-ah rest-ah <- get rest, right rest <- lookup *rest-ah diff --git a/shell/primitives.mu b/shell/primitives.mu index 3ea943a5..1b25583c 100644 --- a/shell/primitives.mu +++ b/shell/primitives.mu @@ -14,6 +14,7 @@ fn initialize-primitives _self: (addr global-table) { append-primitive self, "<=" append-primitive self, ">=" # generic + append-primitive self, "apply" append-primitive self, "=" append-primitive self, "no" append-primitive self, "not" @@ -104,7 +105,7 @@ fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int { tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg y <- increment var tmpx/eax: int <- copy xmin - tmpx <- draw-text-rightward screen, "fn set if while cons car cdr no not and or = ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + tmpx <- draw-text-rightward screen, "fn apply set if while cons car cdr no not and or = ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg # numbers tmpx <- draw-text-rightward screen, "< > <= >= + - * / % sqrt abs sgn", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg } diff --git a/shell/tokenize.mu b/shell/tokenize.mu index ab25615f..f7e4663c 100644 --- a/shell/tokenize.mu +++ b/shell/tokenize.mu @@ -386,7 +386,7 @@ fn test-tokenize-indent { fn next-token in: (addr gap-buffer), out: (addr token), start-of-line?: boolean, trace: (addr trace) -> _/edi: boolean { trace-text trace, "tokenize", "next-token" trace-lower trace - # first save an indent token + # save an indent token if necessary { compare start-of-line?, 0/false break-if-= @@ -406,12 +406,13 @@ fn next-token in: (addr gap-buffer), out: (addr token), start-of-line?: boolean, trace-text trace, "tokenize", "newline" g <- read-from-gap-buffer in initialize-skip-token out # might drop indent if that's all there was in this line + trace-higher trace return 1/at-start-of-line } { compare start-of-line?, 0/false break-if-= - # still here? no comment or newline? + # still here? no comment or newline? return saved indent trace-higher trace return 0/not-at-start-of-line } @@ -421,6 +422,7 @@ fn next-token in: (addr gap-buffer), out: (addr token), start-of-line?: boolean, break-if-= trace-text trace, "tokenize", "end" initialize-skip-token out + trace-higher trace return 1/at-start-of-line } var _g/eax: grapheme <- peek-from-gap-buffer in -- cgit 1.4.1-2-gfad0