From 71f3532e04e5c76327363a3fd36b506f54e5043d Mon Sep 17 00:00:00 2001
From: Přemysl Janouch
Date: Sat, 21 Nov 2015 22:47:52 +0100
Subject: degesch: add the first Lua plugin to distribution
This required separate plugin directories for both pluginized executables.
---
CMakeLists.txt | 11 +-
config.h.in | 2 +-
plugins/coin | 128 ---
plugins/degesch/ping-timeout.lua | 33 +
plugins/eval | 312 -----
plugins/pomodoro | 502 ---------
plugins/script | 2310 --------------------------------------
plugins/youtube | 111 --
plugins/zyklonb/coin | 128 +++
plugins/zyklonb/eval | 312 +++++
plugins/zyklonb/pomodoro | 502 +++++++++
plugins/zyklonb/script | 2310 ++++++++++++++++++++++++++++++++++++++
plugins/zyklonb/youtube | 111 ++
zyklonb.c | 1 +
14 files changed, 3404 insertions(+), 3369 deletions(-)
delete mode 100755 plugins/coin
create mode 100644 plugins/degesch/ping-timeout.lua
delete mode 100755 plugins/eval
delete mode 100755 plugins/pomodoro
delete mode 100755 plugins/script
delete mode 100755 plugins/youtube
create mode 100755 plugins/zyklonb/coin
create mode 100755 plugins/zyklonb/eval
create mode 100755 plugins/zyklonb/pomodoro
create mode 100755 plugins/zyklonb/script
create mode 100755 plugins/zyklonb/youtube
diff --git a/CMakeLists.txt b/CMakeLists.txt
index 64bb667..2e8a2f8 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -94,7 +94,8 @@ set (HAVE_EDITLINE "${WANT_LIBEDIT}")
set (HAVE_LUA "${WITH_LUA}")
include (GNUInstallDirs)
-set (plugin_dir ${CMAKE_INSTALL_LIBDIR}/${PROJECT_NAME})
+# ZyklonB is currently an odd duck but degesch follows normal XDG rules
+set (zyklonb_plugin_dir ${CMAKE_INSTALL_LIBDIR}/zyklonb/plugins)
configure_file (${PROJECT_SOURCE_DIR}/config.h.in ${PROJECT_BINARY_DIR}/config.h)
include_directories (${PROJECT_SOURCE_DIR} ${PROJECT_BINARY_DIR})
@@ -138,10 +139,10 @@ add_custom_target (clang-tidy
# Installation
install (TARGETS zyklonb degesch kike DESTINATION ${CMAKE_INSTALL_BINDIR})
install (FILES LICENSE DESTINATION ${CMAKE_INSTALL_DOCDIR})
-
-foreach (plugin coin eval script youtube ${plugins})
- install (FILES plugins/${plugin} DESTINATION ${plugin_dir})
-endforeach (plugin)
+install (DIRECTORY plugins/zyklonb/
+ DESTINATION ${zyklonb_plugin_dir} USE_SOURCE_PERMISSIONS)
+install (DIRECTORY plugins/degesch/
+ DESTINATION ${CMAKE_INSTALL_DATADIR}/degesch/plugins)
# Generate documentation from program help
find_program (HELP2MAN_EXECUTABLE help2man)
diff --git a/config.h.in b/config.h.in
index 833f874..0ad9559 100644
--- a/config.h.in
+++ b/config.h.in
@@ -2,7 +2,7 @@
#define CONFIG_H
#define PROGRAM_VERSION "${project_VERSION}"
-#define PLUGIN_DIR "${CMAKE_INSTALL_PREFIX}/${plugin_dir}"
+#define ZYKLONB_PLUGIN_DIR "${CMAKE_INSTALL_PREFIX}/${zyklonb_plugin_dir}"
#cmakedefine HAVE_READLINE
#cmakedefine HAVE_EDITLINE
diff --git a/plugins/coin b/plugins/coin
deleted file mode 100755
index 65967ad..0000000
--- a/plugins/coin
+++ /dev/null
@@ -1,128 +0,0 @@
-#!/usr/bin/env tclsh
-#
-# ZyklonB coin plugin, random number-based utilities
-#
-# Copyright 2012, 2014 Přemysl Janouch
-# See the file LICENSE for licensing information.
-#
-
-# This is a terrible excuse for a programming language and I feel dirty.
-
-proc parse {line} {
- global msg
- unset -nocomplain msg
-
- if [regexp {^:([^ ]*) *(.*)} $line -> prefix rest] {
- set msg(prefix) $prefix
- set line $rest
- }
- if [regexp {^([^ ]*) *(.*)} $line -> command rest] {
- set msg(command) $command
- set line $rest
- }
- while {1} {
- set line [string trimleft $line " "]
- set i [string first " " $line]
- if {$i == -1} { set i [string length $line] }
- if {$i == 0} { break }
-
- if {[string index $line 0] == ":"} {
- lappend msg(param) [string range $line 1 end]
- break
- }
- lappend msg(param) [string range $line 0 [expr $i - 1]]
- set line [string range $line $i end]
- }
-}
-
-proc get_config {key} {
- global msg
- puts "ZYKLONB get_config :$key"
- gets stdin line
- parse $line
- return [lindex $msg(param) 0]
-}
-
-proc pmrespond {text} {
- global ctx
- global ctx_quote
- puts "PRIVMSG $ctx :$ctx_quote$text"
-}
-
-fconfigure stdin -translation crlf -encoding iso8859-1
-fconfigure stdout -translation crlf -encoding iso8859-1
-
-set prefix [get_config prefix]
-puts "ZYKLONB register"
-
-set eightball [list \
- "It is certain" \
- "It is decidedly so" \
- "Without a doubt" \
- "Yes - definitely" \
- "You may rely on it" \
- "As I see it, yes" \
- "Most likely" \
- "Outlook good" \
- "Yes" \
- "Signs point to yes" \
- "Reply hazy, try again" \
- "Ask again later" \
- "Better not tell you now" \
- "Cannot predict now" \
- "Concentrate and ask again" \
- "Don't count on it" \
- "My reply is no" \
- "My sources say no" \
- "Outlook not so good" \
- "Very doubtful"]
-
-while {[gets stdin line] != -1} {
- parse $line
-
- if {! [info exists msg(prefix)] || ! [info exists msg(command)]
- || $msg(command) != "PRIVMSG" || ! [info exists msg(param)]
- || [llength $msg(param)] < 2} { continue }
-
- regexp {^[^!]*} $msg(prefix) ctx
- if [regexp {^[#&+!]} [lindex $msg(param) 0]] {
- set ctx_quote "$ctx: "
- set ctx [lindex $msg(param) 0]
- } else { set ctx_quote "" }
-
- set input [lindex $msg(param) 1]
- set first_chars [string range $input 0 \
- [expr [string length $prefix] - 1]]
- if {$first_chars != $prefix} { continue }
- set input [string range $input [string length $prefix] end]
-
- if {$input == "coin"} {
- if {rand() < 0.5} {
- pmrespond "Heads."
- } else {
- pmrespond "Tails."
- }
- } elseif {[regexp {^dice( +|$)(.*)} $input -> _ args]} {
- if {! [string is integer -strict $args] || $args <= 0} {
- pmrespond "Invalid or missing number."
- } else {
- pmrespond [expr {int($args * rand()) + 1}]
- }
- } elseif {[regexp {^(choose|\?)( +|$)(.*)} $input -> _ _ args]} {
- if {$args == ""} {
- pmrespond "Nothing to choose from."
- } else {
- set c [split $args ",|"]
- pmrespond [string trim [lindex $c \
- [expr {int([llength $c] * rand())}]]]
- }
- } elseif {[regexp {^eightball( +|$)(.*)} $input -> _ args]} {
- if {$args == ""} {
- pmrespond "You should, you know, ask something."
- } else {
- pmrespond [lindex $eightball \
- [expr {int([llength $eightball] * rand())}]].
- }
- }
-}
-
diff --git a/plugins/degesch/ping-timeout.lua b/plugins/degesch/ping-timeout.lua
new file mode 100644
index 0000000..72a754f
--- /dev/null
+++ b/plugins/degesch/ping-timeout.lua
@@ -0,0 +1,33 @@
+--
+-- ping-timeout.lua: ping timeout readability enhancement plugin
+--
+-- Copyright (c) 2015, Přemysl Janouch
+--
+-- Permission to use, copy, modify, and/or distribute this software for any
+-- purpose with or without fee is hereby granted, provided that the above
+-- copyright notice and this permission notice appear in all copies.
+--
+-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+-- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
+-- OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+-- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+--
+
+degesch.hook_irc (function (hook, server, line)
+ local start, timeout =
+ line:match ("^(:[^ ]* QUIT :Ping timeout:) (%d+) seconds$")
+ if not start then
+ return line
+ end
+
+ local minutes = timeout // 60
+ if minutes == 0 then
+ return line
+ end
+
+ local seconds = timeout % 60
+ return string.format ("%s %d minutes, %d seconds", start, minutes, seconds)
+end)
diff --git a/plugins/eval b/plugins/eval
deleted file mode 100755
index 982d78b..0000000
--- a/plugins/eval
+++ /dev/null
@@ -1,312 +0,0 @@
-#!/usr/bin/awk -f
-#
-# ZyklonB eval plugin, LISP-like expression evaluator
-#
-# Copyright 2013, 2014 Přemysl Janouch
-# See the file LICENSE for licensing information.
-#
-
-BEGIN \
-{
- RS = "\r"
- ORS = "\r\n"
- IGNORECASE = 1
- srand()
-
- prefix = get_config("prefix")
-
- print "ZYKLONB register"
- fflush("")
-
- # All functions have to be in this particular array
- min_args["int"] = 1
- min_args["+"] = 1
- min_args["-"] = 1
- min_args["*"] = 1
- min_args["/"] = 1
- min_args["%"] = 1
- min_args["^"] = 1
- min_args["**"] = 1
- min_args["exp"] = 1
- min_args["sin"] = 1
- min_args["cos"] = 1
- min_args["atan2"] = 2
- min_args["log"] = 1
- min_args["rand"] = 0
- min_args["sqrt"] = 1
-
- min_args["pi"] = 0
- min_args["e"] = 0
-
- min_args["min"] = 1
- min_args["max"] = 1
-
- # Whereas here their presence is only optional
- max_args["int"] = 1
- max_args["sin"] = 1
- max_args["cos"] = 1
- max_args["atan2"] = 2
- max_args["log"] = 1
- max_args["rand"] = 0
- max_args["sqrt"] = 1
-
- max_args["pi"] = 0
- max_args["e"] = 0
-}
-
-{
- parse($0)
-}
-
-msg_command == "PRIVMSG" \
-{
- # Context = either channel or user nickname
- match(msg_prefix, /^[^!]+/)
- ctx = substr(msg_prefix, RSTART, RLENGTH)
- if (msg_param[0] ~ /^[#&!+]/)
- {
- ctx_quote = ctx ": "
- ctx = msg_param[0]
- }
- else
- ctx_quote = ""
-
-
- if (substr(msg_param[1], 1, length(prefix)) == prefix)
- {
- keyword = "eval"
- text = substr(msg_param[1], 1 + length(prefix))
- if (match(text, "^" keyword "([^A-Za-z0-9].*|$)"))
- process_request(substr(text, 1 + length(keyword)))
- }
-}
-
-{
- fflush("")
-}
-
-function pmrespond (text)
-{
- print "PRIVMSG " ctx " :" ctx_quote text
-}
-
-function process_request (input, res, x)
-{
- delete funs
- delete accumulator
- delete n_args
-
- res = ""
- fun_top = 0
- funs[0] = ""
- accumulator[0] = 0
- n_args[0] = 0
-
- if (match(input, "^[ \t]*"))
- input = substr(input, RLENGTH + 1)
- if (input == "")
- res = "expression missing"
-
- while (res == "" && input != "") {
- if (match(input, "^-?[0-9]+\\.?[0-9]*")) {
- x = substr(input, RSTART, RLENGTH)
- input = substr(input, RLENGTH + 1)
-
- match(input, "^ *")
- input = substr(input, RLENGTH + 1)
-
- res = process_argument(x)
- } else if (match(input, "^[(]([^ ()]+)")) {
- x = substr(input, RSTART + 1, RLENGTH - 1)
- input = substr(input, RLENGTH + 1)
-
- match(input, "^ *")
- input = substr(input, RLENGTH + 1)
-
- if (!(x in min_args)) {
- res = "undefined function '" x "'"
- } else {
- fun_top++
- funs[fun_top] = x
- accumulator[fun_top] = 636363
- n_args[fun_top] = 0
- }
- } else if (match(input, "^[)] *")) {
- input = substr(input, RLENGTH + 1)
- res = process_end()
- } else
- res = "invalid input at '" substr(input, 1, 10) "...'"
- }
-
- if (res == "") {
- if (fun_top != 0)
- res = "unclosed '" funs[fun_top] "'"
- else if (n_args[0] != 1)
- res = "internal error, expected one result" \
- ", got " n_args[0] " instead"
- }
-
- if (res == "")
- pmrespond(accumulator[0])
- else
- pmrespond(res)
-}
-
-function process_argument (arg)
-{
- if (fun_top == 0) {
- if (n_args[0]++ != 0)
- return "too many results, I only expect one"
-
- accumulator[0] = arg
- return ""
- }
-
- fun = funs[fun_top]
- if (fun in max_args && max_args[fun] <= n_args[fun_top])
- return "too many operands for " fun
-
- if (fun == "int") {
- accumulator[fun_top] = int(arg)
- } else if (fun == "+") {
- if (n_args[fun_top] == 0)
- accumulator[fun_top] = arg
- else
- accumulator[fun_top] += arg
- } else if (fun == "-") {
- if (n_args[fun_top] == 0)
- accumulator[fun_top] = arg
- else
- accumulator[fun_top] -= arg
- } else if (fun == "*") {
- if (n_args[fun_top] == 0)
- accumulator[fun_top] = arg
- else
- accumulator[fun_top] *= arg
- } else if (fun == "/") {
- if (n_args[fun_top] == 0)
- accumulator[fun_top] = arg
- else if (arg == 0)
- return "division by zero"
- else
- accumulator[fun_top] /= arg
- } else if (fun == "%") {
- if (n_args[fun_top] == 0)
- accumulator[fun_top] = arg
- else if (arg == 0)
- return "division by zero"
- else
- accumulator[fun_top] %= arg
- } else if (fun == "^" || fun == "**" || fun == "exp") {
- if (n_args[fun_top] == 0)
- accumulator[fun_top] = arg
- else
- accumulator[fun_top] ^= arg
- } else if (fun == "sin") {
- accumulator[fun_top] = sin(arg)
- } else if (fun == "cos") {
- accumulator[fun_top] = cos(arg)
- } else if (fun == "atan2") {
- if (n_args[fun_top] == 0)
- accumulator[fun_top] = arg
- else
- accumulator[fun_top] = atan2(accumulator[fun_top], arg)
- } else if (fun == "log") {
- accumulator[fun_top] = log(arg)
- } else if (fun == "rand") {
- # Just for completeness, execution never gets here
- } else if (fun == "sqrt") {
- accumulator[fun_top] = sqrt(arg)
- } else if (fun == "min") {
- if (n_args[fun_top] == 0)
- accumulator[fun_top] = arg
- else if (accumulator[fun_top] > arg)
- accumulator[fun_top] = arg
- } else if (fun == "max") {
- if (n_args[fun_top] == 0)
- accumulator[fun_top] = arg
- else if (accumulator[fun_top] < arg)
- accumulator[fun_top] = arg
- } else
- return "internal error, unhandled operands for " fun
-
- n_args[fun_top]++
- return ""
-}
-
-function process_end ()
-{
- if (fun_top <= 0)
- return "extraneous ')'"
-
- fun = funs[fun_top]
- if (!(fun in min_args))
- return "internal error, unhandled ')' for '" fun "'"
- if (min_args[fun] > n_args[fun_top])
- return "not enough operands for '" fun "'"
-
- # There's no 'init' function to do it in
- if (fun == "rand")
- accumulator[fun_top] = rand()
- else if (fun == "pi")
- accumulator[fun_top] = 3.141592653589793
- else if (fun == "e")
- accumulator[fun_top] = 2.718281828459045
-
- return process_argument(accumulator[fun_top--])
-}
-
-function get_config (key)
-{
- print "ZYKLONB get_config :" key
- fflush("")
-
- getline
- parse($0)
- return msg_param[0]
-}
-
-function parse (line, s, n, id, token)
-{
- s = 1
- id = 0
-
- # NAWK only uses the first character of RS
- if (line ~ /^\n/)
- line = substr(line, 2)
-
- msg_prefix = ""
- msg_command = ""
- delete msg_param
-
- n = match(substr(line, s), / |$/)
- while (n)
- {
- token = substr(line, s, n - 1)
- if (token ~ /^:/)
- {
- if (s == 1)
- msg_prefix = substr(token, 2)
- else
- {
- msg_param[id] = substr(line, s + 1)
- break
- }
- }
- else if (!msg_command)
- msg_command = toupper(token)
- else
- msg_param[id++] = token
-
- s = s + n
- n = index(substr(line, s), " ")
-
- if (!n)
- {
- n = length(substr(line, s)) + 1
- if (n == 1)
- break;
- }
- }
-}
-
diff --git a/plugins/pomodoro b/plugins/pomodoro
deleted file mode 100755
index 8f30327..0000000
--- a/plugins/pomodoro
+++ /dev/null
@@ -1,502 +0,0 @@
-#!/usr/bin/env ruby
-# coding: utf-8
-#
-# ZyklonB pomodoro plugin
-#
-# Copyright 2015 Přemysl Janouch
-# See the file LICENSE for licensing information.
-#
-
-# --- Simple event loop --------------------------------------------------------
-
-# This is more or less a straight-forward port of my C event loop. It's a bit
-# unfortunate that I really have to implement all this in order to get some
-# basic asynchronicity but at least I get to exercise my Ruby.
-
-class TimerEvent
- attr_accessor :index, :when, :callback
-
- def initialize (callback)
- raise ArgumentError unless callback.is_a? Proc
-
- @index = nil
- @when = nil
- @callback = callback
- end
-
- def active?
- @index != nil
- end
-
- def until
- return @when - Time.new
- end
-end
-
-class IOEvent
- READ = 1 << 0
- WRITE = 1 << 1
-
- attr_accessor :read_index, :write_index, :io, :callback
-
- def initialize (io, callback)
- raise ArgumentError unless callback.is_a? Proc
-
- @read_index = nil
- @write_index = nil
- @io = io
- @callback = callback
- end
-end
-
-class EventLoop
- def initialize
- @running = false
- @timers = []
- @readers = []
- @writers = []
- @io_to_event = {}
- end
-
- def set_timer (timer, timeout)
- raise ArgumentError unless timer.is_a? TimerEvent
-
- timer.when = Time.now + timeout
- if timer.index
- heapify_down timer.index
- heapify_up timer.index
- else
- timer.index = @timers.size
- @timers.push timer
- heapify_up timer.index
- end
- end
-
- def reset_timer (timer)
- raise ArgumentError unless timer.is_a? TimerEvent
- remove_timer_at timer.index if timer.index
- end
-
- def set_io (io_event, events)
- raise ArgumentError unless io_event.is_a? IOEvent
- raise ArgumentError unless events.is_a? Numeric
-
- reset_io io_event
-
- @io_to_event[io_event.io] = io_event
- if events & IOEvent::READ
- io_event.read_index = @readers.size
- @readers.push io_event.io
- end
- if events & IOEvent::WRITE
- io_event.read_index = @writers.size
- @writers.push io_event.io
- end
- end
-
- def reset_io (io_event)
- raise ArgumentError unless io_event.is_a? IOEvent
-
- @readers.delete_at io_event.read_index if io_event.read_index
- @writers.delete_at io_event.write_index if io_event.write_index
-
- io_event.read_index = nil
- io_event.write_index = nil
-
- @io_to_event.delete io_event.io
- end
-
- def run
- @running = true
- while @running do one_iteration end
- end
-
- def quit
- @running = false
- end
-
-private
- def one_iteration
- rs, ws, = IO.select @readers, @writers, [], nearest_timeout
- dispatch_timers
- (Array(rs) | Array(ws)).each do |io|
- @io_to_event[io].callback.call io
- end
- end
-
- def dispatch_timers
- now = Time.new
- while not @timers.empty? and @timers[0].when <= now do
- @timers[0].callback.call
- remove_timer_at 0
- end
- end
-
- def nearest_timeout
- return nil if @timers.empty?
- timeout = @timers[0].until
- if timeout < 0 then 0 else timeout end
- end
-
- def remove_timer_at (index)
- @timers[index].index = nil
- moved = @timers.pop
- return if index == @timers.size
-
- @timers[index] = moved
- @timers[index].index = index
- heapify_down index
- end
-
- def swap_timers (a, b)
- @timers[a], @timers[b] = @timers[b], @timers[a]
- @timers[a].index = a
- @timers[b].index = b
- end
-
- def heapify_up (index)
- while index != 0 do
- parent = (index - 1) / 2
- break if @timers[parent].when <= @timers[index].when
- swap_timers index, parent
- index = parent
- end
- end
-
- def heapify_down (index)
- loop do
- parent = index
- left = 2 * index + 1
- right = 2 * index + 2
-
- lowest = parent
- lowest = left if left < @timers.size and
- @timers[left] .when < @timers[lowest].when
- lowest = right if right < @timers.size and
- @timers[right].when < @timers[lowest].when
- break if parent == lowest
-
- swap_timers lowest, parent
- index = lowest
- end
- end
-end
-
-# --- IRC protocol -------------------------------------------------------------
-
-$stdin.set_encoding 'ASCII-8BIT'
-$stdout.set_encoding 'ASCII-8BIT'
-
-$stdin.sync = true
-$stdout.sync = true
-
-$/ = "\r\n"
-$\ = "\r\n"
-
-RE_MSG = /(?::([^! ]*)(?:!([^@]*)@([^ ]*))? +)?([^ ]+)(?: +(.*))?$/
-RE_ARGS = /:?((?<=:).*|[^ ]+) */
-
-def parse (line)
- m = line.match RE_MSG
- return nil if not m
-
- nick, user, host, command, args = *m.captures
- args = if args then args.scan(RE_ARGS).flatten else [] end
- [nick, user, host, command, args]
-end
-
-def bot_print (what)
- print "ZYKLONB print :#{what}"
-end
-
-# --- Initialization -----------------------------------------------------------
-
-# We can only read in configuration from here so far
-# To read it from anywhere else, it has to be done asynchronously
-$config = {}
-[:prefix].each do |name|
- print "ZYKLONB get_config :#{name}"
- _, _, _, _, args = *parse($stdin.gets.chomp)
- $config[name] = args[0]
-end
-
-print "ZYKLONB register"
-
-# --- Plugin logic -------------------------------------------------------------
-
-# FIXME: this needs a major refactor as it doesn't make much sense at all
-
-class MessageMeta < Struct.new(:nick, :user, :host, :channel, :ctx, :quote)
- def respond (message)
- print "PRIVMSG #{ctx} :#{quote}#{message}"
- end
-end
-
-class Context
- attr_accessor :nick, :ctx
-
- def initialize (meta)
- @nick = meta.nick
- @ctx = meta.ctx
- end
-
- def == (other)
- self.class == other.class \
- and other.nick == @nick \
- and other.ctx == @ctx
- end
-
- alias eql? ==
-
- def hash
- @nick.hash ^ @ctx.hash
- end
-end
-
-class PomodoroTimer
- def initialize (context)
- @ctx = context.ctx
- @nicks = [context.nick]
-
- @timer_work = TimerEvent.new(lambda { on_work })
- @timer_rest = TimerEvent.new(lambda { on_rest })
-
- on_work
- end
-
- def inform (message)
- # FIXME: it tells the nick even in PM's
- quote = "#{@nicks.join(" ")}: "
- print "PRIVMSG #{@ctx} :#{quote}#{message}"
- end
-
- def on_work
- inform "work now!"
- $loop.set_timer @timer_rest, 25 * 60
- end
-
- def on_rest
- inform "rest now!"
- $loop.set_timer @timer_work, 5 * 60
- end
-
- def join (meta)
- return if @nicks.include? meta.nick
-
- meta.respond "you have joined their pomodoro"
- @nicks |= [meta.nick]
- end
-
- def part (meta, requested)
- return if not @nicks.include? meta.nick
-
- if requested
- meta.respond "you have stopped your pomodoro"
- end
-
- @nicks -= [meta.nick]
- if @nicks.empty?
- $loop.reset_timer @timer_work
- $loop.reset_timer @timer_rest
- end
- end
-
- def status (meta)
- return if not @nicks.include? meta.nick
-
- if @timer_rest.active?
- till = @timer_rest.until
- meta.respond "working, #{(till / 60).to_i} minutes, " +
- "#{(till % 60).to_i} seconds until rest"
- end
- if @timer_work.active?
- till = @timer_work.until
- meta.respond "resting, #{(till / 60).to_i} minutes, " +
- "#{(till % 60).to_i} seconds until work"
- end
- end
-end
-
-class Pomodoro
- KEYWORD = "pomodoro"
-
- def initialize
- @timers = {}
- end
-
- def on_help (meta, args)
- meta.respond "usage: #{KEYWORD} { start | stop | join | status }"
- end
-
- def on_start (meta, args)
- if args.size != 0
- meta.respond "usage: #{KEYWORD} start"
- return
- end
-
- context = Context.new meta
- if @timers[context]
- meta.respond "you already have a timer running here"
- else
- @timers[context] = PomodoroTimer.new meta
- end
- end
-
- def on_join (meta, args)
- if args.size != 1
- meta.respond "usage: #{KEYWORD} join "
- return
- end
-
- context = Context.new meta
- if @timers[context]
- meta.respond "you already have a timer running here"
- return
- end
-
- joined_context = Context.new meta
- joined_context.nick = args.shift
- timer = @timers[joined_context]
- if not timer
- meta.respond "that person doesn't have a timer here"
- else
- timer.join meta
- @timers[context] = timer
- end
- end
-
- def on_stop (meta, args)
- if args.size != 0
- meta.respond "usage: #{KEYWORD} stop"
- return
- end
-
- context = Context.new meta
- timer = @timers[context]
- if not timer
- meta.respond "you don't have a timer running here"
- else
- timer.part meta, true
- @timers.delete context
- end
- end
-
- def on_status (meta, args)
- if args.size != 0
- meta.respond "usage: #{KEYWORD} status"
- return
- end
-
- timer = @timers[Context.new meta]
- if not timer
- meta.respond "you don't have a timer running here"
- else
- timer.status meta
- end
- end
-
- def process_command (meta, msg)
- args = msg.split
- return if args.shift != KEYWORD
-
- method = "on_#{args.shift}"
- send method, meta, args if respond_to? method
- end
-
- def on_server_nick (meta, command, args)
- # TODO: either handle this properly...
- happened = false
- @timers.keys.each do |key|
- next if key.nick != meta.nick
- @timers[key].part meta, false
- @timers.delete key
- happened = true
- end
- if happened
- # TODO: ...or at least inform the user via his new nick
- end
- end
-
- def on_server_part (meta, command, args)
- # TODO: instead of cancelling the user's pomodoros, either redirect
- # them to PM's and later upon rejoining undo the redirection...
- context = Context.new(meta)
- context.ctx = meta.channel
- if @timers.include? context
- # TODO: ...or at least inform the user about the cancellation
- @timers[context].part meta, false
- @timers.delete context
- end
- end
-
- def on_server_quit (meta, command, args)
- @timers.keys.each do |key|
- next if key.nick != meta.nick
- @timers[key].part meta, false
- @timers.delete key
- end
- end
-
- def process (meta, command, args)
- method = "on_server_#{command.downcase}"
- send method, meta, command, args if respond_to? method
- end
-end
-
-# --- IRC message processing ---------------------------------------------------
-
-$handlers = [Pomodoro.new]
-def process_line (line)
- msg = parse line
- return if not msg
-
- nick, user, host, command, args = *msg
-
- context = nick
- quote = ""
- channel = nil
-
- if args.size >= 1 and args[0].start_with? ?#, ?+, ?&, ?!
- case command
- when "PRIVMSG", "NOTICE", "JOIN"
- context = args[0]
- quote = "#{nick}: "
- channel = args[0]
- when "PART"
- channel = args[0]
- end
- end
-
- # Handle any IRC message
- meta = MessageMeta.new(nick, user, host, channel, context, quote).freeze
- $handlers.each do |handler|
- handler.process meta, command, args
- end
-
- # Handle pre-processed bot commands
- if command == 'PRIVMSG' and args.size >= 2
- msg = args[1]
- return unless msg.start_with? $config[:prefix]
- $handlers.each do |handler|
- handler.process_command meta, msg[$config[:prefix].size..-1]
- end
- end
-end
-
-buffer = ""
-stdin_io = IOEvent.new($stdin, lambda do |io|
- begin
- buffer << io.read_nonblock(4096)
- lines = buffer.split $/, -1
- buffer = lines.pop
- lines.each { |line| process_line line }
- rescue EOFError
- $loop.quit
- rescue IO::WaitReadable
- # Ignore
- end
-end)
-
-$loop = EventLoop.new
-$loop.set_io stdin_io, IOEvent::READ
-$loop.run
diff --git a/plugins/script b/plugins/script
deleted file mode 100755
index 661fbb0..0000000
--- a/plugins/script
+++ /dev/null
@@ -1,2310 +0,0 @@
-#!/usr/bin/tcc -run -lm
-//
-// ZyklonB scripting plugin, using a custom stack-based language
-//
-// Copyright 2014 Přemysl Janouch
-// See the file LICENSE for licensing information.
-//
-// Just compile this file as usual (sans #!) if you don't feel like using TCC.
-// It is a very basic and portable C99 application. It's not supposed to be
-// very sophisticated, for it'd get extremely big.
-//
-// The main influences of the language were Factor and Joy, stripped of all
-// even barely complex stuff. In its current state, it's only really useful as
-// a calculator but it's got great potential for extending.
-//
-// If you don't like something, just change it; this is just an experiment.
-//
-// NOTE: it is relatively easy to abuse. Be careful.
-//
-
-#define _XOPEN_SOURCE 500
-
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-#include
-
-#define ADDRESS_SPACE_LIMIT (100 * 1024 * 1024)
-#include
-
-#if defined __GNUC__
-#define ATTRIBUTE_PRINTF(x, y) __attribute__ ((format (printf, x, y)))
-#else // ! __GNUC__
-#define ATTRIBUTE_PRINTF(x, y)
-#endif // ! __GNUC__
-
-#define N_ELEMENTS(a) (sizeof (a) / sizeof ((a)[0]))
-
-// --- Utilities ---------------------------------------------------------------
-
-static char *strdup_printf (const char *format, ...) ATTRIBUTE_PRINTF (1, 2);
-
-static char *
-strdup_vprintf (const char *format, va_list ap)
-{
- va_list aq;
- va_copy (aq, ap);
- int size = vsnprintf (NULL, 0, format, aq);
- va_end (aq);
- if (size < 0)
- return NULL;
-
- char buf[size + 1];
- size = vsnprintf (buf, sizeof buf, format, ap);
- if (size < 0)
- return NULL;
-
- return strdup (buf);
-}
-
-static char *
-strdup_printf (const char *format, ...)
-{
- va_list ap;
- va_start (ap, format);
- char *result = strdup_vprintf (format, ap);
- va_end (ap);
- return result;
-}
-
-// --- Generic buffer ----------------------------------------------------------
-
-struct buffer
-{
- char *s; ///< Buffer data
- size_t alloc; ///< Number of bytes allocated
- size_t len; ///< Number of bytes used
- bool memory_failure; ///< Memory allocation failed
-};
-
-#define BUFFER_INITIALIZER { NULL, 0, 0, false }
-
-static bool
-buffer_append (struct buffer *self, const void *s, size_t n)
-{
- if (self->memory_failure)
- return false;
-
- if (!self->s)
- self->s = malloc (self->alloc = 8);
- while (self->len + n > self->alloc)
- self->s = realloc (self->s, self->alloc <<= 1);
-
- if (!self->s)
- {
- self->memory_failure = true;
- return false;
- }
-
- memcpy (self->s + self->len, s, n);
- self->len += n;
- return true;
-}
-
-inline static bool
-buffer_append_c (struct buffer *self, char c)
-{
- return buffer_append (self, &c, 1);
-}
-
-// --- Data types --------------------------------------------------------------
-
-enum item_type
-{
- ITEM_STRING,
- ITEM_WORD,
- ITEM_INTEGER,
- ITEM_FLOAT,
- ITEM_LIST
-};
-
-struct item
-{
-#define ITEM_HEADER \
- enum item_type type; /**< The type of this object */ \
- struct item *next; /**< Next item on the list/stack */
-
- ITEM_HEADER
-};
-
-struct item_string
-{
- ITEM_HEADER
- size_t len; ///< Length of the string (sans '\0')
- char value[]; ///< The null-terminated string value
-};
-
-#define get_string(item) \
- (assert ((item)->type == ITEM_STRING), \
- ((struct item_string *)(item))->value)
-
-/// It looks like a string but it doesn't quack like a string
-#define item_word item_string
-
-#define get_word(item) \
- (assert ((item)->type == ITEM_WORD), \
- ((struct item_word *)(item))->value)
-
-struct item_integer
-{
- ITEM_HEADER
- long long value; ///< The integer value
-};
-
-#define get_integer(item) \
- (assert ((item)->type == ITEM_INTEGER), \
- ((struct item_integer *)(item))->value)
-
-struct item_float
-{
- ITEM_HEADER
- long double value; ///< The floating point value
-};
-
-#define get_float(item) \
- (assert ((item)->type == ITEM_FLOAT), \
- ((struct item_float *)(item))->value)
-
-struct item_list
-{
- ITEM_HEADER
- struct item *head; ///< The head of the list
-};
-
-#define get_list(item) \
- (assert ((item)->type == ITEM_LIST), \
- ((struct item_list *)(item))->head)
-
-#define set_list(item, head_) \
- (assert ((item)->type == ITEM_LIST), \
- item_free_list (((struct item_list *)(item))->head), \
- ((struct item_list *)(item))->head = (head_))
-
-const char *
-item_type_to_str (enum item_type type)
-{
- switch (type)
- {
- case ITEM_STRING: return "string";
- case ITEM_WORD: return "word";
- case ITEM_INTEGER: return "integer";
- case ITEM_FLOAT: return "float";
- case ITEM_LIST: return "list";
- }
- abort ();
-}
-
-// --- Item management ---------------------------------------------------------
-
-static void item_free_list (struct item *);
-static struct item *new_clone_list (const struct item *);
-
-static void
-item_free (struct item *item)
-{
- if (item->type == ITEM_LIST)
- item_free_list (get_list (item));
- free (item);
-}
-
-static void
-item_free_list (struct item *item)
-{
- while (item)
- {
- struct item *link = item;
- item = item->next;
- item_free (link);
- }
-}
-
-static struct item *
-new_clone (const struct item *item)
-{
- size_t size;
- switch (item->type)
- {
- case ITEM_STRING:
- case ITEM_WORD:
- {
- const struct item_string *x = (const struct item_string *) item;
- size = sizeof *x + x->len + 1;
- break;
- }
- case ITEM_INTEGER: size = sizeof (struct item_integer); break;
- case ITEM_FLOAT: size = sizeof (struct item_float); break;
- case ITEM_LIST: size = sizeof (struct item_list); break;
- }
-
- struct item *clone = malloc (size);
- if (!clone)
- return NULL;
-
- memcpy (clone, item, size);
- if (item->type == ITEM_LIST)
- {
- struct item_list *x = (struct item_list *) clone;
- if (x->head && !(x->head = new_clone_list (x->head)))
- {
- free (clone);
- return NULL;
- }
- }
- clone->next = NULL;
- return clone;
-}
-
-static struct item *
-new_clone_list (const struct item *item)
-{
- struct item *head = NULL, *clone;
- for (struct item **out = &head; item; item = item->next)
- {
- if (!(clone = *out = new_clone (item)))
- {
- item_free_list (head);
- return NULL;
- }
- clone->next = NULL;
- out = &clone->next;
- }
- return head;
-}
-
-static struct item *
-new_string (const char *s, ssize_t len)
-{
- if (len < 0)
- len = strlen (s);
-
- struct item_string *item = calloc (1, sizeof *item + len + 1);
- if (!item)
- return NULL;
-
- item->type = ITEM_STRING;
- item->len = len;
- memcpy (item->value, s, len);
- item->value[len] = '\0';
- return (struct item *) item;
-}
-
-static struct item *
-new_word (const char *s, ssize_t len)
-{
- struct item *item = new_string (s, len);
- if (!item)
- return NULL;
-
- item->type = ITEM_WORD;
- return item;
-}
-
-static struct item *
-new_integer (long long value)
-{
- struct item_integer *item = calloc (1, sizeof *item);
- if (!item)
- return NULL;
-
- item->type = ITEM_INTEGER;
- item->value = value;
- return (struct item *) item;
-}
-
-static struct item *
-new_float (long double value)
-{
- struct item_float *item = calloc (1, sizeof *item);
- if (!item)
- return NULL;
-
- item->type = ITEM_FLOAT;
- item->value = value;
- return (struct item *) item;
-}
-
-static struct item *
-new_list (struct item *head)
-{
- struct item_list *item = calloc (1, sizeof *item);
- if (!item)
- return NULL;
-
- item->type = ITEM_LIST;
- item->head = head;
- return (struct item *) item;
-}
-
-// --- Parsing -----------------------------------------------------------------
-
-#define PARSE_ERROR_TABLE(XX) \
- XX( OK, NULL ) \
- XX( EOF, "unexpected end of input" ) \
- XX( INVALID_HEXA_ESCAPE, "invalid hexadecimal escape sequence" ) \
- XX( INVALID_ESCAPE, "unrecognized escape sequence" ) \
- XX( MEMORY, "memory allocation failure" ) \
- XX( FLOAT_RANGE, "floating point value out of range" ) \
- XX( INTEGER_RANGE, "integer out of range" ) \
- XX( INVALID_INPUT, "invalid input" ) \
- XX( UNEXPECTED_INPUT, "unexpected input" )
-
-enum tokenizer_error
-{
-#define XX(x, y) PARSE_ERROR_ ## x,
- PARSE_ERROR_TABLE (XX)
-#undef XX
- PARSE_ERROR_COUNT
-};
-
-struct tokenizer
-{
- const char *cursor;
- enum tokenizer_error error;
-};
-
-static bool
-decode_hexa_escape (struct tokenizer *self, struct buffer *buf)
-{
- int i;
- char c, code = 0;
-
- for (i = 0; i < 2; i++)
- {
- c = tolower (*self->cursor);
- if (c >= '0' && c <= '9')
- code = (code << 4) | (c - '0');
- else if (c >= 'a' && c <= 'f')
- code = (code << 4) | (c - 'a' + 10);
- else
- break;
-
- self->cursor++;
- }
-
- if (!i)
- return false;
-
- buffer_append_c (buf, code);
- return true;
-}
-
-static bool
-decode_octal_escape (struct tokenizer *self, struct buffer *buf)
-{
- int i;
- char c, code = 0;
-
- for (i = 0; i < 3; i++)
- {
- c = *self->cursor;
- if (c < '0' || c > '7')
- break;
-
- code = (code << 3) | (c - '0');
- self->cursor++;
- }
-
- if (!i)
- return false;
-
- buffer_append_c (buf, code);
- return true;
-}
-
-static bool
-decode_escape_sequence (struct tokenizer *self, struct buffer *buf)
-{
- // Support some basic escape sequences from the C language
- char c;
- switch ((c = *self->cursor))
- {
- case '\0':
- self->error = PARSE_ERROR_EOF;
- return false;
- case 'x':
- case 'X':
- self->cursor++;
- if (decode_hexa_escape (self, buf))
- return true;
-
- self->error = PARSE_ERROR_INVALID_HEXA_ESCAPE;
- return false;
- default:
- if (decode_octal_escape (self, buf))
- return true;
-
- self->cursor++;
- const char *from = "abfnrtv\"\\", *to = "\a\b\f\n\r\t\v\"\\", *x;
- if ((x = strchr (from, c)))
- {
- buffer_append_c (buf, to[x - from]);
- return true;
- }
-
- self->error = PARSE_ERROR_INVALID_ESCAPE;
- return false;
- }
-}
-
-static struct item *
-parse_string (struct tokenizer *self)
-{
- struct buffer buf = BUFFER_INITIALIZER;
- struct item *item = NULL;
- char c;
-
- while (true)
- switch ((c = *self->cursor++))
- {
- case '\0':
- self->cursor--;
- self->error = PARSE_ERROR_EOF;
- goto end;
- case '"':
- if (buf.memory_failure
- || !(item = new_string (buf.s, buf.len)))
- self->error = PARSE_ERROR_MEMORY;
- goto end;
- case '\\':
- if (decode_escape_sequence (self, &buf))
- break;
- goto end;
- default:
- buffer_append_c (&buf, c);
- }
-
-end:
- free (buf.s);
- return item;
-}
-
-static struct item *
-try_parse_number (struct tokenizer *self)
-{
- // These two standard library functions can digest a lot of various inputs,
- // including NaN and +/- infinity. That may get a bit confusing.
- char *float_end;
- errno = 0;
- long double float_value = strtold (self->cursor, &float_end);
- int float_errno = errno;
-
- char *int_end;
- errno = 0;
- long long int_value = strtoll (self->cursor, &int_end, 10);
- int int_errno = errno;
-
- // If they both fail, then this is most probably not a number.
- if (float_end == int_end && float_end == self->cursor)
- return NULL;
-
- // Only use the floating point result if it parses more characters:
- struct item *item;
- if (float_end > int_end)
- {
- if (float_errno == ERANGE)
- {
- self->error = PARSE_ERROR_FLOAT_RANGE;
- return NULL;
- }
- self->cursor = float_end;
- if (!(item = new_float (float_value)))
- self->error = PARSE_ERROR_MEMORY;
- return item;
- }
- else
- {
- if (int_errno == ERANGE)
- {
- self->error = PARSE_ERROR_INTEGER_RANGE;
- return NULL;
- }
- self->cursor = int_end;
- if (!(item = new_integer (int_value)))
- self->error = PARSE_ERROR_MEMORY;
- return item;
- }
-}
-
-static struct item *
-parse_word (struct tokenizer *self)
-{
- struct buffer buf = BUFFER_INITIALIZER;
- struct item *item = NULL;
- char c;
-
- // Here we accept almost anything that doesn't break the grammar
- while (!strchr (" []\"", (c = *self->cursor++)) && (unsigned char) c > ' ')
- buffer_append_c (&buf, c);
- self->cursor--;
-
- if (buf.memory_failure)
- self->error = PARSE_ERROR_MEMORY;
- else if (!buf.len)
- self->error = PARSE_ERROR_INVALID_INPUT;
- else if (!(item = new_word (buf.s, buf.len)))
- self->error = PARSE_ERROR_MEMORY;
-
- free (buf.s);
- return item;
-}
-
-static struct item *parse_item_list (struct tokenizer *);
-
-static struct item *
-parse_list (struct tokenizer *self)
-{
- struct item *list = parse_item_list (self);
- if (self->error)
- {
- assert (list == NULL);
- return NULL;
- }
- if (!*self->cursor)
- {
- self->error = PARSE_ERROR_EOF;
- item_free_list (list);
- return NULL;
- }
- assert (*self->cursor == ']');
- self->cursor++;
- return new_list (list);
-}
-
-static struct item *
-parse_item (struct tokenizer *self)
-{
- char c;
- switch ((c = *self->cursor++))
- {
- case '[': return parse_list (self);
- case '"': return parse_string (self);
- default:;
- }
-
- self->cursor--;
- struct item *item = try_parse_number (self);
- if (!item && !self->error)
- item = parse_word (self);
- return item;
-}
-
-static struct item *
-parse_item_list (struct tokenizer *self)
-{
- struct item *head = NULL;
- struct item **tail = &head;
-
- char c;
- bool expected = true;
- while ((c = *self->cursor) && c != ']')
- {
- if (isspace (c))
- {
- self->cursor++;
- expected = true;
- continue;
- }
- else if (!expected)
- {
- self->error = PARSE_ERROR_UNEXPECTED_INPUT;
- goto fail;
- }
-
- if (!(*tail = parse_item (self)))
- goto fail;
- tail = &(*tail)->next;
- expected = false;
- }
- return head;
-
-fail:
- item_free_list (head);
- return NULL;
-}
-
-static struct item *
-parse (const char *s, const char **error)
-{
- struct tokenizer self = { .cursor = s, .error = PARSE_ERROR_OK };
- struct item *list = parse_item_list (&self);
- if (!self.error && *self.cursor != '\0')
- {
- self.error = PARSE_ERROR_UNEXPECTED_INPUT;
- item_free_list (list);
- list = NULL;
- }
-
-#define XX(x, y) y,
- static const char *strings[PARSE_ERROR_COUNT] =
- { PARSE_ERROR_TABLE (XX) };
-#undef XX
-
- static char error_buf[128];
- if (self.error && error)
- {
- snprintf (error_buf, sizeof error_buf, "at character %d: %s",
- (int) (self.cursor - s) + 1, strings[self.error]);
- *error = error_buf;
- }
- return list;
-}
-
-// --- Runtime -----------------------------------------------------------------
-
-// TODO: try to think of a _simple_ way to do preemptive multitasking
-
-struct context
-{
- struct item *stack; ///< The current top of the stack
- size_t stack_size; ///< Number of items on the stack
-
- size_t reduction_count; ///< # of function calls so far
- size_t reduction_limit; ///< The hard limit on function calls
-
- char *error; ///< Error information
- bool error_is_fatal; ///< Whether the error can be catched
- bool memory_failure; ///< Memory allocation failure
-
- void *user_data; ///< User data
-};
-
-/// Internal handler for a function
-typedef bool (*handler_fn) (struct context *);
-
-struct fn
-{
- struct fn *next; ///< The next link in the chain
-
- handler_fn handler; ///< Internal C handler, or NULL
- struct item *script; ///< Alternatively runtime code
- char name[]; ///< The name of the function
-};
-
-struct fn *g_functions; ///< Maps words to functions
-
-static void
-context_init (struct context *ctx)
-{
- ctx->stack = NULL;
- ctx->stack_size = 0;
-
- ctx->reduction_count = 0;
- ctx->reduction_limit = 2000;
-
- ctx->error = NULL;
- ctx->error_is_fatal = false;
- ctx->memory_failure = false;
-
- ctx->user_data = NULL;
-}
-
-static void
-context_free (struct context *ctx)
-{
- item_free_list (ctx->stack);
- ctx->stack = NULL;
-
- free (ctx->error);
- ctx->error = NULL;
-}
-
-static bool
-set_error (struct context *ctx, const char *format, ...)
-{
- free (ctx->error);
-
- va_list ap;
- va_start (ap, format);
- ctx->error = strdup_vprintf (format, ap);
- va_end (ap);
-
- if (!ctx->error)
- ctx->memory_failure = true;
- return false;
-}
-
-static bool
-push (struct context *ctx, struct item *item)
-{
- // The `item' is typically a result from new_(), thus when it is null,
- // that function must have failed. This is a shortcut for convenience.
- if (!item)
- {
- ctx->memory_failure = true;
- return false;
- }
-
- assert (item->next == NULL);
- item->next = ctx->stack;
- ctx->stack = item;
- ctx->stack_size++;
- return true;
-}
-
-static bool
-bump_reductions (struct context *ctx)
-{
- if (++ctx->reduction_count >= ctx->reduction_limit)
- {
- ctx->error_is_fatal = true;
- return set_error (ctx, "reduction limit reached");
- }
- return true;
-}
-
-static bool execute (struct context *, struct item *);
-
-static bool
-call_function (struct context *ctx, const char *name)
-{
- struct fn *iter;
- for (iter = g_functions; iter; iter = iter->next)
- if (!strcmp (name, iter->name))
- goto found;
- return set_error (ctx, "unknown function: %s", name);
-
-found:
- if (!bump_reductions (ctx))
- return false;
-
- if (iter->handler
- ? iter->handler (ctx)
- : execute (ctx, iter->script))
- return true;
-
- // In this case, `error' is NULL
- if (ctx->memory_failure)
- return false;
-
- // This creates some form of a stack trace
- char *tmp = ctx->error;
- ctx->error = NULL;
- set_error (ctx, "%s -> %s", name, tmp);
- free (tmp);
- return false;
-}
-
-static void
-free_function (struct fn *fn)
-{
- item_free_list (fn->script);
- free (fn);
-}
-
-static void
-unregister_function (const char *name)
-{
- for (struct fn **iter = &g_functions; *iter; iter = &(*iter)->next)
- if (!strcmp ((*iter)->name, name))
- {
- struct fn *tmp = *iter;
- *iter = tmp->next;
- free_function (tmp);
- break;
- }
-}
-
-static struct fn *
-prepend_new_fn (const char *name)
-{
- struct fn *fn = calloc (1, sizeof *fn + strlen (name) + 1);
- if (!fn)
- return NULL;
-
- strcpy (fn->name, name);
- fn->next = g_functions;
- return g_functions = fn;
-}
-
-static bool
-register_handler (const char *name, handler_fn handler)
-{
- unregister_function (name);
- struct fn *fn = prepend_new_fn (name);
- if (!fn)
- return false;
- fn->handler = handler;
- return true;
-}
-
-static bool
-register_script (const char *name, struct item *script)
-{
- unregister_function (name);
- struct fn *fn = prepend_new_fn (name);
- if (!fn)
- return false;
- fn->script = script;
- return true;
-}
-
-static bool
-execute (struct context *ctx, struct item *script)
-{
- for (; script; script = script->next)
- {
- if (script->type != ITEM_WORD)
- {
- if (!bump_reductions (ctx)
- || !push (ctx, new_clone (script)))
- return false;
- }
- else if (!call_function (ctx, get_word (script)))
- return false;
- }
- return true;
-}
-
-// --- Runtime library ---------------------------------------------------------
-
-#define defn(name) static bool name (struct context *ctx)
-
-#define check_stack(n) \
- if (ctx->stack_size < n) { \
- set_error (ctx, "stack underflow"); \
- return 0; \
- }
-
-inline static bool
-check_stack_safe (struct context *ctx, size_t n)
-{
- check_stack (n);
- return true;
-}
-
-static bool
-check_type (struct context *ctx, const void *item_, enum item_type type)
-{
- const struct item *item = item_;
- if (item->type == type)
- return true;
-
- return set_error (ctx, "invalid type: expected `%s', got `%s'",
- item_type_to_str (type), item_type_to_str (item->type));
-}
-
-static struct item *
-pop (struct context *ctx)
-{
- check_stack (1);
- struct item *top = ctx->stack;
- ctx->stack = top->next;
- top->next = NULL;
- ctx->stack_size--;
- return top;
-}
-
-// - - Types - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#define defn_is_type(name, item_type) \
- defn (fn_is_##name) { \
- check_stack (1); \
- struct item *top = pop (ctx); \
- push (ctx, new_integer (top->type == (item_type))); \
- item_free (top); \
- return true; \
- }
-
-defn_is_type (string, ITEM_STRING)
-defn_is_type (word, ITEM_WORD)
-defn_is_type (integer, ITEM_INTEGER)
-defn_is_type (float, ITEM_FLOAT)
-defn_is_type (list, ITEM_LIST)
-
-defn (fn_to_string)
-{
- check_stack (1);
- struct item *item = pop (ctx);
- char *value;
-
- switch (item->type)
- {
- case ITEM_WORD:
- item->type = ITEM_STRING;
- case ITEM_STRING:
- return push (ctx, item);
-
- case ITEM_FLOAT:
- value = strdup_printf ("%Lf", get_float (item));
- break;
- case ITEM_INTEGER:
- value = strdup_printf ("%lld", get_integer (item));
- break;
-
- default:
- set_error (ctx, "cannot convert `%s' to `%s'",
- item_type_to_str (item->type), item_type_to_str (ITEM_STRING));
- item_free (item);
- return false;
- }
-
- item_free (item);
- if (!value)
- {
- ctx->memory_failure = true;
- return false;
- }
-
- item = new_string (value, -1);
- free (value);
- return push (ctx, item);
-}
-
-defn (fn_to_integer)
-{
- check_stack (1);
- struct item *item = pop (ctx);
- long long value;
-
- switch (item->type)
- {
- case ITEM_INTEGER:
- return push (ctx, item);
- case ITEM_FLOAT:
- value = get_float (item);
- break;
-
- case ITEM_STRING:
- {
- char *end;
- const char *s = get_string (item);
- value = strtoll (s, &end, 10);
- if (end != s && *s == '\0')
- break;
-
- item_free (item);
- return set_error (ctx, "integer conversion error");
- }
-
- default:
- set_error (ctx, "cannot convert `%s' to `%s'",
- item_type_to_str (item->type), item_type_to_str (ITEM_INTEGER));
- item_free (item);
- return false;
- }
-
- item_free (item);
- return push (ctx, new_integer (value));
-}
-
-defn (fn_to_float)
-{
- check_stack (1);
- struct item *item = pop (ctx);
- long double value;
-
- switch (item->type)
- {
- case ITEM_FLOAT:
- return push (ctx, item);
- case ITEM_INTEGER:
- value = get_integer (item);
- break;
-
- case ITEM_STRING:
- {
- char *end;
- const char *s = get_string (item);
- value = strtold (s, &end);
- if (end != s && *s == '\0')
- break;
-
- item_free (item);
- return set_error (ctx, "float conversion error");
- }
-
- default:
- set_error (ctx, "cannot convert `%s' to `%s'",
- item_type_to_str (item->type), item_type_to_str (ITEM_FLOAT));
- item_free (item);
- return false;
- }
-
- item_free (item);
- return push (ctx, new_float (value));
-}
-
-// - - Miscellaneous - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-defn (fn_length)
-{
- check_stack (1);
- struct item *item = pop (ctx);
- bool success = true;
- switch (item->type)
- {
- case ITEM_STRING:
- success = push (ctx, new_integer (((struct item_string *) item)->len));
- break;
- case ITEM_LIST:
- {
- long long length = 0;
- struct item *iter;
- for (iter = get_list (item); iter; iter = iter->next)
- length++;
- success = push (ctx, new_integer (length));
- break;
- }
- default:
- success = set_error (ctx, "invalid type");
- }
- item_free (item);
- return success;
-}
-
-// - - Stack operations - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-defn (fn_dup)
-{
- check_stack (1);
- return push (ctx, new_clone (ctx->stack));
-}
-
-defn (fn_drop)
-{
- check_stack (1);
- item_free (pop (ctx));
- return true;
-}
-
-defn (fn_swap)
-{
- check_stack (2);
- struct item *second = pop (ctx), *first = pop (ctx);
- return push (ctx, second) && push (ctx, first);
-}
-
-defn (fn_call)
-{
- check_stack (1);
- struct item *script = pop (ctx);
- bool success = check_type (ctx, script, ITEM_LIST)
- && execute (ctx, get_list (script));
- item_free (script);
- return success;
-}
-
-defn (fn_dip)
-{
- check_stack (2);
- struct item *script = pop (ctx);
- struct item *item = pop (ctx);
- bool success = check_type (ctx, script, ITEM_LIST)
- && execute (ctx, get_list (script));
- item_free (script);
- if (!success)
- {
- item_free (item);
- return false;
- }
- return push (ctx, item);
-}
-
-defn (fn_unit)
-{
- check_stack (1);
- struct item *item = pop (ctx);
- return push (ctx, new_list (item));
-}
-
-defn (fn_cons)
-{
- check_stack (2);
- struct item *list = pop (ctx);
- struct item *item = pop (ctx);
- if (!check_type (ctx, list, ITEM_LIST))
- {
- item_free (list);
- item_free (item);
- return false;
- }
- item->next = get_list (list);
- ((struct item_list *) list)->head = item;
- return push (ctx, list);
-}
-
-defn (fn_cat)
-{
- check_stack (2);
- struct item *scnd = pop (ctx);
- struct item *frst = pop (ctx);
- if (!check_type (ctx, frst, ITEM_LIST)
- || !check_type (ctx, scnd, ITEM_LIST))
- {
- item_free (frst);
- item_free (scnd);
- return false;
- }
-
- // XXX: we shouldn't have to do this in O(n)
- struct item **tail = &((struct item_list *) frst)->head;
- while (*tail)
- tail = &(*tail)->next;
- *tail = get_list (scnd);
-
- ((struct item_list *) scnd)->head = NULL;
- item_free (scnd);
- return push (ctx, frst);
-}
-
-defn (fn_uncons)
-{
- check_stack (1);
- struct item *list = pop (ctx);
- if (!check_type (ctx, list, ITEM_LIST))
- goto fail;
- struct item *first = get_list (list);
- if (!first)
- {
- set_error (ctx, "list is empty");
- goto fail;
- }
- ((struct item_list *) list)->head = first->next;
- first->next = NULL;
- return push (ctx, first) && push (ctx, list);
-fail:
- item_free (list);
- return false;
-}
-
-// - - Logical - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-static bool
-to_boolean (struct context *ctx, struct item *item, bool *ok)
-{
- switch (item->type)
- {
- case ITEM_STRING:
- return *get_string (item) != '\0';
- case ITEM_INTEGER:
- return get_integer (item) != 0;
- case ITEM_FLOAT:
- return get_float (item) != 0.;
- default:
- return (*ok = set_error (ctx, "cannot convert `%s' to boolean",
- item_type_to_str (item->type)));
- }
-}
-
-defn (fn_not)
-{
- check_stack (1);
- struct item *item = pop (ctx);
- bool ok = true;
- bool result = !to_boolean (ctx, item, &ok);
- item_free (item);
- return ok && push (ctx, new_integer (result));
-}
-
-defn (fn_and)
-{
- check_stack (2);
- struct item *op1 = pop (ctx);
- struct item *op2 = pop (ctx);
- bool ok = true;
- bool result = to_boolean (ctx, op1, &ok) && to_boolean (ctx, op2, &ok);
- item_free (op1);
- item_free (op2);
- return ok && push (ctx, new_integer (result));
-}
-
-defn (fn_or)
-{
- check_stack (2);
- struct item *op1 = pop (ctx);
- struct item *op2 = pop (ctx);
- bool ok = true;
- bool result = to_boolean (ctx, op1, &ok)
- || !ok || to_boolean (ctx, op2, &ok);
- item_free (op1);
- item_free (op2);
- return ok && push (ctx, new_integer (result));
-}
-
-// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-defn (fn_if)
-{
- check_stack (3);
- struct item *else_ = pop (ctx);
- struct item *then_ = pop (ctx);
- struct item *cond_ = pop (ctx);
-
- bool ok = true;
- bool condition = to_boolean (ctx, cond_, &ok);
- item_free (cond_);
-
- bool success = false;
- if (ok
- && check_type (ctx, then_, ITEM_LIST)
- && check_type (ctx, else_, ITEM_LIST))
- success = execute (ctx, condition
- ? get_list (then_)
- : get_list (else_));
-
- item_free (then_);
- item_free (else_);
- return success;
-}
-
-defn (fn_try)
-{
- check_stack (2);
- struct item *catch = pop (ctx);
- struct item *try = pop (ctx);
- bool success = false;
- if (!check_type (ctx, try, ITEM_LIST)
- || !check_type (ctx, catch, ITEM_LIST))
- goto fail;
-
- if (!execute (ctx, get_list (try)))
- {
- if (ctx->memory_failure || ctx->error_is_fatal)
- goto fail;
-
- success = push (ctx, new_string (ctx->error, -1));
- free (ctx->error);
- ctx->error = NULL;
-
- if (success)
- success = execute (ctx, get_list (catch));
- }
-
-fail:
- item_free (try);
- item_free (catch);
- return success;
-}
-
-defn (fn_map)
-{
- check_stack (2);
- struct item *fn = pop (ctx);
- struct item *list = pop (ctx);
- if (!check_type (ctx, fn, ITEM_LIST)
- || !check_type (ctx, list, ITEM_LIST))
- {
- item_free (fn);
- item_free (list);
- return false;
- }
-
- bool success = false;
- struct item *result = NULL, **tail = &result;
- for (struct item *iter = get_list (list); iter; iter = iter->next)
- {
- if (!push (ctx, new_clone (iter))
- || !execute (ctx, get_list (fn))
- || !check_stack_safe (ctx, 1))
- goto fail;
-
- struct item *item = pop (ctx);
- *tail = item;
- tail = &item->next;
- }
- success = true;
-
-fail:
- set_list (list, result);
- item_free (fn);
- if (!success)
- {
- item_free (list);
- return false;
- }
- return push (ctx, list);
-}
-
-defn (fn_filter)
-{
- check_stack (2);
- struct item *fn = pop (ctx);
- struct item *list = pop (ctx);
- if (!check_type (ctx, fn, ITEM_LIST)
- || !check_type (ctx, list, ITEM_LIST))
- {
- item_free (fn);
- item_free (list);
- return false;
- }
-
- bool success = false;
- bool ok = true;
- struct item *result = NULL, **tail = &result;
- for (struct item *iter = get_list (list); iter; iter = iter->next)
- {
- if (!push (ctx, new_clone (iter))
- || !execute (ctx, get_list (fn))
- || !check_stack_safe (ctx, 1))
- goto fail;
-
- struct item *item = pop (ctx);
- bool survived = to_boolean (ctx, item, &ok);
- item_free (item);
- if (!ok)
- goto fail;
- if (!survived)
- continue;
-
- if (!(item = new_clone (iter)))
- goto fail;
- *tail = item;
- tail = &item->next;
- }
- success = true;
-
-fail:
- set_list (list, result);
- item_free (fn);
- if (!success)
- {
- item_free (list);
- return false;
- }
- return push (ctx, list);
-}
-
-defn (fn_fold)
-{
- check_stack (3);
- struct item *op = pop (ctx);
- struct item *null = pop (ctx);
- struct item *list = pop (ctx);
- bool success = false;
- if (!check_type (ctx, op, ITEM_LIST)
- || !check_type (ctx, list, ITEM_LIST))
- {
- item_free (null);
- goto fail;
- }
-
- push (ctx, null);
- for (struct item *iter = get_list (list); iter; iter = iter->next)
- if (!push (ctx, new_clone (iter))
- || !execute (ctx, get_list (op)))
- goto fail;
- success = true;
-
-fail:
- item_free (op);
- item_free (list);
- return success;
-}
-
-defn (fn_each)
-{
- check_stack (2);
- struct item *op = pop (ctx);
- struct item *list = pop (ctx);
- bool success = false;
- if (!check_type (ctx, op, ITEM_LIST)
- || !check_type (ctx, list, ITEM_LIST))
- goto fail;
-
- for (struct item *iter = get_list (list); iter; iter = iter->next)
- if (!push (ctx, new_clone (iter))
- || !execute (ctx, get_list (op)))
- goto fail;
- success = true;
-
-fail:
- item_free (op);
- item_free (list);
- return success;
-}
-
-// - - Arithmetic - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-// XXX: why not a `struct item_string *` argument?
-static bool
-push_repeated_string (struct context *ctx, struct item *op1, struct item *op2)
-{
- struct item_string *string = (struct item_string *) op1;
- struct item_integer *repeat = (struct item_integer *) op2;
- assert (string->type == ITEM_STRING);
- assert (repeat->type == ITEM_INTEGER);
-
- if (repeat->value < 0)
- return set_error (ctx, "cannot multiply a string by a negative value");
-
- char *buf = NULL;
- size_t len = string->len * repeat->value;
- if (len < string->len && repeat->value != 0)
- goto allocation_fail;
-
- buf = malloc (len);
- if (!buf)
- goto allocation_fail;
-
- for (size_t i = 0; i < len; i += string->len)
- memcpy (buf + i, string->value, string->len);
- struct item *item = new_string (buf, len);
- free (buf);
- return push (ctx, item);
-
-allocation_fail:
- ctx->memory_failure = true;
- return false;
-}
-
-defn (fn_times)
-{
- check_stack (2);
- struct item *op2 = pop (ctx);
- struct item *op1 = pop (ctx);
-
- bool ok;
- if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_integer (get_integer (op1) * get_integer (op2)));
- else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (get_integer (op1) * get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (get_float (op1) * get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_float (get_float (op1) * get_integer (op2)));
- else if (op1->type == ITEM_INTEGER && op2->type == ITEM_STRING)
- ok = push_repeated_string (ctx, op2, op1);
- else if (op1->type == ITEM_STRING && op2->type == ITEM_INTEGER)
- ok = push_repeated_string (ctx, op1, op2);
- else
- ok = set_error (ctx, "cannot multiply `%s' and `%s'",
- item_type_to_str (op1->type), item_type_to_str (op2->type));
-
- item_free (op1);
- item_free (op2);
- return ok;
-}
-
-defn (fn_pow)
-{
- check_stack (2);
- struct item *op2 = pop (ctx);
- struct item *op1 = pop (ctx);
-
- bool ok;
- if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
- // TODO: implement this properly, outputting an integer
- ok = push (ctx, new_float (powl (get_integer (op1), get_integer (op2))));
- else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (powl (get_integer (op1), get_float (op2))));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (powl (get_float (op1), get_float (op2))));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_float (powl (get_float (op1), get_integer (op2))));
- else
- ok = set_error (ctx, "cannot exponentiate `%s' and `%s'",
- item_type_to_str (op1->type), item_type_to_str (op2->type));
-
- item_free (op1);
- item_free (op2);
- return ok;
-}
-
-defn (fn_div)
-{
- check_stack (2);
- struct item *op2 = pop (ctx);
- struct item *op1 = pop (ctx);
-
- bool ok;
- if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
- {
- if (get_integer (op2) == 0)
- ok = set_error (ctx, "division by zero");
- else
- ok = push (ctx, new_integer (get_integer (op1) / get_integer (op2)));
- }
- else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (get_integer (op1) / get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (get_float (op1) / get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_float (get_float (op1) / get_integer (op2)));
- else
- ok = set_error (ctx, "cannot divide `%s' and `%s'",
- item_type_to_str (op1->type), item_type_to_str (op2->type));
-
- item_free (op1);
- item_free (op2);
- return ok;
-}
-
-defn (fn_mod)
-{
- check_stack (2);
- struct item *op2 = pop (ctx);
- struct item *op1 = pop (ctx);
-
- bool ok;
- if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
- {
- if (get_integer (op2) == 0)
- ok = set_error (ctx, "division by zero");
- else
- ok = push (ctx, new_integer (get_integer (op1) % get_integer (op2)));
- }
- else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (fmodl (get_integer (op1), get_float (op2))));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (fmodl (get_float (op1), get_float (op2))));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_float (fmodl (get_float (op1), get_integer (op2))));
- else
- ok = set_error (ctx, "cannot divide `%s' and `%s'",
- item_type_to_str (op1->type), item_type_to_str (op2->type));
-
- item_free (op1);
- item_free (op2);
- return ok;
-}
-
-static bool
-push_concatenated_string (struct context *ctx,
- struct item *op1, struct item *op2)
-{
- struct item_string *s1 = (struct item_string *) op1;
- struct item_string *s2 = (struct item_string *) op2;
- assert (s1->type == ITEM_STRING);
- assert (s2->type == ITEM_STRING);
-
- char *buf = NULL;
- size_t len = s1->len + s2->len;
- if (len < s1->len || len < s2->len)
- goto allocation_fail;
-
- buf = malloc (len);
- if (!buf)
- goto allocation_fail;
-
- memcpy (buf, s1->value, s1->len);
- memcpy (buf + s1->len, s2->value, s2->len);
- struct item *item = new_string (buf, len);
- free (buf);
- return push (ctx, item);
-
-allocation_fail:
- ctx->memory_failure = true;
- return false;
-
-}
-
-defn (fn_plus)
-{
- check_stack (2);
- struct item *op2 = pop (ctx);
- struct item *op1 = pop (ctx);
-
- bool ok;
- if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_integer (get_integer (op1) + get_integer (op2)));
- else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (get_integer (op1) + get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (get_float (op1) + get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_float (get_float (op1) + get_integer (op2)));
- else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING)
- ok = push_concatenated_string (ctx, op1, op2);
- else
- ok = set_error (ctx, "cannot add `%s' and `%s'",
- item_type_to_str (op1->type), item_type_to_str (op2->type));
-
- item_free (op1);
- item_free (op2);
- return ok;
-}
-
-defn (fn_minus)
-{
- check_stack (2);
- struct item *op2 = pop (ctx);
- struct item *op1 = pop (ctx);
-
- bool ok;
- if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_integer (get_integer (op1) - get_integer (op2)));
- else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (get_integer (op1) - get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_float (get_float (op1) - get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_float (get_float (op1) - get_integer (op2)));
- else
- ok = set_error (ctx, "cannot subtract `%s' and `%s'",
- item_type_to_str (op1->type), item_type_to_str (op2->type));
-
- item_free (op1);
- item_free (op2);
- return ok;
-}
-
-// - - Comparison - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-static int
-compare_strings (struct item_string *s1, struct item_string *s2)
-{
- // XXX: not entirely correct wrt. null bytes
- size_t len = (s1->len < s2->len ? s1->len : s2->len) + 1;
- return memcmp (s1->value, s2->value, len);
-}
-
-static bool compare_lists (struct item *, struct item *);
-
-static bool
-compare_list_items (struct item *op1, struct item *op2)
-{
- if (op1->type != op2->type)
- return false;
-
- switch (op1->type)
- {
- case ITEM_STRING:
- case ITEM_WORD:
- return !compare_strings ((struct item_string *) op1,
- (struct item_string *) op2);
- case ITEM_FLOAT:
- return get_float (op1) == get_float (op2);
- case ITEM_INTEGER:
- return get_integer (op1) == get_integer (op2);
- case ITEM_LIST:
- return compare_lists (get_list (op1), get_list (op2));
- }
- abort ();
-}
-
-static bool
-compare_lists (struct item *op1, struct item *op2)
-{
- while (op1 && op2)
- {
- if (!compare_list_items (op1, op2))
- return false;
-
- op1 = op1->next;
- op2 = op2->next;
- }
- return !op1 && !op2;
-}
-
-defn (fn_eq)
-{
- check_stack (2);
- struct item *op2 = pop (ctx);
- struct item *op1 = pop (ctx);
-
- bool ok;
- if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_integer (get_integer (op1) == get_integer (op2)));
- else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_integer (get_integer (op1) == get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_integer (get_float (op1) == get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_integer (get_float (op1) == get_integer (op2)));
- else if (op1->type == ITEM_LIST && op2->type == ITEM_LIST)
- ok = push (ctx, new_integer (compare_lists
- (get_list (op1), get_list (op2))));
- else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING)
- ok = push (ctx, new_integer (compare_strings
- ((struct item_string *)(op1), (struct item_string *)(op2)) == 0));
- else
- ok = set_error (ctx, "cannot compare `%s' and `%s'",
- item_type_to_str (op1->type), item_type_to_str (op2->type));
-
- item_free (op1);
- item_free (op2);
- return ok;
-}
-
-defn (fn_lt)
-{
- check_stack (2);
- struct item *op2 = pop (ctx);
- struct item *op1 = pop (ctx);
-
- bool ok;
- if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_integer (get_integer (op1) < get_integer (op2)));
- else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_integer (get_integer (op1) < get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
- ok = push (ctx, new_integer (get_float (op1) < get_float (op2)));
- else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
- ok = push (ctx, new_integer (get_float (op1) < get_integer (op2)));
- else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING)
- ok = push (ctx, new_integer (compare_strings
- ((struct item_string *)(op1), (struct item_string *)(op2)) < 0));
- else
- ok = set_error (ctx, "cannot compare `%s' and `%s'",
- item_type_to_str (op1->type), item_type_to_str (op2->type));
-
- item_free (op1);
- item_free (op2);
- return ok;
-}
-
-// - - Utilities - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-defn (fn_rand)
-{
- return push (ctx, new_float ((long double) rand ()
- / ((long double) RAND_MAX + 1)));
-}
-
-defn (fn_time)
-{
- return push (ctx, new_integer (time (NULL)));
-}
-
-// XXX: this is a bit too constrained; combines strftime() with gmtime()
-defn (fn_strftime)
-{
- check_stack (2);
- struct item *format = pop (ctx);
- struct item *time_ = pop (ctx);
- bool success = false;
- if (!check_type (ctx, time_, ITEM_INTEGER)
- || !check_type (ctx, format, ITEM_STRING))
- goto fail;
-
- if (get_integer (time_) < 0)
- {
- set_error (ctx, "invalid time value");
- goto fail;
- }
-
- char buf[128];
- time_t time__ = get_integer (time_);
- struct tm tm;
- gmtime_r (&time__, &tm);
- buf[strftime (buf, sizeof buf, get_string (format), &tm)] = '\0';
- success = push (ctx, new_string (buf, -1));
-
-fail:
- item_free (time_);
- item_free (format);
- return success;
-}
-
-// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-static void item_list_to_str (const struct item *, struct buffer *);
-
-static void
-string_to_str (const struct item_string *string, struct buffer *buf)
-{
- buffer_append_c (buf, '"');
- for (size_t i = 0; i < string->len; i++)
- {
- char c = string->value[i];
- if (c == '\n') buffer_append (buf, "\\n", 2);
- else if (c == '\r') buffer_append (buf, "\\r", 2);
- else if (c == '\t') buffer_append (buf, "\\t", 2);
- else if (!isprint (c))
- {
- char tmp[8];
- snprintf (tmp, sizeof tmp, "\\x%02x", (unsigned char) c);
- buffer_append (buf, tmp, strlen (tmp));
- }
- else if (c == '\\') buffer_append (buf, "\\\\", 2);
- else if (c == '"') buffer_append (buf, "\\\"", 2);
- else buffer_append_c (buf, c);
- }
- buffer_append_c (buf, '"');
-}
-
-static void
-item_to_str (const struct item *item, struct buffer *buf)
-{
- switch (item->type)
- {
- char *x;
- case ITEM_STRING:
- string_to_str ((struct item_string *) item, buf);
- break;
- case ITEM_WORD:
- {
- struct item_word *word = (struct item_word *) item;
- buffer_append (buf, word->value, word->len);
- break;
- }
- case ITEM_INTEGER:
- if (!(x = strdup_printf ("%lld", get_integer (item))))
- goto alloc_failure;
- buffer_append (buf, x, strlen (x));
- free (x);
- break;
- case ITEM_FLOAT:
- if (!(x = strdup_printf ("%Lf", get_float (item))))
- goto alloc_failure;
- buffer_append (buf, x, strlen (x));
- free (x);
- break;
- case ITEM_LIST:
- buffer_append_c (buf, '[');
- item_list_to_str (get_list (item), buf);
- buffer_append_c (buf, ']');
- break;
- }
- return;
-
-alloc_failure:
- // This is a bit hackish but it simplifies stuff
- buf->memory_failure = true;
- free (buf->s);
- buf->s = NULL;
-}
-
-static void
-item_list_to_str (const struct item *script, struct buffer *buf)
-{
- if (!script)
- return;
-
- item_to_str (script, buf);
- while ((script = script->next))
- {
- buffer_append_c (buf, ' ');
- item_to_str (script, buf);
- }
-}
-
-// --- IRC protocol ------------------------------------------------------------
-
-struct message
-{
- char *prefix; ///< Message prefix
- char *command; ///< IRC command
- char *params[16]; ///< Command parameters (0-terminated)
- size_t n_params; ///< Number of parameters present
-};
-
-inline static char *
-cut_word (char **s)
-{
- char *start = *s, *end = *s + strcspn (*s, " ");
- *s = end + strspn (end, " ");
- *end = '\0';
- return start;
-}
-
-static bool
-parse_message (char *s, struct message *msg)
-{
- memset (msg, 0, sizeof *msg);
-
- // Ignore IRC 3.2 message tags, if present
- if (*s == '@')
- {
- s += strcspn (s, " ");
- s += strspn (s, " ");
- }
-
- // Prefix
- if (*s == ':')
- msg->prefix = cut_word (&s) + 1;
-
- // Command
- if (!*(msg->command = cut_word (&s)))
- return false;
-
- // Parameters
- while (*s)
- {
- size_t n = msg->n_params++;
- if (msg->n_params >= N_ELEMENTS (msg->params))
- return false;
- if (*s == ':')
- {
- msg->params[n] = ++s;
- break;
- }
- msg->params[n] = cut_word (&s);
- }
- return true;
-}
-
-static struct message *
-read_message (void)
-{
- static bool discard = false;
- static char buf[1025];
- static struct message msg;
-
- bool discard_this;
- do
- {
- if (!fgets (buf, sizeof buf, stdin))
- return NULL;
- size_t len = strlen (buf);
-
- // Just to be on the safe side, if the line overflows our buffer,
- // ignore everything up until the next line.
- discard_this = discard;
- if (len >= 2 && !strcmp (buf + len - 2, "\r\n"))
- {
- buf[len -= 2] = '\0';
- discard = false;
- }
- else
- discard = true;
- }
- // Invalid messages are silently ignored
- while (discard_this || !parse_message (buf, &msg));
- return &msg;
-}
-
-// --- Interfacing with the bot ------------------------------------------------
-
-#define BOT_PRINT "ZYKLONB print :script: "
-
-static const char *
-get_config (const char *key)
-{
- printf ("ZYKLONB get_config :%s\r\n", key);
- struct message *msg = read_message ();
- if (!msg || msg->n_params <= 0)
- exit (EXIT_FAILURE);
- return msg->params[0];
-}
-
-// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-// TODO: implement more functions; try to avoid writing them in C
-
-static bool
-init_runtime_library_scripts (void)
-{
- bool ok = true;
-
- // It's much cheaper (and more fun) to define functions in terms of other
- // ones. The "unit tests" serve a secondary purpose of showing the usage.
- struct script
- {
- const char *name; ///< Name of the function
- const char *definition; ///< The defining script
- const char *unit_test; ///< Trivial unit test, must return 1
- }
- scripts[] =
- {
- { "nip", "swap drop", "1 2 nip 2 =" },
- { "over", "[dup] dip swap", "1 2 over nip nip 1 =" },
- { "swons", "swap cons", "[2] 1 swons [1 2] =" },
- { "first", "uncons drop", "[1 2 3] first 1 =" },
- { "rest", "uncons swap drop", "[1 2 3] rest [2 3] =" },
- { "reverse", "[] swap [swap cons] each", "[1 2] reverse [2 1] =" },
- { "curry", "cons", "1 2 [+] curry call 3 =" },
-
- { "xor", "not swap not + 1 =", "1 1 xor 0 =" },
- { "min", "over over < [drop] [nip] if", "1 2 min 1 =" },
- { "max", "over over > [drop] [nip] if", "1 2 max 2 =" },
-
- { "all?", "[and] cat 1 swap fold", "[3 4 5] [> 3] all? 0 =" },
- { "any?", "[or] cat 0 swap fold", "[3 4 5] [> 3] any? 1 =" },
-
- { ">", "swap <", "1 2 > 0 =" },
- { "!=", "= not", "1 2 != 1 =" },
- { "<=", "> not", "1 2 <= 1 =" },
- { ">=", "< not", "1 2 >= 0 =" },
-
- // XXX: this is a bit crazy and does not work with an empty list
- { "join", "[uncons] dip swap [[dup] dip swap [+ +] dip] each drop",
- "[1 2 3] [>string] map \" -> \" join \"1 -> 2 -> 3\" =" },
- };
-
- for (size_t i = 0; i < N_ELEMENTS (scripts); i++)
- {
- const char *error = NULL;
- struct item *script = parse (scripts[i].definition, &error);
- if (error)
- {
- printf (BOT_PRINT "error parsing internal script `%s': %s\r\n",
- scripts[i].definition, error);
- ok = false;
- }
- else
- ok &= register_script (scripts[i].name, script);
- }
-
- struct context ctx;
- for (size_t i = 0; i < N_ELEMENTS (scripts); i++)
- {
- const char *error = NULL;
- struct item *script = parse (scripts[i].unit_test, &error);
- if (error)
- {
- printf (BOT_PRINT "error parsing unit test for `%s': %s\r\n",
- scripts[i].name, error);
- ok = false;
- continue;
- }
- context_init (&ctx);
- execute (&ctx, script);
- item_free_list (script);
-
- const char *failure = NULL;
- if (ctx.memory_failure)
- failure = "memory allocation failure";
- else if (ctx.error)
- failure = ctx.error;
- else if (ctx.stack_size != 1)
- failure = "too many results on the stack";
- else if (ctx.stack->type != ITEM_INTEGER)
- failure = "result is not an integer";
- else if (get_integer (ctx.stack) != 1)
- failure = "wrong test result";
- if (failure)
- {
- printf (BOT_PRINT "error executing unit test for `%s': %s\r\n",
- scripts[i].name, failure);
- ok = false;
- }
- context_free (&ctx);
- }
- return ok;
-}
-
-static bool
-init_runtime_library (void)
-{
- bool ok = true;
-
- // Type detection
- ok &= register_handler ("string?", fn_is_string);
- ok &= register_handler ("word?", fn_is_word);
- ok &= register_handler ("integer?", fn_is_integer);
- ok &= register_handler ("float?", fn_is_float);
- ok &= register_handler ("list?", fn_is_list);
-
- // Type conversion
- ok &= register_handler (">string", fn_to_string);
- ok &= register_handler (">integer", fn_to_integer);
- ok &= register_handler (">float", fn_to_float);
-
- // Miscellaneous
- ok &= register_handler ("length", fn_length);
-
- // Basic stack manipulation
- ok &= register_handler ("dup", fn_dup);
- ok &= register_handler ("drop", fn_drop);
- ok &= register_handler ("swap", fn_swap);
-
- // Calling stuff
- ok &= register_handler ("call", fn_call);
- ok &= register_handler ("dip", fn_dip);
-
- // Control flow
- ok &= register_handler ("if", fn_if);
- ok &= register_handler ("try", fn_try);
-
- // List processing
- ok &= register_handler ("map", fn_map);
- ok &= register_handler ("filter", fn_filter);
- ok &= register_handler ("fold", fn_fold);
- ok &= register_handler ("each", fn_each);
-
- // List manipulation
- ok &= register_handler ("unit", fn_unit);
- ok &= register_handler ("cons", fn_cons);
- ok &= register_handler ("cat", fn_cat);
- ok &= register_handler ("uncons", fn_uncons);
-
- // Arithmetic operations
- ok &= register_handler ("+", fn_plus);
- ok &= register_handler ("-", fn_minus);
- ok &= register_handler ("*", fn_times);
- ok &= register_handler ("^", fn_pow);
- ok &= register_handler ("/", fn_div);
- ok &= register_handler ("%", fn_mod);
-
- // Comparison
- ok &= register_handler ("=", fn_eq);
- ok &= register_handler ("<", fn_lt);
-
- // Logical operations
- ok &= register_handler ("not", fn_not);
- ok &= register_handler ("and", fn_and);
- ok &= register_handler ("or", fn_or);
-
- // Utilities
- ok &= register_handler ("rand", fn_rand);
- ok &= register_handler ("time", fn_time);
- ok &= register_handler ("strftime", fn_strftime);
-
- ok &= init_runtime_library_scripts ();
- return ok;
-}
-
-static void
-free_runtime_library (void)
-{
- struct fn *next, *iter;
- for (iter = g_functions; iter; iter = next)
- {
- next = iter->next;
- free_function (iter);
- }
-}
-
-// --- Function database -------------------------------------------------------
-
-// TODO: a global variable storing the various procedures (db)
-// XXX: defining procedures would ideally need some kind of an ACL
-
-static void
-read_db (void)
-{
- // TODO
-}
-
-static void
-write_db (void)
-{
- // TODO
-}
-
-// --- Main --------------------------------------------------------------------
-
-static char *g_prefix;
-
-struct user_info
-{
- char *ctx; ///< Context: channel or user
- char *ctx_quote; ///< Reply quotation
-};
-
-defn (fn_dot)
-{
- check_stack (1);
- struct item *item = pop (ctx);
- struct user_info *info = ctx->user_data;
-
- struct buffer buf = BUFFER_INITIALIZER;
- item_to_str (item, &buf);
- item_free (item);
- buffer_append_c (&buf, '\0');
- if (buf.memory_failure)
- {
- ctx->memory_failure = true;
- return false;
- }
-
- if (buf.len > 255)
- buf.s[255] = '\0';
-
- printf ("PRIVMSG %s :%s%s\r\n", info->ctx, info->ctx_quote, buf.s);
- free (buf.s);
- return true;
-}
-
-static void
-process_message (struct message *msg)
-{
- if (!msg->prefix
- || strcasecmp (msg->command, "PRIVMSG")
- || msg->n_params < 2)
- return;
- char *line = msg->params[1];
-
- // Filter out only our commands
- size_t prefix_len = strlen (g_prefix);
- if (strncmp (line, g_prefix, prefix_len))
- return;
- line += prefix_len;
-
- char *command = cut_word (&line);
- if (strcasecmp (command, "script"))
- return;
-
- // Retrieve information on how to respond back
- char *msg_ctx = msg->prefix, *x;
- if ((x = strchr (msg_ctx, '!')))
- *x = '\0';
-
- char *msg_ctx_quote;
- if (strchr ("#+&!", *msg->params[0]))
- {
- msg_ctx_quote = strdup_printf ("%s: ", msg_ctx);
- msg_ctx = msg->params[0];
- }
- else
- msg_ctx_quote = strdup ("");
-
- if (!msg_ctx_quote)
- {
- printf (BOT_PRINT "%s\r\n", "memory allocation failure");
- return;
- }
-
- struct user_info info;
- info.ctx = msg_ctx;
- info.ctx_quote = msg_ctx_quote;
-
- // Finally parse and execute the macro
- const char *error = NULL;
- struct item *script = parse (line, &error);
- if (error)
- {
- printf ("PRIVMSG %s :%s%s: %s\r\n",
- msg_ctx, msg_ctx_quote, "parse error", error);
- goto end;
- }
-
- struct context ctx;
- context_init (&ctx);
- ctx.user_data = &info;
- execute (&ctx, script);
- item_free_list (script);
-
- const char *failure = NULL;
- if (ctx.memory_failure)
- failure = "memory allocation failure";
- else if (ctx.error)
- failure = ctx.error;
- if (failure)
- printf ("PRIVMSG %s :%s%s: %s\r\n",
- msg_ctx, msg_ctx_quote, "runtime error", failure);
- context_free (&ctx);
-end:
- free (msg_ctx_quote);
-}
-
-int
-main (int argc, char *argv[])
-{
- freopen (NULL, "rb", stdin); setvbuf (stdin, NULL, _IOLBF, BUFSIZ);
- freopen (NULL, "wb", stdout); setvbuf (stdout, NULL, _IOLBF, BUFSIZ);
-
- struct rlimit limit =
- {
- .rlim_cur = ADDRESS_SPACE_LIMIT,
- .rlim_max = ADDRESS_SPACE_LIMIT
- };
-
- // Lower the memory limits to something sensible to prevent abuse
- (void) setrlimit (RLIMIT_AS, &limit);
-
- read_db ();
- if (!init_runtime_library ()
- || !register_handler (".", fn_dot))
- printf (BOT_PRINT "%s\r\n", "runtime library initialization failed");
-
- g_prefix = strdup (get_config ("prefix"));
- printf ("ZYKLONB register\r\n");
- struct message *msg;
- while ((msg = read_message ()))
- process_message (msg);
-
- free_runtime_library ();
- free (g_prefix);
- return 0;
-}
-
diff --git a/plugins/youtube b/plugins/youtube
deleted file mode 100755
index 5614860..0000000
--- a/plugins/youtube
+++ /dev/null
@@ -1,111 +0,0 @@
-#!/usr/bin/env python3
-#
-# ZyklonB YouTube plugin, displaying info about YouTube links
-#
-# Copyright 2014 - 2015, Přemysl Janouch
-# See the file LICENSE for licensing information.
-#
-
-import sys
-import io
-import re
-import json
-import urllib.request
-
-class Plugin:
- re_msg = re.compile ('(?::([^! ]*)(?:!([^@]*)@([^ ]*))? +)?'
- '([^ ]+)(?: +(.*))?\r\n$')
- re_args = re.compile (':?((?<=:).*|[^ ]+) *')
-
- def parse (self, line):
- m = self.re_msg.match (line)
- if m is None:
- return None
-
- (nick, user, host, command, args) = m.groups ()
- args = [] if args is None else self.re_args.findall (args)
- return (nick, user, host, command, args)
-
- def get_config (self, key):
- print ("ZYKLONB get_config :%s" % key)
- (_, _, _, _, args) = self.parse (sys.stdin.readline ())
- return args[0]
-
- def bot_print (self, what):
- print ('ZYKLONB print :%s' % what)
-
-class YouTube (Plugin):
- re_videos = [re.compile (x) for x in [
- r'youtube\.[a-z]+/[^ ]*[&?]v=([-\w]+)',
- r'youtube\.[a-z]+/v/([-\w]+)',
- r'youtu\.be/([-\w]+)'
- ]]
- re_playlists = [re.compile (x) for x in [
- r'youtube\.[a-z]+/playlist[&?][^ ]*(?<=&|\?)list=([-\w]+)',
- ]]
-
- def print_info (self, channel, url, cb):
- try:
- data = json.loads (urllib.request.urlopen
- (url, None, 30).read ().decode ('utf-8'))
-
- for line in map (lambda x: "YouTube: " + cb (x), data['items']):
- print ("PRIVMSG %s :%s" % (channel,
- line.encode ('utf-8').decode ('iso8859-1')))
-
- except Exception as err:
- self.bot_print ('youtube: %s' % (err))
-
- def print_video_info (self, channel, video_id):
- url = 'https://www.googleapis.com/youtube/v3/' \
- + 'videos?id=%s&key=%s&part=snippet,contentDetails,statistics' \
- % (video_id, self.youtube_api_key)
- self.print_info (channel, url, lambda x: "%s | %s | %sx" % (
- x['snippet']['title'],
- x['contentDetails']['duration'][2:].lower (),
- x['statistics']['viewCount']))
-
- def print_playlist_info (self, channel, playlist_id):
- url = 'https://www.googleapis.com/youtube/v3/' \
- + 'playlists?id=%s&key=%s&part=snippet,contentDetails' \
- % (playlist_id, self.youtube_api_key)
- self.print_info (channel, url, lambda x: "%s | %d videos" % (
- x['snippet']['title'],
- x['contentDetails']['itemCount']))
-
- def process_line (self, line):
- msg = self.parse (line)
- if msg is None:
- return
-
- (nick, user, host, command, args) = msg
- if command != 'PRIVMSG' or len (args) < 2:
- return
-
- ctx = args[0]
- if not ctx.startswith (('#', '+', '&', '!')):
- ctx = nick
-
- for regex in self.re_videos:
- for i in regex.findall (args[1]):
- self.print_video_info (ctx, i)
- for regex in self.re_playlists:
- for i in regex.findall (args[1]):
- self.print_playlist_info (ctx, i)
-
- def run (self):
- self.youtube_api_key = self.get_config ('youtube_api_key')
- if self.youtube_api_key == "":
- self.bot_print ("youtube: missing `youtube_api_key'")
-
- print ("ZYKLONB register")
-
- for line in sys.stdin:
- self.process_line (line)
-
-sys.stdin = io.TextIOWrapper (sys.__stdin__.buffer,
- encoding = 'iso8859-1', newline = '\r\n', line_buffering = True)
-sys.stdout = io.TextIOWrapper (sys.__stdout__.buffer,
- encoding = 'iso8859-1', newline = '\r\n', line_buffering = True)
-
-YouTube ().run ()
diff --git a/plugins/zyklonb/coin b/plugins/zyklonb/coin
new file mode 100755
index 0000000..65967ad
--- /dev/null
+++ b/plugins/zyklonb/coin
@@ -0,0 +1,128 @@
+#!/usr/bin/env tclsh
+#
+# ZyklonB coin plugin, random number-based utilities
+#
+# Copyright 2012, 2014 Přemysl Janouch
+# See the file LICENSE for licensing information.
+#
+
+# This is a terrible excuse for a programming language and I feel dirty.
+
+proc parse {line} {
+ global msg
+ unset -nocomplain msg
+
+ if [regexp {^:([^ ]*) *(.*)} $line -> prefix rest] {
+ set msg(prefix) $prefix
+ set line $rest
+ }
+ if [regexp {^([^ ]*) *(.*)} $line -> command rest] {
+ set msg(command) $command
+ set line $rest
+ }
+ while {1} {
+ set line [string trimleft $line " "]
+ set i [string first " " $line]
+ if {$i == -1} { set i [string length $line] }
+ if {$i == 0} { break }
+
+ if {[string index $line 0] == ":"} {
+ lappend msg(param) [string range $line 1 end]
+ break
+ }
+ lappend msg(param) [string range $line 0 [expr $i - 1]]
+ set line [string range $line $i end]
+ }
+}
+
+proc get_config {key} {
+ global msg
+ puts "ZYKLONB get_config :$key"
+ gets stdin line
+ parse $line
+ return [lindex $msg(param) 0]
+}
+
+proc pmrespond {text} {
+ global ctx
+ global ctx_quote
+ puts "PRIVMSG $ctx :$ctx_quote$text"
+}
+
+fconfigure stdin -translation crlf -encoding iso8859-1
+fconfigure stdout -translation crlf -encoding iso8859-1
+
+set prefix [get_config prefix]
+puts "ZYKLONB register"
+
+set eightball [list \
+ "It is certain" \
+ "It is decidedly so" \
+ "Without a doubt" \
+ "Yes - definitely" \
+ "You may rely on it" \
+ "As I see it, yes" \
+ "Most likely" \
+ "Outlook good" \
+ "Yes" \
+ "Signs point to yes" \
+ "Reply hazy, try again" \
+ "Ask again later" \
+ "Better not tell you now" \
+ "Cannot predict now" \
+ "Concentrate and ask again" \
+ "Don't count on it" \
+ "My reply is no" \
+ "My sources say no" \
+ "Outlook not so good" \
+ "Very doubtful"]
+
+while {[gets stdin line] != -1} {
+ parse $line
+
+ if {! [info exists msg(prefix)] || ! [info exists msg(command)]
+ || $msg(command) != "PRIVMSG" || ! [info exists msg(param)]
+ || [llength $msg(param)] < 2} { continue }
+
+ regexp {^[^!]*} $msg(prefix) ctx
+ if [regexp {^[#&+!]} [lindex $msg(param) 0]] {
+ set ctx_quote "$ctx: "
+ set ctx [lindex $msg(param) 0]
+ } else { set ctx_quote "" }
+
+ set input [lindex $msg(param) 1]
+ set first_chars [string range $input 0 \
+ [expr [string length $prefix] - 1]]
+ if {$first_chars != $prefix} { continue }
+ set input [string range $input [string length $prefix] end]
+
+ if {$input == "coin"} {
+ if {rand() < 0.5} {
+ pmrespond "Heads."
+ } else {
+ pmrespond "Tails."
+ }
+ } elseif {[regexp {^dice( +|$)(.*)} $input -> _ args]} {
+ if {! [string is integer -strict $args] || $args <= 0} {
+ pmrespond "Invalid or missing number."
+ } else {
+ pmrespond [expr {int($args * rand()) + 1}]
+ }
+ } elseif {[regexp {^(choose|\?)( +|$)(.*)} $input -> _ _ args]} {
+ if {$args == ""} {
+ pmrespond "Nothing to choose from."
+ } else {
+ set c [split $args ",|"]
+ pmrespond [string trim [lindex $c \
+ [expr {int([llength $c] * rand())}]]]
+ }
+ } elseif {[regexp {^eightball( +|$)(.*)} $input -> _ args]} {
+ if {$args == ""} {
+ pmrespond "You should, you know, ask something."
+ } else {
+ pmrespond [lindex $eightball \
+ [expr {int([llength $eightball] * rand())}]].
+ }
+ }
+}
+
diff --git a/plugins/zyklonb/eval b/plugins/zyklonb/eval
new file mode 100755
index 0000000..982d78b
--- /dev/null
+++ b/plugins/zyklonb/eval
@@ -0,0 +1,312 @@
+#!/usr/bin/awk -f
+#
+# ZyklonB eval plugin, LISP-like expression evaluator
+#
+# Copyright 2013, 2014 Přemysl Janouch
+# See the file LICENSE for licensing information.
+#
+
+BEGIN \
+{
+ RS = "\r"
+ ORS = "\r\n"
+ IGNORECASE = 1
+ srand()
+
+ prefix = get_config("prefix")
+
+ print "ZYKLONB register"
+ fflush("")
+
+ # All functions have to be in this particular array
+ min_args["int"] = 1
+ min_args["+"] = 1
+ min_args["-"] = 1
+ min_args["*"] = 1
+ min_args["/"] = 1
+ min_args["%"] = 1
+ min_args["^"] = 1
+ min_args["**"] = 1
+ min_args["exp"] = 1
+ min_args["sin"] = 1
+ min_args["cos"] = 1
+ min_args["atan2"] = 2
+ min_args["log"] = 1
+ min_args["rand"] = 0
+ min_args["sqrt"] = 1
+
+ min_args["pi"] = 0
+ min_args["e"] = 0
+
+ min_args["min"] = 1
+ min_args["max"] = 1
+
+ # Whereas here their presence is only optional
+ max_args["int"] = 1
+ max_args["sin"] = 1
+ max_args["cos"] = 1
+ max_args["atan2"] = 2
+ max_args["log"] = 1
+ max_args["rand"] = 0
+ max_args["sqrt"] = 1
+
+ max_args["pi"] = 0
+ max_args["e"] = 0
+}
+
+{
+ parse($0)
+}
+
+msg_command == "PRIVMSG" \
+{
+ # Context = either channel or user nickname
+ match(msg_prefix, /^[^!]+/)
+ ctx = substr(msg_prefix, RSTART, RLENGTH)
+ if (msg_param[0] ~ /^[#&!+]/)
+ {
+ ctx_quote = ctx ": "
+ ctx = msg_param[0]
+ }
+ else
+ ctx_quote = ""
+
+
+ if (substr(msg_param[1], 1, length(prefix)) == prefix)
+ {
+ keyword = "eval"
+ text = substr(msg_param[1], 1 + length(prefix))
+ if (match(text, "^" keyword "([^A-Za-z0-9].*|$)"))
+ process_request(substr(text, 1 + length(keyword)))
+ }
+}
+
+{
+ fflush("")
+}
+
+function pmrespond (text)
+{
+ print "PRIVMSG " ctx " :" ctx_quote text
+}
+
+function process_request (input, res, x)
+{
+ delete funs
+ delete accumulator
+ delete n_args
+
+ res = ""
+ fun_top = 0
+ funs[0] = ""
+ accumulator[0] = 0
+ n_args[0] = 0
+
+ if (match(input, "^[ \t]*"))
+ input = substr(input, RLENGTH + 1)
+ if (input == "")
+ res = "expression missing"
+
+ while (res == "" && input != "") {
+ if (match(input, "^-?[0-9]+\\.?[0-9]*")) {
+ x = substr(input, RSTART, RLENGTH)
+ input = substr(input, RLENGTH + 1)
+
+ match(input, "^ *")
+ input = substr(input, RLENGTH + 1)
+
+ res = process_argument(x)
+ } else if (match(input, "^[(]([^ ()]+)")) {
+ x = substr(input, RSTART + 1, RLENGTH - 1)
+ input = substr(input, RLENGTH + 1)
+
+ match(input, "^ *")
+ input = substr(input, RLENGTH + 1)
+
+ if (!(x in min_args)) {
+ res = "undefined function '" x "'"
+ } else {
+ fun_top++
+ funs[fun_top] = x
+ accumulator[fun_top] = 636363
+ n_args[fun_top] = 0
+ }
+ } else if (match(input, "^[)] *")) {
+ input = substr(input, RLENGTH + 1)
+ res = process_end()
+ } else
+ res = "invalid input at '" substr(input, 1, 10) "...'"
+ }
+
+ if (res == "") {
+ if (fun_top != 0)
+ res = "unclosed '" funs[fun_top] "'"
+ else if (n_args[0] != 1)
+ res = "internal error, expected one result" \
+ ", got " n_args[0] " instead"
+ }
+
+ if (res == "")
+ pmrespond(accumulator[0])
+ else
+ pmrespond(res)
+}
+
+function process_argument (arg)
+{
+ if (fun_top == 0) {
+ if (n_args[0]++ != 0)
+ return "too many results, I only expect one"
+
+ accumulator[0] = arg
+ return ""
+ }
+
+ fun = funs[fun_top]
+ if (fun in max_args && max_args[fun] <= n_args[fun_top])
+ return "too many operands for " fun
+
+ if (fun == "int") {
+ accumulator[fun_top] = int(arg)
+ } else if (fun == "+") {
+ if (n_args[fun_top] == 0)
+ accumulator[fun_top] = arg
+ else
+ accumulator[fun_top] += arg
+ } else if (fun == "-") {
+ if (n_args[fun_top] == 0)
+ accumulator[fun_top] = arg
+ else
+ accumulator[fun_top] -= arg
+ } else if (fun == "*") {
+ if (n_args[fun_top] == 0)
+ accumulator[fun_top] = arg
+ else
+ accumulator[fun_top] *= arg
+ } else if (fun == "/") {
+ if (n_args[fun_top] == 0)
+ accumulator[fun_top] = arg
+ else if (arg == 0)
+ return "division by zero"
+ else
+ accumulator[fun_top] /= arg
+ } else if (fun == "%") {
+ if (n_args[fun_top] == 0)
+ accumulator[fun_top] = arg
+ else if (arg == 0)
+ return "division by zero"
+ else
+ accumulator[fun_top] %= arg
+ } else if (fun == "^" || fun == "**" || fun == "exp") {
+ if (n_args[fun_top] == 0)
+ accumulator[fun_top] = arg
+ else
+ accumulator[fun_top] ^= arg
+ } else if (fun == "sin") {
+ accumulator[fun_top] = sin(arg)
+ } else if (fun == "cos") {
+ accumulator[fun_top] = cos(arg)
+ } else if (fun == "atan2") {
+ if (n_args[fun_top] == 0)
+ accumulator[fun_top] = arg
+ else
+ accumulator[fun_top] = atan2(accumulator[fun_top], arg)
+ } else if (fun == "log") {
+ accumulator[fun_top] = log(arg)
+ } else if (fun == "rand") {
+ # Just for completeness, execution never gets here
+ } else if (fun == "sqrt") {
+ accumulator[fun_top] = sqrt(arg)
+ } else if (fun == "min") {
+ if (n_args[fun_top] == 0)
+ accumulator[fun_top] = arg
+ else if (accumulator[fun_top] > arg)
+ accumulator[fun_top] = arg
+ } else if (fun == "max") {
+ if (n_args[fun_top] == 0)
+ accumulator[fun_top] = arg
+ else if (accumulator[fun_top] < arg)
+ accumulator[fun_top] = arg
+ } else
+ return "internal error, unhandled operands for " fun
+
+ n_args[fun_top]++
+ return ""
+}
+
+function process_end ()
+{
+ if (fun_top <= 0)
+ return "extraneous ')'"
+
+ fun = funs[fun_top]
+ if (!(fun in min_args))
+ return "internal error, unhandled ')' for '" fun "'"
+ if (min_args[fun] > n_args[fun_top])
+ return "not enough operands for '" fun "'"
+
+ # There's no 'init' function to do it in
+ if (fun == "rand")
+ accumulator[fun_top] = rand()
+ else if (fun == "pi")
+ accumulator[fun_top] = 3.141592653589793
+ else if (fun == "e")
+ accumulator[fun_top] = 2.718281828459045
+
+ return process_argument(accumulator[fun_top--])
+}
+
+function get_config (key)
+{
+ print "ZYKLONB get_config :" key
+ fflush("")
+
+ getline
+ parse($0)
+ return msg_param[0]
+}
+
+function parse (line, s, n, id, token)
+{
+ s = 1
+ id = 0
+
+ # NAWK only uses the first character of RS
+ if (line ~ /^\n/)
+ line = substr(line, 2)
+
+ msg_prefix = ""
+ msg_command = ""
+ delete msg_param
+
+ n = match(substr(line, s), / |$/)
+ while (n)
+ {
+ token = substr(line, s, n - 1)
+ if (token ~ /^:/)
+ {
+ if (s == 1)
+ msg_prefix = substr(token, 2)
+ else
+ {
+ msg_param[id] = substr(line, s + 1)
+ break
+ }
+ }
+ else if (!msg_command)
+ msg_command = toupper(token)
+ else
+ msg_param[id++] = token
+
+ s = s + n
+ n = index(substr(line, s), " ")
+
+ if (!n)
+ {
+ n = length(substr(line, s)) + 1
+ if (n == 1)
+ break;
+ }
+ }
+}
+
diff --git a/plugins/zyklonb/pomodoro b/plugins/zyklonb/pomodoro
new file mode 100755
index 0000000..8f30327
--- /dev/null
+++ b/plugins/zyklonb/pomodoro
@@ -0,0 +1,502 @@
+#!/usr/bin/env ruby
+# coding: utf-8
+#
+# ZyklonB pomodoro plugin
+#
+# Copyright 2015 Přemysl Janouch
+# See the file LICENSE for licensing information.
+#
+
+# --- Simple event loop --------------------------------------------------------
+
+# This is more or less a straight-forward port of my C event loop. It's a bit
+# unfortunate that I really have to implement all this in order to get some
+# basic asynchronicity but at least I get to exercise my Ruby.
+
+class TimerEvent
+ attr_accessor :index, :when, :callback
+
+ def initialize (callback)
+ raise ArgumentError unless callback.is_a? Proc
+
+ @index = nil
+ @when = nil
+ @callback = callback
+ end
+
+ def active?
+ @index != nil
+ end
+
+ def until
+ return @when - Time.new
+ end
+end
+
+class IOEvent
+ READ = 1 << 0
+ WRITE = 1 << 1
+
+ attr_accessor :read_index, :write_index, :io, :callback
+
+ def initialize (io, callback)
+ raise ArgumentError unless callback.is_a? Proc
+
+ @read_index = nil
+ @write_index = nil
+ @io = io
+ @callback = callback
+ end
+end
+
+class EventLoop
+ def initialize
+ @running = false
+ @timers = []
+ @readers = []
+ @writers = []
+ @io_to_event = {}
+ end
+
+ def set_timer (timer, timeout)
+ raise ArgumentError unless timer.is_a? TimerEvent
+
+ timer.when = Time.now + timeout
+ if timer.index
+ heapify_down timer.index
+ heapify_up timer.index
+ else
+ timer.index = @timers.size
+ @timers.push timer
+ heapify_up timer.index
+ end
+ end
+
+ def reset_timer (timer)
+ raise ArgumentError unless timer.is_a? TimerEvent
+ remove_timer_at timer.index if timer.index
+ end
+
+ def set_io (io_event, events)
+ raise ArgumentError unless io_event.is_a? IOEvent
+ raise ArgumentError unless events.is_a? Numeric
+
+ reset_io io_event
+
+ @io_to_event[io_event.io] = io_event
+ if events & IOEvent::READ
+ io_event.read_index = @readers.size
+ @readers.push io_event.io
+ end
+ if events & IOEvent::WRITE
+ io_event.read_index = @writers.size
+ @writers.push io_event.io
+ end
+ end
+
+ def reset_io (io_event)
+ raise ArgumentError unless io_event.is_a? IOEvent
+
+ @readers.delete_at io_event.read_index if io_event.read_index
+ @writers.delete_at io_event.write_index if io_event.write_index
+
+ io_event.read_index = nil
+ io_event.write_index = nil
+
+ @io_to_event.delete io_event.io
+ end
+
+ def run
+ @running = true
+ while @running do one_iteration end
+ end
+
+ def quit
+ @running = false
+ end
+
+private
+ def one_iteration
+ rs, ws, = IO.select @readers, @writers, [], nearest_timeout
+ dispatch_timers
+ (Array(rs) | Array(ws)).each do |io|
+ @io_to_event[io].callback.call io
+ end
+ end
+
+ def dispatch_timers
+ now = Time.new
+ while not @timers.empty? and @timers[0].when <= now do
+ @timers[0].callback.call
+ remove_timer_at 0
+ end
+ end
+
+ def nearest_timeout
+ return nil if @timers.empty?
+ timeout = @timers[0].until
+ if timeout < 0 then 0 else timeout end
+ end
+
+ def remove_timer_at (index)
+ @timers[index].index = nil
+ moved = @timers.pop
+ return if index == @timers.size
+
+ @timers[index] = moved
+ @timers[index].index = index
+ heapify_down index
+ end
+
+ def swap_timers (a, b)
+ @timers[a], @timers[b] = @timers[b], @timers[a]
+ @timers[a].index = a
+ @timers[b].index = b
+ end
+
+ def heapify_up (index)
+ while index != 0 do
+ parent = (index - 1) / 2
+ break if @timers[parent].when <= @timers[index].when
+ swap_timers index, parent
+ index = parent
+ end
+ end
+
+ def heapify_down (index)
+ loop do
+ parent = index
+ left = 2 * index + 1
+ right = 2 * index + 2
+
+ lowest = parent
+ lowest = left if left < @timers.size and
+ @timers[left] .when < @timers[lowest].when
+ lowest = right if right < @timers.size and
+ @timers[right].when < @timers[lowest].when
+ break if parent == lowest
+
+ swap_timers lowest, parent
+ index = lowest
+ end
+ end
+end
+
+# --- IRC protocol -------------------------------------------------------------
+
+$stdin.set_encoding 'ASCII-8BIT'
+$stdout.set_encoding 'ASCII-8BIT'
+
+$stdin.sync = true
+$stdout.sync = true
+
+$/ = "\r\n"
+$\ = "\r\n"
+
+RE_MSG = /(?::([^! ]*)(?:!([^@]*)@([^ ]*))? +)?([^ ]+)(?: +(.*))?$/
+RE_ARGS = /:?((?<=:).*|[^ ]+) */
+
+def parse (line)
+ m = line.match RE_MSG
+ return nil if not m
+
+ nick, user, host, command, args = *m.captures
+ args = if args then args.scan(RE_ARGS).flatten else [] end
+ [nick, user, host, command, args]
+end
+
+def bot_print (what)
+ print "ZYKLONB print :#{what}"
+end
+
+# --- Initialization -----------------------------------------------------------
+
+# We can only read in configuration from here so far
+# To read it from anywhere else, it has to be done asynchronously
+$config = {}
+[:prefix].each do |name|
+ print "ZYKLONB get_config :#{name}"
+ _, _, _, _, args = *parse($stdin.gets.chomp)
+ $config[name] = args[0]
+end
+
+print "ZYKLONB register"
+
+# --- Plugin logic -------------------------------------------------------------
+
+# FIXME: this needs a major refactor as it doesn't make much sense at all
+
+class MessageMeta < Struct.new(:nick, :user, :host, :channel, :ctx, :quote)
+ def respond (message)
+ print "PRIVMSG #{ctx} :#{quote}#{message}"
+ end
+end
+
+class Context
+ attr_accessor :nick, :ctx
+
+ def initialize (meta)
+ @nick = meta.nick
+ @ctx = meta.ctx
+ end
+
+ def == (other)
+ self.class == other.class \
+ and other.nick == @nick \
+ and other.ctx == @ctx
+ end
+
+ alias eql? ==
+
+ def hash
+ @nick.hash ^ @ctx.hash
+ end
+end
+
+class PomodoroTimer
+ def initialize (context)
+ @ctx = context.ctx
+ @nicks = [context.nick]
+
+ @timer_work = TimerEvent.new(lambda { on_work })
+ @timer_rest = TimerEvent.new(lambda { on_rest })
+
+ on_work
+ end
+
+ def inform (message)
+ # FIXME: it tells the nick even in PM's
+ quote = "#{@nicks.join(" ")}: "
+ print "PRIVMSG #{@ctx} :#{quote}#{message}"
+ end
+
+ def on_work
+ inform "work now!"
+ $loop.set_timer @timer_rest, 25 * 60
+ end
+
+ def on_rest
+ inform "rest now!"
+ $loop.set_timer @timer_work, 5 * 60
+ end
+
+ def join (meta)
+ return if @nicks.include? meta.nick
+
+ meta.respond "you have joined their pomodoro"
+ @nicks |= [meta.nick]
+ end
+
+ def part (meta, requested)
+ return if not @nicks.include? meta.nick
+
+ if requested
+ meta.respond "you have stopped your pomodoro"
+ end
+
+ @nicks -= [meta.nick]
+ if @nicks.empty?
+ $loop.reset_timer @timer_work
+ $loop.reset_timer @timer_rest
+ end
+ end
+
+ def status (meta)
+ return if not @nicks.include? meta.nick
+
+ if @timer_rest.active?
+ till = @timer_rest.until
+ meta.respond "working, #{(till / 60).to_i} minutes, " +
+ "#{(till % 60).to_i} seconds until rest"
+ end
+ if @timer_work.active?
+ till = @timer_work.until
+ meta.respond "resting, #{(till / 60).to_i} minutes, " +
+ "#{(till % 60).to_i} seconds until work"
+ end
+ end
+end
+
+class Pomodoro
+ KEYWORD = "pomodoro"
+
+ def initialize
+ @timers = {}
+ end
+
+ def on_help (meta, args)
+ meta.respond "usage: #{KEYWORD} { start | stop | join | status }"
+ end
+
+ def on_start (meta, args)
+ if args.size != 0
+ meta.respond "usage: #{KEYWORD} start"
+ return
+ end
+
+ context = Context.new meta
+ if @timers[context]
+ meta.respond "you already have a timer running here"
+ else
+ @timers[context] = PomodoroTimer.new meta
+ end
+ end
+
+ def on_join (meta, args)
+ if args.size != 1
+ meta.respond "usage: #{KEYWORD} join "
+ return
+ end
+
+ context = Context.new meta
+ if @timers[context]
+ meta.respond "you already have a timer running here"
+ return
+ end
+
+ joined_context = Context.new meta
+ joined_context.nick = args.shift
+ timer = @timers[joined_context]
+ if not timer
+ meta.respond "that person doesn't have a timer here"
+ else
+ timer.join meta
+ @timers[context] = timer
+ end
+ end
+
+ def on_stop (meta, args)
+ if args.size != 0
+ meta.respond "usage: #{KEYWORD} stop"
+ return
+ end
+
+ context = Context.new meta
+ timer = @timers[context]
+ if not timer
+ meta.respond "you don't have a timer running here"
+ else
+ timer.part meta, true
+ @timers.delete context
+ end
+ end
+
+ def on_status (meta, args)
+ if args.size != 0
+ meta.respond "usage: #{KEYWORD} status"
+ return
+ end
+
+ timer = @timers[Context.new meta]
+ if not timer
+ meta.respond "you don't have a timer running here"
+ else
+ timer.status meta
+ end
+ end
+
+ def process_command (meta, msg)
+ args = msg.split
+ return if args.shift != KEYWORD
+
+ method = "on_#{args.shift}"
+ send method, meta, args if respond_to? method
+ end
+
+ def on_server_nick (meta, command, args)
+ # TODO: either handle this properly...
+ happened = false
+ @timers.keys.each do |key|
+ next if key.nick != meta.nick
+ @timers[key].part meta, false
+ @timers.delete key
+ happened = true
+ end
+ if happened
+ # TODO: ...or at least inform the user via his new nick
+ end
+ end
+
+ def on_server_part (meta, command, args)
+ # TODO: instead of cancelling the user's pomodoros, either redirect
+ # them to PM's and later upon rejoining undo the redirection...
+ context = Context.new(meta)
+ context.ctx = meta.channel
+ if @timers.include? context
+ # TODO: ...or at least inform the user about the cancellation
+ @timers[context].part meta, false
+ @timers.delete context
+ end
+ end
+
+ def on_server_quit (meta, command, args)
+ @timers.keys.each do |key|
+ next if key.nick != meta.nick
+ @timers[key].part meta, false
+ @timers.delete key
+ end
+ end
+
+ def process (meta, command, args)
+ method = "on_server_#{command.downcase}"
+ send method, meta, command, args if respond_to? method
+ end
+end
+
+# --- IRC message processing ---------------------------------------------------
+
+$handlers = [Pomodoro.new]
+def process_line (line)
+ msg = parse line
+ return if not msg
+
+ nick, user, host, command, args = *msg
+
+ context = nick
+ quote = ""
+ channel = nil
+
+ if args.size >= 1 and args[0].start_with? ?#, ?+, ?&, ?!
+ case command
+ when "PRIVMSG", "NOTICE", "JOIN"
+ context = args[0]
+ quote = "#{nick}: "
+ channel = args[0]
+ when "PART"
+ channel = args[0]
+ end
+ end
+
+ # Handle any IRC message
+ meta = MessageMeta.new(nick, user, host, channel, context, quote).freeze
+ $handlers.each do |handler|
+ handler.process meta, command, args
+ end
+
+ # Handle pre-processed bot commands
+ if command == 'PRIVMSG' and args.size >= 2
+ msg = args[1]
+ return unless msg.start_with? $config[:prefix]
+ $handlers.each do |handler|
+ handler.process_command meta, msg[$config[:prefix].size..-1]
+ end
+ end
+end
+
+buffer = ""
+stdin_io = IOEvent.new($stdin, lambda do |io|
+ begin
+ buffer << io.read_nonblock(4096)
+ lines = buffer.split $/, -1
+ buffer = lines.pop
+ lines.each { |line| process_line line }
+ rescue EOFError
+ $loop.quit
+ rescue IO::WaitReadable
+ # Ignore
+ end
+end)
+
+$loop = EventLoop.new
+$loop.set_io stdin_io, IOEvent::READ
+$loop.run
diff --git a/plugins/zyklonb/script b/plugins/zyklonb/script
new file mode 100755
index 0000000..661fbb0
--- /dev/null
+++ b/plugins/zyklonb/script
@@ -0,0 +1,2310 @@
+#!/usr/bin/tcc -run -lm
+//
+// ZyklonB scripting plugin, using a custom stack-based language
+//
+// Copyright 2014 Přemysl Janouch
+// See the file LICENSE for licensing information.
+//
+// Just compile this file as usual (sans #!) if you don't feel like using TCC.
+// It is a very basic and portable C99 application. It's not supposed to be
+// very sophisticated, for it'd get extremely big.
+//
+// The main influences of the language were Factor and Joy, stripped of all
+// even barely complex stuff. In its current state, it's only really useful as
+// a calculator but it's got great potential for extending.
+//
+// If you don't like something, just change it; this is just an experiment.
+//
+// NOTE: it is relatively easy to abuse. Be careful.
+//
+
+#define _XOPEN_SOURCE 500
+
+#include
+#include
+#include
+#include
+#include
+#include
+#include
+#include
+#include
+#include
+#include
+
+#define ADDRESS_SPACE_LIMIT (100 * 1024 * 1024)
+#include
+
+#if defined __GNUC__
+#define ATTRIBUTE_PRINTF(x, y) __attribute__ ((format (printf, x, y)))
+#else // ! __GNUC__
+#define ATTRIBUTE_PRINTF(x, y)
+#endif // ! __GNUC__
+
+#define N_ELEMENTS(a) (sizeof (a) / sizeof ((a)[0]))
+
+// --- Utilities ---------------------------------------------------------------
+
+static char *strdup_printf (const char *format, ...) ATTRIBUTE_PRINTF (1, 2);
+
+static char *
+strdup_vprintf (const char *format, va_list ap)
+{
+ va_list aq;
+ va_copy (aq, ap);
+ int size = vsnprintf (NULL, 0, format, aq);
+ va_end (aq);
+ if (size < 0)
+ return NULL;
+
+ char buf[size + 1];
+ size = vsnprintf (buf, sizeof buf, format, ap);
+ if (size < 0)
+ return NULL;
+
+ return strdup (buf);
+}
+
+static char *
+strdup_printf (const char *format, ...)
+{
+ va_list ap;
+ va_start (ap, format);
+ char *result = strdup_vprintf (format, ap);
+ va_end (ap);
+ return result;
+}
+
+// --- Generic buffer ----------------------------------------------------------
+
+struct buffer
+{
+ char *s; ///< Buffer data
+ size_t alloc; ///< Number of bytes allocated
+ size_t len; ///< Number of bytes used
+ bool memory_failure; ///< Memory allocation failed
+};
+
+#define BUFFER_INITIALIZER { NULL, 0, 0, false }
+
+static bool
+buffer_append (struct buffer *self, const void *s, size_t n)
+{
+ if (self->memory_failure)
+ return false;
+
+ if (!self->s)
+ self->s = malloc (self->alloc = 8);
+ while (self->len + n > self->alloc)
+ self->s = realloc (self->s, self->alloc <<= 1);
+
+ if (!self->s)
+ {
+ self->memory_failure = true;
+ return false;
+ }
+
+ memcpy (self->s + self->len, s, n);
+ self->len += n;
+ return true;
+}
+
+inline static bool
+buffer_append_c (struct buffer *self, char c)
+{
+ return buffer_append (self, &c, 1);
+}
+
+// --- Data types --------------------------------------------------------------
+
+enum item_type
+{
+ ITEM_STRING,
+ ITEM_WORD,
+ ITEM_INTEGER,
+ ITEM_FLOAT,
+ ITEM_LIST
+};
+
+struct item
+{
+#define ITEM_HEADER \
+ enum item_type type; /**< The type of this object */ \
+ struct item *next; /**< Next item on the list/stack */
+
+ ITEM_HEADER
+};
+
+struct item_string
+{
+ ITEM_HEADER
+ size_t len; ///< Length of the string (sans '\0')
+ char value[]; ///< The null-terminated string value
+};
+
+#define get_string(item) \
+ (assert ((item)->type == ITEM_STRING), \
+ ((struct item_string *)(item))->value)
+
+/// It looks like a string but it doesn't quack like a string
+#define item_word item_string
+
+#define get_word(item) \
+ (assert ((item)->type == ITEM_WORD), \
+ ((struct item_word *)(item))->value)
+
+struct item_integer
+{
+ ITEM_HEADER
+ long long value; ///< The integer value
+};
+
+#define get_integer(item) \
+ (assert ((item)->type == ITEM_INTEGER), \
+ ((struct item_integer *)(item))->value)
+
+struct item_float
+{
+ ITEM_HEADER
+ long double value; ///< The floating point value
+};
+
+#define get_float(item) \
+ (assert ((item)->type == ITEM_FLOAT), \
+ ((struct item_float *)(item))->value)
+
+struct item_list
+{
+ ITEM_HEADER
+ struct item *head; ///< The head of the list
+};
+
+#define get_list(item) \
+ (assert ((item)->type == ITEM_LIST), \
+ ((struct item_list *)(item))->head)
+
+#define set_list(item, head_) \
+ (assert ((item)->type == ITEM_LIST), \
+ item_free_list (((struct item_list *)(item))->head), \
+ ((struct item_list *)(item))->head = (head_))
+
+const char *
+item_type_to_str (enum item_type type)
+{
+ switch (type)
+ {
+ case ITEM_STRING: return "string";
+ case ITEM_WORD: return "word";
+ case ITEM_INTEGER: return "integer";
+ case ITEM_FLOAT: return "float";
+ case ITEM_LIST: return "list";
+ }
+ abort ();
+}
+
+// --- Item management ---------------------------------------------------------
+
+static void item_free_list (struct item *);
+static struct item *new_clone_list (const struct item *);
+
+static void
+item_free (struct item *item)
+{
+ if (item->type == ITEM_LIST)
+ item_free_list (get_list (item));
+ free (item);
+}
+
+static void
+item_free_list (struct item *item)
+{
+ while (item)
+ {
+ struct item *link = item;
+ item = item->next;
+ item_free (link);
+ }
+}
+
+static struct item *
+new_clone (const struct item *item)
+{
+ size_t size;
+ switch (item->type)
+ {
+ case ITEM_STRING:
+ case ITEM_WORD:
+ {
+ const struct item_string *x = (const struct item_string *) item;
+ size = sizeof *x + x->len + 1;
+ break;
+ }
+ case ITEM_INTEGER: size = sizeof (struct item_integer); break;
+ case ITEM_FLOAT: size = sizeof (struct item_float); break;
+ case ITEM_LIST: size = sizeof (struct item_list); break;
+ }
+
+ struct item *clone = malloc (size);
+ if (!clone)
+ return NULL;
+
+ memcpy (clone, item, size);
+ if (item->type == ITEM_LIST)
+ {
+ struct item_list *x = (struct item_list *) clone;
+ if (x->head && !(x->head = new_clone_list (x->head)))
+ {
+ free (clone);
+ return NULL;
+ }
+ }
+ clone->next = NULL;
+ return clone;
+}
+
+static struct item *
+new_clone_list (const struct item *item)
+{
+ struct item *head = NULL, *clone;
+ for (struct item **out = &head; item; item = item->next)
+ {
+ if (!(clone = *out = new_clone (item)))
+ {
+ item_free_list (head);
+ return NULL;
+ }
+ clone->next = NULL;
+ out = &clone->next;
+ }
+ return head;
+}
+
+static struct item *
+new_string (const char *s, ssize_t len)
+{
+ if (len < 0)
+ len = strlen (s);
+
+ struct item_string *item = calloc (1, sizeof *item + len + 1);
+ if (!item)
+ return NULL;
+
+ item->type = ITEM_STRING;
+ item->len = len;
+ memcpy (item->value, s, len);
+ item->value[len] = '\0';
+ return (struct item *) item;
+}
+
+static struct item *
+new_word (const char *s, ssize_t len)
+{
+ struct item *item = new_string (s, len);
+ if (!item)
+ return NULL;
+
+ item->type = ITEM_WORD;
+ return item;
+}
+
+static struct item *
+new_integer (long long value)
+{
+ struct item_integer *item = calloc (1, sizeof *item);
+ if (!item)
+ return NULL;
+
+ item->type = ITEM_INTEGER;
+ item->value = value;
+ return (struct item *) item;
+}
+
+static struct item *
+new_float (long double value)
+{
+ struct item_float *item = calloc (1, sizeof *item);
+ if (!item)
+ return NULL;
+
+ item->type = ITEM_FLOAT;
+ item->value = value;
+ return (struct item *) item;
+}
+
+static struct item *
+new_list (struct item *head)
+{
+ struct item_list *item = calloc (1, sizeof *item);
+ if (!item)
+ return NULL;
+
+ item->type = ITEM_LIST;
+ item->head = head;
+ return (struct item *) item;
+}
+
+// --- Parsing -----------------------------------------------------------------
+
+#define PARSE_ERROR_TABLE(XX) \
+ XX( OK, NULL ) \
+ XX( EOF, "unexpected end of input" ) \
+ XX( INVALID_HEXA_ESCAPE, "invalid hexadecimal escape sequence" ) \
+ XX( INVALID_ESCAPE, "unrecognized escape sequence" ) \
+ XX( MEMORY, "memory allocation failure" ) \
+ XX( FLOAT_RANGE, "floating point value out of range" ) \
+ XX( INTEGER_RANGE, "integer out of range" ) \
+ XX( INVALID_INPUT, "invalid input" ) \
+ XX( UNEXPECTED_INPUT, "unexpected input" )
+
+enum tokenizer_error
+{
+#define XX(x, y) PARSE_ERROR_ ## x,
+ PARSE_ERROR_TABLE (XX)
+#undef XX
+ PARSE_ERROR_COUNT
+};
+
+struct tokenizer
+{
+ const char *cursor;
+ enum tokenizer_error error;
+};
+
+static bool
+decode_hexa_escape (struct tokenizer *self, struct buffer *buf)
+{
+ int i;
+ char c, code = 0;
+
+ for (i = 0; i < 2; i++)
+ {
+ c = tolower (*self->cursor);
+ if (c >= '0' && c <= '9')
+ code = (code << 4) | (c - '0');
+ else if (c >= 'a' && c <= 'f')
+ code = (code << 4) | (c - 'a' + 10);
+ else
+ break;
+
+ self->cursor++;
+ }
+
+ if (!i)
+ return false;
+
+ buffer_append_c (buf, code);
+ return true;
+}
+
+static bool
+decode_octal_escape (struct tokenizer *self, struct buffer *buf)
+{
+ int i;
+ char c, code = 0;
+
+ for (i = 0; i < 3; i++)
+ {
+ c = *self->cursor;
+ if (c < '0' || c > '7')
+ break;
+
+ code = (code << 3) | (c - '0');
+ self->cursor++;
+ }
+
+ if (!i)
+ return false;
+
+ buffer_append_c (buf, code);
+ return true;
+}
+
+static bool
+decode_escape_sequence (struct tokenizer *self, struct buffer *buf)
+{
+ // Support some basic escape sequences from the C language
+ char c;
+ switch ((c = *self->cursor))
+ {
+ case '\0':
+ self->error = PARSE_ERROR_EOF;
+ return false;
+ case 'x':
+ case 'X':
+ self->cursor++;
+ if (decode_hexa_escape (self, buf))
+ return true;
+
+ self->error = PARSE_ERROR_INVALID_HEXA_ESCAPE;
+ return false;
+ default:
+ if (decode_octal_escape (self, buf))
+ return true;
+
+ self->cursor++;
+ const char *from = "abfnrtv\"\\", *to = "\a\b\f\n\r\t\v\"\\", *x;
+ if ((x = strchr (from, c)))
+ {
+ buffer_append_c (buf, to[x - from]);
+ return true;
+ }
+
+ self->error = PARSE_ERROR_INVALID_ESCAPE;
+ return false;
+ }
+}
+
+static struct item *
+parse_string (struct tokenizer *self)
+{
+ struct buffer buf = BUFFER_INITIALIZER;
+ struct item *item = NULL;
+ char c;
+
+ while (true)
+ switch ((c = *self->cursor++))
+ {
+ case '\0':
+ self->cursor--;
+ self->error = PARSE_ERROR_EOF;
+ goto end;
+ case '"':
+ if (buf.memory_failure
+ || !(item = new_string (buf.s, buf.len)))
+ self->error = PARSE_ERROR_MEMORY;
+ goto end;
+ case '\\':
+ if (decode_escape_sequence (self, &buf))
+ break;
+ goto end;
+ default:
+ buffer_append_c (&buf, c);
+ }
+
+end:
+ free (buf.s);
+ return item;
+}
+
+static struct item *
+try_parse_number (struct tokenizer *self)
+{
+ // These two standard library functions can digest a lot of various inputs,
+ // including NaN and +/- infinity. That may get a bit confusing.
+ char *float_end;
+ errno = 0;
+ long double float_value = strtold (self->cursor, &float_end);
+ int float_errno = errno;
+
+ char *int_end;
+ errno = 0;
+ long long int_value = strtoll (self->cursor, &int_end, 10);
+ int int_errno = errno;
+
+ // If they both fail, then this is most probably not a number.
+ if (float_end == int_end && float_end == self->cursor)
+ return NULL;
+
+ // Only use the floating point result if it parses more characters:
+ struct item *item;
+ if (float_end > int_end)
+ {
+ if (float_errno == ERANGE)
+ {
+ self->error = PARSE_ERROR_FLOAT_RANGE;
+ return NULL;
+ }
+ self->cursor = float_end;
+ if (!(item = new_float (float_value)))
+ self->error = PARSE_ERROR_MEMORY;
+ return item;
+ }
+ else
+ {
+ if (int_errno == ERANGE)
+ {
+ self->error = PARSE_ERROR_INTEGER_RANGE;
+ return NULL;
+ }
+ self->cursor = int_end;
+ if (!(item = new_integer (int_value)))
+ self->error = PARSE_ERROR_MEMORY;
+ return item;
+ }
+}
+
+static struct item *
+parse_word (struct tokenizer *self)
+{
+ struct buffer buf = BUFFER_INITIALIZER;
+ struct item *item = NULL;
+ char c;
+
+ // Here we accept almost anything that doesn't break the grammar
+ while (!strchr (" []\"", (c = *self->cursor++)) && (unsigned char) c > ' ')
+ buffer_append_c (&buf, c);
+ self->cursor--;
+
+ if (buf.memory_failure)
+ self->error = PARSE_ERROR_MEMORY;
+ else if (!buf.len)
+ self->error = PARSE_ERROR_INVALID_INPUT;
+ else if (!(item = new_word (buf.s, buf.len)))
+ self->error = PARSE_ERROR_MEMORY;
+
+ free (buf.s);
+ return item;
+}
+
+static struct item *parse_item_list (struct tokenizer *);
+
+static struct item *
+parse_list (struct tokenizer *self)
+{
+ struct item *list = parse_item_list (self);
+ if (self->error)
+ {
+ assert (list == NULL);
+ return NULL;
+ }
+ if (!*self->cursor)
+ {
+ self->error = PARSE_ERROR_EOF;
+ item_free_list (list);
+ return NULL;
+ }
+ assert (*self->cursor == ']');
+ self->cursor++;
+ return new_list (list);
+}
+
+static struct item *
+parse_item (struct tokenizer *self)
+{
+ char c;
+ switch ((c = *self->cursor++))
+ {
+ case '[': return parse_list (self);
+ case '"': return parse_string (self);
+ default:;
+ }
+
+ self->cursor--;
+ struct item *item = try_parse_number (self);
+ if (!item && !self->error)
+ item = parse_word (self);
+ return item;
+}
+
+static struct item *
+parse_item_list (struct tokenizer *self)
+{
+ struct item *head = NULL;
+ struct item **tail = &head;
+
+ char c;
+ bool expected = true;
+ while ((c = *self->cursor) && c != ']')
+ {
+ if (isspace (c))
+ {
+ self->cursor++;
+ expected = true;
+ continue;
+ }
+ else if (!expected)
+ {
+ self->error = PARSE_ERROR_UNEXPECTED_INPUT;
+ goto fail;
+ }
+
+ if (!(*tail = parse_item (self)))
+ goto fail;
+ tail = &(*tail)->next;
+ expected = false;
+ }
+ return head;
+
+fail:
+ item_free_list (head);
+ return NULL;
+}
+
+static struct item *
+parse (const char *s, const char **error)
+{
+ struct tokenizer self = { .cursor = s, .error = PARSE_ERROR_OK };
+ struct item *list = parse_item_list (&self);
+ if (!self.error && *self.cursor != '\0')
+ {
+ self.error = PARSE_ERROR_UNEXPECTED_INPUT;
+ item_free_list (list);
+ list = NULL;
+ }
+
+#define XX(x, y) y,
+ static const char *strings[PARSE_ERROR_COUNT] =
+ { PARSE_ERROR_TABLE (XX) };
+#undef XX
+
+ static char error_buf[128];
+ if (self.error && error)
+ {
+ snprintf (error_buf, sizeof error_buf, "at character %d: %s",
+ (int) (self.cursor - s) + 1, strings[self.error]);
+ *error = error_buf;
+ }
+ return list;
+}
+
+// --- Runtime -----------------------------------------------------------------
+
+// TODO: try to think of a _simple_ way to do preemptive multitasking
+
+struct context
+{
+ struct item *stack; ///< The current top of the stack
+ size_t stack_size; ///< Number of items on the stack
+
+ size_t reduction_count; ///< # of function calls so far
+ size_t reduction_limit; ///< The hard limit on function calls
+
+ char *error; ///< Error information
+ bool error_is_fatal; ///< Whether the error can be catched
+ bool memory_failure; ///< Memory allocation failure
+
+ void *user_data; ///< User data
+};
+
+/// Internal handler for a function
+typedef bool (*handler_fn) (struct context *);
+
+struct fn
+{
+ struct fn *next; ///< The next link in the chain
+
+ handler_fn handler; ///< Internal C handler, or NULL
+ struct item *script; ///< Alternatively runtime code
+ char name[]; ///< The name of the function
+};
+
+struct fn *g_functions; ///< Maps words to functions
+
+static void
+context_init (struct context *ctx)
+{
+ ctx->stack = NULL;
+ ctx->stack_size = 0;
+
+ ctx->reduction_count = 0;
+ ctx->reduction_limit = 2000;
+
+ ctx->error = NULL;
+ ctx->error_is_fatal = false;
+ ctx->memory_failure = false;
+
+ ctx->user_data = NULL;
+}
+
+static void
+context_free (struct context *ctx)
+{
+ item_free_list (ctx->stack);
+ ctx->stack = NULL;
+
+ free (ctx->error);
+ ctx->error = NULL;
+}
+
+static bool
+set_error (struct context *ctx, const char *format, ...)
+{
+ free (ctx->error);
+
+ va_list ap;
+ va_start (ap, format);
+ ctx->error = strdup_vprintf (format, ap);
+ va_end (ap);
+
+ if (!ctx->error)
+ ctx->memory_failure = true;
+ return false;
+}
+
+static bool
+push (struct context *ctx, struct item *item)
+{
+ // The `item' is typically a result from new_(), thus when it is null,
+ // that function must have failed. This is a shortcut for convenience.
+ if (!item)
+ {
+ ctx->memory_failure = true;
+ return false;
+ }
+
+ assert (item->next == NULL);
+ item->next = ctx->stack;
+ ctx->stack = item;
+ ctx->stack_size++;
+ return true;
+}
+
+static bool
+bump_reductions (struct context *ctx)
+{
+ if (++ctx->reduction_count >= ctx->reduction_limit)
+ {
+ ctx->error_is_fatal = true;
+ return set_error (ctx, "reduction limit reached");
+ }
+ return true;
+}
+
+static bool execute (struct context *, struct item *);
+
+static bool
+call_function (struct context *ctx, const char *name)
+{
+ struct fn *iter;
+ for (iter = g_functions; iter; iter = iter->next)
+ if (!strcmp (name, iter->name))
+ goto found;
+ return set_error (ctx, "unknown function: %s", name);
+
+found:
+ if (!bump_reductions (ctx))
+ return false;
+
+ if (iter->handler
+ ? iter->handler (ctx)
+ : execute (ctx, iter->script))
+ return true;
+
+ // In this case, `error' is NULL
+ if (ctx->memory_failure)
+ return false;
+
+ // This creates some form of a stack trace
+ char *tmp = ctx->error;
+ ctx->error = NULL;
+ set_error (ctx, "%s -> %s", name, tmp);
+ free (tmp);
+ return false;
+}
+
+static void
+free_function (struct fn *fn)
+{
+ item_free_list (fn->script);
+ free (fn);
+}
+
+static void
+unregister_function (const char *name)
+{
+ for (struct fn **iter = &g_functions; *iter; iter = &(*iter)->next)
+ if (!strcmp ((*iter)->name, name))
+ {
+ struct fn *tmp = *iter;
+ *iter = tmp->next;
+ free_function (tmp);
+ break;
+ }
+}
+
+static struct fn *
+prepend_new_fn (const char *name)
+{
+ struct fn *fn = calloc (1, sizeof *fn + strlen (name) + 1);
+ if (!fn)
+ return NULL;
+
+ strcpy (fn->name, name);
+ fn->next = g_functions;
+ return g_functions = fn;
+}
+
+static bool
+register_handler (const char *name, handler_fn handler)
+{
+ unregister_function (name);
+ struct fn *fn = prepend_new_fn (name);
+ if (!fn)
+ return false;
+ fn->handler = handler;
+ return true;
+}
+
+static bool
+register_script (const char *name, struct item *script)
+{
+ unregister_function (name);
+ struct fn *fn = prepend_new_fn (name);
+ if (!fn)
+ return false;
+ fn->script = script;
+ return true;
+}
+
+static bool
+execute (struct context *ctx, struct item *script)
+{
+ for (; script; script = script->next)
+ {
+ if (script->type != ITEM_WORD)
+ {
+ if (!bump_reductions (ctx)
+ || !push (ctx, new_clone (script)))
+ return false;
+ }
+ else if (!call_function (ctx, get_word (script)))
+ return false;
+ }
+ return true;
+}
+
+// --- Runtime library ---------------------------------------------------------
+
+#define defn(name) static bool name (struct context *ctx)
+
+#define check_stack(n) \
+ if (ctx->stack_size < n) { \
+ set_error (ctx, "stack underflow"); \
+ return 0; \
+ }
+
+inline static bool
+check_stack_safe (struct context *ctx, size_t n)
+{
+ check_stack (n);
+ return true;
+}
+
+static bool
+check_type (struct context *ctx, const void *item_, enum item_type type)
+{
+ const struct item *item = item_;
+ if (item->type == type)
+ return true;
+
+ return set_error (ctx, "invalid type: expected `%s', got `%s'",
+ item_type_to_str (type), item_type_to_str (item->type));
+}
+
+static struct item *
+pop (struct context *ctx)
+{
+ check_stack (1);
+ struct item *top = ctx->stack;
+ ctx->stack = top->next;
+ top->next = NULL;
+ ctx->stack_size--;
+ return top;
+}
+
+// - - Types - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+#define defn_is_type(name, item_type) \
+ defn (fn_is_##name) { \
+ check_stack (1); \
+ struct item *top = pop (ctx); \
+ push (ctx, new_integer (top->type == (item_type))); \
+ item_free (top); \
+ return true; \
+ }
+
+defn_is_type (string, ITEM_STRING)
+defn_is_type (word, ITEM_WORD)
+defn_is_type (integer, ITEM_INTEGER)
+defn_is_type (float, ITEM_FLOAT)
+defn_is_type (list, ITEM_LIST)
+
+defn (fn_to_string)
+{
+ check_stack (1);
+ struct item *item = pop (ctx);
+ char *value;
+
+ switch (item->type)
+ {
+ case ITEM_WORD:
+ item->type = ITEM_STRING;
+ case ITEM_STRING:
+ return push (ctx, item);
+
+ case ITEM_FLOAT:
+ value = strdup_printf ("%Lf", get_float (item));
+ break;
+ case ITEM_INTEGER:
+ value = strdup_printf ("%lld", get_integer (item));
+ break;
+
+ default:
+ set_error (ctx, "cannot convert `%s' to `%s'",
+ item_type_to_str (item->type), item_type_to_str (ITEM_STRING));
+ item_free (item);
+ return false;
+ }
+
+ item_free (item);
+ if (!value)
+ {
+ ctx->memory_failure = true;
+ return false;
+ }
+
+ item = new_string (value, -1);
+ free (value);
+ return push (ctx, item);
+}
+
+defn (fn_to_integer)
+{
+ check_stack (1);
+ struct item *item = pop (ctx);
+ long long value;
+
+ switch (item->type)
+ {
+ case ITEM_INTEGER:
+ return push (ctx, item);
+ case ITEM_FLOAT:
+ value = get_float (item);
+ break;
+
+ case ITEM_STRING:
+ {
+ char *end;
+ const char *s = get_string (item);
+ value = strtoll (s, &end, 10);
+ if (end != s && *s == '\0')
+ break;
+
+ item_free (item);
+ return set_error (ctx, "integer conversion error");
+ }
+
+ default:
+ set_error (ctx, "cannot convert `%s' to `%s'",
+ item_type_to_str (item->type), item_type_to_str (ITEM_INTEGER));
+ item_free (item);
+ return false;
+ }
+
+ item_free (item);
+ return push (ctx, new_integer (value));
+}
+
+defn (fn_to_float)
+{
+ check_stack (1);
+ struct item *item = pop (ctx);
+ long double value;
+
+ switch (item->type)
+ {
+ case ITEM_FLOAT:
+ return push (ctx, item);
+ case ITEM_INTEGER:
+ value = get_integer (item);
+ break;
+
+ case ITEM_STRING:
+ {
+ char *end;
+ const char *s = get_string (item);
+ value = strtold (s, &end);
+ if (end != s && *s == '\0')
+ break;
+
+ item_free (item);
+ return set_error (ctx, "float conversion error");
+ }
+
+ default:
+ set_error (ctx, "cannot convert `%s' to `%s'",
+ item_type_to_str (item->type), item_type_to_str (ITEM_FLOAT));
+ item_free (item);
+ return false;
+ }
+
+ item_free (item);
+ return push (ctx, new_float (value));
+}
+
+// - - Miscellaneous - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+defn (fn_length)
+{
+ check_stack (1);
+ struct item *item = pop (ctx);
+ bool success = true;
+ switch (item->type)
+ {
+ case ITEM_STRING:
+ success = push (ctx, new_integer (((struct item_string *) item)->len));
+ break;
+ case ITEM_LIST:
+ {
+ long long length = 0;
+ struct item *iter;
+ for (iter = get_list (item); iter; iter = iter->next)
+ length++;
+ success = push (ctx, new_integer (length));
+ break;
+ }
+ default:
+ success = set_error (ctx, "invalid type");
+ }
+ item_free (item);
+ return success;
+}
+
+// - - Stack operations - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+defn (fn_dup)
+{
+ check_stack (1);
+ return push (ctx, new_clone (ctx->stack));
+}
+
+defn (fn_drop)
+{
+ check_stack (1);
+ item_free (pop (ctx));
+ return true;
+}
+
+defn (fn_swap)
+{
+ check_stack (2);
+ struct item *second = pop (ctx), *first = pop (ctx);
+ return push (ctx, second) && push (ctx, first);
+}
+
+defn (fn_call)
+{
+ check_stack (1);
+ struct item *script = pop (ctx);
+ bool success = check_type (ctx, script, ITEM_LIST)
+ && execute (ctx, get_list (script));
+ item_free (script);
+ return success;
+}
+
+defn (fn_dip)
+{
+ check_stack (2);
+ struct item *script = pop (ctx);
+ struct item *item = pop (ctx);
+ bool success = check_type (ctx, script, ITEM_LIST)
+ && execute (ctx, get_list (script));
+ item_free (script);
+ if (!success)
+ {
+ item_free (item);
+ return false;
+ }
+ return push (ctx, item);
+}
+
+defn (fn_unit)
+{
+ check_stack (1);
+ struct item *item = pop (ctx);
+ return push (ctx, new_list (item));
+}
+
+defn (fn_cons)
+{
+ check_stack (2);
+ struct item *list = pop (ctx);
+ struct item *item = pop (ctx);
+ if (!check_type (ctx, list, ITEM_LIST))
+ {
+ item_free (list);
+ item_free (item);
+ return false;
+ }
+ item->next = get_list (list);
+ ((struct item_list *) list)->head = item;
+ return push (ctx, list);
+}
+
+defn (fn_cat)
+{
+ check_stack (2);
+ struct item *scnd = pop (ctx);
+ struct item *frst = pop (ctx);
+ if (!check_type (ctx, frst, ITEM_LIST)
+ || !check_type (ctx, scnd, ITEM_LIST))
+ {
+ item_free (frst);
+ item_free (scnd);
+ return false;
+ }
+
+ // XXX: we shouldn't have to do this in O(n)
+ struct item **tail = &((struct item_list *) frst)->head;
+ while (*tail)
+ tail = &(*tail)->next;
+ *tail = get_list (scnd);
+
+ ((struct item_list *) scnd)->head = NULL;
+ item_free (scnd);
+ return push (ctx, frst);
+}
+
+defn (fn_uncons)
+{
+ check_stack (1);
+ struct item *list = pop (ctx);
+ if (!check_type (ctx, list, ITEM_LIST))
+ goto fail;
+ struct item *first = get_list (list);
+ if (!first)
+ {
+ set_error (ctx, "list is empty");
+ goto fail;
+ }
+ ((struct item_list *) list)->head = first->next;
+ first->next = NULL;
+ return push (ctx, first) && push (ctx, list);
+fail:
+ item_free (list);
+ return false;
+}
+
+// - - Logical - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+static bool
+to_boolean (struct context *ctx, struct item *item, bool *ok)
+{
+ switch (item->type)
+ {
+ case ITEM_STRING:
+ return *get_string (item) != '\0';
+ case ITEM_INTEGER:
+ return get_integer (item) != 0;
+ case ITEM_FLOAT:
+ return get_float (item) != 0.;
+ default:
+ return (*ok = set_error (ctx, "cannot convert `%s' to boolean",
+ item_type_to_str (item->type)));
+ }
+}
+
+defn (fn_not)
+{
+ check_stack (1);
+ struct item *item = pop (ctx);
+ bool ok = true;
+ bool result = !to_boolean (ctx, item, &ok);
+ item_free (item);
+ return ok && push (ctx, new_integer (result));
+}
+
+defn (fn_and)
+{
+ check_stack (2);
+ struct item *op1 = pop (ctx);
+ struct item *op2 = pop (ctx);
+ bool ok = true;
+ bool result = to_boolean (ctx, op1, &ok) && to_boolean (ctx, op2, &ok);
+ item_free (op1);
+ item_free (op2);
+ return ok && push (ctx, new_integer (result));
+}
+
+defn (fn_or)
+{
+ check_stack (2);
+ struct item *op1 = pop (ctx);
+ struct item *op2 = pop (ctx);
+ bool ok = true;
+ bool result = to_boolean (ctx, op1, &ok)
+ || !ok || to_boolean (ctx, op2, &ok);
+ item_free (op1);
+ item_free (op2);
+ return ok && push (ctx, new_integer (result));
+}
+
+// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+defn (fn_if)
+{
+ check_stack (3);
+ struct item *else_ = pop (ctx);
+ struct item *then_ = pop (ctx);
+ struct item *cond_ = pop (ctx);
+
+ bool ok = true;
+ bool condition = to_boolean (ctx, cond_, &ok);
+ item_free (cond_);
+
+ bool success = false;
+ if (ok
+ && check_type (ctx, then_, ITEM_LIST)
+ && check_type (ctx, else_, ITEM_LIST))
+ success = execute (ctx, condition
+ ? get_list (then_)
+ : get_list (else_));
+
+ item_free (then_);
+ item_free (else_);
+ return success;
+}
+
+defn (fn_try)
+{
+ check_stack (2);
+ struct item *catch = pop (ctx);
+ struct item *try = pop (ctx);
+ bool success = false;
+ if (!check_type (ctx, try, ITEM_LIST)
+ || !check_type (ctx, catch, ITEM_LIST))
+ goto fail;
+
+ if (!execute (ctx, get_list (try)))
+ {
+ if (ctx->memory_failure || ctx->error_is_fatal)
+ goto fail;
+
+ success = push (ctx, new_string (ctx->error, -1));
+ free (ctx->error);
+ ctx->error = NULL;
+
+ if (success)
+ success = execute (ctx, get_list (catch));
+ }
+
+fail:
+ item_free (try);
+ item_free (catch);
+ return success;
+}
+
+defn (fn_map)
+{
+ check_stack (2);
+ struct item *fn = pop (ctx);
+ struct item *list = pop (ctx);
+ if (!check_type (ctx, fn, ITEM_LIST)
+ || !check_type (ctx, list, ITEM_LIST))
+ {
+ item_free (fn);
+ item_free (list);
+ return false;
+ }
+
+ bool success = false;
+ struct item *result = NULL, **tail = &result;
+ for (struct item *iter = get_list (list); iter; iter = iter->next)
+ {
+ if (!push (ctx, new_clone (iter))
+ || !execute (ctx, get_list (fn))
+ || !check_stack_safe (ctx, 1))
+ goto fail;
+
+ struct item *item = pop (ctx);
+ *tail = item;
+ tail = &item->next;
+ }
+ success = true;
+
+fail:
+ set_list (list, result);
+ item_free (fn);
+ if (!success)
+ {
+ item_free (list);
+ return false;
+ }
+ return push (ctx, list);
+}
+
+defn (fn_filter)
+{
+ check_stack (2);
+ struct item *fn = pop (ctx);
+ struct item *list = pop (ctx);
+ if (!check_type (ctx, fn, ITEM_LIST)
+ || !check_type (ctx, list, ITEM_LIST))
+ {
+ item_free (fn);
+ item_free (list);
+ return false;
+ }
+
+ bool success = false;
+ bool ok = true;
+ struct item *result = NULL, **tail = &result;
+ for (struct item *iter = get_list (list); iter; iter = iter->next)
+ {
+ if (!push (ctx, new_clone (iter))
+ || !execute (ctx, get_list (fn))
+ || !check_stack_safe (ctx, 1))
+ goto fail;
+
+ struct item *item = pop (ctx);
+ bool survived = to_boolean (ctx, item, &ok);
+ item_free (item);
+ if (!ok)
+ goto fail;
+ if (!survived)
+ continue;
+
+ if (!(item = new_clone (iter)))
+ goto fail;
+ *tail = item;
+ tail = &item->next;
+ }
+ success = true;
+
+fail:
+ set_list (list, result);
+ item_free (fn);
+ if (!success)
+ {
+ item_free (list);
+ return false;
+ }
+ return push (ctx, list);
+}
+
+defn (fn_fold)
+{
+ check_stack (3);
+ struct item *op = pop (ctx);
+ struct item *null = pop (ctx);
+ struct item *list = pop (ctx);
+ bool success = false;
+ if (!check_type (ctx, op, ITEM_LIST)
+ || !check_type (ctx, list, ITEM_LIST))
+ {
+ item_free (null);
+ goto fail;
+ }
+
+ push (ctx, null);
+ for (struct item *iter = get_list (list); iter; iter = iter->next)
+ if (!push (ctx, new_clone (iter))
+ || !execute (ctx, get_list (op)))
+ goto fail;
+ success = true;
+
+fail:
+ item_free (op);
+ item_free (list);
+ return success;
+}
+
+defn (fn_each)
+{
+ check_stack (2);
+ struct item *op = pop (ctx);
+ struct item *list = pop (ctx);
+ bool success = false;
+ if (!check_type (ctx, op, ITEM_LIST)
+ || !check_type (ctx, list, ITEM_LIST))
+ goto fail;
+
+ for (struct item *iter = get_list (list); iter; iter = iter->next)
+ if (!push (ctx, new_clone (iter))
+ || !execute (ctx, get_list (op)))
+ goto fail;
+ success = true;
+
+fail:
+ item_free (op);
+ item_free (list);
+ return success;
+}
+
+// - - Arithmetic - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+// XXX: why not a `struct item_string *` argument?
+static bool
+push_repeated_string (struct context *ctx, struct item *op1, struct item *op2)
+{
+ struct item_string *string = (struct item_string *) op1;
+ struct item_integer *repeat = (struct item_integer *) op2;
+ assert (string->type == ITEM_STRING);
+ assert (repeat->type == ITEM_INTEGER);
+
+ if (repeat->value < 0)
+ return set_error (ctx, "cannot multiply a string by a negative value");
+
+ char *buf = NULL;
+ size_t len = string->len * repeat->value;
+ if (len < string->len && repeat->value != 0)
+ goto allocation_fail;
+
+ buf = malloc (len);
+ if (!buf)
+ goto allocation_fail;
+
+ for (size_t i = 0; i < len; i += string->len)
+ memcpy (buf + i, string->value, string->len);
+ struct item *item = new_string (buf, len);
+ free (buf);
+ return push (ctx, item);
+
+allocation_fail:
+ ctx->memory_failure = true;
+ return false;
+}
+
+defn (fn_times)
+{
+ check_stack (2);
+ struct item *op2 = pop (ctx);
+ struct item *op1 = pop (ctx);
+
+ bool ok;
+ if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_integer (get_integer (op1) * get_integer (op2)));
+ else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (get_integer (op1) * get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (get_float (op1) * get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_float (get_float (op1) * get_integer (op2)));
+ else if (op1->type == ITEM_INTEGER && op2->type == ITEM_STRING)
+ ok = push_repeated_string (ctx, op2, op1);
+ else if (op1->type == ITEM_STRING && op2->type == ITEM_INTEGER)
+ ok = push_repeated_string (ctx, op1, op2);
+ else
+ ok = set_error (ctx, "cannot multiply `%s' and `%s'",
+ item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+ item_free (op1);
+ item_free (op2);
+ return ok;
+}
+
+defn (fn_pow)
+{
+ check_stack (2);
+ struct item *op2 = pop (ctx);
+ struct item *op1 = pop (ctx);
+
+ bool ok;
+ if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+ // TODO: implement this properly, outputting an integer
+ ok = push (ctx, new_float (powl (get_integer (op1), get_integer (op2))));
+ else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (powl (get_integer (op1), get_float (op2))));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (powl (get_float (op1), get_float (op2))));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_float (powl (get_float (op1), get_integer (op2))));
+ else
+ ok = set_error (ctx, "cannot exponentiate `%s' and `%s'",
+ item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+ item_free (op1);
+ item_free (op2);
+ return ok;
+}
+
+defn (fn_div)
+{
+ check_stack (2);
+ struct item *op2 = pop (ctx);
+ struct item *op1 = pop (ctx);
+
+ bool ok;
+ if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+ {
+ if (get_integer (op2) == 0)
+ ok = set_error (ctx, "division by zero");
+ else
+ ok = push (ctx, new_integer (get_integer (op1) / get_integer (op2)));
+ }
+ else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (get_integer (op1) / get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (get_float (op1) / get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_float (get_float (op1) / get_integer (op2)));
+ else
+ ok = set_error (ctx, "cannot divide `%s' and `%s'",
+ item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+ item_free (op1);
+ item_free (op2);
+ return ok;
+}
+
+defn (fn_mod)
+{
+ check_stack (2);
+ struct item *op2 = pop (ctx);
+ struct item *op1 = pop (ctx);
+
+ bool ok;
+ if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+ {
+ if (get_integer (op2) == 0)
+ ok = set_error (ctx, "division by zero");
+ else
+ ok = push (ctx, new_integer (get_integer (op1) % get_integer (op2)));
+ }
+ else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (fmodl (get_integer (op1), get_float (op2))));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (fmodl (get_float (op1), get_float (op2))));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_float (fmodl (get_float (op1), get_integer (op2))));
+ else
+ ok = set_error (ctx, "cannot divide `%s' and `%s'",
+ item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+ item_free (op1);
+ item_free (op2);
+ return ok;
+}
+
+static bool
+push_concatenated_string (struct context *ctx,
+ struct item *op1, struct item *op2)
+{
+ struct item_string *s1 = (struct item_string *) op1;
+ struct item_string *s2 = (struct item_string *) op2;
+ assert (s1->type == ITEM_STRING);
+ assert (s2->type == ITEM_STRING);
+
+ char *buf = NULL;
+ size_t len = s1->len + s2->len;
+ if (len < s1->len || len < s2->len)
+ goto allocation_fail;
+
+ buf = malloc (len);
+ if (!buf)
+ goto allocation_fail;
+
+ memcpy (buf, s1->value, s1->len);
+ memcpy (buf + s1->len, s2->value, s2->len);
+ struct item *item = new_string (buf, len);
+ free (buf);
+ return push (ctx, item);
+
+allocation_fail:
+ ctx->memory_failure = true;
+ return false;
+
+}
+
+defn (fn_plus)
+{
+ check_stack (2);
+ struct item *op2 = pop (ctx);
+ struct item *op1 = pop (ctx);
+
+ bool ok;
+ if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_integer (get_integer (op1) + get_integer (op2)));
+ else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (get_integer (op1) + get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (get_float (op1) + get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_float (get_float (op1) + get_integer (op2)));
+ else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING)
+ ok = push_concatenated_string (ctx, op1, op2);
+ else
+ ok = set_error (ctx, "cannot add `%s' and `%s'",
+ item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+ item_free (op1);
+ item_free (op2);
+ return ok;
+}
+
+defn (fn_minus)
+{
+ check_stack (2);
+ struct item *op2 = pop (ctx);
+ struct item *op1 = pop (ctx);
+
+ bool ok;
+ if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_integer (get_integer (op1) - get_integer (op2)));
+ else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (get_integer (op1) - get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_float (get_float (op1) - get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_float (get_float (op1) - get_integer (op2)));
+ else
+ ok = set_error (ctx, "cannot subtract `%s' and `%s'",
+ item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+ item_free (op1);
+ item_free (op2);
+ return ok;
+}
+
+// - - Comparison - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+static int
+compare_strings (struct item_string *s1, struct item_string *s2)
+{
+ // XXX: not entirely correct wrt. null bytes
+ size_t len = (s1->len < s2->len ? s1->len : s2->len) + 1;
+ return memcmp (s1->value, s2->value, len);
+}
+
+static bool compare_lists (struct item *, struct item *);
+
+static bool
+compare_list_items (struct item *op1, struct item *op2)
+{
+ if (op1->type != op2->type)
+ return false;
+
+ switch (op1->type)
+ {
+ case ITEM_STRING:
+ case ITEM_WORD:
+ return !compare_strings ((struct item_string *) op1,
+ (struct item_string *) op2);
+ case ITEM_FLOAT:
+ return get_float (op1) == get_float (op2);
+ case ITEM_INTEGER:
+ return get_integer (op1) == get_integer (op2);
+ case ITEM_LIST:
+ return compare_lists (get_list (op1), get_list (op2));
+ }
+ abort ();
+}
+
+static bool
+compare_lists (struct item *op1, struct item *op2)
+{
+ while (op1 && op2)
+ {
+ if (!compare_list_items (op1, op2))
+ return false;
+
+ op1 = op1->next;
+ op2 = op2->next;
+ }
+ return !op1 && !op2;
+}
+
+defn (fn_eq)
+{
+ check_stack (2);
+ struct item *op2 = pop (ctx);
+ struct item *op1 = pop (ctx);
+
+ bool ok;
+ if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_integer (get_integer (op1) == get_integer (op2)));
+ else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_integer (get_integer (op1) == get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_integer (get_float (op1) == get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_integer (get_float (op1) == get_integer (op2)));
+ else if (op1->type == ITEM_LIST && op2->type == ITEM_LIST)
+ ok = push (ctx, new_integer (compare_lists
+ (get_list (op1), get_list (op2))));
+ else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING)
+ ok = push (ctx, new_integer (compare_strings
+ ((struct item_string *)(op1), (struct item_string *)(op2)) == 0));
+ else
+ ok = set_error (ctx, "cannot compare `%s' and `%s'",
+ item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+ item_free (op1);
+ item_free (op2);
+ return ok;
+}
+
+defn (fn_lt)
+{
+ check_stack (2);
+ struct item *op2 = pop (ctx);
+ struct item *op1 = pop (ctx);
+
+ bool ok;
+ if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_integer (get_integer (op1) < get_integer (op2)));
+ else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_integer (get_integer (op1) < get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
+ ok = push (ctx, new_integer (get_float (op1) < get_float (op2)));
+ else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
+ ok = push (ctx, new_integer (get_float (op1) < get_integer (op2)));
+ else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING)
+ ok = push (ctx, new_integer (compare_strings
+ ((struct item_string *)(op1), (struct item_string *)(op2)) < 0));
+ else
+ ok = set_error (ctx, "cannot compare `%s' and `%s'",
+ item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+ item_free (op1);
+ item_free (op2);
+ return ok;
+}
+
+// - - Utilities - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+defn (fn_rand)
+{
+ return push (ctx, new_float ((long double) rand ()
+ / ((long double) RAND_MAX + 1)));
+}
+
+defn (fn_time)
+{
+ return push (ctx, new_integer (time (NULL)));
+}
+
+// XXX: this is a bit too constrained; combines strftime() with gmtime()
+defn (fn_strftime)
+{
+ check_stack (2);
+ struct item *format = pop (ctx);
+ struct item *time_ = pop (ctx);
+ bool success = false;
+ if (!check_type (ctx, time_, ITEM_INTEGER)
+ || !check_type (ctx, format, ITEM_STRING))
+ goto fail;
+
+ if (get_integer (time_) < 0)
+ {
+ set_error (ctx, "invalid time value");
+ goto fail;
+ }
+
+ char buf[128];
+ time_t time__ = get_integer (time_);
+ struct tm tm;
+ gmtime_r (&time__, &tm);
+ buf[strftime (buf, sizeof buf, get_string (format), &tm)] = '\0';
+ success = push (ctx, new_string (buf, -1));
+
+fail:
+ item_free (time_);
+ item_free (format);
+ return success;
+}
+
+// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+static void item_list_to_str (const struct item *, struct buffer *);
+
+static void
+string_to_str (const struct item_string *string, struct buffer *buf)
+{
+ buffer_append_c (buf, '"');
+ for (size_t i = 0; i < string->len; i++)
+ {
+ char c = string->value[i];
+ if (c == '\n') buffer_append (buf, "\\n", 2);
+ else if (c == '\r') buffer_append (buf, "\\r", 2);
+ else if (c == '\t') buffer_append (buf, "\\t", 2);
+ else if (!isprint (c))
+ {
+ char tmp[8];
+ snprintf (tmp, sizeof tmp, "\\x%02x", (unsigned char) c);
+ buffer_append (buf, tmp, strlen (tmp));
+ }
+ else if (c == '\\') buffer_append (buf, "\\\\", 2);
+ else if (c == '"') buffer_append (buf, "\\\"", 2);
+ else buffer_append_c (buf, c);
+ }
+ buffer_append_c (buf, '"');
+}
+
+static void
+item_to_str (const struct item *item, struct buffer *buf)
+{
+ switch (item->type)
+ {
+ char *x;
+ case ITEM_STRING:
+ string_to_str ((struct item_string *) item, buf);
+ break;
+ case ITEM_WORD:
+ {
+ struct item_word *word = (struct item_word *) item;
+ buffer_append (buf, word->value, word->len);
+ break;
+ }
+ case ITEM_INTEGER:
+ if (!(x = strdup_printf ("%lld", get_integer (item))))
+ goto alloc_failure;
+ buffer_append (buf, x, strlen (x));
+ free (x);
+ break;
+ case ITEM_FLOAT:
+ if (!(x = strdup_printf ("%Lf", get_float (item))))
+ goto alloc_failure;
+ buffer_append (buf, x, strlen (x));
+ free (x);
+ break;
+ case ITEM_LIST:
+ buffer_append_c (buf, '[');
+ item_list_to_str (get_list (item), buf);
+ buffer_append_c (buf, ']');
+ break;
+ }
+ return;
+
+alloc_failure:
+ // This is a bit hackish but it simplifies stuff
+ buf->memory_failure = true;
+ free (buf->s);
+ buf->s = NULL;
+}
+
+static void
+item_list_to_str (const struct item *script, struct buffer *buf)
+{
+ if (!script)
+ return;
+
+ item_to_str (script, buf);
+ while ((script = script->next))
+ {
+ buffer_append_c (buf, ' ');
+ item_to_str (script, buf);
+ }
+}
+
+// --- IRC protocol ------------------------------------------------------------
+
+struct message
+{
+ char *prefix; ///< Message prefix
+ char *command; ///< IRC command
+ char *params[16]; ///< Command parameters (0-terminated)
+ size_t n_params; ///< Number of parameters present
+};
+
+inline static char *
+cut_word (char **s)
+{
+ char *start = *s, *end = *s + strcspn (*s, " ");
+ *s = end + strspn (end, " ");
+ *end = '\0';
+ return start;
+}
+
+static bool
+parse_message (char *s, struct message *msg)
+{
+ memset (msg, 0, sizeof *msg);
+
+ // Ignore IRC 3.2 message tags, if present
+ if (*s == '@')
+ {
+ s += strcspn (s, " ");
+ s += strspn (s, " ");
+ }
+
+ // Prefix
+ if (*s == ':')
+ msg->prefix = cut_word (&s) + 1;
+
+ // Command
+ if (!*(msg->command = cut_word (&s)))
+ return false;
+
+ // Parameters
+ while (*s)
+ {
+ size_t n = msg->n_params++;
+ if (msg->n_params >= N_ELEMENTS (msg->params))
+ return false;
+ if (*s == ':')
+ {
+ msg->params[n] = ++s;
+ break;
+ }
+ msg->params[n] = cut_word (&s);
+ }
+ return true;
+}
+
+static struct message *
+read_message (void)
+{
+ static bool discard = false;
+ static char buf[1025];
+ static struct message msg;
+
+ bool discard_this;
+ do
+ {
+ if (!fgets (buf, sizeof buf, stdin))
+ return NULL;
+ size_t len = strlen (buf);
+
+ // Just to be on the safe side, if the line overflows our buffer,
+ // ignore everything up until the next line.
+ discard_this = discard;
+ if (len >= 2 && !strcmp (buf + len - 2, "\r\n"))
+ {
+ buf[len -= 2] = '\0';
+ discard = false;
+ }
+ else
+ discard = true;
+ }
+ // Invalid messages are silently ignored
+ while (discard_this || !parse_message (buf, &msg));
+ return &msg;
+}
+
+// --- Interfacing with the bot ------------------------------------------------
+
+#define BOT_PRINT "ZYKLONB print :script: "
+
+static const char *
+get_config (const char *key)
+{
+ printf ("ZYKLONB get_config :%s\r\n", key);
+ struct message *msg = read_message ();
+ if (!msg || msg->n_params <= 0)
+ exit (EXIT_FAILURE);
+ return msg->params[0];
+}
+
+// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+// TODO: implement more functions; try to avoid writing them in C
+
+static bool
+init_runtime_library_scripts (void)
+{
+ bool ok = true;
+
+ // It's much cheaper (and more fun) to define functions in terms of other
+ // ones. The "unit tests" serve a secondary purpose of showing the usage.
+ struct script
+ {
+ const char *name; ///< Name of the function
+ const char *definition; ///< The defining script
+ const char *unit_test; ///< Trivial unit test, must return 1
+ }
+ scripts[] =
+ {
+ { "nip", "swap drop", "1 2 nip 2 =" },
+ { "over", "[dup] dip swap", "1 2 over nip nip 1 =" },
+ { "swons", "swap cons", "[2] 1 swons [1 2] =" },
+ { "first", "uncons drop", "[1 2 3] first 1 =" },
+ { "rest", "uncons swap drop", "[1 2 3] rest [2 3] =" },
+ { "reverse", "[] swap [swap cons] each", "[1 2] reverse [2 1] =" },
+ { "curry", "cons", "1 2 [+] curry call 3 =" },
+
+ { "xor", "not swap not + 1 =", "1 1 xor 0 =" },
+ { "min", "over over < [drop] [nip] if", "1 2 min 1 =" },
+ { "max", "over over > [drop] [nip] if", "1 2 max 2 =" },
+
+ { "all?", "[and] cat 1 swap fold", "[3 4 5] [> 3] all? 0 =" },
+ { "any?", "[or] cat 0 swap fold", "[3 4 5] [> 3] any? 1 =" },
+
+ { ">", "swap <", "1 2 > 0 =" },
+ { "!=", "= not", "1 2 != 1 =" },
+ { "<=", "> not", "1 2 <= 1 =" },
+ { ">=", "< not", "1 2 >= 0 =" },
+
+ // XXX: this is a bit crazy and does not work with an empty list
+ { "join", "[uncons] dip swap [[dup] dip swap [+ +] dip] each drop",
+ "[1 2 3] [>string] map \" -> \" join \"1 -> 2 -> 3\" =" },
+ };
+
+ for (size_t i = 0; i < N_ELEMENTS (scripts); i++)
+ {
+ const char *error = NULL;
+ struct item *script = parse (scripts[i].definition, &error);
+ if (error)
+ {
+ printf (BOT_PRINT "error parsing internal script `%s': %s\r\n",
+ scripts[i].definition, error);
+ ok = false;
+ }
+ else
+ ok &= register_script (scripts[i].name, script);
+ }
+
+ struct context ctx;
+ for (size_t i = 0; i < N_ELEMENTS (scripts); i++)
+ {
+ const char *error = NULL;
+ struct item *script = parse (scripts[i].unit_test, &error);
+ if (error)
+ {
+ printf (BOT_PRINT "error parsing unit test for `%s': %s\r\n",
+ scripts[i].name, error);
+ ok = false;
+ continue;
+ }
+ context_init (&ctx);
+ execute (&ctx, script);
+ item_free_list (script);
+
+ const char *failure = NULL;
+ if (ctx.memory_failure)
+ failure = "memory allocation failure";
+ else if (ctx.error)
+ failure = ctx.error;
+ else if (ctx.stack_size != 1)
+ failure = "too many results on the stack";
+ else if (ctx.stack->type != ITEM_INTEGER)
+ failure = "result is not an integer";
+ else if (get_integer (ctx.stack) != 1)
+ failure = "wrong test result";
+ if (failure)
+ {
+ printf (BOT_PRINT "error executing unit test for `%s': %s\r\n",
+ scripts[i].name, failure);
+ ok = false;
+ }
+ context_free (&ctx);
+ }
+ return ok;
+}
+
+static bool
+init_runtime_library (void)
+{
+ bool ok = true;
+
+ // Type detection
+ ok &= register_handler ("string?", fn_is_string);
+ ok &= register_handler ("word?", fn_is_word);
+ ok &= register_handler ("integer?", fn_is_integer);
+ ok &= register_handler ("float?", fn_is_float);
+ ok &= register_handler ("list?", fn_is_list);
+
+ // Type conversion
+ ok &= register_handler (">string", fn_to_string);
+ ok &= register_handler (">integer", fn_to_integer);
+ ok &= register_handler (">float", fn_to_float);
+
+ // Miscellaneous
+ ok &= register_handler ("length", fn_length);
+
+ // Basic stack manipulation
+ ok &= register_handler ("dup", fn_dup);
+ ok &= register_handler ("drop", fn_drop);
+ ok &= register_handler ("swap", fn_swap);
+
+ // Calling stuff
+ ok &= register_handler ("call", fn_call);
+ ok &= register_handler ("dip", fn_dip);
+
+ // Control flow
+ ok &= register_handler ("if", fn_if);
+ ok &= register_handler ("try", fn_try);
+
+ // List processing
+ ok &= register_handler ("map", fn_map);
+ ok &= register_handler ("filter", fn_filter);
+ ok &= register_handler ("fold", fn_fold);
+ ok &= register_handler ("each", fn_each);
+
+ // List manipulation
+ ok &= register_handler ("unit", fn_unit);
+ ok &= register_handler ("cons", fn_cons);
+ ok &= register_handler ("cat", fn_cat);
+ ok &= register_handler ("uncons", fn_uncons);
+
+ // Arithmetic operations
+ ok &= register_handler ("+", fn_plus);
+ ok &= register_handler ("-", fn_minus);
+ ok &= register_handler ("*", fn_times);
+ ok &= register_handler ("^", fn_pow);
+ ok &= register_handler ("/", fn_div);
+ ok &= register_handler ("%", fn_mod);
+
+ // Comparison
+ ok &= register_handler ("=", fn_eq);
+ ok &= register_handler ("<", fn_lt);
+
+ // Logical operations
+ ok &= register_handler ("not", fn_not);
+ ok &= register_handler ("and", fn_and);
+ ok &= register_handler ("or", fn_or);
+
+ // Utilities
+ ok &= register_handler ("rand", fn_rand);
+ ok &= register_handler ("time", fn_time);
+ ok &= register_handler ("strftime", fn_strftime);
+
+ ok &= init_runtime_library_scripts ();
+ return ok;
+}
+
+static void
+free_runtime_library (void)
+{
+ struct fn *next, *iter;
+ for (iter = g_functions; iter; iter = next)
+ {
+ next = iter->next;
+ free_function (iter);
+ }
+}
+
+// --- Function database -------------------------------------------------------
+
+// TODO: a global variable storing the various procedures (db)
+// XXX: defining procedures would ideally need some kind of an ACL
+
+static void
+read_db (void)
+{
+ // TODO
+}
+
+static void
+write_db (void)
+{
+ // TODO
+}
+
+// --- Main --------------------------------------------------------------------
+
+static char *g_prefix;
+
+struct user_info
+{
+ char *ctx; ///< Context: channel or user
+ char *ctx_quote; ///< Reply quotation
+};
+
+defn (fn_dot)
+{
+ check_stack (1);
+ struct item *item = pop (ctx);
+ struct user_info *info = ctx->user_data;
+
+ struct buffer buf = BUFFER_INITIALIZER;
+ item_to_str (item, &buf);
+ item_free (item);
+ buffer_append_c (&buf, '\0');
+ if (buf.memory_failure)
+ {
+ ctx->memory_failure = true;
+ return false;
+ }
+
+ if (buf.len > 255)
+ buf.s[255] = '\0';
+
+ printf ("PRIVMSG %s :%s%s\r\n", info->ctx, info->ctx_quote, buf.s);
+ free (buf.s);
+ return true;
+}
+
+static void
+process_message (struct message *msg)
+{
+ if (!msg->prefix
+ || strcasecmp (msg->command, "PRIVMSG")
+ || msg->n_params < 2)
+ return;
+ char *line = msg->params[1];
+
+ // Filter out only our commands
+ size_t prefix_len = strlen (g_prefix);
+ if (strncmp (line, g_prefix, prefix_len))
+ return;
+ line += prefix_len;
+
+ char *command = cut_word (&line);
+ if (strcasecmp (command, "script"))
+ return;
+
+ // Retrieve information on how to respond back
+ char *msg_ctx = msg->prefix, *x;
+ if ((x = strchr (msg_ctx, '!')))
+ *x = '\0';
+
+ char *msg_ctx_quote;
+ if (strchr ("#+&!", *msg->params[0]))
+ {
+ msg_ctx_quote = strdup_printf ("%s: ", msg_ctx);
+ msg_ctx = msg->params[0];
+ }
+ else
+ msg_ctx_quote = strdup ("");
+
+ if (!msg_ctx_quote)
+ {
+ printf (BOT_PRINT "%s\r\n", "memory allocation failure");
+ return;
+ }
+
+ struct user_info info;
+ info.ctx = msg_ctx;
+ info.ctx_quote = msg_ctx_quote;
+
+ // Finally parse and execute the macro
+ const char *error = NULL;
+ struct item *script = parse (line, &error);
+ if (error)
+ {
+ printf ("PRIVMSG %s :%s%s: %s\r\n",
+ msg_ctx, msg_ctx_quote, "parse error", error);
+ goto end;
+ }
+
+ struct context ctx;
+ context_init (&ctx);
+ ctx.user_data = &info;
+ execute (&ctx, script);
+ item_free_list (script);
+
+ const char *failure = NULL;
+ if (ctx.memory_failure)
+ failure = "memory allocation failure";
+ else if (ctx.error)
+ failure = ctx.error;
+ if (failure)
+ printf ("PRIVMSG %s :%s%s: %s\r\n",
+ msg_ctx, msg_ctx_quote, "runtime error", failure);
+ context_free (&ctx);
+end:
+ free (msg_ctx_quote);
+}
+
+int
+main (int argc, char *argv[])
+{
+ freopen (NULL, "rb", stdin); setvbuf (stdin, NULL, _IOLBF, BUFSIZ);
+ freopen (NULL, "wb", stdout); setvbuf (stdout, NULL, _IOLBF, BUFSIZ);
+
+ struct rlimit limit =
+ {
+ .rlim_cur = ADDRESS_SPACE_LIMIT,
+ .rlim_max = ADDRESS_SPACE_LIMIT
+ };
+
+ // Lower the memory limits to something sensible to prevent abuse
+ (void) setrlimit (RLIMIT_AS, &limit);
+
+ read_db ();
+ if (!init_runtime_library ()
+ || !register_handler (".", fn_dot))
+ printf (BOT_PRINT "%s\r\n", "runtime library initialization failed");
+
+ g_prefix = strdup (get_config ("prefix"));
+ printf ("ZYKLONB register\r\n");
+ struct message *msg;
+ while ((msg = read_message ()))
+ process_message (msg);
+
+ free_runtime_library ();
+ free (g_prefix);
+ return 0;
+}
+
diff --git a/plugins/zyklonb/youtube b/plugins/zyklonb/youtube
new file mode 100755
index 0000000..5614860
--- /dev/null
+++ b/plugins/zyklonb/youtube
@@ -0,0 +1,111 @@
+#!/usr/bin/env python3
+#
+# ZyklonB YouTube plugin, displaying info about YouTube links
+#
+# Copyright 2014 - 2015, Přemysl Janouch
+# See the file LICENSE for licensing information.
+#
+
+import sys
+import io
+import re
+import json
+import urllib.request
+
+class Plugin:
+ re_msg = re.compile ('(?::([^! ]*)(?:!([^@]*)@([^ ]*))? +)?'
+ '([^ ]+)(?: +(.*))?\r\n$')
+ re_args = re.compile (':?((?<=:).*|[^ ]+) *')
+
+ def parse (self, line):
+ m = self.re_msg.match (line)
+ if m is None:
+ return None
+
+ (nick, user, host, command, args) = m.groups ()
+ args = [] if args is None else self.re_args.findall (args)
+ return (nick, user, host, command, args)
+
+ def get_config (self, key):
+ print ("ZYKLONB get_config :%s" % key)
+ (_, _, _, _, args) = self.parse (sys.stdin.readline ())
+ return args[0]
+
+ def bot_print (self, what):
+ print ('ZYKLONB print :%s' % what)
+
+class YouTube (Plugin):
+ re_videos = [re.compile (x) for x in [
+ r'youtube\.[a-z]+/[^ ]*[&?]v=([-\w]+)',
+ r'youtube\.[a-z]+/v/([-\w]+)',
+ r'youtu\.be/([-\w]+)'
+ ]]
+ re_playlists = [re.compile (x) for x in [
+ r'youtube\.[a-z]+/playlist[&?][^ ]*(?<=&|\?)list=([-\w]+)',
+ ]]
+
+ def print_info (self, channel, url, cb):
+ try:
+ data = json.loads (urllib.request.urlopen
+ (url, None, 30).read ().decode ('utf-8'))
+
+ for line in map (lambda x: "YouTube: " + cb (x), data['items']):
+ print ("PRIVMSG %s :%s" % (channel,
+ line.encode ('utf-8').decode ('iso8859-1')))
+
+ except Exception as err:
+ self.bot_print ('youtube: %s' % (err))
+
+ def print_video_info (self, channel, video_id):
+ url = 'https://www.googleapis.com/youtube/v3/' \
+ + 'videos?id=%s&key=%s&part=snippet,contentDetails,statistics' \
+ % (video_id, self.youtube_api_key)
+ self.print_info (channel, url, lambda x: "%s | %s | %sx" % (
+ x['snippet']['title'],
+ x['contentDetails']['duration'][2:].lower (),
+ x['statistics']['viewCount']))
+
+ def print_playlist_info (self, channel, playlist_id):
+ url = 'https://www.googleapis.com/youtube/v3/' \
+ + 'playlists?id=%s&key=%s&part=snippet,contentDetails' \
+ % (playlist_id, self.youtube_api_key)
+ self.print_info (channel, url, lambda x: "%s | %d videos" % (
+ x['snippet']['title'],
+ x['contentDetails']['itemCount']))
+
+ def process_line (self, line):
+ msg = self.parse (line)
+ if msg is None:
+ return
+
+ (nick, user, host, command, args) = msg
+ if command != 'PRIVMSG' or len (args) < 2:
+ return
+
+ ctx = args[0]
+ if not ctx.startswith (('#', '+', '&', '!')):
+ ctx = nick
+
+ for regex in self.re_videos:
+ for i in regex.findall (args[1]):
+ self.print_video_info (ctx, i)
+ for regex in self.re_playlists:
+ for i in regex.findall (args[1]):
+ self.print_playlist_info (ctx, i)
+
+ def run (self):
+ self.youtube_api_key = self.get_config ('youtube_api_key')
+ if self.youtube_api_key == "":
+ self.bot_print ("youtube: missing `youtube_api_key'")
+
+ print ("ZYKLONB register")
+
+ for line in sys.stdin:
+ self.process_line (line)
+
+sys.stdin = io.TextIOWrapper (sys.__stdin__.buffer,
+ encoding = 'iso8859-1', newline = '\r\n', line_buffering = True)
+sys.stdout = io.TextIOWrapper (sys.__stdout__.buffer,
+ encoding = 'iso8859-1', newline = '\r\n', line_buffering = True)
+
+YouTube ().run ()
diff --git a/zyklonb.c b/zyklonb.c
index 13a68e3..053130a 100644
--- a/zyklonb.c
+++ b/zyklonb.c
@@ -19,6 +19,7 @@
#include "config.h"
#define PROGRAM_NAME "ZyklonB"
+#define PLUGIN_DIR ZYKLONB_PLUGIN_DIR
#include "common.c"
--
cgit v1.2.3-70-g09d2