diff --git a/examples/gfcc/Imper.gf b/examples/gfcc/Imper.gf index 31ca82f75..28ac3d4bd 100644 --- a/examples/gfcc/Imper.gf +++ b/examples/gfcc/Imper.gf @@ -2,6 +2,7 @@ abstract Imper = PredefAbs ** { cat Program ; + Rec ListTyp ; Typ ; NumTyp ; ListTyp ; @@ -15,12 +16,13 @@ abstract Imper = PredefAbs ** { fun Empty : Program ; Funct : (AS : ListTyp) -> (V : Typ) -> - Body AS -> (Fun AS V -> Program) -> Program ; + (Fun AS V -> Rec AS) -> Program ; + FunctNil : (V : Typ) -> + Stm -> (Fun NilTyp V -> Program) -> Program ; - BodyNil : Stm -> Body NilTyp ; - BodyOne : (A : Typ) -> (Var A -> Stm) -> Body (ConsTyp A NilTyp) ; - BodyCons : (A : Typ) -> (AS : ListTyp) -> - (Var A -> Body AS) -> Body (ConsTyp A AS) ; + RecOne : (A : Typ) -> (Var A -> Stm) -> Program -> Rec (ConsTyp A NilTyp) ; + RecCons : (A : Typ) -> (AS : ListTyp) -> + (Var A -> Rec AS) -> Program -> Rec (ConsTyp A AS) ; Decl : (A : Typ) -> (Var A -> Stm) -> Stm ; Assign : (A : Typ) -> Var A -> Exp A -> Stm -> Stm ; diff --git a/examples/gfcc/ImperC.gf b/examples/gfcc/ImperC.gf index 28ce65a95..69ffa9226 100644 --- a/examples/gfcc/ImperC.gf +++ b/examples/gfcc/ImperC.gf @@ -4,21 +4,25 @@ concrete ImperC of Imper = open ResImper in { lincat Exp = PrecExp ; - Body = {s,s2 : Str} ; + Rec = {s,s2,s3 : Str} ; lin Empty = ss [] ; - Funct args val body cont = ss ( - val.s ++ cont.$0 ++ paren body.s2 ++ "{" ++ - body.s ++ "}" ++ ";" ++ cont.s) ; + FunctNil val stm cont = ss ( + val.s ++ cont.$0 ++ paren [] ++ "{" ++ + stm.s ++ "}" ++ ";" ++ cont.s) ; + Funct args val rec = ss ( + val.s ++ rec.$0 ++ paren rec.s2 ++ "{" ++ + rec.s ++ "}" ++ ";" ++ rec.s3) ; - BodyNil stm = stm ** {s2 = []} ; - BodyOne typ stm = stm ** { - s2 = typ.s ++ stm.$0 + RecOne typ stm prg = stm ** { + s2 = typ.s ++ stm.$0 ; + s3 = prg.s } ; - BodyCons typ _ body = { + RecCons typ _ body prg = { s = body.s ; s2 = typ.s ++ body.$0 ++ "," ++ body.s2 ; + s3 = prg.s } ; Decl typ cont = continues (typ.s ++ cont.$0) cont ; diff --git a/examples/gfcc/ImperJVM.gf b/examples/gfcc/ImperJVM.gf index 59506c47b..1cfce48df 100644 --- a/examples/gfcc/ImperJVM.gf +++ b/examples/gfcc/ImperJVM.gf @@ -1,24 +1,37 @@ +--# -path=.:../prelude concrete ImperJVM of Imper = open ResImper in { flags lexer=codevars ; unlexer=code ; startcat=Stm ; lincat - Body = {s,s2 : Str} ; -- code, storage for locals + Rec = {s,s2,s3 : Str} ; -- code, storage for locals, continuation Stm = Instr ; lin Empty = ss [] ; - Funct args val body rest = ss ( - ".method" ++ rest.$0 ++ paren args.s ++ val.s ++ ";" ++ - ".limit" ++ "locals" ++ body.s2 ++ ";" ++ + FunctNil val stm cont = ss ( + ".method" ++ cont.$0 ++ paren [] ++ val.s ++ ";" ++ + ".limit" ++ "locals" ++ stm.s2 ++ ";" ++ ".limit" ++ "stack" ++ "1000" ++ ";" ++ - body.s ++ + stm.s ++ ".end" ++ "method" ++ ";" ++ - rest.s + cont.s ) ; - BodyNil stm = stm ; - BodyCons a as body = instrb a.s ( - "alloc" ++ a.s ++ body.$0 ++ body.s2) (body ** {s3 = []}); + Funct args val rec = ss ( + ".method" ++ rec.$0 ++ paren args.s ++ val.s ++ ";" ++ + ".limit" ++ "locals" ++ rec.s2 ++ ";" ++ + ".limit" ++ "stack" ++ "1000" ++ ";" ++ + rec.s ++ + ".end" ++ "method" ++ ";" ++ + rec.s3 + ) ; + + RecOne typ stm prg = instrb typ.s ( + "alloc" ++ typ.s ++ stm.$0 ++ stm.s2) {s = stm.s ; s2 = stm.s2 ; s3 = prg.s}; + + RecCons typ _ body prg = instrb typ.s ( + "alloc" ++ typ.s ++ body.$0 ++ body.s2) + {s = body.s ; s2 = body.s2 ; s3 = prg.s}; Decl typ cont = instrb typ.s ( "alloc" ++ typ.s ++ cont.$0 @@ -61,19 +74,16 @@ flags lexer=codevars ; unlexer=code ; startcat=Stm ; EVar t x = instr (t.s ++ "_load" ++ x.s) ; EInt n = instr ("ipush" ++ n.s) ; EFloat a b = instr ("fpush" ++ a.s ++ "." ++ b.s) ; - EAddI = binop "iadd" ; - EAddF = binop "fadd" ; - ESubI = binop "isub" ; - ESubF = binop "fsub" ; - EMulI = binop "imul" ; - EMulF = binop "fmul" ; - ELtI = binop ("call" ++ "ilt") ; - ELtF = binop ("call" ++ "flt") ; + EAdd = binopt "add" ; + ESub = binopt "sub" ; + EMul = binopt "mul" ; + ELt t = binop ("invoke" ++ t.s ++ "lt" ++ paren (t.s ++ t.s) ++ "i") ; EApp args val f exps = instr ( exps.s ++ "invoke" ++ f.s ++ paren args.s ++ val.s ) ; + TNum t = t ; TInt = ss "i" ; TFloat = ss "f" ; @@ -81,5 +91,6 @@ flags lexer=codevars ; unlexer=code ; startcat=Stm ; ConsTyp = cc2 ; NilExp = ss [] ; + OneExp _ e = e ; ConsExp _ _ = cc2 ; } diff --git a/examples/gfcc/ResImper.gf b/examples/gfcc/ResImper.gf index a72aaf8c2..62097bdc3 100644 --- a/examples/gfcc/ResImper.gf +++ b/examples/gfcc/ResImper.gf @@ -67,4 +67,6 @@ resource ResImper = { ss (s ++ ";" ++ i.s) ** {s2 = v ++ i.s2 ; s3 = i.s3} ; binop : Str -> SS -> SS -> SS = \op, x, y -> ss (x.s ++ y.s ++ op ++ ";") ; + binopt : Str -> SS -> SS -> SS -> SS = \op, x, y, t -> + ss (x.s ++ y.s ++ t.s ++ op ++ ";") ; } diff --git a/src/GF/Grammar/PrGrammar.hs b/src/GF/Grammar/PrGrammar.hs index c49553425..ec01cdab5 100644 --- a/src/GF/Grammar/PrGrammar.hs +++ b/src/GF/Grammar/PrGrammar.hs @@ -168,6 +168,7 @@ instance Print Val where prt (VClos env e) = case e of Meta _ -> prt_ e ++ prEnv env _ -> prt_ e ---- ++ prEnv env ---- for debugging + prt VType = "Type" prv1 v = case v of VApp _ _ -> prParenth $ prt v diff --git a/src/GF/Source/LexGF.hs b/src/GF/Source/LexGF.hs index 400ae4be3..81ed2ab8f 100644 --- a/src/GF/Source/LexGF.hs +++ b/src/GF/Source/LexGF.hs @@ -59,7 +59,7 @@ prToken t = case t of PT _ (TD s) -> s PT _ (TC s) -> s PT _ (T_LString s) -> s - + _ -> show t eitherResIdent :: (String -> Tok) -> String -> Tok eitherResIdent tv s = if isResWord s then (TS s) else (tv s) where