Welcome to Hoa\Praspel \o/!

2 files changed, 686 insertions, 0 deletions

diff --git a/Visitor/Compiler.php b/Visitor/Compiler.php
new file mode 100644
index 0000000..15e058f
--- /dev/null
+++ b/Visitor/Compiler.php
@@ -0,0 +1,201 @@
+<?php
+
+/**
+ * Hoa
+ *
+ *
+ * @license
+ *
+ * New BSD License
+ *
+ * Copyright © 2007-2012, Ivan Enderlin. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *     * Redistributions of source code must retain the above copyright
+ *       notice, this list of conditions and the following disclaimer.
+ *     * Redistributions in binary form must reproduce the above copyright
+ *       notice, this list of conditions and the following disclaimer in the
+ *       documentation and/or other materials provided with the distribution.
+ *     * Neither the name of the Hoa nor the names of its contributors may be
+ *       used to endorse or promote products derived from this software without
+ *       specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS AND CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ */
+
+namespace {
+
+from('Hoa')
+
+/**
+ * \Hoa\Visitor\Visit
+ */
+-> import('Visitor.Visit');
+
+}
+
+namespace Hoa\Praspel\Visitor {
+
+/**
+ * Class \Hoa\Praspel\Visitor\Compiler.
+ *
+ * Compile the model to PHP code.
+ *
+ * @author     Ivan Enderlin <ivan.enderlin@hoa-project.net>
+ * @copyright  Copyright © 2007-2012 Ivan Enderlin.
+ * @license    New BSD License
+ */
+
+class Compiler implements \Hoa\Visitor\Visit {
+
+    /**
+     * Visit an element.
+     *
+     * @access  public
+     * @param   \Hoa\Visitor\Element  $element    Element to visit.
+     * @param   mixed                 &$handle    Handle (reference).
+     * @param   mixed                 $eldnah     Handle (not reference).
+     * @return  mixed
+     */
+    public function visit ( \Hoa\Visitor\Element $element,
+                            &$handle = null, $eldnah = null ) {
+
+        $out    = null;
+        $parent = '$praspel';
+
+        if(null !== $eldnah)
+            $parent = '$' . substr($eldnah, 0, -1);
+
+        if($element instanceof \Hoa\Praspel\Model\Specification) {
+
+            $out     = $parent . ' = new \Hoa\Praspel\Model\Specification();' .  "\n";
+            $clauses = array(
+                'is',
+                'invariant',
+                'requires',
+                'ensures',
+                'behavior',
+                'throwable',
+                'forexample'
+            );
+
+            foreach($clauses as $clause)
+                if(true === $element->clauseExists($clause))
+                    $out .= $element->getClause($clause)->accept(
+                        $this,
+                        $handle,
+                        $eldnah
+                    );
+        }
+        elseif($element instanceof \Hoa\Praspel\Model\Is) {
+
+            $out = "\n" .
+                   $parent . '->getClause(\'is\')->setProperty(' .
+                   $element->getProperty() .
+                   ');' . "\n";
+        }
+        elseif($element instanceof \Hoa\Praspel\Model\Declaration) {
+
+            $clause   = $element->getName();
+            $variable = '$' . $eldnah . $clause;
+            $out      = "\n" .
+                        $variable . ' = ' . $parent .
+                        '->getClause(\'' . $clause . '\');' . "\n";
+
+            foreach($element as $name => $var) {
+
+                $start  = $variable . '[\'' . $name . '\']';
+                $out   .= $start;
+
+                if(null === $alias = $var->getAlias())
+                    $out .= '->in = ' . $var->getDomains() . ';' . "\n";
+                else
+                    $out .= '->domainof(\'' . $alias . '\');' . "\n";
+
+                $constraints = $var->getConstraints();
+
+                if(isset($constraints['is']))
+                    $out .= $start . '->is(\'' .
+                            implode('\', \'', $constraints['is']) . '\');' .
+                            "\n";
+
+                if(isset($constraints['contains']))
+                    foreach($constraints['contains'] as $contains)
+                        $out .= $start . '->contains(' . $contains . ');' . "\n";
+
+                if(isset($constraints['key']))
+                    foreach($constraints['key'] as $pairs)
+                        $out .= $start . '->key(' . $pairs[0] . ')->in = ' .
+                                $pairs[1] . ';' . "\n";
+            }
+
+            foreach($element->getPredicates() as $predicate)
+                $out .= $variable . '->predicate(\'' . $predicate . '\');' . "\n";
+        }
+        elseif($element instanceof \Hoa\Praspel\Model\Throwable) {
+
+            $variable = '$' . $eldnah . 'throwable';
+            $out       = "\n" .
+                         $variable . ' = ' . $parent .
+                         '->getClause(\'throwable\');' . "\n";
+
+            foreach($element->getExceptions() as $class)
+                $out .= $variable . '->exception(\'' . $class . '\');' . "\n";
+        }
+        elseif($element instanceof \Hoa\Praspel\Model\Behavior) {
+
+            $identifier = $element->getIdentifier();
+            $variable   = '$' . $eldnah . 'behavior_' . $identifier;
+            $out        = "\n" .
+                          $variable . ' = ' . $parent .
+                          '->getClause(\'behavior\');' . "\n" .
+                          $variable . '->setIdentifier(\'' . $identifier . '\');' . "\n";
+            $eldnah     = $eldnah . 'behavior_' . $identifier . '_';
+            $clauses    = array(
+                'invariant',
+                'requires',
+                'ensures',
+                'behavior',
+                'throwable'
+            );
+
+            foreach($clauses as $clause)
+                if(true === $element->clauseExists($clause))
+                    $out .= $element->getClause($clause)->accept(
+                        $this,
+                        $handle,
+                        $eldnah
+                    );
+        }
+        elseif($element instanceof \Hoa\Praspel\Model\Forexample) {
+
+            $variable = '$' . $eldnah . 'forexample';
+            $out      = "\n" .
+                        $variable . ' = ' . $parent .
+                        '->getClause(\'forexample\');' . "\n";
+
+            foreach($element as $example)
+                $out .= $variable . '[] = \'' .
+                        preg_replace('#(?<!\\\)\'#', '\\\'', $example) .
+                        '\';' . "\n";
+        }
+        else
+            throw new \Hoa\Core\Exception(
+                '%s is not yet implemented.', 0, get_class($element));
+
+        return $out;
+    }
+}
+
+}
diff --git a/Visitor/Interpreter.php b/Visitor/Interpreter.php
new file mode 100644
index 0000000..2d842ba
--- /dev/null
+++ b/Visitor/Interpreter.php
@@ -0,0 +1,485 @@
+<?php
+
+/**
+ * Hoa
+ *
+ *
+ * @license
+ *
+ * New BSD License
+ *
+ * Copyright © 2007-2012, Ivan Enderlin. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *     * Redistributions of source code must retain the above copyright
+ *       notice, this list of conditions and the following disclaimer.
+ *     * Redistributions in binary form must reproduce the above copyright
+ *       notice, this list of conditions and the following disclaimer in the
+ *       documentation and/or other materials provided with the distribution.
+ *     * Neither the name of the Hoa nor the names of its contributors may be
+ *       used to endorse or promote products derived from this software without
+ *       specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS AND CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ */
+
+namespace {
+
+from('Hoa')
+
+/**
+ * \Hoa\Visitor\Visit
+ */
+-> import('Visitor.Visit')
+
+/**
+ * \Hoa\Praspel\Exception\Interpreter
+ */
+-> import('Praspel.Exception.Interpreter')
+
+/**
+ * \Hoa\Praspel\Model\Specification
+ */
+-> import('Praspel.Model.Specification')
+
+/**
+ * \Hoa\String
+ */
+-> import('String.~');
+
+}
+
+namespace Hoa\Praspel\Visitor {
+
+/**
+ * Class \Hoa\Praspel\Visitor\Interpreter.
+ *
+ * Compile Praspel to model.
+ *
+ * @author     Ivan Enderlin <ivan.enderlin@hoa-project.net>
+ * @copyright  Copyright © 2007-2012 Ivan Enderlin.
+ * @license    New BSD License
+ */
+
+class Interpreter implements \Hoa\Visitor\Visit {
+
+    /**
+     * Root.
+     *
+     * @var \Hoa\Praspel\Model\Specification object
+     */
+    protected $_root    = null;
+
+    /**
+     * Current clause.
+     *
+     * @var \Hoa\Praspel\Model\Clause object
+     */
+    protected $_clause  = null;
+
+    /**
+     * Current object.
+     *
+     * @var \Hoa\Praspel\Model object
+     */
+    protected $_current = null;
+
+
+
+    /**
+     * Visit an element.
+     *
+     * @access  public
+     * @param   \Hoa\Visitor\Element  $element    Element to visit.
+     * @param   mixed                 &$handle    Handle (reference).
+     * @param   mixed                 $eldnah     Handle (not reference).
+     * @return  mixed
+     * @throw   \Hoa\Praspel\Exception\Interpreter
+     */
+    public function visit ( \Hoa\Visitor\Element $element,
+                            &$handle = null, $eldnah = null ) {
+
+        $id = $element->getId();
+
+        switch($id) {
+
+            case '#specification':
+                $this->_clause = $this->_current
+                               = $this->_root
+                               = new \Hoa\Praspel\Model\Specification();
+
+                foreach($element->getChildren() as $child)
+                    $child->accept($this, $handle, $eldnah);
+
+                return $this->_root;
+              break;
+
+            case '#is':
+                $this->_clause = $this->_root->getClause('is');
+
+                foreach($element->getChildren() as $child)
+                    $this->_clause->addProperty(
+                        $this->_clause->getPropertyValue(
+                            $child->accept($this, $handle, $eldnah)
+                        )
+                    );
+              break;
+
+            case '#requires':
+            case '#ensures':
+            case '#invariant':
+            case '#throwable':
+                $this->_clause = $this->_current->getClause(substr($id, 1));
+
+                foreach($element->getChildren() as $child)
+                    $child->accept($this, $handle, $eldnah);
+              break;
+
+            case '#behavior':
+                $children      = $element->getChildren();
+                $child0        = array_shift($children);
+                $previous      = $this->_current;
+                $this->_clause = $this->_current
+                               = $this->_current->getClause('behavior');
+                $this->_clause->setIdentifier(
+                    $child0->accept($this, $handle, $eldnah)
+                );
+
+                foreach($children as $child)
+                    $child->accept($this, $handle, $eldnah);
+
+                $this->_current = $previous;
+              break;
+
+            case '#forexample':
+                $this->_clause   = $this->_root->getClause('forexample');
+                $this->_clause[] = $element->getChild(0)->accept(
+                    $this,
+                    $handle,
+                    $eldnah
+                );
+              break;
+
+            case '#exception_list':
+                foreach($element->getChildren() as $child)
+                    $this->_clause->exception(
+                        $child->accept($this, $handle, $eldnah)
+                    );
+              break;
+
+            case '#declaration':
+                $variable                     = $element->getChild(0)
+                                                        ->accept($this, $handle, $eldnah);
+                $this->_clause[$variable]->in = $element->getChild(1)
+                                                        ->accept($this, $handle, $eldnah);
+              break;
+
+            case '#qualification':
+                $children = $element->getChildren();
+                $variable = $this->_clause[array_shift($children)->accept(
+                    $this,
+                    $handle,
+                    $eldnah
+                )];
+
+                foreach($children as $child)
+                    $variable->is($child->accept($this, $handle, $eldnah));
+              break;
+
+            case '#contains':
+                $variable = $element->getChild(0)->accept($this, $handle, $eldnah);
+                $value    = $element->getChild(1)->accept($this, $handle, $eldnah);
+
+                $this->_clause[$variable]->contains($value);
+              break;
+
+            case '#domainof':
+                $left  = $element->getChild(0)->accept($this, $handle, $eldnah);
+                $right = $element->getChild(1)->accept($this, $handle, $eldnah);
+
+                $this->_clause[$left]->domainof($right);
+              break;
+
+            case '#predicate':
+                $this->_clause->predicate(
+                    $element->getChild(0)->accept($this, $handle, $eldnah)
+                );
+              break;
+
+            case '#disjunction':
+                $disjunction = realdom();
+
+                foreach($element->getChildren() as $child) {
+
+                    $value = $child->accept($this, $handle, $eldnah);
+
+                    if($value instanceof \Hoa\Realdom\Disjunction)
+                        $disjunction->addRealdom($value->getRealdoms());
+                    else
+                        $disjunction->const($value);
+                }
+
+                return $disjunction;
+              break;
+
+            case '#realdom':
+                $children  = $element->getChildren();
+                $child0    = array_shift($children);
+                $name      = $child0->accept($this, $handle, $eldnah);
+                $arguments = array();
+
+                foreach($children as $child) {
+
+                    $argument = $child->accept($this, $handle, $eldnah);
+
+                    if($argument instanceof \Hoa\Realdom\Disjunction)
+                        $argument = $argument->getRealdoms();
+
+                    $arguments[] = $argument;
+                }
+
+                return realdom()->_call($name, $arguments);
+              break;
+
+            case '#concatenation':
+                $string = null;
+
+                foreach($element->getChildren() as $child)
+                    $string .= $child->accept($this, $handle, $eldnah);
+
+                return $string;
+              break;
+
+            case '#array':
+                $array = array();
+
+                foreach($element->getChildren() as $child) {
+
+                    if('#pair' === $child->getId()) {
+
+                        $key     = $child->getChild(0)
+                                         ->accept($this, $handle, $eldnah);
+                        $value   = $child->getChild(1)
+                                         ->accept($this, $handle, $eldnah);
+                        $array[] = array($key, $value);
+
+                        continue;
+                    }
+
+                    $key     = realdom()->integerpp(0, 1);
+                    $value   = $child->accept($this, $handle, $eldnah);
+                    $array[] = array($key, $value);
+                }
+
+                return $array;
+              break;
+
+            case '#range':
+                $left  = $element->getChild(0)->accept($this, $handle, $eldnah);
+                $right = $element->getChild(1)->accept($this, $handle, $eldnah);
+
+                if(is_float($left) || is_float($right))
+                    return realdom()->boundfloat(
+                        floatval($left),
+                        floatval($right)
+                    );
+
+                return realdom()->boundinteger(intval($left), intval($right));
+              break;
+
+            case '#left_range':
+                $left = $element->getChild(0)->accept($this, $handle, $eldnah);
+
+                if(is_float($left))
+                    return realdom()->boundfloat($left);
+
+                return realdom()->boundinteger($left);
+              break;
+
+            case '#right_range':
+                $right = $element->getChild(0)->accept($this, $handle, $eldnah);
+
+                if(is_float($right))
+                    return realdom()->boundfloat(null, $right);
+
+                return realdom()->boundinteger(null, $right);
+              break;
+
+            case '#arrayaccessbykey':
+                $variable = $element->getChild(0)->accept($this, $handle, $eldnah);
+                $key      = $element->getChild(1)->accept($this, $handle, $eldnah);
+
+                $this->_clause[$variable]->key($key);
+
+                return $variable;
+              break;
+
+            case '#this_identifier':
+                $identifier = 'this';
+
+                foreach($element->getChildren() as $child)
+                    $identifier .= '->' . $child->accept($this, $handle, $eldnah);
+
+                return $identifier;
+              break;
+
+            case '#self_identifier':
+            case '#static_identifier':
+            case '#parent_identifier':
+                $identifier = substr($id, 1, strpos($id, '_', 1) - 1);
+
+                foreach($element->getChildren() as $child)
+                    $identifier .= '::' . $child->accept($this, $handle, $eldnah);
+
+                return $identifier;
+              break;
+
+            case '#old':
+                return '\old(' .
+                       $element->getChild(0)->accept($this, $handle, $eldnah) .
+                       ')';
+              break;
+
+            case '#result':
+                return '\result';
+              break;
+
+            case '#classname':
+                $classname = array();
+
+                foreach($element->getChildren() as $child)
+                    $classname[] = $child->accept($this, $handle, $eldnah);
+
+                return implode('\\', $classname);
+              break;
+
+            case '#nowdoc':
+            case '#heredoc':
+                return $element->getChild(1)->accept($this, $handle, $eldnah);
+              break;
+
+            case 'token':
+                $tId   = $element->getValueToken();
+                $value = $element->getValueValue();
+
+                switch($tId) {
+
+                    case 'content':
+                    case 'identifier':
+                    case 'pure':
+                    case 'result':
+                        return $value;
+
+                    case 'default':
+                        return …;
+
+                    case 'null':
+                        return null;
+
+                    case 'true':
+                        return true;
+
+                    case 'false':
+                        return false;
+
+                    case 'binary':
+                        $int = intval(substr($value, strpos($value, 'b') + 1), 2);
+
+                        if('-' === $value[0])
+                            return -$int;
+
+                        return $int;
+
+                    case 'octal':
+                        $int = intval(substr($value, strpos($value, '0') + 1), 8);
+
+                        if('-' === $value[0])
+                            return -$int;
+
+                        return $int;
+
+                    case 'hexa':
+                        $value = strtolower($value);
+                        $int   = intval(substr($value, strpos($value, 'x') + 1), 16);
+
+                        if('-' === $value[0])
+                            return -$int;
+
+                        return $int;
+
+                    case 'decimal':
+                        if(true === ctype_digit(ltrim($value, '+-')))
+                            return intval($value);
+
+                        return floatval($value);
+
+                    case 'escaped':
+                        switch($value[1]) {
+
+                            case 'n':
+                                return "\n";
+
+                            case 'r':
+                                return "\r";
+
+                            case 't':
+                                return "\t";
+
+                            case 'v':
+                                return "\v";
+
+                            case 'e':
+                                return "\033";
+
+                            case 'f':
+                                return "\f";
+
+                            case 'b':
+                                return "\033[D";
+
+                            case 'x':
+                                return \Hoa\String::fromCode(hexdec($value));
+
+                            default:
+                                return \Hoa\String::fromCode(octdec($value));
+                        }
+
+                    case 'string':
+                        return $value;
+
+                    default:
+                        throw new \Hoa\Praspel\Exception\Interpreter(
+                            'Token %s is not yet implemented.', 1, $tId);
+                }
+              break;
+
+            default:
+                throw new \Hoa\Praspel\Exception\Interpreter(
+                    'Element %s is unknown.', 2, $id);
+        }
+    }
+
+    /**
+     * Get root.
+     *
+     * @access  public
+     * @return  \Hoa\Praspel\Model\Specification
+     */
+    public function getRoot ( ) {
+
+        return $this->_root;
+    }
+}
+
+}