Ints n

8 files changed, 125 insertions, 25 deletions

diff --git a/examples/gfcc/ImperC.gf b/examples/gfcc/ImperC.gf
index 69ffa9226..a97688529 100644
--- a/examples/gfcc/ImperC.gf
+++ b/examples/gfcc/ImperC.gf
@@ -36,10 +36,10 @@ concrete ImperC of Imper = open ResImper in {
     EVar  _ x  = constant x.s ;
     EInt    n  = constant n.s ;
     EFloat a b = constant (a.s ++ "." ++ b.s) ;
-    EMul _     = infixL P2 "*" ;
-    EAdd _     = infixL P1 "+" ;
-    ESub _     = infixL P1 "-" ;
-    ELt _      = infixN P0 "<" ;
+    EMul _     = infixL 3 "*" ;
+    EAdd _     = infixL 2 "+" ;
+    ESub _     = infixL 2 "-" ;
+    ELt _      = infixN 1 "<" ;
 
     EApp args val f exps = constant (f.s ++ paren exps.s) ;
 
diff --git a/examples/gfcc/ResImper.gf b/examples/gfcc/ResImper.gf
index 62097bdc3..beea5f549 100644
--- a/examples/gfcc/ResImper.gf
+++ b/examples/gfcc/ResImper.gf
@@ -1,33 +1,28 @@
-resource ResImper = {
+resource ResImper = open Predef in {
 
   -- precedence
 
-  param
-    Prec = P0 | P1 | P2 | P3 ;
-  oper
-    PrecExp   : Type = {s : Prec => Str} ;
-    ex        : PrecExp -> Str = \exp -> exp.s ! P0 ;
-    constant  : Str -> PrecExp = \c -> {s = \\_ => c} ;
+  oper 
+    Prec     : PType = Predef.Ints 4 ;
+    PrecExp  : Type = {s : Prec => Str} ;
+    ex       : PrecExp -> Str = \exp -> exp.s ! 0 ;
+    constant : Str -> PrecExp = \c -> {s = \\_ => c} ;
     infixN : Prec -> Str -> PrecExp -> PrecExp -> PrecExp = \p,f,x,y ->
-      {s = \\k => mkPrec (x.s ! (nextPrec ! p) ++ f ++ y.s ! (nextPrec ! p)) ! p ! k} ;
+      {s = mkPrec (x.s ! (nextPrec ! p) ++ f ++ y.s ! (nextPrec ! p)) ! p} ;
     infixL : Prec -> Str -> PrecExp -> PrecExp -> PrecExp = \p,f,x,y ->
       {s = mkPrec (x.s ! p ++ f ++ y.s ! (nextPrec ! p)) ! p} ;
 
-    nextPrec : Prec => Prec = table {P0 => P1 ; P1 => P2 ; _ => P3} ;
-    mkPrec : Str -> Prec => Prec => Str = \str -> table {
-      P3 => table {                -- use the term of precedence P3...
-        _   => str} ;              -- ...always without parentheses
-      P2 => table {                -- use the term of precedence P2...
-        P3  => paren str ;     -- ...in parentheses if P3 is expected...
-        _   => str} ;              -- ...otherwise without parentheses
-      P1 => table {
-        P3 | P2 => paren str ;
-        _  => str} ;
-      P0 => table {
-        P0  => str ;
-        _   => paren str}
+    nextPrec : Prec => Prec = table {
+      4 => 4 ; 
+      n => Predef.plus n 1
       } ;
 
+    mkPrec : Str -> Prec => Prec => Str = \str -> 
+      \\p,q => case Predef.lessInt p q of {
+        Predef.PTrue => paren str ;
+        _ => str
+        } ;
+
   -- string operations
 
     SS  : Type = {s : Str} ;
diff --git a/examples/gfcc/compiler/CleanJVM.hs b/examples/gfcc/compiler/CleanJVM.hs
new file mode 100644
index 000000000..02070df4c
--- /dev/null
+++ b/examples/gfcc/compiler/CleanJVM.hs
@@ -0,0 +1,30 @@
+module Main where
+
+import System
+
+main :: IO ()
+main = do
+  jvm:src:_ <- getArgs
+  s <- readFile jvm
+  let obj = takeWhile (/='.') src ++ ".j"
+  writeFile obj $ mkJVM s
+  putStrLn $ "wrote file " ++ obj
+
+mkJVM :: String -> String
+mkJVM = unlines . reverse . fst . foldl trans ([],([],0)) . lines where
+  trans (code,(env,v)) s = case words s of
+    ".method":f:ns -> ((".method " ++ f ++ concat ns):code,([],0))
+    "alloc":t:x:_  -> (code, ((x,v):env, v + size t))
+    ".limit":"locals":ns -> chCode (".limit locals " ++ show (length ns - 1))
+    t:"_load" :x:_ -> chCode (t ++ "load "  ++ look x) 
+    t:"_store":x:_ -> chCode (t ++ "store " ++ look x)
+    t:"_return":_  -> chCode (t ++ "return")
+    "goto":ns      -> chCode ("goto " ++ concat ns)
+    "ifzero":ns    -> chCode ("ifzero " ++ concat ns) 
+    _ ->   chCode s
+   where
+     chCode c = (c:code,(env,v))
+     look x = maybe (x ++ show env) show $ lookup x env
+     size t = case t of
+       "d" -> 2
+       _ -> 1
diff --git a/examples/gfcc/compiler/FILES b/examples/gfcc/compiler/FILES
new file mode 100644
index 000000000..306a8d133
--- /dev/null
+++ b/examples/gfcc/compiler/FILES
@@ -0,0 +1,39 @@
+GF sources:
+----------
+Imper.gf      -- abstract syntax of an imperative language
+ImperC.gf     -- concrete syntax for C notation
+ImperJVM.gf   -- concrete syntax for JVM notation
+ResImper.gf   -- resource module for concrete syntaxes
+
+Scripts:
+-------
+gfcc          -- the main compiler executable reading Foo.c ; shell script
+typecheck.gfs -- the type checker and constraint solver ; GF editor script
+CleanJVM.hs   -- cleans up jvm.tmp to produce Foo.j ; Haskell module
+makefile      -- builds the compiler from GF source ; Unix Make file
+
+Generated files:
+---------------
+Imper.gfcm    -- canonical multilingual GF grammar for C and JVM
+ImperC.cf     -- LBNF grammar for C generated from Imper.gfcm
+gft.tmp       -- parse result generated by the compiler front end
+jvm.tmp       -- pseudo-JVM produced by GF linearization
+
+Required programs to use the compiler:
+-------------------------------------
+gf+       -- Grammatical Framework version 2.0+, >= 23/9/2004
+jasmin    -- JVM assembler (to compile Foo.j to Foo.class)
+
+Required programs to build the compiler:
+---------------------------------------
+bnfc       -- BNF Converter version 2.1+,  >= 23/9/2004
+happy      -- parser generator for Haskell, >= 1.13 
+alex       -- lexer generator for Haskell, >= 2.0
+Profile.hs -- BNFC source file (formats/profile), must be on your path
+Trees.hs   -- BNFC source file (formats/profile), must be on your path
+
+File formats:
+------------
+Foo.c      -- C source file
+Foo.j      -- generated Jasmin JVM assembler file
+Foo.class  -- assembled JVM bytecode file
diff --git a/examples/gfcc/compiler/abs.c b/examples/gfcc/compiler/abs.c
new file mode 100644
index 000000000..c93b703b6
--- /dev/null
+++ b/examples/gfcc/compiler/abs.c
@@ -0,0 +1,12 @@
+int abs (int x){
+  if (x < 0){
+    return 0 - x ;
+    }
+  else return x ;
+  } ;
+int main () {
+  int i ;
+  i = abs (16);
+  } ;
+
+
diff --git a/examples/gfcc/compiler/gfcc b/examples/gfcc/compiler/gfcc
new file mode 100644
index 000000000..5ad505061
--- /dev/null
+++ b/examples/gfcc/compiler/gfcc
@@ -0,0 +1,4 @@
+./TestImperC $1 | tail -1 >gft.tmp
+echo "es -file=typecheck.gfs" | gf+ -s Imper.gfcm
+runhugs CleanJVM jvm.tmp $1
+rm *.tmp
diff --git a/examples/gfcc/compiler/makefile b/examples/gfcc/compiler/makefile
new file mode 100644
index 000000000..754f77f51
--- /dev/null
+++ b/examples/gfcc/compiler/makefile
@@ -0,0 +1,12 @@
+GF=gf+
+SRC=../
+
+all: compiler
+
+compiler:
+	echo "pm | wf Imper.gfcm ;; pg -lang=ImperC -printer=lbnf | wf ImperC.tmp" | $(GF) $(SRC)ImperC.gf $(SRC)ImperJVM.gf
+	echo "entrypoints Program, Stm, Exp ;" >entry.tmp
+	cat entry.tmp ImperC.tmp >ImperC.cf
+	bnfc -m -prof ImperC.cf
+	make -f Makefile
+	rm *.tmp
diff --git a/examples/gfcc/compiler/typecheck.gfs b/examples/gfcc/compiler/typecheck.gfs
new file mode 100644
index 000000000..30bf320d4
--- /dev/null
+++ b/examples/gfcc/compiler/typecheck.gfs
@@ -0,0 +1,8 @@
+n Program
+open gft.tmp
+'
+c solve
+'
+c reindex
+'
+save ImperJVM jvm.tmp