aboutsummaryrefslogtreecommitdiff
path: root/lib/core
diff options
context:
space:
mode:
authorBruce Hill <bruce@bruce-hill.com>2019-01-16 21:33:02 -0800
committerBruce Hill <bruce@bruce-hill.com>2019-01-16 21:33:30 -0800
commit520acd39795766354fc44c6e15f5f33f255ca33a (patch)
treea4a538dd72ab9a1e229ec3d44beb86b80cfbe7ba /lib/core
parent517d661368611fe753e9fd97a7adb2e45fca745e (diff)
Overhauling OO-API a little to make it more minimalistic.
Diffstat (limited to 'lib/core')
-rw-r--r--lib/core/control_flow.nom14
-rw-r--r--lib/core/metaprogramming.nom22
-rw-r--r--lib/core/operators.nom2
-rw-r--r--lib/core/things.nom108
4 files changed, 63 insertions, 83 deletions
diff --git a/lib/core/control_flow.nom b/lib/core/control_flow.nom
index c4c1770..2ad7ec7 100644
--- a/lib/core/control_flow.nom
+++ b/lib/core/control_flow.nom
@@ -327,7 +327,7 @@ test:
$code = (Lua "")
$clause = "if"
$else_allowed = (yes)
- unless ($body.type is "Block"):
+ unless ($body.type == "Block"):
at $body fail ("
Compile error: 'if' expected a Block, but got a \($body.type).
Hint: Perhaps you forgot to put a ':' after 'if'?
@@ -335,7 +335,7 @@ test:
for $line in $body:
unless
- (($line.type is "Action") and ((size of $line) >= 2)) and
+ (($line.type == "Action") and ((size of $line) >= 2)) and
$line.(size of $line) is "Block" syntax tree
..:
at $line fail ("
@@ -344,7 +344,7 @@ test:
..by a block, or "else" followed by a block.
")
$action = $line.(size of $line)
- if (($line.1 is "else") and ((size of $line) == 2)):
+ if (($line.1 == "else") and ((size of $line) == 2)):
unless $else_allowed:
at $line fail ("
Compile error: You can't have two 'else' blocks.
@@ -398,7 +398,7 @@ test:
$clause = "if"
$else_allowed = (yes)
define mangler
- unless ($body.type is "Block"):
+ unless ($body.type == "Block"):
at $body fail ("
Compile error: 'if' expected a Block, but got a \($body.type).
Hint: Perhaps you forgot to put a ':' after the 'is'?
@@ -406,7 +406,7 @@ test:
for $line in $body:
unless
- (($line.type is "Action") and ((size of $line) >= 2)) and
+ (($line.type == "Action") and ((size of $line) >= 2)) and
$line.(size of $line) is "Block" syntax tree
..:
at $line fail ("
@@ -414,7 +414,7 @@ test:
Hint: Each line should contain expressions followed by a block, or "else" followed by a block.
")
$action = $line.(size of $line)
- if (($line.1 is "else") and ((size of $line) == 2)):
+ if (($line.1 == "else") and ((size of $line) == 2)):
unless $else_allowed:
at $line fail ("
Compile error: You can't have two 'else' blocks.
@@ -470,7 +470,7 @@ test:
$t = [1, [2, [[3], 4], 5, [[[6]]]]]
$flat = []
for $ in recursive $t:
- if ((lua type of $) is "table"):
+ if ((lua type of $) == "table"):
for $2 in $:
recurse $ on $2
..else:
diff --git a/lib/core/metaprogramming.nom b/lib/core/metaprogramming.nom
index a17a33c..76ccf4a 100644
--- a/lib/core/metaprogramming.nom
+++ b/lib/core/metaprogramming.nom
@@ -68,10 +68,10 @@ test:
test:
lua> "do"
loc x
- unless ($x is 99):
+ unless ($x == 99):
fail "Compile to statements with locals failed."
lua> "end"
- unless ($x is (nil)):
+ unless ($x == (nil)):
fail "Failed to properly localize a variable."
(asdf) compiles to:
@@ -80,7 +80,7 @@ test:
test:
asdf
- unless ($tmp is (nil)):
+ unless ($tmp == (nil)):
fail "compile to is leaking variables"
lua> ("
@@ -136,7 +136,7 @@ test:
unless ((foo 10) == 11):
fail "Action didn't work."
- unless ($y is (nil)):
+ unless ($y == (nil)):
fail "Action leaked a local into globals."
(baz $) parses as (foo $)
@@ -402,10 +402,11 @@ test:
(quote $s) compiles to "tostring(\($s as lua expr)):as_lua()"
test:
assume (lua type of {}) == "table"
- assume (type of {}) == "Dict"
- assume ({} is a "Dict")
+ assume (type of {}) == "a Dict"
+ assume ({} is "a Dict")
assume ("" is text)
- assume ("" isn't a "Dict")
+ assume ("" is "Text")
+ assume ("" isn't "a Dict")
external:
($ is text) means (=lua "\(lua type of $) == 'string'")
@@ -418,12 +419,11 @@ external:
local mt = getmetatable(\$)
if mt and mt.__type then return mt.__type end
end
- return lua_type
+ return 'a '..lua_type
")
-[$ is a $type, $ is an $type] all parse as ((type of $) == $type)
-[$ isn't a $type, $ isn't an $type, $ is not a $type, $ is not an $type]
-..all parse as ((type of $) != $type)
+($ is $type) parses as ((type of $) == $type)
+[$ isn't $type, $ is not $type] all parse as ((type of $) != $type)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/lib/core/operators.nom b/lib/core/operators.nom
index b0f37f0..c2e6b57 100644
--- a/lib/core/operators.nom
+++ b/lib/core/operators.nom
@@ -14,7 +14,7 @@ test:
($x > $y) compiles to "(\($x as lua expr) > \($y as lua expr))"
($x <= $y) compiles to "(\($x as lua expr) <= \($y as lua expr))"
($x >= $y) compiles to "(\($x as lua expr) >= \($y as lua expr))"
-[$a is $b, $a == $b] all compile to "(\($a as lua expr) == \($b as lua expr))"
+($a == $b) compiles to "(\($a as lua expr) == \($b as lua expr))"
[$a isn't $b, $a is not $b, $a not= $b, $a != $b] all compile to
"(\($a as lua expr) ~= \($b as lua expr))"
diff --git a/lib/core/things.nom b/lib/core/things.nom
index c52eb5d..104c8d0 100644
--- a/lib/core/things.nom
+++ b/lib/core/things.nom
@@ -11,29 +11,30 @@ use "core/errors"
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
test:
- an (Empty) is a thing
- a (Buffer) is a thing:
- $its.is_a_buffer = (yes)
- ($its, set up) means:
- $its.bits or= []
- ($it, as text) means ($it.bits, joined)
- [($its, add $bit), ($its, append $bit)] all mean: $its.bits, add $bit
- assume (Buffer).is_a_buffer
+ (an Empty) is (a thing) with []
+ (a Buffer) is (a thing) with [$bits]:
+ $self.is_a_buffer = (yes)
+ ($self, set up) means:
+ $bits or= []
+ ($self, as text) means ($bits, joined)
+ [($self, add $bit), ($self, append $bit)] all mean: $bits, add $bit
+ assume $(a Buffer).is_a_buffer
$b = (a Buffer)
- assume (type of $b) == "Buffer"
+ assume (type of $b) == "a Buffer"
+ assume ($b is "a Buffer")
assume $b.is_a_buffer
assume "\$b" == ""
assume ($b, as text) == ""
- $b = (a Buffer with {.bits = ["x"]})
+ $b = (a Buffer {.bits = ["x"]})
$b,
add "y"
append "z"
assume "\$b" == "xyz"
- assume $b == (a Buffer with {.bits = ["x", "y", "z"]})
- assume $b != (a Buffer with {.bits = []})
- a (Comma Buffer) is a (Buffer):
- ($it, as text) means ($it.bits, joined with ",")
- ($its, number of commas) means ((#$its.bits) - 1)
+ assume $b == (a Buffer {.bits = ["x", "y", "z"]})
+ assume $b != (a Buffer {.bits = []})
+ (a Comma Buffer) is (a Buffer) with [$bits]:
+ ($self, as text) means ($bits, joined with ",")
+ ($self, number of commas) means ((#$bits) - 1)
$csv = (a Comma Buffer)
assume $csv.is_a_buffer
assume "\$csv" == ""
@@ -41,14 +42,13 @@ test:
$csv, add "y"
assume "\$csv" == "x,y"
assume ($csv, number of commas) == 1
- a (Vec) is a thing with {.x, .y}:
- ($its, + $other) means (Vec {.x = ($its.x + $other.x), .y = ($its.y + $other.y)})
-
- assume ((Vec {.x = 1, .y = 2}) + (Vec {.x = 10, .y = 10})) ==
- Vec {.x = 11, .y = 12}
-
- assume
- ((Vec {.x = 1, .y = 2}) + (Vec {.x = 10, .y = 10})) != (Vec {.x = 0, .y = 0})
+ (a Vec) is (a thing) with [$x, $y]:
+ ($self, + $other) means (Vec ($x + $other.x) ($y + $other.y))
+ ($self, length) means (sqrt ($x * $x + $y * $y))
+ (Vec $x $y) means (a Vec {.x = $x, .y = $y})
+ assume ((Vec 1 2) + (Vec 10 10)) == (Vec 11 12)
+ assume (((Vec 1 2) + (Vec 10 10)) != (Vec 0 0))
+ assume (Vec 3 4, length) == 5
$METAMETHOD_MAP = {
."as text" = "__tostring", ."clean up" = "__gc", ."+" = "__add", ."-" = "__sub"
@@ -61,30 +61,19 @@ $METAMETHOD_MAP = {
$($ as text like a dict) = ({}'s metatable).__tostring
external:
- [
- a $parent class named $classname with $members $(initialize $)
- an $parent class named $classname with $members $(initialize $)
- ] all mean:
+ ($parent class named $classname $(initialize $)) means:
$class = {.__type = $classname}
$class.__index = $class
$class.class = $class
$class.__tostring = ($ -> "\($.__type) \($ as text like a dict)")
$class.__eq = ({}'s metatable).__eq
$class.__len = ({}'s metatable).__len
- if $members:
- $class.__members = $members
- $class.__newindex =
- for ($its $key = $value):
- if $members.$key:
- rawset $its $key $value
- ..else:
- fail "Cannot set \$key, it's not one of the allowed member fields."
set $class's metatable to {
.__index = $parent, .__tostring = ($class -> $class.__type)
.__call =
for ($class with $initial_values):
- if ($initial_values == (nil)): return $class
+ $initial_values or= {}
set $initial_values's metatable to $class
if $initial_values.set_up:
$initial_values, set up
@@ -98,44 +87,35 @@ external:
$class.$metamethod = $class.($stub, as lua id)
return $class
-
- [
- a $classname is a $parent with $members $class_body
- an $classname is a $parent with $members $class_body
- a $classname is an $parent with $members $class_body
- an $classname is an $parent with $members $class_body
- ] all compile to:
+
+ $(a thing) = ((nil) class named "thing")
+
+ ($classname is $parent with $vars $class_body) compiles to:
+ unless ($vars.type == "List"):
+ at $vars fail ("
+ Compile error: This is not a list of variables.
+ ")
$class_id = ($classname.stub, as lua id)
+ if $class_body:
+ $class_body =
+ $class_body with vars {
+ : for $v in $vars:
+ add ($v as lua expr, text) =
+ SyntaxTree {.type = "IndexChain"} (SyntaxTree {.type = "Var"} "self")
+ SyntaxTree {.type = "Index"} (SyntaxTree {.type = "Text"} $v.1)
+ }
$lua =
Lua ("
- \$class_id = a_1_class_named_2_with(\($parent as lua), \(quote $classname.stub), \
- ..\($members as lua)\(
+ \$class_id = _1_class_named(\($parent as lua), \(quote $classname.stub)\(
(
Lua ("
, function(\$class_id)
- local it, its = \$class_id, \$class_id;
+ local self = \$class_id
\($class_body as lua)
end
")
) if $class_body else ""
))
- a_\$class_id = function(initial_values) return \$class_id(initial_values or {}) end
- an_\$class_id, a_\($class_id)_with, an_\($class_id)_with = a_\$class_id, a_\$class_id, a_\$class_id
")
- $lua, add free vars [$class_id, "a_\$class_id", "an_\$class_id"]
+ $lua, add free vars [$class_id]
return $lua
-
- [
- a $classname is a thing with $members $class_body
- an $classname is a thing with $members $class_body
- a $classname is an thing with $members $class_body
- an $classname is an thing with $members $class_body
- ] all parse as (a $classname is a (nil) with $members $class_body)
-
- [a $classname is a thing $class_body, an $classname is a thing $class_body]
- ..all parse as (a $classname is a (nil) with (nil) $class_body)
-
- [
- a $classname is a $parent $class_body, an $classname is a $parent $class_body
- a $classname is an $parent $class_body, an $classname is an $parent $class_body
- ] all parse as (a $classname is a $parent with (nil) $class_body)