C compiler

5 files changed, 157 insertions, 1 deletions

diff --git a/examples/gfcc/Imper.gf b/examples/gfcc/Imper.gf
new file mode 100644
index 000000000..e67e504f8
--- /dev/null
+++ b/examples/gfcc/Imper.gf
@@ -0,0 +1,52 @@
+abstract Imper = {
+
+  cat
+    Stm ;
+    Typ ;
+    Exp Typ ;
+    Var Typ ;
+
+  fun
+    Decl   : (A : Typ) -> (Var A -> Stm) -> Stm ;
+    Assign : (A : Typ) -> Var A -> Exp A -> Stm ;
+    Return : (A : Typ) -> Exp A -> Stm ;
+    While  : Exp TInt -> Stm -> Stm ;
+    Block  : Stm -> Stm ;
+    None   : Stm ;
+    Next   : Stm -> Stm -> Stm ;
+
+    EVar   : (A : Typ) -> Var A -> Exp A ;
+    EInt   : Int -> Exp TInt ;
+    EFloat : Int -> Int -> Exp TFloat ;
+    EAddI  : Exp TInt -> Exp TInt -> Exp TInt ;
+    EAddF  : Exp TFloat -> Exp TFloat -> Exp TFloat ;
+
+    TInt   : Typ ;
+    TFloat : Typ ;
+
+  cat
+    Program ;
+    Typs ;
+    Fun Typs Typ ;
+    Body Typs ;
+    Exps Typs ;
+
+  fun
+    Empty : Program ;
+    Funct : (AS : Typs) -> (V : Typ) -> 
+              (Body AS) -> (Fun V AS -> Program) -> Program ;
+
+    NilTyp : Typs ;
+    ConsTyp : Typ -> Typs -> Typs ;
+
+    BodyNil  : Stm -> Body NilTyp ;
+    BodyCons : (A : Typ) -> (AS : Typs) -> 
+                  (Var A -> Body AS) -> Body (ConsTyp A AS) ;
+
+    EApp  : (args : Typs) -> (val : Typ) -> Fun args val -> Exps args -> Exp val ;
+
+    NilExp : Exps NilTyp ;
+    ConsExp : (A : Typ) -> (AS : Typs) -> 
+                 Exp A -> Exps AS -> Exps (ConsExp A AS) ;
+
+}
diff --git a/examples/gfcc/ImperC.gf b/examples/gfcc/ImperC.gf
new file mode 100644
index 000000000..9fdf6f6af
--- /dev/null
+++ b/examples/gfcc/ImperC.gf
@@ -0,0 +1,54 @@
+--# -path=.:../prelude
+
+concrete ImperC of Imper = open Prelude, Precedence, ResImper in {
+
+flags lexer=codevars ; unlexer=code ; startcat=Stm ;
+  lincat
+    Stm = SS ;
+    Typ = SS ;
+    Exp = {s : PrecTerm} ;
+    Var = SS ;
+
+  lin
+    Decl  typ cont = continue  (typ.s ++ cont.$0) cont ;
+    Assign _ x exp = statement (x.s ++ "=" ++ ex exp) ;
+    Return _ exp   = statement ("return" ++ ex exp) ;
+    While exp loop = statement ("while" ++ paren (ex exp) ++ loop.s) ;
+    Block stm      = ss ("{" ++ stm.s ++ "}") ;
+    None           = ss ";" ;
+    Next stm cont  = ss (stm.s ++ cont.s) ;      
+
+    EVar  _ x  = constant x.s ;
+    EInt    n  = constant n.s ;
+    EFloat a b = constant (a.s ++ "." ++ b.s) ;
+    EAddI      = infixL p2 "+" ;
+    EAddF      = infixL p2 "+" ;
+
+    TInt       = ss "int" ;
+    TFloat     = ss "float" ;
+ 
+  lincat
+    Program = SS ;
+    Typs = SS ;
+    Fun = SS ;
+    Body = {s,s2 : Str} ;
+    Exps = SS ;
+
+  lin
+    Empty = ss [] ;
+    Funct args val body cont = ss (
+      val.s ++ cont.$0 ++ paren body.s2 ++ "{" ++ 
+        body.s ++ 
+      "}" ++ ";" ++ 
+      cont.s
+      ) ;
+
+    BodyNil stm = stm ** {s2 = []} ;
+    BodyCons typ _ body = {s = body.s ; s2 = typ.s ++ body.$0 ++ "," ++ body.s2} ;
+
+    EApp args val f exps = constant (f.s ++ paren exps.s) ;
+
+    NilExp = ss [] ;
+    ConsExp _ _ e es = ss (ex e ++ "," ++ es.s) ;
+
+}
diff --git a/examples/gfcc/ImperJVM.gf b/examples/gfcc/ImperJVM.gf
new file mode 100644
index 000000000..10457fbfe
--- /dev/null
+++ b/examples/gfcc/ImperJVM.gf
@@ -0,0 +1,30 @@
+--# -path=.:../prelude
+
+concrete ImperJVM of Imper = open Prelude, Precedence, ResImper in {
+
+flags lexer=codevars ; unlexer=code ; startcat=Stm ;
+  lincat
+    Stm = SS ;
+    Typ = SS ;
+    Exp = SS ;
+    Var = SS ;
+
+  lin
+    Decl  typ cont = ss [] ; ----
+    Assign t x exp = statement (exp.s ++ t.s ++ "_store" ++ x.s) ;
+    Return t exp   = statement (exp.s ++ t.s ++ "_return") ;
+    While exp loop = statement ("TEST:" ++ exp.s ++ "ifzero_goto" ++
+    "END" ++ ";" ++ loop.s ++ "END") ;
+    Block stm      = stm ;
+    Next stm cont  = ss (stm.s ++ cont.s) ;      
+
+    EVar  t x  = statement (t.s ++ "_load" ++ x.s) ;
+    EInt    n  = statement ("i_push" ++ n.s) ;
+    EFloat a b = statement ("f_push" ++ a.s ++ "." ++ b.s) ;
+    EAddI  x y = statement (x.s ++ y.s ++ "iadd") ;
+    EAddF  x y = statement (x.s ++ y.s ++ "fadd") ;
+
+    TInt       = ss "i" ;
+    TFloat     = ss "f" ;
+
+}
diff --git a/examples/gfcc/ResImper.gf b/examples/gfcc/ResImper.gf
new file mode 100644
index 000000000..d77322d75
--- /dev/null
+++ b/examples/gfcc/ResImper.gf
@@ -0,0 +1,13 @@
+resource ResImper = open Prelude, Precedence in {
+
+  oper
+    continue  : Str -> SS -> SS = \s -> infixSS ";" (ss s); 
+    statement : Str -> SS       = \s -> postfixSS ";" (ss s); 
+    ex       : {s : PrecTerm} -> Str = \exp -> exp.s ! p0 ;
+    infixL   : 
+      Prec -> Str -> {s : PrecTerm} -> {s : PrecTerm} -> {s : PrecTerm} =
+        \p,h,x,y -> {s = mkInfixL h p x.s y.s} ;
+
+    constant : Str -> {s : PrecTerm} = \c -> {s = mkConst c} ;
+
+}
\ No newline at end of file
diff --git a/src/GF/UseGrammar/Tokenize.hs b/src/GF/UseGrammar/Tokenize.hs
index 7ae3463a0..d53fb0597 100644
--- a/src/GF/UseGrammar/Tokenize.hs
+++ b/src/GF/UseGrammar/Tokenize.hs
@@ -130,13 +130,20 @@ reservedAnsiCWords = words $
 
 unknown2string :: (String -> Bool) -> [CFTok] -> [CFTok]
 unknown2string isKnown = map mkOne where
-  mkOne t@(TS s) = if isKnown s then t else mkTL s
+  mkOne t@(TS s) 
+    | isKnown s = t
+    | all isDigit s = tI s 
+    | otherwise = tV s
   mkOne t@(TC s) = if isKnown s then t else mkTL s
   mkOne t        = t
 
 unknown2var :: (String -> Bool) -> [CFTok] -> [CFTok]
 unknown2var isKnown = map mkOne where
   mkOne t@(TS "??") = if isKnown "??" then t else tM "??"
+  mkOne t@(TS s) 
+    | isKnown s = t
+    | all isDigit s = tI s 
+    | otherwise = tV s
   mkOne t@(TS s) = if isKnown s then t else tV s
   mkOne t@(TC s) = if isKnown s then t else tV s
   mkOne t        = t