Fix norm

X-R-G-B · Jan 7, 2024 · 55cb491 · 55cb491
1 parent 9cc4bc6
commit 55cb491
Showing 1 changed file with 68 additions and 38 deletions.
diff --git a/lvtc/src/WatLike.hs b/lvtc/src/WatLike.hs
@@ -51,36 +51,46 @@ newIndex = newIndex' 0
 
 modifyAllValue :: [Value] -> [Index] -> [Index] -> ([Value], [Index], [Index])
 modifyAllValue [] varsIndex funcsIndex = ([], varsIndex, funcsIndex)
-modifyAllValue (x:xs) varsIndex funcsIndex = (val:vals, varsIndex'', funcsIndex'')
+modifyAllValue (x:xs) varsIndex funcsIndex =
+    (val:vals, varsIndex'', funcsIndex'')
     where
         (val, varsIndex', funcsIndex') = modifyAll' x varsIndex funcsIndex
-        (vals, varsIndex'', funcsIndex'') = modifyAllValue xs varsIndex' funcsIndex'
+        (vals, varsIndex'', funcsIndex'') =
+            modifyAllValue xs varsIndex' funcsIndex'
 
 modifyAll' :: Value -> [Index] -> [Index] -> (Value, [Index], [Index])
-modifyAll' (FuncValue (fName, vals)) varsIndex funcsIndex = (newFunc, varsIndex'', funcsIndex'')
+modifyAll' (FuncValue (fName, vals)) varsIndex funcsIndex =
+    (newFunc, varsIndex'', funcsIndex'')
     where
         (funcsIndex', indFunc) = getRegisterIndex fName funcsIndex
-        (vals', varsIndex'', funcsIndex'') = modifyAllValue vals varsIndex funcsIndex'
+        (vals', varsIndex'', funcsIndex'') =
+            modifyAllValue vals varsIndex funcsIndex'
         newFunc = FuncValue (show indFunc, vals')
 modifyAll' (Var vName) varsIndex funcsIndex = (newVar, varsIndex', funcsIndex)
     where
         (varsIndex', indVar) = getRegisterIndex vName varsIndex
         newVar = Var (show indVar)
 modifyAll' x varsIndex funcsIndex = (x, varsIndex, funcsIndex)
 
-modifyAll :: [Instruction] -> [Index] -> [Index] -> ([Instruction], [Index], [Index])
+---
+
+modifyAll :: [Instruction] -> [Index] -> [Index]
+            -> ([Instruction], [Index], [Index])
 modifyAll [] varsIndex funcsIndex = ([], varsIndex, funcsIndex)
 modifyAll ((Function (fName, vals)):xs) varsIndex funcsIndex =
     (newFunc:ins', varsIndex''', funcsIndex''')
     where
         (funcsIndex', indFunc) = getRegisterIndex fName funcsIndex
-        (vals', varsIndex'', funcsIndex'') = modifyAllValue vals varsIndex funcsIndex'
+        (vals', varsIndex'', funcsIndex'') =
+            modifyAllValue vals varsIndex funcsIndex'
         newFunc = Function (show indFunc, vals')
-        (ins', varsIndex''', funcsIndex''') = modifyAll xs varsIndex'' funcsIndex''
+        (ins', varsIndex''', funcsIndex''') =
+            modifyAll xs varsIndex'' funcsIndex''
 modifyAll ((Return vValue):xs) varsIndex funcsIndex =
     (newReturn:ins', varsIndex'', funcsIndex'')
     where
-        (vValue', varsIndex', funcsIndex') =modifyAll' vValue varsIndex funcsIndex
+        (vValue', varsIndex', funcsIndex') =
+            modifyAll' vValue varsIndex funcsIndex
         newReturn = Return vValue'
         (ins', varsIndex'', funcsIndex'') = modifyAll xs varsIndex' funcsIndex'
 modifyAll ((Declaration ((vName, vTyp), vValue)):xs) varsIndex funcsIndex =
@@ -93,17 +103,19 @@ modifyAll ((Assignation (vName, vValue)):xs) varsIndex funcsIndex =
     (newAssignation:ins', varsIndex''', funcsIndex''')
     where
         (varsIndex', ind) = getRegisterIndex vName varsIndex
-        (vValue', varsIndex'', funcsIndex'') = modifyAll' vValue varsIndex' funcsIndex
+        (vValue', varsIndex'', funcsIndex'') =
+            modifyAll' vValue varsIndex' funcsIndex
         newAssignation = Assignation (show ind, vValue')
-        (ins', varsIndex''', funcsIndex''') = modifyAll xs varsIndex'' funcsIndex''
-modifyAll ((Cond (vValue, insIf, insElse)):xs) varsIndex funcsIndex =
-    (newCond:ins', varsIndex'''', funcsIndex'''')
+        (ins', varsIndex''', funcsIndex''') =
+            modifyAll xs varsIndex'' funcsIndex''
+modifyAll ((Cond (vValue, insIf, insElse)):xs) vsInd fsInd =
+    (newCond:ins', vsInd'''', fsInd'''')
     where
-        (vValue', varsIndex', funcsIndex') = modifyAll' vValue varsIndex funcsIndex
-        (insIf', varsIndex'', funcsIndex'') = modifyAll insIf varsIndex' funcsIndex'
-        (insElse', varsIndex''', funcsIndex''') = modifyAll insElse varsIndex'' funcsIndex''
+        (vValue', vsInd', fsInd') = modifyAll' vValue vsInd fsInd
+        (insIf', vsInd'', fsInd'') = modifyAll insIf vsInd' fsInd'
+        (insElse', vsInd''', fsInd''') = modifyAll insElse vsInd'' fsInd''
         newCond = Cond (vValue', insIf', insElse')
-        (ins', varsIndex'''', funcsIndex'''') = modifyAll xs varsIndex''' funcsIndex'''
+        (ins', vsInd'''', fsInd'''') = modifyAll xs vsInd''' fsInd'''
 
 transformType :: Type -> Type
 transformType "Void" = "Int"
@@ -115,10 +127,12 @@ registerParams :: FuncDeclare -> FuncDeclare
 registerParams (((fName, [], typ), ins), varsIndex) =
     (((fName, [], transformType typ), ins), varsIndex)
 registerParams (((fName, (pName, pTyp):vParams, typ), ins), varsIndex) =
-    (((fName', (show indVar, transformType pTyp):vParams', vTyp'), ins), varsIndex'')
+    (((fName', newParams:vParams', vTyp'), ins), varsIndex'')
     where
         (varsIndex', indVar) = getRegisterIndex pName varsIndex
-        (((fName', vParams', vTyp'), _), varsIndex'') = registerParams (((fName, vParams, typ), ins), varsIndex')
+        (((fName', vParams', vTyp'), _), varsIndex'') =
+            registerParams (((fName, vParams, typ), ins), varsIndex')
+        newParams = (show indVar, transformType pTyp)
 
 registerAllFuncs :: [FuncDeclaration] -> [Index] -> [Index]
 registerAllFuncs [] funcsIndex = funcsIndex
@@ -133,8 +147,10 @@ changeIndexes (((fName, vars, typ), ins):xs) funcsIndex =
     (newFunc:funcs, funcsIndex''')
     where
         (funcsIndex', indFunc) = getRegisterIndex fName funcsIndex
-        (((_, vars', typ'), ins'), varsIndex) = registerParams (((fName, vars, typ), ins), [])
-        (ins'', varsIndex'', funcsIndex'') = modifyAll ins' varsIndex funcsIndex'
+        (((_, vars', typ'), ins'), varsIndex) =
+            registerParams (((fName, vars, typ), ins), [])
+        (ins'', varsIndex'', funcsIndex'') =
+            modifyAll ins' varsIndex funcsIndex'
         newFunc = (((show indFunc, vars', typ'), ins''), varsIndex'')
         (funcs, funcsIndex''') = changeIndexes xs funcsIndex''
 
@@ -146,7 +162,8 @@ instance Eq WatLikeState where
     (==) (WLS x y z) (WLS x' y' z') = x == x' && y == y' && z == z'
 
 instance Show WatLikeState where
-    show (WLS x y z) = "WLS[[ " ++ show x ++ " ][ " ++ show y ++ " ][ " ++ show z ++ " ]]"
+    show (WLS x y z) =
+        "WLS[[ " ++ show x ++ " ][ " ++ show y ++ " ][ " ++ show z ++ " ]]"
 
 ------------------------------------------------------------------------------
 
@@ -158,22 +175,27 @@ getPrototype fName ((((fName', vars, typ), _), _):xs)
 
 ------------------------------------------------------------------------------
 
-funcCallToWatLike :: FuncCall -> ([FuncDeclare], [Index]) -> [Index] -> ([Index], [Instruction], FuncCall)
+funcCallToWatLike :: FuncCall -> ([FuncDeclare], [Index]) -> [Index]
+                    -> ([Index], [Instruction], FuncCall)
 funcCallToWatLike (fName, []) _ varsIndex = (varsIndex, [], (fName, []))
 funcCallToWatLike (fName, vVal:vVals) oldFuncs varsIndex =
     (varsIndex'', ins ++ inss, (fName, vVal':vVals'))
     where
         (varsIndex', ins, vVal') = valueToWatLike vVal oldFuncs varsIndex
-        (varsIndex'', inss, (_, vVals')) = funcCallToWatLike (fName, vVals) oldFuncs varsIndex'
+        (varsIndex'', inss, (_, vVals')) =
+            funcCallToWatLike (fName, vVals) oldFuncs varsIndex'
 
-valueToWatLike :: Value -> ([FuncDeclare], [Index]) -> [Index] -> ([Index], [Instruction], Value)
+valueToWatLike :: Value -> ([FuncDeclare], [Index]) -> [Index]
+                -> ([Index], [Instruction], Value)
 valueToWatLike (FuncValue x) (oldFuncs, funcsIndex) varsIndex =
     (varsIndex'', ins ++ [newDeclaration], Var (show indVar))
     where
-        (varsIndex', ins, (fName, vVals)) = funcCallToWatLike x (oldFuncs, funcsIndex) varsIndex
+        (varsIndex', ins, (fName, vVals)) =
+            funcCallToWatLike x (oldFuncs, funcsIndex) varsIndex
         (varsIndex'', indVar) = newIndex varsIndex'
         (_, _, typ) = getPrototype fName oldFuncs
-        newDeclaration = Declaration ((show indVar, typ), FuncValue (fName, vVals))
+        newDeclaration =
+            Declaration ((show indVar, typ), FuncValue (fName, vVals))
 valueToWatLike (Boolean True) _ varsIndex =
     (varsIndex', [newDeclaration], Var (show indVar))
     where
@@ -188,7 +210,8 @@ valueToWatLike (Character x) _ varsIndex =
     (varsIndex', [newDeclaration], Var (show indVar))
     where
         (varsIndex', indVar) = newIndex varsIndex
-        newDeclaration = Declaration ((show indVar, "Int"), Integer (read (show (ord x)) :: Int32))
+        ordChar = read (show (ord x)) :: Int32
+        newDeclaration = Declaration ((show indVar, "Int"), Integer ordChar)
 valueToWatLike (StringView _) _ _ = undefined
 valueToWatLike Void _ varsIndex =
     (varsIndex', [newDeclaration], Var (show indVar))
@@ -202,7 +225,8 @@ valueToWatLike (Integer x) _ varsIndex =
         newDeclaration = Declaration ((show indVar, "Int"), Integer x)
 valueToWatLike (Var x) _ varsIndex = (varsIndex, [], Var x)
 
-instructionToWatLike :: Instruction -> ([FuncDeclare], [Index]) -> [Index] -> ([Index], [Instruction])
+instructionToWatLike :: Instruction -> ([FuncDeclare], [Index]) -> [Index]
+                    -> ([Index], [Instruction])
 instructionToWatLike
     (Declaration ((vName, vTyp), vValue)) oldFuncs varsIndex =
     (varsIndex', ins' ++ [newDeclaration])
@@ -219,7 +243,8 @@ instructionToWatLike
     (Function (fName, fParams)) oldFuncs varsIndex =
     (varsIndex', ins' ++ [newFunction])
     where
-        (varsIndex', ins', (_, fParams')) = funcCallToWatLike (fName, fParams) oldFuncs varsIndex
+        (varsIndex', ins', (_, fParams')) =
+            funcCallToWatLike (fName, fParams) oldFuncs varsIndex
         newFunction = Function (fName, fParams')
 instructionToWatLike
     (Return vValue) oldFuncs varsIndex =
@@ -228,15 +253,17 @@ instructionToWatLike
         (varsIndex', ins', vValue') = valueToWatLike vValue oldFuncs varsIndex
         newReturn = Return vValue'
 instructionToWatLike
-    (Cond (vValCond, vInsTrue, vInsFalse)) oldFuncs varsIndex =
-    (varsIndex''', insCond ++ [newCond])
+    (Cond (vValCond, vInsTrue, vInsFalse)) oldFuncs vsInd =
+    (vsInd''', insCond ++ [newCond])
     where
-        (varsIndex', insCond, vValCond') = valueToWatLike vValCond oldFuncs varsIndex
-        (varsIndex'', vInsTrue') = instructionsToWatLike vInsTrue oldFuncs varsIndex'
-        (varsIndex''', vInsFalse') = instructionsToWatLike vInsFalse oldFuncs varsIndex''
+        (vsInd', insCond, vValCond') = valueToWatLike vValCond oldFuncs vsInd
+        (vsInd'', vInsTrue') = instructionsToWatLike vInsTrue oldFuncs vsInd'
+        (vsInd''', vInsFalse') =
+            instructionsToWatLike vInsFalse oldFuncs vsInd''
         newCond = Cond (vValCond', vInsTrue', vInsFalse')
 
-instructionsToWatLike :: [Instruction] -> ([FuncDeclare], [Index]) -> [Index] -> ([Index], [Instruction])
+instructionsToWatLike :: [Instruction] -> ([FuncDeclare], [Index])
+                    -> [Index] -> ([Index], [Instruction])
 instructionsToWatLike [] _ varsIndex = (varsIndex, [])
 instructionsToWatLike (x:xs) oldFuncs varsIndex =
     (varsIndex'', ins ++ inss)
@@ -247,12 +274,14 @@ instructionsToWatLike (x:xs) oldFuncs varsIndex =
 ------------------------------------------------------------------------------
 
 funcToWatLike' :: FuncDeclare -> ([FuncDeclare], [Index]) -> FuncDeclare
-funcToWatLike' (((fName, fParams, fRet), []), varsIndex) _ = (((fName, fParams, fRet), []), varsIndex)
+funcToWatLike' (((fName, fParams, fRet), []), varsIndex) _ =
+    (((fName, fParams, fRet), []), varsIndex)
 funcToWatLike'  (((fName, fParams, fRet), ins:inss), varsIndex) oldFuncs =
     (((fName, fParams, fRet), ins' ++ inss'), varsIndex'')
     where
         (varsIndex', ins') = instructionToWatLike ins oldFuncs varsIndex
-        (((_, _, _), inss'), varsIndex'') = funcToWatLike' (((fName, fParams, fRet), inss), varsIndex') oldFuncs
+        thisFunc = (((fName, fParams, fRet), inss), varsIndex')
+        (((_, _, _), inss'), varsIndex'') = funcToWatLike' thisFunc oldFuncs
 
 funcToWatLike :: FuncDeclare -> WatLikeState -> WatLikeState
 funcToWatLike   (((fName, fParams, fRet), fInss), varsIndex)
@@ -266,7 +295,8 @@ funcToWatLike   (((fName, fParams, fRet), fInss), varsIndex)
 ------------------------------------------------------------------------------
 
 aSTToWatLike' :: [FuncDeclare] -> WatLikeState -> WatLikeState
-aSTToWatLike' [] (WLS funcsIndex oldFunc newFunc) = WLS funcsIndex oldFunc newFunc
+aSTToWatLike' [] (WLS funcsIndex oldFunc newFunc) =
+    WLS funcsIndex oldFunc newFunc
 aSTToWatLike'   (func:xs)
                 (WLS funcsIndex oldFunc newFunc) =
     aSTToWatLike' xs (WLS funcsIndex' oldFunc newFunc')