Add strings to type system and parser/lexer

diff --git a/parse/ast.sml b/parse/ast.sml
index 75f704243da867828b4a8ab0e70baec7336d3356..ce756abb87e7714fb5988df088b4be3698653f30 100644 (file)
--- a/parse/ast.sml
+++ b/parse/ast.sml
@@ -39,6 +39,7 @@ sig
   datatype exp =
      Var of ident
    | ConstExp of Word32.word
   datatype exp =
      Var of ident
    | ConstExp of Word32.word

+   | StringExp of string

    | OpExp of oper * exp list
    | Marked of (* Kane *) exp Mark.marked
    | FuncCall of ident * (exp list)
    | OpExp of oper * exp list
    | Marked of (* Kane *) exp Mark.marked
    | FuncCall of ident * (exp list)


@@ -109,6 +110,7 @@ struct
   datatype exp =
      Var of ident
    | ConstExp of Word32.word
   datatype exp =
      Var of ident
    | ConstExp of Word32.word

+   | StringExp of string

    | OpExp of oper * exp list
    | Marked of exp Mark.marked
    | FuncCall of ident * (exp list)
    | OpExp of oper * exp list
    | Marked of exp Mark.marked
    | FuncCall of ident * (exp list)


@@ -171,6 +173,7 @@ struct
 
     fun pp_exp (Var(id)) = pp_ident id
       | pp_exp (ConstExp(c)) = Word32Signed.toString c
 
     fun pp_exp (Var(id)) = pp_ident id
       | pp_exp (ConstExp(c)) = Word32Signed.toString c

+      | pp_exp (StringExp(s)) = "\"" ^ s ^ "\""

       | pp_exp (OpExp(oper, [e])) =
          pp_oper oper ^ "(" ^ pp_exp e ^ ")"
       | pp_exp (OpExp(oper, [e1,e2])) =
       | pp_exp (OpExp(oper, [e])) =
          pp_oper oper ^ "(" ^ pp_exp e ^ ")"
       | pp_exp (OpExp(oper, [e1,e2])) =

diff --git a/parse/l5.grm b/parse/l5.grm
index 7195271967c36fc6e62d3c8e700402ba9966bdc8..39f33cd2ad7cb5d1e271a75c7f13136ea4ce7ebd 100644 (file)
--- a/parse/l5.grm
+++ b/parse/l5.grm
@@ -35,6 +35,7 @@ fun make_lval (A.Var(id)) ext = id
  | SEMI
  | INTNUM of Word32.word
  | IDENT of Symbol.symbol
  | SEMI
  | INTNUM of Word32.word
  | IDENT of Symbol.symbol

+ | STRING of string

  | RETURN
  | PLUS | MINUS | STAR | SLASH | PERCENT | LSH | RSH | LOGOR | LOGAND | BITAND | BITXOR | BITOR | BITNOT | BANG
  | ASSIGN | PLUSEQ | MINUSEQ | STAREQ | SLASHEQ | PERCENTEQ | LSHEQ | RSHEQ | BITANDEQ | BITXOREQ | BITOREQ
  | RETURN
  | PLUS | MINUS | STAR | SLASH | PERCENT | LSH | RSH | LOGOR | LOGAND | BITAND | BITXOR | BITOR | BITNOT | BANG
  | ASSIGN | PLUSEQ | MINUSEQ | STAREQ | SLASHEQ | PERCENTEQ | LSHEQ | RSHEQ | BITANDEQ | BITXOREQ | BITOREQ


@@ -43,7 +44,7 @@ fun make_lval (A.Var(id)) ext = id
  | LBRACE | RBRACE
  | LPAREN | RPAREN
  | UNARY | ASNOP (* dummy *)
  | LBRACE | RBRACE
  | LPAREN | RPAREN
  | UNARY | ASNOP (* dummy *)

- | EXTERN | VAR | INT | QUESTION | COLON | COMMA | STRUCT | NULL | LBRACKET | RBRACKET | ARROW | DOT | NEW
+ | EXTERN | VAR | INT | TSTRING | QUESTION | COLON | COMMA | STRUCT | NULL | LBRACKET | RBRACKET | ARROW | DOT | NEW

  | PLUSPLUS | MINUSMINUS
 
 %nonterm 
  | PLUSPLUS | MINUSMINUS
 
 %nonterm 


@@ -103,6 +104,7 @@ programx   : decls                  (decls)
            | programx function      (AUP.append_function programx function)
 
 vtype      : INT                    (T.Int)
            | programx function      (AUP.append_function programx function)
 
 vtype      : INT                    (T.Int)

+           | TSTRING                (T.String)

            | IDENT                  (T.Typedef IDENT)
            | vtype STAR             (T.Pointer vtype)
            | vtype LBRACKET RBRACKET
            | IDENT                  (T.Typedef IDENT)
            | vtype STAR             (T.Pointer vtype)
            | vtype LBRACKET RBRACKET


@@ -184,6 +186,7 @@ block      : stm                    ([stm])
 
 exp        : LPAREN exp RPAREN      (exp)
            | INTNUM                 (mark (A.ConstExp(INTNUM),(INTNUMleft,INTNUMright)))
 
 exp        : LPAREN exp RPAREN      (exp)
            | INTNUM                 (mark (A.ConstExp(INTNUM),(INTNUMleft,INTNUMright)))

+           | STRING                 (mark (A.StringExp(STRING),(STRINGleft,STRINGright)))

            | IDENT                  (mark (A.Var(IDENT), (IDENTleft,IDENTright)))
            | exp DOT IDENT          (mark (A.Member(exp, IDENT), (expleft, IDENTright)))
            | exp ARROW IDENT        (mark (A.DerefMember(exp, IDENT), (expleft, IDENTright)))
            | IDENT                  (mark (A.Var(IDENT), (IDENTleft,IDENTright)))
            | exp DOT IDENT          (mark (A.Member(exp, IDENT), (expleft, IDENTright)))
            | exp ARROW IDENT        (mark (A.DerefMember(exp, IDENT), (expleft, IDENTright)))

diff --git a/parse/l5.lex b/parse/l5.lex
index e10f8b7da384d198bb047cce7e2c8f06a21fb1c4..3028a6c9407460d83bdf00a64e5c8fc146e9b2a6 100644 (file)
--- a/parse/l5.lex
+++ b/parse/l5.lex
@@ -17,6 +17,9 @@ type lexresult = (svalue,pos) Tokens.token
 local
   val commentLevel = ref 0
   val commentPos = ref 0
 local
   val commentLevel = ref 0
   val commentPos = ref 0

+  val inString = ref false
+  val stringPos = ref 0
+  val stringAcc : string list ref = ref [] (* :( *)

 in
   fun enterComment yypos =
       ( commentLevel := !commentLevel + 1 ;
 in
   fun enterComment yypos =
       ( commentLevel := !commentLevel + 1 ;


@@ -62,14 +65,20 @@ in
       ( if (!commentLevel > 0)
           then (ErrorMsg.error (ParseState.ext (!commentPos,!commentPos)) "unterminated comment")
           else ();
       ( if (!commentLevel > 0)
           then (ErrorMsg.error (ParseState.ext (!commentPos,!commentPos)) "unterminated comment")
           else ();

+        if (!inString)
+          then (ErrorMsg.error (ParseState.ext (!stringPos,!stringPos)) "unterminated string")
+          else ();

        Tokens.EOF (0,0) )              (* bogus position information; unused *)
 
        Tokens.EOF (0,0) )              (* bogus position information; unused *)
 

+  fun newString yyp = ( inString := true; stringPos := yyp; stringAcc := [] )
+  fun endString yyp = ( Tokens.STRING (concat (rev (!stringAcc)), !stringPos, yyp+1) )
+  fun addString yyt = ( inString := false; stringAcc := yyt :: (!stringAcc) )

 end
 
 %%
 %header (functor L5LexFn(structure Tokens : L5_TOKENS));
 %full
 end
 
 %%
 %header (functor L5LexFn(structure Tokens : L5_TOKENS));
 %full

-%s COMMENT COMMENT_LINE;
+%s COMMENT COMMENT_LINE STRING;

 
 id = [A-Za-z_][A-Za-z0-9_]*;
 decnum = [0-9][0-9]*;
 
 id = [A-Za-z_][A-Za-z0-9_]*;
 decnum = [0-9][0-9]*;


@@ -143,6 +152,7 @@ ws = [\ \t\012];
 <INITIAL> "else"      => (Tokens.ELSE (yypos, yypos + size yytext));
 <INITIAL> "var"       => (Tokens.VAR (yypos, yypos + size yytext));
 <INITIAL> "int"       => (Tokens.INT (yypos, yypos + size yytext));
 <INITIAL> "else"      => (Tokens.ELSE (yypos, yypos + size yytext));
 <INITIAL> "var"       => (Tokens.VAR (yypos, yypos + size yytext));
 <INITIAL> "int"       => (Tokens.INT (yypos, yypos + size yytext));

+<INITIAL> "string"    => (Tokens.TSTRING (yypos, yypos + size yytext));

 <INITIAL> "extern"    => (Tokens.EXTERN (yypos, yypos + size yytext));
 <INITIAL> "struct"    => (Tokens.STRUCT (yypos, yypos + size yytext));
 <INITIAL> "NULL"      => (Tokens.NULL (yypos, yypos + size yytext));
 <INITIAL> "extern"    => (Tokens.EXTERN (yypos, yypos + size yytext));
 <INITIAL> "struct"    => (Tokens.STRUCT (yypos, yypos + size yytext));
 <INITIAL> "NULL"      => (Tokens.NULL (yypos, yypos + size yytext));


@@ -164,10 +174,12 @@ ws = [\ \t\012];
 
 <INITIAL> "//"        => (YYBEGIN COMMENT_LINE; lex());
 <INITIAL> "#"         => (YYBEGIN COMMENT_LINE; lex());
 
 <INITIAL> "//"        => (YYBEGIN COMMENT_LINE; lex());
 <INITIAL> "#"         => (YYBEGIN COMMENT_LINE; lex());

+<INITIAL> "\""        => (YYBEGIN STRING; newString yypos ; lex () );

 <INITIAL> .           => (ErrorMsg.error (ParseState.ext (yypos,yypos))
                               ("illegal character: \"" ^ yytext ^ "\"");
                           lex ());
 
 <INITIAL> .           => (ErrorMsg.error (ParseState.ext (yypos,yypos))
                               ("illegal character: \"" ^ yytext ^ "\"");
                           lex ());
 

+

 <COMMENT> "/*"        => (enterComment yypos; lex());
 <COMMENT> "*/"        => (if exitComment () then YYBEGIN INITIAL else (); lex());
 <COMMENT> \n          => (ParseState.newline yypos; lex ());
 <COMMENT> "/*"        => (enterComment yypos; lex());
 <COMMENT> "*/"        => (if exitComment () then YYBEGIN INITIAL else (); lex());
 <COMMENT> \n          => (ParseState.newline yypos; lex ());


@@ -175,3 +187,6 @@ ws = [\ \t\012];
 
 <COMMENT_LINE> \n     => (ParseState.newline yypos; YYBEGIN INITIAL; lex());
 <COMMENT_LINE> .      => (lex());
 
 <COMMENT_LINE> \n     => (ParseState.newline yypos; YYBEGIN INITIAL; lex());
 <COMMENT_LINE> .      => (lex());

+
+<STRING> [^\"\\]*     => (addString yytext ; lex() );
+<STRING> "\""         => (YYBEGIN INITIAL; endString yypos );

diff --git a/trans/trans.sml b/trans/trans.sml
index d8807f03def58f35ee4ce85c7e29d368b7175098..73968d9c36cf0f20df3007576d5ded04e0835b4a 100644 (file)
--- a/trans/trans.sml
+++ b/trans/trans.sml
@@ -129,8 +129,12 @@ struct
         | trans_exp env vartypes (A.ArrIndex(exp1, exp2)) =
             let
               val asubk = T.BINOP(T.ADD, trans_exp env vartypes exp1, 
         | trans_exp env vartypes (A.ArrIndex(exp1, exp2)) =
             let
               val asubk = T.BINOP(T.ADD, trans_exp env vartypes exp1, 

-                                  T.BINOP(T.MUL, trans_exp env vartypes exp2,
-                                          T.CONST(Word32.fromInt(sizeof (deref (typeof' vartypes exp1))))))
+                                  if sizeof (deref (typeof' vartypes exp1)) = 1
+                                  then trans_exp env vartypes exp2
+                                  else T.BINOP(T.MUL, trans_exp env vartypes exp2,
+                                               T.CONST(Word32.fromInt(sizeof (deref (typeof' vartypes exp1))))
+                                              )
+                                 )

               val tipo = deref (typeof' vartypes exp1)
               val d =
                 if not (Flag.isset Flags.safe)
               val tipo = deref (typeof' vartypes exp1)
               val d =
                 if not (Flag.isset Flags.safe)


@@ -160,7 +164,9 @@ struct
             end
         | trans_exp env vartypes (A.NewArr(tipo, exp)) =
             let
             end
         | trans_exp env vartypes (A.NewArr(tipo, exp)) =
             let

-              val size = T.BINOP(T.MUL, trans_exp env vartypes exp, T.CONST(Word32.fromInt(sizeof tipo)))
+              val size = if (sizeof tipo) = 1
+                         then trans_exp env vartypes exp
+                         else T.BINOP(T.MUL, trans_exp env vartypes exp, T.CONST(Word32.fromInt(sizeof tipo)))

               val t1 = T.TEMP (Temp.new "allocated address")
               val ts = T.TEMP (Temp.new "size")
             in
               val t1 = T.TEMP (Temp.new "allocated address")
               val ts = T.TEMP (Temp.new "size")
             in

diff --git a/type/type.sml b/type/type.sml
index 69f35f8c27c6b7487890c67c30a4e0afab14c251..82bc8b1a054bfa46b42298f940b2e30c7a431bf4 100644 (file)
--- a/type/type.sml
+++ b/type/type.sml
@@ -1,7 +1,7 @@
 signature TYPE =
 sig
   type ident = Symbol.symbol
 signature TYPE =
 sig
   type ident = Symbol.symbol

-  datatype vtype = Int | Typedef of ident | Pointer of vtype | Array of vtype | TNull
+  datatype vtype = Int | String | Typedef of ident | Pointer of vtype | Array of vtype | TNull

   type variable = ident * vtype
   datatype typedef = MarkedTypedef of typedef Mark.marked | Struct of variable list
 
   type variable = ident * vtype
   datatype typedef = MarkedTypedef of typedef Mark.marked | Struct of variable list
 


@@ -28,14 +28,15 @@ end
 structure Type :> TYPE =
 struct
   type ident = Symbol.symbol
 structure Type :> TYPE =
 struct
   type ident = Symbol.symbol

-  datatype vtype = Int | Typedef of ident | Pointer of vtype | Array of vtype | TNull
+  datatype vtype = Int | String | Typedef of ident | Pointer of vtype | Array of vtype | TNull

   type variable = ident * vtype
   datatype typedef = MarkedTypedef of typedef Mark.marked | Struct of variable list
 
   type variable = ident * vtype
   datatype typedef = MarkedTypedef of typedef Mark.marked | Struct of variable list
 

-  fun size (Int) = 4
-    | size (Pointer _) = 8
-    | size (Array _) = 8
-    | size (TNull) = 8
+  fun size (Int) = 1
+    | size (String) = 1
+    | size (Pointer _) = 1
+    | size (Array _) = 1
+    | size (TNull) = 1

     | size _ = raise ErrorMsg.InternalError "Type.size on non-small type..."
 
   (************************************************)
     | size _ = raise ErrorMsg.InternalError "Type.size on non-small type..."
 
   (************************************************)


@@ -48,9 +49,10 @@ struct
     (* determine size of items *)
     fun sizeof_reset () = ( size_memotable := Symbol.empty )
     fun alignment_reset () = ( align_memotable := Symbol.empty )
     (* determine size of items *)
     fun sizeof_reset () = ( size_memotable := Symbol.empty )
     fun alignment_reset () = ( align_memotable := Symbol.empty )

-    fun sizeof _ (Int) = 4
-      | sizeof _ (Pointer _) = 8
-      | sizeof _ (Array _) = 8
+    fun sizeof _ (Int) = 1
+      | sizeof _ (String) = 1
+      | sizeof _ (Pointer _) = 1
+      | sizeof _ (Array _) = 1

       | sizeof _ (TNull) = raise ErrorMsg.InternalError "Type.sizeof on TNull?"
       | sizeof d (Typedef id) =
           (case (Symbol.look (!size_memotable) id)
       | sizeof _ (TNull) = raise ErrorMsg.InternalError "Type.sizeof on TNull?"
       | sizeof d (Typedef id) =
           (case (Symbol.look (!size_memotable) id)


@@ -70,9 +72,10 @@ struct
       | sizeof_s d (MarkedTypedef(a)) = sizeof_s d (Mark.data a)
 
     (* determine alignment of items *)
       | sizeof_s d (MarkedTypedef(a)) = sizeof_s d (Mark.data a)
 
     (* determine alignment of items *)

-    and alignment _ (Int) = 4
-      | alignment _ (Pointer _) = 8
-      | alignment _ (Array _) = 8
+    and alignment _ (Int) = 1
+      | alignment _ (String) = 1
+      | alignment _ (Pointer _) = 1
+      | alignment _ (Array _) = 1

       | alignment d (Typedef id) =
           (case Symbol.look (!align_memotable) id
           of SOME(r) => r
       | alignment d (Typedef id) =
           (case Symbol.look (!align_memotable) id
           of SOME(r) => r


@@ -104,12 +107,14 @@ struct
 
 
   fun issmall (Int) = true
 
 
   fun issmall (Int) = true

+    | issmall (String) = true

     | issmall (Pointer _) = true
     | issmall (Array _) = true
     | issmall (TNull) = true
     | issmall _ = false
 
   fun typeeq (Int, Int) = true
     | issmall (Pointer _) = true
     | issmall (Array _) = true
     | issmall (TNull) = true
     | issmall _ = false
 
   fun typeeq (Int, Int) = true

+    | typeeq (String, String) = true

     | typeeq (Typedef a, Typedef b) = (Symbol.name a) = (Symbol.name b)
     | typeeq (Pointer a, Pointer b) = typeeq (a, b)
     | typeeq (Array a, Array b) = typeeq (a, b)
     | typeeq (Typedef a, Typedef b) = (Symbol.name a) = (Symbol.name b)
     | typeeq (Pointer a, Pointer b) = typeeq (a, b)
     | typeeq (Array a, Array b) = typeeq (a, b)


@@ -131,6 +136,7 @@ struct
     fun pp_ident i = Symbol.name i
 
     fun pp_type (Int) = "int"
     fun pp_ident i = Symbol.name i
 
     fun pp_type (Int) = "int"

+      | pp_type (String) = "string"

       | pp_type (Pointer t) = pp_type t ^ "*"
       | pp_type (Array t) = pp_type t ^ "[]"
       | pp_type (TNull) = "{NULL type}"
       | pp_type (Pointer t) = pp_type t ^ "*"
       | pp_type (Array t) = pp_type t ^ "[]"
       | pp_type (TNull) = "{NULL type}"

diff --git a/type/typechecker.sml b/type/typechecker.sml
index 06c6d89dce342aafdb9abc4ce88c3196b2573b6b..8be373158bbeac5c1bea4c2e34d473f919ac6436 100644 (file)
--- a/type/typechecker.sml
+++ b/type/typechecker.sml
@@ -25,6 +25,7 @@ struct
                      of NONE => (ErrorMsg.error mark ("variable `"^(Symbol.name a)^"' not declared here") ; raise ErrorMsg.Error)
                       | SOME t => t)
        | A.ConstExp _ => T.Int
                      of NONE => (ErrorMsg.error mark ("variable `"^(Symbol.name a)^"' not declared here") ; raise ErrorMsg.Error)
                       | SOME t => t)
        | A.ConstExp _ => T.Int

+       | A.StringExp _ => T.String

        | A.OpExp (A.EQ, [a, b]) =>
            (case (typeof (tds, funcs) vars mark a, typeof (tds, funcs) vars mark b)
             of (T.Int, T.Int) => T.Int (* You shall pass! *)
        | A.OpExp (A.EQ, [a, b]) =>
            (case (typeof (tds, funcs) vars mark a, typeof (tds, funcs) vars mark b)
             of (T.Int, T.Int) => T.Int (* You shall pass! *)


@@ -207,6 +208,7 @@ struct
                                   raise ErrorMsg.Error )
            | SOME ASSIGNED => ())
     | varcheck_exp env (A.ConstExp _) mark = ()
                                   raise ErrorMsg.Error )
            | SOME ASSIGNED => ())
     | varcheck_exp env (A.ConstExp _) mark = ()

+    | varcheck_exp env (A.StringExp _) mark = ()

     | varcheck_exp env (A.OpExp (_, l)) mark = List.app (fn znt => varcheck_exp env znt mark) l
     | varcheck_exp env (A.FuncCall (f, l)) mark = List.app (fn znt => varcheck_exp env znt mark) l
     | varcheck_exp env (A.Marked m) mark = varcheck_exp env (Mark.kane m) (Mark.ext m)
     | varcheck_exp env (A.OpExp (_, l)) mark = List.app (fn znt => varcheck_exp env znt mark) l
     | varcheck_exp env (A.FuncCall (f, l)) mark = List.app (fn znt => varcheck_exp env znt mark) l
     | varcheck_exp env (A.Marked m) mark = varcheck_exp env (Mark.kane m) (Mark.ext m)


@@ -408,6 +410,7 @@ struct
         
   (* XXX does not check big vs. small types *)
   fun typecheck_type (tds, funcs) mark T.Int = ()
         
   (* XXX does not check big vs. small types *)
   fun typecheck_type (tds, funcs) mark T.Int = ()

+    | typecheck_type (tds, funcs) mark T.String = ()

     | typecheck_type (tds, funcs) mark T.TNull = ()
     | typecheck_type (tds, funcs) mark (T.Pointer t) = typecheck_type (tds, funcs) mark t
     | typecheck_type (tds, funcs) mark (T.Array t) = typecheck_type (tds, funcs) mark t
     | typecheck_type (tds, funcs) mark T.TNull = ()
     | typecheck_type (tds, funcs) mark (T.Pointer t) = typecheck_type (tds, funcs) mark t
     | typecheck_type (tds, funcs) mark (T.Array t) = typecheck_type (tds, funcs) mark t