Specially handle short strings in the parser

src/BodyBuilder.hs

@@ -19,6 +19,7 @@ import Snippets ( boolType, intType, primMove )
 import Util
 import Config (minimumSwitchCases, wordSize)
 import Options (LogSelection(BodyBuilder))
+import Data.Char ( ord )
 import Data.Map as Map
 import Data.List as List
 import Data.Set as Set
@@ -234,11 +235,6 @@ instance Show Constraint where
         = show v ++ ":" ++ show t ++ " ~= " ++ show a
 
 
--- negateConstraint :: Constraint -> Constraint
--- negateConstraint (Equal v n)    = NotEqual v n
--- negateConstraint (NotEqual v n) = Equal v n
-
-
 ----------------------------------------------------------------
 --                      BodyBuilder Primitive Operations
 ----------------------------------------------------------------
@@ -954,6 +950,7 @@ updateVariableFlows prim = do
 --  performing the operation at compile-time.
 simplifyForeign ::  String -> ProcName -> [Ident] -> [PrimArg] -> Prim
 simplifyForeign "llvm" op flags args = simplifyOp op flags args
+simplifyForeign "lpvm" op flags args = simplifyLPVM op flags args
 simplifyForeign lang op flags args = PrimForeign lang op flags args
 
 
@@ -1130,6 +1127,8 @@ simplifyOp "fdiv" _ [ArgFloat n1 ty, ArgFloat n2 _, output] =
 simplifyOp "fdiv" _ [arg, ArgFloat 1 _, output] =
   primMove arg output
 -- Float comparisons
+simplifyOp "fcmp_ord" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
+  primMove (boolConstant True) output
 simplifyOp "fcmp_oeq" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
   primMove (boolConstant $ n1==n2) output
 simplifyOp "fcmp_one" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
@@ -1142,9 +1141,39 @@ simplifyOp "fcmp_ogt" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
   primMove (boolConstant $ n1>n2) output
 simplifyOp "fcmp_oge" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
   primMove (boolConstant $ n1>=n2) output
+simplifyOp "fcmp_ord" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
+  primMove (boolConstant True) output
+simplifyOp "fcmp_oeq" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
+  primMove (boolConstant $ n1==n2) output
+simplifyOp "fcmp_une" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
+  primMove (boolConstant $ n1/=n2) output
+simplifyOp "fcmp_ult" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
+  primMove (boolConstant $ n1<n2) output
+simplifyOp "fcmp_ule" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
+  primMove (boolConstant $ n1<=n2) output
+simplifyOp "fcmp_ugt" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
+  primMove (boolConstant $ n1>n2) output
+simplifyOp "fcmp_uge" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
+  primMove (boolConstant $ n1>=n2) output
+simplifyOp "fcmp_true" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
+  primMove (boolConstant True) output
+simplifyOp "fcmp_false" _ [ArgFloat n1 _, ArgFloat n2 _, output] =
+  primMove (boolConstant False) output
 simplifyOp name flags args = PrimForeign "llvm" name flags args
 
 
+-- | Simplify and canonicalise llpm instructions where possible.  For now, this only 
+--   handles cast instructions for constants.
+simplifyLPVM :: ProcName -> [Ident] -> [PrimArg] -> Prim
+simplifyLPVM "cast" _ [ArgInt n _, output] =
+  primMove (ArgInt n (argType output)) output
+simplifyLPVM "cast" _ [ArgChar ch _, output] =
+  primMove (ArgInt (fromIntegral $ ord ch) (argType output)) output
+simplifyLPVM "cast" _ [ArgFloat n _, output] =
+  primMove (ArgFloat n (argType output)) output
+simplifyLPVM name flags args = PrimForeign "lpvm" name flags args
+
+
 boolConstant :: Bool -> PrimArg
 boolConstant bool = ArgInt (fromIntegral $ fromEnum bool) boolType
 

src/Parser.hs

@@ -171,7 +171,7 @@ typeRep = do
 -- | Type declaration body where visibility, constructors, and items are given
 typeCtors :: Parser (TypeImpln,[Item])
 typeCtors = betweenB Brace $ do
-    vis <- option Private 
+    vis <- option Private
         $ try (visibility <* (ident "constructor" <|> ident "constructors"))
     ctors <- TypeCtors vis <$> ctorDecls
     items <- option [] (separator *> items)
@@ -260,7 +260,7 @@ procOrFuncItem vis = do
                 Nothing -> do
                     body <- embracedTerm >>= parseWith termToBody
                     return $ ProcDecl vis mods proto' body $ Just pos
-        
+
 
 
 -- | Parse an optional series of resource flows
@@ -1171,9 +1171,9 @@ termToExp (Call pos [] "@" flow exps) = do
     exps' <- mapM termToExp exps
     case content <$> exps' of
         [] -> return $ Placed (AnonParamVar Nothing flow) pos
-        [IntValue i] | i > 0 
+        [IntValue i] | i > 0
             -> return $ Placed (AnonParamVar (Just i) flow) pos
-        [exp] 
+        [exp]
             -> return $ Placed (AnonFunc $ head exps') pos
         _ -> syntaxError pos "invalid anonymous parameter/function expression"
 termToExp (Call pos [] "|" ParamIn [exp1,exp2]) = do
@@ -1219,6 +1219,11 @@ termToExp (Foreign pos lang inst flags args) =
 termToExp (IntConst pos num) = Right $ Placed (IntValue num) pos
 termToExp (FloatConst pos num) = Right $ Placed (FloatValue num) pos
 termToExp (CharConst pos char) = Right $ Placed (CharValue char) pos
+termToExp (StringConst pos "" DoubleQuote)
+    = return $ Placed (Fncall ["wybe","string"] "empty" False []) pos
+termToExp (StringConst pos [chr] DoubleQuote)
+    = return $ Placed (Fncall ["wybe","string"] "singleton" False
+                        [Unplaced (CharValue chr)]) pos
 termToExp (StringConst pos str DoubleQuote)
     = return $ Placed (StringValue str WybeString) pos
 termToExp (StringConst pos str (IdentQuote "c" DoubleQuote))

src/Types.hs

@@ -1219,10 +1219,9 @@ typecheckProcDecl' pdef = do
                         typeError $ ReasonUndef name callee $ place pcall
                     _ -> shouldnt "typecheckProcDecl'"
                 ) badCalls
-            ifOK pdef $ do
-                typecheckCalls calls' [] False
-                    $ List.filter (isForeign . content) calls
-                ifOK pdef $ modeCheckProcDecl pdef
+            typecheckCalls calls' [] False
+                $ List.filter (isForeign . content) calls
+            ifOK pdef $ modeCheckProcDecl pdef
 
 
 -- | If no type errors have been recorded, execute the enclosed code; otherwise