Added GLSL parser

src/Elm/AST/Canonical.elm

@@ -85,6 +85,7 @@ type Expr
     | Tuple3 LocatedExpr LocatedExpr LocatedExpr
     | Record (Dict VarName (Binding LocatedExpr))
     | Case LocatedExpr (List { pattern : LocatedPattern, body : LocatedExpr })
+    | Shader String
 
 
 type alias LocatedPattern =
@@ -212,6 +213,9 @@ unwrap expr =
                     )
                     branches
 
+        Shader shader ->
+            Unwrapped.Shader shader
+
 
 {-| Discard the [location metadata](Elm.Data.Located#Located).
 -}
@@ -371,6 +375,9 @@ fromUnwrapped expr =
                         )
                         branches
 
+            Unwrapped.Shader shader ->
+                Shader shader
+
 
 {-| Adds [**dummy** locations](Elm.Data.Located#dummyRegion) to the [Unwrapped.Pattern](Elm.AST.Canonical.Unwrapped#Pattern).
 -}

src/Elm/AST/Canonical/Unwrapped.elm

@@ -42,6 +42,7 @@ type Expr
     | Tuple3 Expr Expr Expr
     | Record (Dict VarName (Binding Expr))
     | Case Expr (List { pattern : Pattern, body : Expr })
+    | Shader String
 
 
 type Pattern

src/Elm/AST/Frontend.elm

@@ -15,6 +15,7 @@ still there.
 
 import Dict exposing (Dict)
 import Elm.AST.Frontend.Unwrapped as Unwrapped
+import Elm.AST.Shader as Shader
 import Elm.Data.Binding as Binding exposing (Binding)
 import Elm.Data.Located as Located exposing (Located)
 import Elm.Data.Module exposing (Module)
@@ -73,6 +74,12 @@ type Expr
     | Tuple3 LocatedExpr LocatedExpr LocatedExpr
     | Record (List (Binding LocatedExpr))
     | Case LocatedExpr (List { pattern : LocatedPattern, body : LocatedExpr })
+    | Shader
+        String
+        { attribute : Dict VarName Shader.Type
+        , uniform : Dict VarName Shader.Type
+        , varying : Dict VarName Shader.Type
+        }
 
 
 type alias LocatedPattern =
@@ -191,6 +198,9 @@ recurse f expr =
                     )
                     branches
 
+        Shader _ _ ->
+            expr
+
 
 {-| [Transform](/packages/Janiczek/transform/latest/Transform#transformAll)
 the expression using the provided function.
@@ -311,6 +321,9 @@ unwrap expr =
                     )
                     branches
 
+        Shader value types ->
+            Unwrapped.Shader value types
+
 
 {-| Discard the [location metadata](Elm.Data.Located#Located).
 -}

src/Elm/AST/Frontend/Unwrapped.elm

@@ -13,6 +13,8 @@ Convert to it using the [`Elm.AST.Frontend.unwrap`](Elm.AST.Frontend#unwrap).
 
 -}
 
+import Dict exposing (Dict)
+import Elm.AST.Shader as Shader
 import Elm.Data.Binding exposing (Binding)
 import Elm.Data.Qualifiedness exposing (PossiblyQualified)
 import Elm.Data.VarName exposing (VarName)
@@ -41,6 +43,12 @@ type Expr
     | Tuple3 Expr Expr Expr
     | Record (List (Binding Expr))
     | Case Expr (List { pattern : Pattern, body : Expr })
+    | Shader
+        String
+        { attribute : Dict VarName Shader.Type
+        , uniform : Dict VarName Shader.Type
+        , varying : Dict VarName Shader.Type
+        }
 
 
 type Pattern

src/Elm/AST/Shader.elm

@@ -0,0 +1,11 @@
+module Elm.AST.Shader exposing (Type(..))
+
+
+type Type
+    = Int
+    | Float
+    | V2
+    | V3
+    | V4
+    | M4
+    | Texture

src/Elm/AST/Typed.elm

@@ -84,6 +84,7 @@ type Expr_
     | Tuple3 LocatedExpr LocatedExpr LocatedExpr
     | Record (Dict VarName (Binding LocatedExpr))
     | Case LocatedExpr (List { pattern : LocatedPattern, body : LocatedExpr })
+    | Shader String
 
 
 type alias LocatedPattern =
@@ -214,6 +215,9 @@ recurse fn locatedExpr =
                                     }
                                 )
                                 branches
+
+                    Shader _ ->
+                        expr
             )
 
 
@@ -308,6 +312,9 @@ recursiveChildren fn locatedExpr =
         Case e branches ->
             fn e ++ List.fastConcatMap (.body >> fn) branches
 
+        Shader _ ->
+            []
+
 
 mapExpr : (Expr_ -> Expr_) -> LocatedExpr -> LocatedExpr
 mapExpr fn locatedExpr =
@@ -451,6 +458,9 @@ unwrap expr =
                         }
                     )
                     branches
+
+        Shader shader ->
+            Unwrapped.Shader shader
     , type_
     )
 
@@ -610,6 +620,9 @@ dropTypes locatedExpr =
                                     }
                                 )
                                 branches
+
+                    Shader shader ->
+                        Canonical.Shader shader
             )
 
 

src/Elm/AST/Typed/Unwrapped.elm

@@ -49,6 +49,7 @@ type Expr_
     | Tuple3 Expr Expr Expr
     | Record (Dict VarName (Binding Expr))
     | Case Expr (List { pattern : Pattern, body : Expr })
+    | Shader String
 
 
 type alias Pattern =

src/Elm/Compiler/Error.elm

@@ -181,6 +181,7 @@ type ParseProblem
     | ExpectingScientificNotationPlus
     | ExpectingScientificNotationMinus
     | IntZeroCannotHaveScientificNotation
+    | ShaderProblem
 
 
 type ParseCompilerBug
@@ -640,6 +641,9 @@ parseProblemToString problem =
         IntZeroCannotHaveScientificNotation ->
             "IntZeroCannotHaveScientificNotation"
 
+        ShaderProblem ->
+            "ShaderProblem"
+
 
 parseCompilerBugToString : ParseCompilerBug -> String
 parseCompilerBugToString bug =

src/Elm/Data/Type.elm

@@ -19,6 +19,7 @@ The main confusion point here is "what is the
 -}
 
 import Dict exposing (Dict)
+import Elm.AST.Shader as Shader
 import Elm.Data.VarName exposing (VarName)
 import OurExtras.Dict as Dict
 import OurExtras.List as List
@@ -129,6 +130,11 @@ type Type a
         , name : String
         , args : List (TypeOrId a)
         }
+    | Shader
+        { attribute : Dict VarName Shader.Type
+        , uniform : Dict VarName Shader.Type
+        , varying : Dict VarName Shader.Type
+        }
 
 
 {-| Unwrap the string inside the type variable
@@ -228,6 +234,9 @@ isParametric typeOrId =
                 UserDefinedType { args } ->
                     List.any f args
 
+                Shader _ ->
+                    False
+
 
 varNames : Type a -> List String
 varNames type_ =
@@ -297,6 +306,9 @@ recursiveChildren fn type_ =
         UserDefinedType { args } ->
             List.fastConcatMap fn_ args
 
+        Shader _ ->
+            []
+
 
 {-| Find all the children of this expression (and their children, etc...)
 -}
@@ -345,6 +357,9 @@ recursiveChildren_ fn typeOrId =
         Type (UserDefinedType { args }) ->
             List.fastConcatMap fn args
 
+        Type (Shader _) ->
+            []
+
 
 mapTypeOrId : (a -> b) -> TypeOrId a -> TypeOrId b
 mapTypeOrId fn typeOrId =
@@ -414,6 +429,9 @@ mapType fn type_ =
                 , args = List.map f r.args
                 }
 
+        Shader shaderInfo ->
+            Shader shaderInfo
+
 
 combineType : Type (Result err a) -> Result err (Type a)
 combineType type_ =
@@ -490,6 +508,9 @@ combineType type_ =
                     |> Result.Extra.combine
                 )
 
+        Shader shaderInfo ->
+            Ok (Shader shaderInfo)
+
 
 combineTypeOrId : TypeOrId (Result err a) -> Result err (TypeOrId a)
 combineTypeOrId typeOrId =

src/Elm/Data/Type/ToString.elm

@@ -331,6 +331,9 @@ toStringType_ qualifiednessToString state type_ =
             else
                 ( "{ " ++ bindingsStr ++ " }", state1 )
 
+        Shader _ ->
+            ( "Shader", state )
+
 
 getName : State -> Int -> ( String, State )
 getName ((State { counter, mapping, used }) as state) varId =
@@ -497,3 +500,6 @@ shouldWrapParens typeOrId =
 
                 Record _ ->
                     False
+
+                Shader _ ->
+                    False

src/Stage/Desugar.elm

@@ -248,6 +248,9 @@ desugarExpr modules thisModule locatedExpr =
                     |> Result.combine
                 )
 
+        Frontend.Shader shader _ ->
+            return <| Canonical.Shader shader
+
 
 desugarPattern :
     Frontend.LocatedPattern

src/Stage/Emit.elm

@@ -564,3 +564,6 @@ findDependenciesOfExpr modules locatedExpr =
             Result.map2 (++)
                 (f e)
                 branchesDependencies
+
+        Shader _ ->
+            Ok []

src/Stage/Emit/JavaScript.elm

@@ -132,6 +132,9 @@ emitExpr located =
         Case _ _ ->
             "TODO"
 
+        Shader _ ->
+            "TODO"
+
 
 emitDeclaration : Declaration Typed.LocatedExpr Never Qualified -> String
 emitDeclaration { module_, name, body } =

src/Stage/Emit/JsonAST.elm

@@ -155,6 +155,9 @@ emitExpr located =
                   )
                 ]
 
+        Shader shader ->
+            encode "shader" [ ( "value", Encode.string shader ) ]
+
 
 emitDeclaration : Declaration Typed.LocatedExpr Never Qualified -> Value
 emitDeclaration { module_, name, body } =

src/Stage/InferTypes.elm

@@ -212,6 +212,9 @@ getBetterType substitutionMap typeOrId =
                             Record <|
                                 Dict.map (\_ binding -> getBetterType substitutionMap binding) bindings
 
+                    Shader _ ->
+                        typeOrId
+
 
 unifyWithTypeAnnotation :
     Dict ( ModuleName, VarName ) (ConcreteType Qualified)

src/Stage/InferTypes/AssignIds.elm

@@ -304,6 +304,9 @@ assignIdsHelp currentId located =
             assignId newId <|
                 Typed.Case e_ branches_
 
+        Canonical.Shader shader ->
+            assignId currentId (Typed.Shader shader)
+
 
 assignPatternIds : Int -> Canonical.LocatedPattern -> ( Typed.LocatedPattern, Int )
 assignPatternIds currentId locatedCanonicalPattern =

src/Stage/InferTypes/GenerateEquations.elm

@@ -428,6 +428,9 @@ generateEquations currentId located =
             , newId
             )
 
+        Typed.Shader _ ->
+            Debug.todo "Shader"
+
 
 findArgumentUsages : VarName -> Typed.LocatedExpr -> List Typed.LocatedExpr
 findArgumentUsages argument bodyExpr =

src/Stage/InferTypes/Unify.elm

@@ -187,6 +187,9 @@ unifyTypes t1 t2 aliases substitutionMap =
                 Just aliasedType ->
                     unifyTypes (ConcreteType.toType aliasedType) t2 aliases substitutionMap
 
+        ( Shader _, _ ) ->
+            err
+
 
 unifyVariable :
     Int
@@ -271,3 +274,6 @@ occurs id typeOrId substitutionMap =
 
                 UserDefinedType { args } ->
                     List.any f args
+
+                Shader _ ->
+                    False