Remove peculiar FFI syntax.

The only remnant is the original weird `export` syntax of the
`effectively` compiler.

Makefile

@@ -27,8 +27,6 @@ reply.c: precisely inn/System.hs $(REPLYHS) inn/reply-native.hs; (cat inn/System
 
 doh.c: precisely $(REPLYHS) inn/reply-wasm.hs inn/SystemWasm.hs; (cat inn/SystemWasm.hs $(REPLYHS) inn/BasePrecisely.hs inn/SystemWasm.hs ; echo '|]'; echo -n "ffiList = "; ./precisely ffis < inn/SystemWasm.hs; cat inn/reply-wasm.hs) | ./precisely wasm > $@
 
-#doh.c: precisely $(REPLYHS) inn/reply-wasm.hs inn/SystemWasm.hs; (cat $(REPLYHS) inn/BasePrecisely.hs inn/SystemWasm.hs ; echo '|]'; cat inn/reply-wasm.hs) | ./precisely wasm > $@
-
 doh.o:doh.c;$(WCC) $^ -c -o $@
 doh.wasm:doh.o;$(WLD) --initial-memory=41943040 --global-base=0 $^ -o $@
 doh.html:doh.txt menu.html;cobble mathbook menu $<
@@ -54,7 +52,8 @@ $(call party,multiparty.c,party,Base0 System Ast Map Parser Kiselyov Unify RTS T
 $(call party,party1.c,multiparty,Base0 System Ast1 Map Parser1 Kiselyov Unify1 RTS Typer1 party)
 $(call party,party2.c,party1,Base1 System Ast2 Map Parser2 Kiselyov Unify1 RTS1 Typer2 party1)
 $(call party,crossly.c,party2,Base1 System Ast3 Map Parser3 Kiselyov Unify1 RTS2 Typer3 party2)
-$(call party,precisely.c,crossly,BasePrecisely System AstPrecisely Map ParserPrecisely Kiselyov Unify1 RTSPrecisely TyperPrecisely precisely)
+$(call party,slowprecisely.c,crossly,BasePrecisely System AstPrecisely Map ParserPrecisely Kiselyov Unify1 RTSPrecisely TyperPrecisely precisely)
+$(call party,precisely.c,slowprecisely,BasePrecisely System AstPrecisely Map ParserPrecisely Kiselyov Unify1 RTSPrecisely TyperPrecisely precisely)
 
 $(call party,check.c,precisely,BasePrecisely System AstPrecisely Map ParserPrecisely Kiselyov Unify1 RTSPrecisely TyperPrecisely precisely)
 

assembly.hs

@@ -10,10 +10,10 @@ infixl 2 ||;
 infixl 1 >> , >>=;
 infixr 0 $;
 
-ffi "putchar" putChar :: Int -> IO Int;
-ffi "getchar" getChar :: IO Int;
-ffi "getargcount" getArgCount :: IO Int;
-ffi "getargchar" getArgChar :: Int -> Int -> IO Char;
+foreign import ccall "putchar" putChar :: Int -> IO Int;
+foreign import ccall "getchar" getChar :: IO Int;
+foreign import ccall "getargcount" getArgCount :: IO Int;
+foreign import ccall "getargchar" getArgChar :: Int -> Int -> IO Char;
 
 class Functor f where { fmap :: (a -> b) -> f a -> f b };
 class Applicative f where
@@ -478,15 +478,15 @@ instDecl r = tok "instance" *>
   (((wrap .) . Pred <$> conId <*> (inst <* tok "=>")) <|> pure [])
     <*> conId <*> inst <*> (tok "where" *> (coalesce <$> braceSep (def r))));
 
-ffiDecl = tok "ffi" *> (addFFI <$> litStr <*> var <*> (char ':' *> spch ':' *> _type aType));
-
 tops precTab = sepBy
   (   adt
   <|> classDecl
   <|> instDecl (expr precTab 0)
-  <|> ffiDecl
+  <|> tok "foreign" *>
+    ( tok "import" *> var *> (addFFI <$> litStr <*> var <*> (char ':' *> spch ':' *> _type aType))
+    <|> tok "export" *> var *> (addExport <$> litStr <*> var)
+    )
   <|> addDefs . coalesce <$> sepBy1 (def $ expr precTab 0) (spch ';')
-  <|> tok "export" *> (addExport <$> litStr <*> var)
   ) (spch ';') <* (spch ';' <|> pure ';');
 program = parse $ sp *> (((":", (5, RAssoc)):) . concat <$> many fixity) >>= tops;
 

e4096.hs

@@ -10,7 +10,7 @@ infixl 2 ||;
 infixl 1 >> , >>=;
 infixr 0 $;
 
-ffi "putchar" putChar :: Int -> IO Int;
+foreign import ccall "putchar" putChar :: Int -> IO Int;
 class Eq a where { (==) :: a -> a -> Bool };
 instance Eq Int where { (==) = intEq };
 class Ord a where { (<=) :: a -> a -> Bool };

effectively.hs

@@ -308,7 +308,7 @@ instDecl r = keyword "instance" *>
   (((wrap .) . Pred <$> conId <*> (inst <* want op "=>")) <|> pure [])
     <*> conId <*> inst <*> (keyword "where" *> braceSep (def r)));
 
-ffiDecl = keyword "ffi" *>
+ffiDecl = keyword "foreign" *> keyword "import" *> var *>
   (FFI <$> litStr <*> var <*> (char ':' *> spch ':' *> _type aType));
 
 eqn r = Def <$> (keyword "export" *> (Just <$> litStr) <|> pure Nothing) <*> def r;

guardedly.hs

@@ -10,8 +10,8 @@ infixl 2 ||;
 infixl 1 >> , >>=;
 infixr 0 $;
 
-ffi "putchar" putChar :: Int -> IO Int;
-ffi "getchar" getChar :: IO Int;
+foreign import ccall "putchar" putChar :: Int -> IO Int;
+foreign import ccall "getchar" getChar :: IO Int;
 
 class Functor f where { fmap :: (a -> b) -> f a -> f b };
 class Applicative f where
@@ -448,15 +448,15 @@ instDecl r = tok "instance" *>
   (((wrap .) . Pred <$> conId <*> (inst <* tok "=>")) <|> pure [])
     <*> conId <*> inst <*> (tok "where" *> (coalesce <$> braceSep (def r))));
 
-ffiDecl = tok "ffi" *> (addFFI <$> litStr <*> var <*> (char ':' *> spch ':' *> _type aType));
-
 tops precTab = sepBy
   (   adt
   <|> classDecl
   <|> instDecl (expr precTab 0)
-  <|> ffiDecl
+  <|> tok "foreign" *>
+    ( tok "import" *> var *> (addFFI <$> litStr <*> var <*> (char ':' *> spch ':' *> _type aType))
+    <|> tok "export" *> var *> (addExport <$> litStr <*> var)
+    )
   <|> addDefs . coalesce <$> sepBy1 (def $ expr precTab 0) (spch ';')
-  <|> tok "export" *> (addExport <$> litStr <*> var)
   ) (spch ';');
 program' = sp *> (((":", (5, RAssoc)):) . concat <$> many fixity) >>= tops;
 

hilsys.lhs

@@ -64,7 +64,7 @@ infixl 2 ||
 infixl 1 >> , >>=
 infixr 0 $
 
-ffi "putchar" putChar :: Int -> IO Int
+foreign import ccall "putchar" putChar :: Int -> IO Int
 
 class Functor f where fmap :: (a -> b) -> f a -> f b
 class Applicative f where

inn/RTSPrecisely.hs

@@ -8,7 +8,6 @@ import Ast
 import Kiselyov
 import Map
 import Parser
-
 import Typer
 
 import_qq_here = import_qq_here
@@ -511,9 +510,6 @@ void errchar(int c) {}
 void errexit() {}
 |]++)
 
-allFFIs s =
-  fromList . concatMap (toAscList . ffiImports) . elems <$> singleFile s
-
 warts opts ffis =
   ("typedef unsigned u;\n"++)
   . libcWarts

inn/Typer.hs

@@ -39,7 +39,7 @@ rewritePats dcs = \case
       cs <- flip mapM vsxs \(a:at, x) -> (a,) <$> foldM (\b (p, v) -> rewriteCase dcs v Tip [(p, b)]) x (zip at vt)
       flip (foldr L) vs <$> rewriteCase dcs vh Tip cs
 
-patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#")  y
+patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#") y
 
 rewriteCase dcs caseVar tab = \case
   [] -> flush $ V "join#"

inn/Typer1.hs

@@ -42,7 +42,7 @@ rewritePats dcs = \case
       cs <- flip mapM vsxs \(a:at, x) -> (a,) <$> foldM (\b (p, v) -> rewriteCase dcs v Tip [(p, b)]) x (zip at vt)
       flip (foldr L) vs <$> rewriteCase dcs vh Tip cs
 
-patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#")  y
+patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#") y
 
 rewriteCase dcs caseVar tab = \case
   [] -> flush $ V "join#"

inn/Typer2.hs

@@ -42,7 +42,7 @@ rewritePats dcs = \case
       cs <- flip mapM vsxs \(a:at, x) -> (a,) <$> foldM (\b (p, v) -> rewriteCase dcs v Tip [(p, b)]) x (zip at $ tail vs)
       flip (foldr L) vs <$> rewriteCase dcs (head vs) Tip cs
 
-patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#")  y
+patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#") y
 
 rewriteCase dcs caseVar tab = \case
   [] -> flush $ V "join#"

inn/Typer3.hs

@@ -43,7 +43,7 @@ rewritePats searcher = \case
       cs <- flip mapM vsxs \(a:at, x) -> (a,) <$> foldM (\b (p, v) -> rewriteCase searcher v Tip [(p, b)]) x (zip at $ tail vs)
       flip (foldr L) vs <$> rewriteCase searcher (head vs) Tip cs
 
-patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#")  y
+patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#") y
 
 rewriteCase searcher caseVar tab = \case
   [] -> flush $ V "join#"

inn/TyperPrecisely.hs

@@ -22,7 +22,7 @@ rewritePats searcher = \case
 
 scottCase q x = A (assertType (E $ Basic "I") q) x
 
-patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#")  y
+patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#") y
 
 rewriteCase searcher caseVar tab = \case
   [] -> flush $ V "join#"

inn/precisely.hs

@@ -50,6 +50,8 @@ objDump s = do
     . shows (_mem m)
     . ("\n  })\n"++)
 
+allFFIs s = fromList . concatMap (toAscList . ffiImports) . elems <$> singleFile s
+
 main = getArgs >>= \case
   "obj":_ -> interact $ either id ($ "") . objDump
   "matrix":_ -> interact $ dumpWith dumpMatrix

lonely.hs

@@ -10,8 +10,8 @@ infixl 2 ||;
 infixl 1 >> , >>=;
 infixr 0 $;
 
-ffi "putchar" putChar :: Int -> IO Int;
-ffi "getchar" getChar :: IO Int;
+foreign import ccall "putchar" putChar :: Int -> IO Int;
+foreign import ccall "getchar" getChar :: IO Int;
 
 class Functor f where { fmap :: (a -> b) -> f a -> f b };
 class Applicative f where
@@ -434,16 +434,16 @@ instDecl r = keyword "instance" *>
   (((wrap .) . Pred <$> conId <*> (inst <* want varSym "=>")) <|> pure [])
     <*> conId <*> inst <*> (keyword "where" *> braceSep (def r)));
 
-ffiDecl = keyword "ffi" *>
-  (addFFI <$> litStr <*> var <*> (char ':' *> spch ':' *> _type aType));
-
 tops precTab = sepBy
   (   adt
   <|> classDecl
   <|> instDecl (expr precTab 0)
-  <|> ffiDecl
+  <|> keyword "foreign" *>
+    ( keyword "import" *> var *>
+      (addFFI <$> litStr <*> var <*> (char ':' *> spch ':' *> _type aType))
+    <|> keyword "export" *> var *> (addExport <$> litStr <*> var)
+    )
   <|> addDef <$> def (expr precTab 0)
-  <|> keyword "export" *> (addExport <$> litStr <*> var)
   ) (spch ';');
 program' = sp *> (((":", (5, RAssoc)):) . concat <$> many fixity) >>= tops;
 

marginally.hs

@@ -10,10 +10,10 @@ infixl 2 ||;
 infixl 1 >> , >>=;
 infixr 0 $;
 
-ffi "putchar" putChar :: Int -> IO Int;
-ffi "getchar" getChar :: IO Int;
-ffi "getargcount" getArgCount :: IO Int;
-ffi "getargchar" getArgChar :: Int -> Int -> IO Char;
+foreign import ccall "putchar" putChar :: Int -> IO Int;
+foreign import ccall "getchar" getChar :: IO Int;
+foreign import ccall "getargcount" getArgCount :: IO Int;
+foreign import ccall "getargchar" getArgChar :: Int -> Int -> IO Char;
 
 class Functor f where { fmap :: (a -> b) -> f a -> f b };
 class Applicative f where
@@ -361,7 +361,7 @@ integer = char '0' *> (char 'x' <|> char 'X') *> hexadecimal <|> decimal;
 literal = Lit . Const <$> integer <|> Lit . ChrCon <$> tokChar <|> Lit . StrCon <$> tokStr;
 varId = fmap ck $ liftA2 (:) small $ many (small <|> large <|> digit <|> char '\'') where
   { ck s = (if elem s
-    ["ffi", "export", "case", "class", "data", "default", "deriving", "do", "else", "foreign", "if", "import", "in", "infix", "infixl", "infixr", "instance", "let", "module", "newtype", "of", "then", "type", "where", "_"]
+    ["export", "case", "class", "data", "default", "deriving", "do", "else", "foreign", "if", "import", "in", "infix", "infixl", "infixr", "instance", "let", "module", "newtype", "of", "then", "type", "where", "_"]
     then Reserved else VarId) s };
 varSym = fmap ck $ (:) <$> sat (\c -> isSymbol c && c /= ':') <*> many (sat isSymbol) where
   { ck s = (if elem s ["..", "=", "\\", "|", "<-", "->", "@", "~", "=>"] then Reserved else VarSym) s };
@@ -767,8 +767,10 @@ topdecls = braceSep
   (   adt
   <|> classDecl
   <|> instDecl
-  <|> res "ffi" *> (addFFI <$> wantString <*> var <*> (res "::" *> _type))
-  <|> res "export" *> (addExport <$> wantString <*> var)
+  <|> res "foreign" *>
+    (   res "import" *> var *> (addFFI <$> wantString <*> var <*> (res "::" *> _type))
+    <|> res "export" *> var *> (addExport <$> wantString <*> var)
+    )
   <|> addDefs <$> defSemi
   <|> fixity
   );

methodically.hs

@@ -11,10 +11,10 @@ infixl 2 ||
 infixl 1 >> , >>=
 infixr 0 $
 
-ffi "putchar" putChar :: Int -> IO Int
-ffi "getchar" getChar :: IO Int
-ffi "getargcount" getArgCount :: IO Int
-ffi "getargchar" getArgChar :: Int -> Int -> IO Char
+foreign import ccall "putchar" putChar :: Int -> IO Int
+foreign import ccall "getchar" getChar :: IO Int
+foreign import ccall "getargcount" getArgCount :: IO Int
+foreign import ccall "getargchar" getArgChar :: Int -> Int -> IO Char
 
 libc = [r|#include<stdio.h>
 static int env_argc;
@@ -376,7 +376,7 @@ integer = char '0' *> (char 'x' <|> char 'X') *> hexadecimal <|> decimal
 literal = Lit . Const <$> integer <|> Lit . ChrCon <$> tokChar <|> Lit . StrCon <$> tokStr
 varId = fmap ck $ liftA2 (:) small $ many (small <|> large <|> digit <|> char '\'') where
   ck s = (if elem s
-    ["ffi", "export", "case", "class", "data", "default", "deriving", "do", "else", "foreign", "if", "import", "in", "infix", "infixl", "infixr", "instance", "let", "module", "newtype", "of", "then", "type", "where", "_"]
+    ["export", "case", "class", "data", "default", "deriving", "do", "else", "foreign", "if", "import", "in", "infix", "infixl", "infixr", "instance", "let", "module", "newtype", "of", "then", "type", "where", "_"]
     then Reserved else VarId) s
 varSym = fmap ck $ (:) <$> sat (\c -> isSymbol c && c /= ':') <*> many (sat isSymbol) where
   ck s = (if elem s ["..", "=", "\\", "|", "<-", "->", "@", "~", "=>"] then Reserved else VarSym) s
@@ -775,8 +775,6 @@ topdecls = braceSep
     (   res "import" *> var *> (addFFI <$> wantString <*> var <*> (res "::" *> _type))
     <|> res "export" *> var *> (addExport <$> wantString <*> var)
     )
-  <|> res "ffi" *> (addFFI <$> wantString <*> var <*> (res "::" *> _type))
-  <|> res "export" *> (addExport <$> wantString <*> var)
   <|> addDefs <$> defSemi
   <|> fixity *> pure id
   )
@@ -940,7 +938,7 @@ rewritePats dcs = \case
       cs <- flip mapM vsxs \(a:at, x) -> (a,) <$> foldM (\b (p, v) -> rewriteCase dcs v Tip [(p, b)]) x (zip at vt)
       flip (foldr L) vs <$> rewriteCase dcs vh Tip cs
 
-patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#")  y
+patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#") y
 
 rewriteCase dcs caseVar tab = \case
   [] -> flush $ V "join#"

mutually.hs

@@ -10,10 +10,10 @@ infixl 2 ||;
 infixl 1 >> , >>=;
 infixr 0 $;
 
-ffi "putchar" putChar :: Int -> IO Int;
-ffi "getchar" getChar :: IO Int;
-ffi "getargcount" getArgCount :: IO Int;
-ffi "getargchar" getArgChar :: Int -> Int -> IO Char;
+foreign import ccall "putchar" putChar :: Int -> IO Int;
+foreign import ccall "getchar" getChar :: IO Int;
+foreign import ccall "getargcount" getArgCount :: IO Int;
+foreign import ccall "getargchar" getArgChar :: Int -> Int -> IO Char;
 
 class Functor f where { fmap :: (a -> b) -> f a -> f b };
 class Applicative f where
@@ -534,15 +534,15 @@ instDecl r = tok "instance" *>
   (((wrap .) . Pred <$> conId <*> (inst <* tok "=>")) <|> pure [])
     <*> conId <*> inst <*> (tok "where" *> (coalesce <$> braceSep (def r))));
 
-ffiDecl = tok "ffi" *> (addFFI <$> litStr <*> var <*> (char ':' *> spch ':' *> _type aType));
-
 tops precTab = sepBy
   (   adt
   <|> classDecl
   <|> instDecl (expr precTab 0)
-  <|> ffiDecl
+  <|> tok "foreign" *>
+    ( tok "import" *> var *> (addFFI <$> litStr <*> var <*> (char ':' *> spch ':' *> _type aType))
+    <|> tok "export" *> var *> (addExport <$> litStr <*> var)
+    )
   <|> addDefs . coalesce <$> sepBy1 (def $ expr precTab 0) (spch ';')
-  <|> tok "export" *> (addExport <$> litStr <*> var)
   ) (spch ';') <* (spch ';' <|> pure ';');
 program = parse $ sp *> (((":", (5, RAssoc)):) . concat <$> many fixity) >>= tops;
 

mvp.lhs

@@ -279,10 +279,6 @@ Now that the syntax is slightly more pleasant:
 
   * We support list comprehensions.
 
-  * To match GHC, we support `foreign import ccall` as well as `ffi`,
-  and `foreign export ccall` as well as `export`. In the next compiler,
-  we'll remove `ffi` and plain `export`.
-
 We prepare to change `getChar` to match Haskell's, which throws an exception on
 end of input. Up until now, ours simply calls the `getchar` function of C,
 which returns -1 on end of input. Also, we would like Haskell's `isEOF` so we

party.hs

@@ -1009,7 +1009,7 @@ rewritePats dcs = \case
       cs <- flip mapM vsxs \(a:at, x) -> (a,) <$> foldM (\b (p, v) -> rewriteCase dcs v Tip [(p, b)]) x (zip at vt)
       flip (foldr L) vs <$> rewriteCase dcs vh Tip cs
 
-patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#")  y
+patEq lit b x y = A (L "join#" $ A (A (A (V "if") (A (A (V "==") (E lit)) b)) x) $ V "join#") y
 
 rewriteCase dcs caseVar tab = \case
   [] -> flush $ V "join#"

patty.hs

@@ -4,14 +4,14 @@ infixl 7 * , / , %;
 infixl 6 + , -;
 infixr 5 ++;
 infixl 4 <*> , <$> , <* , *>;
-infix 4 == , /= , <=;
+infix 4 == , <=;
 infixl 3 && , <|>;
 infixl 2 ||;
 infixl 1 >> , >>=;
 infixr 0 $;
 
-ffi "putchar" putChar :: Int -> IO Int;
-ffi "getchar" getChar :: IO Int;
+foreign import ccall "putchar" putChar :: Int -> IO Int;
+foreign import ccall "getchar" getChar :: IO Int;
 
 data Bool = True | False;
 ife a b c = case a of { True -> b ; False -> c };
@@ -514,16 +514,16 @@ instDecl r = keyword "instance" *>
   (((wrap .) . Pred <$> conId <*> (inst <* want varSym "=>")) <|> pure [])
     <*> conId <*> inst <*> (keyword "where" *> (coalesce <$> braceSep (def r))));
 
-ffiDecl = keyword "ffi" *>
-  (addFFI <$> litStr <*> var <*> (char ':' *> spch ':' *> _type aType));
-
 tops precTab = sepBy
   (   adt
   <|> classDecl
   <|> instDecl (expr precTab 0)
-  <|> ffiDecl
+  <|> keyword "foreign" *>
+    ( keyword "import" *> var *>
+      (addFFI <$> litStr <*> var <*> (char ':' *> spch ':' *> _type aType))
+    <|> keyword "export" *> var *> (addExport <$> litStr <*> var)
+    )
   <|> addDefs . coalesce <$> sepBy1 (def $ expr precTab 0) (spch ';')
-  <|> keyword "export" *> (addExport <$> litStr <*> var)
   ) (spch ';');
 program' = sp *> (((":", (5, RAssoc)):) . concat <$> many fixity) >>= tops;
 

q11.hs

@@ -10,7 +10,7 @@ infixl 2 ||;
 infixl 1 >> , >>=;
 infixr 0 $;
 
-ffi "putchar" putChar :: Int -> IO Int;
+foreign import ccall "putchar" putChar :: Int -> IO Int;
 
 class Eq a where { (==) :: a -> a -> Bool };
 instance Eq Int where { (==) = intEq };