perl6/core.pm

   1 unit module core;
   2 use types;
   3 use printer;
   4 use reader;
   5
   6 sub equal ($a, $b) {
   7   if $a ~~ MalSequence && $b ~~ MalSequence {
   8     return $FALSE if $a.elems != $b.elems;
   9     for |$a Z |$b -> ($a_el, $b_el) {
  10       return $FALSE if equal($a_el, $b_el) ~~ $FALSE;
  11     }
  12     return $TRUE;
  13   }
  14   elsif $a ~~ MalHashMap && $b ~~ MalHashMap {
  15     return $FALSE if $a.elems != $b.elems;
  16     for $a.pairs {
  17       return $FALSE if !$b{.key} || equal(.value, $b{.key}) ~~ $FALSE;
  18     }
  19     return $TRUE;
  20   }
  21   else {
  22     return $a.^name eq $b.^name && $a.val ~~ $b.val ?? $TRUE !! $FALSE;
  23   }
  24 }
  25
  26 sub perl6-eval ($code) {
  27   my &convert = -> $data {
  28     given $data {
  29       when Array|List { MalList($_.map({&convert($_)}).Array) }
  30       when Hash { MalHashMap($_.map({.key => &convert(.value)}).Hash) }
  31       when Bool { $_ ?? $TRUE !! $FALSE }
  32       when Int { MalNumber($_) }
  33       when Nil { $NIL }
  34       default { $_.^name eq 'Any' ?? $NIL !! MalString($_.gist) }
  35     }
  36   };
  37
  38   use MONKEY-SEE-NO-EVAL;
  39   return &convert(EVAL($code));
  40 }
  41
  42 our %ns = (
  43   '+'         => MalCode({ MalNumber($^a.val + $^b.val) }),
  44   '-'         => MalCode({ MalNumber($^a.val - $^b.val) }),
  45   '*'         => MalCode({ MalNumber($^a.val * $^b.val) }),
  46   '/'         => MalCode({ MalNumber(($^a.val / $^b.val).Int) }),
  47   '<'         => MalCode({ $^a.val < $^b.val ?? $TRUE !! $FALSE }),
  48   '<='        => MalCode({ $^a.val <= $^b.val ?? $TRUE !! $FALSE }),
  49   '>'         => MalCode({ $^a.val > $^b.val ?? $TRUE !! $FALSE }),
  50   '>='        => MalCode({ $^a.val >= $^b.val ?? $TRUE !! $FALSE }),
  51   '='         => MalCode({ equal($^a, $^b) }),
  52   prn         => MalCode({ say @_.map({ pr_str($_, True) }).join(' '); $NIL }),
  53   println     => MalCode({ say @_.map({ pr_str($_) }).join(' '); $NIL }),
  54   pr-str      => MalCode({ MalString(@_.map({ pr_str($_, True) }).join(' ') ) }),
  55   str         => MalCode({ MalString(@_.map({ pr_str($_) }).join) }),
  56   read-string => MalCode({ read_str($^a.val) }),
  57   slurp       => MalCode({ MalString($^a.val.IO.slurp) }),
  58   list        => MalCode({ MalList(@_) }),
  59   'list?'     => MalCode({ $^a ~~ MalList ?? $TRUE !! $FALSE }),
  60   'empty?'    => MalCode({ $^a.elems ?? $FALSE !! $TRUE }),
  61   count       => MalCode({ MalNumber($^a ~~ $NIL ?? 0 !! $^a.elems) }),
  62   atom        => MalCode({ MalAtom($^a) }),
  63   'atom?'     => MalCode({ $^a ~~ MalAtom ?? $TRUE !! $FALSE }),
  64   deref       => MalCode({ $^a.val }),
  65   'reset!'    => MalCode({ $^a.val = $^b }),
  66   'swap!'     => MalCode(-> $atom, $func, *@args { $atom.val = $func.apply($atom.val, |@args) }),
  67   cons        => MalCode({ MalList([$^a, |$^b.val]) }),
  68   concat      => MalCode({ MalList([@_.map({|$_.val})]) }),
  69   nth         => MalCode({ $^a[$^b.val] // die X::MalOutOfRange.new }),
  70   first       => MalCode({ $^a[0] // $NIL }),
  71   rest        => MalCode({ MalList([$^a[1..*]]) }),
  72   throw       => MalCode({ die X::MalThrow.new(value => $^a) }),
  73   apply       => MalCode(-> $func, *@args { $func.apply(|@args[0..*-2], |@args[*-1].val) }),
  74   map         => MalCode(-> $func, $list { MalList([$list.map({ $func.apply($_) })]) }),
  75   'nil?'      => MalCode({ $^a ~~ MalNil ?? $TRUE !! $FALSE }),
  76   'true?'     => MalCode({ $^a ~~ MalTrue ?? $TRUE !! $FALSE }),
  77   'false?'    => MalCode({ $^a ~~ MalFalse ?? $TRUE !! $FALSE }),
  78   'symbol?'   => MalCode({ $^a ~~ MalSymbol ?? $TRUE !! $FALSE }),
  79   symbol      => MalCode({ MalSymbol($^a.val) }),
  80   keyword     => MalCode({ $^a.val ~~ /^\x29E/ ?? $^a !! MalString("\x29E" ~ $^a.val) }),
  81   'keyword?'  => MalCode({ $^a.val ~~ /^\x29E/ ?? $TRUE !! $FALSE }),
  82   'number?'   => MalCode({ $^a ~~ MalNumber ?? $TRUE !! $FALSE }),
  83   'fn?'       => MalCode({ ($^a ~~ MalCallable && !$^a.?is_macro) ?? $TRUE !! $FALSE }),
  84   'macro?'    => MalCode({ $^a.?is_macro ?? $TRUE !! $FALSE }),
  85   vector      => MalCode({ MalVector(@_) }),
  86   'vector?'   => MalCode({ $^a ~~ MalVector ?? $TRUE !! $FALSE }),
  87   hash-map    => MalCode({ MalHashMap(@_.map({ $^a.val => $^b }).Hash) }),
  88   'map?'      => MalCode({ $^a ~~ MalHashMap ?? $TRUE !! $FALSE }),
  89   assoc       => MalCode(-> $map, *@kv { MalHashMap(Hash.new(|$map.kv, |@kv.map({$^a.val, $^b}))) }),
  90   dissoc      => MalCode(-> $map, *@keys { my %h = $map.val.clone; %h{@keys.map(*.val)}:delete; MalHashMap(%h) }),
  91   get         => MalCode({ $^a.val{$^b.val} // $NIL }),
  92   'contains?' => MalCode({ $^a.val{$^b.val}:exists ?? $TRUE !! $FALSE }),
  93   keys        => MalCode({ MalList([$^a.keys.map({ MalString($_) })]) }),
  94   vals        => MalCode({ MalList([$^a.values]) }),
  95   'sequential?' => MalCode({ $^a ~~ MalList|MalVector ?? $TRUE !! $FALSE }),
  96   readline    => MalCode({ with prompt($^a.val) { MalString($_) } else { $NIL } }),
  97   time-ms     => MalCode({ MalNumber((now * 1000).Int) }),
  98   conj        => MalCode(-> $seq, *@args { $seq.conj(@args) }),
  99   'string?'   => MalCode({ $^a ~~ MalString && $^a.val !~~ /^\x29E/ ?? $TRUE !! $FALSE }),
 100   seq         => MalCode({ $^a.seq }),
 101   with-meta   => MalCode({ return $NIL if !$^a.can('meta'); my $x = $^a.clone; $x.meta = $^b; $x }),
 102   meta        => MalCode({ $^a.?meta // $NIL }),
 103   perl6-eval  => MalCode({ perl6-eval($^a.val) }),
 104 );