Add JSON parser example

samples/json.wybe

@@ -0,0 +1,282 @@
+pub constructors jobject(list(pair)) 
+               | jstring(string) 
+               | jbool(bool) 
+               | jnumber(float) 
+               | jlist(list(_)) 
+               | jnull
+
+pub def {test} (a:_ = b:_) { 
+    foreign lpvm cast(a):int = foreign lpvm cast(b):int
+}
+
+pub type pair {
+    ## pair type
+    # A pair contianing a key and value.
+    pub pair(key:string, value:json)
+}
+
+resource tokens:string
+
+## parse/2
+# Parse a string into a JSON value. 
+# Fails if the string cannot be parsed.
+pub def {test} parse(tokens:string, ?json:_) {
+    use tokens in {
+        !space
+        !json(?json)
+    }
+}
+
+## char/2
+# Parse a single character from the input string.
+def {test} char(?c:char) use !tokens {
+    tokens = [?c | ?tokens]
+}
+
+## literal/2
+# Parse a character literal followed by whitespace.
+def {test} literal(c:char) use !tokens {
+    !char(c)
+    !space
+}
+
+## literal/2
+# Parse a string literal followed by whitespace.
+def {test} literal(str:string) use !tokens {
+    for ?c in str {
+        !char(c)
+    }
+    !space
+}
+
+## space/1
+# Parse zero or more whitespace characters from the input.
+def space() use !tokens {
+    !char(?c)
+    (c = ' ' | c = '\n' | c = '\r' | c = '\t')
+    !space
+  | pass
+}
+
+## json/1
+# Parse a JSON object followed by whitespace.
+def {test} json(?j:_) use !tokens {
+    !object(?j) 
+  | !list(?j)
+  | !string(?j)
+  | !bool(?j)
+  | !number(?j)
+  | !null(?j)
+}
+
+## object/1
+# Parse a JSON object, followed by whitespace.
+def {test} object(?obj:_) use !tokens {
+    !sequence('{', {test,resource}{
+        !string(?key)
+        !literal(':')
+        !json(?value)
+        ?@ = pair(key, value)
+    }, '}', ?pairs)
+    ?obj = jobject(pairs)
+}
+
+## list/1
+# Parse a JSON list, followed by whitespace.
+def {test} list(?list:_) use !tokens {
+    !sequence('[', json, ']', ?jsons)
+    ?list = jlist(jsons)
+}
+
+## string/1
+# Parse a JSON string, followed by whitespace.
+def {test} string(?string:_) use !tokens {
+    !string(?str)
+    ?string = jstring(str)
+}
+
+## number/1
+# Parse a JSON number, followed by whitespace.
+def {test} number(?number:_) use !tokens {
+    !digits(?n, _)
+    if { !char('.') ::
+        !digits(?f, ?len)
+        !n += f / power(10.0, len)
+    }
+    if { { !char('e') | !char('E') } ::
+        !digits(?e, _)
+        !n *= power(10.0, e)
+    }
+    !space
+    ?number = jnumber(n)
+}
+
+## bool/1
+# Parse a JSON Boolean, followed by whitespace.
+def {test} bool(?bool:_) use !tokens {
+    !literal("false")
+    ?bool = jbool(false)
+  | !literal("true")
+    ?bool = jbool(true)
+}
+
+## null/1
+# Parse a JSON null, followed by whitespace.
+def {test} null(?null:_) use !tokens {
+    !literal("null")
+    ?null = jnull
+}
+
+## sequence/4
+# Parse a comma-separated sequence of things, with a preceding and 
+# following character, followed by whitespace.
+def {test} sequence(before:char, parse_item:{resource,test}(?X), after:char, ?xs:list(X)) use !tokens {
+    !literal(before)
+    if { !parse_item(?x) :: 
+        !sequence_tail(parse_item, ?xs)
+        ?xs = [x | xs]
+      | else :: 
+        ?xs = []
+    }
+    !literal(after)
+}
+
+## sequence_tail/2
+# Parse the tail of a sequnece. Helper for sequence/4.
+def {test} sequence_tail(parse_item:{resource,test}(?X), ?xs:list(X)) use !tokens {
+    if { !literal(',') ::
+        !parse_item(?x)
+        !sequence_tail(parse_item, ?xs)
+        ?xs = [x | xs]
+      | else ::
+        ?xs = []
+    }
+}
+
+## string/1
+# Parse a string, followed by whitespace.
+def {test} string(?str:string) use !tokens {
+    !char('\"')
+    !string_tail(?str)
+    ?str = string(c_string(str))
+}
+
+## string_tail/1
+# Parse the tail of a string. Helper for string/1.
+def {test} string_tail(?str:string) use !tokens {
+    !literal('\"')
+    ?str = ""
+  | !char(?c)
+    if { c:char = '\\' :: 
+        !char(?c)
+        if { c = '"' :: pass
+           | c = '\\' :: pass
+           | c = '/' :: pass
+           | c = 'b' :: ?c = '\b'
+           | c = 'f' :: ?c = '\f'
+           | c = 'n' :: ?c = '\n'
+           | c = 'r' :: ?c = '\r'
+           | c = 't' :: ?c = '\t'
+           | else :: fail
+        }
+    }
+    !string_tail(?str)
+    ?str = c ,, str
+}
+
+## digits/2
+# Parse a sequence of one or more digits
+def {test} digits(?n:float, ?len:float) use !tokens {
+    !digit(?n)
+    ?len = 1.0
+    do {
+        !digit(?d) 
+        !len += 1.0 
+        ?n = n * 10.0 + d
+      | break
+    }
+}
+
+## digits/1
+# Parse a single digit
+def {test} digit(?d:float) use !tokens {
+    !char(?c)
+    '0' <= c & c <= '9'
+    ?d = foreign llvm sitofp(ord(c) - ord('0'):int)
+}
+
+pub def print(x:_) use !io {
+    !print(0, x)
+    !nl
+}
+
+def print(ind:int, x:_) use !io {
+    case x in {
+        jobject(?pairs) :: 
+        !print_list('{', {resource}{
+            !indent(@1)
+            !escape(@2^key)
+            !print(": ")
+            !print(@1, @2^value)
+        }, ind, pairs, '}')
+      | jlist(?list) :: 
+        !print_list('[', {resource}{
+            !indent(@1)
+            !print(@1, @2)
+        }, ind, list, ']')
+      | jstring(?s) :: !escape(s)
+      | jbool(?b) :: !print(b)
+      | jnumber(?n) :: !print(n)
+      | else :: !print("null")
+    }
+}
+
+def indent(ind:int) use !io {
+    ind <= 0
+  | !print("  ")
+    !indent(ind - 1)
+}
+
+def escape(s:string) use !io {
+    !print('"')
+    for ?c in s {
+        if { c = '"' :: !print("\\\"")
+           | c = '\\' :: !print("\\\\")
+           | c = '\b' :: !print("\\b")
+           | c = '\f' :: !print("\\f")
+           | c = '\n' :: !print("\\n")
+           | c = '\r' :: !print("\\r")
+           | c = '\t' :: !print("\\t")
+           | else :: !print(c)
+        }
+    }
+    !print('"')
+}
+
+def print_list(start:char, printer:{resource}(int, X), ind:int, xs:list(X), end:char) use !io {
+    !print(start)
+    if { [?x | ?xs] = xs :: 
+        !nl
+        !printer(ind + 1, x)
+        for ?x in xs {
+            !println(',')
+            !printer(ind + 1, x)
+        }
+        !nl
+        !indent(ind)
+    }
+    !print(end)
+}
+
+?str = "  {\"a\": [1, 1.020, 1e2, 01.2E3, false, { \"key\": null}],\n \"abc\\ndef\": true }  "
+
+!print("Attempting to parse ")
+!escape(str)
+!nl
+
+if { parse(str, ?json) :: 
+    !println("Successfully parsed!")
+    !print(json) 
+  | else :: 
+    !print("Failed to parse :(") 
+}

src/AliasAnalysis.hs

@@ -25,6 +25,7 @@ import           Data.Tuple.Extra
 import           Flow          ((|>))
 import           Options       (LogSelection (Analysis))
 import           Util
+import           Config        (specialName2)
 
 
 -- This "AliasMapLocal" is used during analysis and it will be converted to
@@ -39,6 +40,7 @@ import           Util
 -- consider the corresponding parameter as interesting.
 data AliasMapLocalItem
     = LiveVar           PrimVarName
+    | AliasByGlobal     GlobalInfo
     | AliasByParam      PrimVarName
     | MaybeAliasByParam PrimVarName
     deriving (Eq, Ord, Show)
@@ -190,7 +192,7 @@ aliasedByFork caller body analysisInfo = do
         PrimFork _ _ _ fBodies deflt -> do
             logAlias ">>> Forking:"
             analysisInfos <-
-                mapM (\body' -> aliasedByBody caller body' analysisInfo) 
+                mapM (\body' -> aliasedByBody caller body' analysisInfo)
                     $ fBodies ++ maybeToList deflt
             return $ mergeAnalysisInfo analysisInfos
         NoFork -> do
@@ -294,8 +296,8 @@ updateAliasedByPrim aliasMap prim =
             -- Analyse simple prims
             logAlias $ "--- simple prim:  " ++ show prim
             let prim' = content prim
-            maybeAliasedVariables <- maybeAliasPrimArgs prim'
-            aliasedArgsInSimplePrim aliasMap maybeAliasedVariables
+            maybeAliasedPrimArgs <- maybeAliasPrimArgs prim'
+            aliasedArgsInSimplePrim aliasMap maybeAliasedPrimArgs
                                         (fst $ primArgs prim')
 
 
@@ -304,16 +306,16 @@ updateAliasedByPrim aliasMap prim =
 -- Not to compute aliasing from mutate instructions with the assumption that we
 -- always try to do nondestructive update.
 -- Retruns maybeAliasedVariables
-maybeAliasPrimArgs :: Prim -> Compiler [PrimVarName]
+maybeAliasPrimArgs :: Prim -> Compiler [AliasMapLocalItem]
 maybeAliasPrimArgs (PrimForeign "lpvm" "access" _ args) =
     _maybeAliasPrimArgs args
 maybeAliasPrimArgs (PrimForeign "lpvm" "cast" _ args) =
     _maybeAliasPrimArgs args
 maybeAliasPrimArgs (PrimForeign "llvm" "move" _ args) =
     _maybeAliasPrimArgs args
-maybeAliasPrimArgs (PrimForeign "llvm" "load" _ args) =
+maybeAliasPrimArgs (PrimForeign "lpvm" "load" _ args) =
     _maybeAliasPrimArgs args
-maybeAliasPrimArgs (PrimForeign "llvm" "store" _ args) =
+maybeAliasPrimArgs (PrimForeign "lpvm" "store" _ args) =
     _maybeAliasPrimArgs args
 maybeAliasPrimArgs prim@(PrimForeign "lpvm" "mutate" flags args) = do
     let [fIn, fOut, _, _, _, _, mem] = args
@@ -330,23 +332,24 @@ maybeAliasPrimArgs prim = return []
 -- It filters the args and keeps those may aliased with others
 -- We don't care about the Flow of args
 -- since the aliasMap is undirectional
-_maybeAliasPrimArgs :: [PrimArg] -> Compiler [PrimVarName]
+_maybeAliasPrimArgs :: [PrimArg] -> Compiler [AliasMapLocalItem]
 _maybeAliasPrimArgs args = do
     args' <- mapM filterArg args
     let escapedVars = catMaybes args'
     return escapedVars
   where
     filterArg arg =
         case arg of
-        ArgVar{argVarName=var, argVarType=ty}
-            -> do
-                isPhantom <- argIsPhantom arg
-                rep <- lookupTypeRepresentation ty
-                -- Only Address type will create alias
-                if not isPhantom && rep == Just Address
-                    then return $ Just var
-                    else return Nothing
-        _   -> return Nothing
+        ArgVar{argVarName=var, argVarType=ty} -> maybeAddressAlias arg ty (LiveVar var)
+        ArgGlobal global ty -> maybeAddressAlias arg ty $ AliasByGlobal global
+        _ -> return Nothing
+    maybeAddressAlias arg ty item = do
+        isPhantom <- argIsPhantom arg
+        rep <- lookupTypeRepresentation ty
+        -- Only Address type will create alias
+        if not isPhantom && rep == Just Address
+        then return $ Just item
+        else return Nothing
 
 
 -- Check Arg aliases in one of proc calls inside a ProcBody
@@ -361,18 +364,15 @@ aliasedArgsInPrimCall calleeArgsAliases currentAlias primArgs = do
 -- Check Arg aliases in one of the prims of a ProcBody.
 -- (maybeAliasedInput, maybeAliasedOutput, primArgs): argument in current prim
 -- that being analysed
-aliasedArgsInSimplePrim :: AliasMapLocal -> [PrimVarName] -> [PrimArg]
+aliasedArgsInSimplePrim :: AliasMapLocal -> [AliasMapLocalItem] -> [PrimArg]
         -> Compiler AliasMapLocal
 aliasedArgsInSimplePrim aliasMap [] primArgs =
         -- No new aliasing incurred but still need to cleanup final args
         return $ removeDeadVar aliasMap primArgs
-aliasedArgsInSimplePrim aliasMap
-                            maybeAliasedVariables primArgs = do
-        logAlias $ "      primArgs:           " ++ show primArgs
-        logAlias $ "      maybeAliasedVariables:  "
-                                    ++ show maybeAliasedVariables
-        let maybeAliasedVariables' = List.map LiveVar maybeAliasedVariables
-        let aliasMap' = addConnectedGroupToDS maybeAliasedVariables' aliasMap
+aliasedArgsInSimplePrim aliasMap maybeAliasedPrimArgs primArgs = do
+        logAlias $ "      primArgs:             " ++ show primArgs
+        logAlias $ "      maybeAliasedPrimArgs: " ++ show maybeAliasedPrimArgs
+        let aliasMap' = addConnectedGroupToDS maybeAliasedPrimArgs aliasMap
         return $ removeDeadVar aliasMap' primArgs