Commits

Tobias Dammers  committed 9c05122

Write better PHP (more robust)

  • Participants
  • Parent commits 40512e5
  • Tags 0.6.1

Comments (0)

Files changed (1)

File Text/HPaco/Writers/PHP.hs

     strid <- scopeResolve key
     return $ maybe key toVarname strid
 
+maybeResolveVariable :: String -> PWS (Maybe String)
+maybeResolveVariable key = do
+    strid <- scopeResolve key
+    return $ maybe Nothing (Just . toVarname) strid
+
 nextVarID :: PWS Integer
 nextVarID = do
     id <- gets pwsNextLocalVariableID
 
 writePreamble :: PWS ()
 writePreamble = do
-    writeIndentedLn "function _r($context, $key) {"
+    -- writeIndentedLn "if (!is_callable(array('_S', '__get'))) {"
+    writeIndentedLn "if (!is_callable('_r')) {"
     withIndent $ do
-        writeIndentedLn "if (is_array($context)) {"
-        withIndent $ writeIndentedLn "if (isset($context[$key])) return $context[$key];"
+        writeIndentedLn "class _S {"
+        withIndent $ do
+            writeIndentedLn "public $t;"
+            writeIndentedLn "public $p;"
+            writeIndentedLn "public function __construct($t, $p) { $this->t = $t; $this->p = $p; }"
+            writeIndentedLn "public function __isset($key) {"
+            withIndent $ do
+                writeIndentedLn "return ("
+                withIndent $ do
+                    writeIndentedLn "(is_array($this->t) && isset($this->t[$key])) ||"
+                    writeIndentedLn "(is_object($this->t) && isset($this->t->$key)) ||"
+                    writeIndentedLn "(is_array($this->p) && isset($this->p[$key])) ||"
+                    writeIndentedLn "(is_object($this->p) && isset($this->p->$key)));"
+            writeIndentedLn "}"
+            writeIndentedLn "public function __get($key) {"
+            withIndent $ do
+                writeIndentedLn "if (is_array($this->t) && isset($this->t[$key])) return $this->t[$key];"
+                writeIndentedLn "if (is_object($this->t) && isset($this->t->$key)) return $this->t->$key;"
+                writeIndentedLn "if (is_array($this->p) && isset($this->p[$key])) return $this->p[$key];"
+                writeIndentedLn "if (is_object($this->p) && isset($this->p->$key)) return $this->p->$key;"
+                writeIndentedLn "return null;"
+            writeIndentedLn "}"
         writeIndentedLn "}"
-        writeIndentedLn "if (is_object($context)) {"
-        withIndent $ writeIndentedLn "if (isset($context->$key)) return $context->$key;"
+    writeIndentedLn "}"
+
+    writeIndentedLn "if (!is_callable('_r')) {"
+    withIndent $ do
+        writeIndentedLn "function _r($context, $key) {"
+        withIndent $ do
+            writeIndentedLn "if ($key === '.') return $context;"
+            writeIndentedLn "if (is_array($context)) {"
+            withIndent $ writeIndentedLn "if (isset($context[$key])) return $context[$key];"
+            writeIndentedLn "}"
+            writeIndentedLn "if (is_object($context)) {"
+            withIndent $ writeIndentedLn "if (isset($context->$key)) return $context->$key;"
+            writeIndentedLn "}"
+            writeIndentedLn "return null;"
         writeIndentedLn "}"
-        writeIndentedLn "return null;"
     writeIndentedLn "}"
 
-    writeIndentedLn "function _in($elem, $list) {"
+    writeIndentedLn "if (!is_callable('_in')) {"
     withIndent $ do
-        writeIndentedLn "if (is_array($list)) {"
-        withIndent $ writeIndentedLn "return in_array($elem, $list);"
+        writeIndentedLn "function _in($elem, $list) {"
+        withIndent $ do
+            writeIndentedLn "if (is_array($list)) {"
+            withIndent $ writeIndentedLn "return in_array($elem, $list);"
+            writeIndentedLn "}"
+            writeIndentedLn "return false;"
         writeIndentedLn "}"
-        writeIndentedLn "return false;"
     writeIndentedLn "}"
 
-    writeIndentedLn "function _f($val) {"
+    writeIndentedLn "if (!is_callable('_f')) {"
     withIndent $ do
-        writeIndentedLn "if (is_array($val)) {"
-        withIndent $ writeIndentedLn "return implode(' ', $val);"
+        writeIndentedLn "function _f($val) {"
+        withIndent $ do
+            writeIndentedLn "if (is_array($val)) {"
+            withIndent $ writeIndentedLn "return implode(' ', $val);"
+            writeIndentedLn "}"
+            writeIndentedLn "return (string)$val;"
         writeIndentedLn "}"
-        writeIndentedLn "return (string)$val;"
     writeIndentedLn "}"
 
-    writeIndentedLn "function _call($func, $args) {"
+    writeIndentedLn "if (!is_callable('_call')) {"
     withIndent $ do
-        exposeFuncs <- woExposeAllFunctions `liftM` ask
-        if exposeFuncs
-            then writeIndentedLn "if (is_callable($func)) {"
-            else writeIndentedLn "if ($func instanceof FunctionPointer) {"
-        withIndent $ writeIndentedLn "return call_user_func_array($func, $args);"
+        writeIndentedLn "function _call($func, $args) {"
+        withIndent $ do
+            exposeFuncs <- woExposeAllFunctions `liftM` ask
+            if exposeFuncs
+                then writeIndentedLn "if (is_callable($func)) {"
+                else writeIndentedLn "if ($func instanceof FunctionPointer) {"
+            withIndent $ writeIndentedLn "return call_user_func_array($func, $args);"
+            writeIndentedLn "}"
+            writeIndentedLn "return null;"
         writeIndentedLn "}"
-        writeIndentedLn "return null;"
     writeIndentedLn "}"
 
 writeHeader :: PWS ()
         write " = array();"
         writeNewline
     writeIndentedLn "}"
-    writeExtractScope
+    writeIndentedLn "$_scope = array();"
+    writePushScope
 
-writeExtractScope = do
+writePushScope = do
     vid <- resolveVariable "."
-    writeIndent
-    write "if (is_array("
-    write "$"
-    write vid
-    write ")) { extract($"
-    write vid
-    write "); }"
-    writeNewline
+    writeIndentedLn $ "$_scope = new _S($" ++ vid ++ ", $_scope);"
+
+writePopScope =
+    writeIndentedLn "if ($_scope instanceof _S) { $_scope = $_scope->p; } else { $_scope = array(); }"
 
 writeFooter :: PWS ()
 writeFooter = do
 
 writeLet :: String -> Expression -> Statement -> PWS ()
 writeLet identifier expr stmt = do
+    writeIndent
+    write "$_tmp = "
+    writeExpression expr
+    write ";"
+    writeNewline
     pushScope
     id <- defineVariable identifier
 
     writeIndent
     write "$"
     write $ toVarname id
-    write " = "
-    writeExpression expr
-    write ";"
+    write " = $_tmp;"
     writeNewline
 
     if identifier == "."
-        then writeExtractScope
+        then writePushScope
         else return ()
 
     writeStatement stmt
 
     popScope
     if identifier == "."
-        then writeExtractScope
+        then writePopScope
         else return ()
 
 
     id <- defineVariable identifier
 
     writeIndent
-    write "foreach ("
+    write "$_iteree = "
     writeExpression expr
-    write " as $"
-    write $ toVarname id
-    write ") {"
+    write ";"
     writeNewline
 
+    writeIndentedLn "if (is_array($_iteree) || ($_iteree instanceof Traversable)) {"
+
     withIndent $ do
-        if identifier == "."
-            then writeExtractScope
-            else return ()
-        writeStatement stmt
+        writeIndent
+        write "foreach ($_iteree as $"
+        write $ toVarname id
+        write ") {"
+        writeNewline
 
-    writeIndentedLn "}"
+        withIndent $ do
+            when (identifier == ".")
+                writePushScope
+            writeStatement stmt
+            when (identifier == ".")
+                writePushScope
 
-    writeIndent
-    write "unset($"
-    write $ toVarname id
-    write ");";
-    writeNewline
+        writeIndentedLn "}"
+
+        writeIndent
+        write "unset($"
+        write $ toVarname id
+        write ");";
+        writeNewline
+
+    writeIndentedLn "}"
 
     popScope
-    if identifier == "."
-        then writeExtractScope
-        else return ()
 
 writeSwitch :: Expression -> [(Expression, Statement)] -> PWS ()
 writeSwitch masterExpr branches = do
                 writeExpression value
 
         VariableReference vn -> do
-            vid <- resolveVariable vn
-            write $ "$" ++ vid
+            vid <- maybeResolveVariable vn
+            write $ maybe
+                ("_r($_scope, '" ++ vn ++ "')")
+                (\v -> "(isset($" ++ v ++ ") ? $" ++ v ++ " : null)")
+                vid
 
         EscapeExpression mode e -> do
             let escapefunc =