rename the definition primitive to 'def'
This commit is contained in:
Kartik K. Agaram
parent
4bb826b40e
commit
bb1ccae27f
|
|
@ -1,25 +1,25 @@
|
|||
(
|
||||
(globals . (
|
||||
(mac . [(def mac (litmac litfn () (name params . body)
|
||||
`(def ,name (litmac litfn () ,params ,@body))))])
|
||||
(mac . [(define mac (litmac litfn () (name params . body)
|
||||
`(define ,name (litmac litfn () ,params ,@body))))])
|
||||
(do . [(mac do body `((fn () ,@body)))])
|
||||
(let . [(mac let (var val . body)
|
||||
`((fn (,var) ,@body) ,val))])
|
||||
(when . [(mac when (cond . body)
|
||||
`(if ,cond (do ,@body) ()))])
|
||||
(hline1 . [(def hline1 (fn (screen y x xmax color)
|
||||
(hline1 . [(define hline1 (fn (screen y x xmax color)
|
||||
(while (< x xmax)
|
||||
(pixel screen x y color)
|
||||
(set x (+ x 1)))))])
|
||||
(vline1 . [(def vline1 (fn (screen x y ymax color)
|
||||
(vline1 . [(define vline1 (fn (screen x y ymax color)
|
||||
(while (< y ymax)
|
||||
(pixel screen x y color)
|
||||
(set y (+ y 1)))))])
|
||||
(hline . [(def hline (fn (screen y color)
|
||||
(hline . [(define hline (fn (screen y color)
|
||||
(hline1 screen y 0 (width screen) color)))])
|
||||
(vline . [(def vline (fn (screen x color)
|
||||
(vline . [(define vline (fn (screen x color)
|
||||
(vline1 screen x 0 (height screen) color)))])
|
||||
(line . [(def line (fn (screen x0 y0 x1 y1 color)
|
||||
(line . [(define line (fn (screen x0 y0 x1 y1 color)
|
||||
(let (x y) `(,x0 ,y0)
|
||||
(let dx (abs (- x1 x0))
|
||||
(let dy (- 0 (abs (- y1 y0)))
|
||||
|
|
@ -42,24 +42,24 @@
|
|||
(if (<= e2 dx)
|
||||
dx
|
||||
0))))))))))))))])
|
||||
(read_line . [(def read_line (fn (keyboard)
|
||||
(read_line . [(define read_line (fn (keyboard)
|
||||
(let str (stream)
|
||||
(let c (key keyboard)
|
||||
(while (not (or (= c 0) (= c 10)))
|
||||
(write str c)
|
||||
(set c (key keyboard))))
|
||||
str)))])
|
||||
(fill_rect . [(def fill_rect (fn (screen x1 y1 x2 y2 color)
|
||||
(fill_rect . [(define fill_rect (fn (screen x1 y1 x2 y2 color)
|
||||
(while (< y1 y2)
|
||||
(hline1 screen y1 x1 x2 color)
|
||||
(set y1 (+ y1 1)))))])
|
||||
(chessboard_row . [(def chessboard_row (fn (screen px y x xmax)
|
||||
(chessboard_row . [(define chessboard_row (fn (screen px y x xmax)
|
||||
(while (< x xmax)
|
||||
(fill_rect screen
|
||||
x y
|
||||
(+ x px) (+ y px) 15)
|
||||
(set x (+ x (* px 2))))))])
|
||||
(chessboard . [(def chessboard (fn (screen px)
|
||||
(chessboard . [(define chessboard (fn (screen px)
|
||||
(clear screen)
|
||||
(let xmax (width screen)
|
||||
(let ymax (height screen)
|
||||
|
|
@ -69,7 +69,7 @@
|
|||
(set y (+ y px))
|
||||
(chessboard_row screen px y px xmax)
|
||||
(set y (+ y px))))))))])
|
||||
(circle . [(def circle (fn (screen cx cy r clr)
|
||||
(circle . [(define circle (fn (screen cx cy r clr)
|
||||
(let x (- 0 r)
|
||||
(let y 0
|
||||
(let err (- 2 (* 2 r))
|
||||
|
|
@ -91,12 +91,12 @@
|
|||
(+ err
|
||||
(+ 1 (* 2 x)))))
|
||||
(set continue (< x 0)))))))))])
|
||||
(ring . [(def ring (fn(screen cx cy r w clr)
|
||||
(ring . [(define ring (fn(screen cx cy r w clr)
|
||||
(let rmax (+ r w)
|
||||
(while (< r rmax)
|
||||
(circle screen cx cy r clr)
|
||||
(set r (+ r 1))))))])
|
||||
(circle_rainbow . [(def circle_rainbow (fn(scr cx cy r w)
|
||||
(circle_rainbow . [(define circle_rainbow (fn(scr cx cy r w)
|
||||
(ring scr cx cy r w 37)
|
||||
(set r (+ r w))
|
||||
(ring scr cx cy r w 33)
|
||||
|
|
@ -116,7 +116,7 @@
|
|||
(ring scr cx cy r w 41)
|
||||
(set r (+ r w))
|
||||
(ring scr cx cy r w 40)))])
|
||||
(bowboard . [(def bowboard (fn (screen side)
|
||||
(bowboard . [(define bowboard (fn (screen side)
|
||||
(let xmax (width screen)
|
||||
(let ymax (height screen)
|
||||
(let y side
|
||||
|
|
@ -126,9 +126,9 @@
|
|||
(circle_rainbow screen x y (- side 100) 10)
|
||||
(set x (+ x (* 2 side)))))
|
||||
(set y (+ y (* 2 side)))))))))])
|
||||
(main . [(def main (fn (screen keyboard)
|
||||
(main . [(define main (fn (screen keyboard)
|
||||
(circle_rainbow screen 90 90 8 1)))])
|
||||
(task . [(def task (fn (screen)
|
||||
(task . [(define task (fn (screen)
|
||||
(circle_rainbow screen 32 24 8 1)))])
|
||||
))
|
||||
(sandbox . (+ 3 4))
|
||||
|
|
|
|||
|
|
@ -217,18 +217,18 @@ fn evaluate _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (han
|
|||
trace-higher trace
|
||||
return
|
||||
}
|
||||
$evaluate:def: {
|
||||
# trees starting with "def" define globals
|
||||
$evaluate:define: {
|
||||
# trees starting with "define" define globals
|
||||
var expr/esi: (addr cell) <- copy in
|
||||
# if its first elem is not "def", break
|
||||
# if its first elem is not "define", 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 def?/eax: boolean <- symbol-equal? first, "def"
|
||||
compare def?, 0/false
|
||||
var define?/eax: boolean <- symbol-equal? first, "define"
|
||||
compare define?, 0/false
|
||||
break-if-=
|
||||
#
|
||||
trace-text trace, "eval", "def"
|
||||
trace-text trace, "eval", "define"
|
||||
trace-text trace, "eval", "evaluating second arg"
|
||||
var rest/eax: (addr cell) <- lookup *rest-ah
|
||||
var first-arg-ah/ecx: (addr handle cell) <- get rest, left
|
||||
|
|
@ -237,7 +237,7 @@ fn evaluate _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (han
|
|||
var first-arg-type/eax: (addr int) <- get first-arg, type
|
||||
compare *first-arg-type, 2/symbol
|
||||
break-if-=
|
||||
error trace, "first arg to def must be a symbol"
|
||||
error trace, "first arg to define must be a symbol"
|
||||
trace-higher trace
|
||||
return
|
||||
}
|
||||
|
|
|
|||
|
|
@ -387,12 +387,12 @@ fn maybe-stash-gap-buffer-to-global _globals: (addr global-table), _definition-a
|
|||
break-if-=
|
||||
return
|
||||
}
|
||||
# if definition->left is neither "def" nor "set", return
|
||||
# if definition->left is neither "define" nor "set", return
|
||||
var left-ah/eax: (addr handle cell) <- get definition, left
|
||||
var _left/eax: (addr cell) <- lookup *left-ah
|
||||
var left/ecx: (addr cell) <- copy _left
|
||||
{
|
||||
var def?/eax: boolean <- symbol-equal? left, "def"
|
||||
var def?/eax: boolean <- symbol-equal? left, "define"
|
||||
compare def?, 0/false
|
||||
break-if-!=
|
||||
var set?/eax: boolean <- symbol-equal? left, "set"
|
||||
|
|
@ -449,12 +449,12 @@ fn move-gap-buffer-to-global _globals: (addr global-table), _definition-ah: (add
|
|||
break-if-=
|
||||
return
|
||||
}
|
||||
# if definition->left is neither "def" nor "set", return
|
||||
# if definition->left is neither "define" nor "set", return
|
||||
var left-ah/eax: (addr handle cell) <- get definition, left
|
||||
var _left/eax: (addr cell) <- lookup *left-ah
|
||||
var left/ecx: (addr cell) <- copy _left
|
||||
{
|
||||
var def?/eax: boolean <- symbol-equal? left, "def"
|
||||
var def?/eax: boolean <- symbol-equal? left, "define"
|
||||
compare def?, 0/false
|
||||
break-if-!=
|
||||
var set?/eax: boolean <- symbol-equal? left, "set"
|
||||
|
|
|
|||
|
|
@ -179,27 +179,27 @@ fn macroexpand-iter _expr-ah: (addr handle cell), globals: (addr global-table),
|
|||
trace-higher trace
|
||||
return 0/false
|
||||
}
|
||||
$macroexpand-iter:def: {
|
||||
# trees starting with "def" define globals
|
||||
var def?/eax: boolean <- symbol-equal? first, "def"
|
||||
compare def?, 0/false
|
||||
$macroexpand-iter:define: {
|
||||
# trees starting with "define" define globals
|
||||
var define?/eax: boolean <- symbol-equal? first, "define"
|
||||
compare define?, 0/false
|
||||
break-if-=
|
||||
#
|
||||
trace-text trace, "mac", "def"
|
||||
trace-text trace, "mac", "define"
|
||||
var rest/eax: (addr cell) <- lookup *rest-ah
|
||||
rest-ah <- get rest, right # skip name
|
||||
rest <- lookup *rest-ah
|
||||
var val-ah/edx: (addr handle cell) <- get rest, left
|
||||
var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
|
||||
trace-higher trace
|
||||
# trace "def=> " _expr-ah {{{
|
||||
# trace "define=> " _expr-ah {{{
|
||||
{
|
||||
var should-trace?/eax: boolean <- should-trace? trace
|
||||
compare should-trace?, 0/false
|
||||
break-if-=
|
||||
var stream-storage: (stream byte 0x200)
|
||||
var stream/ecx: (addr stream byte) <- address stream-storage
|
||||
write stream, "def=> "
|
||||
write stream, "define=> "
|
||||
var nested-trace-storage: trace
|
||||
var nested-trace/edi: (addr trace) <- address nested-trace-storage
|
||||
initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
|
||||
|
|
@ -401,7 +401,7 @@ fn test-macroexpand {
|
|||
# new macro: m
|
||||
var sandbox-storage: sandbox
|
||||
var sandbox/esi: (addr sandbox) <- address sandbox-storage
|
||||
initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
|
||||
initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
|
||||
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-tweak-screen
|
||||
# invoke macro
|
||||
initialize-sandbox-with sandbox, "(m 3 4)"
|
||||
|
|
@ -440,7 +440,7 @@ fn test-macroexpand-inside-anonymous-fn {
|
|||
# new macro: m
|
||||
var sandbox-storage: sandbox
|
||||
var sandbox/esi: (addr sandbox) <- address sandbox-storage
|
||||
initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
|
||||
initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
|
||||
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-tweak-screen
|
||||
# invoke macro
|
||||
initialize-sandbox-with sandbox, "(fn() (m 3 4))"
|
||||
|
|
@ -478,7 +478,7 @@ fn test-macroexpand-inside-fn-call {
|
|||
# new macro: m
|
||||
var sandbox-storage: sandbox
|
||||
var sandbox/esi: (addr sandbox) <- address sandbox-storage
|
||||
initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
|
||||
initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
|
||||
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-tweak-screen
|
||||
# invoke macro
|
||||
initialize-sandbox-with sandbox, "((fn() (m 3 4)))"
|
||||
|
|
@ -547,7 +547,7 @@ fn pending-test-macroexpand-inside-backquote-unquote {
|
|||
# new macro: m
|
||||
var sandbox-storage: sandbox
|
||||
var sandbox/esi: (addr sandbox) <- address sandbox-storage
|
||||
initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
|
||||
initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
|
||||
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-tweak-screen
|
||||
# invoke macro
|
||||
initialize-sandbox-with sandbox, "`(print [result is ] ,(m 3 4)))"
|
||||
|
|
@ -585,7 +585,7 @@ fn pending-test-macroexpand-inside-nested-backquote-unquote {
|
|||
# new macro: m
|
||||
var sandbox-storage: sandbox
|
||||
var sandbox/esi: (addr sandbox) <- address sandbox-storage
|
||||
initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
|
||||
initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
|
||||
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-tweak-screen
|
||||
# invoke macro
|
||||
initialize-sandbox-with sandbox, "`(a ,(m 3 4) `(b ,(m 3 4) ,,(m 3 4)))"
|
||||
|
|
|
|||
Loading…
Reference in New Issue