MiniLogo Simulator

commit bda42ad2e01ede8f83cb80a5a96b8db4160f875e Author: Danila Fedorin Date: Fri Feb 1 20:02:24 2019 -0800 Add implementation of evaluator, without dynamic code loading. diff --git a/elm.json b/elm.json new file mode 100644 index 0000000..8e8c712 --- /dev/null +++ b/elm.json @@ -0,0 +1,27 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.0", + "dependencies": { + "direct": { + "avh4/elm-color": "1.0.0", + "elm/browser": "1.0.1", + "elm/core": "1.0.2", + "elm/html": "1.0.0", + "elm/parser": "1.1.0", + "joakin/elm-canvas": "3.0.3" + }, + "indirect": { + "elm/json": "1.1.2", + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.2" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} \ No newline at end of file diff --git a/index.html b/index.html new file mode 100644 index 0000000..6a81602 --- /dev/null +++ b/index.html @@ -0,0 +1,32 @@ + + + MiniLogo Simulator + + + + +

+ + + diff --git a/src/Main.elm b/src/Main.elm new file mode 100644 index 0000000..4461099 --- /dev/null +++ b/src/Main.elm @@ -0,0 +1,334 @@ +import Html exposing (Html, div, text) +import Html.Attributes exposing (class) +import Browser exposing (element) +import Canvas exposing (Shape) +import Dict exposing (Dict) +import Parser exposing (Parser, (|.), (|=), variable, succeed, symbol, int, spaces, map, oneOf, lazy, sequence, Trailing(..), keyword, run, backtrackable) +import Color +import Canvas exposing (Point, path, lineTo, circle, shapes, stroke, lineWidth) +import Set + +{- +======= Syntax Definitions ======= +-} +type LogoPenMode = Up | Down +type LogoExpr = Variable String + | Number Int + | Sum LogoExpr LogoExpr +type LogoCmd = Pen LogoPenMode + | Move LogoExpr LogoExpr + | Define String (List String) LogoProg + | Call String (List LogoExpr) +type alias LogoProg = List LogoCmd + +{- +======= Semantics Definitions ==== +-} + +type alias Coord = (Int, Int) +type alias Line = (Coord, Coord) +type alias Function = (List String, LogoProg) + +type Scope = Child Scope (Dict String Function) (Dict String Int) | End +type alias Board = List Line +type alias State = + { penMode : LogoPenMode + , pos : Coord + , scope : Scope + } + +type alias Step a = State -> Result String (a, State) + +{- +======= Type Definitions ======= +-} + +type alias Flags = + { initialText : String + } + +type alias Model = + { programText : String + } + +type Msg + = Run + +{- +======= Syntax Code +-} + +parseInt : Parser LogoExpr +parseInt = map Number int + +parseVarName : Parser String +parseVarName = variable + { start = Char.isAlphaNum + , inner = Char.isAlphaNum + , reserved = Set.fromList [ "move", "pen", "define", "call" ] + } + +parseVar : Parser LogoExpr +parseVar = map Variable parseVarName + +parseSum : Parser LogoExpr +parseSum = succeed Sum + |= oneOf [ backtrackable parseVar, backtrackable parseInt ] + |. spaces + |. symbol "+" + |. spaces + |= parseExpr + +parseExpr : Parser LogoExpr +parseExpr = oneOf [ lazy (\_ -> backtrackable parseSum), backtrackable parseInt, backtrackable parseVar ] + +parseProg : Parser LogoProg +parseProg = sequence + { start = "" + , separator = ";" + , end = "" + , spaces = spaces + , item = lazy (\_ -> parseCmd) + , trailing = Mandatory + } + +parseCmd : Parser LogoCmd +parseCmd = oneOf [ parseDefine, parseCall, parseMove, parsePen ] + +parseDefine : Parser LogoCmd +parseDefine = succeed Define + |. keyword "define" + |. spaces + |= parseVarName + |. spaces + |= sequence + { start = "(" + , separator = "," + , end = ")" + , spaces = spaces + , item = parseVarName + , trailing = Forbidden + } + |. spaces + |. symbol "{" + |. spaces + |= parseProg + |. spaces + |. symbol "}" + +parseCall : Parser LogoCmd +parseCall = succeed Call + |. keyword "call" + |. spaces + |= parseVarName + |. spaces + |= sequence + { start = "(" + , separator = "," + , end = ")" + , spaces = spaces + , item = parseExpr + , trailing = Forbidden + } + +parsePenMode : Parser LogoPenMode +parsePenMode = oneOf + [ succeed Up |. keyword "up" + , succeed Down |. keyword "down" + ] + +parsePen : Parser LogoCmd +parsePen = succeed Pen + |. keyword "pen" + |. spaces + |= parsePenMode + +parseMove : Parser LogoCmd +parseMove = succeed Move + |. keyword "move" + |. spaces + |. symbol "(" + |= parseExpr + |. spaces + |. symbol "," + |. spaces + |= parseExpr + |. symbol ")" + +{- +======= Semantics Code ======= +-} + +initialScope : Scope +initialScope = Child End Dict.empty Dict.empty + +initialState : State +initialState = + { penMode = Up + , pos = (0, 0) + , scope = initialScope + } + +unit : a -> Step a +unit a state = Ok (a, state) + +bind : Step a -> (a -> Step b) -> Step b +bind sa f state = case sa state of + Ok (a, newState) -> f a newState + Err e -> Err e + +rbind : (a -> Step b) -> Step a -> Step b +rbind f sa = bind sa f + +updatePosition : Coord -> Board -> Step Board +updatePosition c b state = + let + newBoard = case state.penMode of + Up -> b + Down -> (state.pos, c)::b + in + Ok (newBoard, { state | pos = c }) + +registerFunction : String -> Function -> Step () +registerFunction s f state = Ok ((), { state | scope = setScopeFunction s f state.scope }) + +registerVariable : String -> Int -> Step () +registerVariable s v state = Ok ((), { state | scope = setScopeVariable s v state.scope }) + +setPenMode : LogoPenMode -> Step () +setPenMode m state = Ok ((), { state | penMode = m}) + +upScope : Step () +upScope state = Ok ((), { state | scope = Child state.scope Dict.empty Dict.empty }) + +downScope : Step () +downScope state = + let + newScope = case state.scope of + End -> End + Child p _ _ -> p + in + Ok ((), { state | scope = newScope }) + +setScopeFunction : String -> Function -> Scope -> Scope +setScopeFunction s f scope = case scope of + End -> setScopeFunction s f initialScope + Child p fs vs -> Child p (Dict.insert s f fs) vs + +setScopeVariable : String -> Int -> Scope -> Scope +setScopeVariable s v scope = case scope of + End -> setScopeVariable s v initialScope + Child p fs vs -> Child p fs (Dict.insert s v vs) + +scopeFunction : String -> Scope -> Maybe Function +scopeFunction s scope = case scope of + End -> Nothing + Child p fs _ -> case Dict.get s fs of + Just f -> Just f + Nothing -> scopeFunction s p + +scopeVariable : String -> Scope -> Maybe Int +scopeVariable s scope = case scope of + End -> Nothing + Child p _ vs -> case Dict.get s vs of + Just i -> Just i + Nothing -> scopeVariable s p + +lookupFunction : String -> Step Function +lookupFunction s state = case scopeFunction s state.scope of + Just f -> Ok (f, state) + Nothing -> Err ("No function with name " ++ s) + +lookupVariable : String -> Step Int +lookupVariable s state = case scopeVariable s state.scope of + Just i -> Ok (i, state) + Nothing -> Err ("No variable with name " ++ s) + +evaluateExp : LogoExpr -> Step Int +evaluateExp le = case le of + Number i -> unit i + Variable v -> lookupVariable v + Sum l r -> evaluateExp l |> rbind (\vl -> evaluateExp r |> rbind (\vr -> unit (vl + vr))) + +evaluateAllExps : List LogoExpr -> Step (List Int) +evaluateAllExps = List.foldr (\x acc -> acc |> rbind (\vs -> evaluateExp x |> rbind (\v -> unit (v::vs)))) (unit []) + +registerAllVariables : List (String, Int) -> Step () +registerAllVariables = List.foldl (\(s, i) m -> bind m (\_ -> registerVariable s i)) (unit ()) + +zip : List a -> List b -> List (a, b) +zip la lb = case (la, lb) of + (a::lat, b::lbt) -> (a, b)::zip lat lbt + _ -> [] + +evaluateCmd : LogoCmd -> Board -> Step Board +evaluateCmd c b = case c of + Move l r -> evaluateExp l |> rbind (\x -> evaluateExp r |> rbind (\y -> updatePosition (x, y) b)) + Define n xs prg -> registerFunction n (xs, prg) |> rbind (\_ -> unit b) + Pen mode -> setPenMode mode |> rbind (\_ -> unit b) + Call n args -> lookupFunction n + |> rbind (\(ns, prg) -> evaluateAllExps args + |> rbind (\vs -> upScope + |> rbind (\_ -> registerAllVariables (zip ns vs) + |> rbind (\_ -> evaluateAll prg b + |> rbind (\nb -> downScope + |> rbind (\_ -> unit nb)))))) + +evaluateAll : LogoProg -> Board -> Step Board +evaluateAll prg board = List.foldl rbind (unit board) <| List.map evaluateCmd prg + +{- +======= Drawing Stuff ===== +-} +transformCoord : Coord -> Point +transformCoord (x, y) = (toFloat x * 25, 500 - toFloat y * 25) + +lineShape : Line -> Shape +lineShape (c1, c2) = path (transformCoord c1) [ lineTo (transformCoord c2) ] + +pointerShape : Coord -> Shape +pointerShape c = circle (transformCoord c) 5 + +allShapes : (Board, State) -> List Shape +allShapes (b, s) = pointerShape s.pos :: List.map lineShape b + +canvas : (Board, State) -> Html Msg +canvas dat = Canvas.toHtml (500, 500) [] + [ shapes [ stroke Color.blue, lineWidth 5] (allShapes dat) + ] + +{- +======= Elm Architecture ======= +-} + +init : Flags -> (Model, Cmd Msg) +init fs = + let + model = + { programText = fs.initialText + } + cmd = Cmd.none + in + (model, cmd) + +view : Model -> Html Msg +view m = + let + dat = Result.withDefault ([], initialState) + <| Result.withDefault (Err "Couldn't parse program") + <| Result.map (\prg -> evaluateAll prg [] initialState) (run parseProg m.programText) + in + canvas dat + +update : Msg -> Model -> (Model, Cmd Msg) +update msg m = (m, Cmd.none) + +subscriptions : Model -> Sub Msg +subscriptions m = Sub.none + +main = element + { init = init + , view = view + , update = update + , subscriptions = subscriptions + }