Specially handle short strings in the parser

These short strings are read using the appropriate
constructor, rather than the general buffer
constructor.  So the empty and singleton
constructors are now public.

Other changes include optimising foreign lpvm cast
instructions applied to constant chars, integers
and floats, as they get generated in this case.
This avoids several instructions in calling
unboxed constructors with constant arguments.

Also use the -n wybemk flag in final-dump-test.sh,
to turn off colourising, making diffs easier to
read.

There are numerous code improvements in final dump
tests, including allowing specialisation to kick
in in many places, since unboxed values cannot be
aliased.

There's one unfortunate change in output for
constant_type_constraint_error.wybe: the error
message for ?a = "s":int now complains about a
type error in the call to wybe.string.singleton,
which doesn't appear on the line. I think this is
tolerable for now, as it would be difficult to
fix.

Closes #473

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