code / nomsu

   1 #!/usr/bin/env nomsu -V7.0.0
   2 ###
   3     A library for simple object oriented programming.
   4     
   5 use "core/metaprogramming"
   6 use "core/operators"
   7 use "core/control_flow"
   8 use "core/collections"
   9 use "core/errors"
  10 
  11 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  12 
  13 test:
  14     (an Empty) is (a thing) with []
  15     (a Buffer) is (a thing) with [$bits]:
  16         $self.is_a_buffer = (yes)
  17         ($self, set up) means:
  18             $bits or= []
  19         ($self, as text) means ($bits, joined)
  20         [($self, add $bit), ($self, append $bit)] all mean: $bits, add $bit
  21     assume $(a Buffer).is_a_buffer
  22     $b = (a Buffer)
  23     assume (type of $b) == "a Buffer"
  24     assume ($b is "a Buffer")
  25     assume $b.is_a_buffer
  26     assume "\$b" == ""
  27     assume ($b, as text) == ""
  28     $b = (a Buffer {.bits = ["x"]})
  29     $b, 
  30         add "y"
  31         append "z"
  32     assume "\$b" == "xyz"
  33     assume $b == (a Buffer {.bits = ["x", "y", "z"]})
  34     assume $b != (a Buffer {.bits = []})
  35     (a Comma Buffer) is (a Buffer) with [$bits]:
  36         ($self, as text) means ($bits, joined with ",")
  37         ($self, number of commas) means (#$bits - 1)
  38     $csv = (a Comma Buffer)
  39     assume $csv.is_a_buffer
  40     assume ($csv is "a Comma Buffer")
  41     assume ($csv is "a Buffer")
  42     assume "\$csv" == ""
  43     $csv, add "x"
  44     $csv, add "y"
  45     assume "\$csv" == "x,y"
  46     assume ($csv, number of commas) == 1
  47     (a Vec) is (a thing) with [$x, $y]:
  48         ($self, +$other) means (Vec ($x + $other.x) ($y + $other.y))
  49         ($self, length) means (sqrt ($x * $x + $y * $y))
  50     (Vec $x $y) means (a Vec {.x = $x, .y = $y})
  51     assume ((Vec 1 2) + (Vec 10 10)) == (Vec 11 12)
  52     assume (((Vec 1 2) + (Vec 10 10)) != (Vec 0 0))
  53     assume (Vec 3 4, length) == 5
  54 
  55 $METAMETHOD_MAP = {
  56     ."as text" = "__tostring", ."clean up" = "__gc", ."+" = "__add", ."-" = "__sub"
  57     ."*" = "__mul", ."/" = "__div", .negative = "__unm", ."//" = "__idiv"
  58     .mod = "__mod", ."^" = "__pow", ."&" = "__band", ."|" = "__bor", ."~" = "__bxor"
  59     ."~" = "__bnot", ."<<" = "__bshl", .">>" = "__bshr", ."==" = "__eq"
  60     ."<" = "__lt", ."<=" = "__le", ."set 1 =" = "__newindex"
  61     ."fallback for" = "__index", .size = "__len", .iterate = "__ipairs"
  62     ."iterate all" = "__pairs"
  63 }
  64 
  65 $($ as text like a dict) = ({}'s metatable).__tostring
  66 external:
  67     ($parent class named $classname $(initialize $)) means:
  68         $class = {.__type = $classname}
  69         $class.__index = $class
  70         $class.class = $class
  71         $class.__tostring = ($ -> "\($.__type) \($ as text like a dict)")
  72         $class.__eq = ({}'s metatable).__eq
  73         $class.__len = ({}'s metatable).__len
  74         set $class's metatable to {
  75             .__index = $parent, .__tostring = ($class -> $class.__type)
  76             .__call =
  77                 for ($class with $initial_values):
  78                     $initial_values or= {}
  79                     set $initial_values's metatable to $class
  80                     if $initial_values.set_up:
  81                         $initial_values, set up
  82                     return $initial_values
  83         }
  84         
  85         if $(initialize $):
  86             initialize $class
  87             for ($stub = $metamethod) in $METAMETHOD_MAP:
  88                 if $class.($stub, as lua id):
  89                     $class.$metamethod = $class.($stub, as lua id)
  90         
  91         return $class
  92     $(a thing) = ((nil) class named "thing")
  93     ($classname is $parent with $vars $class_body) compiles to:
  94         unless ($vars.type == "List"):
  95             at $vars fail "Compile error: This is not a list of variables."
  96         $class_id = ($classname.stub, as lua id)
  97         $class_body and=
  98             $class_body, with
  99                 $t ->:
 100                     for $v in $vars:
 101                         if ($t == $v):
 102                             return
 103                                 "IndexChain" tree with ("Var" tree with "self")
 104                                     "Index" tree with ("Text" tree with $v.1)
 105         
 106         if ($parent.type == "Action"):
 107             $parent = ("Var" tree with $parent)
 108         
 109         $lua =
 110             Lua ("
 111                 \$class_id = _1_class_named(\($parent as lua id), \(quote $classname.stub)\(
 112                     (
 113                         Lua ("
 114                             , function(\$class_id)
 115                                 local self = \$class_id
 116                                 \($class_body as lua)
 117                             end
 118                         ")
 119                     ) if $class_body else ""
 120                 ))
 121             ")
 122         
 123         $lua, add free vars [$class_id]
 124         return $lua