tiger (empty) → 1.0
raw patch · 11 files changed
+3159/−0 lines, 11 filesdep +arraydep +basedep +haskell98setup-changed
Dependencies added: array, base, haskell98, uulib
Files
- INSTALL +5/−0
- LICENSE +28/−0
- Setup.hs +6/−0
- derived/TigerAS.hs +50/−0
- derived/TigerError.hs +232/−0
- derived/TigerSem.hs +2100/−0
- dist/build/tiger/tiger-tmp/TigerScanner.hs +411/−0
- src/Tiger.hs +140/−0
- src/TigerScanner.x +99/−0
- src/TigerTypes.hs +66/−0
- tiger.cabal +22/−0
+ INSTALL view
@@ -0,0 +1,5 @@+run:++autoconf+./configure+make
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2008 Universiteit Utrecht+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of Universiteit Utrecht nor the names of its contributors+ may be used to endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ derived/TigerAS.hs view
@@ -0,0 +1,50 @@+-- UUAGC 0.9.5 (src/TigerAS.ag)+module TigerAS where+++import TigerTypes+import UU.Scanner.Position+-- Args --------------------------------------------------------+type Args = [Expr]+-- AssignField -------------------------------------------------+data AssignField = AssignField (VarIdent) (Expr)+-- AssignFields ------------------------------------------------+type AssignFields = [AssignField]+-- DeclGroup ---------------------------------------------------+data DeclGroup = FunDecs (FunDecs)+ | TypeDecs (TypeDecs)+ | VarDec (Pos) (VarIdent) (Maybe TypeIdent) (Expr)+-- Declarations ------------------------------------------------+type Declarations = [DeclGroup]+-- Expr --------------------------------------------------------+data Expr = Apply (VarIdent) (Args)+ | ArrayVal (TypeIdent) (Expr) (Expr)+ | Assign (LValue) (Pos) (Expr)+ | Break (Pos)+ | For (Pos) (VarIdent) (Expr) (Expr) (Expr)+ | If (Pos) (Expr) (Expr) (Expr)+ | IntLit (Integer) (Pos)+ | LValue (LValue)+ | Let (Pos) (Declarations) (Expr)+ | Nil (Pos)+ | Op (String) (Pos) (Expr) (Expr)+ | RecordVal (TypeIdent) (AssignFields)+ | Sequence (Expr) (Expr)+ | Skip + | StringLit (String) (Pos)+ | UnOp (Pos) (String) (Expr)+ | While (Pos) (Expr) (Expr)+-- FunDec ------------------------------------------------------+data FunDec = FunDec (Pos) (VarIdent) ([TypedVar]) (Maybe TypeIdent) (Expr)+-- FunDecs -----------------------------------------------------+type FunDecs = [FunDec]+-- LValue ------------------------------------------------------+data LValue = Dot (Pos) (LValue) (VarIdent)+ | Ident (VarIdent)+ | Sub (Pos) (LValue) (Expr)+-- Program -----------------------------------------------------+data Program = Program (Expr)+-- TypeDec -----------------------------------------------------+data TypeDec = TypeDec (Pos) (TypeIdent) (Type)+-- TypeDecs ----------------------------------------------------+type TypeDecs = [TypeDec]
+ derived/TigerError.hs view
@@ -0,0 +1,232 @@+-- UUAGC 0.9.5 (src/TigerError.ag)+module TigerError where+++import TigerTypes+import UU.Scanner.Position+ +showField ident = show (getName ident) +-- Error -------------------------------------------------------+data Error = AssignLoopcounter (Pos)+ | CompareOp (Pos) (String)+ | CyclicType (Ident)+ | DupRecordFieldDecl (Ident) (Pos)+ | DuplicateArg (Ident) (Ident) (Pos)+ | DuplicateFun (Ident) (Pos)+ | DuplicateType (Ident) (Pos)+ | FieldNotInit (Ident)+ | InitWithVoid (Pos)+ | NoSuchField (Pos) (Ident)+ | NotArrayType (Pos)+ | NotFunType (Ident)+ | NotRecordType (Pos)+ | NotVarType (Ident)+ | TooFewArguments (Ident)+ | TooManyArguments (Ident)+ | TypeMisMatch (TYPE) (TYPE)+ | UndeclaredFun (Ident)+ | UndeclaredType (Ident)+ | UndeclaredVar (Ident)+ | UnknownType (Pos)+-- cata+sem_Error :: Error ->+ T_Error+sem_Error (AssignLoopcounter _pos) =+ (sem_Error_AssignLoopcounter _pos)+sem_Error (CompareOp _pos _op) =+ (sem_Error_CompareOp _pos _op)+sem_Error (CyclicType _ident) =+ (sem_Error_CyclicType _ident)+sem_Error (DupRecordFieldDecl _ident _pos2) =+ (sem_Error_DupRecordFieldDecl _ident _pos2)+sem_Error (DuplicateArg _fun _ident _pos2) =+ (sem_Error_DuplicateArg _fun _ident _pos2)+sem_Error (DuplicateFun _ident _pos2) =+ (sem_Error_DuplicateFun _ident _pos2)+sem_Error (DuplicateType _ident _pos2) =+ (sem_Error_DuplicateType _ident _pos2)+sem_Error (FieldNotInit _field) =+ (sem_Error_FieldNotInit _field)+sem_Error (InitWithVoid _pos) =+ (sem_Error_InitWithVoid _pos)+sem_Error (NoSuchField _pos _field) =+ (sem_Error_NoSuchField _pos _field)+sem_Error (NotArrayType _pos) =+ (sem_Error_NotArrayType _pos)+sem_Error (NotFunType _ident) =+ (sem_Error_NotFunType _ident)+sem_Error (NotRecordType _pos) =+ (sem_Error_NotRecordType _pos)+sem_Error (NotVarType _ident) =+ (sem_Error_NotVarType _ident)+sem_Error (TooFewArguments _fun) =+ (sem_Error_TooFewArguments _fun)+sem_Error (TooManyArguments _fun) =+ (sem_Error_TooManyArguments _fun)+sem_Error (TypeMisMatch _expect _tp) =+ (sem_Error_TypeMisMatch _expect _tp)+sem_Error (UndeclaredFun _ident) =+ (sem_Error_UndeclaredFun _ident)+sem_Error (UndeclaredType _ident) =+ (sem_Error_UndeclaredType _ident)+sem_Error (UndeclaredVar _ident) =+ (sem_Error_UndeclaredVar _ident)+sem_Error (UnknownType _pos) =+ (sem_Error_UnknownType _pos)+-- semantic domain+type T_Error = ( String)+sem_Error_AssignLoopcounter :: Pos ->+ T_Error+sem_Error_AssignLoopcounter pos_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "at: " ++ show pos_ ++ ":" ++ "cannot assign to loop variable"+ in ( _lhsOmsg))+sem_Error_CompareOp :: Pos ->+ String ->+ T_Error+sem_Error_CompareOp pos_ op_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "at: " ++ show pos_ ++ ":" ++ " operator " ++ show op_ ++ " only defined for int and string"+ in ( _lhsOmsg))+sem_Error_CyclicType :: Ident ->+ T_Error+sem_Error_CyclicType ident_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "cyclic type synonym: " ++ show ident_+ in ( _lhsOmsg))+sem_Error_DupRecordFieldDecl :: Ident ->+ Pos ->+ T_Error+sem_Error_DupRecordFieldDecl ident_ pos2_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "duplicate record field declaration: " ++ show ident_ ++ " other occurrence at: " ++ show pos2_+ in ( _lhsOmsg))+sem_Error_DuplicateArg :: Ident ->+ Ident ->+ Pos ->+ T_Error+sem_Error_DuplicateArg fun_ ident_ pos2_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "duplicate formal argument declaration: " ++ show ident_ ++ " other occurrence at: " ++ show pos2_+ in ( _lhsOmsg))+sem_Error_DuplicateFun :: Ident ->+ Pos ->+ T_Error+sem_Error_DuplicateFun ident_ pos2_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "duplicate function declaration: " ++ show ident_ ++ " other occurrence at: " ++ show pos2_+ in ( _lhsOmsg))+sem_Error_DuplicateType :: Ident ->+ Pos ->+ T_Error+sem_Error_DuplicateType ident_ pos2_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "duplicate type declaration: " ++ show ident_ ++ " other occurrence at: " ++ show pos2_+ in ( _lhsOmsg))+sem_Error_FieldNotInit :: Ident ->+ T_Error+sem_Error_FieldNotInit field_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "field not initialized: " ++ showField field_+ in ( _lhsOmsg))+sem_Error_InitWithVoid :: Pos ->+ T_Error+sem_Error_InitWithVoid pos_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "at: " ++ show pos_ ++ ":" ++ "cannot initialize with no value"+ in ( _lhsOmsg))+sem_Error_NoSuchField :: Pos ->+ Ident ->+ T_Error+sem_Error_NoSuchField pos_ field_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "at: " ++ show pos_ ++ " record type does not have a field named: " ++ showField field_+ in ( _lhsOmsg))+sem_Error_NotArrayType :: Pos ->+ T_Error+sem_Error_NotArrayType pos_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "at: " ++ show pos_ ++ " subscript of non-array type"+ in ( _lhsOmsg))+sem_Error_NotFunType :: Ident ->+ T_Error+sem_Error_NotFunType ident_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "identifier: " ++ show ident_ ++ " is not a function"+ in ( _lhsOmsg))+sem_Error_NotRecordType :: Pos ->+ T_Error+sem_Error_NotRecordType pos_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "at: " ++ show pos_ ++ " field selection of non-record type"+ in ( _lhsOmsg))+sem_Error_NotVarType :: Ident ->+ T_Error+sem_Error_NotVarType ident_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "identifier: " ++ show ident_ ++ " is not a variable"+ in ( _lhsOmsg))+sem_Error_TooFewArguments :: Ident ->+ T_Error+sem_Error_TooFewArguments fun_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "not enough arguments for: " ++ show fun_+ in ( _lhsOmsg))+sem_Error_TooManyArguments :: Ident ->+ T_Error+sem_Error_TooManyArguments fun_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "too many arguments for: " ++ show fun_+ in ( _lhsOmsg))+sem_Error_TypeMisMatch :: TYPE ->+ TYPE ->+ T_Error+sem_Error_TypeMisMatch expect_ tp_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "type: " ++ show tp_ ++ " does not match: " ++ show expect_+ in ( _lhsOmsg))+sem_Error_UndeclaredFun :: Ident ->+ T_Error+sem_Error_UndeclaredFun ident_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "undeclared function: " ++ show ident_+ in ( _lhsOmsg))+sem_Error_UndeclaredType :: Ident ->+ T_Error+sem_Error_UndeclaredType ident_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "undeclared type: " ++ show ident_+ in ( _lhsOmsg))+sem_Error_UndeclaredVar :: Ident ->+ T_Error+sem_Error_UndeclaredVar ident_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "undeclared variable: " ++ show ident_+ in ( _lhsOmsg))+sem_Error_UnknownType :: Pos ->+ T_Error+sem_Error_UnknownType pos_ =+ (let _lhsOmsg :: String+ _lhsOmsg =+ "unable to determine type for expression at: " ++ show pos_+ in ( _lhsOmsg))
+ derived/TigerSem.hs view
@@ -0,0 +1,2100 @@+-- UUAGC 0.9.5 (src/TigerSem.ag)+module TigerSem where+++import TigerAS+import Monad(mplus)+import List(sort)+import Maybe(fromMaybe)+import UU.DData.Map(Map,insert,unionWith,member,elems,findWithDefault, keys, mapWithKey)+import UU.DData.Seq +import qualified UU.DData.Map as Map(lookup,empty,fromList)+import TigerError++import TigerTypes+import UU.Scanner.Position++type Errors = Seq Error++union a b = unionWith const a b+type TypeEnv = Map TypeIdent (Pos, TYPE)+type VarEnv = Map VarIdent (Pos,VarType)+type TypeSyns = Map TypeIdent (Pos,TypeIdent) +--type RecordEnv = Map TypeRef (Map VarIdent TypeRef)+--type ArrayEnv = Map TypeRef TypeRef++data VarType = VarType TYPE + | FunType [TYPE] -- argument types+ TYPE -- return type++{-+loopCounterType,errorType, emptyRecType, voidType, intType, strType :: TYPE+loopCounterType = (-6)+errorType = (-5)+emptyRecType = (-4)+voidType = (-3)+intType = (-2)+strType = (-1)+-}+{-+unaryOps = fromList [("-", (intType,intType))]+binaryOps = fromList [ (o,iii) | o <- ["*", "/", "+", "-" ,">=", "<=", "=", "<>", "<", ">","&","|" ]]+ where iii = (intType,intType,intType)+-}++initTypeEnv = Map.fromList (map toIdent+ [ ("int", INT)+ , ("string", STRING) + ])++toIdent (n,t) = (Id n noPos,(noPos, t))+ +initVarEnv = Map.fromList (map toIdent+ [ ("print" , procedure [STRING])+ , ("flush" , procedure [] )+ , ("exit" , procedure [INT] )+ , ("getchar" , function [] STRING )+ , ("ord" , function [STRING] INT )+ , ("chr" , function [INT] STRING )+ , ("size" , function [STRING] INT )+ , ("substring", function [STRING, INT, INT] STRING )+ , ("concat" , function [STRING, STRING] STRING )+ , ("not" , function [INT] INT )+ ])+ +procedure args = FunType args VOID+function args res = FunType args res ++findType env n = case lookupIdent n env of+ Just x -> (empty, x)+ Nothing -> (single (UndeclaredType n), ERROR)+ +findVar env n = case lookupIdent n env of+ Just x -> case x of+ VarType t -> (empty, t)+ FunType _ _ -> (single (NotVarType n), ERROR) + Nothing -> (single (UndeclaredVar n), ERROR)+findFunction env n = case lookupIdent n env of+ Just x -> case x of+ VarType t -> (single (NotFunType n), [], ERROR) + FunType a r -> (empty, a,r)+ Nothing -> (single (UndeclaredFun n), [], ERROR)+++lookupIdent :: Ident -> Map Ident (Pos,a) -> Maybe a+lookupIdent i env = fmap snd (Map.lookup i env) ++compilerError msg = error ("compiler error: " ++ msg) ++recordFields :: TypeEnv -> [TypedVar] -> (Errors,Map Ident (Pos,TYPE))+recordFields tenv tvs = foldr field (empty,Map.empty) tvs+ where field (TypedVar v t) ~(es,fs) + = case lookupPos v fs of+ Just p -> (es <> single (DupRecordFieldDecl v p),fs)+ Nothing -> let (err,t') = findType tenv t+ in (es <> err,insertIdent v t' fs)+ +++lookupPos :: Ident -> Map Ident (Pos,a) -> Maybe Pos+lookupPos i env = fmap fst (Map.lookup i env)++insertIdent :: Ident -> a -> Map Ident (Pos,a) -> Map Ident (Pos,a)+insertIdent i@(Id n p) val = insert i (p,val) ++addTypeDecls :: (TypeEnv,TypeSyns) -> TypeEnv -> (Errors,TypeEnv)+addTypeDecls (new,syns) env = (errors, fmap (snd.snd) resolve `union` rest)+ where rest = new `union` env+ errors = foldr (<>) empty (map (fst.snd) (elems resolve))+ resolve :: Map Ident ([Ident],(Seq Error,(Pos,TYPE)))+ resolve = mapWithKey find syns+ where find l (p,v) + = case Map.lookup v resolve of+ Just ~(vs,~(_,b)) -> (v:vs, if v `elem` vs + then (single (CyclicType l)+ ,(p,ERROR)+ ) + else (empty,(p, snd b))+ )+ Nothing -> let (es,tp) = findType rest v+ in ([], (es, (p,tp)))++arrayComponentType :: Pos -> TYPE -> (Errors,TYPE)+arrayComponentType _ ERROR = (empty,ERROR)+arrayComponentType _ (ARRAY _ _ c) = (empty,c)+arrayComponentType p tp = (single (NotArrayType p),ERROR)++recordFieldType :: Pos -> Map VarIdent (Pos,TYPE) -> Ident -> (Errors,TYPE)+recordFieldType p fields ident = case lookupIdent ident fields of+ Nothing -> (single (NoSuchField p ident), ERROR)+ Just t -> (empty,t)+ +recordType :: Pos -> TYPE -> (Errors,Map Ident (Pos,TYPE))+recordType _ ERROR = (empty,Map.empty)+recordType p (RECORD n _ fs) = (empty,fs)+recordType p NIL = (single (UnknownType p),Map.empty)+recordType p tp = (single (NotRecordType p),Map.empty)++match a b = maybe False (const True) (meet a b)++meet a ERROR = Just a+meet ERROR b = Just b+meet LOOPCOUNTER INT = Just LOOPCOUNTER+meet INT LOOPCOUNTER = Just LOOPCOUNTER+meet a@(RECORD _ _ _) NIL = Just a+meet NIL b@(RECORD _ _ _) = Just b+meet a b | a == b = Just a+ | otherwise = Nothing+++meetErr a b = case meet a b of+ Nothing -> (single (TypeMisMatch a b), ERROR)+ Just t -> (empty, t)+--Nil?+-- Args --------------------------------------------------------+-- cata+sem_Args :: Args ->+ T_Args+sem_Args list =+ (Prelude.foldr sem_Args_Cons sem_Args_Nil (Prelude.map sem_Expr list))+-- semantic domain+type T_Args = Errors ->+ ([TYPE]) ->+ TypeEnv ->+ Int ->+ VarEnv ->+ ( Errors,Int,Int)+sem_Args_Cons :: T_Expr ->+ T_Args ->+ T_Args+sem_Args_Cons hd_ tl_ =+ (\ _lhsIerrors+ _lhsIexpects+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _hdOexpect :: TYPE+ _tlOexpects :: ([TYPE])+ _lhsOsize :: Int+ _lhsOerrors :: Errors+ _lhsOtypecounter :: Int+ _hdOerrors :: Errors+ _hdOtypeEnv :: TypeEnv+ _hdOtypecounter :: Int+ _hdOvarEnv :: VarEnv+ _tlOerrors :: Errors+ _tlOtypeEnv :: TypeEnv+ _tlOtypecounter :: Int+ _tlOvarEnv :: VarEnv+ _hdIerrors :: Errors+ _hdItp :: TYPE+ _hdItypecounter :: Int+ _tlIerrors :: Errors+ _tlIsize :: Int+ _tlItypecounter :: Int+ _hdOexpect =+ head _lhsIexpects+ _tlOexpects =+ tail _lhsIexpects+ _lhsOsize =+ 1 + _tlIsize+ _lhsOerrors =+ _tlIerrors+ _lhsOtypecounter =+ _tlItypecounter+ _hdOerrors =+ _lhsIerrors+ _hdOtypeEnv =+ _lhsItypeEnv+ _hdOtypecounter =+ _lhsItypecounter+ _hdOvarEnv =+ _lhsIvarEnv+ _tlOerrors =+ _hdIerrors+ _tlOtypeEnv =+ _lhsItypeEnv+ _tlOtypecounter =+ _hdItypecounter+ _tlOvarEnv =+ _lhsIvarEnv+ ( _hdIerrors,_hdItp,_hdItypecounter) =+ (hd_ _hdOerrors _hdOexpect _hdOtypeEnv _hdOtypecounter _hdOvarEnv)+ ( _tlIerrors,_tlIsize,_tlItypecounter) =+ (tl_ _tlOerrors _tlOexpects _tlOtypeEnv _tlOtypecounter _tlOvarEnv)+ in ( _lhsOerrors,_lhsOsize,_lhsOtypecounter)))+sem_Args_Nil :: T_Args+sem_Args_Nil =+ (\ _lhsIerrors+ _lhsIexpects+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOsize :: Int+ _lhsOerrors :: Errors+ _lhsOtypecounter :: Int+ _lhsOsize =+ 0+ _lhsOerrors =+ _lhsIerrors+ _lhsOtypecounter =+ _lhsItypecounter+ in ( _lhsOerrors,_lhsOsize,_lhsOtypecounter)))+-- AssignField -------------------------------------------------+-- cata+sem_AssignField :: AssignField ->+ T_AssignField+sem_AssignField (AssignField _ident _expr) =+ (sem_AssignField_AssignField _ident (sem_Expr _expr))+-- semantic domain+type T_AssignField = Errors ->+ TYPE ->+ TypeEnv ->+ Int ->+ VarEnv ->+ ( Errors,VarIdent,Int)+sem_AssignField_AssignField :: VarIdent ->+ T_Expr ->+ T_AssignField+sem_AssignField_AssignField ident_ expr_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOname :: VarIdent+ _lhsOerrors :: Errors+ _lhsOtypecounter :: Int+ _exprOerrors :: Errors+ _exprOexpect :: TYPE+ _exprOtypeEnv :: TypeEnv+ _exprOtypecounter :: Int+ _exprOvarEnv :: VarEnv+ _exprIerrors :: Errors+ _exprItp :: TYPE+ _exprItypecounter :: Int+ _lhsOname =+ ident_+ _lhsOerrors =+ _exprIerrors+ _lhsOtypecounter =+ _exprItypecounter+ _exprOerrors =+ _lhsIerrors+ _exprOexpect =+ _lhsIexpect+ _exprOtypeEnv =+ _lhsItypeEnv+ _exprOtypecounter =+ _lhsItypecounter+ _exprOvarEnv =+ _lhsIvarEnv+ ( _exprIerrors,_exprItp,_exprItypecounter) =+ (expr_ _exprOerrors _exprOexpect _exprOtypeEnv _exprOtypecounter _exprOvarEnv)+ in ( _lhsOerrors,_lhsOname,_lhsOtypecounter)))+-- AssignFields ------------------------------------------------+-- cata+sem_AssignFields :: AssignFields ->+ T_AssignFields+sem_AssignFields list =+ (Prelude.foldr sem_AssignFields_Cons sem_AssignFields_Nil (Prelude.map sem_AssignField list))+-- semantic domain+type T_AssignFields = Errors ->+ ([TYPE]) ->+ TypeEnv ->+ Int ->+ VarEnv ->+ ( Errors,([VarIdent]),Int)+sem_AssignFields_Cons :: T_AssignField ->+ T_AssignFields ->+ T_AssignFields+sem_AssignFields_Cons hd_ tl_ =+ (\ _lhsIerrors+ _lhsIexpects+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOnames :: ([VarIdent])+ _hdOexpect :: TYPE+ _tlOexpects :: ([TYPE])+ _lhsOerrors :: Errors+ _lhsOtypecounter :: Int+ _hdOerrors :: Errors+ _hdOtypeEnv :: TypeEnv+ _hdOtypecounter :: Int+ _hdOvarEnv :: VarEnv+ _tlOerrors :: Errors+ _tlOtypeEnv :: TypeEnv+ _tlOtypecounter :: Int+ _tlOvarEnv :: VarEnv+ _hdIerrors :: Errors+ _hdIname :: VarIdent+ _hdItypecounter :: Int+ _tlIerrors :: Errors+ _tlInames :: ([VarIdent])+ _tlItypecounter :: Int+ _lhsOnames =+ _hdIname : _tlInames+ _hdOexpect =+ head _lhsIexpects+ _tlOexpects =+ tail _lhsIexpects+ _lhsOerrors =+ _tlIerrors+ _lhsOtypecounter =+ _tlItypecounter+ _hdOerrors =+ _lhsIerrors+ _hdOtypeEnv =+ _lhsItypeEnv+ _hdOtypecounter =+ _lhsItypecounter+ _hdOvarEnv =+ _lhsIvarEnv+ _tlOerrors =+ _hdIerrors+ _tlOtypeEnv =+ _lhsItypeEnv+ _tlOtypecounter =+ _hdItypecounter+ _tlOvarEnv =+ _lhsIvarEnv+ ( _hdIerrors,_hdIname,_hdItypecounter) =+ (hd_ _hdOerrors _hdOexpect _hdOtypeEnv _hdOtypecounter _hdOvarEnv)+ ( _tlIerrors,_tlInames,_tlItypecounter) =+ (tl_ _tlOerrors _tlOexpects _tlOtypeEnv _tlOtypecounter _tlOvarEnv)+ in ( _lhsOerrors,_lhsOnames,_lhsOtypecounter)))+sem_AssignFields_Nil :: T_AssignFields+sem_AssignFields_Nil =+ (\ _lhsIerrors+ _lhsIexpects+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOnames :: ([VarIdent])+ _lhsOerrors :: Errors+ _lhsOtypecounter :: Int+ _lhsOnames =+ []+ _lhsOerrors =+ _lhsIerrors+ _lhsOtypecounter =+ _lhsItypecounter+ in ( _lhsOerrors,_lhsOnames,_lhsOtypecounter)))+-- DeclGroup ---------------------------------------------------+-- cata+sem_DeclGroup :: DeclGroup ->+ T_DeclGroup+sem_DeclGroup (FunDecs _decs) =+ (sem_DeclGroup_FunDecs (sem_FunDecs _decs))+sem_DeclGroup (TypeDecs _decs) =+ (sem_DeclGroup_TypeDecs (sem_TypeDecs _decs))+sem_DeclGroup (VarDec _pos _ident _tp _expr) =+ (sem_DeclGroup_VarDec _pos _ident _tp (sem_Expr _expr))+-- semantic domain+type T_DeclGroup = Errors ->+ TypeEnv ->+ Int ->+ VarEnv ->+ ( Errors,TypeEnv,Int,VarEnv)+sem_DeclGroup_FunDecs :: T_FunDecs ->+ T_DeclGroup+sem_DeclGroup_FunDecs decs_ =+ (\ _lhsIerrors+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOerrors :: Errors+ _lhsOtypeEnv :: TypeEnv+ _lhsOtypecounter :: Int+ _lhsOvarEnv :: VarEnv+ _decsOerrors :: Errors+ _decsOtypeEnv :: TypeEnv+ _decsOtypecounter :: Int+ _decsOvarEnv :: VarEnv+ _decsIerrors :: Errors+ _decsIfundecs :: VarEnv+ _decsItypecounter :: Int+ _varEnv =+ _decsIfundecs `union` _lhsIvarEnv+ _lhsOerrors =+ _decsIerrors+ _lhsOtypeEnv =+ _lhsItypeEnv+ _lhsOtypecounter =+ _decsItypecounter+ _lhsOvarEnv =+ _varEnv+ _decsOerrors =+ _lhsIerrors+ _decsOtypeEnv =+ _lhsItypeEnv+ _decsOtypecounter =+ _lhsItypecounter+ _decsOvarEnv =+ _varEnv+ ( _decsIerrors,_decsIfundecs,_decsItypecounter) =+ (decs_ _decsOerrors _decsOtypeEnv _decsOtypecounter _decsOvarEnv)+ in ( _lhsOerrors,_lhsOtypeEnv,_lhsOtypecounter,_lhsOvarEnv)))+sem_DeclGroup_TypeDecs :: T_TypeDecs ->+ T_DeclGroup+sem_DeclGroup_TypeDecs decs_ =+ (\ _lhsIerrors+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _decsOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtypeEnv :: TypeEnv+ _lhsOtypecounter :: Int+ _lhsOvarEnv :: VarEnv+ _decsOtypeEnv :: TypeEnv+ _decsOtypecounter :: Int+ _decsIerrors :: Errors+ _decsItypecounter :: Int+ _decsItypedecs :: ((TypeEnv, TypeSyns))+ __tup1 =+ addTypeDecls _decsItypedecs _lhsItypeEnv+ (_errs,_) =+ __tup1+ (_,_typeEnv) =+ __tup1+ _decsOerrors =+ _lhsIerrors <> _errs+ _lhsOerrors =+ _decsIerrors+ _lhsOtypeEnv =+ _typeEnv+ _lhsOtypecounter =+ _decsItypecounter+ _lhsOvarEnv =+ _lhsIvarEnv+ _decsOtypeEnv =+ _typeEnv+ _decsOtypecounter =+ _lhsItypecounter+ ( _decsIerrors,_decsItypecounter,_decsItypedecs) =+ (decs_ _decsOerrors _decsOtypeEnv _decsOtypecounter)+ in ( _lhsOerrors,_lhsOtypeEnv,_lhsOtypecounter,_lhsOvarEnv)))+sem_DeclGroup_VarDec :: Pos ->+ VarIdent ->+ (Maybe TypeIdent) ->+ T_Expr ->+ T_DeclGroup+sem_DeclGroup_VarDec pos_ ident_ tp_ expr_ =+ (\ _lhsIerrors+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOvarEnv :: VarEnv+ _exprOexpect :: TYPE+ _exprOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtypeEnv :: TypeEnv+ _lhsOtypecounter :: Int+ _exprOtypeEnv :: TypeEnv+ _exprOtypecounter :: Int+ _exprOvarEnv :: VarEnv+ _exprIerrors :: Errors+ _exprItp :: TYPE+ _exprItypecounter :: Int+ _lhsOvarEnv =+ insertIdent ident_ (VarType _theType) _lhsIvarEnv+ __tup2 =+ case tp_ of+ Just t -> findType _lhsItypeEnv t+ Nothing -> case _exprItp of+ NIL -> (single (UnknownType (getPos ident_)),ERROR)+ VOID -> (single (InitWithVoid (getPos ident_)),ERROR)+ _ -> (empty,_exprItp)+ (_errs,_) =+ __tup2+ (_,_theType) =+ __tup2+ _exprOexpect =+ _theType+ _exprOerrors =+ _lhsIerrors <> _errs+ _lhsOerrors =+ _exprIerrors+ _lhsOtypeEnv =+ _lhsItypeEnv+ _lhsOtypecounter =+ _exprItypecounter+ _exprOtypeEnv =+ _lhsItypeEnv+ _exprOtypecounter =+ _lhsItypecounter+ _exprOvarEnv =+ _lhsIvarEnv+ ( _exprIerrors,_exprItp,_exprItypecounter) =+ (expr_ _exprOerrors _exprOexpect _exprOtypeEnv _exprOtypecounter _exprOvarEnv)+ in ( _lhsOerrors,_lhsOtypeEnv,_lhsOtypecounter,_lhsOvarEnv)))+-- Declarations ------------------------------------------------+-- cata+sem_Declarations :: Declarations ->+ T_Declarations+sem_Declarations list =+ (Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_DeclGroup list))+-- semantic domain+type T_Declarations = Errors ->+ TypeEnv ->+ Int ->+ VarEnv ->+ ( Errors,TypeEnv,Int,VarEnv)+sem_Declarations_Cons :: T_DeclGroup ->+ T_Declarations ->+ T_Declarations+sem_Declarations_Cons hd_ tl_ =+ (\ _lhsIerrors+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOerrors :: Errors+ _lhsOtypeEnv :: TypeEnv+ _lhsOtypecounter :: Int+ _lhsOvarEnv :: VarEnv+ _hdOerrors :: Errors+ _hdOtypeEnv :: TypeEnv+ _hdOtypecounter :: Int+ _hdOvarEnv :: VarEnv+ _tlOerrors :: Errors+ _tlOtypeEnv :: TypeEnv+ _tlOtypecounter :: Int+ _tlOvarEnv :: VarEnv+ _hdIerrors :: Errors+ _hdItypeEnv :: TypeEnv+ _hdItypecounter :: Int+ _hdIvarEnv :: VarEnv+ _tlIerrors :: Errors+ _tlItypeEnv :: TypeEnv+ _tlItypecounter :: Int+ _tlIvarEnv :: VarEnv+ _lhsOerrors =+ _tlIerrors+ _lhsOtypeEnv =+ _tlItypeEnv+ _lhsOtypecounter =+ _tlItypecounter+ _lhsOvarEnv =+ _tlIvarEnv+ _hdOerrors =+ _lhsIerrors+ _hdOtypeEnv =+ _lhsItypeEnv+ _hdOtypecounter =+ _lhsItypecounter+ _hdOvarEnv =+ _lhsIvarEnv+ _tlOerrors =+ _hdIerrors+ _tlOtypeEnv =+ _hdItypeEnv+ _tlOtypecounter =+ _hdItypecounter+ _tlOvarEnv =+ _hdIvarEnv+ ( _hdIerrors,_hdItypeEnv,_hdItypecounter,_hdIvarEnv) =+ (hd_ _hdOerrors _hdOtypeEnv _hdOtypecounter _hdOvarEnv)+ ( _tlIerrors,_tlItypeEnv,_tlItypecounter,_tlIvarEnv) =+ (tl_ _tlOerrors _tlOtypeEnv _tlOtypecounter _tlOvarEnv)+ in ( _lhsOerrors,_lhsOtypeEnv,_lhsOtypecounter,_lhsOvarEnv)))+sem_Declarations_Nil :: T_Declarations+sem_Declarations_Nil =+ (\ _lhsIerrors+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOerrors :: Errors+ _lhsOtypeEnv :: TypeEnv+ _lhsOtypecounter :: Int+ _lhsOvarEnv :: VarEnv+ _lhsOerrors =+ _lhsIerrors+ _lhsOtypeEnv =+ _lhsItypeEnv+ _lhsOtypecounter =+ _lhsItypecounter+ _lhsOvarEnv =+ _lhsIvarEnv+ in ( _lhsOerrors,_lhsOtypeEnv,_lhsOtypecounter,_lhsOvarEnv)))+-- Expr --------------------------------------------------------+-- cata+sem_Expr :: Expr ->+ T_Expr+sem_Expr (Apply _ident _args) =+ (sem_Expr_Apply _ident (sem_Args _args))+sem_Expr (ArrayVal _ident _size _init) =+ (sem_Expr_ArrayVal _ident (sem_Expr _size) (sem_Expr _init))+sem_Expr (Assign _lvalue _pos _expr) =+ (sem_Expr_Assign (sem_LValue _lvalue) _pos (sem_Expr _expr))+sem_Expr (Break _pos) =+ (sem_Expr_Break _pos)+sem_Expr (For _pos _ident _low _hi _body) =+ (sem_Expr_For _pos _ident (sem_Expr _low) (sem_Expr _hi) (sem_Expr _body))+sem_Expr (If _pos _cond _thenPart _elsePart) =+ (sem_Expr_If _pos (sem_Expr _cond) (sem_Expr _thenPart) (sem_Expr _elsePart))+sem_Expr (IntLit _value _pos) =+ (sem_Expr_IntLit _value _pos)+sem_Expr (LValue _lvalue) =+ (sem_Expr_LValue (sem_LValue _lvalue))+sem_Expr (Let _pos _decls _body) =+ (sem_Expr_Let _pos (sem_Declarations _decls) (sem_Expr _body))+sem_Expr (Nil _pos) =+ (sem_Expr_Nil _pos)+sem_Expr (Op _op _pos _left _right) =+ (sem_Expr_Op _op _pos (sem_Expr _left) (sem_Expr _right))+sem_Expr (RecordVal _ident _fields) =+ (sem_Expr_RecordVal _ident (sem_AssignFields _fields))+sem_Expr (Sequence _left _right) =+ (sem_Expr_Sequence (sem_Expr _left) (sem_Expr _right))+sem_Expr (Skip ) =+ (sem_Expr_Skip )+sem_Expr (StringLit _value _pos) =+ (sem_Expr_StringLit _value _pos)+sem_Expr (UnOp _pos _op _expr) =+ (sem_Expr_UnOp _pos _op (sem_Expr _expr))+sem_Expr (While _pos _cond _body) =+ (sem_Expr_While _pos (sem_Expr _cond) (sem_Expr _body))+-- semantic domain+type T_Expr = Errors ->+ TYPE ->+ TypeEnv ->+ Int ->+ VarEnv ->+ ( Errors,TYPE,Int)+sem_Expr_Apply :: VarIdent ->+ T_Args ->+ T_Expr+sem_Expr_Apply ident_ args_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOtp :: TYPE+ _argsOexpects :: ([TYPE])+ _argsOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtypecounter :: Int+ _argsOtypeEnv :: TypeEnv+ _argsOtypecounter :: Int+ _argsOvarEnv :: VarEnv+ _argsIerrors :: Errors+ _argsIsize :: Int+ _argsItypecounter :: Int+ __tup3 =+ findFunction _lhsIvarEnv ident_+ (_errs,_,_) =+ __tup3+ (_,_argTps,_) =+ __tup3+ (_,_,_retTp) =+ __tup3+ _lhsOtp =+ _retTp+ _argsOexpects =+ _argTps ++ repeat ERROR+ _argsOerrors =+ _lhsIerrors <>+ _errs <>+ (case compare _argsIsize (length _argTps) of+ LT -> single (TooFewArguments ident_)+ GT -> single (TooManyArguments ident_)+ EQ -> empty) <>+ if match _lhsIexpect _retTp+ then empty+ else single (TypeMisMatch _lhsIexpect _retTp)+ _lhsOerrors =+ _argsIerrors+ _lhsOtypecounter =+ _argsItypecounter+ _argsOtypeEnv =+ _lhsItypeEnv+ _argsOtypecounter =+ _lhsItypecounter+ _argsOvarEnv =+ _lhsIvarEnv+ ( _argsIerrors,_argsIsize,_argsItypecounter) =+ (args_ _argsOerrors _argsOexpects _argsOtypeEnv _argsOtypecounter _argsOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_ArrayVal :: TypeIdent ->+ T_Expr ->+ T_Expr ->+ T_Expr+sem_Expr_ArrayVal ident_ size_ init_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _sizeOexpect :: TYPE+ _initOexpect :: TYPE+ _initOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _sizeOerrors :: Errors+ _sizeOtypeEnv :: TypeEnv+ _sizeOtypecounter :: Int+ _sizeOvarEnv :: VarEnv+ _initOtypeEnv :: TypeEnv+ _initOtypecounter :: Int+ _initOvarEnv :: VarEnv+ _sizeIerrors :: Errors+ _sizeItp :: TYPE+ _sizeItypecounter :: Int+ _initIerrors :: Errors+ _initItp :: TYPE+ _initItypecounter :: Int+ __tup4 =+ findType _lhsItypeEnv ident_+ (_err1,_) =+ __tup4+ (_,_tp) =+ __tup4+ __tup5 =+ arrayComponentType (getPos ident_) _tp+ (_err2,_) =+ __tup5+ (_,_compTp) =+ __tup5+ _sizeOexpect =+ INT+ _initOexpect =+ _compTp+ _initOerrors =+ _lhsIerrors <>+ _err1 <>+ _err2 <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOerrors =+ _initIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _initItypecounter+ _sizeOerrors =+ _lhsIerrors+ _sizeOtypeEnv =+ _lhsItypeEnv+ _sizeOtypecounter =+ _lhsItypecounter+ _sizeOvarEnv =+ _lhsIvarEnv+ _initOtypeEnv =+ _lhsItypeEnv+ _initOtypecounter =+ _sizeItypecounter+ _initOvarEnv =+ _lhsIvarEnv+ ( _sizeIerrors,_sizeItp,_sizeItypecounter) =+ (size_ _sizeOerrors _sizeOexpect _sizeOtypeEnv _sizeOtypecounter _sizeOvarEnv)+ ( _initIerrors,_initItp,_initItypecounter) =+ (init_ _initOerrors _initOexpect _initOtypeEnv _initOtypecounter _initOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_Assign :: T_LValue ->+ Pos ->+ T_Expr ->+ T_Expr+sem_Expr_Assign lvalue_ pos_ expr_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lvalueOexpect :: TYPE+ _exprOexpect :: TYPE+ _lvalueOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _lvalueOtypeEnv :: TypeEnv+ _lvalueOtypecounter :: Int+ _lvalueOvarEnv :: VarEnv+ _exprOerrors :: Errors+ _exprOtypeEnv :: TypeEnv+ _exprOtypecounter :: Int+ _exprOvarEnv :: VarEnv+ _lvalueIerrors :: Errors+ _lvalueItp :: TYPE+ _lvalueItypecounter :: Int+ _exprIerrors :: Errors+ _exprItp :: TYPE+ _exprItypecounter :: Int+ _tp =+ VOID+ __tup6 =+ _lvalueItp `meetErr` _exprItp+ (_err,_) =+ __tup6+ (_,_expType) =+ __tup6+ _lvalueOexpect =+ _expType+ _exprOexpect =+ _expType+ _lvalueOerrors =+ _lhsIerrors <>+ _err <>+ (if _lvalueItp == LOOPCOUNTER+ then single (AssignLoopcounter pos_)+ else empty+ ) <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOerrors =+ _exprIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _exprItypecounter+ _lvalueOtypeEnv =+ _lhsItypeEnv+ _lvalueOtypecounter =+ _lhsItypecounter+ _lvalueOvarEnv =+ _lhsIvarEnv+ _exprOerrors =+ _lvalueIerrors+ _exprOtypeEnv =+ _lhsItypeEnv+ _exprOtypecounter =+ _lvalueItypecounter+ _exprOvarEnv =+ _lhsIvarEnv+ ( _lvalueIerrors,_lvalueItp,_lvalueItypecounter) =+ (lvalue_ _lvalueOerrors _lvalueOexpect _lvalueOtypeEnv _lvalueOtypecounter _lvalueOvarEnv)+ ( _exprIerrors,_exprItp,_exprItypecounter) =+ (expr_ _exprOerrors _exprOexpect _exprOtypeEnv _exprOtypecounter _exprOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_Break :: Pos ->+ T_Expr+sem_Expr_Break pos_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _tp =+ VOID+ _lhsOerrors =+ _lhsIerrors <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _lhsItypecounter+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_For :: Pos ->+ VarIdent ->+ T_Expr ->+ T_Expr ->+ T_Expr ->+ T_Expr+sem_Expr_For pos_ ident_ low_ hi_ body_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _bodyOvarEnv :: VarEnv+ _hiOexpect :: TYPE+ _lowOexpect :: TYPE+ _bodyOexpect :: TYPE+ _lowOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _lowOtypeEnv :: TypeEnv+ _lowOtypecounter :: Int+ _lowOvarEnv :: VarEnv+ _hiOerrors :: Errors+ _hiOtypeEnv :: TypeEnv+ _hiOtypecounter :: Int+ _hiOvarEnv :: VarEnv+ _bodyOerrors :: Errors+ _bodyOtypeEnv :: TypeEnv+ _bodyOtypecounter :: Int+ _lowIerrors :: Errors+ _lowItp :: TYPE+ _lowItypecounter :: Int+ _hiIerrors :: Errors+ _hiItp :: TYPE+ _hiItypecounter :: Int+ _bodyIerrors :: Errors+ _bodyItp :: TYPE+ _bodyItypecounter :: Int+ _bodyOvarEnv =+ insertIdent ident_ (VarType LOOPCOUNTER) _lhsIvarEnv+ _tp =+ VOID+ _hiOexpect =+ INT+ _lowOexpect =+ INT+ _bodyOexpect =+ VOID+ _lowOerrors =+ _lhsIerrors <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOerrors =+ _bodyIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _bodyItypecounter+ _lowOtypeEnv =+ _lhsItypeEnv+ _lowOtypecounter =+ _lhsItypecounter+ _lowOvarEnv =+ _lhsIvarEnv+ _hiOerrors =+ _lowIerrors+ _hiOtypeEnv =+ _lhsItypeEnv+ _hiOtypecounter =+ _lowItypecounter+ _hiOvarEnv =+ _lhsIvarEnv+ _bodyOerrors =+ _hiIerrors+ _bodyOtypeEnv =+ _lhsItypeEnv+ _bodyOtypecounter =+ _hiItypecounter+ ( _lowIerrors,_lowItp,_lowItypecounter) =+ (low_ _lowOerrors _lowOexpect _lowOtypeEnv _lowOtypecounter _lowOvarEnv)+ ( _hiIerrors,_hiItp,_hiItypecounter) =+ (hi_ _hiOerrors _hiOexpect _hiOtypeEnv _hiOtypecounter _hiOvarEnv)+ ( _bodyIerrors,_bodyItp,_bodyItypecounter) =+ (body_ _bodyOerrors _bodyOexpect _bodyOtypeEnv _bodyOtypecounter _bodyOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_If :: Pos ->+ T_Expr ->+ T_Expr ->+ T_Expr ->+ T_Expr+sem_Expr_If pos_ cond_ thenPart_ elsePart_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _condOexpect :: TYPE+ _elsePartOexpect :: TYPE+ _thenPartOexpect :: TYPE+ _condOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _condOtypeEnv :: TypeEnv+ _condOtypecounter :: Int+ _condOvarEnv :: VarEnv+ _thenPartOerrors :: Errors+ _thenPartOtypeEnv :: TypeEnv+ _thenPartOtypecounter :: Int+ _thenPartOvarEnv :: VarEnv+ _elsePartOerrors :: Errors+ _elsePartOtypeEnv :: TypeEnv+ _elsePartOtypecounter :: Int+ _elsePartOvarEnv :: VarEnv+ _condIerrors :: Errors+ _condItp :: TYPE+ _condItypecounter :: Int+ _thenPartIerrors :: Errors+ _thenPartItp :: TYPE+ _thenPartItypecounter :: Int+ _elsePartIerrors :: Errors+ _elsePartItp :: TYPE+ _elsePartItypecounter :: Int+ _tp =+ _expectType+ __tup7 =+ _thenPartItp `meetErr` _elsePartItp+ (_err,_) =+ __tup7+ (_,_expectType) =+ __tup7+ _condOexpect =+ INT+ _elsePartOexpect =+ _expectType+ _thenPartOexpect =+ _expectType+ _condOerrors =+ _lhsIerrors <>+ _err <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOerrors =+ _elsePartIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _elsePartItypecounter+ _condOtypeEnv =+ _lhsItypeEnv+ _condOtypecounter =+ _lhsItypecounter+ _condOvarEnv =+ _lhsIvarEnv+ _thenPartOerrors =+ _condIerrors+ _thenPartOtypeEnv =+ _lhsItypeEnv+ _thenPartOtypecounter =+ _condItypecounter+ _thenPartOvarEnv =+ _lhsIvarEnv+ _elsePartOerrors =+ _thenPartIerrors+ _elsePartOtypeEnv =+ _lhsItypeEnv+ _elsePartOtypecounter =+ _thenPartItypecounter+ _elsePartOvarEnv =+ _lhsIvarEnv+ ( _condIerrors,_condItp,_condItypecounter) =+ (cond_ _condOerrors _condOexpect _condOtypeEnv _condOtypecounter _condOvarEnv)+ ( _thenPartIerrors,_thenPartItp,_thenPartItypecounter) =+ (thenPart_ _thenPartOerrors _thenPartOexpect _thenPartOtypeEnv _thenPartOtypecounter _thenPartOvarEnv)+ ( _elsePartIerrors,_elsePartItp,_elsePartItypecounter) =+ (elsePart_ _elsePartOerrors _elsePartOexpect _elsePartOtypeEnv _elsePartOtypecounter _elsePartOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_IntLit :: Integer ->+ Pos ->+ T_Expr+sem_Expr_IntLit value_ pos_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _tp =+ INT+ _lhsOerrors =+ _lhsIerrors <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _lhsItypecounter+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_LValue :: T_LValue ->+ T_Expr+sem_Expr_LValue lvalue_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lvalueOexpect :: TYPE+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _lvalueOerrors :: Errors+ _lvalueOtypeEnv :: TypeEnv+ _lvalueOtypecounter :: Int+ _lvalueOvarEnv :: VarEnv+ _lvalueIerrors :: Errors+ _lvalueItp :: TYPE+ _lvalueItypecounter :: Int+ _tp =+ if _lvalueItp == LOOPCOUNTER+ then INT+ else _lvalueItp+ _lvalueOexpect =+ _lhsIexpect+ _lhsOerrors =+ _lvalueIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _lvalueItypecounter+ _lvalueOerrors =+ _lhsIerrors+ _lvalueOtypeEnv =+ _lhsItypeEnv+ _lvalueOtypecounter =+ _lhsItypecounter+ _lvalueOvarEnv =+ _lhsIvarEnv+ ( _lvalueIerrors,_lvalueItp,_lvalueItypecounter) =+ (lvalue_ _lvalueOerrors _lvalueOexpect _lvalueOtypeEnv _lvalueOtypecounter _lvalueOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_Let :: Pos ->+ T_Declarations ->+ T_Expr ->+ T_Expr+sem_Expr_Let pos_ decls_ body_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOtp :: TYPE+ _bodyOexpect :: TYPE+ _lhsOerrors :: Errors+ _lhsOtypecounter :: Int+ _declsOerrors :: Errors+ _declsOtypeEnv :: TypeEnv+ _declsOtypecounter :: Int+ _declsOvarEnv :: VarEnv+ _bodyOerrors :: Errors+ _bodyOtypeEnv :: TypeEnv+ _bodyOtypecounter :: Int+ _bodyOvarEnv :: VarEnv+ _declsIerrors :: Errors+ _declsItypeEnv :: TypeEnv+ _declsItypecounter :: Int+ _declsIvarEnv :: VarEnv+ _bodyIerrors :: Errors+ _bodyItp :: TYPE+ _bodyItypecounter :: Int+ _lhsOtp =+ _bodyItp+ _bodyOexpect =+ _lhsIexpect+ _lhsOerrors =+ _bodyIerrors+ _lhsOtypecounter =+ _bodyItypecounter+ _declsOerrors =+ _lhsIerrors+ _declsOtypeEnv =+ _lhsItypeEnv+ _declsOtypecounter =+ _lhsItypecounter+ _declsOvarEnv =+ _lhsIvarEnv+ _bodyOerrors =+ _declsIerrors+ _bodyOtypeEnv =+ _declsItypeEnv+ _bodyOtypecounter =+ _declsItypecounter+ _bodyOvarEnv =+ _declsIvarEnv+ ( _declsIerrors,_declsItypeEnv,_declsItypecounter,_declsIvarEnv) =+ (decls_ _declsOerrors _declsOtypeEnv _declsOtypecounter _declsOvarEnv)+ ( _bodyIerrors,_bodyItp,_bodyItypecounter) =+ (body_ _bodyOerrors _bodyOexpect _bodyOtypeEnv _bodyOtypecounter _bodyOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_Nil :: Pos ->+ T_Expr+sem_Expr_Nil pos_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _tp =+ NIL+ _lhsOerrors =+ _lhsIerrors <>+ (if _lhsIexpect == NIL+ then single (UnknownType pos_)+ else empty+ ) <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _lhsItypecounter+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_Op :: String ->+ Pos ->+ T_Expr ->+ T_Expr ->+ T_Expr+sem_Expr_Op op_ pos_ left_ right_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _leftOexpect :: TYPE+ _rightOexpect :: TYPE+ _leftOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _leftOtypeEnv :: TypeEnv+ _leftOtypecounter :: Int+ _leftOvarEnv :: VarEnv+ _rightOerrors :: Errors+ _rightOtypeEnv :: TypeEnv+ _rightOtypecounter :: Int+ _rightOvarEnv :: VarEnv+ _leftIerrors :: Errors+ _leftItp :: TYPE+ _leftItypecounter :: Int+ _rightIerrors :: Errors+ _rightItp :: TYPE+ _rightItypecounter :: Int+ _leftOexpect =+ _expect+ _rightOexpect =+ _expect+ _tp =+ INT+ __tup8 =+ let check | op_ `elem` ["+","-","*","/","|","&"] = (empty,INT)+ | op_ `elem` [">=", "<=", "<", ">"] = let (e,tp) = meetErr _leftItp _rightItp+ in if tp `elem` [INT,STRING,ERROR]+ then (e,tp)+ else (e<>single(CompareOp pos_ op_),tp)+ | op_ `elem` [ "=", "<>"] = let (e,tp) = meetErr _leftItp _rightItp+ in if tp == NIL+ then (e<>single(UnknownType pos_) ,ERROR)+ else (e,tp)+ | otherwise = compilerError ("unknown binary operator: " ++ op_)+ in check+ (_err,_) =+ __tup8+ (_,_expect) =+ __tup8+ _leftOerrors =+ _lhsIerrors <>+ _err <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOerrors =+ _rightIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _rightItypecounter+ _leftOtypeEnv =+ _lhsItypeEnv+ _leftOtypecounter =+ _lhsItypecounter+ _leftOvarEnv =+ _lhsIvarEnv+ _rightOerrors =+ _leftIerrors+ _rightOtypeEnv =+ _lhsItypeEnv+ _rightOtypecounter =+ _leftItypecounter+ _rightOvarEnv =+ _lhsIvarEnv+ ( _leftIerrors,_leftItp,_leftItypecounter) =+ (left_ _leftOerrors _leftOexpect _leftOtypeEnv _leftOtypecounter _leftOvarEnv)+ ( _rightIerrors,_rightItp,_rightItypecounter) =+ (right_ _rightOerrors _rightOexpect _rightOtypeEnv _rightOtypecounter _rightOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_RecordVal :: TypeIdent ->+ T_AssignFields ->+ T_Expr+sem_Expr_RecordVal ident_ fields_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _fieldsOexpects :: ([TYPE])+ _fieldsOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _fieldsOtypeEnv :: TypeEnv+ _fieldsOtypecounter :: Int+ _fieldsOvarEnv :: VarEnv+ _fieldsIerrors :: Errors+ _fieldsInames :: ([VarIdent])+ _fieldsItypecounter :: Int+ __tup9 =+ findType _lhsItypeEnv ident_+ (_err1,_) =+ __tup9+ (_,_tp) =+ __tup9+ __tup10 =+ recordType (getPos ident_) _tp+ (_err2,_) =+ __tup10+ (_,_fieldEnv) =+ __tup10+ __tup11 =+ let f i ~(err,ts) = case recordFieldType (getPos i) _fieldEnv i of+ (e,t) -> (err<>e,t:ts)+ in foldr f (empty,[]) _fieldsInames+ (_err3,_) =+ __tup11+ (_,_expFields) =+ __tup11+ _notInit =+ foldr cons empty [ FieldNotInit f | f <- keys _fieldEnv, not (f `elem` _fieldsInames)]+ _fieldsOexpects =+ _expFields+ _fieldsOerrors =+ _lhsIerrors <>+ _err1 <>+ _err2 <>+ _err3 <>+ _notInit <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOerrors =+ _fieldsIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _fieldsItypecounter+ _fieldsOtypeEnv =+ _lhsItypeEnv+ _fieldsOtypecounter =+ _lhsItypecounter+ _fieldsOvarEnv =+ _lhsIvarEnv+ ( _fieldsIerrors,_fieldsInames,_fieldsItypecounter) =+ (fields_ _fieldsOerrors _fieldsOexpects _fieldsOtypeEnv _fieldsOtypecounter _fieldsOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_Sequence :: T_Expr ->+ T_Expr ->+ T_Expr+sem_Expr_Sequence left_ right_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _leftOexpect :: TYPE+ _leftOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _leftOtypeEnv :: TypeEnv+ _leftOtypecounter :: Int+ _leftOvarEnv :: VarEnv+ _rightOerrors :: Errors+ _rightOexpect :: TYPE+ _rightOtypeEnv :: TypeEnv+ _rightOtypecounter :: Int+ _rightOvarEnv :: VarEnv+ _leftIerrors :: Errors+ _leftItp :: TYPE+ _leftItypecounter :: Int+ _rightIerrors :: Errors+ _rightItp :: TYPE+ _rightItypecounter :: Int+ _tp =+ _rightItp+ _leftOexpect =+ _leftItp+ _leftOerrors =+ _lhsIerrors <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOerrors =+ _rightIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _rightItypecounter+ _leftOtypeEnv =+ _lhsItypeEnv+ _leftOtypecounter =+ _lhsItypecounter+ _leftOvarEnv =+ _lhsIvarEnv+ _rightOerrors =+ _leftIerrors+ _rightOexpect =+ _lhsIexpect+ _rightOtypeEnv =+ _lhsItypeEnv+ _rightOtypecounter =+ _leftItypecounter+ _rightOvarEnv =+ _lhsIvarEnv+ ( _leftIerrors,_leftItp,_leftItypecounter) =+ (left_ _leftOerrors _leftOexpect _leftOtypeEnv _leftOtypecounter _leftOvarEnv)+ ( _rightIerrors,_rightItp,_rightItypecounter) =+ (right_ _rightOerrors _rightOexpect _rightOtypeEnv _rightOtypecounter _rightOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_Skip :: T_Expr+sem_Expr_Skip =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _tp =+ VOID+ _lhsOerrors =+ _lhsIerrors <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _lhsItypecounter+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_StringLit :: String ->+ Pos ->+ T_Expr+sem_Expr_StringLit value_ pos_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _tp =+ STRING+ _lhsOerrors =+ _lhsIerrors <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _lhsItypecounter+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_UnOp :: Pos ->+ String ->+ T_Expr ->+ T_Expr+sem_Expr_UnOp pos_ op_ expr_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _exprOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _exprOexpect :: TYPE+ _exprOtypeEnv :: TypeEnv+ _exprOtypecounter :: Int+ _exprOvarEnv :: VarEnv+ _exprIerrors :: Errors+ _exprItp :: TYPE+ _exprItypecounter :: Int+ __tup12 =+ case op_ of+ "-" -> (INT,INT)+ _ -> compilerError ("unknown unary operator: " ++ op_)+ (_tp,_) =+ __tup12+ (_,_expect) =+ __tup12+ _exprOerrors =+ _lhsIerrors <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOerrors =+ _exprIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _exprItypecounter+ _exprOexpect =+ _expect+ _exprOtypeEnv =+ _lhsItypeEnv+ _exprOtypecounter =+ _lhsItypecounter+ _exprOvarEnv =+ _lhsIvarEnv+ ( _exprIerrors,_exprItp,_exprItypecounter) =+ (expr_ _exprOerrors _exprOexpect _exprOtypeEnv _exprOtypecounter _exprOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_Expr_While :: Pos ->+ T_Expr ->+ T_Expr ->+ T_Expr+sem_Expr_While pos_ cond_ body_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _condOexpect :: TYPE+ _bodyOexpect :: TYPE+ _condOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _condOtypeEnv :: TypeEnv+ _condOtypecounter :: Int+ _condOvarEnv :: VarEnv+ _bodyOerrors :: Errors+ _bodyOtypeEnv :: TypeEnv+ _bodyOtypecounter :: Int+ _bodyOvarEnv :: VarEnv+ _condIerrors :: Errors+ _condItp :: TYPE+ _condItypecounter :: Int+ _bodyIerrors :: Errors+ _bodyItp :: TYPE+ _bodyItypecounter :: Int+ _tp =+ VOID+ _condOexpect =+ INT+ _bodyOexpect =+ VOID+ _condOerrors =+ _lhsIerrors <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOerrors =+ _bodyIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _bodyItypecounter+ _condOtypeEnv =+ _lhsItypeEnv+ _condOtypecounter =+ _lhsItypecounter+ _condOvarEnv =+ _lhsIvarEnv+ _bodyOerrors =+ _condIerrors+ _bodyOtypeEnv =+ _lhsItypeEnv+ _bodyOtypecounter =+ _condItypecounter+ _bodyOvarEnv =+ _lhsIvarEnv+ ( _condIerrors,_condItp,_condItypecounter) =+ (cond_ _condOerrors _condOexpect _condOtypeEnv _condOtypecounter _condOvarEnv)+ ( _bodyIerrors,_bodyItp,_bodyItypecounter) =+ (body_ _bodyOerrors _bodyOexpect _bodyOtypeEnv _bodyOtypecounter _bodyOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+-- FunDec ------------------------------------------------------+-- cata+sem_FunDec :: FunDec ->+ T_FunDec+sem_FunDec (FunDec _pos _ident _argTps _retTp _body) =+ (sem_FunDec_FunDec _pos _ident _argTps _retTp (sem_Expr _body))+-- semantic domain+type T_FunDec = Errors ->+ VarEnv ->+ TypeEnv ->+ Int ->+ VarEnv ->+ ( Errors,VarEnv,Int)+sem_FunDec_FunDec :: Pos ->+ VarIdent ->+ ([TypedVar]) ->+ (Maybe TypeIdent) ->+ T_Expr ->+ T_FunDec+sem_FunDec_FunDec pos_ ident_ argTps_ retTp_ body_ =+ (\ _lhsIerrors+ _lhsIfundecs+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _bodyOvarEnv :: VarEnv+ _bodyOerrors :: Errors+ _bodyOexpect :: TYPE+ _lhsOerrors :: Errors+ _lhsOfundecs :: VarEnv+ _lhsOtypecounter :: Int+ _bodyOtypeEnv :: TypeEnv+ _bodyOtypecounter :: Int+ _bodyIerrors :: Errors+ _bodyItp :: TYPE+ _bodyItypecounter :: Int+ __tup13 =+ case lookupPos ident_ _lhsIfundecs of+ Just pos -> (single (DuplicateFun ident_ pos ), _lhsIfundecs)+ Nothing -> (empty, insertIdent ident_ (FunType _atps _ret) _lhsIfundecs)+ (_err1,_) =+ __tup13+ (_,_fundecs) =+ __tup13+ __tup14 =+ let f (TypedVar n t) ~(errs,env,tps)+ = let (e1,tp) = findType _lhsItypeEnv t+ (e2,en) = case lookupPos n env of+ Just p -> (single (DuplicateArg ident_ n p), env)+ Nothing -> (empty, insertIdent n (VarType tp) env)+ in(e1 <> e2 <> errs,en,tp:tps)+ in foldr f (empty,Map.empty,[]) argTps_+ (_err2,_,_) =+ __tup14+ (_,_argEnv,_) =+ __tup14+ (_,_,_atps) =+ __tup14+ __tup15 =+ case retTp_ of+ Just tp -> findType _lhsItypeEnv tp+ Nothing -> (empty,VOID)+ (_err3,_) =+ __tup15+ (_,_ret) =+ __tup15+ _bodyOvarEnv =+ _argEnv `union` _lhsIvarEnv+ _bodyOerrors =+ _lhsIerrors <> _err1 <> _err2 <> _err3+ _bodyOexpect =+ _ret+ _lhsOerrors =+ _bodyIerrors+ _lhsOfundecs =+ _fundecs+ _lhsOtypecounter =+ _bodyItypecounter+ _bodyOtypeEnv =+ _lhsItypeEnv+ _bodyOtypecounter =+ _lhsItypecounter+ ( _bodyIerrors,_bodyItp,_bodyItypecounter) =+ (body_ _bodyOerrors _bodyOexpect _bodyOtypeEnv _bodyOtypecounter _bodyOvarEnv)+ in ( _lhsOerrors,_lhsOfundecs,_lhsOtypecounter)))+-- FunDecs -----------------------------------------------------+-- cata+sem_FunDecs :: FunDecs ->+ T_FunDecs+sem_FunDecs list =+ (Prelude.foldr sem_FunDecs_Cons sem_FunDecs_Nil (Prelude.map sem_FunDec list))+-- semantic domain+type T_FunDecs = Errors ->+ TypeEnv ->+ Int ->+ VarEnv ->+ ( Errors,VarEnv,Int)+sem_FunDecs_Cons :: T_FunDec ->+ T_FunDecs ->+ T_FunDecs+sem_FunDecs_Cons hd_ tl_ =+ (\ _lhsIerrors+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOfundecs :: VarEnv+ _hdOfundecs :: VarEnv+ _lhsOerrors :: Errors+ _lhsOtypecounter :: Int+ _hdOerrors :: Errors+ _hdOtypeEnv :: TypeEnv+ _hdOtypecounter :: Int+ _hdOvarEnv :: VarEnv+ _tlOerrors :: Errors+ _tlOtypeEnv :: TypeEnv+ _tlOtypecounter :: Int+ _tlOvarEnv :: VarEnv+ _hdIerrors :: Errors+ _hdIfundecs :: VarEnv+ _hdItypecounter :: Int+ _tlIerrors :: Errors+ _tlIfundecs :: VarEnv+ _tlItypecounter :: Int+ _lhsOfundecs =+ _hdIfundecs+ _hdOfundecs =+ _tlIfundecs+ _lhsOerrors =+ _tlIerrors+ _lhsOtypecounter =+ _tlItypecounter+ _hdOerrors =+ _lhsIerrors+ _hdOtypeEnv =+ _lhsItypeEnv+ _hdOtypecounter =+ _lhsItypecounter+ _hdOvarEnv =+ _lhsIvarEnv+ _tlOerrors =+ _hdIerrors+ _tlOtypeEnv =+ _lhsItypeEnv+ _tlOtypecounter =+ _hdItypecounter+ _tlOvarEnv =+ _lhsIvarEnv+ ( _hdIerrors,_hdIfundecs,_hdItypecounter) =+ (hd_ _hdOerrors _hdOfundecs _hdOtypeEnv _hdOtypecounter _hdOvarEnv)+ ( _tlIerrors,_tlIfundecs,_tlItypecounter) =+ (tl_ _tlOerrors _tlOtypeEnv _tlOtypecounter _tlOvarEnv)+ in ( _lhsOerrors,_lhsOfundecs,_lhsOtypecounter)))+sem_FunDecs_Nil :: T_FunDecs+sem_FunDecs_Nil =+ (\ _lhsIerrors+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOfundecs :: VarEnv+ _lhsOerrors :: Errors+ _lhsOtypecounter :: Int+ _lhsOfundecs =+ Map.empty+ _lhsOerrors =+ _lhsIerrors+ _lhsOtypecounter =+ _lhsItypecounter+ in ( _lhsOerrors,_lhsOfundecs,_lhsOtypecounter)))+-- LValue ------------------------------------------------------+-- cata+sem_LValue :: LValue ->+ T_LValue+sem_LValue (Dot _pos _expr _ident) =+ (sem_LValue_Dot _pos (sem_LValue _expr) _ident)+sem_LValue (Ident _ident) =+ (sem_LValue_Ident _ident)+sem_LValue (Sub _pos _expr _index) =+ (sem_LValue_Sub _pos (sem_LValue _expr) (sem_Expr _index))+-- semantic domain+type T_LValue = Errors ->+ TYPE ->+ TypeEnv ->+ Int ->+ VarEnv ->+ ( Errors,TYPE,Int)+sem_LValue_Dot :: Pos ->+ T_LValue ->+ VarIdent ->+ T_LValue+sem_LValue_Dot pos_ expr_ ident_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _exprOexpect :: TYPE+ _exprOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _exprOtypeEnv :: TypeEnv+ _exprOtypecounter :: Int+ _exprOvarEnv :: VarEnv+ _exprIerrors :: Errors+ _exprItp :: TYPE+ _exprItypecounter :: Int+ __tup16 =+ recordType pos_ _exprItp+ (_err1,_) =+ __tup16+ (_,_fieldEnv) =+ __tup16+ __tup17 =+ recordFieldType pos_ _fieldEnv ident_+ (_err2,_) =+ __tup17+ (_,_tp) =+ __tup17+ _exprOexpect =+ case _tp of ERROR -> ERROR ; _ -> _exprItp+ _exprOerrors =+ _lhsIerrors <>+ _err1 <>+ _err2 <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOerrors =+ _exprIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _exprItypecounter+ _exprOtypeEnv =+ _lhsItypeEnv+ _exprOtypecounter =+ _lhsItypecounter+ _exprOvarEnv =+ _lhsIvarEnv+ ( _exprIerrors,_exprItp,_exprItypecounter) =+ (expr_ _exprOerrors _exprOexpect _exprOtypeEnv _exprOtypecounter _exprOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_LValue_Ident :: VarIdent ->+ T_LValue+sem_LValue_Ident ident_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ __tup18 =+ findVar _lhsIvarEnv ident_+ (_errs,_) =+ __tup18+ (_,_tp) =+ __tup18+ _lhsOerrors =+ _lhsIerrors <>+ _errs <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _lhsItypecounter+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+sem_LValue_Sub :: Pos ->+ T_LValue ->+ T_Expr ->+ T_LValue+sem_LValue_Sub pos_ expr_ index_ =+ (\ _lhsIerrors+ _lhsIexpect+ _lhsItypeEnv+ _lhsItypecounter+ _lhsIvarEnv ->+ (let _indexOexpect :: TYPE+ _exprOexpect :: TYPE+ _exprOerrors :: Errors+ _lhsOerrors :: Errors+ _lhsOtp :: TYPE+ _lhsOtypecounter :: Int+ _exprOtypeEnv :: TypeEnv+ _exprOtypecounter :: Int+ _exprOvarEnv :: VarEnv+ _indexOerrors :: Errors+ _indexOtypeEnv :: TypeEnv+ _indexOtypecounter :: Int+ _indexOvarEnv :: VarEnv+ _exprIerrors :: Errors+ _exprItp :: TYPE+ _exprItypecounter :: Int+ _indexIerrors :: Errors+ _indexItp :: TYPE+ _indexItypecounter :: Int+ __tup19 =+ arrayComponentType pos_ _exprItp+ (_err,_) =+ __tup19+ (_,_tp) =+ __tup19+ _indexOexpect =+ INT+ _exprOexpect =+ case _tp of ERROR -> ERROR ; _ -> _exprItp+ _exprOerrors =+ _lhsIerrors <>+ _err <>+ if match _lhsIexpect _tp+ then empty+ else single (TypeMisMatch _lhsIexpect _tp)+ _lhsOerrors =+ _indexIerrors+ _lhsOtp =+ _tp+ _lhsOtypecounter =+ _indexItypecounter+ _exprOtypeEnv =+ _lhsItypeEnv+ _exprOtypecounter =+ _lhsItypecounter+ _exprOvarEnv =+ _lhsIvarEnv+ _indexOerrors =+ _exprIerrors+ _indexOtypeEnv =+ _lhsItypeEnv+ _indexOtypecounter =+ _exprItypecounter+ _indexOvarEnv =+ _lhsIvarEnv+ ( _exprIerrors,_exprItp,_exprItypecounter) =+ (expr_ _exprOerrors _exprOexpect _exprOtypeEnv _exprOtypecounter _exprOvarEnv)+ ( _indexIerrors,_indexItp,_indexItypecounter) =+ (index_ _indexOerrors _indexOexpect _indexOtypeEnv _indexOtypecounter _indexOvarEnv)+ in ( _lhsOerrors,_lhsOtp,_lhsOtypecounter)))+-- Program -----------------------------------------------------+-- cata+sem_Program :: Program ->+ T_Program+sem_Program (Program _expr) =+ (sem_Program_Program (sem_Expr _expr))+-- semantic domain+type T_Program = ( ([Error]))+sem_Program_Program :: T_Expr ->+ T_Program+sem_Program_Program expr_ =+ (let _lhsOerrors :: ([Error])+ _exprOerrors :: Errors+ _exprOvarEnv :: VarEnv+ _exprOtypeEnv :: TypeEnv+ _exprOtypecounter :: Int+ _exprOexpect :: TYPE+ _exprIerrors :: Errors+ _exprItp :: TYPE+ _exprItypecounter :: Int+ _lhsOerrors =+ toList _exprIerrors+ _exprOerrors =+ empty+ _exprOvarEnv =+ initVarEnv+ _exprOtypeEnv =+ initTypeEnv+ _exprOtypecounter =+ 10+ _exprOexpect =+ _exprItp+ ( _exprIerrors,_exprItp,_exprItypecounter) =+ (expr_ _exprOerrors _exprOexpect _exprOtypeEnv _exprOtypecounter _exprOvarEnv)+ in ( _lhsOerrors))+-- TypeDec -----------------------------------------------------+-- cata+sem_TypeDec :: TypeDec ->+ T_TypeDec+sem_TypeDec (TypeDec _pos _ident _tp) =+ (sem_TypeDec_TypeDec _pos _ident _tp)+-- semantic domain+type T_TypeDec = Errors ->+ TypeEnv ->+ Int ->+ ((TypeEnv, TypeSyns)) ->+ ( Errors,Int,((TypeEnv, TypeSyns)))+sem_TypeDec_TypeDec :: Pos ->+ TypeIdent ->+ Type ->+ T_TypeDec+sem_TypeDec_TypeDec pos_ ident_ tp_ =+ (\ _lhsIerrors+ _lhsItypeEnv+ _lhsItypecounter+ _lhsItypedecs ->+ (let _lhsOtypecounter :: Int+ _lhsOerrors :: Errors+ _lhsOtypedecs :: ((TypeEnv, TypeSyns))+ __tup20 =+ let (env,syns) = _lhsItypedecs+ in case lookupPos ident_ env `mplus` lookupPos ident_ syns of+ Just pos -> (single (DuplicateType ident_ pos ), _lhsItypedecs)+ Nothing -> case tp_ of+ Var nm -> (empty, (env, insertIdent ident_ nm syns) )+ Array t -> let (err,t') = findType _lhsItypeEnv t+ tp = ARRAY ident_ _lhsItypecounter t'+ in (err, (insertIdent ident_ tp env, syns))+ Record fs -> let (err,fs') = recordFields _lhsItypeEnv fs+ tp = RECORD ident_ _lhsItypecounter fs'+ in (err, (insertIdent ident_ tp env, syns))+ (_errs,_) =+ __tup20+ (_,_typedecs) =+ __tup20+ _lhsOtypecounter =+ _lhsItypecounter + 1+ _lhsOerrors =+ _lhsIerrors <> _errs+ _lhsOtypedecs =+ _typedecs+ in ( _lhsOerrors,_lhsOtypecounter,_lhsOtypedecs)))+-- TypeDecs ----------------------------------------------------+-- cata+sem_TypeDecs :: TypeDecs ->+ T_TypeDecs+sem_TypeDecs list =+ (Prelude.foldr sem_TypeDecs_Cons sem_TypeDecs_Nil (Prelude.map sem_TypeDec list))+-- semantic domain+type T_TypeDecs = Errors ->+ TypeEnv ->+ Int ->+ ( Errors,Int,((TypeEnv, TypeSyns)))+sem_TypeDecs_Cons :: T_TypeDec ->+ T_TypeDecs ->+ T_TypeDecs+sem_TypeDecs_Cons hd_ tl_ =+ (\ _lhsIerrors+ _lhsItypeEnv+ _lhsItypecounter ->+ (let _lhsOtypedecs :: ((TypeEnv, TypeSyns))+ _hdOtypedecs :: ((TypeEnv, TypeSyns))+ _lhsOerrors :: Errors+ _lhsOtypecounter :: Int+ _hdOerrors :: Errors+ _hdOtypeEnv :: TypeEnv+ _hdOtypecounter :: Int+ _tlOerrors :: Errors+ _tlOtypeEnv :: TypeEnv+ _tlOtypecounter :: Int+ _hdIerrors :: Errors+ _hdItypecounter :: Int+ _hdItypedecs :: ((TypeEnv, TypeSyns))+ _tlIerrors :: Errors+ _tlItypecounter :: Int+ _tlItypedecs :: ((TypeEnv, TypeSyns))+ _lhsOtypedecs =+ _hdItypedecs+ _hdOtypedecs =+ _tlItypedecs+ _lhsOerrors =+ _tlIerrors+ _lhsOtypecounter =+ _tlItypecounter+ _hdOerrors =+ _lhsIerrors+ _hdOtypeEnv =+ _lhsItypeEnv+ _hdOtypecounter =+ _lhsItypecounter+ _tlOerrors =+ _hdIerrors+ _tlOtypeEnv =+ _lhsItypeEnv+ _tlOtypecounter =+ _hdItypecounter+ ( _hdIerrors,_hdItypecounter,_hdItypedecs) =+ (hd_ _hdOerrors _hdOtypeEnv _hdOtypecounter _hdOtypedecs)+ ( _tlIerrors,_tlItypecounter,_tlItypedecs) =+ (tl_ _tlOerrors _tlOtypeEnv _tlOtypecounter)+ in ( _lhsOerrors,_lhsOtypecounter,_lhsOtypedecs)))+sem_TypeDecs_Nil :: T_TypeDecs+sem_TypeDecs_Nil =+ (\ _lhsIerrors+ _lhsItypeEnv+ _lhsItypecounter ->+ (let _lhsOtypedecs :: ((TypeEnv, TypeSyns))+ _lhsOerrors :: Errors+ _lhsOtypecounter :: Int+ _lhsOtypedecs =+ (Map.empty,Map.empty)+ _lhsOerrors =+ _lhsIerrors+ _lhsOtypecounter =+ _lhsItypecounter+ in ( _lhsOerrors,_lhsOtypecounter,_lhsOtypedecs)))
+ dist/build/tiger/tiger-tmp/TigerScanner.hs view
@@ -0,0 +1,411 @@+{-# OPTIONS -fglasgow-exts -cpp #-}+{-# LINE 1 "src/TigerScanner.x" #-}++module TigerScanner(scanFile) where++import UU.Scanner.Token+import UU.Scanner.TokenShow+import UU.Scanner.Position+import qualified UU.DData.Set as Set++#if __GLASGOW_HASKELL__ >= 603+#include "ghcconfig.h"+#elif defined(__GLASGOW_HASKELL__)+#include "config.h"+#endif+#if __GLASGOW_HASKELL__ >= 503+import Data.Array+import Data.Char (ord)+import Data.Array.Base (unsafeAt)+#else+import Array+import Char (ord)+#endif+#if __GLASGOW_HASKELL__ >= 503+import GHC.Exts+#else+import GlaExts+#endif+{-# LINE 1 "templates/wrappers.hs" #-}+{-# LINE 1 "templates/wrappers.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++++++++-- -----------------------------------------------------------------------------+-- The input type+++type AlexInput = (AlexPosn, -- current position,+ Char, -- previous char+ String) -- current input string++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (p,c,s) = c++alexGetChar :: AlexInput -> Maybe (Char,AlexInput)+alexGetChar (p,c,[]) = Nothing+alexGetChar (p,_,(c:s)) = let p' = alexMove p c in p' `seq`+ Just (c, (p', c, s))+++{-# LINE 45 "templates/wrappers.hs" #-}++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text. It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+ deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1)+alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1+alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad++{-# LINE 150 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++{-# LINE 233 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Basic wrapper++{-# LINE 255 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version++{-# LINE 277 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++{-# LINE 294 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version++{-# LINE 309 "templates/wrappers.hs" #-}+++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.+++alexGScan stop state inp = alex_gscan stop alexStartPos '\n' inp (0,state)++alex_gscan stop p c inp (sc,state) =+ case alexScan (p,c,inp) sc of+ AlexEOF -> stop p c inp (sc,state)+ AlexError _ -> stop p c inp (sc,state)+ AlexSkip (p',c',inp') len -> alex_gscan stop p' c' inp' (sc,state)+ AlexToken (p',c',inp') len k ->+ k p c inp len (\scs -> alex_gscan stop p' c' inp' scs)+ (sc,state)+alex_base :: AlexAddr+alex_base = AlexA# "\xf8\xff\xff\xff\xfd\xff\xff\xff\x6d\x00\x00\x00\x00\x00\x00\x00\xe1\xff\xff\xff\x00\x00\x00\x00\xcf\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xd2\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x6e\x00\x00\x00\xcd\x00\x00\x00\x2c\x01\x00\x00\x8b\x01\x00\x00\xea\x01\x00\x00\x49\x02\x00\x00\xa8\x02\x00\x00\x05\x03\x00\x00\x4e\x03\x00\x00\x74\x03\x00\x00\xbf\x03\x00\x00"#++alex_table :: AlexAddr+alex_table = AlexA# "\x00\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x03\x00\x1a\x00\x15\x00\x14\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x1d\x00\x00\x00\x00\x00\x02\x00\x18\x00\x00\x00\x08\x00\x09\x00\x11\x00\x0f\x00\x05\x00\x10\x00\x0e\x00\x04\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x06\x00\x07\x00\x13\x00\x12\x00\x16\x00\x00\x00\x00\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x0c\x00\x19\x00\x0d\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x1e\x00\x1e\x00\x1c\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x24\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1c\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x24\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1c\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x20\x00\x20\x00\x20\x00\x20\x00\x20\x00\x20\x00\x20\x00\x20\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x24\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1c\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x21\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x24\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1c\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x24\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1c\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x24\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x23\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1c\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x24\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x1e\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x1e\x00\x00\x00\x1e\x00\x00\x00\x25\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x00\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x22\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x00\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x00\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++alex_check :: AlexAddr+alex_check = AlexA# "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2a\x00\x3d\x00\x3d\x00\x3e\x00\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\xff\xff\x20\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\x5d\x00\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\x61\x00\x62\x00\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\xff\xff\x76\x00\xff\xff\x78\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++alex_deflt :: AlexAddr+alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++alex_accept = listArray (0::Int,39) [[],[],[(AlexAccSkip)],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[],[],[],[],[],[],[],[],[],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_5))]]+{-# LINE 42 "src/TigerScanner.x" #-}+ +-- semantic actions+-- if a sequence of letters is an identifier, except when it is member of the set of reserved words.+identifier = makeToken keywordOrIdentifier + where keywordOrIdentifier str | Set.member str reservedwords = reserved str + | otherwise = valueToken TkVarid str + ++reservedwords = Set.fromList [ "array", "if", "then", "else", "while", "for", "to", "do", "let", "in", "end", "of", "break", "nil", "function", "var", "type" ]++-- special symbols and operators+symbol = makeToken reserved++-- decimal integers+integer = makeToken (valueToken TkInteger10)++-- string literals+string = makeToken (valueToken TkString)++-- comment-lexer: drops a comment-block enclosed by /* and */ from the input, and resumes lexing. +-- block comments can be nested, hence: /* this /* is some */ text */ +-- is a single comment-block++comment pos _ inp _ _ st@(_,file) = dropcomments (move_pos2 pos) 1 (drop 2 inp)+ where move_pos2 (AlexPn a l c) = AlexPn (a+2) l (c+2)+ dropcomments p 0 ss = continue p ss + dropcomments p n inp = case inp of+ ('*':'/':ss) -> dropcomments (move_pos2 p ) (n-1) ss+ ('/':'*':ss) -> dropcomments (move_pos2 p ) (n+1) ss+ (s :ss) -> dropcomments (alexMove p s) n ss+ [] -> errToken ("unterminated comment") (makePos file pos)+ : continue p [] + continue = tiger_scan file + +makeToken :: (String -> Pos -> Token) + -> AlexPosn + -> a + -> String + -> Int + -> ((Int,FilePath) -> [Token]) + -> (Int,FilePath) -> [Token]+makeToken f p _ inp len cont state@(_,file) = f (take len inp) (makePos file p) : cont state ++makePos :: FilePath -> AlexPosn -> Pos+makePos f (AlexPn _ l c) = Pos l c f ++scanFile :: FilePath -> IO [Token]+scanFile file = do txt <- readFile file+ return (tiger_scan file alexStartPos txt)++tiger_scan :: FilePath -> AlexPosn -> String -> [Token]+tiger_scan file pos input = alex_gscan stop_act pos '\n' input (0,file)++stop_act pos char "" state = []+stop_act pos char (s:ss) state = errToken ("unexpected character: " ++ show s) (makePos (snd state) pos)+ : tiger_scan (snd state) (alexMove pos s) ss++alex_action_1 = comment +alex_action_2 = symbol +alex_action_3 = integer +alex_action_4 = string +alex_action_5 = identifier +{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++{-# LINE 35 "templates/GenericTemplate.hs" #-}++{-# LINE 45 "templates/GenericTemplate.hs" #-}+++data AlexAddr = AlexA# Addr#++#if __GLASGOW_HASKELL__ < 503+uncheckedShiftL# = shiftL#+#endif++{-# INLINE alexIndexInt16OffAddr #-}+alexIndexInt16OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+ narrow16Int# i+ where+ i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+ high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+ low = int2Word# (ord# (indexCharOffAddr# arr off'))+ off' = off *# 2#+#else+ indexInt16OffAddr# arr off+#endif++++++{-# INLINE alexIndexInt32OffAddr #-}+alexIndexInt32OffAddr (AlexA# arr) off = +#ifdef WORDS_BIGENDIAN+ narrow32Int# i+ where+ i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`+ (b2 `uncheckedShiftL#` 16#) `or#`+ (b1 `uncheckedShiftL#` 8#) `or#` b0)+ b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))+ b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))+ b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+ b0 = int2Word# (ord# (indexCharOffAddr# arr off'))+ off' = off *# 4#+#else+ indexInt32OffAddr# arr off+#endif++++++#if __GLASGOW_HASKELL__ < 503+quickIndex arr i = arr ! i+#else+-- GHC >= 503, unsafeAt is available from Data.Array.Base.+quickIndex = unsafeAt+#endif+++++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+ = AlexEOF+ | AlexError !AlexInput+ | AlexSkip !AlexInput !Int+ | AlexToken !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input (I# (sc))+ = alexScanUser undefined input (I# (sc))++alexScanUser user input (I# (sc))+ = case alex_scan_tkn user input 0# input sc AlexNone of+ (AlexNone, input') ->+ case alexGetChar input of+ Nothing -> ++++ AlexEOF+ Just _ ->++++ AlexError input'++ (AlexLastSkip input len, _) ->++++ AlexSkip input len++ (AlexLastAcc k input len, _) ->++++ AlexToken input len k+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user orig_input len input s last_acc =+ input `seq` -- strict in the input+ let + new_acc = check_accs (alex_accept `quickIndex` (I# (s)))+ in+ new_acc `seq`+ case alexGetChar input of+ Nothing -> (new_acc, input)+ Just (c, new_input) -> ++++ let+ base = alexIndexInt32OffAddr alex_base s+ (I# (ord_c)) = ord c+ offset = (base +# ord_c)+ check = alexIndexInt16OffAddr alex_check offset+ + new_s = if (offset >=# 0#) && (check ==# ord_c)+ then alexIndexInt16OffAddr alex_table offset+ else alexIndexInt16OffAddr alex_deflt s+ in+ case new_s of + -1# -> (new_acc, input)+ -- on an error, we want to keep the input *before* the+ -- character that failed, not after.+ _ -> alex_scan_tkn user orig_input (len +# 1#) + new_input new_s new_acc++ where+ check_accs [] = last_acc+ check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))+ check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len))+ check_accs (AlexAccPred a pred : rest)+ | pred user orig_input (I# (len)) input+ = AlexLastAcc a input (I# (len))+ check_accs (AlexAccSkipPred pred : rest)+ | pred user orig_input (I# (len)) input+ = AlexLastSkip input (I# (len))+ check_accs (_ : rest) = check_accs rest++data AlexLastAcc a+ = AlexNone+ | AlexLastAcc a !AlexInput !Int+ | AlexLastSkip !AlexInput !Int++data AlexAcc a user+ = AlexAcc a+ | AlexAccSkip+ | AlexAccPred a (AlexAccPred user)+ | AlexAccSkipPred (AlexAccPred user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user in1 len in2+ = p1 user in1 len in2 && p2 user in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _ +alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ +alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (I# (sc)) user _ _ input = + case alex_scan_tkn user input 0# input sc AlexNone of+ (AlexNone, _) -> False+ _ -> True+ -- TODO: there's no need to find the longest+ -- match when checking the right context, just+ -- the first match will do.++-- used by wrappers+iUnbox (I# (i)) = i
+ src/Tiger.hs view
@@ -0,0 +1,140 @@+module Main where++import Prelude hiding (exp)+import UU.Parsing +import TigerScanner (scanFile)+import UU.Scanner.Token+import UU.Scanner.Position+import UU.Scanner.TokenParser+import TigerSem(sem_Program)+import TigerError(sem_Error)+import TigerAS+import TigerTypes+import System(getArgs)+import UU.Scanner.GenTokenSymbol+import UU.Scanner.GenTokenOrd++pBracksPos p = (,) <$> pOBrackPos <*> p <* pCBrack ++ident :: Parser Token Ident +ident = uncurry Id <$> (pVaridPos <|> pConidPos)++integer :: Parser Token (Integer,Pos)+integer = (\(v,p) -> (read v,p) ) <$> pIntegerPos++string :: Parser Token (String,Pos)+string = pStringPos+{-+Precedence of the operators (high to low): ++* / -- left++ - -- left+>= <= = <> < > -- non+& -- left+| -- left+:= -- right+-}++++main = do args <- getArgs+ case args of+ [fn] -> parseFile fn+ _ -> putStrLn "usage: tiger <file>"++parseFile f = do text <- readFile f+ putStrLn text+ tokens <- scanFile f+ ast <- parseIO program tokens+ --print ast+ mapM (putStrLn.sem_Error) + (sem_Program ast)+ return () +{-+ where keywords = ["array", "if", "then", "else", "while", "for", "to", "do", "let", "in", "end", "of", "break", "nil", "function", "var", "type" ]+ keyops = [".",":", "+", "-", "*", "/", "=", "<>", "<", "<=", ">", ">=", "&", "|", ":=" ]+ symbols = ",;()[]{}"+ opchars = ":+-*/=<>&.|"+-} +program = Program <$> exp+++oper ops = case ops of + [] -> error "empty operator list"+ [x] -> mkOp x+ _ -> foldr1 (<|>) (map mkOp ops) + where mkOp x = Op x <$> pKeyPos x+ +operators = [ (["*", "/" ], LeftAssoc)+ , (["+", "-" ], LeftAssoc) + , ([">=", "<=", "=", "<>", "<", ">"], NonAssoc )+ , (["&" ], LeftAssoc)+ , (["|" ], LeftAssoc)+ ]+ +expression = foldl f atom operators+ where f p (ops,assoc) = case assoc of + LeftAssoc -> pChainl (oper ops) p+ RightAssoc -> pChainr (oper ops) p+ NonAssoc -> p <??> (oper ops <*> p) + +data Assoc = LeftAssoc | RightAssoc | NonAssoc deriving Show++assignField = AssignField <$> ident <* pKey "=" <*> exp++exp = Assign <$> lvalue <*> pKeyPos ":=" <*> exp+ <|> expression+ +atom = Nil <$> pKeyPos "nil"+ <|> uncurry IntLit <$> integer+ <|> uncurry StringLit <$> string+ <|> RecordVal <$> type_ident <*> pCurly (pListSep (pKey ",") assignField)+ <|> LValue <$> lvalue+ <|> Apply <$>ident <*> pParens (pListSep (pKey ",") exp)+ <|> pParens exps + <|> Let <$> pKeyPos "let" <*> decs + <* pKey "in" <*> exps + <* pKey "end"+ <|> ArrayVal <$> type_ident <*> pBracks exp <* pKey "of" <*> exp+ <|> (\p e -> UnOp p "-" e) <$> pKeyPos "-" <*> exp+ <|> Break <$> pKeyPos "break"+ -- Control structures+ <|> If <$> pKeyPos "if" <*> exp + <* pKey "then" <*> exp + <*> ((pKey "else" *> exp) `opt` Skip)+ <|> While <$> pKeyPos "while" <*> exp + <* pKey "do" <*> exp+ <|> For <$> pKeyPos "for" <*> ident <* pKey ":=" <*> exp <* pKey "to" <*> exp + <* pKey "do" <*> exp++lvalue = (\i f -> f (Ident i)) <$> ident <*> subOrFields+ where subOrFields = (\xs x -> foldl (flip ($)) x xs) <$> pList subOrField+ subOrField = (\p f e -> Dot p e f) <$> pKeyPos "." <*> ident+ <|> (\(p,i) e -> Sub p e i) <$> pBracksPos exp++exps = f <$> pListSep (pKey ";") exp+ where f xs = case xs of+ [] -> Skip+ [x] -> x+ _ -> foldr1 Sequence xs ++decs = pList declGroup ++declGroup = FunDecs <$> pList1 funDec+ <|> TypeDecs <$> pList1 typeDec+ <|> varDec++typeDec = TypeDec <$> pKeyPos "type" <*> ident <* pKey "=" <*> ty+varDec = VarDec <$> pKeyPos "var" <*> ident <*> optType <* pKey ":=" <*> exp+funDec = FunDec <$> pKeyPos "function" <*> ident <*> pParens tyfields <*> optType <* pKey "=" <*> exp++optType = (Just <$ pKey ":" <*> type_ident) `opt` Nothing+-- Types+ty = Var <$> type_ident+ <|> Record <$> pCurly tyfields+ <|> Array <$ pKey "array" <* pKey "of" <*> type_ident+ +tyfields = pListSep (pKey ",") tyfield+ where tyfield = TypedVar <$> ident <* pKey ":" <*> type_ident ++type_ident = ident
+ src/TigerScanner.x view
@@ -0,0 +1,99 @@+{+module TigerScanner(scanFile) where++import UU.Scanner.Token+import UU.Scanner.TokenShow+import UU.Scanner.Position+import qualified UU.DData.Set as Set+}+%wrapper "gscan"++$letter = [a-zA-Z] -- alphabetic characters+$digit = 0-9 -- digits+$octal = 0-7 -- octal digits+$hex = [0-9A-Fa-f] -- hexadecimal digits+$ident = [$letter $digit _] -- identifier character++@escape = \\([abfnrtv\^"\\] | $octal{1,3} | x$hex{1,2}) -- character escape+@content = $printable # ["\\] | @escape -- string character++tiger :-+ $white+ ;++ "/*" { comment }+++ "," | ":" | ";" | "(" | ")" |+ "[" | "]" | "{" | "}" | "." | + "+" | "-" | "*" | "/" | "=" | + "<>" | "<" | "<=" | ">" | + ">=" | "&" | "|" | ":=" { symbol }++ $digit+ { integer }++ \" @content* \" { string }++ $letter $ident* { identifier }+ + ++++{ +-- semantic actions+-- if a sequence of letters is an identifier, except when it is member of the set of reserved words.+identifier = makeToken keywordOrIdentifier + where keywordOrIdentifier str | Set.member str reservedwords = reserved str + | otherwise = valueToken TkVarid str + ++reservedwords = Set.fromList [ "array", "if", "then", "else", "while", "for", "to", "do", "let", "in", "end", "of", "break", "nil", "function", "var", "type" ]++-- special symbols and operators+symbol = makeToken reserved++-- decimal integers+integer = makeToken (valueToken TkInteger10)++-- string literals+string = makeToken (valueToken TkString)++-- comment-lexer: drops a comment-block enclosed by /* and */ from the input, and resumes lexing. +-- block comments can be nested, hence: /* this /* is some */ text */ +-- is a single comment-block++comment pos _ inp _ _ st@(_,file) = dropcomments (move_pos2 pos) 1 (drop 2 inp)+ where move_pos2 (AlexPn a l c) = AlexPn (a+2) l (c+2)+ dropcomments p 0 ss = continue p ss + dropcomments p n inp = case inp of+ ('*':'/':ss) -> dropcomments (move_pos2 p ) (n-1) ss+ ('/':'*':ss) -> dropcomments (move_pos2 p ) (n+1) ss+ (s :ss) -> dropcomments (alexMove p s) n ss+ [] -> errToken ("unterminated comment") (makePos file pos)+ : continue p [] + continue = tiger_scan file + +makeToken :: (String -> Pos -> Token) + -> AlexPosn + -> a + -> String + -> Int + -> ((Int,FilePath) -> [Token]) + -> (Int,FilePath) -> [Token]+makeToken f p _ inp len cont state@(_,file) = f (take len inp) (makePos file p) : cont state ++makePos :: FilePath -> AlexPosn -> Pos+makePos f (AlexPn _ l c) = Pos l c f ++scanFile :: FilePath -> IO [Token]+scanFile file = do txt <- readFile file+ return (tiger_scan file alexStartPos txt)++tiger_scan :: FilePath -> AlexPosn -> String -> [Token]+tiger_scan file pos input = alex_gscan stop_act pos '\n' input (0,file)++stop_act pos char "" state = []+stop_act pos char (s:ss) state = errToken ("unexpected character: " ++ show s) (makePos (snd state) pos)+ : tiger_scan (snd state) (alexMove pos s) ss+}+
+ src/TigerTypes.hs view
@@ -0,0 +1,66 @@+module TigerTypes where++import UU.DData.Map(Map)+import UU.Scanner.Position++data Ident = Id {getName :: String, getPos :: Pos} +++instance Eq Ident where+ Id x _ == Id y _ = x == y+ +instance Ord Ident where+ compare (Id x _) (Id y _) = compare x y+ +instance Show Ident where+ show (Id x p) = show x ++ " at " ++ show p++type VarIdent = Ident++type TypeIdent = Ident++data Type+ = Var TypeIdent+ | Array TypeIdent+ | Record [TypedVar] deriving Show++data TypedVar = TypedVar VarIdent TypeIdent deriving Show++-- note that TYPE structure is cyclic for recursive record and array types+-- only shallow structural matching possible+data TYPE = INT -- primitive int type+ | STRING -- primitive string type+ | VOID -- no value+ | NIL -- empty record type+ | LOOPCOUNTER -- type of for loop counter, cannot be used as lhs of assignment+ | ARRAY TypeIdent -- original name of array type+ TypeRef -- internal name of array type + TYPE -- component type+ | RECORD TypeIdent -- original name of record type+ TypeRef -- internal name of record type + (Map VarIdent (Pos,TYPE)) -- field types+ | ERROR -- error type, matches all types ++instance Show TYPE where+ show x = case x of+ INT -> "int" + STRING -> "string" + VOID -> "no value" + NIL -> "empty record" + LOOPCOUNTER -> "int:loopcounter" + ARRAY nm _ c -> show nm + RECORD nm _ fs -> show nm + ERROR -> "erroneus type" ++instance Eq TYPE where+ ERROR == ERROR = True+ INT == INT = True+ LOOPCOUNTER == LOOPCOUNTER = True+ STRING == STRING = True+ VOID == VOID = True+ NIL == NIL = True+ ARRAY _ t1 _ == ARRAY _ t2 _ = t1 == t2 + RECORD _ t1 _ == RECORD _ t2 _ = t1 == t2 + _ == _ = False++type TypeRef = Int
+ tiger.cabal view
@@ -0,0 +1,22 @@+cabal-version: >=1.2+build-type: Simple+name: tiger+version: 1.0+license: GPL+license-file: LICENSE+maintainer: Doaitse Swierstra+homepage: http://www.cs.uu.nl/wiki/HUT/WebHome+description: Tiger compiler+synopsis: Tiger Compiler of Universiteit Utrecht+category: Compiler+stability: Experimental+copyright: Universiteit Utrecht+extra-source-files: INSTALL, LICENSE++executable tiger+ build-depends: base >= 3+ build-depends: haskell98, array+ build-depends: uulib+ main-is: Tiger.hs+ hs-source-dirs: src, derived+ other-modules: TigerAS, TigerSem, TigerError, TigerScanner, TigerTypes